[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/native-comp 2fcb85c 1/2: Merge remote-tracking branch 'savannah/
|
From: |
Andrea Corallo |
|
Subject: |
feature/native-comp 2fcb85c 1/2: Merge remote-tracking branch 'savannah/master' into HEAD |
|
Date: |
Wed, 10 Feb 2021 16:04:06 -0500 (EST) |
branch: feature/native-comp
commit 2fcb85c3e780f1f2871ce0f300cfaffce9836eb0
Merge: 1f626e9 6bfdfee
Author: Andrea Corallo <akrl@sdf.org>
Commit: Andrea Corallo <akrl@sdf.org>
Merge remote-tracking branch 'savannah/master' into HEAD
---
CONTRIBUTE | 2 +-
ChangeLog.3 | 1969 ++++++++++++++++++++
admin/admin.el | 18 +-
admin/authors.el | 20 +-
admin/cus-test.el | 17 +-
admin/find-gc.el | 25 +-
admin/gitmerge.el | 8 +-
doc/emacs/buffers.texi | 32 +-
doc/emacs/custom.texi | 9 +-
doc/emacs/display.texi | 18 +-
doc/emacs/files.texi | 6 +-
doc/emacs/indent.texi | 4 +-
doc/emacs/killing.texi | 14 +-
doc/emacs/search.texi | 7 +
doc/emacs/windows.texi | 8 +-
doc/lispref/frames.texi | 2 +
doc/lispref/hash.texi | 9 +-
doc/lispref/keymaps.texi | 6 -
doc/lispref/lists.texi | 15 +-
doc/lispref/maps.texi | 3 -
doc/lispref/minibuf.texi | 21 +-
doc/lispref/modes.texi | 5 +
doc/lispref/processes.texi | 6 +-
doc/lispref/syntax.texi | 9 +-
doc/misc/dbus.texi | 5 +
doc/misc/tramp.texi | 7 +-
etc/MACHINES | 5 +-
etc/NEWS | 162 +-
etc/facemenu-removal.txt | 20 +
etc/themes/modus-operandi-theme.el | 10 +-
etc/themes/modus-vivendi-theme.el | 10 +-
leim/SKK-DIC/SKK-JISYO.L | 4 +-
lisp/abbrev.el | 3 +-
lisp/align.el | 10 +-
lisp/allout-widgets.el | 47 +-
lisp/allout.el | 79 +-
lisp/auth-source.el | 77 +-
lisp/avoid.el | 21 +-
lisp/bindings.el | 27 +-
lisp/bookmark.el | 10 +-
lisp/buff-menu.el | 3 +-
lisp/calc/calc-embed.el | 36 +-
lisp/calc/calcalg2.el | 4 +-
lisp/cedet/data-debug.el | 48 +-
lisp/cedet/ede.el | 9 +-
lisp/cedet/ede/proj-archive.el | 2 +
lisp/cedet/ede/project-am.el | 111 +-
lisp/cedet/mode-local.el | 3 +-
lisp/cedet/pulse.el | 4 +-
lisp/cedet/semantic.el | 36 +-
lisp/cedet/semantic/bovine.el | 3 +-
lisp/cedet/semantic/bovine/gcc.el | 11 +-
lisp/cedet/semantic/complete.el | 3 +-
lisp/cedet/semantic/ctxt.el | 6 +-
lisp/cedet/semantic/db-find.el | 6 +-
lisp/cedet/semantic/db.el | 18 +-
lisp/cedet/semantic/debug.el | 12 +-
lisp/cedet/semantic/dep.el | 6 +-
lisp/cedet/semantic/format.el | 6 +-
lisp/cedet/semantic/fw.el | 3 +-
lisp/cedet/semantic/grammar.el | 9 +-
lisp/cedet/semantic/idle.el | 38 +-
lisp/cedet/semantic/imenu.el | 3 +-
lisp/cedet/semantic/lex-spp.el | 12 +-
lisp/cedet/semantic/lex.el | 52 +-
lisp/cedet/semantic/scope.el | 14 +-
lisp/cedet/semantic/senator.el | 3 +-
lisp/cedet/semantic/sort.el | 3 +-
lisp/cedet/semantic/tag.el | 3 +-
lisp/cedet/semantic/util-modes.el | 13 +-
lisp/cedet/semantic/util.el | 6 +-
lisp/cedet/semantic/wisent.el | 6 +-
lisp/color.el | 5 -
lisp/comint.el | 32 +-
lisp/completion.el | 3 +-
lisp/cus-dep.el | 4 +-
lisp/cus-edit.el | 7 +-
lisp/cus-start.el | 2 +-
lisp/custom.el | 6 +-
lisp/dframe.el | 66 +-
lisp/dired-aux.el | 2 +-
lisp/dired.el | 16 +-
lisp/double.el | 9 +-
lisp/ehelp.el | 3 +-
lisp/emacs-lisp/byte-opt.el | 439 +++--
lisp/emacs-lisp/bytecomp.el | 3 +-
lisp/emacs-lisp/chart.el | 3 +-
lisp/emacs-lisp/checkdoc.el | 7 -
lisp/emacs-lisp/easy-mmode.el | 12 +-
lisp/emacs-lisp/edebug.el | 81 +-
lisp/emacs-lisp/elp.el | 3 +-
lisp/emacs-lisp/generator.el | 21 +-
lisp/emacs-lisp/generic.el | 3 +-
lisp/emacs-lisp/lisp-mnt.el | 2 +-
lisp/emacs-lisp/lisp-mode.el | 25 +-
lisp/emacs-lisp/macroexp.el | 71 +-
lisp/emacs-lisp/package-x.el | 3 +-
lisp/emacs-lisp/pcase.el | 19 +-
lisp/emacs-lisp/pp.el | 5 +-
lisp/emacs-lisp/re-builder.el | 10 +-
lisp/emacs-lisp/syntax.el | 3 +-
lisp/emacs-lisp/tcover-ses.el | 2 +
lisp/emacs-lisp/testcover.el | 52 +-
lisp/emulation/cua-base.el | 8 +-
lisp/emulation/cua-rect.el | 6 +-
lisp/emulation/viper-cmd.el | 2 +-
lisp/emulation/viper-init.el | 117 +-
lisp/emulation/viper-keym.el | 22 +-
lisp/emulation/viper-mous.el | 11 +-
lisp/emulation/viper-util.el | 10 +-
lisp/emulation/viper.el | 5 -
lisp/epa.el | 6 +-
lisp/epg.el | 46 +-
lisp/erc/erc-backend.el | 84 +-
lisp/erc/erc-capab.el | 6 +-
lisp/erc/erc-dcc.el | 9 +-
lisp/erc/erc-ezbounce.el | 3 +-
lisp/erc/erc-imenu.el | 2 -
lisp/erc/erc-join.el | 3 +-
lisp/erc/erc-netsplit.el | 3 +-
lisp/erc/erc-networks.el | 3 +-
lisp/erc/erc-notify.el | 6 +-
lisp/erc/erc-pcomplete.el | 2 +-
lisp/erc/erc-ring.el | 6 +-
lisp/erc/erc-stamp.el | 9 +-
lisp/erc/erc.el | 126 +-
lisp/eshell/em-cmpl.el | 189 +-
lisp/eshell/em-hist.el | 30 +-
lisp/eshell/esh-cmd.el | 18 +-
lisp/eshell/esh-util.el | 10 +-
lisp/expand.el | 9 +-
lisp/face-remap.el | 27 +-
lisp/facemenu.el | 4 -
lisp/ffap.el | 3 +-
lisp/files-x.el | 3 +-
lisp/files.el | 41 +-
lisp/foldout.el | 6 +-
lisp/follow.el | 3 +-
lisp/font-core.el | 3 +-
lisp/font-lock.el | 15 +-
lisp/forms.el | 3 +-
lisp/frame.el | 1 +
lisp/generic-x.el | 337 ++--
lisp/gnus/canlock.el | 13 +-
lisp/gnus/deuglify.el | 38 +-
lisp/gnus/gmm-utils.el | 24 +-
lisp/gnus/gnus-agent.el | 108 +-
lisp/gnus/gnus-art.el | 675 +++----
lisp/gnus/gnus-bcklg.el | 2 +-
lisp/gnus/gnus-bookmark.el | 33 +-
lisp/gnus/gnus-cache.el | 18 +-
lisp/gnus/gnus-cite.el | 80 +-
lisp/gnus/gnus-cloud.el | 16 +-
lisp/gnus/gnus-cus.el | 13 +-
lisp/gnus/gnus-delay.el | 20 +-
lisp/gnus/gnus-demon.el | 4 +-
lisp/gnus/gnus-diary.el | 16 +-
lisp/gnus/gnus-dired.el | 10 +-
lisp/gnus/gnus-draft.el | 17 +-
lisp/gnus/gnus-dup.el | 3 -
lisp/gnus/gnus-eform.el | 4 +-
lisp/gnus/gnus-fun.el | 8 +-
lisp/gnus/gnus-gravatar.el | 9 +-
lisp/gnus/gnus-group.el | 189 +-
lisp/gnus/gnus-html.el | 130 +-
lisp/gnus/gnus-int.el | 400 ++--
lisp/gnus/gnus-kill.el | 26 +-
lisp/gnus/gnus-logic.el | 2 +-
lisp/gnus/gnus-mh.el | 6 +-
lisp/gnus/gnus-ml.el | 2 +-
lisp/gnus/gnus-mlspl.el | 6 +-
lisp/gnus/gnus-msg.el | 287 +--
lisp/gnus/gnus-notifications.el | 16 +-
lisp/gnus/gnus-picon.el | 25 +-
lisp/gnus/gnus-range.el | 4 +-
lisp/gnus/gnus-registry.el | 15 +-
lisp/gnus/gnus-rfc1843.el | 8 +-
lisp/gnus/gnus-salt.el | 8 +-
lisp/gnus/gnus-score.el | 131 +-
lisp/gnus/gnus-search.el | 123 +-
lisp/gnus/gnus-sieve.el | 28 +-
lisp/gnus/gnus-spec.el | 46 +-
lisp/gnus/gnus-srvr.el | 19 +-
lisp/gnus/gnus-start.el | 125 +-
lisp/gnus/gnus-sum.el | 95 +-
lisp/gnus/gnus-topic.el | 84 +-
lisp/gnus/gnus-undo.el | 34 +-
lisp/gnus/gnus-util.el | 165 +-
lisp/gnus/gnus-uu.el | 47 +-
lisp/gnus/gnus-vm.el | 2 +-
lisp/gnus/gnus-win.el | 14 +-
lisp/gnus/gnus.el | 13 +-
lisp/gnus/gssapi.el | 2 +-
lisp/gnus/legacy-gnus-agent.el | 4 +-
lisp/gnus/mail-source.el | 146 +-
lisp/gnus/message.el | 72 +-
lisp/gnus/mm-archive.el | 16 +-
lisp/gnus/mm-bodies.el | 2 +-
lisp/gnus/mm-decode.el | 14 +-
lisp/gnus/mm-encode.el | 11 +-
lisp/gnus/mm-partial.el | 19 +-
lisp/gnus/mm-url.el | 13 +-
lisp/gnus/mm-util.el | 14 +-
lisp/gnus/mm-view.el | 67 +-
lisp/gnus/mml-sec.el | 31 +-
lisp/gnus/mml-smime.el | 29 +-
lisp/gnus/mml.el | 91 +-
lisp/gnus/mml1991.el | 13 +-
lisp/gnus/mml2015.el | 30 +-
lisp/gnus/nnagent.el | 18 +-
lisp/gnus/nnbabyl.el | 38 +-
lisp/gnus/nndiary.el | 61 +-
lisp/gnus/nndir.el | 2 +-
lisp/gnus/nndoc.el | 37 +-
lisp/gnus/nndraft.el | 34 +-
lisp/gnus/nneething.el | 16 +-
lisp/gnus/nnfolder.el | 26 +-
lisp/gnus/nngateway.el | 2 +-
lisp/gnus/nnheader.el | 55 +-
lisp/gnus/nnimap.el | 9 +-
lisp/gnus/nnmail.el | 59 +-
lisp/gnus/nnmaildir.el | 40 +-
lisp/gnus/nnmairix.el | 145 +-
lisp/gnus/nnmbox.el | 46 +-
lisp/gnus/nnmh.el | 45 +-
lisp/gnus/nnml.el | 40 +-
lisp/gnus/nnnil.el | 22 +-
lisp/gnus/nnoo.el | 128 +-
lisp/gnus/nnregistry.el | 13 +-
lisp/gnus/nnrss.el | 25 +-
lisp/gnus/nnselect.el | 38 +-
lisp/gnus/nnspool.el | 34 +-
lisp/gnus/nntp.el | 14 +-
lisp/gnus/nnvirtual.el | 44 +-
lisp/gnus/nnweb.el | 30 +-
lisp/gnus/score-mode.el | 2 +-
lisp/gnus/smiley.el | 21 +-
lisp/gnus/smime.el | 39 +-
lisp/gnus/spam-report.el | 28 +-
lisp/gnus/spam-stat.el | 55 +-
lisp/gnus/spam-wash.el | 8 +-
lisp/gnus/spam.el | 377 ++--
lisp/help-fns.el | 4 +-
lisp/help-mode.el | 12 +-
lisp/hexl.el | 6 +-
lisp/hi-lock.el | 8 +-
lisp/hilit-chg.el | 4 +-
lisp/ibuffer.el | 19 +-
lisp/ido.el | 3 +-
lisp/imenu.el | 105 +-
lisp/indent.el | 16 +-
lisp/info.el | 4 +-
lisp/international/characters.el | 2 +-
lisp/international/mule-cmds.el | 88 +-
lisp/international/mule.el | 3 +-
lisp/international/quail.el | 37 +-
lisp/international/robin.el | 6 +-
lisp/isearch.el | 26 +-
lisp/jka-compr.el | 3 +-
lisp/jsonrpc.el | 8 +-
lisp/language/ethio-util.el | 3 +-
lisp/language/korea-util.el | 16 +-
lisp/ldefs-boot.el | 191 +-
lisp/leim/quail/hangul.el | 3 +-
lisp/leim/quail/japanese.el | 3 +-
lisp/linum.el | 6 +-
lisp/loadup.el | 26 +-
lisp/mail/emacsbug.el | 6 +-
lisp/mail/mail-utils.el | 4 +-
lisp/mail/reporter.el | 3 +-
lisp/mail/rmail.el | 6 +-
lisp/mail/rmailsum.el | 9 +-
lisp/mail/sendmail.el | 6 +-
lisp/mail/supercite.el | 7 +-
lisp/man.el | 26 +-
lisp/menu-bar.el | 9 +-
lisp/mh-e/mh-e.el | 1 +
lisp/mh-e/mh-mime.el | 4 +-
lisp/minibuffer.el | 23 +-
lisp/mouse-copy.el | 3 -
lisp/mouse-drag.el | 3 -
lisp/net/browse-url.el | 3 +-
lisp/net/dbus.el | 17 +
lisp/net/dictionary-connection.el | 23 +-
lisp/net/dictionary.el | 177 +-
lisp/net/ldap.el | 10 +-
lisp/net/mailcap.el | 10 +-
lisp/net/mairix.el | 145 +-
lisp/net/newst-backend.el | 1 -
lisp/net/newst-plainview.el | 1 -
lisp/net/rcirc.el | 15 +-
lisp/net/snmp-mode.el | 44 +-
lisp/net/soap-inspect.el | 8 +-
lisp/net/telnet.el | 11 +-
lisp/net/tramp-adb.el | 26 +-
lisp/net/tramp-compat.el | 7 +
lisp/net/tramp-crypt.el | 12 +-
lisp/net/tramp-gvfs.el | 179 +-
lisp/net/tramp-rclone.el | 12 +-
lisp/net/tramp-sh.el | 35 +-
lisp/net/tramp-smb.el | 43 +-
lisp/net/tramp-sudoedit.el | 8 +-
lisp/net/tramp.el | 33 +-
lisp/nxml/rng-cmpct.el | 9 +-
lisp/nxml/rng-pttrn.el | 3 +-
lisp/nxml/rng-valid.el | 30 +-
lisp/org/ol-w3m.el | 6 +-
lisp/org/org-refile.el | 6 +-
lisp/org/org-table.el | 2 +-
lisp/org/org.el | 2 +-
lisp/pcomplete.el | 34 +-
lisp/play/5x5.el | 55 +-
lisp/play/blackbox.el | 2 +-
lisp/play/bubbles.el | 11 +-
lisp/play/cookie1.el | 15 +-
lisp/play/decipher.el | 24 +-
lisp/play/doctor.el | 2 +-
lisp/play/dunnet.el | 3 +-
lisp/play/gamegrid.el | 42 +-
lisp/play/gametree.el | 33 +-
lisp/play/gomoku.el | 9 +-
lisp/play/hanoi.el | 16 +-
lisp/play/snake.el | 26 +-
lisp/play/tetris.el | 28 +-
lisp/play/zone.el | 21 +-
lisp/progmodes/antlr-mode.el | 7 +-
lisp/progmodes/cc-engine.el | 21 +-
lisp/progmodes/cc-langs.el | 49 +-
lisp/progmodes/cmacexp.el | 9 -
lisp/progmodes/compile.el | 19 +-
lisp/progmodes/cperl-mode.el | 90 +-
lisp/progmodes/cpp.el | 18 +-
lisp/progmodes/dcl-mode.el | 32 +-
lisp/progmodes/ebnf2ps.el | 15 +-
lisp/progmodes/elisp-mode.el | 19 +-
lisp/progmodes/f90.el | 19 +-
lisp/progmodes/grep.el | 2 -
lisp/progmodes/gud.el | 3 +-
lisp/progmodes/idlwave.el | 1 -
lisp/progmodes/js.el | 19 +-
lisp/progmodes/make-mode.el | 3 +
lisp/progmodes/octave.el | 8 +-
lisp/progmodes/project.el | 2 +
lisp/progmodes/python.el | 3 +-
lisp/progmodes/ruby-mode.el | 4 +-
lisp/progmodes/sh-script.el | 3 +-
lisp/progmodes/simula.el | 2 +-
lisp/progmodes/sql.el | 4 +-
lisp/progmodes/tcl.el | 29 +-
lisp/progmodes/verilog-mode.el | 616 ++++--
lisp/registry.el | 33 +-
lisp/repeat.el | 4 +-
lisp/replace.el | 9 +-
lisp/reveal.el | 6 +-
lisp/ruler-mode.el | 3 +-
lisp/scroll-lock.el | 3 +-
lisp/server.el | 6 +-
lisp/shell.el | 7 +-
lisp/simple.el | 114 +-
lisp/speedbar.el | 22 +-
lisp/startup.el | 2 +-
lisp/subr.el | 18 +-
lisp/tab-bar.el | 3 +-
lisp/tab-line.el | 4 +-
lisp/tar-mode.el | 7 +-
lisp/term.el | 654 +++----
lisp/term/ns-win.el | 3 +-
lisp/textmodes/artist.el | 34 +-
lisp/textmodes/bib-mode.el | 11 +-
lisp/textmodes/css-mode.el | 9 +-
lisp/textmodes/dns-mode.el | 20 +-
lisp/textmodes/enriched.el | 4 +-
lisp/textmodes/flyspell.el | 39 +-
lisp/textmodes/ispell.el | 10 +-
lisp/textmodes/less-css-mode.el | 1 -
lisp/textmodes/nroff-mode.el | 2 +-
lisp/textmodes/refill.el | 6 +-
lisp/textmodes/rst.el | 5 +-
lisp/textmodes/sgml-mode.el | 16 +-
lisp/textmodes/table.el | 3 +-
lisp/textmodes/tex-mode.el | 3 +-
lisp/textmodes/texinfmt.el | 10 +-
lisp/textmodes/text-mode.el | 4 -
lisp/textmodes/two-column.el | 6 +-
lisp/thumbs.el | 18 +-
lisp/tutorial.el | 9 +-
lisp/url/url-http.el | 6 +-
lisp/url/url-vars.el | 13 +-
lisp/vc/cvs-status.el | 5 +-
lisp/vc/ediff-diff.el | 15 +-
lisp/vc/ediff-init.el | 75 +-
lisp/vc/ediff-util.el | 4 +-
lisp/vc/smerge-mode.el | 5 +-
lisp/vc/vc-bzr.el | 27 +-
lisp/vc/vc-cvs.el | 18 +-
lisp/vc/vc-dir.el | 62 +-
lisp/vc/vc-dispatcher.el | 3 +-
lisp/vc/vc-git.el | 38 +-
lisp/vc/vc-hg.el | 4 +-
lisp/vc/vc-svn.el | 4 +-
lisp/vc/vc.el | 3 +
lisp/vcursor.el | 8 +-
lisp/view.el | 30 +-
lisp/wid-edit.el | 19 +-
lisp/window.el | 57 +-
lisp/woman.el | 5 +-
src/data.c | 4 +-
src/editfns.c | 10 +-
src/eval.c | 2 +
src/filelock.c | 2 +-
src/fns.c | 33 +
src/frame.c | 16 +-
src/frame.h | 12 +-
src/keymap.c | 9 -
src/lisp.h | 1 +
src/lread.c | 117 +-
src/macros.c | 5 +-
src/minibuf.c | 64 +-
src/nsfns.m | 27 +-
src/nsmenu.m | 4 +-
src/w32fns.c | 32 +-
src/w32menu.c | 10 +-
src/xdisp.c | 52 +-
src/xfaces.c | 2 +-
src/xfns.c | 36 +-
src/xmenu.c | 14 +-
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/bytecomp-tests.el | 92 +-
test/lisp/emacs-lisp/cl-extra-tests.el | 22 +-
test/lisp/emacs-lisp/cl-lib-tests.el | 22 +-
test/lisp/emacs-lisp/cl-macs-tests.el | 22 +-
.../edebug-resources/edebug-test-code.el | 22 +-
test/lisp/emacs-lisp/edebug-tests.el | 22 +-
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 +
.../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/mail/mail-utils-tests.el | 104 ++
test/lisp/minibuffer-tests.el | 24 +-
test/lisp/net/dbus-tests.el | 8 +
test/lisp/net/sasl-scram-rfc-tests.el | 2 +
test/lisp/net/tramp-tests.el | 14 +-
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 +
test/lisp/progmodes/ruby-mode-resources/ruby.rb | 2 +-
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/editfns-tests.el | 22 +-
test/src/fns-tests.el | 30 +-
test/src/indent-tests.el | 22 +-
test/src/minibuf-tests.el | 8 +-
test/src/process-tests.el | 28 +
500 files changed, 9775 insertions(+), 7468 deletions(-)
diff --git a/CONTRIBUTE b/CONTRIBUTE
index cb09391..9b2af9c 100644
--- a/CONTRIBUTE
+++ b/CONTRIBUTE
@@ -67,7 +67,7 @@ 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
+of non-trivial code, 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.
diff --git a/ChangeLog.3 b/ChangeLog.3
index 22b45cb..460a1d2 100644
--- a/ChangeLog.3
+++ b/ChangeLog.3
@@ -1,3 +1,1971 @@
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Bump Emacs version to 27.1.91
+
+ * README:
+ * configure.ac:
+ * nt/README.W32:
+ * msdos/sed2v2.inp: Bump Emacs version to 27.1.91.
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Improve documentation of 'read-regexp' and friends
+
+ * doc/emacs/glossary.texi (Glossary): Add "Tag" to the Glossary.
+ * doc/emacs/maintaining.texi (Xref): Mention that identifiers are
+ also known as "tags".
+
+ * lisp/replace.el (read-regexp, read-regexp-suggestions): Improve
+ wording of doc strings. (Bug#46088) (Bug#46089)
+
+ (cherry picked from commit 49eb03d6c8a181fd46adbbcf1f0a976d0a9efa87)
+
+2021-02-03 Lars Ingebrigtsen <larsi@gnus.org>
+
+ read-regexp-suggestions doc string improvement
+
+ * lisp/replace.el (read-regexp-suggestions): Add a link to the
+ manual to explain what a tag is (bug#46089).
+
+ (cherry picked from commit f9cc2d48246fe8370e9286866e6115ba8e2acf44)
+
+2021-02-03 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Try to improve the read-regexp doc string
+
+ * lisp/replace.el (read-regexp): Attempt to clarify the semantics
+ (bug#46088).
+
+ (cherry picked from commit eded2a7ad7d456a417354a2797c18e9a578414d7)
+
+2021-02-03 Dmitry Gutov <dgutov@yandex.ru>
+
+ Erase the buffer only after fetching the new contents
+
+ * lisp/progmodes/xref.el (xref-revert-buffer):
+ Erase the buffer only after fetching the new contents (bug#46042).
+
+ (cherry picked from commit 5821dee0949b2913c07970d6e4b8bb8e8a35f036)
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Fix last change
+
+ * doc/lispref/text.texi (Undo): Add a cross-reference to the
+ description of 'undo-amalgamate-change-group'.
+ (Atomic Changes): Expand and improve the description of
+ 'undo-amalgamate-change-group'. (Bug#42303)
+
+2021-02-03 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Mention undo-amalgamate-change-group in the lispref manual
+
+ * doc/lispref/text.texi (Atomic Changes): Mention
+ undo-amalgamate-change-group (bug#42303).
+
+ (cherry picked from commit ba25a82855a2c03c25fec83f3056c166b692e94f)
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid sending systemd shutdown notifications if non-daemon
+
+ * src/emacs.c (Fkill_emacs): Send the shutdown notification only
+ in daemon mode. (Bug#46022)
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ * src/cmds.c (Fforward_line): Doc fix. (Bug#46027)
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Improve documentation of sendmail.el defcustom's
+
+ * lisp/mail/sendmail.el (mail-archive-file-name)
+ (mail-default-reply-to, mail-self-blind, mail-default-headers):
+ Say in the doc string that 'message-default-mail-headers' shall be
+ customized when using 'message-mode' for email composition.
+ (Bug#46029)
+
+2021-02-03 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Don't let `maybe_quit` prevent resetting `consing_until_gc` (bug#43389)
+
+ * src/alloc.c (garbage_collect): Postpone `unblock_input` a bit.
+ * src/window.c (window_parameter): Avoid `maybe_quit`.
+
+ cherry picked from commit 420661af07448857f0a17e15dc27bceeb6aff541
+
+2021-02-03 Juri Linkov <juri@linkov.net>
+
+ Remove one of recently added warnings abound binding keys in Isearch
maps
+
+ * lisp/isearch.el (minibuffer-local-isearch-map): Remove comments
+ which warn against wantonly rebinding unbound keys from
+ irrelevant keymap.
+ https://lists.gnu.org/archive/html/emacs-devel/2021-01/msg00259.html
+
+2021-02-03 Martin Rudalics <rudalics@gmx.at>
+
+ Fix assertion failure in window_box_height (Bug#45737)
+
+ * lisp/window.el (window-sizable): Don't try to grow a mini window
+ when the root window's minimum height is already larger than its
+ actual height (Bug#45737).
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Fix cl-concatenate inlining
+
+ * lisp/emacs-lisp/seq.el (seq-concatenate): Auto-load it. Do not
+ merge to master. (Bug#45610)
+
+2021-02-03 Tak Kunihiro <tkk@misasa.okayama-u.ac.jp>
+
+ Fix infloop in 'pixel-scroll-mode'
+
+ * lisp/pixel-scroll.el (pixel-scroll-up, pixel-scroll-down): Avoid
+ inflooping when 'vertical-motion' doesn't move. (Bug#45628)
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Fix inhibiting the default.el loading in user init file
+
+ * lisp/startup.el (startup--load-user-init-file): Test the value
+ of 'inhibit-default-init', not just the LOAD-DEFAULTS argument,
+ because loading the user's init file could have set the value of
+ the former.
+ (command-line): Call 'startup--load-user-init-file' with last arg
+ t: there's no longer any need to test the value of
+ 'inhibit-default-init' here, as it will be tested by the called
+ function. (Bug#45708)
+
+2021-02-03 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Fix problem with 8bit content-transfer-encoding in nndoc mbox files
+
+ * lisp/gnus/nndoc.el (nndoc-possibly-change-buffer): If we're
+ reading an mbox file, it may contain messages that use
+ content-transfer-encoding 8bit, which means that we have to treat
+ the file as a sequence of byte (bug#42951). This avoids
+ double-decoding -- once by Emacs when inserting the mbox into the
+ buffer, and once by Gnus when displaying the articles.
+
+2021-02-03 Michael Albinus <michael.albinus@gmx.de>
+
+ * doc/misc/tramp.texi (Quick Start Guide): Fix thinko.
+
+2021-02-03 Robert Pluim <rpluim@gmail.com>
+
+ Tell people how to remove fontconfig customizations
+
+2021-02-03 Simen Heggestøyl <simenheg@gmail.com>
+
+ Remove extraneous closing paren
+
+ * doc/lispref/modes.texi (SMIE Indentation Example): Remove extraneous
+ closing paren.
+
+2021-02-03 Mauro Aranda <maurooaranda@gmail.com>
+
+ Update two user option names in the Widget manual
+
+ * doc/misc/widget.texi (Basic Types): The user options
+ widget-glyph-directory and widget-glyph-enable were renamed long ago
+ to widget-image-directory and widget-image-enable, but the manual
+ kept calling them by their old names. Update the names.
+
+2021-02-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ Mention -lcurses problem on AIX
+
+ * etc/PROBLEMS: Describe problem with Emacs 27 and -lcurses.
+ Do not merge to master.
+
+2021-02-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ Revert previous patch which was installed into wrong branch.
+
+2021-02-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix broken build on AIX 7.2
+
+ Without this fix, the build on AIX 7.2 with xlc fails in the ‘CCLD
+ temacs’ step with the diagnostic ‘ld: 0711-317 ERROR: Undefined
+ symbol: BC’. This is because -lcurses does not define BC etc.
+ * configure.ac: When building terminfo.o, define
+ TERMINFO_DEFINES_BC if the library defines BC etc.
+ * src/terminfo.c (UP, BC, PC): Define depending on
+ TERMINFO_DEFINES_BC, not on TERMINFO.
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Fix last change
+
+ * doc/lispref/strings.texi (Creating Strings): Improve wording of
+ last change. (Bug#45516)
+
+2021-02-03 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Add a reference between the Strings node and Search/Replace
+
+ * doc/lispref/strings.texi (Creating Strings): Mention
+ string-replace/replace-regexp-in-string (bug#45516).
+
+ (cherry picked from commit b9359d4183a1a6923122d3aa12b922ab89693354)
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Add warning comments abound binding keys in Isearch maps
+
+ * lisp/isearch.el (isearch-mode-map)
+ (minibuffer-local-isearch-map): Add comments which warn against
+ wantonly rebinding unbound keys.
+
+2021-02-03 Alan Third <alan@idiocy.org>
+
+ Fix crash in ns_mouse_position (bug#45541)
+
+ * src/nsterm.m (ns_mouse_position): Explicitly initialize f to NULL.
+
+2021-02-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix copyright years by hand
+
+ These are dates that admin/update-copyright did not update.
+
+2021-02-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ Update copyright year to 2021
+
+ Run "TZ=UTC0 admin/update-copyright $(git ls-files)".
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Improve documentation of 'network-lookup-address-info'
+
+ * src/process.c (Fnetwork_lookup_address_info):
+ * doc/lispref/processes.texi (Misc Network): Document the error
+ message emitted by 'network-lookup-address-info' when it fails.
+
+2021-02-03 Amin Bandali <bandali@gnu.org>
+
+ Display messages sent using ERC's /say
+
+ * lisp/erc/erc.el (erc-cmd-SAY): Call `erc-display-msg' to display the
+ user's message in the buffer, just like other [non-command] messages.
+
+ https://lists.gnu.org/r/help-gnu-emacs/2020-12/msg00066.html
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Fix Rmail summary display when From: header is malformed
+
+ * lisp/mail/rmailsum.el (rmail-header-summary): Remove newlines
+ from the "From:" value, to avoid producing corrupted summary
+ display.
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Add more details to the "word processor" section
+
+ * etc/TODO (Emacs as word processor): Add more details based on
+ recent discussions.
+
+2021-02-03 Philipp Stephani <phst@google.com>
+
+ * src/Makefile.in (DO_CODESIGN): Fix expected architecture name.
+
+2021-02-03 Itai Seggev <is+apple@cs.hmc.edu> (tiny change)
+
+ Codesign the executable on recene MacOS systems
+
+ * src/Makefile.in (temacs$(EXEEXT)): Codesign the executable on
+ recent (ARM) MacOS systems (bug#43878). Without this, building
+ Emacs fails.
+
+2021-02-03 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Support build of Emacs on ARM Macos machines
+
+ * configure.ac: Add support for aarch64-* on Macos (i.e., 64-bit
+ ARM) (bug#43369).
+
+2021-02-03 Bastien Guerry <bzg@gnu.org>
+
+ Update to Org 9.4.4
+
+2021-02-03 Stefan Kangas <stefan@marxist.se>
+
+ * lisp/so-long.el: Decrease use of passive voice.
+
+ Suggested by Richard Stallman <rms@gnu.org>.
+
+2021-02-03 Stefan Kangas <stefan@marxist.se>
+
+ * doc/misc/efaq.texi (New in Emacs 27): Add section.
+
+ * doc/misc/efaq.texi (Latest version of Emacs): Bump version.
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ * lisp/face-remap.el (face-remap-set-base): Doc fix. (Bug#45264)
+
+2021-02-03 Vasilij Schneidermann <mail@vasilij.de>
+
+ Correct argument order in comment
+
+ * etc/ETAGS.EBNF (position): Correct comment.
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Update files for the 27.1.90 pretest
+
+ * README:
+ * configure.ac:
+ * nt/README.W32:
+ * msdos/sed2v2.inp: Bump Emacs version to 27.1.90.
+ * lisp/ldefs-boot.el: Update from loaddefs.el
+
+2021-02-03 Eli Zaretskii <eliz@fencepost.gnu.org>
+
+ * README:
+ * configure.ac:
+ * nt/README.W32:
+ * msdos/sed2v2.inp: Bump Emacs version to 27.1.90.
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Minor fixes in authors.el and in tarball-making instructions
+
+ * admin/authors.el (authors): Make the error message more helpful.
+ (authors-ignored-files, authors-renamed-files-alist): Update.
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Improve documentation of 'query-replace'
+
+ * doc/emacs/search.texi (Query Replace): Add 'E' to the list of
+ characters one can type at 'query-replace' prompt. (Bug#45273)
+
+2021-02-03 Bastien Guerry <bzg@gnu.org>
+
+ Update to Org 9.4.3
+
+ Fix #45259
+
+2021-02-03 Alan Third <alan@idiocy.org>
+
+ Fix error with fn key in NS port (bug#44533)
+
+ * src/nsterm.m ([EmacsView keyDown:]): Move the correction for fn key
+ handling to before the modifiers are calculated.
+
+ (cherry picked from commit 7970610d48701a949ce443c94c71eac47d044197)
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Fix point location when completing in gdb-mi.el
+
+ * lisp/progmodes/gdb-mi.el (def-gdb-auto-update-handler): Don't
+ force window-start position, so that redisplay doesn't move point
+ when popping completion window below the GUD one. (Bug#45052)
+
+2021-02-03 Bastien Guerry <bzg@gnu.org>
+
+ Update to Org 9.4.2
+
+ Mostly fixing compiler warnings.
+
+2021-02-03 Bastien Guerry <bzg@gnu.org>
+
+ Update to Org 9.4.1
+
+2021-02-03 Alan Third <alan@idiocy.org>
+
+ Fix crash in ns_mouse_position (bug#44313)
+
+ * src/nsterm.m (ns_destroy_window): Close the window before freeing
+ the frame resources so we don't end up accessing the frame struct
+ after it's been freed.
+
+ (cherry picked from commit 18a7267c32a909bb26bd93d24543155aeb10e042)
+
+2021-02-03 Alan Third <alan@idiocy.org>
+
+ Fix crash when using XRender and restoring image from X (bug#44930)
+
+ * src/dispextern.h (struct image): Add original dimension elements.
+ * src/image.c (image_set_transform): Store the original dimensions.
+ (image_get_x_image): If we're using transforms use the original
+ dimensions with XGetImage.
+
+2021-02-03 Tassilo Horn <tsdh@gnu.org>
+
+ Bind k to image-kill-buffer in doc-view-mode-map.
+
+ * lisp/doc-view.el (doc-view-mode-map): Bind k to image-kill-buffer.
+ The binding k -> doc-view-kill-proc-and-buffer has been removed in
+ 2015 and the function been made an obsolete function alias to
+ image-kill-buffer (bug#45157).
+
+2021-02-03 Serge Tupchii <serge.tupchii@protonmail.com> (tiny change)
+
+ Fix crash (segfault) in etags on generating tags for Erlang files
+
+ * lib-src/etags.c: Set allocated and lastlen to zero, after
+ freeing last ptr in Erlang_functions to prevent dereferencing NULL
+ pointer (bug#45122).
+
+
+ (cherry picked from commit 2d8f0364fcd1d5dad2b82dd3a9af870b03854547)
+
+2021-02-03 Stefan Kangas <stefan@marxist.se>
+
+ Update publicsuffix.txt from upstream
+
+ * etc/publicsuffix.txt: Update from
+ https://publicsuffix.org/list/public_suffix_list.dat
+ dated 2020-11-30 21:57:25 UTC.
+
+2021-02-03 Juri Linkov <juri@linkov.net>
+
+ * lisp/vc/vc.el: Update args of backend API calls in the header comments
+
+ https://lists.gnu.org/archive/html/emacs-devel/2020-12/msg00283.html
+
+2021-02-03 Juri Linkov <juri@linkov.net>
+
+ Backport Handle read-char-from-minibuffer and y-or-n-p from
pre-command-hook
+
+ * lisp/subr.el (read-char-from-minibuffer-insert-char)
+ (read-char-from-minibuffer-insert-other, y-or-n-p-insert-y)
+ (y-or-n-p-insert-n, y-or-n-p-insert-other):
+ Check for 'minibufferp' before executing the body.
+ (read-char-from-minibuffer, y-or-n-p): Let-bind this-command
+ before calling read-from-minibuffer. (Bug#45029)
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Improve documentation of streams in batch mode
+
+ * doc/lispref/os.texi (Batch Mode):
+ * doc/lispref/streams.texi (Input Streams, Output Streams): Better
+ documentation of I/O streams in batch mode, with more
+ cross-references.
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Support ks_c_5601-1987 encoding
+
+ * lisp/language/korean.el (ks_c_5601-1987): Define as an alias for
+ 'korean-iso-8bit. (It is sometimes used in email messages.)
+
+2021-02-03 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
+
+ Fix Xaw widget text disappearing when built with cairo (bug#43418)
+
+ * lwlib/lwlib-utils.c (crxft_font_open_name): Use FcFontMatch to
+ get a pattern to pass to cairo_ft_font_face_create_for_pattern.
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Improve documentation of 'ps-print-color-p'
+
+ * doc/emacs/misc.texi (PostScript Variables): Improve and clarify
+ the description of 'ps-print-color-p'. (Bug#44962)
+
+2021-02-03 Dmitry Gutov <dgutov@yandex.ru>
+
+ Reset xref-show-xrefs-function temporarily
+
+ * lisp/dired-aux.el (dired-do-find-regexp-and-replace):
+ Make sure xref-show-xrefs-function has the necessary value (bug#44905).
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Don't show in 'view-lossage' responses to xterm feature queries
+
+ * lisp/term/xterm.el (xterm--read-event-for-query): Prevent
+ recording the characters read as the xterm response to a query,
+ so as not to show them in 'view-lossage'. (Bug#44908)
+
+2021-02-03 Michael Albinus <michael.albinus@gmx.de>
+
+ Adapt Tramp versions. Do not merge
+
+ * doc/misc/tramp.texi (Obtaining @value{tramp})
+ (Remote shell setup, Remote processes, Archive file names):
+ * doc/misc/trampver.texi:
+ * lisp/net/tramp.el:
+ * lisp/net/trampver.el (tramp-version)
+ (customize-package-emacs-version-alist): Adapt Tramp versions.
+
+2021-02-03 Akira Kyle <akira@akirakyle.com>
+
+ Return the correct suffix in eww-make-unique-file-name
+
+ * lisp/net/eww.el (eww-make-unique-file-name): Return the correct
+ suffix (bug#44936).
+
+2021-02-03 Karl Fogel <kfogel@red-bean.com>
+
+ Save bookmarks by using `write-file' (bug#12507)
+
+ Go back to using `write-file' to save bookmarks, instead of using
+ `write-region'. This means numbered backups of the bookmark file may
+ get made again, depending on the value of `bookmark-version-control'.
+
+ Thanks especially to Drew Adams and Eli Zaretskii for their
+ persistence in tracking down information relevant to this change.
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Fix filing messages when 'rmail-output-reset-deleted-flag' is non-nil
+
+ * lisp/mail/rmailout.el (rmail-output): Fix off-by-one error in
+ deciding when to advance to the next message under non-nil
+ 'rmail-output-reset-deleted-flag'. (Bug#44839)
+
+2021-02-03 Michael Albinus <michael.albinus@gmx.de>
+
+ Make file copying in tramp-gvfs more robust
+
+ * test/lisp/net/tramp-tests.el (tramp-test11-copy-file)
+ (tramp-test12-rename-file): Do not skip for tramp-gvfs.el.
+
+ * lisp/net/tramp-gvfs.el (tramp-gvfs-do-copy-or-rename-file):
+ Add sanity checks.
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Revert "Fix incorrect handling of module runtime and environment
pointers."
+
+ This reverts commit cdc632fbe6e149318147a98cccf1b7af191f2ce8.
+ Those changes are too significant and non-trivial to be
+ suitable for a release branch at this time.
+
+2021-02-03 Philipp Stephani <phst@google.com>
+
+ Fix incorrect handling of module runtime and environment pointers.
+
+ We used to store module runtime and environment pointers in the static
+ lists Vmodule_runtimes and Vmodule_environments. However, this is
+ incorrect because these objects have to be kept per-thread. With this
+ naive approach, interleaving module function calls in separate threads
+ leads to environments being removed in the wrong order, which in turn
+ can cause local module values to be incorrectly garbage-collected.
+
+ Instead, turn Vmodule_runtimes and Vmodule_environments into
+ hashtables keyed by the thread objects. The fix is relatively
+ localized and should therefore be safe enough for the release branch.
+
+ Module assertions now have to walk the pointer list for the current
+ thread, which is more correct since they now only find environments
+ for the current thread.
+
+ Also add a unit test that exemplifies the problem. It interleaves two
+ module calls in two threads so that the first call ends while the
+ second one is still active. Without this change, this test triggers
+ an assertion failure.
+
+ * src/emacs-module.c (Fmodule_load, initialize_environment)
+ (finalize_environment, finalize_runtime_unwind): Store runtime and
+ environment pointers in per-thread lists.
+ (syms_of_module): Initialize runtimes and environments hashtables.
+ (module_assert_runtime, module_assert_env, value_to_lisp): Consider
+ only objects for the current thread.
+ (module_gc_hash_table_size, module_hash_push, module_hash_pop): New
+ generic hashtable helper functions.
+ (module_objects, module_push_pointer, module_pop_pointer): New helper
+ functions to main thread-specific lists of runtime and environment
+ pointers.
+ (mark_modules): Mark all environments in all threads.
+
+ * test/data/emacs-module/mod-test.c (Fmod_test_funcall): New test
+ function.
+ (emacs_module_init): Bind it.
+
+ * test/src/emacs-module-tests.el (emacs-module-tests--variable): New
+ helper type to guard access to state in a thread-safe way.
+ (emacs-module-tests--wait-for-variable)
+ (emacs-module-tests--change-variable): New helper functions.
+ (emacs-module-tests/interleaved-threads): New unit test.
+
+2021-02-03 Alan Mackenzie <acm@muc.de>
+
+ CC Mode: Fix error in cache handling. This fixes bug #43481
+
+ * lisp/progmodes/cc-engine.el (c-full-pp-to-literal): Handle correctly
END
+ being before HERE by using parse-partial-sexp to get the end of the
literal
+ containing HERE.
+
+2021-02-03 Martin Rudalics <rudalics@gmx.at>
+
+ Revert extra focus redirection in do_switch_frame (Bug#24803)
+
+ * src/frame.c (do_switch_frame): Do not also redirect frame
+ focus when FRAME has its minibuffer window on the selected
+ frame which was intended to fix Bug#24500. It may cause
+ Bug#24803 and lead to a nasty state where no active cursor is
+ shown on any frame, see
+ https://lists.gnu.org/archive/html/emacs-devel/2020-11/msg01137.html.
+
+2021-02-03 Michael Albinus <michael.albinus@gmx.de>
+
+ Minor cleanup of tramp-tests.el on MS Windows
+
+ * test/lisp/net/tramp-tests.el (tramp-test29-start-file-process):
+ Do not test remote pty on MS Windows.
+
+2021-02-03 Basil L. Contovounesios <contovob@tcd.ie>
+
+ Fix handling of defcustom :local tag
+
+ For discussion, see the following emacs-devel thread:
+ https://lists.gnu.org/r/emacs-devel/2020-11/msg00734.html
+
+ * lisp/custom.el (custom-declare-variable): Delay call to
+ make-variable-buffer-local until after user option has been
+ initialized with a value. Otherwise the user option may be
+ initialized to nil.
+ * test/lisp/custom-tests.el (custom--test-local-option)
+ (custom--test-permanent-option): New :local user options.
+ (custom-test-local-option): New test for defcustom :local keyword.
+
+2021-02-03 Alan Mackenzie <acm@muc.de>
+
+ CC Mode. Fix an off by one error. Fixes bug #41809
+
+ * lisp/progmodes/cc-engine.el (c-full-pp-to-literal): Change > to >=
(twice).
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Fix display artifacts when 'display' properties cover newlines
+
+ * src/xdisp.c (pos_visible_p): Set glyph_row of scratch iterators
+ to NULL, to avoid producing glyphs while we figure out the layout.
+ (Bug#44826)
+
+2021-02-03 Stefan Kangas <stefankangas@gmail.com>
+
+ Sync latest SKK-JISYO.L
+
+ * leim/SKK-DIC/SKK-JISYO.L: Sync to current upstream version.
+
+ (cherry picked from commit 6a5f9700846551a7f3795e257356dbab865116f4)
+
+2021-02-03 Stefan Kangas <stefan@marxist.se>
+
+ Update publicsuffix.txt from upstream
+
+ * etc/publicsuffix.txt: Update from
+ https://publicsuffix.org/list/public_suffix_list.dat
+ dated 2020-10-09 08:23:34 UTC.
+
+ (cherry picked from commit 5b13afab0a903ead8363482529019d4fb80ec4b4)
+
+2021-02-03 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix Bug#44481
+
+ * lisp/net/tramp.el (tramp-system-name): New defconst.
+ (tramp-default-host, tramp-restricted-shell-hosts-alist)
+ (tramp-local-host-regexp):
+ * lisp/net/tramp-sh.el (tramp-maybe-open-connection): Use it.
(Bug#44481)
+
+2021-02-03 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Minor Edebug manual keystroke clarifications
+
+ * doc/lispref/edebug.texi (Edebug Misc): Also mention the `a'
+ binding to abort (bug#44697). Also fix `d' function reference, and
+ add `P' reference.
+
+ (cherry picked from commit b613f25f97abf756101eaa2af90689a19c0b3350)
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Make ignoring modifiers on IME input optional
+
+ By default, ignore modifier keys on IME input, but add
+ a variable to get back old behavior.
+ * src/w32fns.c (syms_of_w32fns): New variable
+ w32-ignore-modifiers-on-IME-input.
+ (w32_wnd_proc): Use it to ignore modifier keys when IME input is
+ used. (Bug#44641)
+
+ * etc/NEWS: Announce the change and the new variable.
+
+2021-02-03 Masahiro Nakamura <tsuucat@icloud.com>
+
+ Ignore modifiers when processing WM_IME_CHAR messages
+
+ * src/w32fns.c (w32_wnd_proc): Ignore modifiers when processing
+ WM_IME_CHAR messages.
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Improve documentation of 'font-spec'
+
+ * doc/lispref/display.texi (Low-Level Font):
+ * src/font.c (Ffont_spec): Document 'font-spec' keys that are
+ supported, but were undocumented.
+
+2021-02-03 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Further doc fixes for dotimes about RESULT
+
+ * lisp/subr.el (dotimes): Be even more explicit about RESULT
+ (bug#16206).
+
+ (cherry picked from commit 5b0d8d0f288fd505ca90bd30df709a5e7ab540d6)
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Reformat argument commentary in etags.c
+
+ * lib-src/etags.c (pfnote, consider_token, C_entries): Resurrect
+ original format of comments to function arguments.
+
+2021-02-03 Alan Mackenzie <acm@muc.de>
+
+ Make the invocation of combine-change-calls in comment-region valid
+
+ This fixes bug #44581. The problem was that whitespace outside of the
(BEG
+ END) region was being deleted, and this made the invocation of
+ combine-change-calls with (BEG END) invalid.
+
+ * lisp/newcomment.el (comment-region-default): Amend the second
argument to
+ combine-change-calls.
+
+2021-02-03 Alan Mackenzie <acm@muc.de>
+
+ * lisp/progmodes/cc-langs.el (c-<>-notable-chars-re): Fix wrong '-' in
regexp
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Update the various INSTALL files
+
+ * nt/INSTALL.W64:
+ * nt/INSTALL:
+ * INSTALL: Update the installation information, in particular the
+ fact that HarfBuzz is now preferred as the shaping library.
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Don't leave lock files after 'replace-buffer-contents'
+
+ * src/editfns.c (Freplace_buffer_contents): Unlock the buffer's
+ file if no changes have been made. (Bug#44303)
+
+ (cherry picked from commit a5867ddfbd721568005175bf6c725f7834b21ea4)
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Fix input method translation near read-only text
+
+ * lisp/international/quail.el (quail-input-method): Don't disable
+ input method when the character after point has the read-only
+ property. Suggested by Evgeny Zajcev <lg.zevlg@gmail.com>
+ (Bug#44466)
+
+ * doc/emacs/mule.texi (Input Methods): Document that input methods
+ are inhibited in read-only text.
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Fix display of truncated R2L lines on TTY frames
+
+ * src/xdisp.c (extend_face_to_end_of_line): Use a while-loop, not
+ a do-while loop, to avoid appending an extra glyph at the end of a
+ line that is one character shorter than the window-width. This is
+ needed to fix display of reversed glyph rows that are almost as
+ wide as the window, because append_space_for_newline already added
+ one space glyph.
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid crashes when a reversed glyph row starts with a composition
+
+ * src/dispnew.c (build_frame_matrix_from_leaf_window): Add an
+ assertion to prevent us from overwriting non-char glyphs with the
+ vertical border glyph.
+ * src/xdisp.c (extend_face_to_end_of_line): Account for one glyph
+ possibly inserted by append_space_for_newline. (Bug#44506)
+ Remove a kludgey correction for an off-by-one error in column
+ counting, which is no longer needed.
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Update information about refcards
+
+ * admin/release-process (refcards):
+ * admin/make-tarball.txt (refcards): Update information about
+ generating refcards and required TeX/LaTeX packages.
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid crashes in the daemon due to user interaction
+
+ * src/minibuf.c (read_minibuf): Avoid crashes in the daemon if the
+ init file invokes some kind of minibuffer interaction, by not
+ updating the selected frame if it's the initial frame.
+ (Bug#44583)
+
+2021-02-03 Michael Albinus <michael.albinus@gmx.de>
+
+ Some minor changes to Tramp, do not merge with master
+
+ * lisp/net/tramp.el (tramp-handle-directory-files)
+ (tramp-handle-directory-files-and-attributes):
+ * lisp/net/tramp-adb.el
+ (tramp-adb-handle-directory-files-and-attributes):
+ * lisp/net/tramp-rclone.el (tramp-rclone-handle-directory-files):
+ * lisp/net/tramp-sh.el (tramp-sh-handle-directory-files-and-attributes):
+ * lisp/net/tramp-smb.el (tramp-smb-handle-directory-files): Add _COUNT.
+ Make the functions forward compatible.
+
+ * lisp/net/tramp-gvfs.el (tramp-gvfs-enabled):
+ Increase `max-specpdl-size' temporarily.
+
+ * test/lisp/net/tramp-tests.el (tramp--test-share-p): New defun.
+ (tramp-test05-expand-file-name-relative): Use it.
+
+2021-02-03 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Add more doc-view requirements
+
+ * lisp/doc-view.el: Add more requirements.
+
+2021-02-03 Philipp Stephani <phst@google.com>
+
+ Fix undefined behavior when fetching glyphs from the display vector.
+
+ You can trigger this rather obscure bug by enabling selective display
+ if the second glyph in its display vector has an invalid face. For
+ example, evaluate
+
+ (set-display-table-slot standard-display-table
+ 'selective-display [?A (?B . invalid)])
+
+ and then enable selective display.
+
+ * src/xdisp.c (next_element_from_display_vector): Check whether next
+ glyph code is valid before accessing it.
+
+2021-02-03 Mattias Engdegård <mattiase@acm.org>
+
+ Fix pcase rx form snag with '?' and '??' (bug#44532)
+
+ This is a regression from Emacs 26.
+ Reported by Phillip Stephani.
+
+ * lisp/emacs-lisp/rx.el (rx--pcase-transform): Process ? and ??
correctly.
+ * test/lisp/emacs-lisp/rx-tests.el (rx-pcase): Add test case.
+
+ (cherry picked from commit 575b0681d926463960fc00d1e33decaa71d5c956)
+
+2021-02-03 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Update the doc-view header line
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid breaking Arabic shaping in 'window-text-pixel-size'
+
+ * src/xdisp.c (CHAR_COMPOSED_P): If the bidi_p flag is not set,
+ pass -1 to composition_reseat_it, so that the shaping engine will
+ figure out the directionality of the text. This is important,
+ e.g., when using move_it_* functions in some context that is not
+ redisplay, such as 'window-text-pixel-size'. (Bug#44521)
+
+2021-02-03 Lars Ingebrigtsen <larsi@gnus.org>
+
+ doc-view.el comment clarification
+
+ * lisp/doc-view.el: Make the commentary mention that it's not
+ limited to a narrow range of file formats (bug#44504).
+
+2021-02-03 Daniel Martín <mardani29@yahoo.es>
+
+ Update erc documentation about C-c C-b
+
+ * doc/misc/erc.texi (Keystroke Summary): C-c C-b runs
+ erc-switch-to-buffer, which is implemented in terms of
+ read-buffer (bug#44498).
+
+2021-02-03 Kazuhiro Ito <kzhr@d1.dion.ne.jp> (tiny change)
+
+ Fix 'uudecode-decode-region-internal' in multibyte buffers
+
+ * lisp/mail/uudecode.el (uudecode-decode-region-internal): Fix
+ inserting the decoded string into a multibyte buffer. Optimize by
+ working with characters, not strings. (Bug#44411)
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Fix 'send-string-to-terminal' writing very long strings
+
+ * src/dispnew.c (Fsend_string_to_terminal): Prevent partial writes
+ by blocking SIGIO while 'fwrite' runs. (Bug#44320)
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ * lisp/subr.el (read-char-from-minibuffer): Doc fix. (Bug#44451)
+
+2021-02-03 Earl Hyatt <ej32u@protonmail.com>
+
+ Fix documentation of 'windmove-swap-states-default-keybindings'
+
+ * doc/emacs/windows.texi (Window Convenience): Fix description of
+ 'windmove-swap-states-default-keybindings' and related index
+ entry. (Bug#44441)
+
+2021-02-03 Martin Rudalics <rudalics@gmx.at>
+
+ Split windows evenly when 'min-margins' parameter was set (Bug#44483)
+
+ * lisp/window.el (split-window): Make new window inherit any
+ 'min-margins' parameter from WINDOW so that horizontal splits
+ reliably produce windows of same width (Bug#44483).
+
+2021-02-03 Pip Cet <pipcet@gmail.com>
+
+ Handle Cairo errors in ftcrfont_open
+
+ * src/ftcrfont.c (ftcrfont_open): Handle Cairo errors (bug#41627).
+
+ (cherry picked from commit 954a4decfcc8e41084789516773b22d0adc11d91)
+
+2021-02-03 Stefan Kangas <stefan@marxist.se>
+
+ Backport: Fix exiting the finder-commentary buffer
+
+ Do not merge to master.
+
+ * lisp/finder.el (finder-exit): Fix exiting the finder-commentary
+ buffer. (Bug#44384)
+ (finder-buffer): New defconst.
+ (finder-list-keywords): Use above new defconst.
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ * src/w32fns.c (Fw32_register_hot_key): Doc fix. (Bug#44456)
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Prevent redisplay from moving point behind user's back
+
+ * src/bidi.c (bidi_at_paragraph_end, bidi_find_paragraph_start):
+ Bind inhibit-quit to a non-nil value around calls to
+ fast_looking_at, to prevent breaking out of redisplay_window,
+ which temporarily moves point in buffers shown in non-selected
+ windows. (Bug#44448)
+
+2021-02-03 Mauro Aranda <maurooaranda@gmail.com>
+
+ Document that the :match function for a widget takes an external value
+
+ * doc/misc/widget.texi (Basic Types): Document what an external value
+ is. Document that a :match function expects the value to be in the
+ external format. (Bug#8717)
+
+2021-02-03 Stephen Berman <Stephen.Berman@gmx.net>
+
+ Don't render XML declaration of an HTML document (bug#44348)
+
+ * lisp/net/eww.el (eww--preprocess-html): Prevent converting the
+ left angle bracket in the sequence "<?" to an HTML entity.
+
+2021-02-03 Yasuhiro KIMURA <yasu@utahime.org> (tiny change)
+
+ Recover the contents of the schemas.xml file
+
+ * etc/schema/schemas.xml: Recover the file, which was apparently
+ (mostly) removed by mistake by commit 165f738382 (bug#42851).
+
+2021-02-03 Stefan Kangas <stefan@marxist.se>
+
+ Improve indexing of check-declare
+
+ * doc/lispref/functions.texi (Declaring Functions): Improve indexing.
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ * doc/lispref/commands.texi (Key Sequence Input): Fix indexing.
+
+ (cherry picked from commit 41c4f337c8f798d4700dcd13b73ad4ccdb3257eb)
+
+2021-02-03 Jared Finder <jared@finder.org>
+
+ Updating docs with all special window prefix keys.
+
+ * doc/lispref/commands.texi (Key Sequence Input): Add documentation for
+ missing special window areas. Explicitly call out window or frame.
+
+ (cherry picked from commit a105db13e11fd15cc72804bf33672122d1c3f2e1)
+
+2021-02-03 Glenn Morris <rgm@gnu.org>
+
+ Improve reproducibility of generated -pkg.el files
+
+ * lisp/emacs-lisp/package.el (package-generate-description-file):
+ Don't include the full name of the source file in the header,
+ since that varies non-reproducibly according to the build directory.
+ https://bugs.debian.org/972861
+ Note that elpa.gnu.org's admin/archive-contents.el does this by hand
+ and already only includes the nondirectory part.
+
+2021-02-03 Noah Friedman <friedman@splode.com>
+
+ Make sure pixel sizes are zero when setting window size for ptys.
+
+ * sysdep.c (set_window_size): Initialize data to zero to avoid
+ passing any garbage from the stack to ioctl.
+
+2021-02-03 Ken Brown <kbrown@cornell.edu>
+
+ Fix failure of 'emacs --daemon' on Cygwin
+
+ * src/emacs.c (DAEMON_MUST_EXEC): Define unconditionally on
+ Cygwin, not just if HAVE_NTGUI is defined. This fixes the failure
+ of 'emacs --daemon' to start on the non-w32 Cygwin builds.
+ (Bug#44285)
+
+2021-02-03 Alan Mackenzie <acm@muc.de>
+
+ CC Mode: Only recognize foo (*bar) as a function pointer when followed
by (
+
+ * lisp/progmodes/cc-engine.el (c-forward-over-decl-or-cast-1): (after
CASE 2)
+ test variables got-suffix-after-parens and at-decl-end before invoking
+ c-fdoc-shift-type-backward.
+
+2021-02-03 Clemens Radermacher <clemens.radermacher@posteo.de>
+
+ Fix NEWS entry for fix of Bug#44080
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ * src/buffer.c (syms_of_buffer) <fill-column>: Improve doc string.
+
+2021-02-03 Clemens Radermacher <clemens.radermacher@posteo.de>
+
+ Don't skip empty lines when fitting mini frame to buffer (Bug#44080)
+
+ * lisp/window.el (fit-mini-frame-to-buffer,
+ window--resize-mini-frame, fit-frame-to-buffer,
+ fit-frame-to-buffer-1): By default, fit a mini frame without skipping
its
+ buffer's leading or trailing empty lines.
+ * src/frame.c (resize-mini-frames): Update doc-string.
+ * lisp/cus-start.el (resize-mini-frames): Update for customize.
+ * doc/lispref/minibuf.texi (resize-mini-frames): Update description.
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Improve documentation of display-fill-column-indicator
+
+ * lisp/display-fill-column-indicator.el
+ (display-fill-column-indicator-mode): Mention the globalized
+ version in the doc string.
+
+ * doc/emacs/display.texi (Displaying Boundaries): Improve and
+ clarify the documentation of display-fill-column-indicator.
+ Suggest using the minor mode as the primary means for turning the
+ feature on.
+
+ * src/xdisp.c (syms_of_xdisp) <display-fill-column-indicator>
+ <display-fill-column-indicator-character>: Doc fix. (Bug#44226)
+
+2021-02-03 Michael Albinus <michael.albinus@gmx.de>
+
+ * INSTALL: Mention efaq.texi for installation of intlfonts.
+
+2021-02-03 Paul Eggert <eggert@cs.ucla.edu> (tiny change)
+ Qiantan Hong <qhong@mit.edu>
+
+ Use WebKit sandboxing
+
+ * src/xwidget.c (Fmake_xwidget): Enable sandboxing if WebKit 2.26
+ or later. Do this early, as required for sandboxing (Bug#43071).
+
+2021-02-03 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix tramp-sh-handle-make-process; don't merge with master
+
+ * lisp/net/tramp-sh.el (tramp-sh-handle-make-process): Accept nil
+ COMMAND. (Bug#44151)
+
+ * test/lisp/net/tramp-tests.el (tramp-test29-start-file-process):
+ Extend test.
+
+2021-02-03 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix an error in tramp-sh-handle-make-process. Dont' merge with master
+
+ * lisp/net/tramp-sh.el (tramp-sh-handle-make-process): Don't use heredoc
+ script whent the argument contains a string.
+
+2021-02-03 Stefan Kangas <stefan@marxist.se>
+
+ Recommend lexical-binding in Coding Conventions
+
+ * doc/lispref/tips.texi (Coding Conventions, Library Headers):
+ Recommend using lexical-binding.
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid rare crashes while producing line numbers
+
+ * src/xdisp.c (maybe_produce_line_number): Prevent freeing of
+ realized faces for as long as we are using lnum_face_id and
+ current_lnum_face_id for producing glyphs. (Bug#44111)
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Improve documentation of 'Info-hide-note-references' in info.texi
+
+ * doc/misc/info.texi (Help-Xref): Improve the wording.
+ (Emacs Info Variables): Update the documentation of
+ 'Info-hide-note-references'. (Bug#44043)
+
+2021-02-03 Stefan Kangas <stefan@marxist.se>
+
+ * admin/release-process: Add note to update files from upstream.
+
+ (cherry picked from commit 86dd9d12aa5a273da2efd4ce8c6e35ae343f1494)
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ * lisp/info.el (Info-hide-note-references): Doc fix. (Bug#44043)
+
+2021-02-03 Alan Mackenzie <acm@muc.de>
+
+ Make lisp/progmodes/js.el dependent on CC Mode in the Makefile.
+
+ This will prevent version mismatches between compile time and runtime
+ versions. This fixes bug #43037.
+
+ * lisp/Makefile.in: Make js.el dependent on cc-{defs,engine,mode}.elc.
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Yet another fix for 'set-minibuffer-message'
+
+ * lisp/minibuffer.el (set-minibuffer-message): Handle the case of
+ separate minibuffer-only frame. Suggested by Gregory Heytings
+ <ghe@sdf.org>.
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Fix posn-at-x-y in builds --without-x
+
+ * src/keyboard.c (make_lispy_position): Don't exclude the
+ window_or_frame = frame case from TTY-only builds. Reported by
+ Jared Finder <jared@finder.org>.
+
+ * doc/lispref/commands.texi (Click Events): Document the format of
+ POSITION in click events on the frame's internal border.
+
+2021-02-03 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Clarify the seq-reduce documentation
+
+ * doc/lispref/sequences.texi (Sequence Functions): Ditto.
+
+ * lisp/emacs-lisp/seq.el (seq-reduce): Clarify the order of the
+ arguments (bug#43995).
+
+2021-02-03 Michael Albinus <michael.albinus@gmx.de>
+
+ Make tramp-completion-reread-directory-timeout obsolete (Bug#43932)
+
+ * doc/misc/tramp.texi (File name completion, Frequently Asked
Questions):
+ Remove `tramp-completion-reread-directory-timeout'. (Bug#43932)
+
+ * etc/NEWS: Mention tramp-completion-reread-directory-timeout as
obsolete.
+
+ * lisp/net/tramp.el (tramp-completion-reread-directory-timeout):
+ Make it obsolete.
+
+2021-02-03 Gregory Heytings <ghe@sdf.org> (tiny change)
+
+ Fix 'message' when there's active minibuffer on another frame
+
+ * lisp/minibuffer.el (set-minibuffer-message): Don't reuse the
+ active minibuffer for displaying messages unless the active
+ minibuffer is on the same frame as the selected window.
+
+2021-02-03 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/emacs-lisp/easy-mmode.el (define-minor-mode): Doc tweak
+
+ Try and clarify the meaning of `init-value`.
+
+ (cherry picked from commit 46c0f28c0e4e212687e90ec0ecb239d994105a19)
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ A better fix for bug#43886
+
+ * src/xfaces.c (load_color2, Fcolor_distance): Revert last change.
+ * src/term.c (clear_tty_hooks): Don't clear defined_color_hook.
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid crashes when a theme is loaded with one frame suspended
+
+ * src/xfaces.c (load_color2, Fcolor_distance): Don't try to call
+ the frame's defined_color_hook if the frame is suspended.
+ (Bug#43886)
+
+2021-02-03 Pankaj Jangid <pankaj.jangid@gmail.com> (tiny change)
+
+ Removed an incorrectly placed extra word in the semantic docs
+
+ * doc/misc/semantic.texi (Parser code): Copy edit (bug#43861).
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Fix current-line hscrolling when overlays change
+
+ * src/xdisp.c (redisplay_internal): Disable "optimization 1" when
+ auto-hscrolling current line and we're redisplaying the selected
+ window. (Bug#43835)
+
+2021-02-03 Michael Albinus <michael.albinus@gmx.de>
+
+ Extend tests for shell-command-dont-erase-buffer
+
+ * test/lisp/simple-tests.el
+ (simple-tests-shell-command-dont-erase-buffer): Extend test.
+
+ * test/lisp/net/tramp-tests.el
+ (tramp-test32-shell-command-dont-erase-buffer): Adapt test. Tag
+ it :unstable.
+
+2021-02-03 Hong Xu <hong@hong.me>
+
+ Clarify what ``chrooted environment means'' for TRAMP
+
+ * doc/misc/tramp.texi (Frequently Asked Questions): Clarify what
+ ``chrooted environment means'' for TRAMP (bug#43839).
+
+2021-02-03 Daniel Martín <mardani29@yahoo.es>
+
+ Add missing full stop in MS-DOS processes documentation
+
+ * doc/emacs/msdos-xtra.texi (MS-DOS Processes): Minor copy edig
+ (bug#43820).
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Fix merging of region face for non-ASCII characters
+
+ * src/xdisp.c (extend_face_to_end_of_line): Restore the correct
+ original face used by the iterator on this line, not the ASCII
+ face. (Bug#43363)
+
+2021-02-03 Alan Third <alan@idiocy.org>
+ Daniel Martín <mardani29@yahoo.es>
+
+ Make drag and drop on NS open all URLs (bug#43470)
+
+ * lisp/term/ns-win.el (ns-drag-n-drop): Merge generic and copy
+ actions.
+
+2021-02-03 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Fix electric-buffer-list buffer selection
+
+ * lisp/ebuff-menu.el (electric-buffer-list): Ensure that point is
+ restored, which isn't always the case if
+ global-display-line-numbers-mode (bug#43755). This enables
+ selecting buffers again.
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ * doc/misc/flymake.texi (Using Flymake): Fix a typo. (Bug#43758)
+
+2021-02-03 Robert Pluim <rpluim@gmail.com>
+
+ Don't error if no GPG signing key configured
+
+ * lisp/gnus/mml-sec.el (mml-secure-epg-sign): Partially revert
+ "Make mml-secure-epg-sign bug out if we can't find an identity".
+ It causes signing to fail for people who have not set up
+ mml-secure-{smime,openpgp}-sign-with-sender, which is a regression
+ from Emacs-26 (Bug#40118). In such a situation gpg will use its
+ default key.
+
+ Do not merge to master. On master Emacs will query the user.
+
+2021-02-03 Michael R. Mauger <michael@mauger.com>
+
+ 2020-03-29 Michael R. Mauger <michael@mauger.com>
+
+ * lisp/progmodes/sql.el (sql-add-product): Re-correct argument
+ spec. Previous change was due to my mistake; I have
+ resolved back to the prior behavior (Bug#39960).
+ * test/lisp/progmodes/sql-tests.el (sql-test-add-product): Added
+ test to insure I don't make the same mistake again.
+
+2021-02-03 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Make aliases introduced in previous patch obsolete
+
+ * lisp/emacs-lisp/debug.el (debugger-toggle-locals):
+ (debug-help-follow): Make reinstated aliases obsolete.
+
+2021-02-03 Gemini Lasswell <gazally@runbox.com>
+
+ Restore some public debugging functions removed in Emacs 27
+
+ * lisp/emacs-lisp/backtrace.el (backtrace--to-string): New function.
+ (backtrace-to-string): Use it. Fix whitespace (bug#40728).
+ * lisp/emacs-lisp/debug.el (debugger-insert-backtrace): New function.
+ Mark it as obsolete.
+ (debugger-toggle-locals, debug-help-follow): New aliases.
+
+2021-02-03 Michael Albinus <michael.albinus@gmx.de>
+
+ Clarification in Tramp manual
+
+ * doc/misc/tramp.texi: Harmonize "Git" spelling.
+ (Frequently Asked Questions): Describe Emacs version mismatch.
+
+2021-02-03 Michael Albinus <michael.albinus@gmx.de>
+
+ Check Emacs version used for Tramp compilation
+
+ * lisp/net/tramp-compat.el (tramp-compat-emacs-compiled-version):
+ New defconst. Raise a warning, when it is not equal to the Emacs
+ version.
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Don't signal an error when saving files on WdebDAV volumes
+
+ * src/w32.c (acl_get_file): If get_file_security raises the
+ ERROR_ACCESS_DENIED error, treat that like unsupported ACLs.
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ * lisp/hi-lock.el (hi-lock-find-patterns): Autoload it. (Bug#43670)
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Minor copyedits in the Emacs user manual
+
+ * doc/emacs/emacs.texi (Top): Remove "real-time" from the Emacs
+ description; add "advanced", to be consistent with what we say in
+ the Introduction section. (Bug#43633)
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Followup to a recent change in menu-bar.el
+
+ * lisp/fileloop.el (fileloop--operate-function): Mention in a
+ comment that menu-bar.el relies on the default value.
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Enable "Continue Tags Search" menu item only when it can be used
+
+ * lisp/menu-bar.el (menu-bar-search-menu) <tags-continue>: Enable
+ only when there was a previous tags search. (Bug#43569)
+ (menu-bar-replace-menu) <tags-repl-continue>: Enable only when
+ there was a previous tags-replace.
+
+2021-02-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix soap-client URL
+
+ * lisp/net/soap-client.el (soap-create-envelope):
+ Fix URL that I broke in 2019-09-23T06:53:30Z!eggert@cs.ucla.edu.
+ Problem reported by Thomas Fitzsimmons.
+
+2021-02-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix out-of-source ‘make check’ emacs-module-tests
+
+ Problem reported by Koki Fukuda in:
+ https://lists.gnu.org/r/emacs-devel/2020-07/msg00169.html
+ * test/Makefile.in (MODULE_CFLAGS):
+ Include from the same directories included from in ../src.
+ * test/src/emacs-module-tests.el (module/describe-function-1):
+ Strip path to source directory.
+
+ (cherry picked from commit c86f3fe0d023cdd25edbbce91c5b32654f2b734e)
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Fix support for Zip64 zip files
+
+ * lisp/arc-mode.el (archive-zip-summarize): Fix detection of Zip64
+ central directory. Support 64-bit file size field used by Zip64.
+ (Bug#43597)
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ * lisp/hi-lock.el (hi-lock-auto-select-face): Doc fix. (Bug#43600)
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid infinite recursion with 'relative' line numbers display
+
+ * src/xdisp.c (display_count_lines_visually): Bind
+ 'display-line-numbers' to 'relative' around 'start_display' as
+ well, since that can invoke 'move_it_to' internally, thus
+ causing infinite recursion. (Bug#43589)
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Minor improvement in the ELisp manual's Introduction
+
+ * doc/lispref/intro.texi (Printing Notation): Clarify what
+ "execute code" means in this context. (Bug#43463)
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Mention in PROBLEMS the problems with fonts and Uniscribe
+
+ * etc/PROBLEMS: Mention font-related problems with Uniscribe on
+ MS-Windows. (Bug#39340)
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Minor copyedits in 'line-height' documentation
+
+ * doc/lispref/display.texi (Line Height): Describe the possible
+ values of the 'line-height' property in a more consistent format.
+
+2021-02-03 Gregor Zattler <telegraph@gmx.net>
+
+ * doc/misc/eww.texi: Document the `w' key's double function
+
+ * doc/misc/eww.texi (Basics): Describe what the `w' command does
+ in eww (bug#43517).
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Fix a rare segfault in syntax.c
+
+ * src/syntax.c (Fforward_comment): Prevent the loop for COUNT < 0
+ from going outside the valid range of character/byte positions.
+ (Bug#43499)
+
+ * doc/lispref/syntax.texi (Syntax Class Table): Mention the
+ "comment-fence" and "string-fence" as alternative names of 2
+ syntax classes.
+
+2021-02-03 Alan Mackenzie <acm@muc.de>
+
+ Add doc to syntax-propertize-function saying it must do a 100% job
+
+ and cannot be combined with other ways of applying syntax-table text
+ properties.
+
+ * lisp/emacs-lisp/syntax.el (syntax-propertize-function): Amend doc
string.
+
+ * doc/lispref/syntax.texi (Syntax Properties): Amend the description of
the
+ variable.
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Minor copyedits of doc of 'with-silent-modifications'
+
+ * doc/lispref/text.texi (Changing Properties):
+ * doc/lispref/buffers.texi (Buffer Modification): Improve
+ documentation and indexing of 'with-silent-modifications'.
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Improve documentation of 'max-mini-window-height'
+
+ * src/xdisp.c (syms_of_xdisp):
+ * doc/lispref/minibuf.texi (Minibuffer Windows): More accurate
+ wording in the documentation of 'max-mini-window-height', to
+ clarify the meaning of an integer value.
+
+2021-02-03 Daniel Martín <mardani29@yahoo.es>
+
+ Use modern constant names for the NS pasteboard
+
+ Use the same pasteboard constant names defined in
+ ns_drag_types. (Bug#43470).
+
+ * src/nsterm.m: Rename NSURLPboardType to NSPasteboardTypeURL,
+ NSStringPboardType to NSPasteboardTypeString, and
+ NSTabularTextPboardType to NSPasteboardTypeTabularText
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Fix doc string of 'toggle-menu-bar-mode-from-frame'
+
+ * lisp/menu-bar.el (toggle-menu-bar-mode-from-frame): Improve the
+ wording of the doc string. (Bug#43383)
+
+2021-02-03 Glenn Morris <rgm@gnu.org>
+
+ Make vc-bzr tests work with brz 3.1 (bug#43314)
+
+ * test/lisp/vc/vc-bzr-tests.el (vc-bzr-test-bug9726)
+ (vc-bzr-test-bug9781, vc-bzr-test-faulty-bzr-autoloads):
+ Make them work with brz 3.1.
+
+2021-02-03 Lars Ingebrigtsen <larsi@gnus.org>
+
+ diff-no-select doc string clarification
+
+ * lisp/vc/diff.el (diff-no-select): Update doc string from the trunk,
+ don't merge.
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Fix compilation on TERMINFO platforms with GCC 10
+
+ * src/terminfo.c [TERMINFO]: Don't redefine UP, BC, and CP, as
+ that could cause linking errors due to multiple definitions.
+ (Bug#43195)
+
+2021-02-03 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Fix the font-lock-debug-fontify NEWS entry
+
+ * etc/NEWS: Fix the name of `font-lock-debug-fontify' (bug#43319).
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid crashes when trying to load bad GIF files
+
+ * src/image.c (gif_load): Handle the case when GifErrorString
+ returns NULL. (Bug#43281)
+
+2021-02-03 Alan Mackenzie <acm@muc.de>
+
+ C++ Mode: handle comma separated brace initializers.
+
+ This includes both indentation and fontification.
+
+ * lisp/progmodes/cc-engine.el (c-do-declarators): Handle brace
initializers
+ without = correctly.
+ (c-looking-at-or-maybe-in-bracelist): Use c-do-declarators with a simple
+ inline function to check that after-type-id-pos points to the start of a
+ declarator.
+
+ * lisp/progmodes/cc-langs.el (c-recognize-bare-brace-inits): New lang
+ const/variable.
+
+2021-02-03 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/display-fill-column-indicator.el: Fix bug#41145
+
+ (global-display-fill-column-indicator-mode): Specify the implicit
+ defustom's group explicitly.
+
+ * lisp/cus-dep.el (custom-make-dependencies): Also look at
+ define(-globalized)-minor-mode since it can also define custom vars.
+
+2021-02-03 Michael Albinus <michael.albinus@gmx.de>
+
+ Backport recent change in tramp-tests.el from master, don't merge
+
+ * test/lisp/net/tramp-tests.el (tramp-test05-expand-file-name):
+ No need to expect different results in Emacs 28 and later.
+
+2021-02-03 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix bug in dbus.el; do not merge with master
+
+ * lisp/net/dbus.el (dbus-register-property)
+ (dbus-property-handler): Handle properties of the same interface
+ at different object paths properly. (Bug#43146)
+
+2021-02-03 Stefan Kangas <stefankangas@gmail.com>
+
+ Fix help message with help-window-select
+
+ * lisp/help.el (help-print-return-message):
+ (help-window-display-message): Recommend 'scroll-up-command' instead
+ of 'scroll-up' when 'help-window-select' is non-nil. (Bug#43122)
+
+2021-02-03 Eric Abrahamsen <eric@ericabrahamsen.net>
+
+ Remove obsolete "Wide Characters" section of Gnus manual
+
+ * doc/misc/gnus.texi: This hasn't been valid since 2016.
+
+2021-02-03 Stefan Kangas <stefankangas@gmail.com>
+
+ Fix typo in Introduction to Emacs Lisp
+
+ * doc/lispintro/emacs-lisp-intro.texi (type-of-animal in detail):
+ Remove extraneous parenthesis.
+
+2021-02-03 Stefan Kangas <stefankangas@gmail.com>
+
+ Update Elisp Manual reference to which-function-mode
+
+ * doc/lispref/modes.texi (Mode Line Top, Mode Line Variables)
+ Don't refer to obsolete alias for 'which-function-mode'.
+ (Bug#13716)
+
+2021-02-03 Michael Albinus <michael.albinus@gmx.de>
+
+ Some precisions to bug handling
+
+ * admin/admin.el (reminder-for-release-blocking-bugs): Add date to
subject.
+
+ * admin/notes/bug-triage:
+ * admin/notes/bugtracker: Minor precisions.
+
+2021-02-03 Alan Mackenzie <acm@muc.de>
+
+ CC Mode: Fix processing for when c-multiline-string-start-char is a
character
+
+ * lisp/progmodes/cc-mode.el (c-pps-to-string-delim)
+ (c-multiline-string-check-final-quote): Replace c-clear-char-property by
+ c-clear-syn-tab.
+ (c-multiline-string-check-final-quote): Replace c-put-char-property by
+ c-put-syn-tab.
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Fix description of %-constructs in 'mode-line-format'
+
+ * doc/lispref/modes.texi (%-Constructs): Document %@ and remove
+ %M, which is no longer supported. (Bug#43092)
+
+2021-02-03 Michael Albinus <michael.albinus@gmx.de>
+
+ Adapt tramp-tests.el, don't merge with master
+
+ * test/lisp/net/tramp-tests.el (tramp-test05-expand-file-name)
+ (tramp-test05-expand-file-name-relative): Adapt tests.
+ (tramp--test-emacs28-p): New defun.
+
+2021-02-03 Michael Albinus <michael.albinus@gmx.de>
+
+ Adapt reminder-for-release-blocking-bugs
+
+ * admin/admin.el (reminder-for-release-blocking-bugs):
+ Require `debbugs-gnu' also in `interactive' form.
+
+ * admin/release-process: Rename RELEASE-CRITICAL to RELEASE-BLOCKING.
+ Adapt Emacs version. Describe `reminder-for-release-blocking-bugs'.
+
+2021-02-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix replace-region-contents performance bug
+
+ Backport from master.
+ * src/editfns.c (rbc_quitcounter): Remove; the quitcounter
+ is now part of the context.
+ (EXTRA_CONTEXT_FIELDS): Remove unused member early_abort_tests.
+ Add jmp, quitcounter.
+ (Freplace_buffer_contents): Use setjmp/longjmp to recover from
+ a compareseq that runs too long. Omit unnecessary rarely_quit
+ call.
+ (buffer_chars_equal): Occasionally check for early abort and
+ longjmp out if so (Bug#43016).
+
+2021-02-03 Michael Albinus <michael.albinus@gmx.de>
+
+ * admin/admin.el (reminder-for-release-blocking-bugs): New command.
+
+2021-02-03 Michael Albinus <michael.albinus@gmx.de>
+
+ Sync with Tramp 2.4.5-pre
+
+ * doc/misc/tramp.texi: Adapt Tramp and Emacs version numbers.
+ (Remote processes): Describe `process-file-return-signal-string'
+ and $INSIDE_EMACS.
+ (Frequently Asked Questions): Mention Emacs 28.
+ Describe `tramp-smb-options'.
+
+ * doc/misc/trampver.texi: Change version to "2.4.5-pre".
+
+ * lisp/net/tramp-adb.el (process-file-return-signal-string): Declare.
+ (tramp-adb-handle-write-region): Flush the cache after the file
+ has been written.
+ (tramp-adb-handle-set-file-modes, tramp-adb-handle-set-file-times):
+ Add optional _FLAG.
+ (tramp-adb-handle-copy-file, tramp-adb-handle-rename-file)
+ (tramp-adb-handle-process-file): Use `tramp-file-local-name'.
+ (tramp-adb-get-signal-strings): New defun.
+ (tramp-adb-handle-process-file): Use it.
+ (tramp-adb-handle-make-process): Implement `stderr'. Use
+ `insert-file-contents-literally'.
+ (tramp-adb-send-command-and-check): Add optional argument
+ EXIT-STATUS.
+ (tramp-adb-handle-process-file): Use it.
+
+ * lisp/net/tramp-archive.el (tramp-archive-file-name-handler):
+ Increase `max-specpdl-size' temporarily.
+
+ * lisp/net/tramp-cache.el (top):
+ Use `insert-file-contents-literally'.
+
+ * lisp/net/tramp-cmds.el (tramp-rename-files):
+ Use `tramp-file-local-name'.
+
+ * lisp/net/tramp-gvfs.el (tramp-gvfs-enabled): Prevent crash for
+ older Emacsen.
+ (top): Adapt `tramp-gvfs-unload-hook'.
+ (tramp-gvfs-handle-file-system-info): Fix error.
+ (tramp-gvfs-handle-set-file-modes, tramp-gvfs-handle-set-file-times):
+ Add optional _FLAG.
+
+ * lisp/net/tramp-rclone.el (tramp-rclone-flush-directory-cache):
+ Fix a problem with older Emacsen.
+
+ * lisp/net/tramp-sh.el (process-file-return-signal-string): Declare.
+ (tramp-sh-extra-args): Add "-noediting" as bash arg.
+ (tramp-hexdump-encode, tramp-hexdump-awk-encode)
+ (tramp-od-encode, tramp-od-awk-encode): New defconst.
+ (tramp-awk-encode, tramp-awk-decode): Adapt.
+ (tramp-awk-coding-test): Remove.
+ (tramp-remote-coding-commands): Add hexdump/awk encoding. (Bug#35639)
+ (tramp-find-inline-encoding): Adapt handling of awk, hexdump and od.
+ (tramp-get-remote-busybox, tramp-get-remote-awk)
+ (tramp-get-remote-hexdump, tramp-get-remote-od): New defuns.
+ (tramp-sh-handle-make-symbolic-link):
+ (tramp-do-copy-or-rename-file-directly)
+ (tramp-sh-handle-process-file, tramp-set-remote-path)
+ (tramp-find-inline-encoding, tramp-get-remote-touch):
+ Use `tramp-file-local-name'.
+ (tramp-do-file-attributes-with-stat): Simplify shell command.
+ Suppress errors (interpret as nil).
+ (tramp-sh-handle-set-file-modes, tramp-sh-handle-set-file-times):
+ Add optional _FLAG.
+ (tramp-sh-handle-make-process): Do not visit with
+ `insert-file-contents'. Delete tmp file only if exists. Support
+ `stderr' as file name. Delete temporary stderr file. Flush
+ connection properties in time.
+ (tramp-sh-get-signal-strings): New defun.
+ (tramp-sh-handle-process-file): Use it.
+ (tramp-sh-handle-write-region): Copy to temp file only if FILENAME
+ exists. (Bug#40156)
+ (tramp-set-remote-path): Send the command in several chunks if it
+ is too large. (Bug#42538)
+ (tramp-open-connection-setup-interactive-shell): Move up "set +o
+ vi +o emacs" command. (Bug#39399)
+ (tramp-send-command-and-read): Suppress `signal-hook-function'
+ when reading expression.
+ (tramp-send-command-and-check): Add optional argument EXIT-STATUS.
+ (tramp-sh-handle-process-file): Use it. (Bug#41099)
+
+ * lisp/net/tramp-smb.el (tramp-smb-conf): Fix docstring.
+ (tramp-smb-options): New defcustom.
+ (tramp-smb-handle-copy-directory, tramp-smb-handle-file-acl)
+ (tramp-smb-handle-set-file-acl, tramp-smb-maybe-open-connection):
+ Use it.
+ (tramp-smb-errors): Add "NT_STATUS_INVALID_PARAMETER".
+ (tramp-smb-handle-make-symbolic-link)
+ (tramp-smb-handle-process-file): Use `tramp-file-local-name'.
+
+ * lisp/net/tramp-sudoedit.el (tramp-sudoedit-do-copy-or-rename-file):
+ (tramp-sudoedit-handle-set-file-uid-gid):
+ Use `tramp-unquote-file-local-name'.
+ (tramp-sudoedit-handle-make-symbolic-link):
+ Use `tramp-file-local-name'.
+ (tramp-sudoedit-handle-file-system-info): Fix a scoping error.
+ (tramp-sudoedit-handle-set-file-modes):
+ (tramp-sudoedit-handle-set-file-times): Add optional _FLAG.
+
+ * lisp/net/tramp.el: Bump version to 2.4.5-pre.
+ (tramp-file-local-name, tramp-unquote-file-local-name): New defuns.
+ (tramp-set-connection-local-variables-for-buffer)
+ (tramp-equal-remote, tramp-handle-make-auto-save-file-name):
+ Use `tramp-tramp-file-p'.
+ (tramp-parse-file): Use `insert-file-contents-literally'.
+ (tramp-handle-file-modes, tramp-handle-file-times):
+ Add optional _FLAG.
+ (tramp-handle-shell-command): Fix `window-start' in output buffer.
+ (Bug#39171)
+ Handle `shell-command-dont-erase-buffer'. (Bug#39067)
+ Reorganize error-buffer handling. Set `default-directory'.
+ (Bug#39253)
+ (tramp-handle-shell-command, tramp-handle-start-file-process):
+ Implement asynchronous `error-buffer'.
+ (tramp-action-process-alive): Read pending output.
+ (tramp-read-passwd): Use `tramp-compat-temporary-file-directory'.
+ (Bug#39389, Bug#39489)
+ (tramp-interrupt-process): Improve command.
+
+ * lisp/net/trampver.el: Change version to "2.4.5-pre".
+ (tramp-repository-branch, tramp-repository-version):
+ Bind `debug-on-error' to nil.
+
+ * test/lisp/net/tramp-tests.el (tramp-get-remote-gid)
+ (process-file-return-signal-string)
+ (shell-command-dont-erase-buffer): Declare.
+ (tramp-test10-write-region, tramp-test28-process-file)
+ (tramp-test29-start-file-process, tramp-test30-make-process)
+ (tramp-test31-interrupt-process, tramp-test32-shell-command):
+ Extend test.
+ (tramp-test10-write-region, tramp-test21-file-links): Use function
+ symbols.
+ (tramp-test18-file-attributes): Check `file-ownership-preserved-p'
+ only if possible.
+ (tramp--test-async-shell-command): New defun.
+ (tramp--test-shell-command-to-string-asynchronously): Use it.
+ (tramp-test32-shell-command-dont-erase-buffer): New test.
+
+2021-02-03 Phillip Lord <phillip.lord@russet.org.uk>
+
+ Fix error in GMP test
+
+ * etc/w32-feature.el: Update to use system-configuration-features for
+ GMP test.
+
+2021-02-03 Phillip Lord <phillip.lord@russet.org.uk>
+
+ Add Feature testing for Windows binaries
+
+ * etc/w32-feature.el: New file
+
+2021-02-03 Stefan Kangas <stefankangas@gmail.com>
+
+ Revert "; * etc/NEWS: Remove temporary note on documentation.
(Bug#42917)"
+
+ This reverts commit 121be3e1181e609734fc4cc9d2d54cf7eec18ab2.
+
+2021-02-03 Glenn Morris <rgm@gnu.org>
+
+ * admin/admin.el (set-version): Trap yet another NEWS error.
+
+2021-02-03 Mattias Engdegård <mattiase@acm.org>
+
+ Fix cond jump table compilation (bug#42919)
+
+ This bug affected compilation of
+
+ (cond ((member '(some list) variable) ...) ...)
+
+ While equal is symmetric, member is not; in the latter case the
+ arguments must be a variable and a constant list, in that order.
+
+ Reported by Ikumi Keita.
+
+ * lisp/emacs-lisp/bytecomp.el (byte-compile--cond-switch-prefix):
+ Don't treat equality and member predicates in the same way; only
+ the former are symmetric in their arguments.
+ * test/lisp/emacs-lisp/bytecomp-tests.el
+ (byte-opt-testsuite-arith-data): Add test cases.
+
+2021-02-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ Let Emacs start even if curdir is inaccessible
+
+ * lisp/startup.el (normal-top-level): Also delete PWD if
+ file-attributes fails for either $PWD or default-directory,
+ instead of failing out of the top level.
+ This fixes a regression from Emacs 26 (Bug#42903).
+
+2021-02-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ * etc/NEWS: Mention GnuPG 2.0 through 2.1.5 issue (Bug#42845).
+
+2021-02-03 Robert Pluim <rpluim@gmail.com>
+
+ Fix bug with ~/Emacs file not being read at init
+
+ * src/xrdb.c (get_user_app): Put "/" between homedir
+ and %L or %N (Bug#42827).
+
+2021-02-03 Tino Calancha <tino.calancha@gmail.com>
+
+ Prevent from frozen frame after `C-z' in Lucid builds
+
+ Some WMs (e.g. mutter in Gnome Shell) don't unmap iconized windows,
+ thus we won't get a MapNotify when deconifying them.
+ Check if we are deconifying a window elsewhere (Bug#42655).
+
+ - src/xterm.c (handle_one_xevent):
+ Check for window deconify when receiving a FocusIn signal.
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Document the 'flex' completion style
+
+ * doc/emacs/mini.texi (Completion Styles): Document the 'flex'
+ completion style. (Bug#42763)
+
+2021-02-03 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Note that Emacs needs systemd support if systemd is used to stop/start
+
+ * etc/NEWS: Note that Emacs needs to be built with systemd support
+ systemd is used to stop/start Emacs (bug#42242). Change suggested by
+ Bhavin Gandhi <bhavin7392@gmail.com>
+
+2021-02-03 Mattias Engdegård <mattiase@acm.org>
+
+ Regexps cannot infloop; fix manual
+
+ * doc/lispref/searching.texi (Regexp Special): Edit erroneous
+ statements about infinite looping in regexps.
+
+ (cherry picked from commit 63268253d21c57d991cba3f3b083d74f154a26fe)
+
+2021-02-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix startup working dir bug on NeXTSTEP
+
+ * src/emacs.c (main) [NS_IMPL_COCOA]: Update emacs_wd
+ after a NS GUI chdirs successfully (Bug#42836).
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Improve documentation of function argument lists
+
+ * doc/lispref/functions.texi (Lambda Components)
+ (Defining Functions): Add a cross-reference to "Argument List".
+ (Argument List): Improve the section name. (Bug#42750)
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Improve documentation of special events
+
+ * doc/lispref/commands.texi (Misc Events): Explain how to bind
+ special events to commands.
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Fix face merging at EOL when inherited face specifies :extend
+
+ * src/xfaces.c (merge_face_ref): Handle correctly faces that
+ inherit from another, and in addition specify :extend.
+ (Bug#42552)
+
+ (cherry picked from commit 39c90f8dfabe158ad7ac9243aa9b9dedb9409e19)
+
+2021-02-03 Eli Zaretskii <eliz@gnu.org>
+
+ Fix face extension past EOL in overlay strings
+
+ * src/xdisp.c (face_at_pos): Pass ATTR_FILTER to
+ face_for_overlay_string.
+ * src/xfaces.c (face_for_overlay_string): Accept an additional
+ argument ATTR_INDEX and pass it to merge_face_ref for merging the
+ face at POS. This ensures a face from buffer text will not be
+ merged unless it specifies the :extend attribute. (Bug#42552)
+ * src/dispextern.h (face_for_overlay_string): Adjust prototype.
+
+ (cherry picked from commit 35564bea4d73bc266743216599d01d644aed6fd8)
+
+2021-02-03 Phil Sainty <psainty@orcon.net.nz>
+
+ Fix comint-redirect-results-list regexp usage (Bug#42662)
+
+ * lisp/comint.el (comint-redirect-results-list-from-process):
+ Don't treat the literal string argument COMMAND as a regexp.
+
+2021-02-03 Nicolas Petton <nicolas@petton.fr>
+
+ * etc/HISTORY: Update the Emacs 27.1 release date.
+
2020-08-03 Phil Sainty <psainty@orcon.net.nz>
lisp/so-long.el: Improve support for major mode hooks
@@ -142478,6 +144446,7 @@
This file records repository revisions from
commit 9d56a21e6a696ad19ac65c4b405aeca44785884a (exclusive) to
+2021-02-03d9244f7cbef9f91e697ad5fc0ce49ec97 (inclusive).
commit 1ca4da054be7eb340c511d817f3ec89c8b819db7 (inclusive).
See ChangeLog.2 for earlier changes.
diff --git a/admin/admin.el b/admin/admin.el
index fa96b7e..d032c1c 100644
--- a/admin/admin.el
+++ b/admin/admin.el
@@ -1,4 +1,4 @@
-;;; admin.el --- utilities for Emacs administration
+;;; admin.el --- utilities for Emacs administration -*- lexical-binding: t;
-*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
@@ -254,7 +254,7 @@ ROOT should be the root of an Emacs source tree."
(search-forward "INFO_COMMON = ")
(let ((start (point)))
(end-of-line)
- (while (and (looking-back "\\\\")
+ (while (and (looking-back "\\\\" (- (point) 2))
(zerop (forward-line 1)))
(end-of-line))
(append (split-string (replace-regexp-in-string
@@ -930,13 +930,19 @@ changes (in a non-trivial way). This function does not
check for that."
(interactive
(list (progn
(require 'debbugs-gnu)
+ (defvar debbugs-gnu-emacs-blocking-reports)
+ (defvar debbugs-gnu-emacs-current-release)
(completing-read
"Emacs release: "
(mapcar #'identity debbugs-gnu-emacs-blocking-reports)
nil t debbugs-gnu-emacs-current-release))))
(require 'debbugs-gnu)
+ (declare-function debbugs-get-status "debbugs" (&rest bug-numbers))
+ (declare-function debbugs-get-attribute "debbugs" (bug-or-message attribute))
(require 'reporter)
+ (declare-function mail-position-on-field "sendmail" (field &optional soft))
+ (declare-function mail-text "sendmail" ())
(when-let ((id (alist-get version debbugs-gnu-emacs-blocking-reports
nil nil #'string-equal))
@@ -958,11 +964,11 @@ changes (in a non-trivial way). This function does not
check for that."
(insert "
The following bugs are regarded as release-blocking for Emacs " version ".
People are encouraged to work on them with priority.\n\n")
- (dolist (_ blockedby-status)
- (unless (equal (debbugs-get-attribute _ 'pending) "done")
+ (dolist (i blockedby-status)
+ (unless (equal (debbugs-get-attribute i 'pending) "done")
(insert (format "bug#%d %s\n"
- (debbugs-get-attribute _ 'id)
- (debbugs-get-attribute _ 'subject)))))
+ (debbugs-get-attribute i 'id)
+ (debbugs-get-attribute i 'subject)))))
(insert "
If you use the debbugs package from GNU ELPA, you can apply the
following form to see all bugs which block a given release:
diff --git a/admin/authors.el b/admin/authors.el
index 0180ffe..6c81c78 100644
--- a/admin/authors.el
+++ b/admin/authors.el
@@ -1,4 +1,4 @@
-;;; authors.el --- utility for maintaining Emacs's AUTHORS file
+;;; authors.el --- utility for maintaining Emacs's AUTHORS file -*-
lexical-binding: t; -*-
;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
@@ -1254,7 +1254,7 @@ Additionally, for these logs we apply the `lax' elements
of
(defun authors-disambiguate-file-name (fullname)
"Convert FULLNAME to an unambiguous relative-name."
(let ((relname (file-name-nondirectory fullname))
- dir parent)
+ dir)
(if (and (member relname authors-ambiguous-files)
;; Try to identify the top-level directory.
;; FIXME should really use ROOT from M-x authors.
@@ -1266,8 +1266,8 @@ Additionally, for these logs we apply the `lax' elements
of
;; I think it looks weird to see eg "lisp/simple.el".
;; But for eg Makefile.in, we do want to say "lisp/Makefile.in".
(if (and (string-equal "lisp"
- (setq parent (file-name-nondirectory
- (directory-file-name dir))))
+ (file-name-nondirectory
+ (directory-file-name dir)))
;; TODO better to simply have hard-coded list?
;; Only really Makefile.in where this applies.
(not (file-exists-p
@@ -1569,9 +1569,9 @@ and changed by AUTHOR."
(cons (cons file (cdr (assq :changed actions)))
changed-list))))))
(if wrote-list
- (setq wrote-list (sort wrote-list 'string-lessp)))
+ (setq wrote-list (sort wrote-list #'string-lessp)))
(if cowrote-list
- (setq cowrote-list (sort cowrote-list 'string-lessp)))
+ (setq cowrote-list (sort cowrote-list #'string-lessp)))
(when changed-list
(setq changed-list (sort changed-list
(lambda (a b)
@@ -1579,7 +1579,7 @@ and changed by AUTHOR."
(string-lessp (car a) (car b))
(> (cdr a) (cdr b))))))
(setq nchanged (length changed-list))
- (setq changed-list (mapcar 'car changed-list)))
+ (setq changed-list (mapcar #'car changed-list)))
(if (> (- nchanged authors-many-files) 2)
(setcdr (nthcdr authors-many-files changed-list)
(list (format "and %d other files" (- nchanged
authors-many-files)))))
@@ -1688,12 +1688,12 @@ list of their contributions.\n")
(when authors-invalid-file-names
(insert "Unrecognized file entries found:\n\n")
(mapc (lambda (f) (if (not (string-match "^[A-Za-z]+$" f)) (insert
f "\n")))
- (sort authors-invalid-file-names 'string-lessp)))
+ (sort authors-invalid-file-names #'string-lessp)))
(when authors-ignored-names
(insert "\n\nThese authors were ignored:\n\n"
(mapconcat
- 'identity
- (sort authors-ignored-names 'string-lessp) "\n")))
+ #'identity
+ (sort authors-ignored-names #'string-lessp) "\n")))
(goto-char (point-min))
(compilation-mode)
(message "Errors were found. See buffer %s" (buffer-name))))
diff --git a/admin/cus-test.el b/admin/cus-test.el
index aca7b68..995586f 100644
--- a/admin/cus-test.el
+++ b/admin/cus-test.el
@@ -1,4 +1,4 @@
-;;; cus-test.el --- tests for custom types and load problems
+;;; cus-test.el --- tests for custom types and load problems -*-
lexical-binding: t; -*-
;; Copyright (C) 1998, 2000, 2002-2021 Free Software Foundation, Inc.
@@ -112,6 +112,7 @@ Names should be as they appear in loaddefs.el.")
;; This avoids a hang of `cus-test-apropos' in 21.2.
;; (add-to-list 'cus-test-skip-list 'sh-alias-alist)
+(defvar viper-mode)
(or noninteractive
;; Never Viperize.
(setq viper-mode nil))
@@ -196,7 +197,7 @@ The detected problematic options are stored in
`cus-test-errors'."
mismatch)
(when (default-boundp symbol)
(push (funcall get symbol) values)
- (push (eval (car (get symbol 'standard-value))) values))
+ (push (eval (car (get symbol 'standard-value)) t) values))
(if (boundp symbol)
(push (symbol-value symbol) values))
;; That does not work.
@@ -222,7 +223,7 @@ The detected problematic options are stored in
`cus-test-errors'."
(get symbol 'standard-value))))
(and (consp c-value)
(boundp symbol)
- (not (equal (eval (car c-value)) (symbol-value symbol)))
+ (not (equal (eval (car c-value) t) (symbol-value symbol)))
(add-to-list 'cus-test-vars-with-changed-state symbol)))
(if mismatch
@@ -239,7 +240,7 @@ The detected problematic options are stored in
`cus-test-errors'."
(defun cus-test-cus-load-groups (&optional cus-load)
"Return a list of current custom groups.
If CUS-LOAD is non-nil, include groups from cus-load.el."
- (append (mapcar 'cdr custom-current-group-alist)
+ (append (mapcar #'cdr custom-current-group-alist)
(if cus-load
(with-temp-buffer
(insert-file-contents (locate-library "cus-load.el"))
@@ -290,7 +291,7 @@ currently defined groups."
"Call `custom-load-symbol' on all atoms."
(interactive)
(if noninteractive (let (noninteractive) (require 'dunnet)))
- (mapatoms 'custom-load-symbol)
+ (mapatoms #'custom-load-symbol)
(run-hooks 'cus-test-after-load-libs-hook))
(defmacro cus-test-load-1 (&rest body)
@@ -346,7 +347,7 @@ Optional argument ALL non-nil means list all (non-obsolete)
Lisp files."
(prog1
;; Hack to remove leading "./".
(mapcar (lambda (e) (substring e 2))
- (apply 'process-lines find-program
+ (apply #'process-lines find-program
"." "-name" "obsolete" "-prune" "-o"
"-name" "[^.]*.el" ; ignore .dir-locals.el
(if all
@@ -542,7 +543,7 @@ in the Emacs source directory."
(message "No options not loaded by custom-load-symbol found")
(message "The following options were not loaded by custom-load-symbol:")
(cus-test-message
- (sort cus-test-vars-not-cus-loaded 'string<)))
+ (sort cus-test-vars-not-cus-loaded #'string<)))
(dolist (o groups-loaded)
(setq groups-not-loaded (delete o groups-not-loaded)))
@@ -550,7 +551,7 @@ in the Emacs source directory."
(if (not groups-not-loaded)
(message "No groups not in cus-load.el found")
(message "The following groups are not in cus-load.el:")
- (cus-test-message (sort groups-not-loaded 'string<)))))
+ (cus-test-message (sort groups-not-loaded #'string<)))))
(provide 'cus-test)
diff --git a/admin/find-gc.el b/admin/find-gc.el
index c70a051..1cce54e 100644
--- a/admin/find-gc.el
+++ b/admin/find-gc.el
@@ -1,4 +1,4 @@
-;;; find-gc.el --- detect functions that call the garbage collector
+;;; find-gc.el --- detect functions that call the garbage collector -*-
lexical-binding: t; -*-
;; Copyright (C) 1992, 2001-2021 Free Software Foundation, Inc.
@@ -42,14 +42,14 @@ Each entry has the form (FUNCTION .
FUNCTIONS-THAT-CALL-IT).")
Each entry has the form (FUNCTION . FUNCTIONS-IT-CALLS).")
-;;; Functions on this list are safe, even if they appear to be able
-;;; to call the target.
+;; Functions on this list are safe, even if they appear to be able
+;; to call the target.
(defvar find-gc-noreturn-list '(Fsignal Fthrow wrong_type_argument))
-;;; This was originally generated directory-files, but there were
-;;; too many files there that were not actually compiled. The
-;;; list below was created for a HP-UX 7.0 system.
+;; This was originally generated directory-files, but there were
+;; too many files there that were not actually compiled. The
+;; list below was created for a HP-UX 7.0 system.
(defvar find-gc-source-files
'("dispnew.c" "scroll.c" "xdisp.c" "window.c"
@@ -76,11 +76,11 @@ Also store it in `find-gc-unsafe-list'."
(lambda (x y)
(string-lessp (car x) (car y))))))
-;;; This does a depth-first search to find all functions that can
-;;; ultimately call the function "target". The result is an a-list
-;;; in find-gc-unsafe-list; the cars are the unsafe functions, and the cdrs
-;;; are (one of) the unsafe functions that these functions directly
-;;; call.
+;; This does a depth-first search to find all functions that can
+;; ultimately call the function "target". The result is an a-list
+;; in find-gc-unsafe-list; the cars are the unsafe functions, and the cdrs
+;; are (one of) the unsafe functions that these functions directly
+;; call.
(defun find-unsafe-funcs (target)
(setq find-gc-unsafe-list (list (list target)))
@@ -134,7 +134,8 @@ Also store it in `find-gc-unsafe-list'."
(setcdr entry (cons name (cdr entry)))))))))))))
(defun trace-use-tree ()
- (setq find-gc-subrs-callers (mapcar 'list (mapcar 'car
find-gc-subrs-called)))
+ (setq find-gc-subrs-callers
+ (mapcar #'list (mapcar #'car find-gc-subrs-called)))
(let ((ptr find-gc-subrs-called)
p2 found)
(while ptr
diff --git a/admin/gitmerge.el b/admin/gitmerge.el
index 1364bdc..851212c 100644
--- a/admin/gitmerge.el
+++ b/admin/gitmerge.el
@@ -1,4 +1,4 @@
-;;; gitmerge.el --- help merge one Emacs branch into another
+;;; gitmerge.el --- help merge one Emacs branch into another -*-
lexical-binding: t; -*-
;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
@@ -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
@@ -390,7 +392,7 @@ is nil, only the single commit BEG is merged."
(if end "s were " " was ")
"skipped:\n\n")
""))
- (apply 'call-process "git" nil t nil "log" "--oneline"
+ (apply #'call-process "git" nil t nil "log" "--oneline"
(if end (list (concat beg "~.." end))
`("-1" ,beg)))
(insert "\n")
@@ -422,7 +424,7 @@ MISSING must be a list of SHA1 strings."
(unless end
(setq end beg))
(unless (zerop
- (apply 'call-process "git" nil t nil "merge" "--no-ff"
+ (apply #'call-process "git" nil t nil "merge" "--no-ff"
(append (when skip '("-s" "ours"))
`("-m" ,commitmessage ,end))))
(gitmerge-write-missing missing from)
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 ede382c..6b3bc43 100644
--- a/doc/emacs/files.texi
+++ b/doc/emacs/files.texi
@@ -927,9 +927,9 @@ 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{M-x
-revert-buffer}. Since reverting unintentionally could lose a lot of
-work, Emacs asks for confirmation first.
+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.
The @code{revert-buffer} command tries to position point in such a
way that, if the file was edited only slightly, you will be at
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/search.texi b/doc/emacs/search.texi
index 637867b..f3c42bc 100644
--- a/doc/emacs/search.texi
+++ b/doc/emacs/search.texi
@@ -2027,6 +2027,13 @@ highlighting:
@item lazy-highlight-initial-delay
@vindex lazy-highlight-initial-delay
Time in seconds to wait before highlighting visible matches.
+Applies only if the search string is less than
+@code{lazy-highlight-no-delay-length} characters long.
+
+@item lazy-highlight-no-delay-length
+@vindex lazy-highlight-no-delay-length
+For search strings at least as long as the value of this variable,
+lazy highlighting of matches starts immediately.
@item lazy-highlight-interval
@vindex lazy-highlight-interval
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/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/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/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/minibuf.texi b/doc/lispref/minibuf.texi
index 0ce17ed..b60775d 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -1799,15 +1799,19 @@ pairs. The following properties are supported:
The value should be a function to add annotations in the completions
buffer. This function must accept one argument, a completion, and
should either return @code{nil} or a string to be displayed next to
-the completion.
+the completion. Unless this function puts own face on the annotation
+suffix string, the @code{completions-annotations} face is added by
+default to that string.
@item :affixation-function
The value should be a function to add prefixes and suffixes to
completions. This function must accept one argument, a list of
completions, and should return such a list of completions where
each element contains a list of three elements: a completion,
-a prefix string, and a suffix string. This function takes priority
-over @code{:annotation-function}.
+a prefix string, and a suffix string. When this function
+returns a list of two elements, it is interpreted as a list
+of a completion and a suffix string like in @code{:annotation-function}.
+This function takes priority over @code{:annotation-function}.
@item :exit-function
The value should be a function to run after performing completion.
@@ -1907,6 +1911,9 @@ The value should be a function for @dfn{annotating}
completions. The
function should take one argument, @var{string}, which is a possible
completion. It should return a string, which is displayed after the
completion @var{string} in the @file{*Completions*} buffer.
+Unless this function puts own face on the annotation suffix string,
+the @code{completions-annotations} face is added by default to
+that string.
@item affixation-function
The value should be a function for adding prefixes and suffixes to
@@ -1915,8 +1922,10 @@ completions. The function should take one argument,
return such a list of @var{completions} where each element contains a list
of three elements: a completion, a prefix which is displayed before
the completion string in the @file{*Completions*} buffer, and
-a suffix displayed after the completion string. This function
-takes priority over @code{annotation-function}.
+a suffix displayed after the completion string. When this function
+returns a list of two elements, it is interpreted as a list of
+a completion and a suffix string like in @code{annotation-function}.
+This function takes priority over @code{annotation-function}.
@item display-sort-function
The value should be a function for sorting completions. The function
@@ -2384,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 abc1254..ce7727b 100644
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -1826,6 +1826,11 @@ starts, for example by providing a @code{:require}
keyword.
Use @code{:group @var{group}} in @var{keyword-args} to specify the
custom group for the mode variable of the global minor mode.
+By default, the buffer-local minor mode variable that says whether the
+mode is switched on or off is the same as the name of the mode itself.
+Use @code{:variable @var{variable}} if that's not the case--some minor
+modes use a different variable to store this state information.
+
Generally speaking, when you define a globalized minor mode, you should
also define a non-globalized version, so that people can use (or
disable) it in individual buffers. This also allows them to disable a
diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index 6dedaa3..8346165 100644
--- a/doc/lispref/processes.texi
+++ b/doc/lispref/processes.texi
@@ -2017,7 +2017,8 @@ describing the type of event.
default sentinel function, which inserts a message in the process's
buffer with the process name and the string describing the event.
- The string describing the event looks like one of the following:
+ The string describing the event looks like one of the following (but
+this is not an exhaustive list of event strings):
@itemize @bullet
@item
@@ -2048,6 +2049,9 @@ core.
@code{"open\n"}.
@item
+@code{"run\n"}.
+
+@item
@code{"connection broken by remote peer\n"}.
@end itemize
diff --git a/doc/lispref/syntax.texi b/doc/lispref/syntax.texi
index d27053a..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}. However, it should not call
-@code{syntax-ppss-flush-cache}; so, it is not allowed to call
-@code{syntax-ppss} on some position and later modify the buffer at an
-earlier position.
+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/misc/dbus.texi b/doc/misc/dbus.texi
index e8e99db..6463687 100644
--- a/doc/misc/dbus.texi
+++ b/doc/misc/dbus.texi
@@ -2151,6 +2151,11 @@ And this form restricts the monitoring on D-Bus errors:
@end lisp
@end defun
+@deffn Command dbus-monitor &optional bus
+This command invokes @code{dbus-register-monitor} interactively, and
+switches to the monitor buffer.
+@end deffn
+
@node Index
@unnumbered Index
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index efe8395..c2e9fe6 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -2792,9 +2792,10 @@ visiting a file will show its encrypted contents.
However, it is
highly discouraged to mix encrypted and not encrypted files in the
same directory.
-@deffn Command tramp-crypt-add-directory name
-If a remote directory shall not include encrypted files anymore, it
-must be indicated by this command.
+@deffn Command tramp-crypt-remove-directory name
+This command should be used to indicate that files in @code{name}
+should no longer be encrypted. Existing encrypted files and
+subdirectories will remain encrypted.
@end deffn
diff --git a/etc/MACHINES b/etc/MACHINES
index 9799577..d8d0b86 100644
--- a/etc/MACHINES
+++ b/etc/MACHINES
@@ -66,8 +66,9 @@ the list at the end of this file.
** macOS
- Mac OS X 10.6 or newer. PowerPC is not supported.
- For installation instructions see the file nextstep/INSTALL.
+ Mac OS X 10.6 or newer. Both AArch64 (Arm) and x86-64 systems are
+ supported, but PowerPC is not supported. For installation
+ instructions see the file nextstep/INSTALL.
** Microsoft Windows
diff --git a/etc/NEWS b/etc/NEWS
index 9408642..f9d3ea1 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -85,7 +85,11 @@ useful on systems such as FreeBSD which ships only with
"etc/termcap".
* Changes in Emacs 28.1
-** The new NonGNU ELPA archive is enabled by default alongside GNU ELPA
+** 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'.
@@ -221,10 +225,25 @@ It is not enabled by default.
+++
** Modifiers now go outside angle brackets in pretty-printed key bindings.
-For example, <return> with Control and Meta modifiers is now shown as
-C-M-<return> instead of <C-M-return>. Either variant can be used as
-input; functions such as 'kbd' and 'read-kbd-macro' accept both styles
-as equivalent (they have done so for a long time).
+For example, 'RET' with Control and Meta modifiers is now shown as
+'C-M-<return>' instead of '<C-M-return>'. Either variant can be used
+as input; functions such as 'kbd' and 'read-kbd-macro' accept both
+styles as equivalent (they have done so for a long time).
+
++++
+** New user option 'lazy-highlight-no-delay-length'.
+Lazy highlighting of matches in Isearch now starts immediately if the
+search string is at least this long. 'lazy-highlight-initial-delay'
+still applies for shorter search strings, which avoids flicker in the
+search buffer due to too many matches being highlighted.
+
++++
+** 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
@@ -247,7 +266,7 @@ forms, but this command has now been changed to work more
like
When 'M-y' is typed not after a yank command, it activates the minibuffer
where you can browse previous kills using the minibuffer history or
completion. In Isearch, you can bind 'C-s M-y' to the command
-`isearch-yank-pop' that uses the minibuffer with completion on
+'isearch-yank-pop' that uses the minibuffer with completion on
previous kills to read a string and append it to the search string.
---
@@ -331,9 +350,10 @@ 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.
** pcase
+
+++
-*** The `pred` pattern can now take the form (pred (not FUN)).
-This is like (pred (lambda (x) (not (FUN x)))) but results
+*** The 'pred' pattern can now take the form '(pred (not FUN))'.
+This is like '(pred (lambda (x) (not (FUN x))))' but results
in better code.
+++
@@ -393,7 +413,7 @@ disabled entirely.
** Windows
+++
-*** New 'display-buffer' function 'display-buffer-use-least-recent-window'
+*** New 'display-buffer' function 'display-buffer-use-least-recent-window'.
This is like 'display-buffer-use-some-window', but won't reuse the
current window, and when called repeatedly will try not to reuse a
previously selected window.
@@ -454,9 +474,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
+++
@@ -505,7 +530,7 @@ time zones will use a form like "+0100" instead of "CET".
** Dired
---
-*** Behaviour change on 'dired-clean-confirm-killing-deleted-buffers'.
+*** Behavior change on 'dired-clean-confirm-killing-deleted-buffers'.
Previously, if 'dired-clean-up-buffers-too' was non-nil, and
'dired-clean-confirm-killing-deleted-buffers' was nil, the buffers
wouldn't be killed. This combination will now kill the buffers.
@@ -577,6 +602,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
@@ -726,7 +758,7 @@ not.
---
*** Respect 'message-forward-ignored-headers' more.
-Previously, this variable would not be consulted if
+Previously, this user option would not be consulted if
'message-forward-show-mml' was nil and forwarding as MIME.
+++
@@ -841,13 +873,21 @@ 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.
---
*** New input method 'cham'.
-There's also a Cham greeting in 'etc/HELLO'.
+There's also a Cham greeting in "etc/HELLO".
** Ispell
@@ -885,7 +925,7 @@ 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'.
@@ -949,6 +989,9 @@ command line under point (and any following output).
** Eshell
---
+*** 'eshell-hist-ignoredups' can now also be used to mimic "erasedups" in bash.
+
+---
*** Environment variable 'INSIDE_EMACS' is now copied to subprocesses.
Its value equals the result of evaluating '(format "%s,eshell" emacs-version)'.
@@ -1386,13 +1429,13 @@ have been renamed to have "proper" public names and
documented
'xref-show-definitions-buffer-at-bottom').
*** New command 'xref-quit-and-pop-marker-stack' and a binding for it
-in Xref buffers ('M-,'). This combination is easy to press
+in "*xref*" buffers ('M-,'). This combination is easy to press
semi-accidentally if the user wants to go back in the middle of
choosing the exact definition to go to, and this should do TRT.
---
-*** New value 'project-relative' for 'xref-file-name-display'
-If chosen, file names in *xref* buffers will be displayed relative
+*** New value 'project-relative' for 'xref-file-name-display'.
+If chosen, file names in "*xref*" buffers will be displayed relative
to the 'project-root' of the current project, when available.
** json.el
@@ -1415,9 +1458,9 @@ https://www.w3.org/TR/xml/#charsets). Now it rejects
such strings.
---
*** erc-services.el now supports NickServ passwords from auth-source.
-The 'erc-use-auth-source-for-nickserv-password' variable enables querying
-auth-source for NickServ passwords. To enable this, add the following
-to your init file:
+The 'erc-use-auth-source-for-nickserv-password' user option enables
+querying auth-source for NickServ passwords. To enable this, add the
+following to your init file:
(setq erc-prompt-for-nickserv-password nil
erc-use-auth-source-for-nickserv-password t)
@@ -1582,18 +1625,25 @@ that makes it a valid button.
'string-clean-whitespace', 'string-fill', 'string-limit',
'string-lines', 'string-pad' and 'string-chop-newline'.
-*** New macro `named-let` that provides Scheme's "named let" looping construct
+*** New macro 'named-let' that provides Scheme's "named let" looping construct.
** thingatpt
+++
*** New variable 'thing-at-point-provider-alist'.
-This allows mode-specific alterations to how `thing-at-point' works.
+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
+++
-*** New command `C-x C-k Q' to force redisplay in keyboard macros.
+*** New command 'C-x C-k Q' to force redisplay in keyboard macros.
---
*** New user option 'remember-diary-regexp'.
@@ -1607,8 +1657,8 @@ This function returns some statistics about the line
lengths in a buffer.
+++
*** New variable 'inhibit-interaction' to make user prompts signal an error.
If this is bound to something non-nil, functions like
-`read-from-minibuffer', `read-char' (and related) will signal an
-`inhibited-interaction' error.
+'read-from-minibuffer', 'read-char' (and related) will signal an
+'inhibited-interaction' error.
---
*** 'process-attributes' now works under OpenBSD, too.
@@ -1879,14 +1929,12 @@ Otherwise, it will use 'xwidget-webkit-last-session'.
+++
*** New user options to customize Flymake's mode-line.
-
-The new customization variable 'flymake-mode-line-format' is a mix of
-strings and symbols like 'flymake-mode-line-title' ,
-'flymake-mode-line-exception' and 'flymake-mode-line-counters'. The
-new customization variable 'flymake-mode-line-counter-format' is a mix
-of strings and symbols like 'flymake-mode-line-error-counter',
-'flymake-mode-line-warning-counter' and
-'flymake-mode-line-note-counter'.
+The new user option 'flymake-mode-line-format' is a mix of strings and
+symbols like 'flymake-mode-line-title', 'flymake-mode-line-exception'
+and 'flymake-mode-line-counters'. The new user option
+'flymake-mode-line-counter-format' is a mix of strings and symbols
+like 'flymake-mode-line-error-counter',
+'flymake-mode-line-warning-counter' and 'flymake-mode-line-note-counter'.
** Flyspell mode
@@ -1945,7 +1993,7 @@ type symbols. Both functions propagate D-Bus errors.
messages, contain the error name of that message now.
+++
-*** D-Bus messages can be monitored with new function 'dbus-register-monitor'.
+*** D-Bus messages can be monitored with the new command 'dbus-monitor'.
+++
*** D-Bus events have changed their internal structure.
@@ -2004,6 +2052,18 @@ first).
* Incompatible Editing Changes in Emacs 28.1
+** The 'M-o' ('facemanu-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.
+
+** 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,
+say something like:
+
+ (modify-syntax-entry ?\\ "\\" f90-mode-syntax-table)
+
** In 'nroff-mode', 'center-line' is now bound to 'M-o M-s'.
The original key binding was 'M-s', which interfered with I-search,
since the latter uses 'M-s' as a prefix key of the search prefix map.
@@ -2014,6 +2074,11 @@ 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'.
+
** 'set-process-buffer' now updates the process mark.
The mark will be set to point to the end of the new buffer.
@@ -2067,6 +2132,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.
@@ -2102,8 +2172,9 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el.
'completion-base-size', 'completion-common-substring',
'crm-minibuffer-complete', 'crm-minibuffer-complete-and-exit',
'crm-minibuffer-completion-help', 'custom-mode', 'custom-mode-hook',
-'define-mode-overload-implementation', 'detect-coding-with-priority',
-'dirtrack-debug', 'dirtrack-debug-toggle', 'dynamic-completion-table',
+'define-key-rebound-commands', 'define-mode-overload-implementation',
+'detect-coding-with-priority', 'dirtrack-debug',
+'dirtrack-debug-toggle', 'dynamic-completion-table',
'easy-menu-precalculate-equivalent-keybindings',
'epa-display-verify-result', 'epg-passphrase-callback-function',
'eshell-report-bug', 'eval-next-after-load', 'exchange-dot-and-mark',
@@ -2158,17 +2229,24 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el.
'vcursor-toggle-vcursor-map', 'w32-focus-frame', 'w32-select-font',
'wisent-lex-make-token-table'.
-** The 'when' argument of `make-obsolete` and related functions is mandatory.
-The use of those functions without a 'when' argument was marked
-obsolete back in Emacs-23.1. The affected functions are:
-make-obsolete, define-obsolete-function-alias, make-obsolete-variable,
-define-obsolete-variable-alias.
+** The WHEN argument of 'make-obsolete' and related functions is mandatory.
+The use of those functions without a WHEN argument was marked obsolete
+back in Emacs 23.1. The affected functions are: 'make-obsolete',
+'define-obsolete-function-alias', 'make-obsolete-variable',
+'define-obsolete-variable-alias'.
-** The variable 'keyboard-type' is obsolete and not dynamically scoped any more
+** The variable 'keyboard-type' is obsolete and not dynamically scoped any
more.
* Lisp Changes in Emacs 28.1
+** The 'values' variable is now obsolete.
+
+---
+** New variable 'indent-line-ignored-functions'.
+This allows modes to cycle through a set of indentation functions
+appropriate for those modes.
+
** New function 'garbage-collect-maybe' to trigger GC early.
---
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/leim/SKK-DIC/SKK-JISYO.L b/leim/SKK-DIC/SKK-JISYO.L
index 9098868..78d6e08 100644
--- a/leim/SKK-DIC/SKK-JISYO.L
+++ b/leim/SKK-DIC/SKK-JISYO.L
@@ -38109,8 +38109,8 @@ sari /
sarin /�����/
sarod /������/����å�/
sars /severe acute respiratory syndrome/�žɵ����Ƶ۴�ɸ���/
-sars-cov /severe acute respiratory syndrome coronavirus/SARS����ʥ����륹
-sars-cov-2 /severe acute respiratory syndrome coronavirus 2/2019��������ʥ����륹
+sars-cov /severe acute respiratory syndrome coronavirus/SARS����ʥ����륹/
+sars-cov-2 /severe acute respiratory syndrome coronavirus 2/2019��������ʥ����륹/
sartre /����ȥ�/
saruman /����ޥ�/
sasa /����/
diff --git a/lisp/abbrev.el b/lisp/abbrev.el
index 65f7118..54783db 100644
--- a/lisp/abbrev.el
+++ b/lisp/abbrev.el
@@ -516,9 +516,8 @@ It is nil if the abbrev has already been unexpanded.")
(defvar last-abbrev-location 0
"The location of the start of the last abbrev expanded.")
-;; (defvar local-abbrev-table fundamental-mode-abbrev-table
+;; (defvar-local local-abbrev-table fundamental-mode-abbrev-table
;; "Local (mode-specific) abbrev table of current buffer.")
-;; (make-variable-buffer-local 'local-abbrev-table)
(defun clear-abbrev-table (table)
"Undefine all abbrevs in abbrev table TABLE, leaving it empty."
diff --git a/lisp/align.el b/lisp/align.el
index 1318b73..1a1d3dd 100644
--- a/lisp/align.el
+++ b/lisp/align.el
@@ -424,7 +424,7 @@ The possible settings for `align-region-separate' are:
(backward-word 1)
(looking-at
"\\(goto\\|return\\|new\\|delete\\|throw\\)"))
- (if (and (boundp 'font-lock-mode) font-lock-mode)
+ (if font-lock-mode
(eq (get-text-property (point) 'face)
'font-lock-comment-face)
(eq (caar (c-guess-basic-syntax)) 'c)))))))
@@ -775,18 +775,14 @@ See the documentation for `align-rules-list' for more
info."
;;; Internal Variables:
-(defvar align-mode-rules-list nil
+(defvar-local align-mode-rules-list nil
"Alignment rules specific to the current major mode.
See the variable `align-rules-list' for more details.")
-(make-variable-buffer-local 'align-mode-rules-list)
-
-(defvar align-mode-exclude-rules-list nil
+(defvar-local align-mode-exclude-rules-list nil
"Alignment exclusion rules specific to the current major mode.
See the variable `align-exclude-rules-list' for more details.")
-(make-variable-buffer-local 'align-mode-exclude-rules-list)
-
(defvar align-highlight-overlays nil
"The current overlays highlighting the text matched by a rule.")
diff --git a/lisp/allout-widgets.el b/lisp/allout-widgets.el
index d31083e..f251be8 100644
--- a/lisp/allout-widgets.el
+++ b/lisp/allout-widgets.el
@@ -78,9 +78,8 @@
;;; during file load, so the involved code must reside above that
;;; definition in the file.
;;;_ = allout-widgets-mode
-(defvar allout-widgets-mode nil
+(defvar-local allout-widgets-mode nil
"Allout mode enhanced with graphical widgets.")
-(make-variable-buffer-local 'allout-widgets-mode)
;;;_ : USER CUSTOMIZATION VARIABLES and incidental functions:
;;;_ > defgroup allout-widgets
@@ -243,14 +242,13 @@ decreases as obsolete widgets are garbage collected."
:version "24.1"
:type 'boolean
:group 'allout-widgets-developer)
-(defvar allout-widgets-tally nil
+(defvar-local allout-widgets-tally nil
"Hash-table of existing allout widgets, for debugging.
Table is maintained only if `allout-widgets-maintain-tally' is non-nil.
The table contents will be out of sync if any widgets are created
or deleted while this variable is nil.")
-(make-variable-buffer-local 'allout-widgets-tally)
(defvar allout-widgets-mode-inhibit) ; defined below
;;;_ > allout-widgets-tally-string
(defun allout-widgets-tally-string ()
@@ -295,7 +293,7 @@ to publicize it by making it a customization variable)."
(message "%s" msg)
msg))
;;;_ = allout-widgets-mode-inhibit
-(defvar allout-widgets-mode-inhibit nil
+(defvar-local allout-widgets-mode-inhibit nil
"Inhibit `allout-widgets-mode' from activating widgets.
This also inhibits automatic adjustment of widgets to track allout outline
@@ -310,15 +308,13 @@ buffers where this is set to enable and disable widget
enhancements, directly.")
;;;###autoload
(put 'allout-widgets-mode-inhibit 'safe-local-variable 'booleanp)
-(make-variable-buffer-local 'allout-widgets-mode-inhibit)
;;;_ = allout-inhibit-body-modification-hook
-(defvar allout-inhibit-body-modification-hook nil
+(defvar-local allout-inhibit-body-modification-hook nil
"Override de-escaping of text-prefixes in item bodies during specific
changes.
This is used by `allout-buffer-modification-handler' to signal such changes
to `allout-body-modification-handler', and is always reset by
`allout-post-command-business'.")
-(make-variable-buffer-local 'allout-inhibit-body-modification-hook)
;;;_ = allout-widgets-icons-cache
(defvar allout-widgets-icons-cache nil
"Cache allout icon images, as an association list.
@@ -358,7 +354,7 @@ See \\[describe-mode] for many more options."
The structure includes the guides lines, bullet, and bullet cue.")
;;;_ = allout-widgets-changes-record
-(defvar allout-widgets-changes-record nil
+(defvar-local allout-widgets-changes-record nil
"Record outline changes for processing by post-command hook.
Entries on the list are lists whose first element is a symbol indicating
@@ -369,14 +365,12 @@ type. For example:
The changes are recorded in reverse order, with new values pushed
onto the front.")
-(make-variable-buffer-local 'allout-widgets-changes-record)
;;;_ = allout-widgets-undo-exposure-record
-(defvar allout-widgets-undo-exposure-record nil
+(defvar-local allout-widgets-undo-exposure-record nil
"Record outline undo traces for processing by post-command hook.
The changes are recorded in reverse order, with new values pushed
onto the front.")
-(make-variable-buffer-local 'allout-widgets-undo-exposure-record)
;;;_ = allout-widgets-last-hook-error
(defvar allout-widgets-last-hook-error nil
"String holding last error string, for debugging purposes.")
@@ -393,13 +387,12 @@ onto the front.")
"Maintained true during `allout-widgets-exposure-undo-processor'")
;;;_ , Widget-specific outline text format
;;;_ = allout-escaped-prefix-regexp
-(defvar allout-escaped-prefix-regexp ""
+(defvar-local allout-escaped-prefix-regexp ""
"Regular expression for body text that would look like an item prefix if
not altered with an escape sequence.")
-(make-variable-buffer-local 'allout-escaped-prefix-regexp)
;;;_ , Widget element formatting
;;;_ = allout-item-icon-keymap
-(defvar allout-item-icon-keymap
+(defvar-local allout-item-icon-keymap
(let ((km (make-sparse-keymap))
(as-parent (if (current-local-map)
(make-composed-keymap (current-local-map)
@@ -420,9 +413,8 @@ not altered with an escape sequence.")
km)
"General tree-node key bindings.")
-(make-variable-buffer-local 'allout-item-icon-keymap)
;;;_ = allout-item-body-keymap
-(defvar allout-item-body-keymap
+(defvar-local allout-item-body-keymap
(let ((km (make-sparse-keymap))
(as-parent (if (current-local-map)
(make-composed-keymap (current-local-map)
@@ -432,17 +424,15 @@ not altered with an escape sequence.")
(set-keymap-parent km as-parent)
km)
"General key bindings for the text content of outline items.")
-(make-variable-buffer-local 'allout-item-body-keymap)
;;;_ = allout-body-span-category
(defvar allout-body-span-category nil
"Symbol carrying allout body-text overlay properties.")
;;;_ = allout-cue-span-keymap
-(defvar allout-cue-span-keymap
+(defvar-local allout-cue-span-keymap
(let ((km (make-sparse-keymap)))
(set-keymap-parent km allout-item-icon-keymap)
km)
"Keymap used in the item cue area - the space between the icon and
headline.")
-(make-variable-buffer-local 'allout-cue-span-keymap)
;;;_ = allout-escapes-category
(defvar allout-escapes-category nil
"Symbol for category of text property used to hide escapes of prefix-like
@@ -477,7 +467,7 @@ including things like:
(defvar allout-trailing-category nil
"Symbol carrying common properties of an overlay's trailing newline.")
;;;_ , Developer
-(defvar allout-widgets-last-decoration-timing nil
+(defvar-local allout-widgets-last-decoration-timing nil
"Timing details for the last cooperative decoration action.
This is maintained when `allout-widgets-time-decoration-activity' is set.
@@ -488,7 +478,6 @@ The value is a list containing two elements:
When active, the value is revised each time automatic decoration activity
happens in the buffer.")
-(make-variable-buffer-local 'allout-widgets-last-decoration-timing)
;;;_ . mode hookup
;;;_ > define-minor-mode allout-widgets-mode (arg)
;;;###autoload
@@ -693,12 +682,11 @@ outline hot-spot navigation (see `allout-mode')."
(allout-get-or-create-item-widget))))))
;;;_ . settings context
;;;_ = allout-container-item
-(defvar allout-container-item-widget nil
+(defvar-local allout-container-item-widget nil
"A widget for the current outline's overarching container as an item.
The item has settings (of the file/connection) and maybe a body, but no
icon/bullet.")
-(make-variable-buffer-local 'allout-container-item-widget)
;;;_ . Hooks and hook helpers
;;;_ , major command-loop business:
;;;_ > allout-widgets-pre-command-business (&optional recursing)
@@ -2243,7 +2231,7 @@ interactive command."
We use a caching strategy, so the caller doesn't need to do so."
(let* ((types allout-widgets-icon-types)
- (use-dir (if (equal (allout-frame-property nil 'background-mode)
+ (use-dir (if (equal (frame-parameter nil 'background-mode)
'light)
allout-widgets-icons-light-subdir
allout-widgets-icons-dark-subdir))
@@ -2274,13 +2262,6 @@ We use a caching strategy, so the caller doesn't need to
do so."
"Return seconds between START/END time values."
(let ((elapsed (time-subtract end start)))
(float-time elapsed)))
-;;;_ > allout-frame-property (frame property)
-(defalias 'allout-frame-property
- (cond ((fboundp 'frame-parameter)
- 'frame-parameter)
- ((fboundp 'frame-property)
- 'frame-property)
- (t nil)))
;;;_ > allout-find-image (specs)
(define-obsolete-function-alias 'allout-find-image #'find-image "28.1")
;;;_ > allout-widgets-copy-list (list)
@@ -2307,6 +2288,8 @@ The elements of LIST are not copied, just the list
structure itself."
(overlays-in start end)))))
(length button-overlays)))
+(define-obsolete-function-alias 'allout-frame-property #'frame-parameter
"28.1")
+
;;;_ : provide
(provide 'allout-widgets)
diff --git a/lisp/allout.el b/lisp/allout.el
index 39aa29b..ff0b675 100644
--- a/lisp/allout.el
+++ b/lisp/allout.el
@@ -830,9 +830,8 @@ such topics are encrypted.)"
The value of `buffer-saved-size' at the time of decryption is used,
for restoring when all encryptions are established.")
-(defvar allout-just-did-undo nil
+(defvar-local allout-just-did-undo nil
"True just after undo commands, until allout-post-command-business.")
-(make-variable-buffer-local 'allout-just-did-undo)
;;;_ + Developer
;;;_ = allout-developer group
@@ -874,10 +873,10 @@ For details, see
`allout-toggle-current-subtree-encryption's docstring."
msg))
;;;_ : Mode activation (defined here because it's referenced early)
;;;_ = allout-mode
-(defvar allout-mode nil "Allout outline mode minor-mode flag.")
-(make-variable-buffer-local 'allout-mode)
+(defvar-local allout-mode nil
+ "Allout outline mode minor-mode flag.")
;;;_ = allout-layout nil
-(defvar allout-layout nil ; LEAVE GLOBAL VALUE NIL -- see docstring.
+(defvar-local allout-layout nil ; LEAVE GLOBAL VALUE NIL -- see
docstring.
"Buffer-specific setting for allout layout.
In buffers where this is non-nil (and if `allout-auto-activation'
@@ -903,34 +902,30 @@ followed by the equivalent of `(allout-expose-topic 0 :
-1 -1 0)'.
`allout-default-layout' describes the specification format.
`allout-layout' can additionally have the value t, in which
case the value of `allout-default-layout' is used.")
-(make-variable-buffer-local 'allout-layout)
;;;###autoload
(put 'allout-layout 'safe-local-variable
(lambda (x) (or (numberp x) (listp x) (memq x '(: * + -)))))
;;;_ : Topic header format
;;;_ = allout-regexp
-(defvar allout-regexp ""
+(defvar-local allout-regexp ""
"Regular expression to match the beginning of a heading line.
Any line whose beginning matches this regexp is considered a
heading. This var is set according to the user configuration vars
by `allout-set-regexp'.")
-(make-variable-buffer-local 'allout-regexp)
;;;_ = allout-bullets-string
-(defvar allout-bullets-string ""
+(defvar-local allout-bullets-string ""
"A string dictating the valid set of outline topic bullets.
This var should *not* be set by the user -- it is set by `allout-set-regexp',
and is produced from the elements of `allout-plain-bullets-string'
and `allout-distinctive-bullets-string'.")
-(make-variable-buffer-local 'allout-bullets-string)
;;;_ = allout-bullets-string-len
-(defvar allout-bullets-string-len 0
+(defvar-local allout-bullets-string-len 0
"Length of current buffers' `allout-plain-bullets-string'.")
-(make-variable-buffer-local 'allout-bullets-string-len)
;;;_ = allout-depth-specific-regexp
-(defvar allout-depth-specific-regexp ""
+(defvar-local allout-depth-specific-regexp ""
"Regular expression to match a heading line prefix for a particular depth.
This expression is used to search for depth-specific topic
@@ -941,34 +936,28 @@ This var is set according to the user configuration vars
by
`allout-set-regexp'. It is prepared with format strings for two
decimal numbers, which should each be one less than the depth of the
topic prefix to be matched.")
-(make-variable-buffer-local 'allout-depth-specific-regexp)
;;;_ = allout-depth-one-regexp
-(defvar allout-depth-one-regexp ""
+(defvar-local allout-depth-one-regexp ""
"Regular expression to match a heading line prefix for depth one.
This var is set according to the user configuration vars by
`allout-set-regexp'. It is prepared with format strings for two
decimal numbers, which should each be one less than the depth of the
topic prefix to be matched.")
-(make-variable-buffer-local 'allout-depth-one-regexp)
;;;_ = allout-line-boundary-regexp
-(defvar allout-line-boundary-regexp ()
+(defvar-local allout-line-boundary-regexp ()
"`allout-regexp' prepended with a newline for the search target.
This is properly set by `allout-set-regexp'.")
-(make-variable-buffer-local 'allout-line-boundary-regexp)
;;;_ = allout-bob-regexp
-(defvar allout-bob-regexp ()
+(defvar-local allout-bob-regexp ()
"Like `allout-line-boundary-regexp', for headers at beginning of buffer.")
-(make-variable-buffer-local 'allout-bob-regexp)
;;;_ = allout-header-subtraction
-(defvar allout-header-subtraction (1- (length allout-header-prefix))
+(defvar-local allout-header-subtraction (1- (length allout-header-prefix))
"Allout-header prefix length to subtract when computing topic depth.")
-(make-variable-buffer-local 'allout-header-subtraction)
;;;_ = allout-plain-bullets-string-len
-(defvar allout-plain-bullets-string-len (length allout-plain-bullets-string)
+(defvar-local allout-plain-bullets-string-len (length
allout-plain-bullets-string)
"Length of `allout-plain-bullets-string', updated by `allout-set-regexp'.")
-(make-variable-buffer-local 'allout-plain-bullets-string-len)
;;;_ = allout-doublecheck-at-and-shallower
(defconst allout-doublecheck-at-and-shallower 3
@@ -1279,11 +1268,10 @@ Also refresh various data structures that hinge on the
regexp."
["Set New Exposure" allout-expose-topic t])))
;;;_ : Allout Modal-Variables Utilities
;;;_ = allout-mode-prior-settings
-(defvar allout-mode-prior-settings nil
+(defvar-local allout-mode-prior-settings nil
"Internal `allout-mode' use; settings to be resumed on mode deactivation.
See `allout-add-resumptions' and `allout-do-resumptions'.")
-(make-variable-buffer-local 'allout-mode-prior-settings)
;;;_ > allout-add-resumptions (&rest pairs)
(defun allout-add-resumptions (&rest pairs)
"Set name/value PAIRS.
@@ -1466,16 +1454,15 @@ that was affected by the undo.."
:version "24.3")
;;;_ = allout-outside-normal-auto-fill-function
-(defvar allout-outside-normal-auto-fill-function nil
+(defvar-local allout-outside-normal-auto-fill-function nil
"Value of `normal-auto-fill-function' outside of allout mode.
Used by `allout-auto-fill' to do the mandated `normal-auto-fill-function'
wrapped within allout's automatic `fill-prefix' setting.")
-(make-variable-buffer-local 'allout-outside-normal-auto-fill-function)
;;;_ = prevent redundant activation by desktop mode:
(add-to-list 'desktop-minor-mode-handlers '(allout-mode . nil))
;;;_ = allout-after-save-decrypt
-(defvar allout-after-save-decrypt nil
+(defvar-local allout-after-save-decrypt nil
"Internal variable, is nil or has the value of two points:
- the location of a topic to be decrypted after saving is done
@@ -1483,9 +1470,8 @@ wrapped within allout's automatic `fill-prefix' setting.")
This is used to decrypt the topic that was currently being edited, if it
was encrypted automatically as part of a file write or autosave.")
-(make-variable-buffer-local 'allout-after-save-decrypt)
;;;_ = allout-encryption-plaintext-sanitization-regexps
-(defvar allout-encryption-plaintext-sanitization-regexps nil
+(defvar-local allout-encryption-plaintext-sanitization-regexps nil
"List of regexps whose matches are removed from plaintext before encryption.
This is for the sake of removing artifacts, like escapes, that are added on
@@ -1498,9 +1484,8 @@ Each value can be a regexp or a list with a regexp
followed by a
substitution string. If it's just a regexp, all its matches are removed
before the text is encrypted. If it's a regexp and a substitution, the
substitution is used against the regexp matches, a la `replace-match'.")
-(make-variable-buffer-local 'allout-encryption-plaintext-sanitization-regexps)
;;;_ = allout-encryption-ciphertext-rejection-regexps
-(defvar allout-encryption-ciphertext-rejection-regexps nil
+(defvar-local allout-encryption-ciphertext-rejection-regexps nil
"Variable for regexps matching plaintext to remove before encryption.
This is used to detect strings in encryption results that would
@@ -1513,13 +1498,11 @@ Encryptions that result in matches will be retried, up
to
`allout-encryption-ciphertext-rejection-ceiling' times, after which
an error is raised.")
-(make-variable-buffer-local 'allout-encryption-ciphertext-rejection-regexps)
;;;_ = allout-encryption-ciphertext-rejection-ceiling
-(defvar allout-encryption-ciphertext-rejection-ceiling 5
+(defvar-local allout-encryption-ciphertext-rejection-ceiling 5
"Limit on number of times encryption ciphertext is rejected.
See `allout-encryption-ciphertext-rejection-regexps' for rejection reasons.")
-(make-variable-buffer-local 'allout-encryption-ciphertext-rejection-ceiling)
;;;_ > allout-mode-p ()
;; Must define this macro above any uses, or byte compilation will lack
;; proper def, if file isn't loaded -- eg, during emacs build!
@@ -1607,10 +1590,9 @@ non-nil in a lasting way.")
;;;_ #2 Mode environment and activation
;;;_ = allout-explicitly-deactivated
-(defvar allout-explicitly-deactivated nil
+(defvar-local allout-explicitly-deactivated nil
"If t, `allout-mode's last deactivation was deliberate.
So `allout-post-command-business' should not reactivate it...")
-(make-variable-buffer-local 'allout-explicitly-deactivated)
;;;_ > allout-setup-menubar ()
(defun allout-setup-menubar ()
"Populate the current buffer's menubar with `allout-mode' stuff."
@@ -2119,21 +2101,17 @@ function can also be used as an
`isearch-mode-end-hook'."
;; for just-established data. This optimization can provide
;; significant speed improvement, but it must be employed carefully.
;;;_ = allout-recent-prefix-beginning
-(defvar allout-recent-prefix-beginning 0
+(defvar-local allout-recent-prefix-beginning 0
"Buffer point of the start of the last topic prefix encountered.")
-(make-variable-buffer-local 'allout-recent-prefix-beginning)
;;;_ = allout-recent-prefix-end
-(defvar allout-recent-prefix-end 0
+(defvar-local allout-recent-prefix-end 0
"Buffer point of the end of the last topic prefix encountered.")
-(make-variable-buffer-local 'allout-recent-prefix-end)
;;;_ = allout-recent-depth
-(defvar allout-recent-depth 0
+(defvar-local allout-recent-depth 0
"Depth of the last topic prefix encountered.")
-(make-variable-buffer-local 'allout-recent-depth)
;;;_ = allout-recent-end-of-subtree
-(defvar allout-recent-end-of-subtree 0
+(defvar-local allout-recent-end-of-subtree 0
"Buffer point last returned by `allout-end-of-current-subtree'.")
-(make-variable-buffer-local 'allout-recent-end-of-subtree)
;;;_ > allout-prefix-data ()
(defsubst allout-prefix-data ()
"Register allout-prefix state data.
@@ -3213,7 +3191,7 @@ Returns resulting position, else nil if none found."
;;;_ - Fundamental
;;;_ = allout-post-goto-bullet
-(defvar allout-post-goto-bullet nil
+(defvar-local allout-post-goto-bullet nil
"Outline internal var, for `allout-pre-command-business' hot-spot operation.
When set, tells post-processing to reposition on topic bullet, and
@@ -3221,18 +3199,15 @@ then unset it. Set by `allout-pre-command-business'
when implementing
hot-spot operation, where literal characters typed over a topic bullet
are mapped to the command of the corresponding control-key on the
`allout-mode-map-value'.")
-(make-variable-buffer-local 'allout-post-goto-bullet)
;;;_ = allout-command-counter
-(defvar allout-command-counter 0
+(defvar-local allout-command-counter 0
"Counter that monotonically increases in allout-mode buffers.
Set by `allout-pre-command-business', to support allout addons in
coordinating with allout activity.")
-(make-variable-buffer-local 'allout-command-counter)
;;;_ = allout-this-command-hid-text
-(defvar allout-this-command-hid-text nil
+(defvar-local allout-this-command-hid-text nil
"True if the most recent allout-mode command hid any text.")
-(make-variable-buffer-local 'allout-this-command-hid-text)
;;;_ > allout-post-command-business ()
(defun allout-post-command-business ()
"Outline `post-command-hook' function.
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/bindings.el b/lisp/bindings.el
index 187444a..2f4bab1 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -199,7 +199,7 @@ mouse-3: Set coding system"
(symbol-name buffer-file-coding-system))
"Buffer coding system: none specified")))
-(defvar mode-line-mule-info
+(defvar-local mode-line-mule-info
`(""
(current-input-method
(:propertize ("" current-input-method-title)
@@ -225,7 +225,6 @@ mnemonics of the following coding systems:
coding system for terminal output (on a text terminal)")
;;;###autoload
(put 'mode-line-mule-info 'risky-local-variable t)
-(make-variable-buffer-local 'mode-line-mule-info)
(defvar mode-line-client
`(""
@@ -247,7 +246,7 @@ mnemonics of the following coding systems:
(format "Buffer is %smodified\nmouse-1: Toggle modification state"
(if (buffer-modified-p (window-buffer window)) "" "not ")))
-(defvar mode-line-modified
+(defvar-local mode-line-modified
(list (propertize
"%1*"
'help-echo 'mode-line-read-only-help-echo
@@ -264,9 +263,8 @@ mnemonics of the following coding systems:
"Mode line construct for displaying whether current buffer is modified.")
;;;###autoload
(put 'mode-line-modified 'risky-local-variable t)
-(make-variable-buffer-local 'mode-line-modified)
-(defvar mode-line-remote
+(defvar-local mode-line-remote
(list (propertize
"%1@"
'mouse-face 'mode-line-highlight
@@ -283,7 +281,6 @@ mnemonics of the following coding systems:
"Mode line construct to indicate a remote buffer.")
;;;###autoload
(put 'mode-line-remote 'risky-local-variable t)
-(make-variable-buffer-local 'mode-line-remote)
;; MSDOS frames have window-system, but want the Fn identification.
(defun mode-line-frame-control ()
@@ -301,12 +298,11 @@ Value is used for `mode-line-frame-identification', which
see."
;;;###autoload
(put 'mode-line-frame-identification 'risky-local-variable t)
-(defvar mode-line-process nil
+(defvar-local mode-line-process nil
"Mode line construct for displaying info on process status.
Normally nil in most modes, since there is no process to display.")
;;;###autoload
(put 'mode-line-process 'risky-local-variable t)
-(make-variable-buffer-local 'mode-line-process)
(defun bindings--define-key (map key item)
"Define KEY in keymap MAP according to ITEM from a menu.
@@ -543,7 +539,7 @@ mouse-1: Previous buffer\nmouse-3: Next buffer")
'mouse-face 'mode-line-highlight
'local-map mode-line-buffer-identification-keymap)))
-(defvar mode-line-buffer-identification
+(defvar-local mode-line-buffer-identification
(propertized-buffer-identification "%12b")
"Mode line construct for identifying the buffer being displayed.
Its default value is (\"%12b\") with some text properties added.
@@ -551,7 +547,6 @@ Major modes that edit things other than ordinary files may
change this
\(e.g. Info, Dired,...)")
;;;###autoload
(put 'mode-line-buffer-identification 'risky-local-variable t)
-(make-variable-buffer-local 'mode-line-buffer-identification)
(defvar mode-line-misc-info
'((global-mode-string ("" global-mode-string " ")))
@@ -1418,6 +1413,18 @@ if `inhibit-field-text-motion' is non-nil."
(define-key ctl-x-map "z" 'repeat)
+(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)
(define-key ctl-x-4-map "a" 'add-change-log-entry-other-window)
diff --git a/lisp/bookmark.el b/lisp/bookmark.el
index c857c9b..dcf8ff0 100644
--- a/lisp/bookmark.el
+++ b/lisp/bookmark.el
@@ -271,13 +271,11 @@ defaults to `bookmark-default-file' and MODTIME is its
modification time.")
(defvar bookmark-file-coding-system nil
"The coding-system of the last loaded or saved bookmark file.")
-(defvar bookmark-current-bookmark nil
+(defvar-local bookmark-current-bookmark nil
"Name of bookmark most recently used in the current file.
It is buffer local, used to make moving a bookmark forward
through a file easier.")
-(make-variable-buffer-local 'bookmark-current-bookmark)
-
(defvar bookmark-alist-modification-count 0
"Number of modifications to bookmark list since it was last saved.")
@@ -903,13 +901,11 @@ Does not affect the kill ring."
(when (and newline-too (= (following-char) ?\n))
(delete-char 1))))
-(defvar bookmark-annotation-name nil
+(defvar-local bookmark-annotation-name nil
"Name of bookmark under edit in `bookmark-edit-annotation-mode'.")
-(make-variable-buffer-local 'bookmark-annotation-name)
-(defvar bookmark--annotation-from-bookmark-list nil
+(defvar-local bookmark--annotation-from-bookmark-list nil
"If non-nil, `bookmark-edit-annotation-mode' should return to bookmark
list.")
-(make-variable-buffer-local 'bookmark--annotation-from-bookmark-list)
(defun bookmark-default-annotation-text (bookmark-name)
"Return default annotation text for BOOKMARK-NAME.
diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el
index 49f8604..bb39e1f 100644
--- a/lisp/buff-menu.el
+++ b/lisp/buff-menu.el
@@ -111,11 +111,10 @@ as it is by default."
:group 'Buffer-menu
:version "22.1")
-(defvar Buffer-menu-files-only nil
+(defvar-local Buffer-menu-files-only nil
"Non-nil if the current Buffer Menu lists only file buffers.
This is set by the prefix argument to `buffer-menu' and related
commands.")
-(make-variable-buffer-local 'Buffer-menu-files-only)
(defvar Buffer-menu-mode-map
(let ((map (make-sparse-keymap))
diff --git a/lisp/calc/calc-embed.el b/lisp/calc/calc-embed.el
index fda0b4b..7455140 100644
--- a/lisp/calc/calc-embed.el
+++ b/lisp/calc/calc-embed.el
@@ -46,10 +46,8 @@
(defvar calc-embedded-modes nil)
(defvar calc-embedded-globals nil)
(defvar calc-embedded-active nil)
-(defvar calc-embedded-all-active nil)
-(make-variable-buffer-local 'calc-embedded-all-active)
-(defvar calc-embedded-some-active nil)
-(make-variable-buffer-local 'calc-embedded-some-active)
+(defvar-local calc-embedded-all-active nil)
+(defvar-local calc-embedded-some-active nil)
;; The following variables are customizable and defined in calc.el.
(defvar calc-embedded-announce-formula)
@@ -856,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/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/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 1428915..e3cc906 100644
--- a/lisp/cedet/ede.el
+++ b/lisp/cedet/ede.el
@@ -140,22 +140,19 @@ specified by `ede-project-directories'."
(defvar ede-projects nil
"A list of all active projects currently loaded in Emacs.")
-(defvar ede-object-root-project nil
+(defvar-local ede-object-root-project nil
"The current buffer's current root project.
If a file is under a project, this specifies the project that is at
the root of a project tree.")
-(make-variable-buffer-local 'ede-object-root-project)
-(defvar ede-object-project nil
+(defvar-local ede-object-project nil
"The current buffer's current project at that level.
If a file is under a project, this specifies the project that contains the
current target.")
-(make-variable-buffer-local 'ede-object-project)
-(defvar ede-object nil
+(defvar-local ede-object nil
"The current buffer's target object.
This object's class determines how to compile and debug from a buffer.")
-(make-variable-buffer-local 'ede-object)
(defvar ede-selected-object nil
"The currently user-selected project or target.
diff --git a/lisp/cedet/ede/proj-archive.el b/lisp/cedet/ede/proj-archive.el
index 2b1e50d..038f994 100644
--- a/lisp/cedet/ede/proj-archive.el
+++ b/lisp/cedet/ede/proj-archive.el
@@ -5,6 +5,8 @@
;; 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
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/mode-local.el b/lisp/cedet/mode-local.el
index d1e528c..63e0cef 100644
--- a/lisp/cedet/mode-local.el
+++ b/lisp/cedet/mode-local.el
@@ -170,11 +170,10 @@ definition."
;;; Core bindings API
;;
-(defvar mode-local-symbol-table nil
+(defvar-local mode-local-symbol-table nil
"Buffer local mode bindings.
These symbols provide a hook for a `major-mode' to specify specific
behaviors. Use the function `mode-local-bind' to define new bindings.")
-(make-variable-buffer-local 'mode-local-symbol-table)
(defvar mode-local-active-mode nil
"Major mode in which bindings are active.")
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.el b/lisp/cedet/semantic.el
index c64a982..44bd4b0 100644
--- a/lisp/cedet/semantic.el
+++ b/lisp/cedet/semantic.el
@@ -77,13 +77,12 @@ introduced."
;;; Variables and Configuration
;;
-(defvar semantic--parse-table nil
+(defvar-local semantic--parse-table nil
"Variable that defines how to parse top level items in a buffer.
This variable is for internal use only, and its content depends on the
external parser used.")
-(make-variable-buffer-local 'semantic--parse-table)
-(defvar semantic-symbol->name-assoc-list
+(defvar-local semantic-symbol->name-assoc-list
'((type . "Types")
(variable . "Variables")
(function . "Functions")
@@ -95,22 +94,19 @@ It is sometimes useful for a language to use a different
string
in place of the default, even though that language will still
return a symbol. For example, Java return's includes, but the
string can be replaced with `Imports'.")
-(make-variable-buffer-local 'semantic-symbol->name-assoc-list)
-(defvar semantic-symbol->name-assoc-list-for-type-parts nil
+(defvar-local semantic-symbol->name-assoc-list-for-type-parts nil
"Like `semantic-symbol->name-assoc-list' for type parts.
Some tags that have children (see `semantic-tag-children-compatibility')
will want to define the names of classes of tags differently than at
the top level. For example, in C++, a Function may be called a
Method. In addition, there may be new types of tags that exist only
in classes, such as protection labels.")
-(make-variable-buffer-local 'semantic-symbol->name-assoc-list-for-type-parts)
-(defvar semantic-case-fold nil
+(defvar-local semantic-case-fold nil
"Value for `case-fold-search' when parsing.")
-(make-variable-buffer-local 'semantic-case-fold)
-(defvar semantic--buffer-cache nil
+(defvar-local semantic--buffer-cache nil
"A cache of the fully parsed buffer.
If no significant changes have been made (based on the state) then
this is returned instead of re-parsing the buffer.
@@ -120,16 +116,13 @@ this is returned instead of re-parsing the buffer.
If you need a tag list, use `semantic-fetch-tags'. If you need the
cached values for some reason, chances are you can add a hook to
`semantic-after-toplevel-cache-change-hook'.")
-(make-variable-buffer-local 'semantic--buffer-cache)
-(defvar semantic-unmatched-syntax-cache nil
+(defvar-local semantic-unmatched-syntax-cache nil
"A cached copy of unmatched syntax tokens.")
-(make-variable-buffer-local 'semantic-unmatched-syntax-cache)
-(defvar semantic-unmatched-syntax-cache-check nil
+(defvar-local semantic-unmatched-syntax-cache-check nil
"Non-nil if the unmatched syntax cache is out of date.
This is tracked with `semantic-change-function'.")
-(make-variable-buffer-local 'semantic-unmatched-syntax-cache-check)
(defvar semantic-edits-are-safe nil
"When non-nil, modifications do not require a reparse.
@@ -180,19 +173,16 @@ during a flush when the cache is given a new value of
nil.")
:group 'semantic
:type 'boolean)
-(defvar semantic-parser-name "LL"
+(defvar-local semantic-parser-name "LL"
"Optional name of the parser used to parse input stream.")
-(make-variable-buffer-local 'semantic-parser-name)
-(defvar semantic--completion-cache nil
+(defvar-local semantic--completion-cache nil
"Internal variable used by `semantic-complete-symbol'.")
-(make-variable-buffer-local 'semantic--completion-cache)
;;; Parse tree state management API
;;
-(defvar semantic-parse-tree-state 'needs-rebuild
+(defvar-local semantic-parse-tree-state 'needs-rebuild
"State of the current parse tree.")
-(make-variable-buffer-local 'semantic-parse-tree-state)
(defmacro semantic-parse-tree-unparseable ()
"Indicate that the current buffer is unparseable.
@@ -268,9 +258,8 @@ These functions are called by `semantic-new-buffer-fcn',
before
(defvar semantic-init-hook nil
"Hook run when a buffer is initialized with a parsing table.")
-(defvar semantic-init-mode-hook nil
+(defvar-local semantic-init-mode-hook nil
"Hook run when a buffer of a particular mode is initialized.")
-(make-variable-buffer-local 'semantic-init-mode-hook)
(defvar semantic-init-db-hook nil
"Hook run when a buffer is initialized with a parsing table for DBs.
@@ -729,9 +718,8 @@ This function returns semantic tags without overlays."
;;
;; Any parser can use this API to provide a list of warnings during a
;; parse which a user may want to investigate.
-(defvar semantic-parser-warnings nil
+(defvar-local semantic-parser-warnings nil
"A list of parser warnings since the last full reparse.")
-(make-variable-buffer-local 'semantic-parser-warnings)
(defun semantic-clear-parser-warnings ()
"Clear the current list of parser warnings for this buffer."
diff --git a/lisp/cedet/semantic/bovine.el b/lisp/cedet/semantic/bovine.el
index 034ecb5..3bc0e4d 100644
--- a/lisp/cedet/semantic/bovine.el
+++ b/lisp/cedet/semantic/bovine.el
@@ -41,10 +41,9 @@
;;; Variables
;;
-(defvar semantic-bovinate-nonterminal-check-obarray nil
+(defvar-local semantic-bovinate-nonterminal-check-obarray nil
"Obarray of streams already parsed for nonterminal symbols.
Use this to detect infinite recursion during a parse.")
-(make-variable-buffer-local 'semantic-bovinate-nonterminal-check-obarray)
diff --git a/lisp/cedet/semantic/bovine/gcc.el
b/lisp/cedet/semantic/bovine/gcc.el
index 1cfe5a3..9cd9cdc 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,9 +89,7 @@ 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))))))))
+ (cl-pushnew (expand-file-name path) inc-path))))))))
inc-path))
@@ -101,7 +100,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 +141,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/complete.el b/lisp/cedet/semantic/complete.el
index 0a80b42..c835058 100644
--- a/lisp/cedet/semantic/complete.el
+++ b/lisp/cedet/semantic/complete.el
@@ -867,9 +867,8 @@ Expected return values are:
;; * semantic-collector-try-completion
;; * semantic-collector-all-completions
-(defvar semantic-collector-per-buffer-list nil
+(defvar-local semantic-collector-per-buffer-list nil
"List of collectors active in this buffer.")
-(make-variable-buffer-local 'semantic-collector-per-buffer-list)
(defvar semantic-collector-list nil
"List of global collectors active this session.")
diff --git a/lisp/cedet/semantic/ctxt.el b/lisp/cedet/semantic/ctxt.el
index 4d2defd..8d5b5dc 100644
--- a/lisp/cedet/semantic/ctxt.el
+++ b/lisp/cedet/semantic/ctxt.el
@@ -32,17 +32,15 @@
(require 'semantic)
;;; Code:
-(defvar semantic-command-separation-character
+(defvar-local semantic-command-separation-character
";"
"String which indicates the end of a command.
Used for identifying the end of a single command.")
-(make-variable-buffer-local 'semantic-command-separation-character)
-(defvar semantic-function-argument-separation-character
+(defvar-local semantic-function-argument-separation-character
","
"String which indicates the end of an argument.
Used for identifying arguments to functions.")
-(make-variable-buffer-local 'semantic-function-argument-separation-character)
;;; Local Contexts
;;
diff --git a/lisp/cedet/semantic/db-find.el b/lisp/cedet/semantic/db-find.el
index 14726e5..db88463 100644
--- a/lisp/cedet/semantic/db-find.el
+++ b/lisp/cedet/semantic/db-find.el
@@ -426,17 +426,15 @@ Default action as described in
`semanticdb-find-translate-path'."
;; searchable item, then instead do the regular thing without caching.
(semanticdb-find-translate-path-includes--internal path))))
-(defvar semanticdb-find-lost-includes nil
+(defvar-local semanticdb-find-lost-includes nil
"Include files that we cannot find associated with this buffer.")
-(make-variable-buffer-local 'semanticdb-find-lost-includes)
-(defvar semanticdb-find-scanned-include-tags nil
+(defvar-local semanticdb-find-scanned-include-tags nil
"All include tags scanned, plus action taken on the tag.
Each entry is an alist:
(ACTION . TAG)
where ACTION is one of `scanned', `duplicate', `lost'
and TAG is a clone of the include tag that was found.")
-(make-variable-buffer-local 'semanticdb-find-scanned-include-tags)
(defvar semanticdb-implied-include-tags nil
"Include tags implied for all files of a given mode.
diff --git a/lisp/cedet/semantic/db.el b/lisp/cedet/semantic/db.el
index b9b1091..8f9ecee 100644
--- a/lisp/cedet/semantic/db.el
+++ b/lisp/cedet/semantic/db.el
@@ -50,27 +50,23 @@
(defvar semanticdb-database-list nil
"List of all active databases.")
-(defvar semanticdb-new-database-class 'semanticdb-project-database-file
+(defvar-local semanticdb-new-database-class 'semanticdb-project-database-file
"The default type of database created for new files.
This can be changed on a per file basis, so that some directories
are saved using one mechanism, and some directories via a different
mechanism.")
-(make-variable-buffer-local 'semanticdb-new-database-class)
-(defvar semanticdb-default-find-index-class 'semanticdb-find-search-index
+(defvar-local semanticdb-default-find-index-class 'semanticdb-find-search-index
"The default type of search index to use for a `semanticdb-table's.
This can be changed to try out new types of search indices.")
-(make-variable-buffer-local 'semanticdb-default-find=index-class)
;;;###autoload
-(defvar semanticdb-current-database nil
+(defvar-local semanticdb-current-database nil
"For a given buffer, this is the currently active database.")
-(make-variable-buffer-local 'semanticdb-current-database)
;;;###autoload
-(defvar semanticdb-current-table nil
+(defvar-local semanticdb-current-table nil
"For a given buffer, this is the currently active database table.")
-(make-variable-buffer-local 'semanticdb-current-table)
;;; ABSTRACT CLASSES
;;
@@ -825,13 +821,12 @@ must return a string, (the root directory) or a list of
strings (multiple
root directories in a more complex system). This variable should be used
by project management programs like EDE or JDE.")
-(defvar semanticdb-project-system-databases nil
+(defvar-local semanticdb-project-system-databases nil
"List of databases containing system library information.
Mode authors can create their own system databases which know
detailed information about the system libraries for querying purposes.
Put those into this variable as a buffer-local, or mode-local
value.")
-(make-variable-buffer-local 'semanticdb-project-system-databases)
(defvar semanticdb-search-system-databases t
"Non-nil if search routines are to include a system database.")
@@ -1016,10 +1011,9 @@ DONTLOAD does not affect the creation of new database
objects."
)
)))
-(defvar semanticdb-out-of-buffer-create-table-fcn nil
+(defvar-local semanticdb-out-of-buffer-create-table-fcn nil
"When non-nil, a function for creating a semanticdb table.
This should take a filename to be parsed.")
-(make-variable-buffer-local 'semanticdb-out-of-buffer-create-table-fcn)
(defun semanticdb-create-table-for-file-not-in-buffer (filename)
"Create a table for the file FILENAME.
diff --git a/lisp/cedet/semantic/debug.el b/lisp/cedet/semantic/debug.el
index b3e8f07..ce4afbb 100644
--- a/lisp/cedet/semantic/debug.el
+++ b/lisp/cedet/semantic/debug.el
@@ -44,24 +44,18 @@
;;; Code:
;;;###autoload
-(defvar semantic-debug-parser-source nil
+(defvar-local semantic-debug-parser-source nil
"For any buffer, the file name (no path) of the parser.
This would be a parser for a specific language, not the source
to one of the parser generators.")
-;;;###autoload
-(make-variable-buffer-local 'semantic-debug-parser-source)
;;;###autoload
-(defvar semantic-debug-parser-class nil
+(defvar-local semantic-debug-parser-class nil
"Class to create when building a debug parser object.")
-;;;###autoload
-(make-variable-buffer-local 'semantic-debug-parser-class)
;;;###autoload
-(defvar semantic-debug-parser-debugger-source nil
+(defvar-local semantic-debug-parser-debugger-source nil
"Location of the debug parser class.")
-;;;###autoload
-(make-variable-buffer-local 'semantic-debug-parser-source)
(defvar semantic-debug-enabled nil
"Non-nil when debugging a parser.")
diff --git a/lisp/cedet/semantic/dep.el b/lisp/cedet/semantic/dep.el
index 0fba2a2..db8be5e 100644
--- a/lisp/cedet/semantic/dep.el
+++ b/lisp/cedet/semantic/dep.el
@@ -39,7 +39,7 @@
;;; Code:
-(defvar semantic-dependency-include-path nil
+(defvar-local semantic-dependency-include-path nil
"Defines the include path used when searching for files.
This should be a list of directories to search which is specific
to the file being included.
@@ -56,9 +56,8 @@ reparsed, the cache will be reset.
TODO: use ffap.el to locate such items?
NOTE: Obsolete this, or use as special user")
-(make-variable-buffer-local 'semantic-dependency-include-path)
-(defvar semantic-dependency-system-include-path nil
+(defvar-local semantic-dependency-system-include-path nil
"Defines the system include path.
This should be set with either `defvar-mode-local', or with
`semantic-add-system-include'.
@@ -71,7 +70,6 @@ When searching for a file associated with a name found in a
tag of
class include, this path will be inspected for includes of type
`system'. Some include tags are agnostic to this setting and will
check both the project and system directories.")
-(make-variable-buffer-local 'semantic-dependency-system-include-path)
(defmacro defcustom-mode-local-semantic-dependency-system-include-path
(mode name value &optional docstring)
diff --git a/lisp/cedet/semantic/format.el b/lisp/cedet/semantic/format.el
index f9c5365..8927ccd 100644
--- a/lisp/cedet/semantic/format.el
+++ b/lisp/cedet/semantic/format.el
@@ -78,13 +78,11 @@ Images can be used as icons instead of some types of text
strings."
:group 'semantic
:type 'boolean)
-(defvar semantic-function-argument-separator ","
+(defvar-local semantic-function-argument-separator ","
"Text used to separate arguments when creating text from tags.")
-(make-variable-buffer-local 'semantic-function-argument-separator)
-(defvar semantic-format-parent-separator "::"
+(defvar-local semantic-format-parent-separator "::"
"Text used to separate names when between namespaces/classes and functions.")
-(make-variable-buffer-local 'semantic-format-parent-separator)
(defvar semantic-format-face-alist
`( (function . font-lock-function-name-face)
diff --git a/lisp/cedet/semantic/fw.el b/lisp/cedet/semantic/fw.el
index f034ba0..91944c4 100644
--- a/lisp/cedet/semantic/fw.el
+++ b/lisp/cedet/semantic/fw.el
@@ -243,9 +243,8 @@ Avoid using a large BODY since it is duplicated."
;;; Misc utilities
;;
-(defvar semantic-new-buffer-fcn-was-run nil
+(defvar-local semantic-new-buffer-fcn-was-run nil
"Non-nil after `semantic-new-buffer-fcn' has been executed.")
-(make-variable-buffer-local 'semantic-new-buffer-fcn-was-run)
(defsubst semantic-active-p ()
"Return non-nil if the current buffer was set up for parsing."
diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el
index 7721a83..4551811 100644
--- a/lisp/cedet/semantic/grammar.el
+++ b/lisp/cedet/semantic/grammar.el
@@ -432,9 +432,8 @@ Also load the specified macro libraries."
defs)))
(nreverse defs)))
-(defvar semantic-grammar-macros nil
+(defvar-local semantic-grammar-macros nil
"List of associations (MACRO-NAME . EXPANDER).")
-(make-variable-buffer-local 'semantic-grammar-macros)
(defun semantic-grammar-macros ()
"Build and return the alist of defined macros."
@@ -1054,8 +1053,7 @@ See also the variable `semantic-grammar-file-regexp'."
;;;; Macros highlighting
;;;;
-(defvar semantic--grammar-macros-regexp-1 nil)
-(make-variable-buffer-local 'semantic--grammar-macros-regexp-1)
+(defvar-local semantic--grammar-macros-regexp-1 nil)
(defun semantic--grammar-macros-regexp-1 ()
"Return font-lock keyword regexp for pre-installed macro names."
@@ -1076,8 +1074,7 @@ See also the variable `semantic-grammar-file-regexp'."
"\\<%use-macros\\>[ \t\r\n]+\\(\\sw\\|\\s_\\)+[ \t\r\n]+{"
"Regexp that matches a macro declaration statement.")
-(defvar semantic--grammar-macros-regexp-2 nil)
-(make-variable-buffer-local 'semantic--grammar-macros-regexp-2)
+(defvar-local semantic--grammar-macros-regexp-2 nil)
(defun semantic--grammar-clear-macros-regexp-2 (&rest _)
"Clear the cached regexp that match macros local in this grammar.
diff --git a/lisp/cedet/semantic/idle.el b/lisp/cedet/semantic/idle.el
index 4898c85..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.
@@ -135,10 +135,9 @@ it is unlikely the user would be ready to type again right
away."
:group 'semantic
:type 'hook)
-(defvar semantic-idle-scheduler-mode nil
+(defvar-local semantic-idle-scheduler-mode nil
"Non-nil if idle-scheduler minor mode is enabled.
Use the command `semantic-idle-scheduler-mode' to change this variable.")
-(make-variable-buffer-local 'semantic-idle-scheduler-mode)
(defcustom semantic-idle-scheduler-max-buffer-size 0
"Maximum size in bytes of buffers where idle-scheduler is enabled.
@@ -223,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)
@@ -431,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
@@ -565,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
@@ -619,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
;;
@@ -717,8 +714,7 @@ specific to a major mode. For example, in jde mode:
(defun semantic-idle-summary-useful-context-p ()
"Non-nil if we should show a summary based on context."
- (if (and (boundp 'font-lock-mode)
- font-lock-mode
+ (if (and font-lock-mode
(memq (get-text-property (point) 'face)
semantic-idle-summary-out-of-context-faces))
;; The best I can think of at the moment is to disable
@@ -823,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
@@ -900,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))
@@ -1233,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/imenu.el b/lisp/cedet/semantic/imenu.el
index 2898f37..4c13959 100644
--- a/lisp/cedet/semantic/imenu.el
+++ b/lisp/cedet/semantic/imenu.el
@@ -136,12 +136,11 @@ other buffer local ones based on the same semanticdb."
"Non-nil if `semantic-imenu-rebuild-directory-indexes' is running.")
;;;###autoload
-(defvar semantic-imenu-expandable-tag-classes '(type)
+(defvar-local semantic-imenu-expandable-tag-classes '(type)
"List of expandable tag classes.
Tags of those classes will be given submenu with children.
By default, a `type' has interesting children. In Texinfo, however, a
`section' has interesting children.")
-(make-variable-buffer-local 'semantic-imenu-expandable-tag-classes)
;;; Code:
(defun semantic-imenu-tag-overlay (tag)
diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el
index 8b83c09..408011c 100644
--- a/lisp/cedet/semantic/lex-spp.el
+++ b/lisp/cedet/semantic/lex-spp.el
@@ -73,28 +73,24 @@
(declare-function c-end-of-macro "cc-engine")
;;; Code:
-(defvar semantic-lex-spp-macro-symbol-obarray nil
+(defvar-local semantic-lex-spp-macro-symbol-obarray nil
"Table of macro keywords used by the Semantic Preprocessor.
These symbols will be used in addition to those in
`semantic-lex-spp-dynamic-macro-symbol-obarray'.")
-(make-variable-buffer-local 'semantic-lex-spp-macro-symbol-obarray)
-(defvar semantic-lex-spp-project-macro-symbol-obarray nil
+(defvar-local semantic-lex-spp-project-macro-symbol-obarray nil
"Table of macro keywords for this project.
These symbols will be used in addition to those in
`semantic-lex-spp-dynamic-macro-symbol-obarray'.")
-(make-variable-buffer-local 'semantic-lex-spp-project-macro-symbol-obarray)
-(defvar semantic-lex-spp-dynamic-macro-symbol-obarray nil
+(defvar-local semantic-lex-spp-dynamic-macro-symbol-obarray nil
"Table of macro keywords used during lexical analysis.
Macros are lexical symbols which are replaced by other lexical
tokens during lexical analysis. During analysis symbols can be
added and removed from this symbol table.")
-(make-variable-buffer-local 'semantic-lex-spp-dynamic-macro-symbol-obarray)
-(defvar semantic-lex-spp-dynamic-macro-symbol-obarray-stack nil
+(defvar-local semantic-lex-spp-dynamic-macro-symbol-obarray-stack nil
"A stack of obarrays for temporarily scoped macro values.")
-(make-variable-buffer-local
'semantic-lex-spp-dynamic-macro-symbol-obarray-stack)
(defvar semantic-lex-spp-expanded-macro-stack nil
"The stack of lexical SPP macros we have expanded.")
diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el
index 993c1dc..ae70d5c 100644
--- a/lisp/cedet/semantic/lex.el
+++ b/lisp/cedet/semantic/lex.el
@@ -202,10 +202,9 @@ as a PROPERTY value. FUN receives a symbol as argument."
;; These keywords are keywords defined for using in a grammar with the
;; %keyword declaration, and are not keywords used in Emacs Lisp.
-(defvar semantic-flex-keywords-obarray nil
+(defvar-local semantic-flex-keywords-obarray nil
"Buffer local keyword obarray for the lexical analyzer.
These keywords are matched explicitly, and converted into special symbols.")
-(make-variable-buffer-local 'semantic-flex-keywords-obarray)
(defmacro semantic-lex-keyword-invalid (name)
"Signal that NAME is an invalid keyword name."
@@ -333,9 +332,8 @@ so that analysis can continue, if possible."
;; with the %type declaration. Types represent different syntaxes.
;; See code for `semantic-lex-preset-default-types' for the classic
;; types of syntax.
-(defvar semantic-lex-types-obarray nil
+(defvar-local semantic-lex-types-obarray nil
"Buffer local types obarray for the lexical analyzer.")
-(make-variable-buffer-local 'semantic-lex-types-obarray)
(defun semantic-lex-type-invalid (type)
"Signal that TYPE is an invalid lexical type name."
@@ -471,12 +469,9 @@ PROPERTY set."
;;; Lexical Analyzer framework settings
;;
-;; FIXME change to non-obsolete default.
-(defvar 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'.")
-(make-variable-buffer-local 'semantic-lex-analyzer)
+See `semantic-lex' for documentation.")
(defvar semantic-lex-tokens
'(
@@ -558,7 +553,7 @@ The key to this alist is the symbol representing token type
that
- whitespace: Characters that match `\\s-+' regexp.
This token is produced with `semantic-lex-whitespace'.")
-(defvar semantic-lex-syntax-modifications nil
+(defvar-local semantic-lex-syntax-modifications nil
"Changes to the syntax table for this buffer.
These changes are active only while the buffer is being flexed.
This is a list where each element has the form:
@@ -566,20 +561,17 @@ This is a list where each element has the form:
CHAR is the char passed to `modify-syntax-entry',
and CLASS is the string also passed to `modify-syntax-entry' to define
what syntax class CHAR has.")
-(make-variable-buffer-local 'semantic-lex-syntax-modifications)
-(defvar semantic-lex-syntax-table nil
+(defvar-local semantic-lex-syntax-table nil
"Syntax table used by lexical analysis.
See also `semantic-lex-syntax-modifications'.")
-(make-variable-buffer-local 'semantic-lex-syntax-table)
-(defvar semantic-lex-comment-regex nil
+(defvar-local semantic-lex-comment-regex nil
"Regular expression for identifying comment start during lexical analysis.
This may be automatically set when semantic initializes in a mode, but
may need to be overridden for some special languages.")
-(make-variable-buffer-local 'semantic-lex-comment-regex)
-(defvar semantic-lex-number-expression
+(defvar-local semantic-lex-number-expression
;; This expression was written by David Ponce for Java, and copied
;; here for C and any other similar language.
(eval-when-compile
@@ -628,12 +620,10 @@ FLOATING_POINT_LITERAL:
| [0-9]+<EXPONENT>[fFdD]?
| [0-9]+<EXPONENT>?[fFdD]
;")
-(make-variable-buffer-local 'semantic-lex-number-expression)
-(defvar semantic-lex-depth 0
+(defvar-local semantic-lex-depth 0
"Default lexing depth.
This specifies how many lists to create tokens in.")
-(make-variable-buffer-local 'semantic-lex-depth)
(defvar semantic-lex-unterminated-syntax-end-function
(lambda (_syntax _syntax-start lex-end) lex-end)
@@ -1768,7 +1758,7 @@ when finding unterminated syntax.")
(make-obsolete-variable 'semantic-flex-unterminated-syntax-end-function
nil "28.1")
-(defvar semantic-flex-extensions nil
+(defvar-local semantic-flex-extensions nil
"Buffer local extensions to the lexical analyzer.
This should contain an alist with a key of a regex and a data element of
a function. The function should both move point, and return a lexical
@@ -1777,10 +1767,9 @@ token of the form:
nil is also a valid return value.
TYPE can be any type of symbol, as long as it doesn't occur as a
nonterminal in the language definition.")
-(make-variable-buffer-local 'semantic-flex-extensions)
(make-obsolete-variable 'semantic-flex-extensions nil "28.1")
-(defvar semantic-flex-syntax-modifications nil
+(defvar-local semantic-flex-syntax-modifications nil
"Changes to the syntax table for this buffer.
These changes are active only while the buffer is being flexed.
This is a list where each element has the form:
@@ -1788,47 +1777,40 @@ This is a list where each element has the form:
CHAR is the char passed to `modify-syntax-entry',
and CLASS is the string also passed to `modify-syntax-entry' to define
what syntax class CHAR has.")
-(make-variable-buffer-local 'semantic-flex-syntax-modifications)
(make-obsolete-variable 'semantic-flex-syntax-modifications nil "28.1")
-(defvar semantic-ignore-comments t
+(defvar-local semantic-ignore-comments t
"Default comment handling.
The value t means to strip comments when flexing; nil means
to keep comments as part of the token stream.")
-(make-variable-buffer-local 'semantic-ignore-comments)
(make-obsolete-variable 'semantic-ignore-comments nil "28.1")
-(defvar semantic-flex-enable-newlines nil
+(defvar-local semantic-flex-enable-newlines nil
"When flexing, report newlines as syntactic elements.
Useful for languages where the newline is a special case terminator.
Only set this on a per mode basis, not globally.")
-(make-variable-buffer-local 'semantic-flex-enable-newlines)
(make-obsolete-variable 'semantic-flex-enable-newlines nil "28.1")
-(defvar semantic-flex-enable-whitespace nil
+(defvar-local semantic-flex-enable-whitespace nil
"When flexing, report whitespace as syntactic elements.
Useful for languages where the syntax is whitespace dependent.
Only set this on a per mode basis, not globally.")
-(make-variable-buffer-local 'semantic-flex-enable-whitespace)
(make-obsolete-variable 'semantic-flex-enable-whitespace nil "28.1")
-(defvar semantic-flex-enable-bol nil
+(defvar-local semantic-flex-enable-bol nil
"When flexing, report beginning of lines as syntactic elements.
Useful for languages like python which are indentation sensitive.
Only set this on a per mode basis, not globally.")
-(make-variable-buffer-local 'semantic-flex-enable-bol)
(make-obsolete-variable 'semantic-flex-enable-bol nil "28.1")
-(defvar semantic-number-expression semantic-lex-number-expression
+(defvar-local semantic-number-expression semantic-lex-number-expression
"See variable `semantic-lex-number-expression'.")
-(make-variable-buffer-local 'semantic-number-expression)
(make-obsolete-variable 'semantic-number-expression
'semantic-lex-number-expression "28.1")
-(defvar semantic-flex-depth 0
+(defvar-local semantic-flex-depth 0
"Default flexing depth.
This specifies how many lists to create tokens in.")
-(make-variable-buffer-local 'semantic-flex-depth)
(make-obsolete-variable 'semantic-flex-depth nil "28.1")
(provide 'semantic/lex)
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/senator.el b/lisp/cedet/semantic/senator.el
index 6768b43..f33356a 100644
--- a/lisp/cedet/semantic/senator.el
+++ b/lisp/cedet/semantic/senator.el
@@ -601,10 +601,9 @@ Makes C/C++ language like assumptions."
)
(t nil)))
-(defvar senator-isearch-semantic-mode nil
+(defvar-local senator-isearch-semantic-mode nil
"Non-nil if isearch does semantic search.
This is a buffer local variable.")
-(make-variable-buffer-local 'senator-isearch-semantic-mode)
(defun senator-beginning-of-defun (&optional arg)
"Move backward to the beginning of a defun.
diff --git a/lisp/cedet/semantic/sort.el b/lisp/cedet/semantic/sort.el
index 154a56a..19f46ff 100644
--- a/lisp/cedet/semantic/sort.el
+++ b/lisp/cedet/semantic/sort.el
@@ -310,11 +310,10 @@ may re-organize the list with side-effects."
;; external members, and bring them together in a cloned copy of the
;; class tag.
;;
-(defvar semantic-orphaned-member-metaparent-type "class"
+(defvar-local semantic-orphaned-member-metaparent-type "class"
"In `semantic-adopt-external-members', the type of 'type for metaparents.
A metaparent is a made-up type semantic token used to hold the child list
of orphaned members of a named type.")
-(make-variable-buffer-local 'semantic-orphaned-member-metaparent-type)
(defvar semantic-mark-external-member-function nil
"Function called when an externally defined orphan is found.
diff --git a/lisp/cedet/semantic/tag.el b/lisp/cedet/semantic/tag.el
index d68ffa5..85defe4 100644
--- a/lisp/cedet/semantic/tag.el
+++ b/lisp/cedet/semantic/tag.el
@@ -1194,7 +1194,7 @@ See also the function `semantic--expand-tag'."
(setq tag (cdr tag)))
(null tag)))
-(defvar semantic-tag-expand-function nil
+(defvar-local semantic-tag-expand-function nil
"Function used to expand a tag.
It is passed each tag production, and must return a list of tags
derived from it, or nil if it does not need to be expanded.
@@ -1207,7 +1207,6 @@ following definition is easily parsed into one tag:
This function should take this compound tag and turn it into two tags,
one for A, and the other for B.")
-(make-variable-buffer-local 'semantic-tag-expand-function)
(defun semantic--tag-expand (tag)
"Convert TAG from a raw state to a cooked state, and expand it.
diff --git a/lisp/cedet/semantic/util-modes.el
b/lisp/cedet/semantic/util-modes.el
index 45eef10..0de66d2 100644
--- a/lisp/cedet/semantic/util-modes.el
+++ b/lisp/cedet/semantic/util-modes.el
@@ -498,10 +498,9 @@ non-nil if the minor mode is enabled."
(semantic-add-minor-mode 'semantic-show-parser-state-mode
"")
-(defvar semantic-show-parser-state-string nil
+(defvar-local semantic-show-parser-state-string nil
"String showing the parser state for this buffer.
See `semantic-show-parser-state-marker' for details.")
-(make-variable-buffer-local 'semantic-show-parser-state-string)
(defun semantic-show-parser-state-marker (&rest ignore)
"Set `semantic-show-parser-state-string' to indicate parser state.
@@ -692,10 +691,6 @@ non-nil if the minor mode is enabled."
;; Disable minor mode if semantic stuff not available
(setq semantic-stickyfunc-mode nil)
(error "Buffer %s was not set up for parsing" (buffer-name)))
- (unless (boundp 'header-line-format)
- ;; Disable if there are no header lines to use.
- (setq semantic-stickyfunc-mode nil)
- (error "Sticky Function mode requires Emacs"))
;; Enable the mode
;; Save previous buffer local value of header line format.
(when (and (local-variable-p 'header-line-format (current-buffer))
@@ -713,10 +708,9 @@ non-nil if the minor mode is enabled."
(setq header-line-format semantic-stickyfunc-old-hlf)
(kill-local-variable 'semantic-stickyfunc-old-hlf)))))
-(defvar semantic-stickyfunc-sticky-classes
+(defvar-local semantic-stickyfunc-sticky-classes
'(function type)
"List of tag classes which stickyfunc will display in the header line.")
-(make-variable-buffer-local 'semantic-stickyfunc-sticky-classes)
(defcustom semantic-stickyfunc-show-only-functions-p nil
"Non-nil means don't show lines that aren't part of a tag.
@@ -886,9 +880,8 @@ Argument EVENT describes the event that caused this
function to be called."
)
(select-window startwin)))
-(defvar semantic-highlight-func-ct-overlay nil
+(defvar-local semantic-highlight-func-ct-overlay nil
"Overlay used to highlight the tag the cursor is in.")
-(make-variable-buffer-local 'semantic-highlight-func-ct-overlay)
(defface semantic-highlight-func-current-tag-face
'((((class color) (background dark))
diff --git a/lisp/cedet/semantic/util.el b/lisp/cedet/semantic/util.el
index 7d33d0e..8c487e1 100644
--- a/lisp/cedet/semantic/util.el
+++ b/lisp/cedet/semantic/util.el
@@ -39,20 +39,18 @@
;;; Code:
-(defvar semantic-type-relation-separator-character '(".")
+(defvar-local semantic-type-relation-separator-character '(".")
"Character strings used to separate a parent/child relationship.
This list of strings are used for displaying or finding separators
in variable field dereferencing. The first character will be used for
display. In C, a type field is separated like this: \"type.field\"
thus, the character is a \".\". In C, and additional value of \"->\"
would be in the list, so that \"type->field\" could be found.")
-(make-variable-buffer-local 'semantic-type-relation-separator-character)
-(defvar semantic-equivalent-major-modes nil
+(defvar-local semantic-equivalent-major-modes nil
"List of major modes which are considered equivalent.
Equivalent modes share a parser, and a set of override methods.
A value of nil means that the current major mode is the only one.")
-(make-variable-buffer-local 'semantic-equivalent-major-modes)
(declare-function semanticdb-file-stream "semantic/db" (file))
diff --git a/lisp/cedet/semantic/wisent.el b/lisp/cedet/semantic/wisent.el
index fb4d0b0..d5b7324 100644
--- a/lisp/cedet/semantic/wisent.el
+++ b/lisp/cedet/semantic/wisent.el
@@ -93,15 +93,13 @@ it to a form suitable for the Wisent's parser."
;;; Syntax analysis
;;
-(defvar wisent-error-function nil
+(defvar-local wisent-error-function nil
"Function used to report parse error.
By default use the function `wisent-message'.")
-(make-variable-buffer-local 'wisent-error-function)
-(defvar wisent-lexer-function 'wisent-lex
+(defvar-local wisent-lexer-function 'wisent-lex
"Function used to obtain the next lexical token in input.
Should be a lexical analyzer created with `define-wisent-lexer'.")
-(make-variable-buffer-local 'wisent-lexer-function)
;; Tag production
;;
diff --git a/lisp/color.el b/lisp/color.el
index 258acbe..fec36ee 100644
--- a/lisp/color.el
+++ b/lisp/color.el
@@ -33,11 +33,6 @@
;;; Code:
-;; Emacs < 23.3
-(eval-and-compile
- (unless (boundp 'float-pi)
- (defconst float-pi (* 4 (atan 1)) "The value of Pi (3.1415926...).")))
-
;;;###autoload
(defun color-name-to-rgb (color &optional frame)
"Convert COLOR string to a list of normalized RGB components.
diff --git a/lisp/comint.el b/lisp/comint.el
index e52d67d..57df6bf 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -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)
@@ -2253,15 +2252,23 @@ This function could be on
`comint-output-filter-functions' or bound to a key."
"Strip trailing `^M' characters from the current output group.
This function could be on `comint-output-filter-functions' or bound to a key."
(interactive)
- (let ((pmark (process-mark (get-buffer-process (current-buffer)))))
- (save-excursion
- (condition-case nil
- (goto-char
- (if (called-interactively-p 'interactive)
- comint-last-input-end comint-last-output-start))
- (error nil))
- (while (re-search-forward "\r+$" pmark t)
- (replace-match "" t t)))))
+ (let ((process (get-buffer-process (current-buffer))))
+ (if (not process)
+ ;; This function may be used in
+ ;; `comint-output-filter-functions', and in that case, if
+ ;; there's no process, then we should do nothing. If
+ ;; interactive, report an error.
+ (when (called-interactively-p 'interactive)
+ (error "No process in the current buffer"))
+ (let ((pmark (process-mark process)))
+ (save-excursion
+ (condition-case nil
+ (goto-char
+ (if (called-interactively-p 'interactive)
+ comint-last-input-end comint-last-output-start))
+ (error nil))
+ (while (re-search-forward "\r+$" pmark t)
+ (replace-match "" t t)))))))
(define-obsolete-function-alias 'shell-strip-ctrl-m #'comint-strip-ctrl-m
"27.1")
(defun comint-show-maximum-output ()
@@ -2375,12 +2382,11 @@ a buffer local variable."
;; saved -- typically passwords to ftp, telnet, or somesuch.
;; Just enter m-x comint-send-invisible and type in your line.
-(defvar comint-password-function nil
+(defvar-local comint-password-function nil
"Abnormal hook run when prompted for a password.
This function gets one argument, a string containing the prompt.
It may return a string containing the password, or nil if normal
password prompting should occur.")
-(make-variable-buffer-local 'comint-password-function)
(defun comint-send-invisible (&optional prompt)
"Read a string without echoing.
diff --git a/lisp/completion.el b/lisp/completion.el
index 8810a22..da2fb38 100644
--- a/lisp/completion.el
+++ b/lisp/completion.el
@@ -505,9 +505,8 @@ Used to decide whether to save completions.")
;; Old name, non-namespace-clean.
(defvaralias 'cmpl-syntax-table 'completion-syntax-table)
-(defvar completion-syntax-table completion-standard-syntax-table
+(defvar-local completion-syntax-table completion-standard-syntax-table
"This variable holds the current completion syntax table.")
-(make-variable-buffer-local 'completion-syntax-table)
;;-----------------------------------------------
;; Symbol functions
diff --git a/lisp/cus-dep.el b/lisp/cus-dep.el
index 60dc0a9..e2b7351 100644
--- a/lisp/cus-dep.el
+++ b/lisp/cus-dep.el
@@ -179,7 +179,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
@@ -240,7 +240,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 e52df4e..dde6e89 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/custom.el b/lisp/custom.el
index 5e354c4..8338107 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -350,7 +350,7 @@ for more information."
;; if you need to recompile all the Lisp files using interpreted code.
`(custom-declare-variable
',symbol
- ,(if lexical-binding ;FIXME: This is not reliable, but is all we have.
+ ,(if lexical-binding
;; The STANDARD arg should be an expression that evaluates to
;; the standard value. The use of `eval' for it is spread
;; over many different places and hence difficult to
@@ -627,6 +627,10 @@ property, or (ii) an alias for another customizable
variable."
(or (get variable 'standard-value)
(get variable 'custom-autoload))))
+(defun custom--standard-value (variable)
+ "Return the standard value of VARIABLE."
+ (eval (car (get variable 'standard-value)) t))
+
(define-obsolete-function-alias 'user-variable-p 'custom-variable-p "24.3")
(defun custom-note-var-changed (variable)
diff --git a/lisp/dframe.el b/lisp/dframe.el
index 09d2fe4..e61d2ea 100644
--- a/lisp/dframe.el
+++ b/lisp/dframe.el
@@ -5,10 +5,6 @@
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: file, tags, tools
-(defvar dframe-version "1.3"
- "The current version of the dedicated frame library.")
-(make-obsolete-variable 'dframe-version nil "28.1")
-
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
@@ -150,42 +146,35 @@ selected frame and the focus will change to that frame."
:group 'dframe
:type 'hook)
-(defvar dframe-track-mouse-function nil
+(defvar-local dframe-track-mouse-function nil
"A function to call when the mouse is moved in the given frame.
Typically used to display info about the line under the mouse.")
-(make-variable-buffer-local 'dframe-track-mouse-function)
-(defvar dframe-help-echo-function nil
+(defvar-local dframe-help-echo-function nil
"A function to call when help-echo is used in newer versions of Emacs.
Typically used to display info about the line under the mouse.")
-(make-variable-buffer-local 'dframe-help-echo-function)
-(defvar dframe-mouse-click-function nil
+(defvar-local dframe-mouse-click-function nil
"A function to call when the mouse is clicked.
Valid clicks are mouse 2, our double mouse 1.")
-(make-variable-buffer-local 'dframe-mouse-click-function)
-(defvar dframe-mouse-position-function nil
+(defvar-local dframe-mouse-position-function nil
"A function to call to position the cursor for a mouse click.")
-(make-variable-buffer-local 'dframe-mouse-position-function)
(defvar dframe-power-click nil
"Never set this by hand. Value is t when S-mouse activity occurs.")
-(defvar dframe-timer nil
+(defvar-local dframe-timer nil
"The dframe timer used for updating the buffer.")
-(make-variable-buffer-local 'dframe-timer)
-(defvar dframe-attached-frame nil
+(defvar-local dframe-attached-frame nil
"The frame which started a frame mode.
This is the frame from which all interesting activities will go
for the mode using dframe.")
-(make-variable-buffer-local 'dframe-attached-frame)
-(defvar dframe-controlled nil
+(defvar-local dframe-controlled nil
"Is this buffer controlled by a dedicated frame.
Local to those buffers, as a function called that created it.")
-(make-variable-buffer-local 'dframe-controlled)
(defun dframe-update-keymap (map)
"Update the keymap MAP for dframe default bindings."
@@ -686,28 +675,26 @@ Evaluates all cached timer functions in sequence."
(funcall (car l)))
(setq l (cdr l)))))
-(defalias 'dframe-popup-kludge
- (lambda (e)
- "Pop up a menu related to the clicked on item.
+(defun dframe-popup-kludge (e)
+ "Pop up a menu related to the clicked on item.
Must be bound to event E."
- (interactive "e")
- (save-excursion
- (mouse-set-point e)
- ;; This gets the cursor where the user can see it.
- (if (not (bolp)) (forward-char -1))
- (sit-for 0)
- (popup-menu (mouse-menu-major-mode-map) e))))
+ (interactive "e")
+ (save-excursion
+ (mouse-set-point e)
+ ;; This gets the cursor where the user can see it.
+ (if (not (bolp)) (forward-char -1))
+ (sit-for 0)
+ (popup-menu (mouse-menu-major-mode-map) e)))
;;; Interactive user functions for the mouse
;;
-(defalias 'dframe-mouse-event-p
- (lambda (event)
- "Return t if the event is a mouse related event."
- (if (and (listp event)
- (member (event-basic-type event)
- '(mouse-1 mouse-2 mouse-3)))
- t
- nil)))
+(defun dframe-mouse-event-p (event)
+ "Return t if the event is a mouse related event."
+ (if (and (listp event)
+ (member (event-basic-type event)
+ '(mouse-1 mouse-2 mouse-3)))
+ t
+ nil))
(defun dframe-track-mouse (event)
"For motion EVENT, display info about the current line."
@@ -836,6 +823,13 @@ the mode-line."
(t (dframe-message
"Click on the edge of the mode line to scroll left/right")))))
+
+;;; Obsolete
+
+(defvar dframe-version "1.3"
+ "The current version of the dedicated frame library.")
+(make-obsolete-variable 'dframe-version nil "28.1")
+
(provide 'dframe)
;;; dframe.el ends here
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index ec864d5..a94bdf5 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -3148,7 +3148,7 @@ REGEXP should use constructs supported by your local
`grep' command."
(with-current-buffer
(let ((xref-show-xrefs-function
;; Some future-proofing (bug#44905).
- (eval (car (get 'xref-show-xrefs-function 'standard-value)))))
+ (custom--standard-value 'xref-show-xrefs-function)))
(dired-do-find-regexp from))
(xref-query-replace-in-results from to)))
diff --git a/lisp/dired.el b/lisp/dired.el
index fe6ac1e..553fb64 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -2332,19 +2332,9 @@ to relist the file at point or the marked files or a
subdirectory, or type \\[dired-build-subdir-alist] to parse the buffer
again for the directory tree.
-Customization variables (rename this buffer and type \\[describe-variable] on
each line
-for more info):
-
- `dired-listing-switches'
- `dired-trivial-filenames'
- `dired-marker-char'
- `dired-del-marker'
- `dired-keep-marker-rename'
- `dired-keep-marker-copy'
- `dired-keep-marker-hardlink'
- `dired-keep-marker-symlink'
-
-Hooks (use \\[describe-variable] to see their documentation):
+See the `dired' customization group for a list of user options.
+
+This mode runs the following hooks:
`dired-before-readin-hook'
`dired-after-readin-hook'
diff --git a/lisp/double.el b/lisp/double.el
index 8bbbaa5..7bc8d92 100644
--- a/lisp/double.el
+++ b/lisp/double.el
@@ -95,8 +95,7 @@ but not `C-u X' or `ESC X' since the X is not the prefix key."
(global-set-key [ignore] 'ignore)
-(or (boundp 'isearch-mode-map)
- (load-library "isearch"))
+(require 'isearch)
(define-key isearch-mode-map [ignore]
(lambda () (interactive) (isearch-update)))
@@ -141,12 +140,6 @@ but not `C-u X' or `ESC X' since the X is not the prefix
key."
;;; Mode
-;; This feature seemed useless and it confused describe-mode,
-;; so I deleted it.
-;; (defvar double-mode-name "Double")
-;; ;; Name of current double mode.
-;; (make-variable-buffer-local 'double-mode-name)
-
;;;###autoload
(define-minor-mode double-mode
"Toggle special insertion on double keypresses (Double mode).
diff --git a/lisp/ehelp.el b/lisp/ehelp.el
index 996b7db..aa809d6 100644
--- a/lisp/ehelp.el
+++ b/lisp/ehelp.el
@@ -95,8 +95,7 @@
map)
"Keymap defining commands available in `electric-help-mode'.")
-(defvar electric-help-orig-major-mode nil)
-(make-variable-buffer-local 'electric-help-orig-major-mode)
+(defvar-local electric-help-orig-major-mode nil)
(defun electric-help-mode ()
"`with-electric-help' temporarily places its buffer in this mode.
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 66a117f..8851f0e 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,54 @@
(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'"))
+ ;; The test is always executed.
+ (let* ((test-opt (byte-optimize-form test nil))
+ ;; The THEN and ELSE branches are executed conditionally.
+ ;;
+ ;; FIXME: We are conservative here: any variable changed in the
+ ;; THEN branch will be barred from substitution in the ELSE
+ ;; branch, despite the branches being mutually exclusive.
+ (byte-optimize--vars-outside-condition byte-optimize--lexvars)
+ (then-opt (byte-optimize-form then for-effect))
+ (else-opt (byte-optimize-body else for-effect)))
+ `(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 +517,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 +556,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 +576,36 @@
;; 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
+ ;; If it's bound outside conditional, invalidate.
+ (if (assq var byte-optimize--vars-outside-condition)
+ ;; We are in conditional code and the variable was
+ ;; bound outside: cancel substitutions.
+ (setcdr (cdr lexvar) nil)
+ ;; Set a new value (if substitutable).
+ (setcdr (cdr lexvar)
+ (and (byte-optimize--substitutable-p value)
+ (list value))))
+ (setcar (cdr lexvar) t)) ; Mark variable to be kept.
+ (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)))
@@ -582,6 +663,66 @@
new)
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)
;; Optimize the cdr of a progn or implicit progn; all forms is a list of
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index c0f8db6..709a310 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
@@ -3365,7 +3364,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 2cd7322..7d760ff 100644
--- a/lisp/emacs-lisp/chart.el
+++ b/lisp/emacs-lisp/chart.el
@@ -67,9 +67,8 @@
(define-obsolete-variable-alias 'chart-map 'chart-mode-map "24.1")
(defvar chart-mode-map (make-sparse-keymap) "Keymap used in chart mode.")
-(defvar chart-local-object nil
+(defvar-local chart-local-object nil
"Local variable containing the locally displayed chart object.")
-(make-variable-buffer-local 'chart-local-object)
(defvar chart-face-color-list '("red" "green" "blue"
"cyan" "yellow" "purple")
diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el
index 9722792..75aefdc 100644
--- a/lisp/emacs-lisp/checkdoc.el
+++ b/lisp/emacs-lisp/checkdoc.el
@@ -147,13 +147,6 @@
;;
;; See the above section "Checking Parameters" for details about
;; parameter checking.
-;;
-;; Dependencies:
-;;
-;; This file requires lisp-mnt (Lisp maintenance routines) for the
-;; comment checkers.
-;;
-;; Requires custom for Emacs v20.
;;; TO DO:
;; Hook into the byte compiler on a defun/defvar level to generate
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index f4dbcee..2916ae4 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -278,11 +278,10 @@ For example, you could write
((not globalp)
`(progn
:autoload-end
- (defvar ,mode ,init-value
+ (defvar-local ,mode ,init-value
,(concat (format "Non-nil if %s is enabled.\n" pretty-name)
(internal--format-docstring-line
- "Use the command `%s' to change this variable."
mode)))
- (make-variable-buffer-local ',mode)))
+ "Use the command `%s' to change this variable."
mode)))))
(t
(let ((base-doc-string
(concat "Non-nil if %s is enabled.
@@ -419,6 +418,7 @@ on if the hook has explicitly disabled it.
(pretty-global-name (easy-mmode-pretty-mode-name global-mode))
(group nil)
(extra-keywords nil)
+ (MODE-variable mode)
(MODE-buffers (intern (concat global-mode-name "-buffers")))
(MODE-enable-in-buffers
(intern (concat global-mode-name "-enable-in-buffers")))
@@ -440,6 +440,7 @@ on if the hook has explicitly disabled it.
(pcase keyw
(:group (setq group (nconc group (list :group (pop body)))))
(:global (pop body))
+ (:variable (setq MODE-variable (pop body)))
(:predicate
(setq predicate (list (pop body)))
(setq turn-on-function
@@ -453,8 +454,7 @@ on if the hook has explicitly disabled it.
(progn
(put ',global-mode 'globalized-minor-mode t)
:autoload-end
- (defvar ,MODE-major-mode nil)
- (make-variable-buffer-local ',MODE-major-mode))
+ (defvar-local ,MODE-major-mode nil))
;; The actual global minor-mode
(define-minor-mode ,global-mode
,(concat (format "Toggle %s in all buffers.\n" pretty-name)
@@ -543,7 +543,7 @@ list."
(with-current-buffer buf
(unless ,MODE-set-explicitly
(unless (eq ,MODE-major-mode major-mode)
- (if ,mode
+ (if ,MODE-variable
(progn
(,mode -1)
(funcall ,turn-on-function))
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index 1ded0e7..0733dce 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -341,7 +341,7 @@ Return the result of the last expression in BODY."
;; FIXME: We should probably just be using `pop-to-buffer'.
(setq window
(cond
- ((and (edebug-window-live-p window)
+ ((and (window-live-p window)
(eq (window-buffer window) buffer))
window)
((eq (window-buffer) buffer)
@@ -392,7 +392,7 @@ Return the result of the last expression in BODY."
;; Get either a full window configuration or some window information.
(if (listp which-windows)
(mapcar (lambda (window)
- (if (edebug-window-live-p window)
+ (if (window-live-p window)
(list window
(window-buffer window)
(window-point window)
@@ -407,7 +407,7 @@ Return the result of the last expression in BODY."
(mapcar (lambda (one-window-info)
(if one-window-info
(apply (lambda (window buffer point start hscroll)
- (if (edebug-window-live-p window)
+ (if (window-live-p window)
(progn
(set-window-buffer window buffer)
(set-window-point window point)
@@ -1687,10 +1687,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--handle-&-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,16 +1721,10 @@ 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)
@@ -1743,9 +1737,6 @@ contains a circular object."
(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.
@@ -1793,7 +1784,7 @@ contains a circular object."
(defsubst edebug-match-body (cursor) (edebug-forms cursor))
-(defun edebug-match-&optional (cursor specs)
+(cl-defmethod edebug--handle-&-spec-op ((_ (eql &optional)) cursor specs)
;; Keep matching until one spec fails.
(edebug-&optional-wrapper cursor specs 'edebug-&optional-wrapper))
@@ -1819,7 +1810,11 @@ contains a circular object."
;; Reuse the &optional handler with this as the remainder handler.
(edebug-&optional-wrapper cursor specs remainder-handler))
-(defun edebug-match-&rest (cursor specs)
+(cl-defgeneric edebug--handle-&-spec-op (op cursor specs)
+ "Handle &foo spec operators.
+&foo spec operators operate on all the subsequent SPECS.")
+
+(cl-defmethod edebug--handle-&-spec-op ((_ (eql &rest)) cursor specs)
;; Repeatedly use specs until failure.
(let ((edebug-&rest specs) ;; remember these
edebug-best-error
@@ -1827,7 +1822,7 @@ contains a circular object."
(edebug-&rest-wrapper cursor specs 'edebug-&rest-wrapper)))
-(defun edebug-match-&or (cursor specs)
+(cl-defmethod edebug--handle-&-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.
@@ -1852,23 +1847,24 @@ contains a circular object."
))
-(defun edebug-match-¬ (cursor specs)
+(cl-defmethod edebug--handle-&-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--handle-&-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--handle-&-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--handle-&-spec-op
+ '&rest
cursor
(cons '&or
(mapcar (lambda (pair)
@@ -1876,7 +1872,7 @@ contains a circular object."
(car (cdr pair))))
specs))))
-(defun edebug-match-&error (cursor specs)
+(cl-defmethod edebug--handle-&-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)))
@@ -1980,7 +1976,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--handle-&-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
@@ -2034,7 +2030,11 @@ contains a circular object."
(edebug-move-cursor cursor)
(list name)))
-(defun edebug-match-colon-name (_cursor spec)
+(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 +2043,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)))
@@ -2641,12 +2641,11 @@ See `edebug-behavior-alist' for implementations.")
;; window-start now stored with each function.
-;;(defvar edebug-window-start nil)
+;;(defvar-local edebug-window-start nil)
;; Remember where each buffers' window starts between edebug calls.
;; This is to avoid spurious recentering.
;; Does this still need to be buffer-local??
;;(setq-default edebug-window-start nil)
-;;(make-variable-buffer-local 'edebug-window-start)
;; Dynamically declared unbound vars
@@ -2689,7 +2688,7 @@ See `edebug-behavior-alist' for implementations.")
(edebug-outside-window (selected-window))
(edebug-outside-buffer (current-buffer))
(edebug-outside-point (point))
- (edebug-outside-mark (edebug-mark))
+ (edebug-outside-mark (mark t))
edebug-outside-windows ; Window or screen configuration.
edebug-buffer-points
@@ -2858,7 +2857,7 @@ See `edebug-behavior-alist' for implementations.")
;; Unrestore edebug-buffer's window-start, if displayed.
(let ((window (car edebug-window-data)))
- (if (and (edebug-window-live-p window)
+ (if (and (window-live-p window)
(eq (window-buffer) edebug-buffer))
(progn
(set-window-start window (cdr edebug-window-data)
@@ -2877,7 +2876,7 @@ See `edebug-behavior-alist' for implementations.")
;; Since we may be in a save-excursion, in case of quit,
;; reselect the outside window only.
;; Only needed if we are not recovering windows??
- (if (edebug-window-live-p edebug-outside-window)
+ (if (window-live-p edebug-outside-window)
(select-window edebug-outside-window))
) ; if edebug-save-windows
@@ -3802,9 +3801,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.
@@ -4541,11 +4541,6 @@ It is removed when you hit any char."
;;; Emacs version specific code
-(defalias 'edebug-window-live-p 'window-live-p)
-
-(defun edebug-mark ()
- (mark t))
-
(defun edebug-set-conditional-breakpoint (arg condition)
"Set a conditional breakpoint at nearest sexp.
The condition is evaluated in the outside context.
@@ -4661,7 +4656,15 @@ instrumentation for, defaulting to all functions."
(message "Removed edebug instrumentation from %s"
(mapconcat #'symbol-name functions ", ")))
+
+;;; Obsolete.
+
+(defun edebug-mark ()
+ (declare (obsolete mark "28.1"))
+ (mark t))
+
(define-obsolete-function-alias 'edebug-mark-marker #'mark-marker "28.1")
+(define-obsolete-function-alias 'edebug-window-live-p #'window-live-p "28.1")
(provide 'edebug)
;;; edebug.el ends here
diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el
index f551c0c..cc2927c 100644
--- a/lisp/emacs-lisp/elp.el
+++ b/lisp/emacs-lisp/elp.el
@@ -110,8 +110,7 @@
;; Boy Jim's profiler.el. Both were written for Emacs 18 and both were
;; pretty good first shots at profiling, but I found that they didn't
;; provide the functionality or interface that I wanted, so I wrote
-;; this. I've tested elp in XEmacs 19 and Emacs 19. There's no point
-;; in even trying to make this work with Emacs 18.
+;; this.
;; Unlike previous profilers, elp uses Emacs 19's built-in function
;; current-time to return interval times. This obviates the need for
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/generic.el b/lisp/emacs-lisp/generic.el
index 6db1bbb..294aba6 100644
--- a/lisp/emacs-lisp/generic.el
+++ b/lisp/emacs-lisp/generic.el
@@ -96,9 +96,8 @@
;; Internal Variables
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defvar generic-font-lock-keywords nil
+(defvar-local generic-font-lock-keywords nil
"Keywords for `font-lock-defaults' in a generic mode.")
-(make-variable-buffer-local 'generic-font-lock-keywords)
;;;###autoload
(defvar generic-mode-list nil
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 3918fa0..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)
@@ -775,7 +772,8 @@ or to switch back to an existing one."
(setq-local find-tag-default-function 'lisp-find-tag-default)
(setq-local comment-start-skip
"\\(\\(^\\|[^\\\n]\\)\\(\\\\\\\\\\)*\\)\\(;+\\|#|\\) *")
- (setq-local comment-end "|#")
+ (setq-local comment-end-skip "[ \t]*\\(\\s>\\||#\\)")
+ (setq-local font-lock-comment-end-skip "|#")
(setq imenu-case-fold-search t))
(defun lisp-find-tag-default ()
@@ -1372,7 +1370,24 @@ and initial semicolons."
(derived-mode-p 'emacs-lisp-mode))
emacs-lisp-docstring-fill-column
fill-column)))
- (fill-paragraph justify))
+ (save-restriction
+ (save-excursion
+ (let ((ppss (syntax-ppss)))
+ ;; If we're in a string, then narrow (roughly) to that
+ ;; string before filling. This avoids filling Lisp
+ ;; statements that follow the string.
+ (when (ppss-string-terminator ppss)
+ (goto-char (ppss-comment-or-string-start ppss))
+ (beginning-of-line)
+ ;; The string may be unterminated -- in that case, don't
+ ;; narrow.
+ (when (ignore-errors
+ (progn
+ (forward-sexp 1)
+ t))
+ (narrow-to-region (ppss-comment-or-string-start ppss)
+ (point))))
+ (fill-paragraph justify)))))
;; Never return nil.
t))
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index e842222..042061c 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'.
@@ -245,12 +308,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)
diff --git a/lisp/emacs-lisp/package-x.el b/lisp/emacs-lisp/package-x.el
index b723643..2e327d1 100644
--- a/lisp/emacs-lisp/package-x.el
+++ b/lisp/emacs-lisp/package-x.el
@@ -182,8 +182,7 @@ if it exists."
;; Check if `package-archive-upload-base' is valid.
(when (or (not (stringp package-archive-upload-base))
(equal package-archive-upload-base
- (car-safe
- (get 'package-archive-upload-base 'standard-value))))
+ (custom--standard-value 'package-archive-upload-base)))
(setq package-archive-upload-base
(read-directory-name
"Base directory for package archive: ")))
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index cf129c4..ec746fa 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -135,7 +135,6 @@ PATTERN matches. PATTERN can take one of the forms:
(pred (not FUN)) matches if FUN called on EXPVAL returns nil.
(app FUN PAT) matches if FUN called on EXPVAL matches PAT.
(guard BOOLEXP) matches if BOOLEXP evaluates to non-nil.
- (let PAT EXPR) matches if EXPR matches PAT.
(and PAT...) matches if all the patterns match.
(or PAT...) matches if any of the patterns matches.
@@ -145,7 +144,7 @@ FUN in `pred' and `app' can take one of the forms:
(F ARG1 .. ARGn)
call F with ARG1..ARGn and EXPVAL as n+1'th argument
-FUN, BOOLEXP, EXPR, and subsequent PAT can refer to variables
+FUN, BOOLEXP, and subsequent PAT can refer to variables
bound earlier in the pattern by a SYMBOL pattern.
Additional patterns can be defined using `pcase-defmacro'.
@@ -426,7 +425,6 @@ of the elements of LIST is performed as if by `pcase-let'.
(if (pcase--self-quoting-p pat) `',pat pat))
((memq head '(pred guard quote)) pat)
((memq head '(or and)) `(,head ,@(mapcar #'pcase--macroexpand (cdr pat))))
- ((eq head 'let) `(let ,(pcase--macroexpand (cadr pat)) ,@(cddr pat)))
((eq head 'app) `(app ,(nth 1 pat) ,(pcase--macroexpand (nth 2 pat))))
(t
(let* ((expander (pcase--get-macroexpander head))
@@ -888,18 +886,9 @@ Otherwise, it defers to REST which is a list of branches
of the form
(if (not (assq upat vars))
(pcase--u1 matches code (cons (cons upat sym) vars) rest)
;; Non-linear pattern. Turn it into an `eq' test.
- (pcase--u1 (cons `(match ,sym . (pred (eq ,(cdr (assq upat vars)))))
+ (pcase--u1 (cons `(match ,sym . (pred (eql ,(cdr (assq upat vars)))))
matches)
code vars rest)))
- ((eq (car-safe upat) 'let)
- ;; A upat of the form (let VAR EXP).
- ;; (pcase--u1 matches code
- ;; (cons (cons (nth 1 upat) (nth 2 upat)) vars) rest)
- (macroexp-let2
- macroexp-copyable-p sym
- (pcase--eval (nth 2 upat) vars)
- (pcase--u1 (cons (pcase--match sym (nth 1 upat)) matches)
- code vars rest)))
((eq (car-safe upat) 'app)
;; A upat of the form (app FUN PAT)
(pcase--mark-used sym)
@@ -1011,5 +1000,9 @@ The predicate is the logical-AND of:
;; compounded values that are not `consp'
(t (error "Unknown QPAT: %S" qpat))))
+(pcase-defmacro let (pat expr)
+ "Matches if EXPR matches PAT."
+ `(app (lambda (_) ,expr) ,pat))
+
(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/re-builder.el b/lisp/emacs-lisp/re-builder.el
index 23221a2..ce8d98d 100644
--- a/lisp/emacs-lisp/re-builder.el
+++ b/lisp/emacs-lisp/re-builder.el
@@ -187,14 +187,14 @@ Set it to nil if you don't want limits here."
(defvar reb-target-window nil
"Window to which the RE is applied to.")
-(defvar reb-regexp nil
+(defvar-local reb-regexp nil
"Last regexp used by RE Builder.")
-(defvar reb-regexp-src nil
+(defvar-local reb-regexp-src nil
"Last regexp used by RE Builder before processing it.
Except for Lisp syntax this is the same as `reb-regexp'.")
-(defvar reb-overlays nil
+(defvar-local reb-overlays nil
"List of overlays of the RE Builder.")
(defvar reb-window-config nil
@@ -212,10 +212,6 @@ Except for Lisp syntax this is the same as `reb-regexp'.")
(defvar reb-valid-string ""
"String in mode line showing validity of RE.")
-(make-variable-buffer-local 'reb-overlays)
-(make-variable-buffer-local 'reb-regexp)
-(make-variable-buffer-local 'reb-regexp-src)
-
(defconst reb-buffer "*RE-Builder*"
"Buffer to use for the RE Builder.")
diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el
index 62f213c..bee2f96 100644
--- a/lisp/emacs-lisp/syntax.el
+++ b/lisp/emacs-lisp/syntax.el
@@ -75,7 +75,7 @@ properties won't work properly.")
(defvar syntax-propertize-chunk-size 500)
-(defvar syntax-propertize-extend-region-functions
+(defvar-local syntax-propertize-extend-region-functions
'(syntax-propertize-wholelines)
"Special hook run just before proceeding to propertize a region.
This is used to allow major modes to help `syntax-propertize' find safe buffer
@@ -89,7 +89,6 @@ These functions are run in turn repeatedly until they all
return nil.
Put first the functions more likely to cause a change and cheaper to compute.")
;; Mark it as a special hook which doesn't use any global setting
;; (i.e. doesn't obey the element t in the buffer-local value).
-(make-variable-buffer-local 'syntax-propertize-extend-region-functions)
(cl-defstruct (ppss
(:constructor make-ppss)
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/emulation/cua-base.el b/lisp/emulation/cua-base.el
index 881eff7..a64274b 100644
--- a/lisp/emulation/cua-base.el
+++ b/lisp/emulation/cua-base.el
@@ -634,9 +634,8 @@ a cons (TYPE . COLOR), then both properties are affected."
;;; Low-level Interface
-(defvar cua-inhibit-cua-keys nil
+(defvar-local cua-inhibit-cua-keys nil
"Buffer-local variable that may disable the CUA keymappings.")
-(make-variable-buffer-local 'cua-inhibit-cua-keys)
;;; Aux. variables
@@ -644,9 +643,8 @@ a cons (TYPE . COLOR), then both properties are affected."
;; checked in post-command hook to see if point was moved
(defvar cua--buffer-and-point-before-command nil)
-;; status string for mode line indications
-(defvar cua--status-string nil)
-(make-variable-buffer-local 'cua--status-string)
+(defvar-local cua--status-string nil
+ "Status string for mode line indications.")
(defvar cua--debug nil)
diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el
index ea5dad2..be2d7c0 100644
--- a/lisp/emulation/cua-rect.el
+++ b/lisp/emulation/cua-rect.el
@@ -37,7 +37,7 @@
(require 'rect)
-(defvar cua--rectangle nil
+(defvar-local cua--rectangle nil
"If non-nil, restrict current region to this rectangle.
A cua-rectangle definition is a vector used for all actions in
`cua-rectangle-mark-mode', of the form:
@@ -59,7 +59,6 @@ If VIRT is non-nil, virtual straight edges are enabled.
If SELECT is a regexp, only lines starting with that regexp are
affected.")
-(make-variable-buffer-local 'cua--rectangle)
(defvar cua--last-rectangle nil
"Most recent rectangle geometry.
@@ -85,9 +84,8 @@ See `cua--rectangle'.")
;; "active " "sert on" " straig" " lines ")
(defvar cua--last-killed-rectangle nil)
-(defvar cua--rectangle-overlays nil
+(defvar-local cua--rectangle-overlays nil
"List of overlays used to display current rectangle.")
-(make-variable-buffer-local 'cua--rectangle-overlays)
(put 'cua--rectangle-overlays 'permanent-local t)
(defvar cua--overlay-keymap
diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el
index 1e23583..f38be90 100644
--- a/lisp/emulation/viper-cmd.el
+++ b/lisp/emulation/viper-cmd.el
@@ -1624,7 +1624,7 @@ invokes the command before that, etc."
;; The following two functions are used to set up undo properly.
;; In VI, unlike Emacs, if you open a line, say, and add a bunch of lines,
;; they are undone all at once.
-(viper-deflocalvar viper--undo-change-group-handle nil)
+(defvar-local viper--undo-change-group-handle nil)
(put 'viper--undo-change-group-handle 'permanent-local t)
(defun viper-adjust-undo ()
diff --git a/lisp/emulation/viper-init.el b/lisp/emulation/viper-init.el
index cede99b..c05cf6a 100644
--- a/lisp/emulation/viper-init.el
+++ b/lisp/emulation/viper-init.el
@@ -91,11 +91,9 @@ In all likelihood, you don't need to bother with this
setting."
"Define VAR as a buffer-local variable.
DEFAULT-VALUE is the default value, and DOCUMENTATION is the
docstring. The variable becomes buffer-local whenever set."
- (declare (indent defun))
- `(progn
- (defvar ,var ,default-value
- ,(format "%s\n(buffer local)" documentation))
- (make-variable-buffer-local ',var)))
+ (declare (indent defun)
+ (obsolete defvar-local "28.1"))
+ `(defvar-local ,var ,default-value ,documentation))
;; (viper-loop COUNT BODY) Execute BODY COUNT times.
(defmacro viper-loop (count &rest body)
@@ -161,87 +159,87 @@ docstring. The variable becomes buffer-local whenever
set."
;;; Viper minor modes
;; Mode for vital things like \e, C-z.
-(viper-deflocalvar viper-vi-intercept-minor-mode nil)
+(defvar-local viper-vi-intercept-minor-mode nil)
-(viper-deflocalvar viper-vi-basic-minor-mode nil
+(defvar-local viper-vi-basic-minor-mode nil
"Viper's minor mode for Vi bindings.")
-(viper-deflocalvar viper-vi-local-user-minor-mode nil
+(defvar-local viper-vi-local-user-minor-mode nil
"Auxiliary minor mode for user-defined local bindings in Vi state.")
-(viper-deflocalvar viper-vi-global-user-minor-mode nil
+(defvar-local viper-vi-global-user-minor-mode nil
"Auxiliary minor mode for user-defined global bindings in Vi state.")
-(viper-deflocalvar viper-vi-state-modifier-minor-mode nil
+(defvar-local viper-vi-state-modifier-minor-mode nil
"Minor mode used to make major-mode-specific modification to Vi state.")
-(viper-deflocalvar viper-vi-diehard-minor-mode nil
+(defvar-local viper-vi-diehard-minor-mode nil
"This minor mode is in effect when the user wants Viper to be Vi.")
-(viper-deflocalvar viper-vi-kbd-minor-mode nil
+(defvar-local viper-vi-kbd-minor-mode nil
"Minor mode for Ex command macros in Vi state.
The corresponding keymap stores key bindings of Vi macros defined with
the Ex command :map.")
;; Mode for vital things like \e, C-z.
-(viper-deflocalvar viper-insert-intercept-minor-mode nil)
+(defvar-local viper-insert-intercept-minor-mode nil)
-(viper-deflocalvar viper-insert-basic-minor-mode nil
+(defvar-local viper-insert-basic-minor-mode nil
"Viper's minor mode for bindings in Insert mode.")
-(viper-deflocalvar viper-insert-local-user-minor-mode nil
+(defvar-local viper-insert-local-user-minor-mode nil
"Auxiliary minor mode for buffer-local user-defined bindings in Insert state.
This is a way to overshadow normal Insert mode bindings locally to certain
designated buffers.")
-(viper-deflocalvar viper-insert-global-user-minor-mode nil
+(defvar-local viper-insert-global-user-minor-mode nil
"Auxiliary minor mode for global user-defined bindings in Insert state.")
-(viper-deflocalvar viper-insert-state-modifier-minor-mode nil
+(defvar-local viper-insert-state-modifier-minor-mode nil
"Minor mode used to make major-mode-specific modification to Insert state.")
-(viper-deflocalvar viper-insert-diehard-minor-mode nil
+(defvar-local viper-insert-diehard-minor-mode nil
"Minor mode that simulates Vi very closely.
Not recommended, except for the novice user.")
-(viper-deflocalvar viper-insert-kbd-minor-mode nil
+(defvar-local viper-insert-kbd-minor-mode nil
"Minor mode for Ex command macros Insert state.
The corresponding keymap stores key bindings of Vi macros defined with
the Ex command :map!.")
-(viper-deflocalvar viper-replace-minor-mode nil
+(defvar-local viper-replace-minor-mode nil
"Minor mode in effect in replace state (cw, C, and the like commands).")
;; Mode for vital things like \C-z and \C-x) This is set to t, when viper-mode
;; is invoked. So, any new buffer will have C-z defined as switch to Vi,
;; unless we switched states in this buffer
-(viper-deflocalvar viper-emacs-intercept-minor-mode nil)
+(defvar-local viper-emacs-intercept-minor-mode nil)
-(viper-deflocalvar viper-emacs-local-user-minor-mode nil
+(defvar-local viper-emacs-local-user-minor-mode nil
"Minor mode for local user bindings effective in Emacs state.
Users can use it to override Emacs bindings when Viper is in its Emacs
state.")
-(viper-deflocalvar viper-emacs-global-user-minor-mode nil
+(defvar-local viper-emacs-global-user-minor-mode nil
"Minor mode for global user bindings in effect in Emacs state.
Users can use it to override Emacs bindings when Viper is in its Emacs
state.")
-(viper-deflocalvar viper-emacs-kbd-minor-mode nil
+(defvar-local viper-emacs-kbd-minor-mode nil
"Minor mode for Vi style macros in Emacs state.
The corresponding keymap stores key bindings of Vi macros defined with
`viper-record-kbd-macro' command. There is no Ex-level command to do this
interactively.")
-(viper-deflocalvar viper-emacs-state-modifier-minor-mode nil
+(defvar-local viper-emacs-state-modifier-minor-mode nil
"Minor mode used to make major-mode-specific modification to Emacs state.
For instance, a Vi purist may want to bind `dd' in Dired mode to a function
that deletes a file.")
-(viper-deflocalvar viper-vi-minibuffer-minor-mode nil
+(defvar-local viper-vi-minibuffer-minor-mode nil
"Minor mode that forces Vi-style when the Minibuffer is in Vi state.")
-(viper-deflocalvar viper-insert-minibuffer-minor-mode nil
+(defvar-local viper-insert-minibuffer-minor-mode nil
"Minor mode that forces Vi-style when the Minibuffer is in Insert state.")
@@ -284,7 +282,7 @@ Use `\\[viper-set-expert-level]' to change this.")
;; If non-nil, ISO accents will be turned on in insert/replace emacs states and
;; turned off in vi-state. For some users, this behavior may be too
;; primitive. In this case, use insert/emacs/vi state hooks.
-(viper-deflocalvar viper-automatic-iso-accents nil "")
+(defvar-local viper-automatic-iso-accents nil "")
;; Set iso-accents-mode to ARG. Check if it is bound first
(defsubst viper-set-iso-accents-mode (arg)
(if (boundp 'iso-accents-mode)
@@ -294,7 +292,7 @@ Use `\\[viper-set-expert-level]' to change this.")
;; Don't change this!
(defvar viper-mule-hook-flag t)
;; If non-nil, the default intl. input method is turned on.
-(viper-deflocalvar viper-special-input-method nil "")
+(defvar-local viper-special-input-method nil "")
;; viper hook to run on input-method activation
(defun viper-activate-input-method-action ()
@@ -357,7 +355,7 @@ it better fits your working style."
;; Replace mode and changing text
;; Hack used to pass global states around for short period of time
-(viper-deflocalvar viper-intermediate-command nil "")
+(defvar-local viper-intermediate-command nil "")
;; This is used to pass the right Vi command key sequence to
;; viper-set-destructive-command whenever (this-command-keys) doesn't give the
@@ -367,7 +365,7 @@ it better fits your working style."
(defconst viper-this-command-keys nil)
;; Indicates that the current destructive command has started in replace mode.
-(viper-deflocalvar viper-began-as-replace nil "")
+(defvar-local viper-began-as-replace nil "")
(defcustom viper-allow-multiline-replace-regions t
"If non-nil, Viper will allow multi-line replace regions.
@@ -398,7 +396,7 @@ delete the text being replaced, as in standard Vi."
;; internal var, used to remember the default cursor color of emacs frames
(defvar viper-vi-state-cursor-color nil)
-(viper-deflocalvar viper-replace-overlay nil "")
+(defvar-local viper-replace-overlay nil "")
(put 'viper-replace-overlay 'permanent-local t)
(defcustom viper-replace-region-end-delimiter "$"
@@ -430,24 +428,24 @@ color displays. By default, the delimiters are used only
on TTYs."
;; `viper-move-marker-locally'
;;
;; Remember the last position inside the replace region.
-(viper-deflocalvar viper-last-posn-in-replace-region nil)
+(defvar-local viper-last-posn-in-replace-region nil)
;; Remember the last position while inserting
-(viper-deflocalvar viper-last-posn-while-in-insert-state nil)
+(defvar-local viper-last-posn-while-in-insert-state nil)
(put 'viper-last-posn-in-replace-region 'permanent-local t)
(put 'viper-last-posn-while-in-insert-state 'permanent-local t)
-(viper-deflocalvar viper-sitting-in-replace nil "")
+(defvar-local viper-sitting-in-replace nil "")
(put 'viper-sitting-in-replace 'permanent-local t)
;; Remember the number of characters that have to be deleted in replace
;; mode to compensate for the inserted characters.
-(viper-deflocalvar viper-replace-chars-to-delete 0 "")
+(defvar-local viper-replace-chars-to-delete 0 "")
;; This variable is used internally by the before/after changed functions to
;; determine how many chars were deleted by the change. This can't be
;; determined inside after-change-functions because those get the length of the
;; deleted region, not the number of chars deleted (which are two different
;; things under MULE).
-(viper-deflocalvar viper-replace-region-chars-deleted 0 "")
+(defvar-local viper-replace-region-chars-deleted 0 "")
;; Insertion ring and command ring
(defcustom viper-insertion-ring-size 14
@@ -490,28 +488,28 @@ will make it hard to use Vi-style timeout macros."
;; Modes and related variables
;; Current mode. One of: `emacs-state', `vi-state', `insert-state'
-(viper-deflocalvar viper-current-state 'emacs-state)
+(defvar-local viper-current-state 'emacs-state)
;; Autoindent in insert
;; Variable that keeps track of whether C-t has been pressed.
-(viper-deflocalvar viper-cted nil "")
+(defvar-local viper-cted nil "")
;; Preserve the indent value, used by C-d in insert mode.
-(viper-deflocalvar viper-current-indent 0)
+(defvar-local viper-current-indent 0)
;; Whether to preserve the indent, used by C-d in insert mode.
-(viper-deflocalvar viper-preserve-indent nil)
+(defvar-local viper-preserve-indent nil)
-(viper-deflocalvar viper-auto-indent nil "")
+(defvar-local viper-auto-indent nil "")
(defcustom viper-auto-indent nil
"Enable autoindent, if t.
This is a buffer-local variable."
:type 'boolean
:group 'viper)
-(viper-deflocalvar viper-electric-mode t "")
+(defvar-local viper-electric-mode t "")
(defcustom viper-electric-mode t
"If t, electrify Viper.
Currently, this only electrifies auto-indentation, making it appropriate to the
@@ -541,7 +539,7 @@ to a new place after repeating previous Vi command."
;; Remember insert point as a marker. This is a local marker that must be
;; initialized to nil and moved with `viper-move-marker-locally'.
-(viper-deflocalvar viper-insert-point nil)
+(defvar-local viper-insert-point nil)
(put 'viper-insert-point 'permanent-local t)
;; This remembers the point before dabbrev-expand was called.
@@ -562,7 +560,7 @@ to a new place after repeating previous Vi command."
;; problem. However, the same trick can be used if such a command is
;; discovered later.
;;
-(viper-deflocalvar viper-pre-command-point nil)
+(defvar-local viper-pre-command-point nil)
(put 'viper-pre-command-point 'permanent-local t) ; this is probably an
overkill
;; This is used for saving inserted text.
@@ -573,7 +571,7 @@ to a new place after repeating previous Vi command."
;; Remember com point as a marker.
;; This is a local marker. Should be moved with `viper-move-marker-locally'
-(viper-deflocalvar viper-com-point nil)
+(defvar-local viper-com-point nil)
;; If non-nil, the value is a list (M-COM VAL COM REG inserted-text cmd-keys)
;; It is used to re-execute last destructive command.
@@ -660,14 +658,14 @@ negative number."
:type 'boolean
:group 'viper)
-(viper-deflocalvar viper-ex-style-motion t "")
+(defvar-local viper-ex-style-motion t "")
(defcustom viper-ex-style-motion t
"If t, the commands l,h do not cross lines, etc (Ex-style).
If nil, these commands cross line boundaries."
:type 'boolean
:group 'viper)
-(viper-deflocalvar viper-ex-style-editing t "")
+(defvar-local viper-ex-style-editing t "")
(defcustom viper-ex-style-editing t
"If t, Ex-style behavior while editing in Vi command and insert states.
`Backspace' and `Delete' don't cross line boundaries in insert.
@@ -679,14 +677,14 @@ If nil, the above commands can work across lines."
:type 'boolean
:group 'viper)
-(viper-deflocalvar viper-ESC-moves-cursor-back viper-ex-style-editing "")
+(defvar-local viper-ESC-moves-cursor-back viper-ex-style-editing "")
(defcustom viper-ESC-moves-cursor-back nil
"If t, ESC moves cursor back when changing from insert to vi state.
If nil, the cursor stays where it was when ESC was hit."
:type 'boolean
:group 'viper)
-(viper-deflocalvar viper-delete-backwards-in-replace nil "")
+(defvar-local viper-delete-backwards-in-replace nil "")
(defcustom viper-delete-backwards-in-replace nil
"If t, DEL key will delete characters while moving the cursor backwards.
If nil, the cursor will move backwards without deleting anything."
@@ -704,7 +702,7 @@ If nil, the cursor will move backwards without deleting
anything."
:tag "Search Wraps Around"
:group 'viper-search)
-(viper-deflocalvar viper-related-files-and-buffers-ring nil "")
+(defvar-local viper-related-files-and-buffers-ring nil "")
(defcustom viper-related-files-and-buffers-ring nil
"List of file and buffer names to consider related to the current buffer.
Related buffers can be cycled through via :R and :P commands."
@@ -713,12 +711,12 @@ Related buffers can be cycled through via :R and :P
commands."
(put 'viper-related-files-and-buffers-ring 'permanent-local t)
;; Used to find out if we are done with searching the current buffer.
-(viper-deflocalvar viper-local-search-start-marker nil)
+(defvar-local viper-local-search-start-marker nil)
;; As above, but global
(defvar viper-search-start-marker (make-marker))
;; the search overlay
-(viper-deflocalvar viper-search-overlay nil)
+(defvar-local viper-search-overlay nil)
(defvar viper-heading-start
@@ -745,9 +743,9 @@ Related buffers can be cycled through via :R and :P
commands."
;; inside the lines.
;; Remembers position of the last jump done using ``'.
-(viper-deflocalvar viper-last-jump nil)
+(defvar-local viper-last-jump nil)
;; Remembers position of the last jump done using `''.
-(viper-deflocalvar viper-last-jump-ignore 0)
+(defvar-local viper-last-jump-ignore 0)
;; History variables
@@ -841,7 +839,7 @@ to customize the actual face object `viper-minibuffer-vi'
this variable represents.")
;; the current face to be used in the minibuffer
-(viper-deflocalvar
+(defvar-local
viper-minibuffer-current-face viper-minibuffer-emacs-face "")
@@ -877,7 +875,7 @@ Should be set in `viper-custom-file-name'."
:group 'viper)
;; overlay used in the minibuffer to indicate which state it is in
-(viper-deflocalvar viper-minibuffer-overlay nil)
+(defvar-local viper-minibuffer-overlay nil)
(put 'viper-minibuffer-overlay 'permanent-local t)
;; Hook, specific to Viper, which is run just *before* exiting the minibuffer.
@@ -946,9 +944,4 @@ on a dumb terminal."
(provide 'viper-init)
-
-;; Local Variables:
-;; eval: (put 'viper-deflocalvar 'lisp-indent-hook 'defun)
-;; End:
-
;;; viper-init.el ends here
diff --git a/lisp/emulation/viper-keym.el b/lisp/emulation/viper-keym.el
index 7209dc6..1d80c9c 100644
--- a/lisp/emulation/viper-keym.el
+++ b/lisp/emulation/viper-keym.el
@@ -82,7 +82,7 @@ major mode in effect."
(defvar viper-insert-intercept-map (make-sparse-keymap))
(defvar viper-emacs-intercept-map (make-sparse-keymap))
-(viper-deflocalvar viper-vi-local-user-map (make-sparse-keymap)
+(defvar-local viper-vi-local-user-map (make-sparse-keymap)
"Keymap for user-defined local bindings.
Useful for changing bindings such as ZZ in certain major modes.
For instance, in letter-mode, one may want to bind ZZ to
@@ -106,7 +106,7 @@ This map is global, shared by all buffers.")
This happens when viper-expert-level is 1 or 2. See viper-set-expert-level.")
-(viper-deflocalvar viper-insert-local-user-map (make-sparse-keymap)
+(defvar-local viper-insert-local-user-map (make-sparse-keymap)
"Auxiliary map for per-buffer user-defined keybindings in Insert state.")
(put 'viper-insert-local-user-map 'permanent-local t)
@@ -133,7 +133,7 @@ viper-insert-basic-map. Not recommended, except for novice
users.")
(defvar viper-emacs-kbd-map (make-sparse-keymap)
"This keymap keeps Vi-style kbd macros for Emacs mode.")
-(viper-deflocalvar viper-emacs-local-user-map (make-sparse-keymap)
+(defvar-local viper-emacs-local-user-map (make-sparse-keymap)
"Auxiliary map for local user-defined bindings in Emacs state.")
(put 'viper-emacs-local-user-map 'permanent-local t)
@@ -209,22 +209,22 @@ In insert mode, this key also functions as Meta."
(defvar viper-emacs-state-modifier-alist nil)
;; The list of viper keymaps. Set by viper-normalize-minor-mode-map-alist
-(viper-deflocalvar viper--key-maps nil)
-(viper-deflocalvar viper--intercept-key-maps nil)
+(defvar-local viper--key-maps nil)
+(defvar-local viper--intercept-key-maps nil)
;; Tells viper-add-local-keys to create a new viper-vi-local-user-map for new
;; buffers. Not a user option.
-(viper-deflocalvar viper-need-new-vi-local-map t "")
+(defvar-local viper-need-new-vi-local-map t "")
(put 'viper-need-new-vi-local-map 'permanent-local t)
;; Tells viper-add-local-keys to create a new viper-insert-local-user-map for
;; new buffers. Not a user option.
-(viper-deflocalvar viper-need-new-insert-local-map t "")
+(defvar-local viper-need-new-insert-local-map t "")
(put 'viper-need-new-insert-local-map 'permanent-local t)
;; Tells viper-add-local-keys to create a new viper-emacs-local-user-map for
;; new buffers. Not a user option.
-(viper-deflocalvar viper-need-new-emacs-local-map t "")
+(defvar-local viper-need-new-emacs-local-map t "")
(put 'viper-need-new-emacs-local-map 'permanent-local t)
@@ -654,10 +654,4 @@ form ((key . function) (key . function) ... )."
(provide 'viper-keym)
-
-;; Local Variables:
-;; eval: (put 'viper-deflocalvar 'lisp-indent-hook 'defun)
-;; End:
-
-
;;; viper-keym.el ends here
diff --git a/lisp/emulation/viper-mous.el b/lisp/emulation/viper-mous.el
index eec83dd..71e40ee 100644
--- a/lisp/emulation/viper-mous.el
+++ b/lisp/emulation/viper-mous.el
@@ -74,10 +74,10 @@ considered related."
:group 'viper-mouse)
;; Local variable used to toggle wraparound search on click.
-(viper-deflocalvar viper-mouse-click-search-noerror t)
+(defvar-local viper-mouse-click-search-noerror t)
;; Local variable used to delimit search after wraparound.
-(viper-deflocalvar viper-mouse-click-search-limit nil)
+(defvar-local viper-mouse-click-search-limit nil)
;; remembers prefix argument to pass along to commands invoked by second
;; click.
@@ -592,11 +592,4 @@ This buffer may be different from the one where the click
occurred."
:set 'viper-reset-mouse-insert-key
:group 'viper-mouse)
-
-
-;; Local Variables:
-;; eval: (put 'viper-deflocalvar 'lisp-indent-hook 'defun)
-;; End:
-
-
;;; viper-mous.el ends here
diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el
index 07a234b..1bdb155 100644
--- a/lisp/emulation/viper-util.el
+++ b/lisp/emulation/viper-util.el
@@ -1085,10 +1085,10 @@ the `Local variables' section of a file."
;; These are characters that are not to be considered as parts of a word in
;; Viper.
;; Set each time state changes and at loading time
-(viper-deflocalvar viper-non-word-characters nil)
+(defvar-local viper-non-word-characters nil)
;; must be buffer-local
-(viper-deflocalvar viper-ALPHA-char-class "w"
+(defvar-local viper-ALPHA-char-class "w"
"String of syntax classes characterizing Viper's alphanumeric symbols.
In addition, the symbol `_' may be considered alphanumeric if
`viper-syntax-preference' is `strict-vi' or `reformed-vi'.")
@@ -1375,10 +1375,4 @@ This option is appropriate if you like Emacs-style
words."
(setq i (1+ i) start (1+ start)))
res))))))
-
-
-;; Local Variables:
-;; eval: (put 'viper-deflocalvar 'lisp-indent-hook 'defun)
-;; End:
-
;;; viper-util.el ends here
diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el
index 6c94280..df5a083 100644
--- a/lisp/emulation/viper.el
+++ b/lisp/emulation/viper.el
@@ -1256,9 +1256,4 @@ These two lines must come in the order given."))
(provide 'viper)
-
-;; Local Variables:
-;; eval: (put 'viper-deflocalvar 'lisp-indent-hook 'defun)
-;; End:
-
;;; viper.el ends here
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 b1f37cb..36515ef 100644
--- a/lisp/epg.el
+++ b/lisp/epg.el
@@ -332,7 +332,6 @@ callback data (if any)."
(cl-defstruct (epg-key
(:constructor nil)
(:constructor epg-make-key (owner-trust))
- (:copier nil)
(:predicate nil))
(owner-trust nil :read-only t)
sub-key-list user-id-list)
@@ -642,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*")
@@ -1383,11 +1374,22 @@ NAME is either a string or a list of strings."
keys))
(defun epg--filter-revoked-keys (keys)
- (seq-remove (lambda (key)
- (seq-find (lambda (user)
- (eq (epg-user-id-validity user) 'revoked))
- (epg-key-user-id-list key)))
- keys))
+ (mapcar
+ (lambda (key)
+ ;; We have something revoked, so copy the key and remove the
+ ;; revoked bits.
+ (if (seq-find (lambda (user)
+ (eq (epg-user-id-validity user) 'revoked))
+ (epg-key-user-id-list key))
+ (let ((copy (copy-epg-key key)))
+ (setf (epg-key-user-id-list copy)
+ (seq-remove (lambda (user)
+ (eq (epg-user-id-validity user) 'revoked))
+ (epg-key-user-id-list copy)))
+ copy)
+ ;; Nothing to delete; return the key.
+ key))
+ keys))
(defun epg--args-from-sig-notations (notations)
(apply #'nconc
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 487dc76..4cabd42 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -120,38 +120,31 @@
;;; User data
-(defvar erc-server-current-nick nil
+(defvar-local erc-server-current-nick nil
"Nickname on the current server.
Use `erc-current-nick' to access this.")
-(make-variable-buffer-local 'erc-server-current-nick)
;;; Server attributes
-(defvar erc-server-process nil
+(defvar-local erc-server-process nil
"The process object of the corresponding server connection.")
-(make-variable-buffer-local 'erc-server-process)
-(defvar erc-session-server nil
+(defvar-local erc-session-server nil
"The server name used to connect to for this session.")
-(make-variable-buffer-local 'erc-session-server)
-(defvar erc-session-connector nil
+(defvar-local erc-session-connector nil
"The function used to connect to this session (nil for the default).")
-(make-variable-buffer-local 'erc-session-connector)
-(defvar erc-session-port nil
+(defvar-local erc-session-port nil
"The port used to connect to.")
-(make-variable-buffer-local 'erc-session-port)
-(defvar erc-server-announced-name nil
+(defvar-local erc-server-announced-name nil
"The name the server announced to use.")
-(make-variable-buffer-local 'erc-server-announced-name)
-(defvar erc-server-version nil
+(defvar-local erc-server-version nil
"The name and version of the server's ircd.")
-(make-variable-buffer-local 'erc-server-version)
-(defvar erc-server-parameters nil
+(defvar-local erc-server-parameters nil
"Alist listing the supported server parameters.
This is only set if the server sends 005 messages saying what is
@@ -177,86 +170,70 @@ RFC2812 - server supports RFC 2812 features
SILENCE=10 - supports the SILENCE command, maximum allowed number of entries
TOPICLEN=160 - maximum allowed topic length
WALLCHOPS - supports sending messages to all operators in a channel")
-(make-variable-buffer-local 'erc-server-parameters)
;;; Server and connection state
(defvar erc-server-ping-timer-alist nil
"Mapping of server buffers to their specific ping timer.")
-(defvar erc-server-connected nil
+(defvar-local erc-server-connected nil
"Non-nil if the current buffer has been used by ERC to establish
an IRC connection.
If you wish to determine whether an IRC connection is currently
active, use the `erc-server-process-alive' function instead.")
-(make-variable-buffer-local 'erc-server-connected)
-(defvar erc-server-reconnect-count 0
+(defvar-local erc-server-reconnect-count 0
"Number of times we have failed to reconnect to the current server.")
-(make-variable-buffer-local 'erc-server-reconnect-count)
-(defvar erc-server-quitting nil
+(defvar-local erc-server-quitting nil
"Non-nil if the user requests a quit.")
-(make-variable-buffer-local 'erc-server-quitting)
-(defvar erc-server-reconnecting nil
+(defvar-local erc-server-reconnecting nil
"Non-nil if the user requests an explicit reconnect, and the
current IRC process is still alive.")
-(make-variable-buffer-local 'erc-server-reconnecting)
-(defvar erc-server-timed-out nil
+(defvar-local erc-server-timed-out nil
"Non-nil if the IRC server failed to respond to a ping.")
-(make-variable-buffer-local 'erc-server-timed-out)
-(defvar erc-server-banned nil
+(defvar-local erc-server-banned nil
"Non-nil if the user is denied access because of a server ban.")
-(make-variable-buffer-local 'erc-server-banned)
-(defvar erc-server-error-occurred nil
+(defvar-local erc-server-error-occurred nil
"Non-nil if the user triggers some server error.")
-(make-variable-buffer-local 'erc-server-error-occurred)
-(defvar erc-server-lines-sent nil
+(defvar-local erc-server-lines-sent nil
"Line counter.")
-(make-variable-buffer-local 'erc-server-lines-sent)
-(defvar erc-server-last-peers '(nil . nil)
+(defvar-local erc-server-last-peers '(nil . nil)
"Last peers used, both sender and receiver.
Those are used for /MSG destination shortcuts.")
-(make-variable-buffer-local 'erc-server-last-peers)
-(defvar erc-server-last-sent-time nil
+(defvar-local erc-server-last-sent-time nil
"Time the message was sent.
This is useful for flood protection.")
-(make-variable-buffer-local 'erc-server-last-sent-time)
-(defvar erc-server-last-ping-time nil
+(defvar-local erc-server-last-ping-time nil
"Time the last ping was sent.
This is useful for flood protection.")
-(make-variable-buffer-local 'erc-server-last-ping-time)
-(defvar erc-server-last-received-time nil
+(defvar-local erc-server-last-received-time nil
"Time the last message was received from the server.
This is useful for detecting hung connections.")
-(make-variable-buffer-local 'erc-server-last-received-time)
-(defvar erc-server-lag nil
+(defvar-local erc-server-lag nil
"Calculated server lag time in seconds.
This variable is only set in a server buffer.")
-(make-variable-buffer-local 'erc-server-lag)
-(defvar erc-server-filter-data nil
+(defvar-local erc-server-filter-data nil
"The data that arrived from the server
but has not been processed yet.")
-(make-variable-buffer-local 'erc-server-filter-data)
-(defvar erc-server-duplicates (make-hash-table :test 'equal)
+(defvar-local erc-server-duplicates (make-hash-table :test 'equal)
"Internal variable used to track duplicate messages.")
-(make-variable-buffer-local 'erc-server-duplicates)
;; From Circe
-(defvar erc-server-processing-p nil
+(defvar-local erc-server-processing-p nil
"Non-nil when we're currently processing a message.
When ERC receives a private message, it sets up a new buffer for
@@ -267,23 +244,19 @@ network exceptions. So, if someone sends you two messages
quickly after each other, ispell is started for the first, but
might take long enough for the second message to be processed
first.")
-(make-variable-buffer-local 'erc-server-processing-p)
-(defvar erc-server-flood-last-message 0
+(defvar-local erc-server-flood-last-message 0
"When we sent the last message.
See `erc-server-flood-margin' for an explanation of the flood
protection algorithm.")
-(make-variable-buffer-local 'erc-server-flood-last-message)
-(defvar erc-server-flood-queue nil
+(defvar-local erc-server-flood-queue nil
"The queue of messages waiting to be sent to the server.
See `erc-server-flood-margin' for an explanation of the flood
protection algorithm.")
-(make-variable-buffer-local 'erc-server-flood-queue)
-(defvar erc-server-flood-timer nil
+(defvar-local erc-server-flood-timer nil
"The timer to resume sending.")
-(make-variable-buffer-local 'erc-server-flood-timer)
;;; IRC protocol and misc options
@@ -453,9 +426,8 @@ If this is set to nil, never try to reconnect."
:type '(choice (const :tag "Disabled" nil)
(integer :tag "Seconds")))
-(defvar erc-server-ping-handler nil
+(defvar-local erc-server-ping-handler nil
"This variable holds the periodic ping timer.")
-(make-variable-buffer-local 'erc-server-ping-handler)
;;;; Helper functions
diff --git a/lisp/erc/erc-capab.el b/lisp/erc/erc-capab.el
index 06d4fbd..4e4d012 100644
--- a/lisp/erc/erc-capab.el
+++ b/lisp/erc/erc-capab.el
@@ -113,13 +113,11 @@ character not found in IRC nicknames to avoid confusion."
;;; Variables:
-(defvar erc-capab-identify-activated nil
+(defvar-local erc-capab-identify-activated nil
"CAPAB IDENTIFY-MSG has been activated.")
-(make-variable-buffer-local 'erc-capab-identify-activated)
-(defvar erc-capab-identify-sent nil
+(defvar-local erc-capab-identify-sent nil
"CAPAB IDENTIFY-MSG and IDENTIFY-CTCP messages have been sent.")
-(make-variable-buffer-local 'erc-capab-identify-sent)
;;; Functions:
diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el
index 590785e..9dedd3c 100644
--- a/lisp/erc/erc-dcc.el
+++ b/lisp/erc/erc-dcc.el
@@ -538,8 +538,7 @@ PROC is the server process."
nil '(notice error) 'active
'dcc-get-notfound ?n nick ?f filename))))
-(defvar erc-dcc-byte-count nil)
-(make-variable-buffer-local 'erc-dcc-byte-count)
+(defvar-local erc-dcc-byte-count nil)
(defun erc-dcc-do-LIST-command (proc)
"This is the handler for the /dcc list command.
@@ -751,9 +750,8 @@ the matching regexp, or nil if none found."
'dcc-malformed ?n nick ?u login ?h host ?q query)))))
-(defvar erc-dcc-entry-data nil
+(defvar-local erc-dcc-entry-data nil
"Holds the `erc-dcc-list' entry for this DCC connection.")
-(make-variable-buffer-local 'erc-dcc-entry-data)
;;; SEND handling
@@ -905,8 +903,7 @@ other client."
:group 'erc-dcc
:type 'integer)
-(defvar erc-dcc-file-name nil)
-(make-variable-buffer-local 'erc-dcc-file-name)
+(defvar-local erc-dcc-file-name nil)
(defun erc-dcc-get-file (entry file parent-proc)
"Set up a transfer from the remote client to the local over a TCP connection.
diff --git a/lisp/erc/erc-ezbounce.el b/lisp/erc/erc-ezbounce.el
index 62238dd..8378ff5 100644
--- a/lisp/erc/erc-ezbounce.el
+++ b/lisp/erc/erc-ezbounce.el
@@ -61,9 +61,8 @@ The alist's format is as follows:
"Alist of actions to take on NOTICEs from EZBounce.")
-(defvar erc-ezb-session-list '()
+(defvar-local erc-ezb-session-list '()
"List of detached EZBounce sessions.")
-(make-variable-buffer-local 'erc-ezb-session-list)
(defvar erc-ezb-inside-session-listing nil
"Indicate whether current notices are expected to be EZB session listings.")
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 947b294..e6e5070 100644
--- a/lisp/erc/erc-join.el
+++ b/lisp/erc/erc-join.el
@@ -105,8 +105,7 @@ servers, presumably in the same domain."
:group 'erc-autojoin
:type 'boolean)
-(defvar erc--autojoin-timer nil)
-(make-variable-buffer-local 'erc--autojoin-timer)
+(defvar-local erc--autojoin-timer nil)
(defun erc-autojoin-channels-delayed (server nick buffer)
"Attempt to autojoin channels.
diff --git a/lisp/erc/erc-netsplit.el b/lisp/erc/erc-netsplit.el
index 9fd3cfe..37fc4cf 100644
--- a/lisp/erc/erc-netsplit.el
+++ b/lisp/erc/erc-netsplit.el
@@ -82,12 +82,11 @@ Args: PROC is the process the netjoin originated from and
:group 'erc-hooks
:type 'hook)
-(defvar erc-netsplit-list nil
+(defvar-local erc-netsplit-list nil
"This is a list of the form
\((\"a.b.c.d e.f.g\" TIMESTAMP FIRST-JOIN \"nick1\" ... \"nickn\") ...)
where FIRST-JOIN is t or nil, depending on whether or not the first
join from that split has been detected or not.")
-(make-variable-buffer-local 'erc-netsplit-list)
(defun erc-netsplit-install-message-catalogs ()
(erc-define-catalog
diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el
index 9c2bb9d..9926255 100644
--- a/lisp/erc/erc-networks.el
+++ b/lisp/erc/erc-networks.el
@@ -722,9 +722,8 @@ MATCHER is used to find a corresponding network to a server
while
(regexp)
(const :tag "Network has no common server ending" nil)))))
-(defvar erc-network nil
+(defvar-local erc-network nil
"The name of the network you are connected to (a symbol).")
-(make-variable-buffer-local 'erc-network)
;; Functions:
diff --git a/lisp/erc/erc-notify.el b/lisp/erc/erc-notify.el
index 098049e..e133e05 100644
--- a/lisp/erc/erc-notify.el
+++ b/lisp/erc/erc-notify.el
@@ -75,13 +75,11 @@ strings."
;;;; Internal variables
-(defvar erc-last-ison nil
+(defvar-local erc-last-ison nil
"Last ISON information received through `erc-notify-timer'.")
-(make-variable-buffer-local 'erc-last-ison)
-(defvar erc-last-ison-time 0
+(defvar-local erc-last-ison-time 0
"Last time ISON was sent to the server in `erc-notify-timer'.")
-(make-variable-buffer-local 'erc-last-ison-time)
;;;; Setup
diff --git a/lisp/erc/erc-pcomplete.el b/lisp/erc/erc-pcomplete.el
index ab4c7c5..ddaf787 100644
--- a/lisp/erc/erc-pcomplete.el
+++ b/lisp/erc/erc-pcomplete.el
@@ -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-ring.el b/lisp/erc/erc-ring.el
index 3813eaf..71a9f8e 100644
--- a/lisp/erc/erc-ring.el
+++ b/lisp/erc/erc-ring.el
@@ -53,16 +53,14 @@ be recalled using M-p and M-n."
(define-key erc-mode-map "\M-p" 'undefined)
(define-key erc-mode-map "\M-n" 'undefined)))
-(defvar erc-input-ring nil "Input ring for erc.")
-(make-variable-buffer-local 'erc-input-ring)
+(defvar-local erc-input-ring nil "Input ring for erc.")
-(defvar erc-input-ring-index nil
+(defvar-local erc-input-ring-index nil
"Position in the input ring for erc.
If nil, the input line is blank and the user is conceptually after
the most recently added item in the ring. If an integer, the input
line is non-blank and displays the item from the ring indexed by this
variable.")
-(make-variable-buffer-local 'erc-input-ring-index)
(defun erc-input-ring-setup ()
"Do the setup required so that we can use comint style input rings.
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index c7dfb08..2c42a18 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -191,21 +191,18 @@ or `erc-send-modify-hook'."
(list (lambda (_window _before dir)
(erc-echo-timestamp dir ct))))))))
-(defvar erc-timestamp-last-inserted nil
+(defvar-local erc-timestamp-last-inserted nil
"Last timestamp inserted into the buffer.")
-(make-variable-buffer-local 'erc-timestamp-last-inserted)
-(defvar erc-timestamp-last-inserted-left nil
+(defvar-local erc-timestamp-last-inserted-left nil
"Last timestamp inserted into the left side of the buffer.
This is used when `erc-insert-timestamp-function' is set to
`erc-timestamp-left-and-right'")
-(make-variable-buffer-local 'erc-timestamp-last-inserted-left)
-(defvar erc-timestamp-last-inserted-right nil
+(defvar-local erc-timestamp-last-inserted-right nil
"Last timestamp inserted into the right side of the buffer.
This is used when `erc-insert-timestamp-function' is set to
`erc-timestamp-left-and-right'")
-(make-variable-buffer-local 'erc-timestamp-last-inserted-right)
(defcustom erc-timestamp-only-if-changed-flag t
"Insert timestamp only if its value changed since last insertion.
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index bb68173..dd7f50f 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -270,9 +270,8 @@ A typical value would be \((\"#emacs\" \"QUIT\" \"JOIN\")
:group 'erc-ignore
:type 'erc-message-type)
-(defvar erc-session-password nil
+(defvar-local erc-session-password nil
"The password used for the current session.")
-(make-variable-buffer-local 'erc-session-password)
(defcustom erc-disconnected-hook nil
"Run this hook with arguments (NICK IP REASON) when disconnected.
@@ -337,18 +336,16 @@ Functions are passed a buffer as the first argument."
:type 'hook)
-(defvar erc-channel-users nil
+(defvar-local erc-channel-users nil
"A hash table of members in the current channel, which
associates nicknames with cons cells of the form:
\(USER . MEMBER-DATA) where USER is a pointer to an
erc-server-user struct, and MEMBER-DATA is a pointer to an
erc-channel-user struct.")
-(make-variable-buffer-local 'erc-channel-users)
-(defvar erc-server-users nil
+(defvar-local erc-server-users nil
"A hash table of users on the current server, which associates
nicknames with erc-server-user struct instances.")
-(make-variable-buffer-local 'erc-server-users)
(defun erc-downcase (string)
"Convert STRING to IRC standard conforming downcase."
@@ -632,23 +629,19 @@ See also: `erc-get-channel-user-list'."
(or (not nicky)
(string-lessp nickx nicky))))))))
-(defvar erc-channel-topic nil
+(defvar-local erc-channel-topic nil
"A topic string for the channel. Should only be used in channel-buffers.")
-(make-variable-buffer-local 'erc-channel-topic)
-(defvar erc-channel-modes nil
+(defvar-local erc-channel-modes nil
"List of strings representing channel modes.
E.g. (\"i\" \"m\" \"s\" \"b Quake!*@*\")
\(not sure the ban list will be here, but why not)")
-(make-variable-buffer-local 'erc-channel-modes)
-(defvar erc-insert-marker nil
+(defvar-local erc-insert-marker nil
"The place where insertion of new text in erc buffers should happen.")
-(make-variable-buffer-local 'erc-insert-marker)
-(defvar erc-input-marker nil
+(defvar-local erc-input-marker nil
"The marker where input should be inserted.")
-(make-variable-buffer-local 'erc-input-marker)
(defun erc-string-no-properties (string)
"Return a copy of STRING will all text-properties removed."
@@ -900,9 +893,8 @@ directory in the list."
:group 'erc-scripts
:type 'boolean)
-(defvar erc-last-saved-position nil
+(defvar-local erc-last-saved-position nil
"A marker containing the position the current buffer was last saved at.")
-(make-variable-buffer-local 'erc-last-saved-position)
(defcustom erc-kill-buffer-on-part nil
"Kill the channel buffer on PART.
@@ -1271,8 +1263,7 @@ See also `erc-show-my-nick'."
(defvar erc-debug-log-file (expand-file-name "ERC.debug")
"Debug log file name.")
-(defvar erc-dbuf nil)
-(make-variable-buffer-local 'erc-dbuf)
+(defvar-local erc-dbuf nil)
(defmacro define-erc-module (name alias doc enable-body disable-body
&optional local-p)
@@ -1462,11 +1453,10 @@ If BUFFER is nil, the current buffer is used."
;; Last active buffer, to print server messages in the right place
-(defvar erc-active-buffer nil
+(defvar-local erc-active-buffer nil
"The current active buffer, the one where the user typed the last command.
Defaults to the server buffer, and should only be set in the
server buffer.")
-(make-variable-buffer-local 'erc-active-buffer)
(defun erc-active-buffer ()
"Return the value of `erc-active-buffer' for the current server.
@@ -1820,52 +1810,41 @@ all channel buffers on all servers."
;; Some local variables
-(defvar erc-default-recipients nil
+(defvar-local erc-default-recipients nil
"List of default recipients of the current buffer.")
-(make-variable-buffer-local 'erc-default-recipients)
-(defvar erc-session-user-full-name nil
+(defvar-local erc-session-user-full-name nil
"Full name of the user on the current server.")
-(make-variable-buffer-local 'erc-session-user-full-name)
-(defvar erc-channel-user-limit nil
+(defvar-local erc-channel-user-limit nil
"Limit of users per channel.")
-(make-variable-buffer-local 'erc-channel-user-limit)
-(defvar erc-channel-key nil
+(defvar-local erc-channel-key nil
"Key needed to join channel.")
-(make-variable-buffer-local 'erc-channel-key)
-(defvar erc-invitation nil
+(defvar-local erc-invitation nil
"Last invitation channel.")
-(make-variable-buffer-local 'erc-invitation)
-(defvar erc-away nil
+(defvar-local erc-away nil
"Non-nil indicates that we are away.
Use `erc-away-time' to access this if you might be in a channel
buffer rather than a server buffer.")
-(make-variable-buffer-local 'erc-away)
-(defvar erc-channel-list nil
+(defvar-local erc-channel-list nil
"Server channel list.")
-(make-variable-buffer-local 'erc-channel-list)
-(defvar erc-bad-nick nil
+(defvar-local erc-bad-nick nil
"Non-nil indicates that we got a `nick in use' error while connecting.")
-(make-variable-buffer-local 'erc-bad-nick)
-(defvar erc-logged-in nil
+(defvar-local erc-logged-in nil
"Non-nil indicates that we are logged in.")
-(make-variable-buffer-local 'erc-logged-in)
-(defvar erc-default-nicks nil
+(defvar-local erc-default-nicks nil
"The local copy of `erc-nick' - the list of nicks to choose from.")
-(make-variable-buffer-local 'erc-default-nicks)
-(defvar erc-nick-change-attempt-count 0
+(defvar-local erc-nick-change-attempt-count 0
"Used to keep track of how many times an attempt at changing nick is made.")
-(make-variable-buffer-local 'erc-nick-change-attempt-count)
(defun erc-migrate-modules (mods)
"Migrate old names of ERC modules to new ones."
@@ -2764,8 +2743,7 @@ present."
(let ((prop-val (erc-get-parsed-vector position)))
(and prop-val (member (erc-response.command prop-val) list))))
-(defvar erc-send-input-line-function 'erc-send-input-line)
-(make-variable-buffer-local 'erc-send-input-line-function)
+(defvar-local erc-send-input-line-function 'erc-send-input-line)
(defun erc-send-input-line (target line &optional force)
"Send LINE to TARGET.
@@ -3181,12 +3159,11 @@ were most recently invited. See also `invitation'."
(defalias 'erc-cmd-CHANNEL 'erc-cmd-JOIN)
(defalias 'erc-cmd-J 'erc-cmd-JOIN)
-(defvar erc-channel-new-member-names nil
+(defvar-local erc-channel-new-member-names nil
"If non-nil, a names list is currently being received.
If non-nil, this variable is a hash-table that associates
received nicks with t.")
-(make-variable-buffer-local 'erc-channel-new-member-names)
(defun erc-cmd-NAMES (&optional channel)
"Display the users in CHANNEL.
@@ -3833,7 +3810,7 @@ If CHANNEL is not specified, clear the topic for the
default channel."
;;; Banlists
-(defvar erc-channel-banlist nil
+(defvar-local erc-channel-banlist nil
"A list of bans seen for the current channel.
Each ban is an alist of the form:
@@ -3841,7 +3818,6 @@ Each ban is an alist of the form:
The property `received-from-server' indicates whether
or not the ban list has been requested from the server.")
-(make-variable-buffer-local 'erc-channel-banlist)
(put 'erc-channel-banlist 'received-from-server nil)
(defun erc-cmd-BANLIST ()
@@ -6488,32 +6464,31 @@ if `erc-away' is non-nil."
(setq mode-line-buffer-identification
(list (format-spec erc-mode-line-format spec)))
(setq mode-line-process (list process-status))
- (when (boundp 'header-line-format)
- (let ((header (if erc-header-line-format
- (format-spec erc-header-line-format spec)
- nil)))
- (cond (erc-header-line-uses-tabbar-p
- (setq-local tabbar--local-hlf header-line-format)
- (kill-local-variable 'header-line-format))
- ((null header)
- (setq header-line-format nil))
- (erc-header-line-uses-help-echo-p
- (let ((help-echo (with-temp-buffer
- (insert header)
- (fill-region (point-min) (point-max))
- (buffer-string))))
- (setq header-line-format
- (replace-regexp-in-string
- "%"
- "%%"
- (if face
- (propertize header 'help-echo help-echo
- 'face face)
- (propertize header 'help-echo help-echo))))))
- (t (setq header-line-format
- (if face
- (propertize header 'face face)
- header)))))))
+ (let ((header (if erc-header-line-format
+ (format-spec erc-header-line-format spec)
+ nil)))
+ (cond (erc-header-line-uses-tabbar-p
+ (setq-local tabbar--local-hlf header-line-format)
+ (kill-local-variable 'header-line-format))
+ ((null header)
+ (setq header-line-format nil))
+ (erc-header-line-uses-help-echo-p
+ (let ((help-echo (with-temp-buffer
+ (insert header)
+ (fill-region (point-min) (point-max))
+ (buffer-string))))
+ (setq header-line-format
+ (replace-regexp-in-string
+ "%"
+ "%%"
+ (if face
+ (propertize header 'help-echo help-echo
+ 'face face)
+ (propertize header 'help-echo help-echo))))))
+ (t (setq header-line-format
+ (if face
+ (propertize header 'face face)
+ header))))))
(force-mode-line-update)))
(defun erc-update-mode-line (&optional buffer)
@@ -6783,8 +6758,7 @@ functions."
"")))))
-(defvar erc-current-message-catalog 'english)
-(make-variable-buffer-local 'erc-current-message-catalog)
+(defvar-local erc-current-message-catalog 'english)
(defun erc-retrieve-catalog-entry (entry &optional catalog)
"Retrieve ENTRY from CATALOG.
diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el
index 0200631..cbfe0b8 100644
--- a/lisp/eshell/em-cmpl.el
+++ b/lisp/eshell/em-cmpl.el
@@ -91,27 +91,23 @@ variable names, arguments, etc."
(defcustom eshell-cmpl-load-hook nil
"A list of functions to run when `eshell-cmpl' is loaded."
:version "24.1" ; removed eshell-cmpl-initialize
- :type 'hook
- :group 'eshell-cmpl)
+ :type 'hook)
(defcustom eshell-show-lisp-completions nil
"If non-nil, include Lisp functions in the command completion list.
If this variable is nil, Lisp completion can still be done in command
position by using M-TAB instead of TAB."
- :type 'boolean
- :group 'eshell-cmpl)
+ :type 'boolean)
(defcustom eshell-show-lisp-alternatives t
"If non-nil, and no other completions found, show Lisp functions.
Setting this variable means nothing if `eshell-show-lisp-completions'
is non-nil."
- :type 'boolean
- :group 'eshell-cmpl)
+ :type 'boolean)
(defcustom eshell-no-completion-during-jobs t
"If non-nil, don't allow completion while a process is running."
- :type 'boolean
- :group 'eshell-cmpl)
+ :type 'boolean)
(defcustom eshell-command-completions-alist
'(("acroread" . "\\.pdf\\'")
@@ -136,8 +132,7 @@ is non-nil."
"An alist that defines simple argument type correlations.
This is provided for common commands, as a simplistic alternative
to writing a completion function."
- :type '(repeat (cons string regexp))
- :group 'eshell-cmpl)
+ :type '(repeat (cons string regexp)))
(defun eshell-cmpl--custom-variable-docstring (pcomplete-var)
"Generate the docstring of a variable derived from a pcomplete-* variable."
@@ -148,23 +143,19 @@ to writing a completion function."
(defcustom eshell-cmpl-file-ignore "~\\'"
(eshell-cmpl--custom-variable-docstring 'pcomplete-file-ignore)
- :type (get 'pcomplete-file-ignore 'custom-type)
- :group 'eshell-cmpl)
+ :type (get 'pcomplete-file-ignore 'custom-type))
(defcustom eshell-cmpl-dir-ignore "\\`\\(\\.\\.?\\|CVS\\)/\\'"
(eshell-cmpl--custom-variable-docstring 'pcomplete-dir-ignore)
- :type (get 'pcomplete-dir-ignore 'custom-type)
- :group 'eshell-cmpl)
+ :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)
- :group 'eshell-cmpl)
+ (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)
- :type (get 'pcomplete-autolist 'custom-type)
- :group 'eshell-cmpl)
+ :type (get 'pcomplete-autolist 'custom-type))
(defcustom eshell-cmpl-suffix-list (list ?/ ?:)
(eshell-cmpl--custom-variable-docstring 'pcomplete-suffix-list)
@@ -176,51 +167,42 @@ to writing a completion function."
(defcustom eshell-cmpl-recexact nil
(eshell-cmpl--custom-variable-docstring 'pcomplete-recexact)
- :type (get 'pcomplete-recexact 'custom-type)
- :group 'eshell-cmpl)
+ :type (get 'pcomplete-recexact 'custom-type))
-(defcustom eshell-cmpl-man-function 'man
+(defcustom eshell-cmpl-man-function #'man
(eshell-cmpl--custom-variable-docstring 'pcomplete-man-function)
- :type (get 'pcomplete-man-function 'custom-type)
- :group 'eshell-cmpl)
+ :type (get 'pcomplete-man-function 'custom-type))
-(defcustom eshell-cmpl-compare-entry-function 'file-newer-than-file-p
+(defcustom eshell-cmpl-compare-entry-function #'file-newer-than-file-p
(eshell-cmpl--custom-variable-docstring 'pcomplete-compare-entry-function)
- :type (get 'pcomplete-compare-entry-function 'custom-type)
- :group 'eshell-cmpl)
+ :type (get 'pcomplete-compare-entry-function 'custom-type))
(defcustom eshell-cmpl-expand-before-complete nil
(eshell-cmpl--custom-variable-docstring 'pcomplete-expand-before-complete)
- :type (get 'pcomplete-expand-before-complete 'custom-type)
- :group 'eshell-cmpl)
+ :type (get 'pcomplete-expand-before-complete 'custom-type))
(defcustom eshell-cmpl-cycle-completions t
(eshell-cmpl--custom-variable-docstring 'pcomplete-cycle-completions)
- :type (get 'pcomplete-cycle-completions 'custom-type)
- :group 'eshell-cmpl)
+ :type (get 'pcomplete-cycle-completions 'custom-type))
(defcustom eshell-cmpl-cycle-cutoff-length 5
(eshell-cmpl--custom-variable-docstring 'pcomplete-cycle-cutoff-length)
- :type (get 'pcomplete-cycle-cutoff-length 'custom-type)
- :group 'eshell-cmpl)
+ :type (get 'pcomplete-cycle-cutoff-length 'custom-type))
(defcustom eshell-cmpl-restore-window-delay 1
(eshell-cmpl--custom-variable-docstring 'pcomplete-restore-window-delay)
- :type (get 'pcomplete-restore-window-delay 'custom-type)
- :group 'eshell-cmpl)
+ :type (get 'pcomplete-restore-window-delay 'custom-type))
(defcustom eshell-command-completion-function
(lambda ()
- (pcomplete-here (eshell-complete-commands-list)))
+ (pcomplete-here (eshell--complete-commands-list)))
(eshell-cmpl--custom-variable-docstring
'pcomplete-command-completion-function)
- :type (get 'pcomplete-command-completion-function 'custom-type)
- :group 'eshell-cmpl)
+ :type (get 'pcomplete-command-completion-function 'custom-type))
(defcustom eshell-cmpl-command-name-function
- 'eshell-completion-command-name
+ #'eshell-completion-command-name
(eshell-cmpl--custom-variable-docstring 'pcomplete-command-name-function)
- :type (get 'pcomplete-command-name-function 'custom-type)
- :group 'eshell-cmpl)
+ :type (get 'pcomplete-command-name-function 'custom-type))
(defcustom eshell-default-completion-function
(lambda ()
@@ -229,13 +211,11 @@ to writing a completion function."
(cdr (assoc (funcall eshell-cmpl-command-name-function)
eshell-command-completions-alist))))))
(eshell-cmpl--custom-variable-docstring
'pcomplete-default-completion-function)
- :type (get 'pcomplete-default-completion-function 'custom-type)
- :group 'eshell-cmpl)
+ :type (get 'pcomplete-default-completion-function 'custom-type))
(defcustom eshell-cmpl-use-paring t
(eshell-cmpl--custom-variable-docstring 'pcomplete-use-paring)
- :type (get 'pcomplete-use-paring 'custom-type)
- :group 'eshell-cmpl)
+ :type (get 'pcomplete-use-paring 'custom-type))
;;; Functions:
@@ -274,12 +254,12 @@ to writing a completion function."
(setq-local pcomplete-default-completion-function
eshell-default-completion-function)
(setq-local pcomplete-parse-arguments-function
- 'eshell-complete-parse-arguments)
+ #'eshell-complete-parse-arguments)
(setq-local pcomplete-file-ignore
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)
@@ -403,64 +383,65 @@ to writing a completion function."
args)
posns)))
-(defun eshell-complete-commands-list ()
+(defun eshell--complete-commands-list ()
"Generate list of applicable, visible commands."
- (let ((filename (pcomplete-arg)) glob-name)
- (if (file-name-directory filename)
- (if eshell-force-execution
- (pcomplete-dirs-or-entries nil #'file-readable-p)
- (pcomplete-executables))
- (if (and (> (length filename) 0)
- (eq (aref filename 0) eshell-explicit-command-char))
- (setq filename (substring filename 1)
- pcomplete-stub filename
- glob-name t))
- (let* ((paths (eshell-get-path))
- (cwd (file-name-as-directory
- (expand-file-name default-directory)))
- (path "") (comps-in-path ())
- (file "") (filepath "") (completions ()))
- ;; Go thru each path in the search path, finding completions.
- (while paths
- (setq path (file-name-as-directory
- (expand-file-name (or (car paths) ".")))
- comps-in-path
- (and (file-accessible-directory-p path)
- (file-name-all-completions filename path)))
- ;; Go thru each completion found, to see whether it should
- ;; be used.
- (while comps-in-path
- (setq file (car comps-in-path)
- filepath (concat path file))
- (if (and (not (member file completions)) ;
- (or (string-equal path cwd)
- (not (file-directory-p filepath)))
- (if eshell-force-execution
- (file-readable-p filepath)
- (file-executable-p filepath)))
- (setq completions (cons file completions)))
- (setq comps-in-path (cdr comps-in-path)))
- (setq paths (cdr paths)))
- ;; Add aliases which are currently visible, and Lisp functions.
- (pcomplete-uniquify-list
- (if glob-name
- completions
- (setq completions
- (append (if (fboundp 'eshell-alias-completions)
- (eshell-alias-completions filename))
- (eshell-winnow-list
- (mapcar
- (lambda (name)
- (substring name 7))
- (all-completions (concat "eshell/" filename)
- obarray #'functionp))
- nil '(eshell-find-alias-function))
- completions))
- (append (and (or eshell-show-lisp-completions
- (and eshell-show-lisp-alternatives
- (null completions)))
- (all-completions filename obarray #'functionp))
- completions)))))))
+ ;; Building the commands list can take quite a while, especially over Tramp
+ ;; (bug#41423), so do it lazily.
+ (let ((glob-name
+ ;; When a command is specified using `eshell-explicit-command-char',
+ ;; that char is not part of the command and hence not part of what
+ ;; we complete. Adjust `pcomplete-stub' accordingly!
+ (if (and (> (length pcomplete-stub) 0)
+ (eq (aref pcomplete-stub 0) eshell-explicit-command-char))
+ (setq pcomplete-stub (substring pcomplete-stub 1)))))
+ (completion-table-dynamic
+ (lambda (filename)
+ (if (file-name-directory filename)
+ (if eshell-force-execution
+ (pcomplete-dirs-or-entries nil #'file-readable-p)
+ (pcomplete-executables))
+ (let* ((paths (eshell-get-path))
+ (cwd (file-name-as-directory
+ (expand-file-name default-directory)))
+ (filepath "") (completions ()))
+ ;; Go thru each path in the search path, finding completions.
+ (dolist (path paths)
+ (setq path (file-name-as-directory
+ (expand-file-name (or path "."))))
+ ;; Go thru each completion found, to see whether it should
+ ;; be used.
+ (dolist (file (and (file-accessible-directory-p path)
+ (file-name-all-completions filename path)))
+ (setq filepath (concat path file))
+ (if (and (not (member file completions)) ;
+ (or (string-equal path cwd)
+ (not (file-directory-p filepath)))
+ ;; FIXME: Those repeated file tests end up
+ ;; very costly over Tramp, we should cache the result.
+ (if eshell-force-execution
+ (file-readable-p filepath)
+ (file-executable-p filepath)))
+ (push file completions))))
+ ;; Add aliases which are currently visible, and Lisp functions.
+ (pcomplete-uniquify-list
+ (if glob-name
+ completions
+ (setq completions
+ (append (if (fboundp 'eshell-alias-completions)
+ (eshell-alias-completions filename))
+ (eshell-winnow-list
+ (mapcar
+ (lambda (name)
+ (substring name 7))
+ (all-completions (concat "eshell/" filename)
+ obarray #'functionp))
+ nil '(eshell-find-alias-function))
+ completions))
+ (append (and (or eshell-show-lisp-completions
+ (and eshell-show-lisp-alternatives
+ (null completions)))
+ (all-completions filename obarray #'functionp))
+ completions)))))))))
(define-obsolete-function-alias 'eshell-pcomplete #'completion-at-point "27.1")
diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el
index 0d09ef4..b7b1778 100644
--- a/lisp/eshell/em-hist.el
+++ b/lisp/eshell/em-hist.el
@@ -99,8 +99,12 @@ If it is nil, Eshell will use the value of HISTFILE."
(defcustom eshell-hist-ignoredups nil
"If non-nil, don't add input matching the last on the input ring.
-This mirrors the optional behavior of bash."
- :type 'boolean)
+The value `erase' mirrors the \"erasedups\" value of HISTCONTROL
+in bash, and any other non-nil value mirrors the \"ignoredups\"
+value."
+ :type '(choice (const :tag "Don't ignore anything" nil)
+ (const :tag "Ignore consecutive duplicates" t)
+ (const :tag "Only keep last duplicate" 'erase)))
(defcustom eshell-save-history-on-exit t
"Determine if history should be automatically saved.
@@ -371,12 +375,22 @@ unless a different file is specified on the command
line.")
Input is entered into the input history ring, if the value of
variable `eshell-input-filter' returns non-nil when called on the
input."
- (if (and (funcall eshell-input-filter input)
- (or (null eshell-hist-ignoredups)
- (not (ring-p eshell-history-ring))
- (ring-empty-p eshell-history-ring)
- (not (string-equal (eshell-get-history 0) input))))
- (eshell-put-history input))
+ (when (and (funcall eshell-input-filter input)
+ (if (eq eshell-hist-ignoredups 'erase)
+ ;; Remove any old occurrences of the input, and put
+ ;; the new one at the end.
+ (progn
+ (ring-remove eshell-history-ring
+ (ring-member eshell-history-ring input))
+ t)
+ ;; Always add...
+ (or (null eshell-hist-ignoredups)
+ ;; ... or add if it's not already present at the
+ ;; end.
+ (not (ring-p eshell-history-ring))
+ (ring-empty-p eshell-history-ring)
+ (not (string-equal (eshell-get-history 0) input)))))
+ (eshell-put-history input))
(setq eshell-save-history-index eshell-history-index)
(setq eshell-history-index nil))
diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el
index 4d63467..daca035 100644
--- a/lisp/eshell/esh-cmd.el
+++ b/lisp/eshell/esh-cmd.el
@@ -1001,7 +1001,7 @@ be finished later after the completion of an asynchronous
subprocess."
;; expand any macros directly into the form. This is done so that
;; we can modify any `let' forms to evaluate only once.
(if (macrop (car form))
- (let ((exp (eshell-copy-tree (macroexpand form))))
+ (let ((exp (copy-tree (macroexpand form))))
(eshell-manipulate (format-message "expanding macro `%s'"
(symbol-name (car form)))
(setcar form (car exp))
@@ -1009,7 +1009,7 @@ be finished later after the completion of an asynchronous
subprocess."
(let ((args (cdr form)))
(cond
((eq (car form) 'while)
- ;; `eshell-copy-tree' is needed here so that the test argument
+ ;; `copy-tree' is needed here so that the test argument
;; doesn't get modified and thus always yield the same result.
(when (car eshell-command-body)
(cl-assert (not synchronous-p))
@@ -1017,27 +1017,27 @@ be finished later after the completion of an
asynchronous subprocess."
(setcar eshell-command-body nil)
(setcar eshell-test-body nil))
(unless (car eshell-test-body)
- (setcar eshell-test-body (eshell-copy-tree (car args))))
+ (setcar eshell-test-body (copy-tree (car args))))
(while (cadr (eshell-do-eval (car eshell-test-body)))
(setcar eshell-command-body
(if (cddr args)
- `(progn ,@(eshell-copy-tree (cdr args)))
- (eshell-copy-tree (cadr args))))
+ `(progn ,@(copy-tree (cdr args)))
+ (copy-tree (cadr args))))
(eshell-do-eval (car eshell-command-body) synchronous-p)
(setcar eshell-command-body nil)
- (setcar eshell-test-body (eshell-copy-tree (car args))))
+ (setcar eshell-test-body (copy-tree (car args))))
(setcar eshell-command-body nil))
((eq (car form) 'if)
- ;; `eshell-copy-tree' is needed here so that the test argument
+ ;; `copy-tree' is needed here so that the test argument
;; doesn't get modified and thus always yield the same result.
(if (car eshell-command-body)
(progn
(cl-assert (not synchronous-p))
(eshell-do-eval (car eshell-command-body)))
(unless (car eshell-test-body)
- (setcar eshell-test-body (eshell-copy-tree (car args))))
+ (setcar eshell-test-body (copy-tree (car args))))
(setcar eshell-command-body
- (eshell-copy-tree
+ (copy-tree
(if (cadr (eshell-do-eval (car eshell-test-body)))
(cadr args)
(car (cddr args)))))
diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el
index 872e3b5..8ef1ac9 100644
--- a/lisp/eshell/esh-util.el
+++ b/lisp/eshell/esh-util.el
@@ -235,11 +235,10 @@ If N or M is nil, it means the end of the list."
a (last a)))
a))
-(defvar eshell-path-env (getenv "PATH")
+(defvar-local eshell-path-env (getenv "PATH")
"Content of $PATH.
It might be different from \(getenv \"PATH\"), when
`default-directory' points to a remote host.")
-(make-variable-buffer-local 'eshell-path-env)
(defun eshell-get-path ()
"Return $PATH as a list.
@@ -486,8 +485,6 @@ list."
"Return the user id for user NAME."
(car (rassoc name (eshell-read-user-names))))
-(defalias 'eshell-user-name 'user-login-name)
-
(autoload 'pcomplete-read-hosts-file "pcomplete")
(autoload 'pcomplete-read-hosts "pcomplete")
(autoload 'pcomplete-read-host-names "pcomplete")
@@ -644,8 +641,6 @@ gid format. Valid values are `string' and `integer',
defaulting to
entry)
(file-attributes file id-format))))
-(defalias 'eshell-copy-tree 'copy-tree)
-
(defsubst eshell-processp (proc)
"If the `processp' function does not exist, PROC is not a process."
(and (fboundp 'processp) (processp proc)))
@@ -715,6 +710,9 @@ gid format. Valid values are `string' and `integer',
defaulting to
; (or result
; (file-attributes filename))))
+(define-obsolete-function-alias 'eshell-copy-tree #'copy-tree "28.1")
+(define-obsolete-function-alias 'eshell-user-name #'user-login-name "28.1")
+
(provide 'esh-util)
;;; esh-util.el ends here
diff --git a/lisp/expand.el b/lisp/expand.el
index 5c0b5f4..9df8d9f 100644
--- a/lisp/expand.el
+++ b/lisp/expand.el
@@ -289,17 +289,14 @@ If ARG is omitted, point is placed at the end of the
expanded text."
(defvar expand-list nil "Temporary variable used by the Expand package.")
-(defvar expand-pos nil
+(defvar-local expand-pos nil
"If non-nil, store a vector with position markers defined by the last
expansion.")
-(make-variable-buffer-local 'expand-pos)
-(defvar expand-index 0
+(defvar-local expand-index 0
"Index of the last marker used in `expand-pos'.")
-(make-variable-buffer-local 'expand-index)
-(defvar expand-point nil
+(defvar-local expand-point nil
"End of the expanded region.")
-(make-variable-buffer-local 'expand-point)
(defun expand-add-abbrev (table abbrev expansion arg)
"Add one abbreviation and provide the hook to move to the specified
positions."
diff --git a/lisp/face-remap.el b/lisp/face-remap.el
index c53b20f..5914ee4 100644
--- a/lisp/face-remap.el
+++ b/lisp/face-remap.el
@@ -217,21 +217,17 @@ Each positive or negative step scales the default face
height by this amount."
:type 'number
:version "23.1")
-;; current remapping cookie for text-scale-mode
-(defvar text-scale-mode-remapping nil)
-(make-variable-buffer-local 'text-scale-mode-remapping)
+(defvar-local text-scale-mode-remapping nil
+ "Current remapping cookie for text-scale-mode.")
-;; Lighter displayed for text-scale-mode in mode-line minor-mode list
-(defvar text-scale-mode-lighter "+0")
-(make-variable-buffer-local 'text-scale-mode-lighter)
+(defvar-local text-scale-mode-lighter "+0"
+ "Lighter displayed for text-scale-mode in mode-line minor-mode list.")
-;; Number of steps that text-scale-mode will increase/decrease text height
-(defvar text-scale-mode-amount 0)
-(make-variable-buffer-local 'text-scale-mode-amount)
+(defvar-local text-scale-mode-amount 0
+ "Number of steps that text-scale-mode will increase/decrease text height.")
-(defvar text-scale-remap-header-line nil
+(defvar-local text-scale-remap-header-line nil
"If non-nil, text scaling may change font size of header lines too.")
-(make-variable-buffer-local 'text-scale-header-line)
(defun face-remap--clear-remappings ()
(dolist (remapping
@@ -358,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
@@ -413,8 +409,7 @@ plist, etc."
:version "23.1")
;; current remapping cookie for buffer-face-mode
-(defvar buffer-face-mode-remapping nil)
-(make-variable-buffer-local 'buffer-face-mode-remapping)
+(defvar-local buffer-face-mode-remapping nil)
;;;###autoload
(define-minor-mode buffer-face-mode
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/ffap.el b/lisp/ffap.el
index 1f43baf..6faf8d5 100644
--- a/lisp/ffap.el
+++ b/lisp/ffap.el
@@ -1675,9 +1675,8 @@ For example, try \":/\" for URL (and some FTP)
references."
:type '(choice (const nil) regexp)
:group 'ffap)
-(defvar ffap-menu-alist nil
+(defvar-local ffap-menu-alist nil
"Buffer local cache of menu presented by `ffap-menu'.")
-(make-variable-buffer-local 'ffap-menu-alist)
(defvar ffap-menu-text-plist
(cond
diff --git a/lisp/files-x.el b/lisp/files-x.el
index 628bf18..526a128 100644
--- a/lisp/files-x.el
+++ b/lisp/files-x.el
@@ -570,13 +570,12 @@ from the MODE alist ignoring the input argument VALUE."
(defvar enable-connection-local-variables t
"Non-nil means enable use of connection-local variables.")
-(defvar connection-local-variables-alist nil
+(defvar-local connection-local-variables-alist nil
"Alist of connection-local variable settings in the current buffer.
Each element in this list has the form (VAR . VALUE), where VAR
is a connection-local variable (a symbol) and VALUE is its value.
The actual value in the buffer may differ from VALUE, if it is
changed by the user.")
-(make-variable-buffer-local 'connection-local-variables-alist)
(setq ignored-local-variables
(cons 'connection-local-variables-alist ignored-local-variables))
diff --git a/lisp/files.el b/lisp/files.el
index 5adbb43..4c56b5f 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -191,20 +191,18 @@ if the file has changed on disk and you have not edited
the buffer."
:type '(repeat regexp)
:group 'find-file)
-(defvar buffer-file-number nil
+(defvar-local buffer-file-number nil
"The device number and file number of the file visited in the current buffer.
The value is a list of the form (FILENUM DEVNUM).
This pair of numbers uniquely identifies the file.
If the buffer is visiting a new file, the value is nil.")
-(make-variable-buffer-local 'buffer-file-number)
(put 'buffer-file-number 'permanent-local t)
(defvar buffer-file-numbers-unique (not (memq system-type '(windows-nt)))
"Non-nil means that `buffer-file-number' uniquely identifies files.")
-(defvar buffer-file-read-only nil
+(defvar-local buffer-file-read-only nil
"Non-nil if visited file was read-only when visited.")
-(make-variable-buffer-local 'buffer-file-read-only)
(defcustom small-temporary-file-directory
(if (eq system-type 'ms-dos) (getenv "TMPDIR"))
@@ -529,15 +527,14 @@ updates before the buffer is saved, use
`before-save-hook'.")
(put 'write-file-functions 'permanent-local t)
;; I found some files still using the obsolete form in 2018.
-(defvar local-write-file-hooks nil)
-(make-variable-buffer-local 'local-write-file-hooks)
+(defvar-local local-write-file-hooks nil)
(put 'local-write-file-hooks 'permanent-local t)
(make-obsolete-variable 'local-write-file-hooks 'write-file-functions "22.1")
;; I found some files still using the obsolete form in 2018.
(define-obsolete-variable-alias 'write-contents-hooks
'write-contents-functions "22.1")
-(defvar write-contents-functions nil
+(defvar-local write-contents-functions nil
"List of functions to be called before writing out a buffer to a file.
Used only by `save-buffer'. If one of them returns non-nil, the
@@ -556,7 +553,6 @@ For hooks that _do_ pertain to the particular visited file,
use
`write-file-functions' relate to how a buffer is saved to file.
To perform various checks or updates before the buffer is saved,
use `before-save-hook'.")
-(make-variable-buffer-local 'write-contents-functions)
(defcustom enable-local-variables t
"Control use of local variables in files you visit.
@@ -2539,13 +2535,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
@@ -2562,13 +2556,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))))
@@ -3448,23 +3441,21 @@ asking you for confirmation."
(put 'c-set-style 'safe-local-eval-function t)
-(defvar file-local-variables-alist nil
+(defvar-local file-local-variables-alist nil
"Alist of file-local variable settings in the current buffer.
Each element in this list has the form (VAR . VALUE), where VAR
is a file-local variable (a symbol) and VALUE is the value
specified. The actual value in the buffer may differ from VALUE,
if it is changed by the major or minor modes, or by the user.")
-(make-variable-buffer-local 'file-local-variables-alist)
(put 'file-local-variables-alist 'permanent-local t)
-(defvar dir-local-variables-alist nil
+(defvar-local dir-local-variables-alist nil
"Alist of directory-local variable settings in the current buffer.
Each element in this list has the form (VAR . VALUE), where VAR
is a directory-local variable (a symbol) and VALUE is the value
specified in .dir-locals.el. The actual value in the buffer
may differ from VALUE, if it is changed by the major or minor modes,
or by the user.")
-(make-variable-buffer-local 'dir-local-variables-alist)
(defvar before-hack-local-variables-hook nil
"Normal hook run before setting file-local variables.
@@ -5238,7 +5229,7 @@ Used only by `save-buffer'."
:type 'hook
:group 'files)
-(defvar save-buffer-coding-system nil
+(defvar-local save-buffer-coding-system nil
"If non-nil, use this coding system for saving the buffer.
More precisely, use this coding system in place of the
value of `buffer-file-coding-system', when saving the buffer.
@@ -5246,7 +5237,6 @@ Calling `write-region' for any purpose other than saving
the buffer
will still use `buffer-file-coding-system'; this variable has no effect
in such cases.")
-(make-variable-buffer-local 'save-buffer-coding-system)
(put 'save-buffer-coding-system 'permanent-local t)
(defun basic-save-buffer (&optional called-interactively)
@@ -5515,9 +5505,8 @@ Before and after saving the buffer, this function runs
"ACTION-ALIST argument used in call to `map-y-or-n-p'.")
(put 'save-some-buffers-action-alist 'risky-local-variable t)
-(defvar buffer-save-without-query nil
+(defvar-local buffer-save-without-query nil
"Non-nil means `save-some-buffers' should save this buffer without asking.")
-(make-variable-buffer-local 'buffer-save-without-query)
(defcustom save-some-buffers-default-predicate nil
"Default predicate for `save-some-buffers'.
diff --git a/lisp/foldout.el b/lisp/foldout.el
index 4c479d6..2de49d2 100644
--- a/lisp/foldout.el
+++ b/lisp/foldout.el
@@ -209,14 +209,12 @@
(require 'outline)
-(defvar foldout-fold-list nil
+(defvar-local foldout-fold-list nil
"List of start and end markers for the folds currently entered.
An end marker of nil means the fold ends after (point-max).")
-(make-variable-buffer-local 'foldout-fold-list)
-(defvar foldout-mode-line-string nil
+(defvar-local foldout-mode-line-string nil
"Mode line string announcing that we are in an outline fold.")
-(make-variable-buffer-local 'foldout-mode-line-string)
;; put our minor mode string immediately following outline-minor-mode's
(or (assq 'foldout-mode-line-string minor-mode-alist)
diff --git a/lisp/follow.el b/lisp/follow.el
index 292dc4a..0697587 100644
--- a/lisp/follow.el
+++ b/lisp/follow.el
@@ -1140,9 +1140,8 @@ Otherwise, return nil."
;; is nil. Start every window directly after the end of the previous
;; window, to make sure long lines are displayed correctly.
-(defvar follow-start-end-invalid t
+(defvar-local follow-start-end-invalid t
"When non-nil, indicates `follow-windows-start-end-cache' is invalid.")
-(make-variable-buffer-local 'follow-start-end-invalid)
(defun follow-redisplay (&optional windows win preserve-win)
"Reposition the WINDOWS around WIN.
diff --git a/lisp/font-core.el b/lisp/font-core.el
index 0f1a3d1..4b69542 100644
--- a/lisp/font-core.el
+++ b/lisp/font-core.el
@@ -26,7 +26,7 @@
;; This variable is used by mode packages that support Font Lock mode by
;; defining their own keywords to use for `font-lock-keywords'. (The mode
;; command should make it buffer-local and set it to provide the set up.)
-(defvar font-lock-defaults nil
+(defvar-local font-lock-defaults nil
"Defaults for Font Lock mode specified by the major mode.
Defaults should be of the form:
@@ -66,7 +66,6 @@ functions, `font-lock-fontify-buffer-function',
`font-lock-unfontify-region-function', and `font-lock-inhibit-thing-lock'.")
;;;###autoload
(put 'font-lock-defaults 'risky-local-variable t)
-(make-variable-buffer-local 'font-lock-defaults)
(defvar font-lock-function 'font-lock-default-function
"A function which is called when `font-lock-mode' is toggled.
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index a9fc69d..c344a61 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -515,17 +515,15 @@ This is normally set via `font-lock-add-keywords' and
"Non-nil means Font Lock should not fontify comments or strings.
This is normally set via `font-lock-defaults'.")
-(defvar font-lock-keywords-case-fold-search nil
+(defvar-local font-lock-keywords-case-fold-search nil
"Non-nil means the patterns in `font-lock-keywords' are case-insensitive.
This is set via the function `font-lock-set-defaults', based on
the CASE-FOLD argument of `font-lock-defaults'.")
-(make-variable-buffer-local 'font-lock-keywords-case-fold-search)
-(defvar font-lock-syntactically-fontified 0
+(defvar-local font-lock-syntactically-fontified 0
"Point up to which `font-lock-syntactic-keywords' has been applied.
If nil, this is ignored, in which case the syntactic fontification may
sometimes be slightly incorrect.")
-(make-variable-buffer-local 'font-lock-syntactically-fontified)
(defvar font-lock-syntactic-face-function
(lambda (state)
@@ -1026,7 +1024,7 @@ The value of this variable is used when Font Lock mode is
turned on."
;; directives correctly and cleanly. (It is the same problem as fontifying
;; multi-line strings and comments; regexps are not appropriate for the job.)
-(defvar font-lock-extend-after-change-region-function nil
+(defvar-local font-lock-extend-after-change-region-function nil
"A function that determines the region to refontify after a change.
This variable is either nil, or is a function that determines the
@@ -1040,7 +1038,6 @@ and end buffer positions \(in that order) of the region
to refontify, or nil
\(which directs the caller to fontify a default region).
This function should preserve the match-data.
The region it returns may start or end in the middle of a line.")
-(make-variable-buffer-local 'font-lock-extend-after-change-region-function)
(defun font-lock-fontify-buffer (&optional interactively)
"Fontify the current buffer the way the function `font-lock-mode' would."
@@ -1159,7 +1156,7 @@ a very meaningful entity to highlight.")
(defvar font-lock-beg) (defvar font-lock-end)
-(defvar font-lock-extend-region-functions
+(defvar-local font-lock-extend-region-functions
'(font-lock-extend-region-wholelines
;; This use of font-lock-multiline property is unreliable but is just
;; a handy heuristic: in case you don't have a function that does
@@ -1181,7 +1178,6 @@ These functions are run in turn repeatedly until they all
return nil.
Put first the functions more likely to cause a change and cheaper to compute.")
;; Mark it as a special hook which doesn't use any global setting
;; (i.e. doesn't obey the element t in the buffer-local value).
-(make-variable-buffer-local 'font-lock-extend-region-functions)
(defun font-lock-extend-region-multiline ()
"Move fontification boundaries away from any `font-lock-multiline' property."
@@ -1888,9 +1884,8 @@ preserve `hi-lock-mode' highlighting patterns."
(kill-local-variable 'font-lock-set-defaults)
(font-lock-mode 1))
-(defvar font-lock-major-mode nil
+(defvar-local font-lock-major-mode nil
"Major mode for which the font-lock settings have been setup.")
-(make-variable-buffer-local 'font-lock-major-mode)
(defun font-lock-set-defaults ()
"Set fontification defaults appropriately for this mode.
diff --git a/lisp/forms.el b/lisp/forms.el
index 5d7e6dd..62c4288 100644
--- a/lisp/forms.el
+++ b/lisp/forms.el
@@ -418,9 +418,8 @@ Also, initial position is at last record."
(defvar forms--parser nil
"Forms parser routine.")
-(defvar forms--mode-setup nil
+(defvar-local forms--mode-setup nil
"To keep track of forms-mode being set-up.")
-(make-variable-buffer-local 'forms--mode-setup)
(defvar forms--dynamic-text nil
"Array that holds dynamic texts to insert between fields.")
diff --git a/lisp/frame.el b/lisp/frame.el
index 06aab26..ce4de83 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/canlock.el b/lisp/gnus/canlock.el
index 6c8c1a5..dbdbaa8 100644
--- a/lisp/gnus/canlock.el
+++ b/lisp/gnus/canlock.el
@@ -1,4 +1,4 @@
-;;; canlock.el --- functions for Cancel-Lock feature
+;;; canlock.el --- functions for Cancel-Lock feature -*- lexical-binding: t;
-*-
;; Copyright (C) 1998-1999, 2001-2021 Free Software Foundation, Inc.
@@ -30,7 +30,7 @@
;; Key) header in a news article by using a hook which will be evaluated
;; just before sending an article as follows:
;;
-;; (add-hook '*e**a*e-header-hook 'canlock-insert-header t)
+;; (add-hook '*e**a*e-header-hook #'canlock-insert-header t)
;;
;; Verifying Cancel-Lock is mainly a function of news servers, however,
;; you can verify your own article using the command `canlock-verify' in
@@ -52,20 +52,17 @@
(defcustom canlock-password nil
"Password to use when signing a Cancel-Lock or a Cancel-Key header."
:type '(radio (const :format "Not specified " nil)
- (string :tag "Password"))
- :group 'canlock)
+ (string :tag "Password")))
(defcustom canlock-password-for-verify canlock-password
"Password to use when verifying a Cancel-Lock or a Cancel-Key header."
:type '(radio (const :format "Not specified " nil)
- (string :tag "Password"))
- :group 'canlock)
+ (string :tag "Password")))
(defcustom canlock-force-insert-header nil
"If non-nil, insert a Cancel-Lock or a Cancel-Key header even if the
buffer does not look like a news message."
- :type 'boolean
- :group 'canlock)
+ :type 'boolean)
(defun canlock-sha1 (message)
"Make a SHA-1 digest of MESSAGE as a unibyte string of length 20 bytes."
diff --git a/lisp/gnus/deuglify.el b/lisp/gnus/deuglify.el
index b77dcdd..08beef7 100644
--- a/lisp/gnus/deuglify.el
+++ b/lisp/gnus/deuglify.el
@@ -1,4 +1,4 @@
-;;; deuglify.el --- deuglify broken Outlook (Express) articles
+;;; deuglify.el --- deuglify broken Outlook (Express) articles -*-
lexical-binding: t; -*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
@@ -155,15 +155,15 @@
;; To automatically invoke deuglification on every article you read,
;; put something like that in your .gnus:
;;
-;; (add-hook 'gnus-article-decode-hook 'gnus-article-outlook-unwrap-lines)
+;; (add-hook 'gnus-article-decode-hook #'gnus-article-outlook-unwrap-lines)
;;
;; or _one_ of the following lines:
;;
;; ;; repair broken attribution lines
-;; (add-hook 'gnus-article-decode-hook
'gnus-article-outlook-repair-attribution)
+;; (add-hook 'gnus-article-decode-hook
#'gnus-article-outlook-repair-attribution)
;;
;; ;; repair broken attribution lines and citations
-;; (add-hook 'gnus-article-decode-hook
'gnus-article-outlook-rearrange-citation)
+;; (add-hook 'gnus-article-decode-hook
#'gnus-article-outlook-rearrange-citation)
;;
;; Note that there always may be some false positives, so I suggest
;; using the manual invocation. After deuglification you may want to
@@ -234,20 +234,17 @@
(defcustom gnus-outlook-deuglify-unwrap-min 45
"Minimum length of the cited line above the (possibly) wrapped line."
:version "22.1"
- :type 'integer
- :group 'gnus-outlook-deuglify)
+ :type 'integer)
(defcustom gnus-outlook-deuglify-unwrap-max 95
"Maximum length of the cited line after unwrapping."
:version "22.1"
- :type 'integer
- :group 'gnus-outlook-deuglify)
+ :type 'integer)
(defcustom gnus-outlook-deuglify-cite-marks ">|#%"
"Characters that indicate cited lines."
:version "22.1"
- :type 'string
- :group 'gnus-outlook-deuglify)
+ :type 'string)
(defcustom gnus-outlook-deuglify-unwrap-stop-chars nil ;; ".?!" or nil
"Characters that, when at end of cited line, inhibit unwrapping.
@@ -255,44 +252,38 @@ When one of these characters is the last one on the cited
line
above the possibly wrapped line, it disallows unwrapping."
:version "22.1"
:type '(radio (const :format "None " nil)
- (string :value ".?!"))
- :group 'gnus-outlook-deuglify)
+ (string :value ".?!")))
(defcustom gnus-outlook-deuglify-no-wrap-chars "`"
"Characters that, when at beginning of line, inhibit unwrapping.
When one of these characters is the first one in the possibly
wrapped line, it disallows unwrapping."
:version "22.1"
- :type 'string
- :group 'gnus-outlook-deuglify)
+ :type 'string)
(defcustom gnus-outlook-deuglify-attrib-cut-regexp
"\\(On \\|Am \\)?\\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\),[^,]+, "
"Regexp matching beginning of attribution line that should be cut off."
:version "22.1"
- :type 'regexp
- :group 'gnus-outlook-deuglify)
+ :type 'regexp)
(defcustom gnus-outlook-deuglify-attrib-verb-regexp
"wrote\\|writes\\|says\\|schrieb\\|schreibt\\|meinte\\|skrev\\|a
écrit\\|schreef\\|escribió"
"Regular expression matching the verb used in an attribution line."
:version "22.1"
- :type 'regexp
- :group 'gnus-outlook-deuglify)
+ :type 'regexp)
(defcustom gnus-outlook-deuglify-attrib-end-regexp
": *\\|\\.\\.\\."
"Regular expression matching the end of an attribution line."
:version "22.1"
- :type 'regexp
- :group 'gnus-outlook-deuglify)
+ :type 'regexp)
(defcustom gnus-outlook-display-hook nil
"A hook called after a deuglified article has been prepared.
It is run after `gnus-article-prepare-hook'."
:version "22.1"
- :type 'hook
- :group 'gnus-outlook-deuglify)
+ :type 'hook)
;; Functions
@@ -345,7 +336,8 @@ NODISPLAY is non-nil, don't redisplay the article buffer."
"Put text from ATTR-START to the end of buffer at the top of the article
buffer."
;; FIXME: 1. (*) text/plain ( ) text/html
(let ((inhibit-read-only t)
- (cite-marks gnus-outlook-deuglify-cite-marks))
+ ;; (cite-marks gnus-outlook-deuglify-cite-marks)
+ )
(gnus-with-article-buffer
(article-goto-body)
;; article does not start with attribution
diff --git a/lisp/gnus/gmm-utils.el b/lisp/gnus/gmm-utils.el
index ab97c59..bcf8dd0 100644
--- a/lisp/gnus/gmm-utils.el
+++ b/lisp/gnus/gmm-utils.el
@@ -1,4 +1,4 @@
-;;; gmm-utils.el --- Utility functions for Gnus, Message and MML
+;;; gmm-utils.el --- Utility functions for Gnus, Message and MML -*-
lexical-binding: t; -*-
;; Copyright (C) 2006-2021 Free Software Foundation, Inc.
@@ -42,8 +42,7 @@ The higher the number, the more messages will flash to say
what
it did. At zero, it will be totally mute; at five, it will
display most important messages; and at ten, it will keep on
jabbering all the time."
- :type 'integer
- :group 'gmm)
+ :type 'integer)
;;;###autoload
(defun gmm-regexp-concat (regexp)
@@ -69,18 +68,18 @@ Guideline for numbers:
7 - not very important messages on stuff
9 - messages inside loops."
(if (<= level gmm-verbose)
- (apply 'message args)
+ (apply #'message args)
;; We have to do this format thingy here even if the result isn't
;; shown - the return value has to be the same as the return value
;; from `message'.
- (apply 'format args)))
+ (apply #'format args)))
;;;###autoload
(defun gmm-error (level &rest args)
"Beep an error if LEVEL is equal to or less than `gmm-verbose'.
ARGS are passed to `message'."
(when (<= (floor level) gmm-verbose)
- (apply 'message args)
+ (apply #'message args)
(ding)
(let (duration)
(when (and (floatp level)
@@ -175,8 +174,7 @@ ARGS are passed to `message'."
'retro)
"Preferred tool bar style."
:type '(choice (const :tag "GNOME style" gnome)
- (const :tag "Retro look" retro))
- :group 'gmm)
+ (const :tag "Retro look" retro)))
(defvar tool-bar-map)
@@ -215,25 +213,25 @@ DEFAULT-MAP specifies the default key map for ICON-LIST."
;; The dummy `gmm-ignore', see `gmm-tool-bar-item'
;; widget. Suppress tooltip by adding `:enable nil'.
(if (fboundp 'tool-bar-local-item)
- (apply 'tool-bar-local-item icon nil nil
+ (apply #'tool-bar-local-item icon nil nil
map :enable nil props)
;; (tool-bar-local-item ICON DEF KEY MAP &rest PROPS)
;; (tool-bar-add-item ICON DEF KEY &rest PROPS)
- (apply 'tool-bar-add-item icon nil nil :enable nil
props)))
+ (apply #'tool-bar-add-item icon nil nil :enable nil
props)))
((equal fmap t) ;; Not a menu command
- (apply 'tool-bar-local-item
+ (apply #'tool-bar-local-item
icon command
(intern icon) ;; reuse icon or fmap here?
map props))
(t ;; A menu command
- (apply 'tool-bar-local-item-from-menu
+ (apply #'tool-bar-local-item-from-menu
;; (apply 'tool-bar-local-item icon def key
;; tool-bar-map props)
command icon map (symbol-value fmap)
props)))
t))
(if (symbolp icon-list)
- (eval icon-list)
+ (symbol-value icon-list)
icon-list))
map))
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index 56640ea..cbe3505 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -1,4 +1,4 @@
-;;; gnus-agent.el --- unplugged support for Gnus
+;;; gnus-agent.el --- unplugged support for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
@@ -248,9 +248,9 @@ Actually a hash table holding subjects mapped to t.")
(gnus-agent-read-servers)
(gnus-category-read)
(gnus-agent-create-buffer)
- (add-hook 'gnus-group-mode-hook 'gnus-agent-mode)
- (add-hook 'gnus-summary-mode-hook 'gnus-agent-mode)
- (add-hook 'gnus-server-mode-hook 'gnus-agent-mode))
+ (add-hook 'gnus-group-mode-hook #'gnus-agent-mode)
+ (add-hook 'gnus-summary-mode-hook #'gnus-agent-mode)
+ (add-hook 'gnus-server-mode-hook #'gnus-agent-mode))
(defun gnus-agent-create-buffer ()
(if (gnus-buffer-live-p gnus-agent-overview-buffer)
@@ -422,15 +422,13 @@ manipulated as follows:
(defmacro gnus-agent-with-fetch (&rest forms)
"Do FORMS safely."
+ (declare (indent 0) (debug t))
`(unwind-protect
(let ((gnus-agent-fetching t))
(gnus-agent-start-fetch)
,@forms)
(gnus-agent-stop-fetch)))
-(put 'gnus-agent-with-fetch 'lisp-indent-function 0)
-(put 'gnus-agent-with-fetch 'edebug-form-spec '(body))
-
(defmacro gnus-agent-append-to-list (tail value)
`(setq ,tail (setcdr ,tail (cons ,value nil))))
@@ -573,14 +571,12 @@ manipulated as follows:
(set-buffer-modified-p t))
(defmacro gnus-agent-while-plugged (&rest body)
+ (declare (indent 0) (debug t))
`(let ((original-gnus-plugged gnus-plugged))
- (unwind-protect
- (progn (gnus-agent-toggle-plugged t)
- ,@body)
- (gnus-agent-toggle-plugged original-gnus-plugged))))
-
-(put 'gnus-agent-while-plugged 'lisp-indent-function 0)
-(put 'gnus-agent-while-plugged 'edebug-form-spec '(body))
+ (unwind-protect
+ (progn (gnus-agent-toggle-plugged t)
+ ,@body)
+ (gnus-agent-toggle-plugged original-gnus-plugged))))
(defun gnus-agent-close-connections ()
"Close all methods covered by the Gnus agent."
@@ -705,7 +701,7 @@ be a select method."
(message-narrow-to-headers)
(let* ((gcc (mail-fetch-field "gcc" nil t))
(methods (and gcc
- (mapcar 'gnus-inews-group-method
+ (mapcar #'gnus-inews-group-method
(message-unquote-tokens
(message-tokenize-header
gcc " ,")))))
@@ -739,7 +735,7 @@ be a select method."
(interactive "P")
(unless gnus-plugged
(error "Groups can't be fetched when Gnus is unplugged"))
- (gnus-group-iterate n 'gnus-agent-fetch-group))
+ (gnus-group-iterate n #'gnus-agent-fetch-group))
(defun gnus-agent-fetch-group (&optional group)
"Put all new articles in GROUP into the Agent."
@@ -824,7 +820,7 @@ be a select method."
(condition-case err
(while t
(let ((bgn (point)))
- (eval (read (current-buffer)))
+ (eval (read (current-buffer)) t)
(delete-region bgn (point))))
(end-of-file
(delete-file (gnus-agent-lib-file "flags")))
@@ -1061,7 +1057,8 @@ article's mark is toggled."
(let* ((alist (gnus-agent-load-alist gnus-newsgroup-name))
(headers (sort (mapcar (lambda (h)
(mail-header-number h))
- gnus-newsgroup-headers) '<))
+ gnus-newsgroup-headers)
+ #'<))
(cached (and gnus-use-cache gnus-newsgroup-cached))
(undownloaded (list nil))
(tail-undownloaded undownloaded)
@@ -1132,7 +1129,7 @@ downloadable."
(when gnus-newsgroup-processable
(setq gnus-newsgroup-downloadable
(let* ((dl gnus-newsgroup-downloadable)
- (processable (sort (copy-tree gnus-newsgroup-processable) '<))
+ (processable (sort (copy-tree gnus-newsgroup-processable) #'<))
(gnus-newsgroup-downloadable processable))
(gnus-agent-summary-fetch-group)
@@ -1824,7 +1821,7 @@ article numbers will be returned."
(dolist (arts (gnus-info-marks (gnus-get-info group)))
(unless (memq (car arts) '(seen recent killed cache))
(setq articles (gnus-range-add articles (cdr arts)))))
- (setq articles (sort (gnus-uncompress-sequence articles) '<)))
+ (setq articles (sort (gnus-uncompress-sequence articles) #'<)))
;; At this point, I have the list of articles to consider for
;; fetching. This is the list that I'll return to my caller. Some
@@ -2070,7 +2067,7 @@ doesn't exist, to valid the overview buffer."
alist (cdr alist))
(while sequence
(push (cons (pop sequence) state) uncomp)))
- (setq alist (sort uncomp 'car-less-than-car)))
+ (setq alist (sort uncomp #'car-less-than-car)))
(setq changed-version (not (= 2
gnus-agent-article-alist-save-format)))))
(when changed-version
(let ((gnus-agent-article-alist alist))
@@ -2412,13 +2409,13 @@ modified) original contents, they are first saved to
their own file."
(setq marked-articles (nconc (gnus-uncompress-range arts)
marked-articles))
))))
- (setq marked-articles (sort marked-articles '<))
+ (setq marked-articles (sort marked-articles #'<))
;; Fetch any new articles from the server
(setq articles (gnus-agent-fetch-headers group))
;; Merge new articles with marked
- (setq articles (sort (append marked-articles articles) '<))
+ (setq articles (sort (append marked-articles articles) #'<))
(when articles
;; Parse them and see which articles we want to fetch.
@@ -2669,7 +2666,7 @@ The following commands are available:
(point)
(prog1 (1+ (point))
;; Insert the text.
- (eval gnus-category-line-format-spec))
+ (eval gnus-category-line-format-spec t))
(list 'gnus-category gnus-tmp-name))))
(defun gnus-enter-category-buffer ()
@@ -2779,16 +2776,15 @@ The following commands are available:
(gnus-edit-form
(gnus-agent-cat-predicate info)
(format "Editing the select predicate for category %s" category)
- `(lambda (predicate)
- ;; Avoid run-time execution of setf form
- ;; (setf (gnus-agent-cat-predicate (assq ',category
gnus-category-alist))
- ;; predicate)
- ;; use its expansion instead:
- (gnus-agent-cat-set-property (assq ',category gnus-category-alist)
- 'agent-predicate predicate)
-
- (gnus-category-write)
- (gnus-category-list)))))
+ (lambda (predicate)
+ ;; Avoid run-time execution of setf form
+ ;; (setf (gnus-agent-cat-predicate (assq ',category
gnus-category-alist))
+ ;; predicate)
+ ;; use its expansion instead:
+ (gnus-agent-cat-set-property (assq category gnus-category-alist)
+ 'agent-predicate predicate)
+ (gnus-category-write)
+ (gnus-category-list)))))
(defun gnus-category-edit-score (category)
"Edit the score expression for CATEGORY."
@@ -2797,16 +2793,15 @@ The following commands are available:
(gnus-edit-form
(gnus-agent-cat-score-file info)
(format "Editing the score expression for category %s" category)
- `(lambda (score-file)
- ;; Avoid run-time execution of setf form
- ;; (setf (gnus-agent-cat-score-file (assq ',category
gnus-category-alist))
- ;; score-file)
- ;; use its expansion instead:
- (gnus-agent-cat-set-property (assq ',category gnus-category-alist)
- 'agent-score-file score-file)
-
- (gnus-category-write)
- (gnus-category-list)))))
+ (lambda (score-file)
+ ;; Avoid run-time execution of setf form
+ ;; (setf (gnus-agent-cat-score-file (assq ',category
gnus-category-alist))
+ ;; score-file)
+ ;; use its expansion instead:
+ (gnus-agent-cat-set-property (assq category gnus-category-alist)
+ 'agent-score-file score-file)
+ (gnus-category-write)
+ (gnus-category-list)))))
(defun gnus-category-edit-groups (category)
"Edit the group list for CATEGORY."
@@ -2815,16 +2810,15 @@ The following commands are available:
(gnus-edit-form
(gnus-agent-cat-groups info)
(format "Editing the group list for category %s" category)
- `(lambda (groups)
- ;; Avoid run-time execution of setf form
- ;; (setf (gnus-agent-cat-groups (assq ',category gnus-category-alist))
- ;; groups)
- ;; use its expansion instead:
- (gnus-agent-set-cat-groups (assq ',category gnus-category-alist)
- groups)
-
- (gnus-category-write)
- (gnus-category-list)))))
+ (lambda (groups)
+ ;; Avoid run-time execution of setf form
+ ;; (setf (gnus-agent-cat-groups (assq category gnus-category-alist))
+ ;; groups)
+ ;; use its expansion instead:
+ (gnus-agent-set-cat-groups (assq category gnus-category-alist)
+ groups)
+ (gnus-category-write)
+ (gnus-category-list)))))
(defun gnus-category-kill (category)
"Kill the current category."
@@ -3131,7 +3125,7 @@ FORCE is equivalent to setting the expiration predicates
to true."
(gnus-uncompress-range
(cons (caar alist)
(caar (last alist))))
- (sort articles '<)))))
+ (sort articles #'<)))))
(marked ;; More articles that are excluded from the
;; expiration process
(cond (gnus-agent-expire-all
@@ -3863,7 +3857,7 @@ If REREAD is not nil, downloaded articles are marked as
unread."
(string-to-number
name)))
(directory-files
dir nil "\\`[0-9]+\\'" t)))
- '>)
+ #'>)
(progn (gnus-make-directory dir) nil)))
nov-arts
alist header
@@ -4167,7 +4161,7 @@ modified."
(path (gnus-agent-group-pathname group))
(entry (gethash path gnus-agent-total-fetched-hashtb)))
(if entry
- (apply '+ entry)
+ (apply #'+ entry)
(let ((gnus-agent-inhibit-update-total-fetched-for (not no-inhibit)))
(+
(gnus-agent-update-view-total-fetched-for group nil method path)
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 4ade36f..c9afa3a 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -1,4 +1,4 @@
-;;; gnus-art.el --- article mode commands for Gnus
+;;; gnus-art.el --- article mode commands for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
@@ -1432,7 +1432,7 @@ See Info node `(gnus)Customizing Articles' and Info node
(message "\
** gnus-treat-display-xface is an obsolete variable;\
use gnus-treat-display-x-face instead")
- (eval (car (get 'gnus-treat-display-xface 'saved-value))))
+ (eval (car (get 'gnus-treat-display-xface 'saved-value)) t))
(t
value)))))
(put 'gnus-treat-display-x-face 'highlight t)
@@ -1623,7 +1623,7 @@ It is a string, such as \"PGP\". If nil, ask user."
:group 'gnus-article
:type 'boolean)
-(defcustom gnus-blocked-images 'gnus-block-private-groups
+(defcustom gnus-blocked-images #'gnus-block-private-groups
"Images that have URLs matching this regexp will be blocked.
Note that the main reason external images are included in HTML
emails (these days) is to allow tracking whether you've read the
@@ -1738,6 +1738,7 @@ Initialized from `text-mode-syntax-table'.")
;;; Macros for dealing with the article buffer.
(defmacro gnus-with-article-headers (&rest forms)
+ (declare (indent 0) (debug t))
`(with-current-buffer gnus-article-buffer
(save-restriction
(let ((inhibit-read-only t)
@@ -1746,18 +1747,13 @@ Initialized from `text-mode-syntax-table'.")
(article-narrow-to-head)
,@forms))))
-(put 'gnus-with-article-headers 'lisp-indent-function 0)
-(put 'gnus-with-article-headers 'edebug-form-spec '(body))
-
(defmacro gnus-with-article-buffer (&rest forms)
+ (declare (indent 0) (debug t))
`(when (buffer-live-p (get-buffer gnus-article-buffer))
(with-current-buffer gnus-article-buffer
(let ((inhibit-read-only t))
,@forms))))
-(put 'gnus-with-article-buffer 'lisp-indent-function 0)
-(put 'gnus-with-article-buffer 'edebug-form-spec '(body))
-
(defun gnus-article-goto-header (header)
"Go to HEADER, which is a regular expression."
(re-search-forward (concat "^\\(" header "\\):") nil t))
@@ -2166,6 +2162,8 @@ MAP is an alist where the elements are on the form
(\"from\" \"to\")."
(put-text-property
(point) (1+ (point)) 'face 'underline)))))))))
+(defvar ansi-color-context-region)
+
(defun article-treat-ansi-sequences ()
"Translate ANSI SGR control sequences into overlays or extents."
(interactive)
@@ -2711,7 +2709,7 @@ If READ-CHARSET, ask for a coding system."
"Format an HTML article."
(interactive)
(let ((handles nil)
- (buffer-read-only nil))
+ (inhibit-read-only t))
(when (gnus-buffer-live-p gnus-original-article-buffer)
(with-current-buffer gnus-original-article-buffer
(setq handles (mm-dissect-buffer t t))))
@@ -2897,7 +2895,7 @@ message header will be added to the bodies of the
\"text/html\" parts."
(t "<br>\n"))))
(goto-char (point-min))
(while (re-search-forward "^[\t ]+" nil t)
- (dotimes (i (prog1
+ (dotimes (_ (prog1
(current-column)
(delete-region (match-beginning 0)
(match-end 0))))
@@ -2991,7 +2989,7 @@ message header will be added to the bodies of the
\"text/html\" parts."
(when tmp-file
(add-to-list 'gnus-article-browse-html-temp-list tmp-file))
(add-hook 'gnus-summary-prepare-exit-hook
- 'gnus-article-browse-delete-temp-files)
+ #'gnus-article-browse-delete-temp-files)
(add-hook 'gnus-exit-gnus-hook
(lambda ()
(gnus-article-browse-delete-temp-files t)))
@@ -3012,8 +3010,7 @@ message header will be added to the bodies of the
\"text/html\" parts."
(when header
(article-decode-encoded-words)
(let ((gnus-visible-headers
- (or (get 'gnus-visible-headers 'standard-value)
- gnus-visible-headers)))
+ (custom--standard-value 'gnus-visible-headers)))
(article-hide-headers))
(goto-char (point-min))
(search-forward "\n\n" nil 'move)
@@ -3025,6 +3022,8 @@ message header will be added to the bodies of the
\"text/html\" parts."
(setq showed t)))))
showed))
+(defvar gnus-mime-display-attachment-buttons-in-header)
+
(defun gnus-article-browse-html-article (&optional arg)
"View \"text/html\" parts of the current article with a WWW browser.
Inline images embedded in a message using the cid scheme, as they are
@@ -3045,8 +3044,8 @@ images if any to the browser, and deletes them when
exiting the group
(interactive "P")
(if arg
(gnus-summary-show-article)
- (let ((gnus-visible-headers (or (get 'gnus-visible-headers 'standard-value)
- gnus-visible-headers))
+ (let ((gnus-visible-headers
+ (custom--standard-value 'gnus-visible-headers))
(gnus-mime-display-attachment-buttons-in-header nil)
;; As we insert a <hr>, there's no need for the body boundary.
(gnus-treat-body-boundary nil))
@@ -4326,74 +4325,65 @@ If variable `gnus-use-long-file-name' is non-nil, it is
(if (gnus-buffer-live-p gnus-original-article-buffer)
(canlock-verify gnus-original-article-buffer)))
-(eval-and-compile
- (mapc
- (lambda (func)
- (let (afunc gfunc)
- (if (consp func)
- (setq afunc (car func)
- gfunc (cdr func))
- (setq afunc func
- gfunc (intern (format "gnus-%s" func))))
- (defalias gfunc
- (when (fboundp afunc)
- `(lambda (&optional interactive &rest args)
- ,(documentation afunc t)
- (interactive (list t))
- (with-current-buffer gnus-article-buffer
- (if interactive
- (call-interactively ',afunc)
- (apply #',afunc args))))))))
- '(article-hide-headers
- article-verify-x-pgp-sig
- article-verify-cancel-lock
- article-hide-boring-headers
- article-treat-overstrike
- article-treat-ansi-sequences
- article-fill-long-lines
- article-capitalize-sentences
- article-remove-cr
- article-remove-leading-whitespace
- article-display-x-face
- article-display-face
- article-de-quoted-unreadable
- article-de-base64-unreadable
- article-decode-HZ
- article-wash-html
- article-unsplit-urls
- article-hide-list-identifiers
- article-strip-banner
- article-babel
- article-hide-pem
- article-hide-signature
- article-strip-headers-in-body
- article-remove-trailing-blank-lines
- article-strip-leading-blank-lines
- article-strip-multiple-blank-lines
- article-strip-leading-space
- article-strip-trailing-space
- article-strip-blank-lines
- article-strip-all-blank-lines
- article-date-local
- article-date-english
- article-date-iso8601
- article-date-original
- article-treat-date
- article-date-ut
- article-decode-mime-words
- article-decode-charset
- article-decode-encoded-words
- article-date-user
- article-date-lapsed
- article-date-combined-lapsed
- article-emphasize
- article-treat-smartquotes
- ;; Obsolete alias.
- article-treat-dumbquotes
- article-treat-non-ascii
- article-normalize-headers)))
+(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))
+ (with-current-buffer gnus-article-buffer
+ (if interactive
+ (call-interactively #',func)
+ (apply #',func args)))))
+ '(article-hide-headers
+ article-verify-x-pgp-sig
+ article-verify-cancel-lock
+ article-hide-boring-headers
+ article-treat-overstrike
+ article-treat-ansi-sequences
+ article-fill-long-lines
+ article-capitalize-sentences
+ article-remove-cr
+ article-remove-leading-whitespace
+ article-display-x-face
+ article-display-face
+ article-de-quoted-unreadable
+ article-de-base64-unreadable
+ article-decode-HZ
+ article-wash-html
+ article-unsplit-urls
+ article-hide-list-identifiers
+ article-strip-banner
+ article-babel
+ article-hide-pem
+ article-hide-signature
+ article-strip-headers-in-body
+ article-remove-trailing-blank-lines
+ article-strip-leading-blank-lines
+ article-strip-multiple-blank-lines
+ article-strip-leading-space
+ article-strip-trailing-space
+ article-strip-blank-lines
+ article-strip-all-blank-lines
+ article-date-local
+ article-date-english
+ article-date-iso8601
+ article-date-original
+ article-treat-date
+ article-date-ut
+ article-decode-mime-words
+ article-decode-charset
+ article-decode-encoded-words
+ article-date-user
+ article-date-lapsed
+ article-date-combined-lapsed
+ article-emphasize
+ article-treat-smartquotes
+ ;;article-treat-dumbquotes ;; Obsolete alias.
+ article-treat-non-ascii
+ article-normalize-headers)))
(define-obsolete-function-alias 'gnus-article-treat-dumbquotes
- 'gnus-article-treat-smartquotes "27.1")
+ #'gnus-article-treat-smartquotes "27.1")
;;;
;;; Gnus article mode
@@ -4721,8 +4711,6 @@ If ALL-HEADERS is non-nil, no headers are hidden."
(gnus-run-hooks 'gnus-article-prepare-hook)
t))))))
-(defvar gnus-mime-display-attachment-buttons-in-header)
-
;;;###autoload
(defun gnus-article-prepare-display ()
"Make the current buffer look like a nice article."
@@ -5009,53 +4997,53 @@ General format specifiers can also be used. See Info
node
"ID of a mime part that should be buttonized.
`gnus-mime-save-part-and-strip' and `gnus-mime-delete-part' bind it.")
+(defvar message-options-set-recipient)
+
(eval-when-compile
(defsubst gnus-article-edit-part (handles &optional current-id)
"Edit an article in order to delete a mime part.
This function is exclusively used by `gnus-mime-save-part-and-strip'
and `gnus-mime-delete-part', and not provided at run-time normally."
- (gnus-article-edit-article
- `(lambda ()
- (buffer-disable-undo)
- (let ((mail-parse-charset (or gnus-article-charset
- ',gnus-newsgroup-charset))
- (mail-parse-ignored-charsets
- (or gnus-article-ignored-charsets
- ',gnus-newsgroup-ignored-charsets))
- (mbl mml-buffer-list))
- (setq mml-buffer-list nil)
- ;; A new text must be inserted before deleting existing ones
- ;; at the end so as not to move existing markers of which
- ;; the insertion type is t.
- (delete-region
- (point-min)
- (prog1
- (goto-char (point-max))
- (insert-buffer-substring gnus-original-article-buffer)))
- (mime-to-mml ',handles)
- (setq gnus-article-mime-handles nil)
- (let ((mbl1 mml-buffer-list))
- (setq mml-buffer-list mbl)
- (setq-local mml-buffer-list mbl1))
- (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)))
- `(lambda (no-highlight)
- (let ((mail-parse-charset (or gnus-article-charset
- ',gnus-newsgroup-charset))
- (message-options message-options)
- (message-options-set-recipient)
- (mail-parse-ignored-charsets
- (or gnus-article-ignored-charsets
- ',gnus-newsgroup-ignored-charsets)))
- (mml-to-mime)
- (mml-destroy-buffers)
- (remove-hook 'kill-buffer-hook
- 'mml-destroy-buffers t)
- (kill-local-variable 'mml-buffer-list))
- (gnus-summary-edit-article-done
- ,(or (mail-header-references gnus-current-headers) "")
- ,(gnus-group-read-only-p)
- ,gnus-summary-buffer no-highlight))
- t)
+ (let ((charset gnus-newsgroup-charset)
+ (ign-cs gnus-newsgroup-ignored-charsets)
+ (gch (or (mail-header-references gnus-current-headers) ""))
+ (ro (gnus-group-read-only-p))
+ (buf gnus-summary-buffer))
+ (gnus-article-edit-article
+ (lambda ()
+ (buffer-disable-undo)
+ (let ((mail-parse-charset (or gnus-article-charset charset))
+ (mail-parse-ignored-charsets
+ (or gnus-article-ignored-charsets ign-cs))
+ (mbl mml-buffer-list))
+ (setq mml-buffer-list nil)
+ ;; A new text must be inserted before deleting existing ones
+ ;; at the end so as not to move existing markers of which
+ ;; the insertion type is t.
+ (delete-region
+ (point-min)
+ (prog1
+ (goto-char (point-max))
+ (insert-buffer-substring gnus-original-article-buffer)))
+ (mime-to-mml handles)
+ (setq gnus-article-mime-handles nil)
+ (let ((mbl1 mml-buffer-list))
+ (setq mml-buffer-list mbl)
+ (setq-local mml-buffer-list mbl1))
+ (add-hook 'kill-buffer-hook #'mml-destroy-buffers t t)))
+ (lambda (no-highlight)
+ (let ((mail-parse-charset (or gnus-article-charset charset))
+ (message-options message-options)
+ (message-options-set-recipient)
+ (mail-parse-ignored-charsets
+ (or gnus-article-ignored-charsets ign-cs)))
+ (mml-to-mime)
+ (mml-destroy-buffers)
+ (remove-hook 'kill-buffer-hook
+ #'mml-destroy-buffers t)
+ (kill-local-variable 'mml-buffer-list))
+ (gnus-summary-edit-article-done gch ro buf no-highlight))
+ t))
;; Force buttonizing this part.
(let ((gnus-mime-buttonized-part-id current-id))
(gnus-article-edit-done))
@@ -5083,50 +5071,53 @@ and `gnus-mime-delete-part', and not provided at
run-time normally."
file))
(gnus-mime-save-part-and-strip file))
-(defun gnus-mime-save-part-and-strip (&optional file)
+(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)
- (gnus-article-check-buffer)
- (when (gnus-group-read-only-p)
- (error "The current group does not support deleting of parts"))
- (when (mm-complicated-handles gnus-article-mime-handles)
- (error "\
+ (interactive (list nil last-nonmenu-event))
+ (save-excursion
+ (mouse-set-point event)
+ (gnus-article-check-buffer)
+ (when (gnus-group-read-only-p)
+ (error "The current group does not support deleting of parts"))
+ (when (mm-complicated-handles gnus-article-mime-handles)
+ (error "\
The current article has a complicated MIME structure, giving up..."))
- (let* ((data (get-text-property (point) 'gnus-data))
- (id (get-text-property (point) 'gnus-part))
- (handles gnus-article-mime-handles))
- (unless file
- (setq file
- (and data (mm-save-part data "Delete MIME part and save to: "))))
- (when file
- (with-current-buffer (mm-handle-buffer data)
- (erase-buffer)
- (insert "Content-Type: " (mm-handle-media-type data))
- (mml-insert-parameter-string (cdr (mm-handle-type data))
- '(charset))
- ;; Add a filename for the sake of saving the part again.
- (mml-insert-parameter
- (mail-header-encode-parameter "name" (file-name-nondirectory file)))
- (insert "\n")
- (insert "Content-ID: " (message-make-message-id) "\n")
- (insert "Content-Transfer-Encoding: binary\n")
- (insert "\n"))
- (setcdr data
- (cdr (mm-make-handle nil
- `("message/external-body"
- (access-type . "LOCAL-FILE")
- (name . ,file)))))
- ;; (set-buffer gnus-summary-buffer)
- (gnus-article-edit-part handles id))))
+ (let* ((data (get-text-property (point) 'gnus-data))
+ (id (get-text-property (point) 'gnus-part))
+ (handles gnus-article-mime-handles))
+ (unless file
+ (setq file
+ (and data (mm-save-part data "Delete MIME part and save to: "))))
+ (when file
+ (with-current-buffer (mm-handle-buffer data)
+ (erase-buffer)
+ (insert "Content-Type: " (mm-handle-media-type data))
+ (mml-insert-parameter-string (cdr (mm-handle-type data))
+ '(charset))
+ ;; Add a filename for the sake of saving the part again.
+ (mml-insert-parameter
+ (mail-header-encode-parameter "name" (file-name-nondirectory file)))
+ (insert "\n")
+ (insert "Content-ID: " (message-make-message-id) "\n")
+ (insert "Content-Transfer-Encoding: binary\n")
+ (insert "\n"))
+ (setcdr data
+ (cdr (mm-make-handle nil
+ `("message/external-body"
+ (access-type . "LOCAL-FILE")
+ (name . ,file)))))
+ ;; (set-buffer gnus-summary-buffer)
+ (gnus-article-edit-part handles id)))))
;; A function like `gnus-summary-save-parts' (`X m', `<MIME> <Extract all
;; parts...>') but with stripping would be nice.
-(defun gnus-mime-delete-part ()
+(defun gnus-mime-delete-part (&optional event)
"Delete the MIME part under point.
Replace it with some information about the removed part."
- (interactive)
+ (interactive (list last-nonmenu-event))
+ (mouse-set-point event)
(gnus-article-check-buffer)
(when (gnus-group-read-only-p)
(error "The current group does not support deleting of parts"))
@@ -5172,33 +5163,37 @@ Deleting parts may malfunction or destroy the article;
continue? "))
;; (set-buffer gnus-summary-buffer)
(gnus-article-edit-part handles id))))
-(defun gnus-mime-save-part ()
+(defun gnus-mime-save-part (&optional event)
"Save the MIME part under point."
- (interactive)
+ (interactive (list last-nonmenu-event))
+ (mouse-set-point event)
(gnus-article-check-buffer)
(let ((data (get-text-property (point) 'gnus-data)))
(when data
(mm-save-part data))))
-(defun gnus-mime-pipe-part (&optional cmd)
+(defun gnus-mime-pipe-part (&optional cmd event)
"Pipe the MIME part under point to a process.
Use CMD as the process."
- (interactive)
+ (interactive (list nil last-nonmenu-event))
+ (mouse-set-point event)
(gnus-article-check-buffer)
(let ((data (get-text-property (point) 'gnus-data)))
(when data
(mm-pipe-part data cmd))))
-(defun gnus-mime-view-part ()
+(defun gnus-mime-view-part (&optional event)
"Interactively choose a viewing method for the MIME part under point."
- (interactive)
- (gnus-article-check-buffer)
- (let ((data (get-text-property (point) 'gnus-data)))
- (when data
- (setq gnus-article-mime-handles
- (mm-merge-handles
- gnus-article-mime-handles (setq data (copy-sequence data))))
- (mm-interactively-view-part data))))
+ (interactive (list last-nonmenu-event))
+ (save-excursion
+ (mouse-set-point event)
+ (gnus-article-check-buffer)
+ (let ((data (get-text-property (point) 'gnus-data)))
+ (when data
+ (setq gnus-article-mime-handles
+ (mm-merge-handles
+ gnus-article-mime-handles (setq data (copy-sequence data))))
+ (mm-interactively-view-part data)))))
(defun gnus-mime-view-part-as-type-internal ()
(gnus-article-check-buffer)
@@ -5208,55 +5203,58 @@ Use CMD as the process."
(mail-content-type-get (mm-handle-type handle) 'name)
;; Content-Disposition: attachment; filename=...
(cdr (assq 'filename (cdr (mm-handle-disposition handle))))))
- (def-type (and name (mm-default-file-encoding name))))
+ (def-type (and name (mm-default-file-type name))))
(or (and def-type (cons def-type 0))
(and handle
(equal (mm-handle-media-supertype handle) "text")
'("text/plain" . 0))
'("application/octet-stream" . 0))))
-(defun gnus-mime-view-part-as-type (&optional mime-type pred)
+(defun gnus-mime-view-part-as-type (&optional mime-type pred event)
"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)
- (unless mime-type
- (setq mime-type
- (let ((default (gnus-mime-view-part-as-type-internal)))
- (gnus-completing-read
- "View as MIME type"
- (if pred
- (seq-filter pred (mailcap-mime-types))
- (mailcap-mime-types))
- nil nil nil
- (car default)))))
- (gnus-article-check-buffer)
- (let ((handle (get-text-property (point) 'gnus-data)))
- (when handle
- (when (equal (mm-handle-media-type handle) "message/external-body")
- (unless (mm-handle-cache handle)
- (mm-extern-cache-contents handle))
- (setq handle (mm-handle-cache handle)))
- (setq handle
- (mm-make-handle (mm-handle-buffer handle)
- (cons mime-type (cdr (mm-handle-type handle)))
- (mm-handle-encoding handle)
- (mm-handle-undisplayer handle)
- (mm-handle-disposition handle)
- (mm-handle-description handle)
- nil
- (mm-handle-id handle)))
- (setq gnus-article-mime-handles
- (mm-merge-handles gnus-article-mime-handles handle))
- (when (mm-handle-displayed-p handle)
- (mm-remove-part handle))
- (gnus-mm-display-part handle))))
-
-(defun gnus-mime-copy-part (&optional handle arg)
+ (interactive (list nil nil last-nonmenu-event))
+ (save-excursion
+ (if event (mouse-set-point event))
+ (unless mime-type
+ (setq mime-type
+ (let ((default (gnus-mime-view-part-as-type-internal)))
+ (gnus-completing-read
+ "View as MIME type"
+ (if pred
+ (seq-filter pred (mailcap-mime-types))
+ (mailcap-mime-types))
+ nil nil nil
+ (car default)))))
+ (gnus-article-check-buffer)
+ (let ((handle (get-text-property (point) 'gnus-data)))
+ (when handle
+ (when (equal (mm-handle-media-type handle) "message/external-body")
+ (unless (mm-handle-cache handle)
+ (mm-extern-cache-contents handle))
+ (setq handle (mm-handle-cache handle)))
+ (setq handle
+ (mm-make-handle (mm-handle-buffer handle)
+ (cons mime-type (cdr (mm-handle-type handle)))
+ (mm-handle-encoding handle)
+ (mm-handle-undisplayer handle)
+ (mm-handle-disposition handle)
+ (mm-handle-description handle)
+ nil
+ (mm-handle-id handle)))
+ (setq gnus-article-mime-handles
+ (mm-merge-handles gnus-article-mime-handles handle))
+ (when (mm-handle-displayed-p handle)
+ (mm-remove-part handle))
+ (gnus-mm-display-part handle)))))
+
+(defun gnus-mime-copy-part (&optional handle arg event)
"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))
+ (interactive (list nil current-prefix-arg last-nonmenu-event))
+ (mouse-set-point event)
(gnus-article-check-buffer)
(unless handle
(setq handle (get-text-property (point) 'gnus-data)))
@@ -5308,15 +5306,18 @@ are decompressed."
(setq buffer-file-name nil))
(goto-char (point-min)))))
-(defun gnus-mime-print-part (&optional handle filename)
+(defun gnus-mime-print-part (&optional handle filename event)
"Print the MIME part under point."
- (interactive (list nil (ps-print-preprint current-prefix-arg)))
- (gnus-article-check-buffer)
- (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
- (contents (and handle (mm-get-part handle)))
- (file (make-temp-file (expand-file-name "mm." mm-tmp-directory)))
- (printer (mailcap-mime-info (mm-handle-media-type handle) "print")))
- (when contents
+ (interactive
+ (list nil (ps-print-preprint current-prefix-arg) last-nonmenu-event))
+ (save-excursion
+ (mouse-set-point event)
+ (gnus-article-check-buffer)
+ (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
+ (contents (and handle (mm-get-part handle)))
+ (file (make-temp-file (expand-file-name "mm." mm-tmp-directory)))
+ (printer (mailcap-mime-info (mm-handle-media-type handle) "print")))
+ (when contents
(if printer
(unwind-protect
(progn
@@ -5331,12 +5332,13 @@ are decompressed."
(with-temp-buffer
(insert contents)
(gnus-print-buffer))
- (ps-despool filename)))))
+ (ps-despool filename))))))
-(defun gnus-mime-inline-part (&optional handle arg)
+(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))
+ (interactive (list nil current-prefix-arg last-nonmenu-event))
+ (if event (mouse-set-point event))
(gnus-article-check-buffer)
(let* ((inhibit-read-only t)
(b (point))
@@ -5430,82 +5432,88 @@ CHARSET may either be a string or a symbol."
(setcdr param charset)
(setcdr type (cons (cons 'charset charset) (cdr type)))))))
-(defun gnus-mime-view-part-as-charset (&optional handle arg)
+(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))
- (gnus-article-check-buffer)
- (let ((handle (or handle (get-text-property (point) 'gnus-data)))
- (fun (get-text-property (point) 'gnus-callback))
- (gnus-newsgroup-ignored-charsets 'gnus-all)
- charset form preferred parts)
- (when handle
- (when (prog1
- (and fun
- (setq charset
- (or (cdr (assq
- arg
- gnus-summary-show-article-charset-alist))
- (read-coding-system "Charset: "))))
- (if (mm-handle-undisplayer handle)
- (mm-remove-part handle)))
- (gnus-mime-set-charset-parameters handle charset)
- (when (and (consp (setq form (cdr-safe fun)))
- (setq form (ignore-errors
- (assq 'gnus-mime-display-alternative form)))
- (setq preferred (caddr form))
- (progn
- (when (eq (car preferred) 'quote)
- (setq preferred (cadr preferred)))
- (not (equal preferred
- (get-text-property (point) 'gnus-data))))
- (setq parts (get-text-property (point) 'gnus-part))
- (setq parts (cdr (assq parts
- gnus-article-mime-handle-alist)))
- (equal (mm-handle-media-type parts) "multipart/alternative")
- (setq parts (reverse (cdr parts))))
- (setcar (cddr form)
- (list 'quote (or (cadr (member preferred parts))
- (car parts)))))
- (funcall fun handle)))))
-
-(defun gnus-mime-view-part-externally (&optional handle)
- "View the MIME part under point with an external viewer."
- (interactive)
- (gnus-article-check-buffer)
- (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
- (mm-inlined-types nil)
- (mail-parse-charset gnus-newsgroup-charset)
- (mail-parse-ignored-charsets
- (with-current-buffer gnus-summary-buffer
- gnus-newsgroup-ignored-charsets))
- (type (mm-handle-media-type handle))
- (method (mailcap-mime-info type))
- (mm-enable-external t))
- (if (not (stringp method))
- (gnus-mime-view-part-as-type
- nil (lambda (type) (stringp (mailcap-mime-info type))))
+ (interactive (list nil current-prefix-arg last-nonmenu-event))
+ (save-excursion
+ (mouse-set-point event)
+ (gnus-article-check-buffer)
+ (let ((handle (or handle (get-text-property (point) 'gnus-data)))
+ (fun (get-text-property (point) 'gnus-callback))
+ (gnus-newsgroup-ignored-charsets 'gnus-all)
+ charset form preferred parts)
(when handle
- (mm-display-part handle nil t)))))
-
-(defun gnus-mime-view-part-internally (&optional handle)
+ (when (prog1
+ (and fun
+ (setq charset
+ (or (cdr (assq
+ arg
+ gnus-summary-show-article-charset-alist))
+ (read-coding-system "Charset: "))))
+ (if (mm-handle-undisplayer handle)
+ (mm-remove-part handle)))
+ (gnus-mime-set-charset-parameters handle charset)
+ (when (and (consp (setq form (cdr-safe fun)))
+ (setq form (ignore-errors
+ (assq 'gnus-mime-display-alternative form)))
+ (setq preferred (caddr form))
+ (progn
+ (when (eq (car preferred) 'quote)
+ (setq preferred (cadr preferred)))
+ (not (equal preferred
+ (get-text-property (point) 'gnus-data))))
+ (setq parts (get-text-property (point) 'gnus-part))
+ (setq parts (cdr (assq parts
+ gnus-article-mime-handle-alist)))
+ (equal (mm-handle-media-type parts)
"multipart/alternative")
+ (setq parts (reverse (cdr parts))))
+ (setcar (cddr form)
+ (list 'quote (or (cadr (member preferred parts))
+ (car parts)))))
+ (funcall fun handle))))))
+
+(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))
+ (save-excursion
+ (mouse-set-point event)
+ (gnus-article-check-buffer)
+ (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
+ (mm-inlined-types nil)
+ (mail-parse-charset gnus-newsgroup-charset)
+ (mail-parse-ignored-charsets
+ (with-current-buffer gnus-summary-buffer
+ gnus-newsgroup-ignored-charsets))
+ (type (mm-handle-media-type handle))
+ (method (mailcap-mime-info type))
+ (mm-enable-external t))
+ (if (not (stringp method))
+ (gnus-mime-view-part-as-type
+ nil (lambda (type) (stringp (mailcap-mime-info type))))
+ (when handle
+ (mm-display-part handle nil t))))))
+
+(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)
- (gnus-article-check-buffer)
- (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
- (mm-inlined-types '(".*"))
- (mm-inline-large-images t)
- (mail-parse-charset gnus-newsgroup-charset)
- (mail-parse-ignored-charsets
- (with-current-buffer gnus-summary-buffer
- gnus-newsgroup-ignored-charsets))
- (inhibit-read-only t))
- (if (not (mm-inlinable-p handle))
- (gnus-mime-view-part-as-type
- nil (lambda (type) (mm-inlinable-p handle type)))
- (when handle
- (gnus-bind-mm-vars (mm-display-part handle nil t))))))
+ (interactive (list nil last-nonmenu-event))
+ (save-excursion
+ (mouse-set-point event)
+ (gnus-article-check-buffer)
+ (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
+ (mm-inlined-types '(".*"))
+ (mm-inline-large-images t)
+ (mail-parse-charset gnus-newsgroup-charset)
+ (mail-parse-ignored-charsets
+ (with-current-buffer gnus-summary-buffer
+ gnus-newsgroup-ignored-charsets))
+ (inhibit-read-only t))
+ (if (not (mm-inlinable-p handle))
+ (gnus-mime-view-part-as-type
+ nil (lambda (type) (mm-inlinable-p handle type)))
+ (when handle
+ (gnus-bind-mm-vars (mm-display-part handle nil t)))))))
(defun gnus-mime-action-on-part (&optional action)
"Do something with the MIME attachment at (point)."
@@ -5755,10 +5763,11 @@ all parts."
(mm-handle-media-type handle))
(mm-handle-set-undisplayer
handle
- `(lambda ()
- (let ((inhibit-read-only t))
- (delete-region ,(copy-marker (point-min) t)
- ,(point-max-marker)))))))
+ (let ((beg (copy-marker (point-min) t))
+ (end (point-max-marker)))
+ (lambda ()
+ (let ((inhibit-read-only t))
+ (delete-region beg end)))))))
(part
(mm-display-inline handle))))))
(when (markerp point)
@@ -6138,7 +6147,7 @@ If nil, don't show those extra buttons."
(let* ((preferred (or preferred (mm-preferred-alternative handles)))
(ihandles handles)
(point (point))
- handle (inhibit-read-only t) from begend not-pref)
+ handle (inhibit-read-only t) begend not-pref) ;; from
(save-window-excursion
(save-restriction
(when ibegend
@@ -6159,7 +6168,8 @@ If nil, don't show those extra buttons."
(not (gnus-unbuttonized-mime-type-p
"multipart/alternative")))
(add-text-properties
- (setq from (point))
+ ;; (setq from
+ (point);; )
(progn
(insert (format "%d. " id))
(point))
@@ -6180,7 +6190,8 @@ If nil, don't show those extra buttons."
;; Do the handles
(while (setq handle (pop handles))
(add-text-properties
- (setq from (point))
+ ;; (setq from
+ (point) ;; )
(progn
(insert (format "(%c) %-18s"
(if (equal handle preferred) ?* ? )
@@ -7140,13 +7151,11 @@ If given a prefix, show the hidden text instead."
(when (and do-update-line
(or (numberp article)
(stringp article)))
- (let ((buf (current-buffer)))
- (set-buffer gnus-summary-buffer)
+ (with-current-buffer gnus-summary-buffer
(gnus-summary-update-article do-update-line sparse-header)
(gnus-summary-goto-subject do-update-line nil t)
(set-window-point (gnus-get-buffer-window (current-buffer) t)
- (point))
- (set-buffer buf))))))
+ (point)))))))
(defun gnus-block-private-groups (group)
"Allows images in newsgroups to be shown, blocks images in all
@@ -7267,12 +7276,13 @@ groups."
(gnus-with-article-buffer
(article-date-original))
(gnus-article-edit-article
- 'ignore
- `(lambda (no-highlight)
- 'ignore
- (gnus-summary-edit-article-done
- ,(or (mail-header-references gnus-current-headers) "")
- ,(gnus-group-read-only-p) ,gnus-summary-buffer no-highlight))))
+ #'ignore
+ (let ((gch (or (mail-header-references gnus-current-headers) ""))
+ (ro (gnus-group-read-only-p))
+ (buf gnus-summary-buffer))
+ (lambda (no-highlight)
+ 'ignore
+ (gnus-summary-edit-article-done gch ro buf no-highlight)))))
(defun gnus-article-edit-article (start-func exit-func &optional quiet)
"Start editing the contents of the current article buffer."
@@ -7340,8 +7350,7 @@ groups."
(gnus-article-mode)
(set-window-configuration winconf)
;; Tippy-toe some to make sure that point remains where it was.
- (save-current-buffer
- (set-buffer curbuf)
+ (with-current-buffer curbuf
(set-window-start (get-buffer-window (current-buffer)) window-start)
(goto-char p))))
(gnus-summary-show-article)))
@@ -7609,7 +7618,7 @@ Calls `describe-variable' or `describe-function'."
"Call `describe-key' when pushing the corresponding URL button."
(let* ((key-string
(replace-regexp-in-string gnus-button-handle-describe-prefix "" url))
- (keys (ignore-errors (eval `(kbd ,key-string)))))
+ (keys (ignore-errors (kbd key-string))))
(if keys
(describe-key keys)
(gnus-message 3 "Invalid key sequence in button: %s" key-string))))
@@ -7875,15 +7884,17 @@ call it with the value of the `gnus-data' text
property."
(when fun
(funcall fun data))))
-(defun gnus-article-press-button ()
+(defun gnus-article-press-button (&optional event)
"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)
- (let ((data (get-text-property (point) 'gnus-data))
- (fun (get-text-property (point) 'gnus-callback)))
- (when fun
- (funcall fun data))))
+ (interactive (list last-nonmenu-event))
+ (save-excursion
+ (when event
+ (mouse-set-point event))
+ (let ((fun (get-text-property (point) 'gnus-callback)))
+ (when fun
+ (funcall fun (get-text-property (point) 'gnus-data))))))
(defun gnus-article-highlight (&optional force)
"Highlight current article.
@@ -7977,13 +7988,13 @@ specified by `gnus-button-alist'."
(article-goto-body)
(setq beg (point))
(while (setq entry (pop alist))
- (setq regexp (eval (car entry)))
+ (setq regexp (eval (car entry) t))
(goto-char beg)
(while (re-search-forward regexp nil t)
(let ((start (match-beginning (nth 1 entry)))
(end (match-end (nth 1 entry)))
(from (match-beginning 0)))
- (when (and (eval (nth 2 entry))
+ (when (and (eval (nth 2 entry) t)
(not (gnus-button-in-region-p
start end 'gnus-callback)))
;; That optional form returned non-nil, so we add the
@@ -8074,14 +8085,14 @@ url is put as the `gnus-button-url' overlay property on
the button."
(match-beginning 0))
(point-max)))
(goto-char beg)
- (while (re-search-forward (eval (nth 1 entry)) end t)
+ (while (re-search-forward (eval (nth 1 entry) t) end t)
;; Each match within a header.
(let* ((entry (cdr entry))
(start (match-beginning (nth 1 entry)))
(end (match-end (nth 1 entry)))
(form (nth 2 entry)))
(goto-char (match-end 0))
- (when (eval form)
+ (when (eval form t)
(gnus-article-add-button
start end (nth 3 entry)
(buffer-substring (match-beginning (nth 4 entry))
@@ -8090,7 +8101,7 @@ url is put as the `gnus-button-url' overlay property on
the button."
;;; External functions:
-(defun gnus-article-add-button (from to fun &optional data text)
+(defun gnus-article-add-button (from to fun &optional data _text)
"Create a button between FROM and TO with callback FUN and data DATA."
(add-text-properties
from to
@@ -8303,7 +8314,7 @@ url is put as the `gnus-button-url' overlay property on
the button."
(setq indx (match-string 1 indx))
(Info-index indx)
(when comma
- (dotimes (i (with-temp-buffer
+ (dotimes (_ (with-temp-buffer
(insert comma)
;; Note: the XEmacs version of `how-many' takes
;; no optional argument.
@@ -8507,8 +8518,8 @@ For example:
(defvar gnus-inhibit-article-treatments nil)
;; Dynamic variables.
-(defvar part-number) ;FIXME: Lacks a "gnus-" prefix.
-(defvar total-parts) ;FIXME: Lacks a "gnus-" prefix.
+(defvar gnus-treat-part-number)
+(defvar gnus-treat-total-parts)
(defvar gnus-treat-type)
(defvar gnus-treat-condition)
(defvar gnus-treat-length)
@@ -8516,8 +8527,8 @@ For example:
(defun gnus-treat-article (condition
&optional part-num total type)
(let ((gnus-treat-condition condition)
- (part-number part-num)
- (total-parts total)
+ (gnus-treat-part-number part-num)
+ (gnus-treat-total-parts total)
(gnus-treat-type type)
(gnus-treat-length (- (point-max) (point-min)))
(alist gnus-treatment-function-alist)
@@ -8577,9 +8588,9 @@ For example:
((eq val 'head)
nil)
((eq val 'first)
- (eq part-number 1))
+ (eq gnus-treat-part-number 1))
((eq val 'last)
- (eq part-number total-parts))
+ (eq gnus-treat-part-number gnus-treat-total-parts))
((numberp val)
(< gnus-treat-length val))
(t
diff --git a/lisp/gnus/gnus-bcklg.el b/lisp/gnus/gnus-bcklg.el
index d6f53e4..6c7ad0c 100644
--- a/lisp/gnus/gnus-bcklg.el
+++ b/lisp/gnus/gnus-bcklg.el
@@ -1,4 +1,4 @@
-;;; gnus-bcklg.el --- backlog functions for Gnus
+;;; gnus-bcklg.el --- backlog functions for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
diff --git a/lisp/gnus/gnus-bookmark.el b/lisp/gnus/gnus-bookmark.el
index 57859d8..bc41d5b 100644
--- a/lisp/gnus/gnus-bookmark.el
+++ b/lisp/gnus/gnus-bookmark.el
@@ -1,4 +1,4 @@
-;;; gnus-bookmark.el --- Bookmarks in Gnus
+;;; gnus-bookmark.el --- Bookmarks in Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 2006-2021 Free Software Foundation, Inc.
@@ -78,22 +78,19 @@
((file-exists-p "~/.gnus.bmk") "~/.gnus.bmk")
(t (nnheader-concat gnus-directory "bookmarks.el")))
"The default Gnus bookmarks file."
- :type 'string
- :group 'gnus-bookmark)
+ :type 'string)
(defcustom gnus-bookmark-file-coding-system
(if (mm-coding-system-p 'iso-2022-7bit)
'iso-2022-7bit)
"Coding system used for writing Gnus bookmark files."
- :type '(symbol :tag "Coding system")
- :group 'gnus-bookmark)
+ :type '(symbol :tag "Coding system"))
(defcustom gnus-bookmark-sort-flag t
"Non-nil means Gnus bookmarks are sorted by bookmark names.
Otherwise they will be displayed in LIFO order (that is,
most recently set ones come first, oldest ones come last)."
- :type 'boolean
- :group 'gnus-bookmark)
+ :type 'boolean)
(defcustom gnus-bookmark-bmenu-toggle-infos t
"Non-nil means show details when listing Gnus bookmarks.
@@ -102,19 +99,16 @@ This may result in truncated bookmark names. To disable
this, put the
following in your `.emacs' file:
\(setq gnus-bookmark-bmenu-toggle-infos nil)"
- :type 'boolean
- :group 'gnus-bookmark)
+ :type 'boolean)
(defcustom gnus-bookmark-bmenu-file-column 30
"Column at which to display details in a buffer listing Gnus bookmarks.
You can toggle whether details are shown with
\\<gnus-bookmark-bmenu-mode-map>\\[gnus-bookmark-bmenu-toggle-infos]."
- :type 'integer
- :group 'gnus-bookmark)
+ :type 'integer)
(defcustom gnus-bookmark-use-annotations nil
"If non-nil, ask for an annotation when setting a bookmark."
- :type 'boolean
- :group 'gnus-bookmark)
+ :type 'boolean)
(defcustom gnus-bookmark-bookmark-inline-details '(author)
"Details to be shown with `gnus-bookmark-bmenu-toggle-infos'.
@@ -125,8 +119,7 @@ The default value is \(subject)."
(const :tag "Subject" subject)
(const :tag "Date" date)
(const :tag "Group" group)
- (const :tag "Message-id" message-id)))
- :group 'gnus-bookmark)
+ (const :tag "Message-id" message-id))))
(defcustom gnus-bookmark-bookmark-details
'(author subject date group annotation)
@@ -139,14 +132,12 @@ The default value is \(author subject date group
annotation)."
(const :tag "Date" date)
(const :tag "Group" group)
(const :tag "Message-id" message-id)
- (const :tag "Annotation" annotation)))
- :group 'gnus-bookmark)
+ (const :tag "Annotation" annotation))))
(defface gnus-bookmark-menu-heading
'((t (:inherit font-lock-type-face)))
"Face used to highlight the heading in Gnus bookmark menu buffers."
- :version "23.1" ;; No Gnus
- :group 'gnus-bookmark)
+ :version "23.1") ;; No Gnus
(defconst gnus-bookmark-end-of-version-stamp-marker
"-*- End Of Bookmark File Format Version Stamp -*-\n"
@@ -279,7 +270,7 @@ So the cdr of each bookmark is an alist too.")
(gnus-bookmark-maybe-load-default-file)
(let* ((bookmark (or bmk-name
(gnus-completing-read "Jump to bookmarked article"
- (mapcar 'car
gnus-bookmark-alist))))
+ (mapcar #'car
gnus-bookmark-alist))))
(bmk-record (cadr (assoc bookmark gnus-bookmark-alist)))
(group (cdr (assoc 'group bmk-record)))
(message-id (cdr (assoc 'message-id bmk-record))))
@@ -359,7 +350,7 @@ deletion, or > if it is flagged for displaying."
(switch-to-buffer (gnus-get-buffer-create "*Gnus Bookmark List*"))
(set-buffer (gnus-get-buffer-create "*Gnus Bookmark List*")))
(let ((inhibit-read-only t)
- alist name start end)
+ alist name) ;; start end
(erase-buffer)
(insert "% Gnus Bookmark\n- --------\n")
(add-text-properties (point-min) (point)
diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el
index 36657e4..5ed7319 100644
--- a/lisp/gnus/gnus-cache.el
+++ b/lisp/gnus/gnus-cache.el
@@ -1,4 +1,4 @@
-;;; gnus-cache.el --- cache interface for Gnus
+;;; gnus-cache.el --- cache interface for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
@@ -29,9 +29,7 @@
(require 'gnus)
(require 'gnus-sum)
-(eval-when-compile
- (unless (fboundp 'gnus-agent-load-alist)
- (defun gnus-agent-load-alist (group))))
+(declare-function gnus-agent-load-alist "gnus-agent" (group))
(defcustom gnus-cache-active-file
(expand-file-name "active" gnus-cache-directory)
@@ -55,7 +53,7 @@
If you only want to cache your nntp groups, you could set this
variable to \"^nntp\".
-If a group matches both gnus-cacheable-groups and gnus-uncacheable-groups
+If a group matches both `gnus-cacheable-groups' and `gnus-uncacheable-groups'
it's not cached."
:group 'gnus-cache
:type '(choice (const :tag "off" nil)
@@ -150,6 +148,8 @@ it's not cached."
(gnus-kill-buffer buffer)
(setq gnus-cache-buffer nil))))
+(defvar gnus-article-decode-hook)
+
(defun gnus-cache-possibly-enter-article
(group article ticked dormant unread &optional force)
(when (and (or force (not (eq gnus-use-cache 'passive)))
@@ -518,7 +518,7 @@ Returns the list of articles removed."
(setq articles
(sort (mapcar (lambda (name) (string-to-number name))
(directory-files dir nil "\\`[0-9]+\\'" t))
- '<))
+ #'<))
;; Update the cache active file, just to synch more.
(if articles
(progn
@@ -714,7 +714,7 @@ If LOW, update the lower bound instead."
(push (string-to-number (file-name-nondirectory (pop files))) nums)
(push (pop files) alphs)))
;; If we have nums, then this is probably a valid group.
- (when (setq nums (sort nums '<))
+ (when (setq nums (sort nums #'<))
(puthash group
(cons (car nums) (car (last nums)))
gnus-cache-active-hashtb))
@@ -730,6 +730,8 @@ If LOW, update the lower bound instead."
(gnus-cache-write-active t)
(gnus-message 5 "Generating the cache active file...done"))))
+(defvar nnml-generate-active-function)
+
;;;###autoload
(defun gnus-cache-generate-nov-databases (dir)
"Generate NOV files recursively starting in DIR."
@@ -884,7 +886,7 @@ supported."
(setq gnus-cache-total-fetched-hashtb (gnus-make-hashtable 1000)))
(let* ((entry (gethash group gnus-cache-total-fetched-hashtb)))
(if entry
- (apply '+ entry)
+ (apply #'+ entry)
(let ((gnus-cache-inhibit-update-total-fetched-for (not no-inhibit)))
(+
(gnus-cache-update-overview-total-fetched-for group nil)
diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el
index d02e898..96f1a7d 100644
--- a/lisp/gnus/gnus-cite.el
+++ b/lisp/gnus/gnus-cite.el
@@ -1,4 +1,4 @@
-;;; gnus-cite.el --- parse citations in articles for Gnus
+;;; gnus-cite.el --- parse citations in articles for Gnus -*-
lexical-binding: t; -*-
;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
@@ -38,19 +38,16 @@
(defcustom gnus-cited-opened-text-button-line-format "%(%{[-]%}%)\n"
"Format of opened cited text buttons."
- :group 'gnus-cite
:type 'string)
(defcustom gnus-cited-closed-text-button-line-format "%(%{[+]%}%)\n"
"Format of closed cited text buttons."
- :group 'gnus-cite
:type 'string)
(defcustom gnus-cited-lines-visible nil
"The number of lines of hidden cited text to remain visible.
Or a pair (cons) of numbers which are the number of lines at the top
and bottom of the text, respectively, to remain visible."
- :group 'gnus-cite
:type '(choice (const :tag "none" nil)
integer
(cons :tag "Top and Bottom" integer integer)))
@@ -58,13 +55,11 @@ and bottom of the text, respectively, to remain visible."
(defcustom gnus-cite-parse-max-size 25000
"Maximum article size (in bytes) where parsing citations is allowed.
Set it to nil to parse all articles."
- :group 'gnus-cite
:type '(choice (const :tag "all" nil)
integer))
(defcustom gnus-cite-max-prefix 20
"Maximum possible length for a citation prefix."
- :group 'gnus-cite
:type 'integer)
(defcustom gnus-supercite-regexp
@@ -72,18 +67,15 @@ Set it to nil to parse all articles."
">>>>> +\"\\([^\"\n]+\\)\" +==")
"Regexp matching normal Supercite attribution lines.
The first grouping must match prefixes added by other packages."
- :group 'gnus-cite
:type 'regexp)
(defcustom gnus-supercite-secondary-regexp "^.*\"\\([^\"\n]+\\)\" +=="
"Regexp matching mangled Supercite attribution lines.
The first regexp group should match the Supercite attribution."
- :group 'gnus-cite
:type 'regexp)
(defcustom gnus-cite-minimum-match-count 2
"Minimum number of identical prefixes before we believe it's a citation."
- :group 'gnus-cite
:type 'integer)
;; Some Microsoft products put in a citation that extends to the
@@ -106,21 +98,18 @@ The first regexp group should match the Supercite
attribution."
(defcustom gnus-cite-attribution-prefix
"In article\\|in <\\|On
\\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\),\\|----- ?Original Message ?-----"
"Regexp matching the beginning of an attribution line."
- :group 'gnus-cite
:type 'regexp)
(defcustom gnus-cite-attribution-suffix
"\\(\\(wrote\\|writes\\|said\\|says\\|>\\)\\(:\\|\\.\\.\\.\\)\\|-----
?Original Message ?-----\\)[ \t]*$"
"Regexp matching the end of an attribution line.
The text matching the first grouping will be used as a button."
- :group 'gnus-cite
:type 'regexp)
(defcustom gnus-cite-unsightly-citation-regexp
"^-----Original Message-----\nFrom: \\(.+\n\\)+\n"
"Regexp matching Microsoft-type rest-of-message citations."
:version "22.1"
- :group 'gnus-cite
:type 'regexp)
(defcustom gnus-cite-ignore-quoted-from t
@@ -128,18 +117,15 @@ The text matching the first grouping will be used as a
button."
Those lines may have been quoted by MTAs in order not to mix up with
the envelope From line."
:version "22.1"
- :group 'gnus-cite
:type 'boolean)
(defface gnus-cite-attribution '((t (:italic t)))
- "Face used for attribution lines."
- :group 'gnus-cite)
+ "Face used for attribution lines.")
(defcustom gnus-cite-attribution-face 'gnus-cite-attribution
"Face used for attribution lines.
It is merged with the face for the cited text belonging to the attribution."
:version "22.1"
- :group 'gnus-cite
:type 'face)
(defface gnus-cite-1 '((((class color)
@@ -150,8 +136,7 @@ It is merged with the face for the cited text belonging to
the attribution."
(:foreground "MidnightBlue"))
(t
(:italic t)))
- "Citation face."
- :group 'gnus-cite)
+ "Citation face.")
(defface gnus-cite-2 '((((class color)
(background dark))
@@ -161,8 +146,7 @@ It is merged with the face for the cited text belonging to
the attribution."
(:foreground "firebrick"))
(t
(:italic t)))
- "Citation face."
- :group 'gnus-cite)
+ "Citation face.")
(defface gnus-cite-3 '((((class color)
(background dark))
@@ -172,8 +156,7 @@ It is merged with the face for the cited text belonging to
the attribution."
(:foreground "dark green"))
(t
(:italic t)))
- "Citation face."
- :group 'gnus-cite)
+ "Citation face.")
(defface gnus-cite-4 '((((class color)
(background dark))
@@ -183,8 +166,7 @@ It is merged with the face for the cited text belonging to
the attribution."
(:foreground "OrangeRed"))
(t
(:italic t)))
- "Citation face."
- :group 'gnus-cite)
+ "Citation face.")
(defface gnus-cite-5 '((((class color)
(background dark))
@@ -194,8 +176,7 @@ It is merged with the face for the cited text belonging to
the attribution."
(:foreground "dark khaki"))
(t
(:italic t)))
- "Citation face."
- :group 'gnus-cite)
+ "Citation face.")
(defface gnus-cite-6 '((((class color)
(background dark))
@@ -205,8 +186,7 @@ It is merged with the face for the cited text belonging to
the attribution."
(:foreground "dark violet"))
(t
(:italic t)))
- "Citation face."
- :group 'gnus-cite)
+ "Citation face.")
(defface gnus-cite-7 '((((class color)
(background dark))
@@ -216,8 +196,7 @@ It is merged with the face for the cited text belonging to
the attribution."
(:foreground "SteelBlue4"))
(t
(:italic t)))
- "Citation face."
- :group 'gnus-cite)
+ "Citation face.")
(defface gnus-cite-8 '((((class color)
(background dark))
@@ -227,8 +206,7 @@ It is merged with the face for the cited text belonging to
the attribution."
(:foreground "magenta"))
(t
(:italic t)))
- "Citation face."
- :group 'gnus-cite)
+ "Citation face.")
(defface gnus-cite-9 '((((class color)
(background dark))
@@ -238,8 +216,7 @@ It is merged with the face for the cited text belonging to
the attribution."
(:foreground "violet"))
(t
(:italic t)))
- "Citation face."
- :group 'gnus-cite)
+ "Citation face.")
(defface gnus-cite-10 '((((class color)
(background dark))
@@ -249,8 +226,7 @@ It is merged with the face for the cited text belonging to
the attribution."
(:foreground "medium purple"))
(t
(:italic t)))
- "Citation face."
- :group 'gnus-cite)
+ "Citation face.")
(defface gnus-cite-11 '((((class color)
(background dark))
@@ -260,8 +236,7 @@ It is merged with the face for the cited text belonging to
the attribution."
(:foreground "turquoise"))
(t
(:italic t)))
- "Citation face."
- :group 'gnus-cite)
+ "Citation face.")
(defcustom gnus-cite-face-list
'(gnus-cite-1 gnus-cite-2 gnus-cite-3 gnus-cite-4 gnus-cite-5 gnus-cite-6
@@ -271,7 +246,6 @@ It is merged with the face for the cited text belonging to
the attribution."
When there are citations from multiple articles in the same message,
Gnus will try to give each citation from each article its own face.
This should make it easier to see who wrote what."
- :group 'gnus-cite
:type '(repeat face)
:set (lambda (symbol value)
(prog1
@@ -290,17 +264,14 @@ This should make it easier to see who wrote what."
(defcustom gnus-cite-hide-percentage 50
"Only hide excess citation if above this percentage of the body."
- :group 'gnus-cite
:type 'number)
(defcustom gnus-cite-hide-absolute 10
"Only hide excess citation if above this number of lines in the body."
- :group 'gnus-cite
:type 'integer)
(defcustom gnus-cite-blank-line-after-header t
"If non-nil, put a blank line between the citation header and the button."
- :group 'gnus-cite
:type 'boolean)
;; This has to go here because its default value depends on
@@ -445,7 +416,7 @@ Lines matching `gnus-cite-attribution-suffix' and perhaps
(gnus-article-search-signature)
(push (cons (point-marker) "") marks)
;; Sort the marks.
- (setq marks (sort marks 'car-less-than-car))
+ (setq marks (sort marks #'car-less-than-car))
(let ((omarks marks))
(setq marks nil)
(while (cdr omarks)
@@ -553,7 +524,7 @@ text (i.e., computer code and the like) will not be folded."
;; like code? Check for ragged edges on the left.
(< (length columns) 3))))
-(defun gnus-article-hide-citation (&optional arg force)
+(defun gnus-article-hide-citation (&optional arg _force)
"Toggle hiding of all cited text except attribution lines.
See the documentation for `gnus-article-highlight-citation'.
If given a negative prefix, always show; if given a positive prefix,
@@ -623,7 +594,7 @@ always hide."
(progn
(gnus-article-add-button
(point)
- (progn (eval gnus-cited-closed-text-button-line-format-spec)
+ (progn (eval gnus-cited-closed-text-button-line-format-spec t)
(point))
'gnus-article-toggle-cited-text
(list (cons beg end) start))
@@ -673,7 +644,8 @@ means show, nil means toggle."
(progn (eval
(if hidden
gnus-cited-opened-text-button-line-format-spec
- gnus-cited-closed-text-button-line-format-spec))
+ gnus-cited-closed-text-button-line-format-spec)
+ t)
(point))
'gnus-article-toggle-cited-text
args)
@@ -726,7 +698,7 @@ See also the documentation for
`gnus-article-highlight-citation'."
;;; Internal functions:
-(defun gnus-cite-parse-maybe (&optional force no-overlay)
+(defun gnus-cite-parse-maybe (&optional _force no-overlay)
"Always parse the buffer."
(gnus-cite-localize)
;;Reset parser information.
@@ -919,25 +891,25 @@ See also the documentation for
`gnus-article-highlight-citation'."
(regexp-quote tag) ">"))))
;; Find loose supercite citations after attributions.
(gnus-cite-match-attributions 'small t
- (lambda (prefix tag)
+ (lambda (_prefix tag)
(when tag
(concat "\\<"
(regexp-quote tag)
"\\>"))))
;; Find loose supercite citations anywhere.
(gnus-cite-match-attributions 'small nil
- (lambda (prefix tag)
+ (lambda (_prefix tag)
(when tag
(concat "\\<"
(regexp-quote tag)
"\\>"))))
;; Find nested citations after attributions.
(gnus-cite-match-attributions 'small-if-unique t
- (lambda (prefix tag)
+ (lambda (prefix _tag)
(concat "\\`" (regexp-quote prefix) ".+")))
;; Find nested citations anywhere.
(gnus-cite-match-attributions 'small nil
- (lambda (prefix tag)
+ (lambda (prefix _tag)
(concat "\\`" (regexp-quote prefix) ".+")))
;; Remove loose prefixes with too few lines.
(let ((alist gnus-cite-loose-prefix-alist)
@@ -999,7 +971,7 @@ See also the documentation for
`gnus-article-highlight-citation'."
cites (cdr cites)
candidate (car cite)
numbers (cdr cite)
- first (apply 'min numbers)
+ first (apply #'min numbers)
compare (if size (length candidate) first))
(and (> first limit)
regexp
@@ -1125,7 +1097,7 @@ See also the documentation for
`gnus-article-highlight-citation'."
"Search for a cited line and set match data accordingly.
Returns nil if there is no such line before LIMIT, t otherwise."
(when (re-search-forward gnus-message-cite-prefix-regexp limit t)
- (let ((cdepth (min (length (apply 'concat
+ (let ((cdepth (min (length (apply #'concat
(split-string
(match-string-no-properties 0)
"[\t [:alnum:]]+")))
@@ -1166,7 +1138,7 @@ When enabled, it automatically turns on `font-lock-mode'."
(when (derived-mode-p 'message-mode)
;; FIXME: Use font-lock-add-keywords!
(let ((defaults (car font-lock-defaults))
- default keywords)
+ default) ;; keywords
(while defaults
(setq default (if (consp defaults)
(pop defaults)
diff --git a/lisp/gnus/gnus-cloud.el b/lisp/gnus/gnus-cloud.el
index f7c71f4..3bc94f1 100644
--- a/lisp/gnus/gnus-cloud.el
+++ b/lisp/gnus/gnus-cloud.el
@@ -1,4 +1,4 @@
-;;; gnus-cloud.el --- storing and retrieving data via IMAP
+;;; gnus-cloud.el --- storing and retrieving data via IMAP -*-
lexical-binding: t; -*-
;; Copyright (C) 2014-2021 Free Software Foundation, Inc.
@@ -52,14 +52,12 @@ Each element may be either a string or a property list.
The latter should have a :directory element whose value is a string,
and a :match element whose value is a regular expression to match
against the basename of files in said directory."
- :group 'gnus-cloud
:type '(repeat (choice (string :tag "File")
(plist :tag "Property list"))))
(defcustom gnus-cloud-storage-method (if (featurep 'epg) 'epg 'base64-gzip)
"Storage method for cloud data, defaults to EPG if that's available."
:version "26.1"
- :group 'gnus-cloud
:type '(radio (const :tag "No encoding" nil)
(const :tag "Base64" base64)
(const :tag "Base64+gzip" base64-gzip)
@@ -68,7 +66,6 @@ against the basename of files in said directory."
(defcustom gnus-cloud-interactive t
"Whether Gnus Cloud changes should be confirmed."
:version "26.1"
- :group 'gnus-cloud
:type 'boolean)
(defvar gnus-cloud-group-name "Emacs-Cloud")
@@ -81,7 +78,6 @@ against the basename of files in said directory."
"The IMAP select method used to store the cloud data.
See also `gnus-server-set-cloud-method-server' for an
easy interactive way to set this from the Server buffer."
- :group 'gnus-cloud
:type '(radio (const :tag "Not set" nil)
(string :tag "A Gnus server name as a string")))
@@ -132,7 +128,7 @@ easy interactive way to set this from the Server buffer."
((eq gnus-cloud-storage-method 'epg)
(let ((context (epg-make-context 'OpenPGP))
- cipher)
+ ) ;; cipher
(setf (epg-context-armor context) t)
(setf (epg-context-textmode context) t)
(let ((data (epg-encrypt-string context
@@ -348,15 +344,15 @@ easy interactive way to set this from the Server buffer."
(group &optional previous method))
(defun gnus-cloud-ensure-cloud-group ()
- (let ((method (if (stringp gnus-cloud-method)
- (gnus-server-to-method gnus-cloud-method)
- gnus-cloud-method)))
+ ;; (let ((method (if (stringp gnus-cloud-method)
+ ;; (gnus-server-to-method gnus-cloud-method)
+ ;; gnus-cloud-method)))
(unless (or (gnus-active gnus-cloud-group-name)
(gnus-activate-group gnus-cloud-group-name nil nil
gnus-cloud-method))
(and (gnus-request-create-group gnus-cloud-group-name gnus-cloud-method)
(gnus-activate-group gnus-cloud-group-name nil nil
gnus-cloud-method)
- (gnus-subscribe-group gnus-cloud-group-name)))))
+ (gnus-subscribe-group gnus-cloud-group-name)))) ;; )
(defun gnus-cloud-upload-all-data ()
"Upload all data (newsrc and files) to the Gnus Cloud."
diff --git a/lisp/gnus/gnus-cus.el b/lisp/gnus/gnus-cus.el
index dc14943..d8f48b1 100644
--- a/lisp/gnus/gnus-cus.el
+++ b/lisp/gnus/gnus-cus.el
@@ -1,4 +1,4 @@
-;;; gnus-cus.el --- customization commands for Gnus
+;;; gnus-cus.el --- customization commands for Gnus -*- lexical-binding: t;
-*-
;; Copyright (C) 1996, 1999-2021 Free Software Foundation, Inc.
@@ -417,7 +417,7 @@ category."))
(setq tmp (cdr tmp))))
(setq gnus-custom-params
- (apply 'widget-create 'group
+ (apply #'widget-create 'group
:value values
(delq nil
(list `(set :inline t
@@ -483,7 +483,7 @@ form, but who cares?"
(buffer-enable-undo)
(goto-char (point-min))))
-(defun gnus-group-customize-done (&rest ignore)
+(defun gnus-group-customize-done (&rest _ignore)
"Apply changes and bury the buffer."
(interactive)
(let ((params (widget-value gnus-custom-params)))
@@ -927,7 +927,7 @@ articles in the thread.
(use-local-map widget-keymap)
(widget-setup)))
-(defun gnus-score-customize-done (&rest ignore)
+(defun gnus-score-customize-done (&rest _ignore)
"Reset the score alist with the present value."
(let ((alist gnus-custom-score-alist)
(value (widget-value gnus-custom-scores)))
@@ -1027,14 +1027,15 @@ articles in the thread.
(widget-create
'push-button
:notify
- (lambda (&rest ignore)
+ (lambda (&rest _ignore)
(let* ((info (assq gnus-agent-cat-name gnus-category-alist))
(widgets category-fields))
(while widgets
(let* ((widget (pop widgets))
(value (condition-case nil (widget-value widget)
(error))))
(eval `(setf (,(widget-get widget :accessor) ',info)
- ',value)))))
+ ',value)
+ t))))
(gnus-category-write)
(gnus-kill-buffer (current-buffer))
(when (get-buffer gnus-category-buffer)
diff --git a/lisp/gnus/gnus-delay.el b/lisp/gnus/gnus-delay.el
index 477ad88..0cee01b 100644
--- a/lisp/gnus/gnus-delay.el
+++ b/lisp/gnus/gnus-delay.el
@@ -1,4 +1,4 @@
-;;; gnus-delay.el --- Delayed posting of articles
+;;; gnus-delay.el --- Delayed posting of articles -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
@@ -44,24 +44,20 @@
(defcustom gnus-delay-group "delayed"
"Group name for storing delayed articles."
- :type 'string
- :group 'gnus-delay)
+ :type 'string)
(defcustom gnus-delay-header "X-Gnus-Delayed"
"Header name for storing info about delayed articles."
- :type 'string
- :group 'gnus-delay)
+ :type 'string)
(defcustom gnus-delay-default-delay "3d"
"Default length of delay."
- :type 'string
- :group 'gnus-delay)
+ :type 'string)
(defcustom gnus-delay-default-hour 8
"If deadline is given as date, then assume this time of day."
:version "22.1"
- :type 'integer
- :group 'gnus-delay)
+ :type 'integer)
;;;###autoload
(defun gnus-delay-article (delay)
@@ -86,7 +82,7 @@ generated when the article is sent."
gnus-delay-default-delay)))
;; Allow spell checking etc.
(run-hooks 'message-send-hook)
- (let (num unit days year month day hour minute deadline)
+ (let (num unit year month day hour minute deadline) ;; days
(cond ((string-match
"\\([0-9][0-9][0-9]?[0-9]?\\)-\\([0-9]+\\)-\\([0-9]+\\)"
delay)
@@ -171,7 +167,7 @@ generated when the article is sent."
(message "Delay header missing for article %d" article)))))))
;;;###autoload
-(defun gnus-delay-initialize (&optional no-keymap no-check)
+(defun gnus-delay-initialize (&optional _no-keymap no-check)
"Initialize the gnus-delay package.
This sets up a key binding in `message-mode' to delay a message.
This tells Gnus to look for delayed messages after getting new news.
@@ -179,7 +175,7 @@ This tells Gnus to look for delayed messages after getting
new news.
The optional arg NO-KEYMAP is ignored.
Checking delayed messages is skipped if optional arg NO-CHECK is non-nil."
(unless no-check
- (add-hook 'gnus-get-new-news-hook 'gnus-delay-send-queue)))
+ (add-hook 'gnus-get-new-news-hook #'gnus-delay-send-queue)))
(provide 'gnus-delay)
diff --git a/lisp/gnus/gnus-demon.el b/lisp/gnus/gnus-demon.el
index 219f15e..e99247c 100644
--- a/lisp/gnus/gnus-demon.el
+++ b/lisp/gnus/gnus-demon.el
@@ -1,4 +1,4 @@
-;;; gnus-demon.el --- daemonic Gnus behavior
+;;; gnus-demon.el --- daemonic Gnus behavior -*- lexical-binding: t; -*-
;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
@@ -52,7 +52,6 @@ this number of `gnus-demon-timestep's.
If IDLE is nil, don't care about idleness.
If IDLE is a number and TIME is nil, then call once each time
Emacs has been idle for IDLE `gnus-demon-timestep's."
- :group 'gnus-demon
:type '(repeat (list function
(choice :tag "Time"
(const :tag "never" nil)
@@ -65,7 +64,6 @@ Emacs has been idle for IDLE `gnus-demon-timestep's."
(defcustom gnus-demon-timestep 60
"Number of seconds in each demon timestep."
- :group 'gnus-demon
:type 'integer)
;;; Internal variables.
diff --git a/lisp/gnus/gnus-diary.el b/lisp/gnus/gnus-diary.el
index 78f1e53..5270564 100644
--- a/lisp/gnus/gnus-diary.el
+++ b/lisp/gnus/gnus-diary.el
@@ -1,4 +1,4 @@
-;;; gnus-diary.el --- Wrapper around the NNDiary Gnus back end
+;;; gnus-diary.el --- Wrapper around the NNDiary Gnus back end -*-
lexical-binding: t; -*-
;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
@@ -57,8 +57,7 @@
(defcustom gnus-diary-time-format "%a, %b %e %y, %H:%M"
"Time format to display appointments in nndiary summary buffers.
Please refer to `format-time-string' for information on possible values."
- :type 'string
- :group 'gnus-diary)
+ :type 'string)
(defcustom gnus-diary-delay-format-function 'gnus-diary-delay-format-english
"Function called to format a diary delay string.
@@ -73,8 +72,7 @@ There are currently two built-in format functions:
`gnus-diary-delay-format-french'"
:type '(choice (const :tag "english" gnus-diary-delay-format-english)
(const :tag "french" gnus-diary-delay-format-french)
- (symbol :tag "other"))
- :group 'gnus-diary)
+ (symbol :tag "other")))
(defconst gnus-diary-version nndiary-version
"Current Diary back end version.")
@@ -276,13 +274,13 @@ Optional prefix (or REVERSE argument) means sort in
reverse order."
(gnus-diary-update-group-parameters group)))
(add-hook 'nndiary-request-create-group-functions
- 'gnus-diary-update-group-parameters)
+ #'gnus-diary-update-group-parameters)
;; Now that we have `gnus-subscribe-newsgroup-functions', this is not needed
;; anymore. Maybe I should remove this completely.
(add-hook 'nndiary-request-update-info-functions
- 'gnus-diary-update-group-parameters)
+ #'gnus-diary-update-group-parameters)
(add-hook 'gnus-subscribe-newsgroup-functions
- 'gnus-diary-maybe-update-group-parameters)
+ #'gnus-diary-maybe-update-group-parameters)
;; Diary Message Checking ===================================================
@@ -360,7 +358,7 @@ If ARG (or prefix) is non-nil, force prompting for all
fields."
header ": ")))
(setq value
(if (listp (nth 1 head))
- (gnus-completing-read prompt (cons "*" (mapcar 'car (nth
1 head)))
+ (gnus-completing-read prompt (cons "*" (mapcar #'car
(nth 1 head)))
t value
'gnus-diary-header-value-history)
(read-string prompt value
diff --git a/lisp/gnus/gnus-dired.el b/lisp/gnus/gnus-dired.el
index 6f231c4..ca2d57d 100644
--- a/lisp/gnus/gnus-dired.el
+++ b/lisp/gnus/gnus-dired.el
@@ -1,4 +1,4 @@
-;;; gnus-dired.el --- utility functions where gnus and dired meet
+;;; gnus-dired.el --- utility functions where gnus and dired meet -*-
lexical-binding: t; -*-
;; Copyright (C) 1996-1999, 2001-2021 Free Software Foundation, Inc.
@@ -29,7 +29,7 @@
;; following in your ~/.gnus:
;; (require 'gnus-dired) ;, isn't needed due to autoload cookies
-;; (add-hook 'dired-mode-hook 'turn-on-gnus-dired-mode)
+;; (add-hook 'dired-mode-hook #'turn-on-gnus-dired-mode)
;; Note that if you visit dired buffers before your ~/.gnus file has
;; been read, those dired buffers won't have the keybindings in
@@ -40,7 +40,6 @@
(require 'dired)
(autoload 'mml-attach-file "mml")
-(autoload 'mm-default-file-encoding "mm-decode");; Shift this to `mailcap.el'?
(autoload 'mailcap-extension-to-mime "mailcap")
(autoload 'mailcap-mime-info "mailcap")
@@ -166,8 +165,9 @@ filenames."
(goto-char (point-max)) ;attach at end of buffer
(while files-to-attach
(mml-attach-file (car files-to-attach)
- (or (mm-default-file-encoding (car files-to-attach))
- "application/octet-stream") nil)
+ (or (mm-default-file-type (car files-to-attach))
+ "application/octet-stream")
+ nil)
(setq files-to-attach (cdr files-to-attach)))
(message "Attached file(s) %s" files-str))))
diff --git a/lisp/gnus/gnus-draft.el b/lisp/gnus/gnus-draft.el
index 5f7ed38..f68e9d6 100644
--- a/lisp/gnus/gnus-draft.el
+++ b/lisp/gnus/gnus-draft.el
@@ -1,4 +1,4 @@
-;;; gnus-draft.el --- draft message support for Gnus
+;;; gnus-draft.el --- draft message support for Gnus -*- lexical-binding: t;
-*-
;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
@@ -65,7 +65,7 @@
;; Set up the menu.
(when (gnus-visual-p 'draft-menu 'menu)
(gnus-draft-make-menu-bar))
- (add-hook 'gnus-summary-prepare-exit-hook 'gnus-draft-clear-marks t t))))
+ (add-hook 'gnus-summary-prepare-exit-hook #'gnus-draft-clear-marks t t))))
;;; Commands
@@ -99,11 +99,11 @@
(let ((gnus-verbose-backends nil))
(gnus-request-expire-articles (list article) group t))
(push
- `((lambda ()
- (when (gnus-buffer-live-p ,gnus-summary-buffer)
- (save-excursion
- (set-buffer ,gnus-summary-buffer)
- (gnus-cache-possibly-remove-article ,article nil nil nil t)))))
+ (let ((buf gnus-summary-buffer))
+ (lambda ()
+ (when (gnus-buffer-live-p buf)
+ (with-current-buffer buf
+ (gnus-cache-possibly-remove-article article nil nil nil t)))))
message-send-actions)))
(defun gnus-draft-send-message (&optional n)
@@ -275,8 +275,7 @@ If DONT-POP is nil, display the buffer after setting it up."
(gnus-configure-posting-styles)
(setq gnus-message-group-art (cons gnus-newsgroup-name (cadr ga)))
(setq message-post-method
- `(lambda (arg)
- (gnus-post-method arg ,(car ga))))
+ (lambda (arg) (gnus-post-method arg (car ga))))
(unless (equal (cadr ga) "")
(dolist (article (cdr ga))
(message-add-action
diff --git a/lisp/gnus/gnus-dup.el b/lisp/gnus/gnus-dup.el
index f7d61bb..e4f3da9 100644
--- a/lisp/gnus/gnus-dup.el
+++ b/lisp/gnus/gnus-dup.el
@@ -40,17 +40,14 @@
"If non-nil, save the duplicate list when shutting down Gnus.
If nil, duplicate suppression will only work on duplicates
seen in the same session."
- :group 'gnus-duplicate
:type 'boolean)
(defcustom gnus-duplicate-list-length 10000
"The maximum number of duplicate Message-IDs to keep track of."
- :group 'gnus-duplicate
:type 'integer)
(defcustom gnus-duplicate-file (nnheader-concat gnus-directory "suppression")
"The name of the file to store the duplicate suppression list."
- :group 'gnus-duplicate
:type 'file)
;;; Internal variables
diff --git a/lisp/gnus/gnus-eform.el b/lisp/gnus/gnus-eform.el
index feee732..265edf4 100644
--- a/lisp/gnus/gnus-eform.el
+++ b/lisp/gnus/gnus-eform.el
@@ -1,4 +1,4 @@
-;;; gnus-eform.el --- a mode for editing forms for Gnus
+;;; gnus-eform.el --- a mode for editing forms for Gnus -*- lexical-binding:
t; -*-
;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
@@ -37,12 +37,10 @@
(defcustom gnus-edit-form-mode-hook nil
"Hook run in `gnus-edit-form-mode' buffers."
- :group 'gnus-edit-form
:type 'hook)
(defcustom gnus-edit-form-menu-hook nil
"Hook run when creating menus in `gnus-edit-form-mode' buffers."
- :group 'gnus-edit-form
:type 'hook)
;;; Internal variables
diff --git a/lisp/gnus/gnus-fun.el b/lisp/gnus/gnus-fun.el
index 615f4a5..f69c2ed 100644
--- a/lisp/gnus/gnus-fun.el
+++ b/lisp/gnus/gnus-fun.el
@@ -1,4 +1,4 @@
-;;; gnus-fun.el --- various frivolous extension functions to Gnus
+;;; gnus-fun.el --- various frivolous extension functions to Gnus -*-
lexical-binding: t; -*-
;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
@@ -268,9 +268,9 @@ colors of the displayed X-Faces."
'xface
(gnus-put-image
(if (gnus-image-type-available-p 'xface)
- (apply 'gnus-create-image (concat "X-Face: " data) 'xface t
+ (apply #'gnus-create-image (concat "X-Face: " data) 'xface t
(cdr (assq 'xface gnus-face-properties-alist)))
- (apply 'gnus-create-image pbm 'pbm t
+ (apply #'gnus-create-image pbm 'pbm t
(cdr (assq 'pbm gnus-face-properties-alist))))
nil 'xface))
(gnus-add-wash-type 'xface))))))
@@ -325,7 +325,7 @@ colors of the displayed X-Faces."
(dotimes (i 255)
(push (format format i i i i i i)
values))
- (mapconcat 'identity values " ")))
+ (mapconcat #'identity values " ")))
(defun gnus-funcall-no-warning (function &rest args)
(when (fboundp function)
diff --git a/lisp/gnus/gnus-gravatar.el b/lisp/gnus/gnus-gravatar.el
index a7ca733..9ea9e10 100644
--- a/lisp/gnus/gnus-gravatar.el
+++ b/lisp/gnus/gnus-gravatar.el
@@ -38,21 +38,18 @@
If nil, default to `gravatar-size'."
:type '(choice (const :tag "Default" nil)
(integer :tag "Pixels"))
- :version "24.1"
- :group 'gnus-gravatar)
+ :version "24.1")
(defcustom gnus-gravatar-properties '(:ascent center :relief 1)
"List of image properties applied to Gravatar images."
:type 'plist
- :version "24.1"
- :group 'gnus-gravatar)
+ :version "24.1")
(defcustom gnus-gravatar-too-ugly gnus-article-x-face-too-ugly
"Regexp matching posters whose avatar shouldn't be shown automatically.
If nil, show all avatars."
:type '(choice regexp (const :tag "Allow all" nil))
- :version "24.1"
- :group 'gnus-gravatar)
+ :version "24.1")
(defun gnus-gravatar-transform-address (header category &optional force)
(gnus-with-article-headers
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index ff792c5..e8b62a4 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -1,4 +1,4 @@
-;;; gnus-group.el --- group mode commands for Gnus
+;;; gnus-group.el --- group mode commands for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
@@ -39,10 +39,11 @@
(eval-when-compile
(require 'mm-url)
(require 'subr-x)
- (let ((features (cons 'gnus-group features)))
- (require 'gnus-sum))
- (unless (boundp 'gnus-cache-active-hashtb)
- (defvar gnus-cache-active-hashtb nil)))
+ (with-suppressed-warnings ((lexical features))
+ (dlet ((features (cons 'gnus-group features)))
+ (require 'gnus-sum))))
+
+(defvar gnus-cache-active-hashtb)
(defvar tool-bar-mode)
@@ -366,13 +367,16 @@ requires an understanding of Lisp expressions. Hopefully
this will
change in a future release. For now, you can use the following
variables in the Lisp expression:
-group: The name of the group.
-unread: The number of unread articles in the group.
-method: The select method used.
-mailp: Whether it's a mail group or not.
-level: The level of the group.
-score: The score of the group.
-ticked: The number of ticked articles."
+`group': The name of the group.
+`unread': The number of unread articles in the group.
+`method': The select method used.
+`total': The total number of articles in the group.
+`mailp': Whether it's a mail group or not.
+`level': The level of the group.
+`score': The score of the group.
+`ticked': The number of ticked articles.
+`group-age': Time in seconds since the group was last read
+ (see info node `(gnus)Group Timestamp')."
:group 'gnus-group-visual
:type '(repeat (cons (sexp :tag "Form") face)))
(put 'gnus-group-highlight 'risky-local-variable t)
@@ -400,16 +404,8 @@ file.
It is also possible to change and add form fields, but currently that
requires an understanding of Lisp expressions. Hopefully this will
-change in a future release. For now, you can use the following
-variables in the Lisp expression:
-
-group: The name of the group.
-unread: The number of unread articles in the group.
-method: The select method used.
-mailp: Whether it's a mail group or not.
-level: The level of the group.
-score: The score of the group.
-ticked: The number of ticked articles."
+change in a future release. For now, you can use the same
+variables in the Lisp expression as in `gnus-group-highlight'."
:group 'gnus-group-icons
:type '(repeat (cons (sexp :tag "Form") file)))
(put 'gnus-group-icon-list 'risky-local-variable t)
@@ -476,20 +472,31 @@ simple manner."
(defvar gnus-group-edit-buffer nil)
-(defvar gnus-tmp-news-method)
+(defvar gnus-tmp-active)
(defvar gnus-tmp-colon)
-(defvar gnus-tmp-news-server)
-(defvar gnus-tmp-header)
-(defvar gnus-tmp-process-marked)
-(defvar gnus-tmp-summary-live)
-(defvar gnus-tmp-news-method-string)
+(defvar gnus-tmp-comment)
+(defvar gnus-tmp-group)
(defvar gnus-tmp-group-icon)
+(defvar gnus-tmp-header)
+(defvar gnus-tmp-level)
+(defvar gnus-tmp-marked)
+(defvar gnus-tmp-marked-mark)
+(defvar gnus-tmp-method)
+(defvar gnus-tmp-moderated)
(defvar gnus-tmp-moderated-string)
(defvar gnus-tmp-newsgroup-description)
-(defvar gnus-tmp-comment)
+(defvar gnus-tmp-news-method)
+(defvar gnus-tmp-news-method-string)
+(defvar gnus-tmp-news-server)
+(defvar gnus-tmp-number-of-read)
+(defvar gnus-tmp-number-of-unread)
+(defvar gnus-tmp-number-total)
+(defvar gnus-tmp-process-marked)
(defvar gnus-tmp-qualified-group)
(defvar gnus-tmp-subscribed)
-(defvar gnus-tmp-number-of-read)
+(defvar gnus-tmp-summary-live)
+(defvar gnus-tmp-user-defined)
+
(defvar gnus-inhibit-demon)
(defvar gnus-pick-mode)
(defvar gnus-tmp-marked-mark)
@@ -505,7 +512,8 @@ simple manner."
(+ number
(gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
(gnus-range-length (cdr (assq 'tick gnus-tmp-marked))))))
- (t number)) ?s)
+ (t number))
+ ?s)
(?R gnus-tmp-number-of-read ?s)
(?U (if (gnus-active gnus-tmp-group)
(gnus-number-of-unseen-articles-in-group gnus-tmp-group)
@@ -516,7 +524,8 @@ simple manner."
(?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
(?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d)
(?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
- (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d)
+ (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))))
+ ?d)
(?g gnus-tmp-group ?s)
(?G gnus-tmp-qualified-group ?s)
(?c (gnus-short-group-name gnus-tmp-group)
@@ -1361,7 +1370,7 @@ if it is a string, only list groups matching REGEXP."
(and (>= level gnus-level-zombie)
(<= lowest gnus-level-zombie)))
(gnus-group-prepare-flat-list-dead
- (setq gnus-zombie-list (sort gnus-zombie-list 'string<))
+ (setq gnus-zombie-list (sort gnus-zombie-list #'string<))
gnus-level-zombie ?Z
regexp))
(when not-in-list
@@ -1372,7 +1381,7 @@ if it is a string, only list groups matching REGEXP."
(gnus-group-prepare-flat-list-dead
(cl-union
not-in-list
- (setq gnus-killed-list (sort gnus-killed-list 'string<))
+ (setq gnus-killed-list (sort gnus-killed-list #'string<))
:test 'equal)
gnus-level-killed ?K regexp))
@@ -1497,12 +1506,16 @@ if it is a string, only list groups matching REGEXP."
(gnus-group-get-new-news 0))))
:type 'boolean)
-(defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level
- gnus-tmp-marked number
- gnus-tmp-method)
+(defun gnus-group-insert-group-line (group level marked number method)
"Insert a group line in the group buffer."
- (let* ((gnus-tmp-method
- (gnus-server-get-method gnus-tmp-group gnus-tmp-method))
+ (with-suppressed-warnings ((lexical number))
+ (defvar number)) ;FIXME: Used in `gnus-group-line-format-alist'.
+ (let* ((number number)
+ (gnus-tmp-level level)
+ (gnus-tmp-marked marked)
+ (gnus-tmp-group group)
+ (gnus-tmp-method
+ (gnus-server-get-method gnus-tmp-group method))
(gnus-tmp-active (gnus-active gnus-tmp-group))
(gnus-tmp-number-total
(if gnus-tmp-active
@@ -1541,7 +1554,8 @@ if it is a string, only list groups matching REGEXP."
(gnus-tmp-news-method-string
(if gnus-tmp-method
(format "(%s:%s)" (car gnus-tmp-method)
- (cadr gnus-tmp-method)) ""))
+ (cadr gnus-tmp-method))
+ ""))
(gnus-tmp-marked-mark
(if (and (numberp number)
(zerop number)
@@ -1564,7 +1578,7 @@ if it is a string, only list groups matching REGEXP."
(point)
(prog1 (1+ (point))
;; Insert the text.
- (eval gnus-group-line-format-spec))
+ (eval gnus-group-line-format-spec t))
`(gnus-group ,gnus-tmp-group
gnus-unread ,(if (numberp number)
(string-to-number gnus-tmp-number-of-unread)
@@ -1605,10 +1619,12 @@ Some value are bound so the form can use them."
(marked (gnus-info-marks info))
(env
(list
+ (cons 'group group)
(cons 'unread (if (numberp (car entry)) (car entry) 0))
+ (cons 'method method)
(cons 'total (if active (1+ (- (cdr active) (car active))) 0))
(cons 'mailp (apply
- 'append
+ #'append
(mapcar
(lambda (x)
(memq x (assoc
@@ -1735,7 +1751,7 @@ already. If INFO-UNCHANGED is non-nil, dribble buffer is
not updated."
(buffer-modified-p gnus-dribble-buffer)
(with-current-buffer gnus-dribble-buffer
(not (zerop (buffer-size))))))
- (mode-string (eval gformat)))
+ (mode-string (eval gformat t)))
;; Say whether the dribble buffer has been modified.
(setq mode-line-modified
(if modified "**" "--"))
@@ -1883,7 +1899,7 @@ If FIRST-TOO, the current line is also eligible as a
target."
"Unmark all groups."
(interactive)
(save-excursion
- (mapc 'gnus-group-remove-mark gnus-group-marked))
+ (mapc #'gnus-group-remove-mark gnus-group-marked))
(gnus-group-position-point))
(defun gnus-group-mark-region (unmark beg end)
@@ -1931,7 +1947,7 @@ Return nil if the group isn't displayed."
(gnus-group-mark-group 1 nil t))
(setq gnus-group-marked (cons group (delete group gnus-group-marked)))))
-(defun gnus-group-universal-argument (arg &optional groups func)
+(defun gnus-group-universal-argument (arg &optional _groups func)
"Perform any command on all groups according to the process/prefix
convention."
(interactive "P")
(if (eq (setq func (or func
@@ -1942,7 +1958,7 @@ Return nil if the group isn't displayed."
'undefined)
(gnus-error 1 "Undefined key")
(gnus-group-iterate arg
- (lambda (group)
+ (lambda (_group)
(command-execute func))))
(gnus-group-position-point))
@@ -1985,31 +2001,18 @@ Take into consideration N (the prefix) and the list of
marked groups."
(let ((group (gnus-group-group-name)))
(and group (list group))))))
-;;; !!!Surely gnus-group-iterate should be a macro instead? I can't
-;;; imagine why I went through these contortions...
-(eval-and-compile
- (let ((function (make-symbol "gnus-group-iterate-function"))
- (window (make-symbol "gnus-group-iterate-window"))
- (groups (make-symbol "gnus-group-iterate-groups"))
- (group (make-symbol "gnus-group-iterate-group")))
- (eval
- `(defun gnus-group-iterate (arg ,function)
- "Iterate FUNCTION over all process/prefixed groups.
+(defun gnus-group-iterate (arg function)
+ "Iterate FUNCTION over all process/prefixed groups.
FUNCTION will be called with the group name as the parameter
and with point over the group in question."
- (let ((,groups (gnus-group-process-prefix arg))
- (,window (selected-window))
- ,group)
- (while ,groups
- (setq ,group (car ,groups)
- ,groups (cdr ,groups))
- (select-window ,window)
- (gnus-group-remove-mark ,group)
- (save-selected-window
- (save-excursion
- (funcall ,function ,group)))))))))
-
-(put 'gnus-group-iterate 'lisp-indent-function 1)
+ (declare (indent 1))
+ (let ((window (selected-window)))
+ (dolist (group (gnus-group-process-prefix arg))
+ (select-window window)
+ (gnus-group-remove-mark group)
+ (save-selected-window
+ (save-excursion
+ (funcall function group))))))
;; Selecting groups.
@@ -2064,6 +2067,12 @@ articles in the group."
(forward-line -1))
(gnus-group-read-group all t))
+(defvar gnus-visual)
+(defvar gnus-score-find-score-files-function)
+(defvar gnus-home-score-file)
+(defvar gnus-apply-kill-hook)
+(defvar gnus-summary-expunge-below)
+
(defun gnus-group-quick-select-group (&optional all group)
"Select the GROUP \"quickly\".
This means that no highlighting or scoring will be performed. If
@@ -2521,7 +2530,7 @@ The arguments have the same meaning as those of
(if (stringp id) (setq id (string-to-number id)))
(setq-local debbugs-gnu-bug-number id)))))
-(defun gnus-group-jump-to-group (group &optional prompt)
+(defun gnus-group-jump-to-group (group &optional _prompt)
"Jump to newsgroup GROUP.
If PROMPT (the prefix) is a number, use the prompt specified in
@@ -2807,7 +2816,7 @@ not-expirable articles, too."
(format "Do you really want to delete these %d articles forever? "
(length articles)))
(gnus-request-expire-articles articles group
- (if current-prefix-arg
+ (if oldp
nil
'force)))))
@@ -2926,8 +2935,8 @@ and NEW-NAME will be prompted for."
((eq part 'params) "group parameters")
(t "group info"))
group)
- `(lambda (form)
- (gnus-group-edit-group-done ',part ,group form)))
+ (lambda (form)
+ (gnus-group-edit-group-done part group form)))
(local-set-key
"\C-c\C-i"
(gnus-create-info-command
@@ -2985,7 +2994,7 @@ and NEW-NAME will be prompted for."
"Create one of the groups described in `gnus-useful-groups'."
(interactive
(let ((entry (assoc (gnus-completing-read "Create group"
- (mapcar 'car gnus-useful-groups)
+ (mapcar #'car gnus-useful-groups)
t)
gnus-useful-groups)))
(list (cadr entry)
@@ -2995,7 +3004,7 @@ and NEW-NAME will be prompted for."
(setq method (copy-tree method))
(let (entry)
(while (setq entry (memq (assq 'eval method) method))
- (setcar entry (eval (cadar entry)))))
+ (setcar entry (eval (cadar entry) t))))
(gnus-group-make-group group method))
(defun gnus-group-make-help-group (&optional noerror)
@@ -3118,7 +3127,7 @@ If there is, use Gnus to create an nnrss group"
(read-from-minibuffer "Title: "
(gnus-newsgroup-savable-name
(mapconcat
- 'identity
+ #'identity
(split-string
(or (cdr (assoc 'title
feedinfo))
@@ -3126,7 +3135,7 @@ If there is, use Gnus to create an nnrss group"
" ")))))
(desc (read-from-minibuffer "Description: "
(mapconcat
- 'identity
+ #'identity
(split-string
(or (cdr (assoc 'description
feedinfo))
@@ -3374,9 +3383,9 @@ Editing the access control list for `%s'.
implementation-defined hierarchy, RENAME or DELETE mailbox)
d - delete messages (STORE \\DELETED flag, perform EXPUNGE)
a - administer (perform SETACL)" group)
- `(lambda (form)
- (nnimap-acl-edit
- ,mailbox ',method ',acl form)))))
+ (lambda (form)
+ (nnimap-acl-edit
+ mailbox method acl form)))))
;; Group sorting commands
;; Suggested by Joe Hildebrand <hildjj@idaho.fuentez.com>.
@@ -4268,7 +4277,7 @@ If DONT-SCAN is non-nil, scan non-activated groups as
well."
(pop-to-buffer "*Gnus Help*")
(buffer-disable-undo)
(erase-buffer)
- (setq groups (sort groups 'string<))
+ (setq groups (sort groups #'string<))
(while groups
;; Groups may be entered twice into the list of groups.
(when (not (string= (car groups) prev))
@@ -4327,9 +4336,9 @@ If FORCE, force saving whether it is necessary or not."
(interactive "P")
(gnus-save-newsrc-file force))
-(defun gnus-group-restart (&optional arg)
+(defun gnus-group-restart (&optional _arg)
"Force Gnus to read the .newsrc file."
- (interactive "P")
+ (interactive)
(when (gnus-yes-or-no-p
(format "Are you sure you want to restart Gnus? "))
(gnus-save-newsrc-file)
@@ -4494,7 +4503,7 @@ and the second element is the address."
(interactive
(list (let ((how (gnus-completing-read
"Which back end"
- (mapcar 'car (append gnus-valid-select-methods
+ (mapcar #'car (append gnus-valid-select-methods
gnus-server-alist))
t (cons "nntp" 0) 'gnus-method-history)))
;; We either got a back end name or a virtual server name.
@@ -4616,7 +4625,9 @@ and the second element is the address."
(setcdr m (gnus-compress-sequence articles t)))
(setcdr m (gnus-compress-sequence
(sort (nconc (gnus-uncompress-range (cdr m))
- (copy-sequence articles)) '<) t))))))
+ (copy-sequence articles))
+ #'<)
+ t))))))
(declare-function gnus-summary-add-mark "gnus-sum" (article type))
@@ -4684,7 +4695,7 @@ This command may read the active file."
;; Cache active file might use "."
;; instead of ":".
(gethash
- (mapconcat 'identity
+ (mapconcat #'identity
(split-string group ":")
".")
gnus-cache-active-hashtb))))
@@ -4746,9 +4757,9 @@ This command may read the active file."
(forward-char 1))
groups))
-(defun gnus-group-list-plus (&optional args)
+(defun gnus-group-list-plus (&optional _args)
"List groups plus the current selection."
- (interactive "P")
+ (interactive)
(let ((gnus-group-listed-groups (gnus-group-listed-groups))
(gnus-group-list-mode gnus-group-list-mode) ;; Save it.
func)
@@ -4808,7 +4819,7 @@ you the groups that have both dormant articles and cached
articles."
(push n gnus-newsgroup-unselected))
(setq n (1+ n)))
(setq gnus-newsgroup-unselected
- (sort gnus-newsgroup-unselected '<)))))
+ (sort gnus-newsgroup-unselected #'<)))))
(gnus-activate-group group)
(gnus-group-make-articles-read group (list article))
(when (and (gnus-group-auto-expirable-p group)
diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el
index bb1ee5a..be62bfd 100644
--- a/lisp/gnus/gnus-html.el
+++ b/lisp/gnus/gnus-html.el
@@ -1,4 +1,4 @@
-;;; gnus-html.el --- Render HTML in a buffer.
+;;; gnus-html.el --- Render HTML in a buffer. -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
@@ -151,8 +151,8 @@ fit these criteria."
(defun gnus-html-wash-images ()
"Run through current buffer and replace img tags by images."
- (let (tag parameters string start end images url alt-text
- inhibit-images blocked-images)
+ (let ( parameters start end ;; tag string images
+ inhibit-images blocked-images)
(if (buffer-live-p gnus-summary-buffer)
(with-current-buffer gnus-summary-buffer
(setq inhibit-images gnus-inhibit-images
@@ -169,67 +169,67 @@ fit these criteria."
(delete-region (match-beginning 0) (match-end 0)))
(setq end (point))
(when (string-match "src=\"\\([^\"]+\\)" parameters)
- (gnus-message 8 "gnus-html-wash-tags: fetching image URL %s" url)
- (setq url (gnus-html-encode-url (match-string 1 parameters))
- alt-text (when (string-match "\\(alt\\|title\\)=\"\\([^\"]+\\)"
- parameters)
- (xml-substitute-special (match-string 2 parameters))))
- (add-text-properties
- start end
- (list 'image-url url
- 'image-displayer `(lambda (url start end)
- (gnus-html-display-image url start end
- ,alt-text))
- 'help-echo alt-text
- 'button t
- 'keymap gnus-html-image-map
- 'gnus-image (list url start end alt-text)))
- (if (string-match "\\`cid:" url)
- ;; URLs with cid: have their content stashed in other
- ;; parts of the MIME structure, so just insert them
- ;; immediately.
- (let* ((handle (mm-get-content-id (substring url (match-end 0))))
- (image (when (and handle
- (not inhibit-images))
- (gnus-create-image
- (mm-with-part handle (buffer-string))
- nil t))))
- (if image
- (gnus-add-image
- 'cid
- (gnus-put-image
- (gnus-rescale-image
- image (gnus-html-maximum-image-size))
- (gnus-string-or (prog1
- (buffer-substring start end)
- (delete-region start end))
- "*")
- 'cid))
+ (let ((url (gnus-html-encode-url (match-string 1 parameters)))
+ (alt-text (when (string-match "\\(alt\\|title\\)=\"\\([^\"]+\\)"
+ parameters)
+ (xml-substitute-special (match-string 2
parameters)))))
+ (gnus-message 8 "gnus-html-wash-tags: fetching image URL %s" url)
+ (add-text-properties
+ start end
+ (list 'image-url url
+ 'image-displayer (lambda (url start end)
+ (gnus-html-display-image url start end
+ alt-text))
+ 'help-echo alt-text
+ 'button t
+ 'keymap gnus-html-image-map
+ 'gnus-image (list url start end alt-text)))
+ (if (string-match "\\`cid:" url)
+ ;; URLs with cid: have their content stashed in other
+ ;; parts of the MIME structure, so just insert them
+ ;; immediately.
+ (let* ((handle (mm-get-content-id (substring url (match-end 0))))
+ (image (when (and handle
+ (not inhibit-images))
+ (gnus-create-image
+ (mm-with-part handle (buffer-string))
+ nil t))))
+ (if image
+ (gnus-add-image
+ 'cid
+ (gnus-put-image
+ (gnus-rescale-image
+ image (gnus-html-maximum-image-size))
+ (gnus-string-or (prog1
+ (buffer-substring start end)
+ (delete-region start end))
+ "*")
+ 'cid))
+ (make-text-button start end
+ 'help-echo url
+ 'keymap gnus-html-image-map)))
+ ;; Normal, external URL.
+ (if (or inhibit-images
+ (gnus-html-image-url-blocked-p url blocked-images))
(make-text-button start end
'help-echo url
- 'keymap gnus-html-image-map)))
- ;; Normal, external URL.
- (if (or inhibit-images
- (gnus-html-image-url-blocked-p url blocked-images))
- (make-text-button start end
- 'help-echo url
- 'keymap gnus-html-image-map)
- ;; Non-blocked url
- (let ((width
- (when (string-match "width=\"?\\([0-9]+\\)" parameters)
- (string-to-number (match-string 1 parameters))))
- (height
- (when (string-match "height=\"?\\([0-9]+\\)" parameters)
- (string-to-number (match-string 1 parameters)))))
- ;; Don't fetch images that are really small. They're
- ;; probably tracking pictures.
- (when (and (or (null height)
- (> height 4))
- (or (null width)
- (> width 4)))
- (gnus-html-display-image url start end alt-text)))))))))
-
-(defun gnus-html-display-image (url start end &optional alt-text)
+ 'keymap gnus-html-image-map)
+ ;; Non-blocked url
+ (let ((width
+ (when (string-match "width=\"?\\([0-9]+\\)" parameters)
+ (string-to-number (match-string 1 parameters))))
+ (height
+ (when (string-match "height=\"?\\([0-9]+\\)" parameters)
+ (string-to-number (match-string 1 parameters)))))
+ ;; Don't fetch images that are really small. They're
+ ;; probably tracking pictures.
+ (when (and (or (null height)
+ (> height 4))
+ (or (null width)
+ (> width 4)))
+ (gnus-html-display-image url start end alt-text))))))))))
+
+(defun gnus-html-display-image (url _start _end &optional alt-text)
"Display image at URL on text from START to END.
Use ALT-TEXT for the image string."
(or alt-text (setq alt-text "*"))
@@ -248,7 +248,7 @@ Use ALT-TEXT for the image string."
(gnus-html-put-image (gnus-html-get-image-data url) url alt-text))))
(defun gnus-html-wash-tags ()
- (let (tag parameters string start end images url)
+ (let (tag parameters start end url) ;; string images
(gnus-html-pre-wash)
(gnus-html-wash-images)
@@ -329,10 +329,10 @@ Use ALT-TEXT for the image string."
(replace-match "" t t))
(mm-url-decode-entities)))
-(defun gnus-html-insert-image (&rest args)
+(defun gnus-html-insert-image (&rest _args)
"Fetch and insert the image under point."
(interactive)
- (apply 'gnus-html-display-image (get-text-property (point) 'gnus-image)))
+ (apply #'gnus-html-display-image (get-text-property (point) 'gnus-image)))
(defun gnus-html-show-alt-text ()
"Show the ALT text of the image under point."
diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el
index 9c68773..6492862 100644
--- a/lisp/gnus/gnus-int.el
+++ b/lisp/gnus/gnus-int.el
@@ -1,4 +1,4 @@
-;;; gnus-int.el --- backend interface functions for Gnus
+;;; gnus-int.el --- backend interface functions for Gnus -*- lexical-binding:
t; -*-
;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
@@ -76,23 +76,25 @@ server denied."
"The current method, for the registry.")
-(defun gnus-server-opened (gnus-command-method)
- "Check whether a connection to GNUS-COMMAND-METHOD has been opened."
- (unless (eq (gnus-server-status gnus-command-method)
+(defun gnus-server-opened (command-method)
+ "Check whether a connection to COMMAND-METHOD has been opened."
+ (unless (eq (gnus-server-status command-method)
'denied)
- (when (stringp gnus-command-method)
- (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
- (funcall (inline (gnus-get-function gnus-command-method 'server-opened))
- (nth 1 gnus-command-method))))
-
-(defun gnus-status-message (gnus-command-method)
- "Return the status message from GNUS-COMMAND-METHOD.
-If GNUS-COMMAND-METHOD is a string, it is interpreted as a group
-name. The method this group uses will be queried."
+ (let ((gnus-command-method
+ (if (stringp command-method)
+ (gnus-server-to-method command-method)
+ command-method)))
+ (funcall (inline (gnus-get-function gnus-command-method 'server-opened))
+ (nth 1 gnus-command-method)))))
+
+(defun gnus-status-message (command-method)
+ "Return the status message from COMMAND-METHOD.
+If COMMAND-METHOD is a string, it is interpreted as a group name.
+The method this group uses will be queried."
(let ((gnus-command-method
- (if (stringp gnus-command-method)
- (gnus-find-method-for-group gnus-command-method)
- gnus-command-method)))
+ (if (stringp command-method)
+ (gnus-find-method-for-group command-method)
+ command-method)))
(funcall (gnus-get-function gnus-command-method 'status-message)
(nth 1 gnus-command-method))))
@@ -265,13 +267,14 @@ If it is down, start it up (again)."
type form))
(setq gnus-backend-trace-elapsed (float-time)))))
-(defun gnus-open-server (gnus-command-method)
- "Open a connection to GNUS-COMMAND-METHOD."
- (when (stringp gnus-command-method)
- (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
+(defun gnus-open-server (command-method)
+ "Open a connection to COMMAND-METHOD."
(gnus-backend-trace :opening gnus-command-method)
- (let ((elem (assoc gnus-command-method gnus-opened-servers))
- (server (gnus-method-to-server-name gnus-command-method)))
+ (let* ((gnus-command-method (if (stringp command-method)
+ (gnus-server-to-method command-method)
+ command-method))
+ (elem (assoc gnus-command-method gnus-opened-servers))
+ (server (gnus-method-to-server-name gnus-command-method)))
;; If this method was previously denied, we just return nil.
(if (eq (nth 1 elem) 'denied)
(progn
@@ -347,23 +350,27 @@ If it is down, start it up (again)."
(gnus-backend-trace :opened gnus-command-method)
result)))))
-(defun gnus-close-server (gnus-command-method)
- "Close the connection to GNUS-COMMAND-METHOD."
- (when (stringp gnus-command-method)
- (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
- (prog1
- (funcall (gnus-get-function gnus-command-method 'close-server)
- (nth 1 gnus-command-method)
- (nthcdr 2 gnus-command-method))
- (when-let ((elem (assoc gnus-command-method gnus-opened-servers)))
- (setf (nth 1 elem) 'closed))))
-
-(defun gnus-request-list (gnus-command-method)
- "Request the active file from GNUS-COMMAND-METHOD."
- (when (stringp gnus-command-method)
- (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
- (funcall (gnus-get-function gnus-command-method 'request-list)
- (nth 1 gnus-command-method)))
+(defun gnus-close-server (command-method)
+ "Close the connection to COMMAND-METHOD."
+ (let ((gnus-command-method
+ (if (stringp command-method)
+ (gnus-server-to-method command-method)
+ command-method)))
+ (prog1
+ (funcall (gnus-get-function gnus-command-method 'close-server)
+ (nth 1 gnus-command-method)
+ (nthcdr 2 gnus-command-method))
+ (when-let ((elem (assoc gnus-command-method gnus-opened-servers)))
+ (setf (nth 1 elem) 'closed)))))
+
+(defun gnus-request-list (command-method)
+ "Request the active file from COMMAND-METHOD."
+ (let ((gnus-command-method
+ (if (stringp command-method)
+ (gnus-server-to-method command-method)
+ command-method)))
+ (funcall (gnus-get-function gnus-command-method 'request-list)
+ (nth 1 gnus-command-method))))
(defun gnus-server-get-active (server &optional ignored)
"Return the active list for SERVER.
@@ -407,47 +414,57 @@ Groups matching the IGNORED regexp are excluded."
(forward-line)))))
groups))
-(defun gnus-finish-retrieve-group-infos (gnus-command-method infos data)
- "Read and update infos from GNUS-COMMAND-METHOD."
- (when (stringp gnus-command-method)
- (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
+(defun gnus-finish-retrieve-group-infos (command-method infos data)
+ "Read and update infos from COMMAND-METHOD."
+ (let ((gnus-command-method
+ (if (stringp command-method)
+ (gnus-server-to-method command-method)
+ command-method)))
(gnus-backend-trace :finishing gnus-command-method)
(prog1
(funcall (gnus-get-function gnus-command-method
'finish-retrieve-group-infos)
(nth 1 gnus-command-method)
infos data)
- (gnus-backend-trace :finished gnus-command-method)))
-
-(defun gnus-retrieve-group-data-early (gnus-command-method infos)
- "Start early async retrieval of data from GNUS-COMMAND-METHOD."
- (when (stringp gnus-command-method)
- (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
- (funcall (gnus-get-function gnus-command-method 'retrieve-group-data-early)
- (nth 1 gnus-command-method)
- infos))
-
-(defun gnus-request-list-newsgroups (gnus-command-method)
- "Request the newsgroups file from GNUS-COMMAND-METHOD."
- (when (stringp gnus-command-method)
- (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
- (funcall (gnus-get-function gnus-command-method 'request-list-newsgroups)
- (nth 1 gnus-command-method)))
-
-(defun gnus-request-newgroups (date gnus-command-method)
- "Request all new groups since DATE from GNUS-COMMAND-METHOD."
- (when (stringp gnus-command-method)
- (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
- (let ((func (gnus-get-function gnus-command-method 'request-newgroups t)))
- (when func
- (funcall func date (nth 1 gnus-command-method)))))
-
-(defun gnus-request-regenerate (gnus-command-method)
- "Request a data generation from GNUS-COMMAND-METHOD."
- (when (stringp gnus-command-method)
- (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
- (funcall (gnus-get-function gnus-command-method 'request-regenerate)
- (nth 1 gnus-command-method)))
+ (gnus-backend-trace :finished gnus-command-method))))
+
+(defun gnus-retrieve-group-data-early (command-method infos)
+ "Start early async retrieval of data from COMMAND-METHOD."
+ (let ((gnus-command-method
+ (if (stringp command-method)
+ (gnus-server-to-method command-method)
+ command-method)))
+ (funcall (gnus-get-function gnus-command-method 'retrieve-group-data-early)
+ (nth 1 gnus-command-method)
+ infos)))
+
+(defun gnus-request-list-newsgroups (command-method)
+ "Request the newsgroups file from COMMAND-METHOD."
+ (let ((gnus-command-method
+ (if (stringp command-method)
+ (gnus-server-to-method command-method)
+ command-method)))
+ (funcall (gnus-get-function gnus-command-method 'request-list-newsgroups)
+ (nth 1 gnus-command-method))))
+
+(defun gnus-request-newgroups (date command-method)
+ "Request all new groups since DATE from COMMAND-METHOD."
+ (let ((gnus-command-method
+ (if (stringp command-method)
+ (gnus-server-to-method command-method)
+ command-method)))
+ (let ((func (gnus-get-function gnus-command-method 'request-newgroups t)))
+ (when func
+ (funcall func date (nth 1 gnus-command-method))))))
+
+(defun gnus-request-regenerate (command-method)
+ "Request a data generation from COMMAND-METHOD."
+ (let ((gnus-command-method
+ (if (stringp command-method)
+ (gnus-server-to-method command-method)
+ command-method)))
+ (funcall (gnus-get-function gnus-command-method 'request-regenerate)
+ (nth 1 gnus-command-method))))
(defun gnus-request-compact-group (group)
(let* ((method (gnus-find-method-for-group group))
@@ -459,17 +476,19 @@ Groups matching the IGNORED regexp are excluded."
(nth 1 gnus-command-method) t)))
result))
-(defun gnus-request-compact (gnus-command-method)
- "Request groups compaction from GNUS-COMMAND-METHOD."
- (when (stringp gnus-command-method)
- (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
- (funcall (gnus-get-function gnus-command-method 'request-compact)
- (nth 1 gnus-command-method)))
+(defun gnus-request-compact (command-method)
+ "Request groups compaction from COMMAND-METHOD."
+ (let ((gnus-command-method
+ (if (stringp command-method)
+ (gnus-server-to-method command-method)
+ command-method)))
+ (funcall (gnus-get-function gnus-command-method 'request-compact)
+ (nth 1 gnus-command-method))))
-(defun gnus-request-group (group &optional dont-check gnus-command-method info)
+(defun gnus-request-group (group &optional dont-check command-method info)
"Request GROUP. If DONT-CHECK, no information is required."
(let ((gnus-command-method
- (or gnus-command-method (inline (gnus-find-method-for-group group)))))
+ (or command-method (inline (gnus-find-method-for-group group)))))
(when (stringp gnus-command-method)
(setq gnus-command-method
(inline (gnus-server-to-method gnus-command-method))))
@@ -522,12 +541,14 @@ If FETCH-OLD, retrieve all headers (or some subset
thereof) in the group."
articles (gnus-group-real-name group)
(nth 1 gnus-command-method))))
-(defun gnus-retrieve-groups (groups gnus-command-method)
- "Request active information on GROUPS from GNUS-COMMAND-METHOD."
- (when (stringp gnus-command-method)
- (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
- (funcall (gnus-get-function gnus-command-method 'retrieve-groups)
- groups (nth 1 gnus-command-method)))
+(defun gnus-retrieve-groups (groups command-method)
+ "Request active information on GROUPS from COMMAND-METHOD."
+ (let ((gnus-command-method
+ (if (stringp command-method)
+ (gnus-server-to-method command-method)
+ command-method)))
+ (funcall (gnus-get-function gnus-command-method 'retrieve-groups)
+ groups (nth 1 gnus-command-method))))
(defun gnus-request-type (group &optional article)
"Return the type (`post' or `mail') of GROUP (and ARTICLE)."
@@ -628,7 +649,7 @@ the group's summary.
article-number)
;; Clean up the new summary and propagate the error
(error (when group-is-new (gnus-summary-exit))
- (apply 'signal err)))))
+ (apply #'signal err)))))
(defun gnus-simplify-group-name (group)
"Return the simplest representation of the name of GROUP.
@@ -715,26 +736,33 @@ from other groups -- for instance, search results and the
like."
(delete-region (point-min) (1- (point))))))
res))
-(defun gnus-request-post (gnus-command-method)
- "Post the current buffer using GNUS-COMMAND-METHOD."
- (when (stringp gnus-command-method)
- (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
- (funcall (gnus-get-function gnus-command-method 'request-post)
- (nth 1 gnus-command-method)))
+(defun gnus-request-post (command-method)
+ "Post the current buffer using COMMAND-METHOD."
+ (let ((gnus-command-method
+ (if (stringp command-method)
+ (gnus-server-to-method command-method)
+ command-method)))
+ (funcall (gnus-get-function gnus-command-method 'request-post)
+ (nth 1 gnus-command-method))))
-(defun gnus-request-expunge-group (group gnus-command-method)
+(defun gnus-request-expunge-group (group command-method)
"Expunge GROUP, which is removing articles that have been marked as deleted."
- (when (stringp gnus-command-method)
- (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
- (funcall (gnus-get-function gnus-command-method 'request-expunge-group)
- (gnus-group-real-name group)
- (nth 1 gnus-command-method)))
-
-(defun gnus-request-scan (group gnus-command-method)
- "Request a SCAN being performed in GROUP from GNUS-COMMAND-METHOD.
-If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
(let ((gnus-command-method
- (if group (gnus-find-method-for-group group) gnus-command-method))
+ (if (stringp command-method)
+ (gnus-server-to-method command-method)
+ command-method)))
+ (funcall (gnus-get-function gnus-command-method 'request-expunge-group)
+ (gnus-group-real-name group)
+ (nth 1 gnus-command-method))))
+
+(defvar mail-source-plugged)
+(defvar gnus-inhibit-demon)
+
+(defun gnus-request-scan (group command-method)
+ "Request a SCAN being performed in GROUP from COMMAND-METHOD.
+If GROUP is nil, all groups on COMMAND-METHOD are scanned."
+ (let ((gnus-command-method
+ (if group (gnus-find-method-for-group group) command-method))
(gnus-inhibit-demon t)
(mail-source-plugged gnus-plugged))
(when (or gnus-plugged
@@ -744,36 +772,40 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are
scanned."
(and group (gnus-group-real-name group))
(nth 1 gnus-command-method)))))
-(defun gnus-request-update-info (info gnus-command-method)
+(defun gnus-request-update-info (info command-method)
(when (gnus-check-backend-function
- 'request-update-info (car gnus-command-method))
- (when (stringp gnus-command-method)
- (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
- (funcall (gnus-get-function gnus-command-method 'request-update-info)
- (gnus-group-real-name (gnus-info-group info)) info
- (nth 1 gnus-command-method))))
-
-(defsubst gnus-request-marks (info gnus-command-method)
- "Request that GNUS-COMMAND-METHOD update INFO."
- (when (stringp gnus-command-method)
- (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
- (when (gnus-check-backend-function
- 'request-marks (car gnus-command-method))
- (let ((group (gnus-info-group info)))
- (and (funcall (gnus-get-function gnus-command-method 'request-marks)
- (gnus-group-real-name group)
- info (nth 1 gnus-command-method))
- ;; If the minimum article number is greater than 1, then all
- ;; smaller article numbers are known not to exist; we'll
- ;; artificially add those to the 'read range.
- (let* ((active (gnus-active group))
- (min (car active)))
- (when (> min 1)
- (let* ((range (if (= min 2) 1 (cons 1 (1- min))))
- (read (gnus-info-read info))
- (new-read (gnus-range-add read (list range))))
- (setf (gnus-info-read info) new-read)))
- info)))))
+ 'request-update-info (car command-method))
+ (let ((gnus-command-method
+ (if (stringp command-method)
+ (gnus-server-to-method command-method)
+ command-method)))
+ (funcall (gnus-get-function gnus-command-method 'request-update-info)
+ (gnus-group-real-name (gnus-info-group info)) info
+ (nth 1 gnus-command-method)))))
+
+(defsubst gnus-request-marks (info command-method)
+ "Request that COMMAND-METHOD update INFO."
+ (let ((gnus-command-method
+ (if (stringp command-method)
+ (gnus-server-to-method command-method)
+ command-method)))
+ (when (gnus-check-backend-function
+ 'request-marks (car gnus-command-method))
+ (let ((group (gnus-info-group info)))
+ (and (funcall (gnus-get-function gnus-command-method 'request-marks)
+ (gnus-group-real-name group)
+ info (nth 1 gnus-command-method))
+ ;; If the minimum article number is greater than 1, then all
+ ;; smaller article numbers are known not to exist; we'll
+ ;; artificially add those to the 'read range.
+ (let* ((active (gnus-active group))
+ (min (car active)))
+ (when (> min 1)
+ (let* ((range (if (= min 2) 1 (cons 1 (1- min))))
+ (read (gnus-info-read info))
+ (new-read (gnus-range-add read (list range))))
+ (setf (gnus-info-read info) new-read)))
+ info))))))
(defun gnus-request-expire-articles (articles group &optional force)
(let* ((gnus-command-method (gnus-find-method-for-group group))
@@ -794,7 +826,7 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are
scanned."
(gnus-agent-expire expired-articles group 'force))))
not-deleted))
-(defun gnus-request-move-article (article group server accept-function
+(defun gnus-request-move-article (article group _server accept-function
&optional last move-is-internal)
(let* ((gnus-command-method (gnus-find-method-for-group group))
(result (funcall (gnus-get-function gnus-command-method
@@ -807,38 +839,40 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are
scanned."
(gnus-agent-unfetch-articles group (list article)))
result))
-(defun gnus-request-accept-article (group &optional gnus-command-method last
+(defun gnus-request-accept-article (group &optional command-method last
no-encode)
- (when (stringp gnus-command-method)
- (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
- (when (and (not gnus-command-method)
- (stringp group))
- (setq gnus-command-method (or (gnus-find-method-for-group group)
- (gnus-group-name-to-method group))))
- (goto-char (point-max))
- ;; Make sure there's a newline at the end of the article.
- (unless (bolp)
- (insert "\n"))
- (unless no-encode
- (let ((message-options message-options))
- (message-options-set-recipient)
- (save-restriction
- (message-narrow-to-head)
- (mail-encode-encoded-word-buffer))
- (message-encode-message-body)))
- (let ((gnus-command-method (or gnus-command-method
- (gnus-find-method-for-group group)))
- (result
- (funcall
- (gnus-get-function gnus-command-method 'request-accept-article)
- (if (stringp group) (gnus-group-real-name group) group)
- (cadr gnus-command-method)
- last)))
- (when (and gnus-agent
- (gnus-agent-method-p gnus-command-method)
- (cdr result))
- (gnus-agent-regenerate-group group (list (cdr result))))
- result))
+ (let ((gnus-command-method
+ (if (stringp command-method)
+ (gnus-server-to-method command-method)
+ command-method)))
+ (when (and (not gnus-command-method)
+ (stringp group))
+ (setq gnus-command-method (or (gnus-find-method-for-group group)
+ (gnus-group-name-to-method group))))
+ (goto-char (point-max))
+ ;; Make sure there's a newline at the end of the article.
+ (unless (bolp)
+ (insert "\n"))
+ (unless no-encode
+ (let ((message-options message-options))
+ (message-options-set-recipient)
+ (save-restriction
+ (message-narrow-to-head)
+ (mail-encode-encoded-word-buffer))
+ (message-encode-message-body)))
+ (let ((gnus-command-method (or gnus-command-method
+ (gnus-find-method-for-group group)))
+ (result
+ (funcall
+ (gnus-get-function gnus-command-method 'request-accept-article)
+ (if (stringp group) (gnus-group-real-name group) group)
+ (cadr gnus-command-method)
+ last)))
+ (when (and gnus-agent
+ (gnus-agent-method-p gnus-command-method)
+ (cdr result))
+ (gnus-agent-regenerate-group group (list (cdr result))))
+ result)))
(defun gnus-request-replace-article (article group buffer &optional no-encode)
(unless no-encode
@@ -862,13 +896,14 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are
scanned."
article (gnus-group-real-name group)
(nth 1 gnus-command-method))))
-(defun gnus-request-create-group (group &optional gnus-command-method args)
- (when (stringp gnus-command-method)
- (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
- (let ((gnus-command-method
- (or gnus-command-method (gnus-find-method-for-group group))))
+(defun gnus-request-create-group (group &optional command-method args)
+ (let* ((gnus-command-method
+ (or (if (stringp command-method)
+ (gnus-server-to-method command-method)
+ command-method)
+ (gnus-find-method-for-group group))))
(funcall (gnus-get-function gnus-command-method 'request-create-group)
- (gnus-group-real-name group) (nth 1 gnus-command-method) args)))
+ (gnus-group-real-name group) (nth 1 gnus-command-method) args)))
(defun gnus-request-delete-group (group &optional force)
(let* ((gnus-command-method (gnus-find-method-for-group group))
@@ -902,15 +937,18 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are
scanned."
"-request-close"))))
(funcall func)))))
-(defun gnus-asynchronous-p (gnus-command-method)
- (let ((func (gnus-get-function gnus-command-method 'asynchronous-p t)))
+(defun gnus-asynchronous-p (command-method)
+ (let ((func (gnus-get-function command-method 'asynchronous-p t)))
(when (fboundp func)
- (funcall func))))
-
-(defun gnus-remove-denial (gnus-command-method)
- (when (stringp gnus-command-method)
- (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
- (let* ((elem (assoc gnus-command-method gnus-opened-servers))
+ (let ((gnus-command-method command-method))
+ (funcall func)))))
+
+(defun gnus-remove-denial (command-method)
+ (let* ((gnus-command-method
+ (if (stringp command-method)
+ (gnus-server-to-method command-method)
+ command-method))
+ (elem (assoc gnus-command-method gnus-opened-servers))
(status (cadr elem)))
;; If this hasn't been opened before, we add it to the list.
(when (eq status 'denied)
diff --git a/lisp/gnus/gnus-kill.el b/lisp/gnus/gnus-kill.el
index 7e59202..b0e6cb5 100644
--- a/lisp/gnus/gnus-kill.el
+++ b/lisp/gnus/gnus-kill.el
@@ -1,4 +1,4 @@
-;;; gnus-kill.el --- kill commands for Gnus
+;;; gnus-kill.el --- kill commands for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
@@ -275,7 +275,7 @@ If NEWSGROUP is nil, the global kill file is selected."
(save-excursion
(save-window-excursion
(pop-to-buffer gnus-summary-buffer)
- (eval (car (read-from-string string)))))))
+ (eval (car (read-from-string string)) t)))))
(defun gnus-kill-file-apply-last-sexp ()
"Apply sexp before point in current buffer to current newsgroup."
@@ -289,7 +289,7 @@ If NEWSGROUP is nil, the global kill file is selected."
(save-excursion
(save-window-excursion
(pop-to-buffer gnus-summary-buffer)
- (eval (car (read-from-string string))))))
+ (eval (car (read-from-string string)) t))))
(ding) (gnus-message 2 "No newsgroup is selected.")))
(defun gnus-kill-file-exit ()
@@ -403,9 +403,9 @@ Returns the number of articles marked as read."
(eq (car form) 'gnus-lower))
(progn
(delete-region beg (point))
- (insert (or (eval form) "")))
+ (insert (or (eval form t) "")))
(with-current-buffer gnus-summary-buffer
- (ignore-errors (eval form)))))
+ (ignore-errors (eval form t)))))
(and (buffer-modified-p)
gnus-kill-save-kill-file
(save-buffer))
@@ -560,7 +560,7 @@ COMMAND must be a Lisp expression or a string representing
a key sequence."
((functionp form)
(funcall form))
(t
- (eval form)))))
+ (eval form t)))))
;; Search article body.
(let ((gnus-current-article nil) ;Save article pointer.
(gnus-last-article nil)
@@ -578,7 +578,7 @@ COMMAND must be a Lisp expression or a string representing
a key sequence."
((functionp form)
(funcall form))
(t
- (eval form)))))))
+ (eval form t)))))))
did-kill)))
(defun gnus-execute (field regexp form &optional backward unread)
@@ -606,12 +606,10 @@ marked as read or ticked are ignored."
(downcase (symbol-name header)))
gnus-extra-headers)))
(setq function
- `(lambda (h)
- (gnus-extra-header
- (quote ,(nth (- (length gnus-extra-headers)
- (length extras))
- gnus-extra-headers))
- h)))))))
+ (let ((type (nth (- (length gnus-extra-headers)
+ (length extras))
+ gnus-extra-headers)))
+ (lambda (h) (gnus-extra-header type h))))))))
;; Signal error.
(t
(error "Unknown header field: \"%s\"" field)))
@@ -641,7 +639,7 @@ Usage: emacs -batch -l ~/.emacs -l gnus -f gnus-batch-score"
(let* ((gnus-newsrc-options-n
(gnus-newsrc-parse-options
(concat "options -n "
- (mapconcat 'identity command-line-args-left " "))))
+ (mapconcat #'identity command-line-args-left " "))))
(gnus-expert-user t)
(mail-sources nil)
(gnus-use-dribble-file nil)
diff --git a/lisp/gnus/gnus-logic.el b/lisp/gnus/gnus-logic.el
index 105222d..cdfdc9b 100644
--- a/lisp/gnus/gnus-logic.el
+++ b/lisp/gnus/gnus-logic.el
@@ -1,4 +1,4 @@
-;;; gnus-logic.el --- advanced scoring code for Gnus
+;;; gnus-logic.el --- advanced scoring code for Gnus -*- lexical-binding: t;
-*-
;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
diff --git a/lisp/gnus/gnus-mh.el b/lisp/gnus/gnus-mh.el
index b26b736..fc8d9be 100644
--- a/lisp/gnus/gnus-mh.el
+++ b/lisp/gnus/gnus-mh.el
@@ -1,4 +1,4 @@
-;;; gnus-mh.el --- mh-e interface for Gnus
+;;; gnus-mh.el --- mh-e interface for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1994-2021 Free Software Foundation, Inc.
@@ -95,7 +95,7 @@ Optional argument FOLDER specifies folder name."
(kill-buffer errbuf))))
(setq gnus-newsgroup-last-folder folder)))
-(defun gnus-Folder-save-name (newsgroup headers &optional last-folder)
+(defun gnus-Folder-save-name (newsgroup _headers &optional last-folder)
"Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER.
If variable `gnus-use-long-file-name' is nil, it is +News.group.
Otherwise, it is like +news/group."
@@ -105,7 +105,7 @@ Otherwise, it is like +news/group."
(gnus-capitalize-newsgroup newsgroup)
(gnus-newsgroup-directory-form newsgroup)))))
-(defun gnus-folder-save-name (newsgroup headers &optional last-folder)
+(defun gnus-folder-save-name (newsgroup _headers &optional last-folder)
"Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER.
If variable `gnus-use-long-file-name' is nil, it is +news.group.
Otherwise, it is like +news/group."
diff --git a/lisp/gnus/gnus-ml.el b/lisp/gnus/gnus-ml.el
index a47c155..3b2b5a0 100644
--- a/lisp/gnus/gnus-ml.el
+++ b/lisp/gnus/gnus-ml.el
@@ -1,4 +1,4 @@
-;;; gnus-ml.el --- Mailing list minor mode for Gnus
+;;; gnus-ml.el --- Mailing list minor mode for Gnus -*- lexical-binding: t;
-*-
;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
diff --git a/lisp/gnus/gnus-mlspl.el b/lisp/gnus/gnus-mlspl.el
index ed8d15a..d42f097 100644
--- a/lisp/gnus/gnus-mlspl.el
+++ b/lisp/gnus/gnus-mlspl.el
@@ -1,4 +1,4 @@
-;;; gnus-mlspl.el --- a group params-based mail splitting mechanism
+;;; gnus-mlspl.el --- a group params-based mail splitting mechanism -*-
lexical-binding: t; -*-
;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
@@ -196,13 +196,13 @@ Calling (gnus-group-split-fancy nil nil \"mail.others\")
returns:
(concat
"\\("
(mapconcat
- 'identity
+ #'identity
(append
(and to-address (list (regexp-quote to-address)))
(and to-list (list (regexp-quote to-list)))
(and extra-aliases
(if (listp extra-aliases)
- (mapcar 'regexp-quote extra-aliases)
+ (mapcar #'regexp-quote extra-aliases)
(list extra-aliases)))
(and split-regexp (list split-regexp)))
"\\|")
diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index 419b5ea..45e665b 100644
--- a/lisp/gnus/gnus-msg.el
+++ b/lisp/gnus/gnus-msg.el
@@ -1,4 +1,4 @@
-;;; gnus-msg.el --- mail and post interface for Gnus
+;;; gnus-msg.el --- mail and post interface for Gnus -*- lexical-binding: t;
-*-
;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
@@ -389,9 +389,10 @@ only affect the Gcc copy, but not the original message."
;;; Internal functions.
(defun gnus-inews-make-draft (articles)
- `(lambda ()
- (gnus-inews-make-draft-meta-information
- ,gnus-newsgroup-name ',articles)))
+ (let ((gn gnus-newsgroup-name))
+ (lambda ()
+ (gnus-inews-make-draft-meta-information
+ gn articles))))
(autoload 'nnselect-article-number "nnselect" nil nil 'macro)
(autoload 'nnselect-article-group "nnselect" nil nil 'macro)
@@ -399,6 +400,7 @@ only affect the Gcc copy, but not the original message."
(defvar gnus-article-reply nil)
(defmacro gnus-setup-message (config &rest forms)
+ (declare (indent 1) (debug t))
(let ((winconf (make-symbol "gnus-setup-message-winconf"))
(winconf-name (make-symbol "gnus-setup-message-winconf-name"))
(buffer (make-symbol "gnus-setup-message-buffer"))
@@ -473,8 +475,8 @@ only affect the Gcc copy, but not the original message."
(let ((mbl1 mml-buffer-list))
(setq mml-buffer-list mbl) ;; Global value
(setq-local mml-buffer-list mbl1) ;; Local value
- (add-hook 'change-major-mode-hook 'mml-destroy-buffers nil t)
- (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))
+ (add-hook 'change-major-mode-hook #'mml-destroy-buffers nil t)
+ (add-hook 'kill-buffer-hook #'mml-destroy-buffers t t))
(mml-destroy-buffers)
(setq mml-buffer-list mbl)))
(message-hide-headers)
@@ -516,14 +518,13 @@ instead."
switch-action yank-action send-actions return-action))
(let ((buf (current-buffer))
;; Don't use posting styles corresponding to any existing group.
- (group-name gnus-newsgroup-name)
+ ;; (group-name gnus-newsgroup-name)
mail-buf)
- (unwind-protect
- (progn
- (let ((gnus-newsgroup-name ""))
- (gnus-setup-message 'message
- (message-mail to subject other-headers continue
- nil yank-action send-actions return-action)))))
+ (let ((gnus-newsgroup-name ""))
+ (gnus-setup-message
+ 'message
+ (message-mail to subject other-headers continue
+ nil yank-action send-actions return-action)))
(when switch-action
(setq mail-buf (current-buffer))
(switch-to-buffer buf)
@@ -565,16 +566,21 @@ instead."
(symbol-value (car elem))))
(throw 'found (cons (cadr elem) (caddr elem)))))))))
+(declare-function gnus-agent-possibly-do-gcc "gnus-agent" ())
+(declare-function gnus-cache-possibly-remove-article "gnus-cache"
+ (article ticked dormant unread &optional force))
+
(defun gnus-inews-add-send-actions (winconf buffer article
&optional config yanked
winconf-name)
- (add-hook 'message-sent-hook (if gnus-agent 'gnus-agent-possibly-do-gcc
- 'gnus-inews-do-gcc) nil t)
+ (add-hook 'message-sent-hook (if gnus-agent #'gnus-agent-possibly-do-gcc
+ #'gnus-inews-do-gcc)
+ nil t)
(when gnus-agent
- (add-hook 'message-header-hook 'gnus-agent-possibly-save-gcc nil t))
+ (add-hook 'message-header-hook #'gnus-agent-possibly-save-gcc nil t))
(setq message-post-method
- `(lambda (&optional arg)
- (gnus-post-method arg ,gnus-newsgroup-name)))
+ (let ((gn gnus-newsgroup-name))
+ (lambda (&optional arg) (gnus-post-method arg gn))))
(message-add-action
`(progn
(setq gnus-current-window-configuration ',winconf-name)
@@ -596,9 +602,6 @@ instead."
`(gnus-summary-mark-article-as-replied ',to-be-marked)))))
'send)))
-(put 'gnus-setup-message 'lisp-indent-function 1)
-(put 'gnus-setup-message 'edebug-form-spec '(form body))
-
;;; Post news commands of Gnus group mode and summary mode
(defun gnus-group-mail (&optional arg)
@@ -608,21 +611,19 @@ 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)
- (buffer (current-buffer)))
- (unwind-protect
- (progn
- (let ((gnus-newsgroup-name
- (if arg
- (if (= 1 (prefix-numeric-value arg))
- (gnus-group-completing-read
- "Use posting style of group"
- nil (gnus-read-active-file-p))
- (gnus-group-group-name))
- "")))
- (gnus-setup-message 'message (message-mail)))))))
+ (let* (;;(group gnus-newsgroup-name)
+ ;; make sure last viewed article doesn't affect posting styles:
+ (gnus-article-copy)
+ ;; (buffer (current-buffer))
+ (gnus-newsgroup-name
+ (if arg
+ (if (= 1 (prefix-numeric-value arg))
+ (gnus-group-completing-read
+ "Use posting style of group"
+ nil (gnus-read-active-file-p))
+ (gnus-group-group-name))
+ "")))
+ (gnus-setup-message 'message (message-mail))))
(defun gnus-group-news (&optional arg)
"Start composing a news.
@@ -635,22 +636,21 @@ 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)
- (buffer (current-buffer)))
- (unwind-protect
- (progn
- (let ((gnus-newsgroup-name
- (if arg
- (if (= 1 (prefix-numeric-value arg))
- (gnus-group-completing-read "Use group"
- nil
- (gnus-read-active-file-p))
- (gnus-group-group-name))
- "")))
- (gnus-setup-message 'message
- (message-news (gnus-group-real-name gnus-newsgroup-name))))))))
+ (let* (;;(group gnus-newsgroup-name)
+ ;; make sure last viewed article doesn't affect posting styles:
+ (gnus-article-copy)
+ ;; (buffer (current-buffer))
+ (gnus-newsgroup-name
+ (if arg
+ (if (= 1 (prefix-numeric-value arg))
+ (gnus-group-completing-read "Use group"
+ nil
+ (gnus-read-active-file-p))
+ (gnus-group-group-name))
+ "")))
+ (gnus-setup-message
+ 'message
+ (message-news (gnus-group-real-name gnus-newsgroup-name)))))
(defun gnus-group-post-news (&optional arg)
"Start composing a message (a news by default).
@@ -679,21 +679,19 @@ 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)
- (buffer (current-buffer)))
- (unwind-protect
- (progn
- (let ((gnus-newsgroup-name
- (if arg
- (if (= 1 (prefix-numeric-value arg))
- (gnus-group-completing-read "Use group"
- nil
- (gnus-read-active-file-p))
- "")
- gnus-newsgroup-name)))
- (gnus-setup-message 'message (message-mail)))))))
+ (let* (;;(group gnus-newsgroup-name)
+ ;; make sure last viewed article doesn't affect posting styles:
+ (gnus-article-copy)
+ ;; (buffer (current-buffer))
+ (gnus-newsgroup-name
+ (if arg
+ (if (= 1 (prefix-numeric-value arg))
+ (gnus-group-completing-read "Use group"
+ nil
+ (gnus-read-active-file-p))
+ "")
+ gnus-newsgroup-name)))
+ (gnus-setup-message 'message (message-mail))))
(defun gnus-summary-news-other-window (&optional arg)
"Start composing a news in another window.
@@ -706,27 +704,26 @@ 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)
- (buffer (current-buffer)))
- (unwind-protect
- (progn
- (let ((gnus-newsgroup-name
- (if arg
- (if (= 1 (prefix-numeric-value arg))
- (gnus-group-completing-read "Use group"
- nil
- (gnus-read-active-file-p))
- "")
- gnus-newsgroup-name)))
- (gnus-setup-message 'message
- (progn
- (message-news (gnus-group-real-name gnus-newsgroup-name))
- (setq-local gnus-discouraged-post-methods
- (remove
- (car (gnus-find-method-for-group
gnus-newsgroup-name))
- gnus-discouraged-post-methods)))))))))
+ (let* (;;(group gnus-newsgroup-name)
+ ;; make sure last viewed article doesn't affect posting styles:
+ (gnus-article-copy)
+ ;; (buffer (current-buffer))
+ (gnus-newsgroup-name
+ (if arg
+ (if (= 1 (prefix-numeric-value arg))
+ (gnus-group-completing-read "Use group"
+ nil
+ (gnus-read-active-file-p))
+ "")
+ gnus-newsgroup-name)))
+ (gnus-setup-message
+ 'message
+ (progn
+ (message-news (gnus-group-real-name gnus-newsgroup-name))
+ (setq-local gnus-discouraged-post-methods
+ (remove
+ (car (gnus-find-method-for-group gnus-newsgroup-name))
+ gnus-discouraged-post-methods))))))
(defun gnus-summary-post-news (&optional arg)
"Start composing a message. Post to the current group by default.
@@ -824,8 +821,8 @@ prefix `a', cancel using the standard posting method; if not
post using the current select method."
(interactive (gnus-interactive "P\ny"))
(let ((message-post-method
- `(lambda (arg)
- (gnus-post-method (eq ',symp 'a) ,gnus-newsgroup-name)))
+ (let ((gn gnus-newsgroup-name))
+ (lambda (_arg) (gnus-post-method (eq symp 'a) gn))))
(custom-address user-mail-address))
(dolist (article (gnus-summary-work-articles n))
(when (gnus-summary-select-article t nil nil article)
@@ -860,11 +857,12 @@ header line with the old Message-ID."
(set-buffer gnus-original-article-buffer)
(message-supersede)
(push
- `((lambda ()
- (when (gnus-buffer-live-p ,gnus-summary-buffer)
- (with-current-buffer ,gnus-summary-buffer
- (gnus-cache-possibly-remove-article ,article nil nil nil t)
- (gnus-summary-mark-as-read ,article gnus-canceled-mark)))))
+ (let ((buf gnus-summary-buffer))
+ (lambda ()
+ (when (gnus-buffer-live-p buf)
+ (with-current-buffer buf
+ (gnus-cache-possibly-remove-article article nil nil nil t)
+ (gnus-summary-mark-as-read article gnus-canceled-mark)))))
message-send-actions)
;; Add Gcc header.
(gnus-inews-insert-gcc))))
@@ -934,7 +932,7 @@ header line with the old Message-ID."
(run-hooks 'gnus-article-decode-hook)))))
gnus-article-copy)))
-(defun gnus-post-news (post &optional group header article-buffer yank subject
+(defun gnus-post-news (post &optional group header article-buffer yank _subject
force-news)
(when article-buffer
(gnus-copy-article-buffer))
@@ -1040,8 +1038,8 @@ If SILENT, don't prompt the user."
gnus-post-method
(list gnus-post-method)))
gnus-secondary-select-methods
- (mapcar 'cdr gnus-server-alist)
- (mapcar 'car gnus-opened-servers)
+ (mapcar #'cdr gnus-server-alist)
+ (mapcar #'car gnus-opened-servers)
(list gnus-select-method)
(list group-method)))
method-alist post-methods method)
@@ -1069,7 +1067,7 @@ If SILENT, don't prompt the user."
;; Just use the last value.
gnus-last-posting-server
(gnus-completing-read
- "Posting method" (mapcar 'car method-alist) t
+ "Posting method" (mapcar #'car method-alist) t
(cons (or gnus-last-posting-server "") 0))))
method-alist))))
;; Override normal method.
@@ -1343,13 +1341,13 @@ For the \"inline\" alternatives, also see the variable
self))
"\n"))
((null self)
- (insert "Gcc: " (mapconcat 'identity gcc ", ") "\n"))
+ (insert "Gcc: " (mapconcat #'identity gcc ", ") "\n"))
((eq self 'no-gcc-self)
(when (setq gcc (delete
gnus-newsgroup-name
(delete (concat "\"" gnus-newsgroup-name "\"")
gcc)))
- (insert "Gcc: " (mapconcat 'identity gcc ", ") "\n")))))))
+ (insert "Gcc: " (mapconcat #'identity gcc ", ") "\n")))))))
(defun gnus-summary-resend-message (address n &optional no-select)
"Resend the current article to ADDRESS.
@@ -1389,13 +1387,14 @@ the message before resending."
(setq user-mail-address tem))))
;; `gnus-summary-resend-message-insert-gcc' must run last.
(add-hook 'message-header-setup-hook
- 'gnus-summary-resend-message-insert-gcc t)
+ #'gnus-summary-resend-message-insert-gcc t)
(add-hook 'message-sent-hook
- `(lambda ()
- (let ((rfc2047-encode-encoded-words nil))
- ,(if gnus-agent
- '(gnus-agent-possibly-do-gcc)
- '(gnus-inews-do-gcc)))))
+ (let ((agent gnus-agent))
+ (lambda ()
+ (let ((rfc2047-encode-encoded-words nil))
+ (if agent
+ (gnus-agent-possibly-do-gcc)
+ (gnus-inews-do-gcc))))))
(dolist (article (gnus-summary-work-articles n))
(if no-select
(with-current-buffer " *nntpd*"
@@ -1736,7 +1735,7 @@ this is a reply."
;; Function.
(funcall (car var) group))
(t
- (eval (car var)))))))
+ (eval (car var) t))))))
(setq var (cdr var)))
result)))
name)
@@ -1793,7 +1792,7 @@ this is a reply."
(with-current-buffer gnus-summary-buffer
gnus-posting-styles)
gnus-posting-styles))
- style match attribute value v results matched-string
+ match value v results matched-string ;; style attribute
filep name address element)
;; If the group has a posting-style parameter, add it at the end with a
;; regexp matching everything, to be sure it takes precedence over all
@@ -1848,7 +1847,7 @@ this is a reply."
(setq matched-string header)))))))
(t
;; This is a form to be evalled.
- (eval match)))))
+ (eval match t)))))
;; We have a match, so we set the variables.
(dolist (attribute style)
(setq element (pop attribute)
@@ -1879,7 +1878,7 @@ this is a reply."
((boundp value)
(symbol-value value))))
((listp value)
- (eval value))))
+ (eval value t))))
;; Translate obsolescent value.
(cond
((eq element 'signature-file)
@@ -1918,49 +1917,51 @@ this is a reply."
(add-hook 'message-setup-hook
(cond
((eq 'eval (car result))
- 'ignore)
+ #'ignore)
((eq 'body (car result))
- `(lambda ()
- (save-excursion
- (message-goto-body)
- (insert ,(cdr result)))))
+ (let ((txt (cdr result)))
+ (lambda ()
+ (save-excursion
+ (message-goto-body)
+ (insert txt)))))
((eq 'signature (car result))
(setq-local message-signature nil)
(setq-local message-signature-file nil)
- (if (not (cdr result))
- 'ignore
- `(lambda ()
- (save-excursion
- (let ((message-signature ,(cdr result)))
- (when message-signature
- (message-insert-signature)))))))
+ (let ((txt (cdr result)))
+ (if (not txt)
+ #'ignore
+ (lambda ()
+ (save-excursion
+ (let ((message-signature txt))
+ (when message-signature
+ (message-insert-signature))))))))
(t
(let ((header
(if (symbolp (car result))
(capitalize (symbol-name (car result)))
- (car result))))
- `(lambda ()
- (save-excursion
- (message-remove-header ,header)
- (let ((value ,(cdr result)))
- (when value
- (message-goto-eoh)
- (insert ,header ": " value)
- (unless (bolp)
- (insert "\n")))))))))
+ (car result)))
+ (value (cdr result)))
+ (lambda ()
+ (save-excursion
+ (message-remove-header header)
+ (when value
+ (message-goto-eoh)
+ (insert header ": " value)
+ (unless (bolp)
+ (insert "\n"))))))))
nil 'local))
(when (or name address)
(add-hook 'message-setup-hook
- `(lambda ()
- (setq-local user-mail-address
- ,(or (cdr address) user-mail-address))
- (let ((user-full-name ,(or (cdr name) (user-full-name)))
- (user-mail-address
- ,(or (cdr address) user-mail-address)))
- (save-excursion
- (message-remove-header "From")
- (message-goto-eoh)
- (insert "From: " (message-make-from) "\n"))))
+ (let ((name (or (cdr name) (user-full-name)))
+ (email (or (cdr address) user-mail-address)))
+ (lambda ()
+ (setq-local user-mail-address email)
+ (let ((user-full-name name)
+ (user-mail-address email))
+ (save-excursion
+ (message-remove-header "From")
+ (message-goto-eoh)
+ (insert "From: " (message-make-from) "\n")))))
nil 'local)))))
(defun gnus-summary-attach-article (n)
diff --git a/lisp/gnus/gnus-notifications.el b/lisp/gnus/gnus-notifications.el
index e772dd8..a4d198b 100644
--- a/lisp/gnus/gnus-notifications.el
+++ b/lisp/gnus/gnus-notifications.el
@@ -1,4 +1,4 @@
-;; gnus-notifications.el -- Send notification on new message in Gnus
+;; gnus-notifications.el -- Send notification on new message in Gnus -*-
lexical-binding: t; -*-
;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
@@ -24,7 +24,7 @@
;; This implements notifications using `notifications-notify' on new
;; messages received.
-;; Use (add-hook 'gnus-after-getting-new-news-hook 'gnus-notifications)
+;; Use (add-hook 'gnus-after-getting-new-news-hook #'gnus-notifications)
;; to get notifications just after getting the new news.
;;; Code:
@@ -47,26 +47,22 @@
(defcustom gnus-notifications-use-google-contacts t
"Use Google Contacts to retrieve photo."
- :type 'boolean
- :group 'gnus-notifications)
+ :type 'boolean)
(defcustom gnus-notifications-use-gravatar t
"Use Gravatar to retrieve photo."
- :type 'boolean
- :group 'gnus-notifications)
+ :type 'boolean)
(defcustom gnus-notifications-minimum-level 1
"Minimum group level the message should have to be notified.
Any message in a group that has a greater value than this will
not get notifications."
- :type 'integer
- :group 'gnus-notifications)
+ :type 'integer)
(defcustom gnus-notifications-timeout nil
"Timeout used for notifications sent via `notifications-notify'."
:type '(choice (const :tag "Server default" nil)
- (integer :tag "Milliseconds"))
- :group 'gnus-notifications)
+ (integer :tag "Milliseconds")))
(defvar gnus-notifications-sent nil
"Notifications already sent.")
diff --git a/lisp/gnus/gnus-picon.el b/lisp/gnus/gnus-picon.el
index 92def9a..7927b88 100644
--- a/lisp/gnus/gnus-picon.el
+++ b/lisp/gnus/gnus-picon.el
@@ -1,4 +1,4 @@
-;;; gnus-picon.el --- displaying pretty icons in Gnus
+;;; gnus-picon.el --- displaying pretty icons in Gnus -*- lexical-binding: t;
-*-
;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
@@ -112,7 +112,7 @@ List of pairs (KEY . GLYPH) where KEY is either a filename
or an URL.")
(let* ((address (gnus-picon-split-address address))
(user (pop address))
(faddress address)
- database directory result instance base)
+ result base) ;; database directory instance
(catch 'found
(dolist (database gnus-picon-databases)
(dolist (directory directories)
@@ -120,7 +120,7 @@ List of pairs (KEY . GLYPH) where KEY is either a filename
or an URL.")
base (expand-file-name directory database))
(while address
(when (setq result (gnus-picon-find-image
- (concat base "/" (mapconcat 'downcase
+ (concat base "/" (mapconcat #'downcase
(reverse address)
"/")
"/" (downcase user) "/")))
@@ -158,7 +158,7 @@ replacement is added."
(defun gnus-picon-create-glyph (file)
(or (cdr (assoc file gnus-picon-glyph-alist))
- (cdar (push (cons file (apply 'gnus-create-image
+ (cdar (push (cons file (apply #'gnus-create-image
file nil nil
gnus-picon-properties))
gnus-picon-glyph-alist))))
@@ -190,7 +190,7 @@ replacement is added."
(gnus-picon-find-face
(concat "unknown@"
(mapconcat
- 'identity (cdr spec) "."))
+ #'identity (cdr spec) "."))
gnus-picon-user-directories)))
(setcar spec (cons (gnus-picon-create-glyph file)
(car spec))))
@@ -201,7 +201,7 @@ replacement is added."
(when (setq file (gnus-picon-find-face
(concat "unknown@"
(mapconcat
- 'identity (nthcdr (1+ i) spec) "."))
+ #'identity (nthcdr (1+ i) spec) "."))
gnus-picon-domain-directories t))
(setcar (nthcdr (1+ i) spec)
(cons (gnus-picon-create-glyph file)
@@ -214,10 +214,11 @@ replacement is added."
(cl-case gnus-picon-style
(right
(when (= (length addresses) 1)
- (setq len (apply '+ (mapcar (lambda (x)
- (condition-case nil
- (car (image-size (car x)))
- (error 0))) spec)))
+ (setq len (apply #'+ (mapcar (lambda (x)
+ (condition-case nil
+ (car (image-size (car x)))
+ (error 0)))
+ spec)))
(when (> len 0)
(goto-char (point-at-eol))
(insert (propertize
@@ -248,7 +249,7 @@ replacement is added."
(gnus-article-goto-header header)
(mail-header-narrow-to-field)
(let ((groups (message-tokenize-header (mail-fetch-field header)))
- spec file point)
+ spec file) ;; point
(dolist (group groups)
(unless (setq spec (cdr (assoc group gnus-picon-cache)))
(setq spec (nreverse (split-string group "[.]")))
@@ -256,7 +257,7 @@ replacement is added."
(when (setq file (gnus-picon-find-face
(concat "unknown@"
(mapconcat
- 'identity (nthcdr i spec) "."))
+ #'identity (nthcdr i spec) "."))
gnus-picon-news-directories t))
(setcar (nthcdr i spec)
(cons (gnus-picon-create-glyph file)
diff --git a/lisp/gnus/gnus-range.el b/lisp/gnus/gnus-range.el
index 1e5d2a06..6cc60cb 100644
--- a/lisp/gnus/gnus-range.el
+++ b/lisp/gnus/gnus-range.el
@@ -1,4 +1,4 @@
-;;; gnus-range.el --- range and sequence functions for Gnus
+;;; gnus-range.el --- range and sequence functions for Gnus -*-
lexical-binding: t; -*-
;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
@@ -87,7 +87,7 @@ Both ranges must be in ascending order."
(setq range2 (gnus-range-normalize range2))
(let* ((new-range (cons nil (copy-sequence range1)))
(r new-range)
- (safe t))
+ ) ;; (safe t)
(while (cdr r)
(let* ((r1 (cadr r))
(r2 (car range2))
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el
index 068066e..147550d 100644
--- a/lisp/gnus/gnus-registry.el
+++ b/lisp/gnus/gnus-registry.el
@@ -131,7 +131,6 @@ display.")
(defcustom gnus-registry-default-mark 'To-Do
"The default mark. Should be a valid key for `gnus-registry-marks'."
- :group 'gnus-registry
:type 'symbol)
(defcustom gnus-registry-unfollowed-addresses
@@ -141,7 +140,6 @@ The addresses are matched, they don't have to be fully
qualified.
In the messages, these addresses can be the sender or the
recipients."
:version "24.1"
- :group 'gnus-registry
:type '(repeat regexp))
(defcustom gnus-registry-unfollowed-groups
@@ -153,12 +151,10 @@ message into a group that matches one of these,
regardless of
references.'
nnmairix groups are specifically excluded because they are ephemeral."
- :group 'gnus-registry
:type '(repeat regexp))
(defcustom gnus-registry-install 'ask
"Whether the registry should be installed."
- :group 'gnus-registry
:type '(choice (const :tag "Never Install" nil)
(const :tag "Always Install" t)
(const :tag "Ask Me" ask)))
@@ -181,7 +177,6 @@ nnmairix groups are specifically excluded because they are
ephemeral."
"Whether the registry should track extra data about a message.
The subject, recipients (To: and Cc:), and Sender (From:) headers
are tracked this way by default."
- :group 'gnus-registry
:type
'(set :tag "Tracking choices"
(const :tag "Track by subject (Subject: header)" subject)
@@ -205,7 +200,6 @@ This is the slowest strategy but also the most accurate one.
When `first', the first element of G wins. This is fast and
should be OK if your senders and subjects don't \"bleed\" across
groups."
- :group 'gnus-registry
:type
'(choice :tag "Splitting strategy"
(const :tag "Only use single choices, discard multiple matches" nil)
@@ -214,7 +208,6 @@ groups."
(defcustom gnus-registry-minimum-subject-length 5
"The minimum length of a subject before it's considered trackable."
- :group 'gnus-registry
:type 'integer)
(defcustom gnus-registry-extra-entries-precious '(mark)
@@ -225,20 +218,18 @@ considered precious.
Before you save the Gnus registry, it's pruned. Any entries with
keys in this list will not be pruned. All other entries go to
the Bit Bucket."
- :group 'gnus-registry
:type '(repeat symbol))
(defcustom gnus-registry-cache-file
+ ;; FIXME: Use `locate-user-emacs-file'!
(nnheader-concat
(or gnus-dribble-directory gnus-home-directory "~/")
".gnus.registry.eieio")
"File where the Gnus registry will be stored."
- :group 'gnus-registry
:type 'file)
(defcustom gnus-registry-max-entries nil
"Maximum number of entries in the registry, nil for unlimited."
- :group 'gnus-registry
:type '(radio (const :format "Unlimited " nil)
(integer :format "Maximum number: %v")))
@@ -253,7 +244,6 @@ cut the registry back to \(- 50000 \(* 50000 0.1)) -> 45000
entries. The pruning process is constrained by the presence of
\"precious\" entries."
:version "25.1"
- :group 'gnus-registry
:type 'float)
(defcustom gnus-registry-default-sort-function
@@ -262,7 +252,6 @@ entries. The pruning process is constrained by the
presence of
Entries that sort to the front of the list are pruned first.
This can slow pruning down. Set to nil to perform no sorting."
:version "25.1"
- :group 'gnus-registry
:type '(choice (const :tag "No sorting" nil) function))
(defun gnus-registry-sort-by-creation-time (l r)
@@ -891,7 +880,7 @@ Addresses without a name will say \"noname\"."
(defun gnus-registry-sort-addresses (&rest addresses)
"Return a normalized and sorted list of ADDRESSES."
- (sort (mapcan #'gnus-registry-extract-addresses addresses) 'string-lessp))
+ (sort (mapcan #'gnus-registry-extract-addresses addresses) #'string-lessp))
(defun gnus-registry-simplify-subject (subject)
(if (stringp subject)
diff --git a/lisp/gnus/gnus-rfc1843.el b/lisp/gnus/gnus-rfc1843.el
index 107e963..5697c87 100644
--- a/lisp/gnus/gnus-rfc1843.el
+++ b/lisp/gnus/gnus-rfc1843.el
@@ -1,4 +1,4 @@
-;;; gnus-rfc1843.el --- HZ (rfc1843) decoding interface functions for Gnus
+;;; gnus-rfc1843.el --- HZ (rfc1843) decoding interface functions for Gnus
-*- lexical-binding: t; -*-
;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
@@ -56,11 +56,11 @@
(defun rfc1843-gnus-setup ()
"Setup HZ decoding for Gnus."
- (add-hook 'gnus-article-decode-hook 'rfc1843-decode-article-body t)
+ (add-hook 'gnus-article-decode-hook #'rfc1843-decode-article-body t)
(setq gnus-decode-encoded-word-function
- 'gnus-multi-decode-encoded-word-string
+ #'gnus-multi-decode-encoded-word-string
gnus-decode-header-function
- 'gnus-multi-decode-header
+ #'gnus-multi-decode-header
gnus-decode-encoded-word-methods
(nconc gnus-decode-encoded-word-methods
(list
diff --git a/lisp/gnus/gnus-salt.el b/lisp/gnus/gnus-salt.el
index abaa844..e222d24 100644
--- a/lisp/gnus/gnus-salt.el
+++ b/lisp/gnus/gnus-salt.el
@@ -1,4 +1,4 @@
-;;; gnus-salt.el --- alternate summary mode interfaces for Gnus
+;;; gnus-salt.el --- alternate summary mode interfaces for Gnus -*-
lexical-binding: t; -*-
;; Copyright (C) 1996-1999, 2001-2021 Free Software Foundation, Inc.
@@ -103,7 +103,7 @@ It accepts the same format specs that
`gnus-summary-line-format' does."
((not (derived-mode-p 'gnus-summary-mode)) (setq gnus-pick-mode nil))
((not gnus-pick-mode)
;; FIXME: a buffer-local minor mode removing globally from a hook??
- (remove-hook 'gnus-message-setup-hook 'gnus-pick-setup-message))
+ (remove-hook 'gnus-message-setup-hook #'gnus-pick-setup-message))
(t
;; Make sure that we don't select any articles upon group entry.
(setq-local gnus-auto-select-first nil)
@@ -113,7 +113,7 @@ It accepts the same format specs that
`gnus-summary-line-format' does."
(gnus-update-format-specifications nil 'summary)
(gnus-update-summary-mark-positions)
;; FIXME: a buffer-local minor mode adding globally to a hook??
- (add-hook 'gnus-message-setup-hook 'gnus-pick-setup-message)
+ (add-hook 'gnus-message-setup-hook #'gnus-pick-setup-message)
(setq-local gnus-summary-goto-unread 'never)
;; Set up the menu.
(when (gnus-visual-p 'pick-menu 'menu)
@@ -609,7 +609,7 @@ Two predefined functions are available:
beg end)
(add-text-properties
(setq beg (point))
- (setq end (progn (eval gnus-tree-line-format-spec) (point)))
+ (setq end (progn (eval gnus-tree-line-format-spec t) (point)))
(list 'gnus-number gnus-tmp-number))
(when (or t (gnus-visual-p 'tree-highlight 'highlight))
(gnus-tree-highlight-node gnus-tmp-number beg end))))
diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el
index e74c498..ade0897 100644
--- a/lisp/gnus/gnus-score.el
+++ b/lisp/gnus/gnus-score.el
@@ -1,4 +1,4 @@
-;;; gnus-score.el --- scoring code for Gnus
+;;; gnus-score.el --- scoring code for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
@@ -683,7 +683,7 @@ current score file."
(and gnus-extra-headers
(equal (nth 1 entry) "extra")
(intern ; need symbol
- (let ((collection (mapcar 'symbol-name gnus-extra-headers)))
+ (let ((collection (mapcar #'symbol-name gnus-extra-headers)))
(gnus-completing-read
"Score extra header" ; prompt
collection ; completion list
@@ -932,7 +932,7 @@ SCORE is the score to add.
EXTRA is the possible non-standard header."
(interactive (list (gnus-completing-read "Header"
(mapcar
- 'car
+ #'car
(seq-filter
(lambda (x) (fboundp (nth 2 x)))
gnus-header-index))
@@ -1235,7 +1235,7 @@ If FORMAT, also format the current score file."
(let ((mark (car (gnus-score-get 'mark alist)))
(expunge (car (gnus-score-get 'expunge alist)))
(mark-and-expunge (car (gnus-score-get 'mark-and-expunge alist)))
- (score-fn (car (gnus-score-get 'score-fn alist)))
+ ;; (score-fn (car (gnus-score-get 'score-fn alist)))
(files (gnus-score-get 'files alist))
(exclude-files (gnus-score-get 'exclude-files alist))
(orphan (car (gnus-score-get 'orphan alist)))
@@ -1258,17 +1258,17 @@ If FORMAT, also format the current score file."
;; We do not respect eval and files atoms from global score
;; files.
(when (and files (not global))
- (setq lists (apply 'append lists
- (mapcar 'gnus-score-load-file
+ (setq lists (apply #'append lists
+ (mapcar #'gnus-score-load-file
(if adapt-file (cons adapt-file files)
files)))))
(when (and eval (not global))
- (eval eval))
+ (eval eval t))
;; We then expand any exclude-file directives.
(setq gnus-scores-exclude-files
(nconc
(apply
- 'nconc
+ #'nconc
(mapcar
(lambda (sfile)
(list
@@ -1554,10 +1554,10 @@ If FORMAT, also format the current score file."
(setq entry (pop entries)
header (nth 0 entry)
gnus-score-index (nth 1 (assoc header gnus-header-index)))
- (when (< 0 (apply 'max (mapcar
- (lambda (score)
- (length (gnus-score-get header score)))
- scores)))
+ (when (< 0 (apply #'max (mapcar
+ (lambda (score)
+ (length (gnus-score-get header score)))
+ scores)))
(when (if (and gnus-inhibit-slow-scoring
(or (eq gnus-inhibit-slow-scoring t)
(and (stringp gnus-inhibit-slow-scoring)
@@ -1574,9 +1574,9 @@ If FORMAT, also format the current score file."
;; Run score-fn
(if (eq header 'score-fn)
(setq new (gnus-score-func scores trace))
- ;; Call the scoring function for this type of "header".
- (setq new (funcall (nth 2 entry) scores header
- now expire trace))))
+ ;; Call the scoring function for this type of
"header".
+ (setq new (funcall (nth 2 entry) scores header
+ now expire trace))))
(push new news))))
(when (gnus-buffer-live-p gnus-summary-buffer)
@@ -1818,45 +1818,44 @@ score in `gnus-newsgroup-scored' by SCORE."
handles))))
(defun gnus-score-body (scores header now expire &optional trace)
- (if gnus-agent-fetching
- nil
- (save-excursion
- (setq gnus-scores-articles
- (sort gnus-scores-articles
- (lambda (a1 a2)
- (< (mail-header-number (car a1))
- (mail-header-number (car a2))))))
- (set-buffer nntp-server-buffer)
- (save-restriction
- (let* ((buffer-read-only nil)
- (articles gnus-scores-articles)
- (all-scores scores)
- (request-func (cond ((string= "head" header)
- 'gnus-request-head)
- ((string= "body" header)
- 'gnus-request-body)
- (t 'gnus-request-article)))
- entries alist ofunc article last)
- (when articles
- (setq last (mail-header-number (caar (last articles))))
- ;; Not all backends support partial fetching. In that case,
- ;; we just fetch the entire article.
- ;; When scoring by body, we need to peek at the headers to detect
- ;; the content encoding
- (unless (or (gnus-check-backend-function
- (and (string-match "^gnus-" (symbol-name
request-func))
- (intern (substring (symbol-name request-func)
- (match-end 0))))
- gnus-newsgroup-name)
- (string= "body" header))
- (setq ofunc request-func)
- (setq request-func 'gnus-request-article))
- (while articles
- (setq article (mail-header-number (caar articles)))
- (gnus-message 7 "Scoring article %s of %s..." article last)
- (widen)
- (let (handles)
- (when (funcall request-func article gnus-newsgroup-name)
+ (if gnus-agent-fetching
+ nil
+ (setq gnus-scores-articles
+ (sort gnus-scores-articles
+ (lambda (a1 a2)
+ (< (mail-header-number (car a1))
+ (mail-header-number (car a2))))))
+ (with-current-buffer nntp-server-buffer
+ (save-restriction
+ (let* ((buffer-read-only nil)
+ (articles gnus-scores-articles)
+ (all-scores scores)
+ (request-func (cond ((string= "head" header)
+ 'gnus-request-head)
+ ((string= "body" header)
+ 'gnus-request-body)
+ (t 'gnus-request-article)))
+ entries alist ofunc article last)
+ (when articles
+ (setq last (mail-header-number (caar (last articles))))
+ ;; Not all backends support partial fetching. In that case,
+ ;; we just fetch the entire article.
+ ;; When scoring by body, we need to peek at the headers to detect
+ ;; the content encoding
+ (unless (or (gnus-check-backend-function
+ (and (string-match "^gnus-" (symbol-name
request-func))
+ (intern (substring (symbol-name request-func)
+ (match-end 0))))
+ gnus-newsgroup-name)
+ (string= "body" header))
+ (setq ofunc request-func)
+ (setq request-func 'gnus-request-article))
+ (while articles
+ (setq article (mail-header-number (caar articles)))
+ (gnus-message 7 "Scoring article %s of %s..." article last)
+ (widen)
+ (let (handles)
+ (when (funcall request-func article gnus-newsgroup-name)
(when (string= "body" header)
(setq handles (gnus-score-decode-text-parts)))
(goto-char (point-min))
@@ -1921,8 +1920,8 @@ score in `gnus-newsgroup-scored' by SCORE."
(setq rest entries))))
(setq entries rest))))
(when handles (mm-destroy-parts handles))))
- (setq articles (cdr articles)))))))
- nil))
+ (setq articles (cdr articles)))))))
+ nil))
(defun gnus-score-thread (scores header now expire &optional trace)
(gnus-score-followup scores header now expire trace t))
@@ -1948,7 +1947,7 @@ score in `gnus-newsgroup-scored' by SCORE."
gnus-newsgroup-name gnus-adaptive-file-suffix))))
(setq gnus-scores-articles (sort gnus-scores-articles
- 'gnus-score-string<)
+ #'gnus-score-string<)
articles gnus-scores-articles)
(erase-buffer)
@@ -2077,7 +2076,7 @@ score in `gnus-newsgroup-scored' by SCORE."
;; We cannot string-sort the extra headers list. *sigh*
(if (= gnus-score-index 9)
gnus-scores-articles
- (sort gnus-scores-articles 'gnus-score-string<))
+ (sort gnus-scores-articles #'gnus-score-string<))
articles gnus-scores-articles)
(erase-buffer)
@@ -2550,11 +2549,11 @@ score in `gnus-newsgroup-scored' by SCORE."
(abbreviate-file-name file))))
(insert
(format "\nTotal score: %d"
- (apply '+ (mapcar
- (lambda (s)
- (or (caddr s)
- gnus-score-interactive-default-score))
- trace))))
+ (apply #'+ (mapcar
+ (lambda (s)
+ (or (caddr s)
+ gnus-score-interactive-default-score))
+ trace))))
(insert
"\n\nQuick help:
@@ -2699,7 +2698,7 @@ the score file and its full name, including the
directory.")
;;; Finding score files.
-(defun gnus-score-score-files (group)
+(defun gnus-score-score-files (_group)
"Return a list of all possible score files."
;; Search and set any global score files.
(when gnus-global-score-files
@@ -2872,7 +2871,7 @@ This includes the score file for the group and all its
parents."
(mapcar (lambda (group)
(gnus-score-file-name group gnus-adaptive-file-suffix))
(setq all (nreverse all)))
- (mapcar 'gnus-score-file-name all)))
+ (mapcar #'gnus-score-file-name all)))
(if (equal prefix "")
all
(mapcar
@@ -2912,7 +2911,7 @@ Destroys the current buffer."
(lambda (file)
(cons (inline (gnus-score-file-rank file)) file))
files)))
- (mapcar 'cdr (sort alist 'car-less-than-car)))))
+ (mapcar #'cdr (sort alist #'car-less-than-car)))))
(defun gnus-score-find-alist (group)
"Return list of score files for GROUP.
diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el
index 4478060..d7b1c06 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:
@@ -123,8 +125,7 @@ If this option is set to nil, search queries will be passed
directly to the search engines without being parsed or
transformed."
:version "28.1"
- :type 'boolean
- :group 'gnus-search)
+ :type 'boolean)
(define-obsolete-variable-alias 'nnir-ignored-newsgroups
'gnus-search-ignored-newsgroups "28.1")
@@ -133,8 +134,7 @@ transformed."
"A regexp to match newsgroups in the active file that should
be skipped when searching."
:version "24.1"
- :type 'regexp
- :group 'gnus-search)
+ :type 'regexp)
(make-obsolete-variable
'nnir-imap-default-search-key
@@ -146,14 +146,12 @@ transformed."
(expand-file-name "~/Mail/swish++.conf")
"Location of Swish++ configuration file.
This variable can also be set per-server."
- :type 'file
- :group 'gnus-search)
+ :type 'file)
(defcustom gnus-search-swish++-program "search"
"Name of swish++ search executable.
This variable can also be set per-server."
- :type 'string
- :group 'gnus-search)
+ :type 'string)
(defcustom gnus-search-swish++-switches '()
"A list of strings, to be given as additional arguments to swish++.
@@ -163,8 +161,7 @@ Instead, use this:
(setq gnus-search-swish++-switches \\='(\"-i\" \"-w\"))
This variable can also be set per-server."
- :type '(repeat string)
- :group 'gnus-search)
+ :type '(repeat string))
(defcustom gnus-search-swish++-remove-prefix (concat (getenv "HOME") "/Mail/")
"The prefix to remove from each file name returned by swish++
@@ -172,30 +169,26 @@ in order to get a group name (albeit with / instead of
.). This is a
regular expression.
This variable can also be set per-server."
- :type 'regexp
- :group 'gnus-search)
+ :type 'regexp)
(defcustom gnus-search-swish++-raw-queries-p nil
"If t, all Swish++ engines will only accept raw search query
strings."
:type 'boolean
- :version "28.1"
- :group 'gnus-search)
+ :version "28.1")
(defcustom gnus-search-swish-e-config-file
(expand-file-name "~/Mail/swish-e.conf")
"Configuration file for swish-e.
This variable can also be set per-server."
:type 'file
- :version "28.1"
- :group 'gnus-search)
+ :version "28.1")
(defcustom gnus-search-swish-e-program "search"
"Name of swish-e search executable.
This variable can also be set per-server."
:type 'string
- :version "28.1"
- :group 'gnus-search)
+ :version "28.1")
(defcustom gnus-search-swish-e-switches '()
"A list of strings, to be given as additional arguments to swish-e.
@@ -206,8 +199,7 @@ Instead, use this:
This variable can also be set per-server."
:type '(repeat string)
- :version "28.1"
- :group 'gnus-search)
+ :version "28.1")
(defcustom gnus-search-swish-e-remove-prefix (concat (getenv "HOME") "/Mail/")
"The prefix to remove from each file name returned by swish-e
@@ -216,22 +208,19 @@ regular expression.
This variable can also be set per-server."
:type 'regexp
- :version "28.1"
- :group 'gnus-search)
+ :version "28.1")
(defcustom gnus-search-swish-e-index-files '()
"A list of index files to use with this Swish-e instance.
This variable can also be set per-server."
:type '(repeat file)
- :version "28.1"
- :group 'gnus-search)
+ :version "28.1")
(defcustom gnus-search-swish-e-raw-queries-p nil
"If t, all Swish-e engines will only accept raw search query
strings."
:type 'boolean
- :version "28.1"
- :group 'gnus-search)
+ :version "28.1")
;; Namazu engine, see <URL:http://www.namazu.org/>
@@ -239,15 +228,13 @@ This variable can also be set per-server."
"Name of Namazu search executable.
This variable can also be set per-server."
:type 'string
- :version "28.1"
- :group 'gnus-search)
+ :version "28.1")
(defcustom gnus-search-namazu-index-directory (expand-file-name
"~/Mail/namazu/")
"Index directory for Namazu.
This variable can also be set per-server."
:type 'directory
- :version "28.1"
- :group 'gnus-search)
+ :version "28.1")
(defcustom gnus-search-namazu-switches '()
"A list of strings, to be given as additional arguments to namazu.
@@ -261,8 +248,7 @@ Instead, use this:
This variable can also be set per-server."
:type '(repeat string)
- :version "28.1"
- :group 'gnus-search)
+ :version "28.1")
(defcustom gnus-search-namazu-remove-prefix (concat (getenv "HOME") "/Mail/")
"The prefix to remove from each file name returned by Namazu
@@ -277,30 +263,26 @@ arrive at the correct group name, \"mail.misc\".
This variable can also be set per-server."
:type 'directory
- :version "28.1"
- :group 'gnus-search)
+ :version "28.1")
(defcustom gnus-search-namazu-raw-queries-p nil
"If t, all Namazu engines will only accept raw search query
strings."
:type 'boolean
- :version "28.1"
- :group 'gnus-search)
+ :version "28.1")
(defcustom gnus-search-notmuch-program "notmuch"
"Name of notmuch search executable.
This variable can also be set per-server."
:type '(string)
- :version "28.1"
- :group 'gnus-search)
+ :version "28.1")
(defcustom gnus-search-notmuch-config-file
(expand-file-name "~/.notmuch-config")
"Configuration file for notmuch.
This variable can also be set per-server."
:type 'file
- :version "28.1"
- :group 'gnus-search)
+ :version "28.1")
(defcustom gnus-search-notmuch-switches '()
"A list of strings, to be given as additional arguments to notmuch.
@@ -311,8 +293,7 @@ Instead, use this:
This variable can also be set per-server."
:type '(repeat string)
- :version "28.1"
- :group 'gnus-search)
+ :version "28.1")
(defcustom gnus-search-notmuch-remove-prefix (concat (getenv "HOME") "/Mail/")
"The prefix to remove from each file name returned by notmuch
@@ -321,37 +302,32 @@ regular expression.
This variable can also be set per-server."
:type 'regexp
- :version "28.1"
- :group 'gnus-search)
+ :version "28.1")
(defcustom gnus-search-notmuch-raw-queries-p nil
"If t, all Notmuch engines will only accept raw search query
strings."
:type 'boolean
- :version "28.1"
- :group 'gnus-search)
+ :version "28.1")
(defcustom gnus-search-imap-raw-queries-p nil
"If t, all IMAP engines will only accept raw search query
strings."
:version "28.1"
- :type 'boolean
- :group 'gnus-search)
+ :type 'boolean)
(defcustom gnus-search-mairix-program "mairix"
"Name of mairix search executable.
This variable can also be set per-server."
:version "28.1"
- :type 'string
- :group 'gnus-search)
+ :type 'string)
(defcustom gnus-search-mairix-config-file
(expand-file-name "~/.mairixrc")
"Configuration file for mairix.
This variable can also be set per-server."
:version "28.1"
- :type 'file
- :group 'gnus-search)
+ :type 'file)
(defcustom gnus-search-mairix-switches '()
"A list of strings, to be given as additional arguments to mairix.
@@ -362,8 +338,7 @@ Instead, use this:
This variable can also be set per-server."
:version "28.1"
- :type '(repeat string)
- :group 'gnus-search)
+ :type '(repeat string))
(defcustom gnus-search-mairix-remove-prefix (concat (getenv "HOME") "/Mail/")
"The prefix to remove from each file name returned by mairix
@@ -372,15 +347,13 @@ regular expression.
This variable can also be set per-server."
:version "28.1"
- :type 'regexp
- :group 'gnus-search)
+ :type 'regexp)
(defcustom gnus-search-mairix-raw-queries-p nil
"If t, all Mairix engines will only accept raw search query
strings."
:version "28.1"
- :type 'boolean
- :group 'gnus-search)
+ :type 'boolean)
;; Options for search language parsing.
@@ -396,7 +369,6 @@ typing in search queries, ie \"subject\" could be entered as
\"subject\" and \"since\".
Ambiguous abbreviations will raise an error."
- :group 'gnus-search
:version "28.1"
:type '(repeat string))
@@ -405,7 +377,6 @@ Ambiguous abbreviations will raise an error."
"A list of keywords whose value should be parsed as a date.
See the docstring of `gnus-search-parse-query' for information on
date parsing."
- :group 'gnus-search
:version "26.1"
:type '(repeat string))
@@ -414,7 +385,6 @@ date parsing."
Each list element should be a table or collection suitable to be
returned by `completion-at-point-functions'. That usually means
a list of strings, a hash table, or an alist."
- :group 'gnus-search
:version "28.1"
:type '(repeat sexp))
@@ -939,7 +909,6 @@ quirks.")
(defcustom gnus-search-default-engines '((nnimap . gnus-search-imap))
"Alist of default search engines keyed by server method."
:version "26.1"
- :group 'gnus-search
:type `(repeat (cons (choice (const nnimap) (const nntp) (const nnspool)
(const nneething) (const nndir) (const nnmbox)
(const nnml) (const nnmh) (const nndraft)
@@ -1073,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)))
@@ -1379,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))
@@ -1547,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))))
@@ -1859,7 +1831,7 @@ Assume \"size\" key is equal to \"larger\"."
"No directory found in definition of server %s"
server))))
(apply
- 'vconcat
+ #'vconcat
(mapcar (lambda (x)
(let ((group x)
artlist)
@@ -1894,7 +1866,7 @@ Assume \"size\" key is equal to \"larger\"."
"Cannot locate directory for group")))
(save-excursion
(apply
- 'call-process "find" nil t
+ #'call-process "find" nil t
"find" group "-maxdepth" "1" "-type" "f"
"-name" "[0-9]*" "-exec"
(slot-value engine 'grep-program)
@@ -1907,7 +1879,8 @@ Assume \"size\" key is equal to \"larger\"."
(let* ((path (split-string
(buffer-substring
(point)
- (line-end-position)) "/" t))
+ (line-end-position))
+ "/" t))
(art (string-to-number (car (last path)))))
(while (string= "." (car path))
(setq path (cdr path)))
diff --git a/lisp/gnus/gnus-sieve.el b/lisp/gnus/gnus-sieve.el
index 3b79d57..5dcd079 100644
--- a/lisp/gnus/gnus-sieve.el
+++ b/lisp/gnus/gnus-sieve.el
@@ -1,4 +1,4 @@
-;;; gnus-sieve.el --- Utilities to manage sieve scripts for Gnus
+;;; gnus-sieve.el --- Utilities to manage sieve scripts for Gnus -*-
lexical-binding: t; -*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
@@ -40,30 +40,25 @@
(defcustom gnus-sieve-file "~/.sieve"
"Path to your Sieve script."
- :type 'file
- :group 'gnus-sieve)
+ :type 'file)
(defcustom gnus-sieve-region-start "\n## Begin Gnus Sieve Script\n"
"Line indicating the start of the autogenerated region in your Sieve script."
- :type 'string
- :group 'gnus-sieve)
+ :type 'string)
(defcustom gnus-sieve-region-end "\n## End Gnus Sieve Script\n"
"Line indicating the end of the autogenerated region in your Sieve script."
- :type 'string
- :group 'gnus-sieve)
+ :type 'string)
(defcustom gnus-sieve-select-method nil
"Which select method we generate the Sieve script for.
For example: \"nnimap:mailbox\""
;; FIXME? gnus-select-method?
- :type '(choice (const nil) string)
- :group 'gnus-sieve)
+ :type '(choice (const nil) string))
(defcustom gnus-sieve-crosspost t
"Whether the generated Sieve script should do crossposting."
- :type 'boolean
- :group 'gnus-sieve)
+ :type 'boolean)
(defcustom gnus-sieve-update-shell-command "echo put %f | sieveshell %s"
"Shell command to execute after updating your Sieve script. The following
@@ -71,8 +66,7 @@ formatting characters are recognized:
%f Script's file name (gnus-sieve-file)
%s Server name (from gnus-sieve-select-method)"
- :type 'string
- :group 'gnus-sieve)
+ :type 'string)
;;;###autoload
(defun gnus-sieve-update ()
@@ -140,7 +134,7 @@ For example:
\(gnus-sieve-string-list \\='(\"to\" \"cc\"))
=> \"[\\\"to\\\", \\\"cc\\\"]\"
"
- (concat "[\"" (mapconcat 'identity list "\", \"") "\"]"))
+ (concat "[\"" (mapconcat #'identity list "\", \"") "\"]"))
(defun gnus-sieve-test-list (list)
"Convert an elisp test list to a Sieve test list.
@@ -148,7 +142,7 @@ For example:
For example:
\(gnus-sieve-test-list \\='((address \"sender\" \"boss@company.com\") (size
:over 4K)))
=> \"(address \\\"sender\\\" \\\"boss@company.com\\\", size :over 4K)\""
- (concat "(" (mapconcat 'gnus-sieve-test list ", ") ")"))
+ (concat "(" (mapconcat #'gnus-sieve-test list ", ") ")"))
;; FIXME: do proper quoting
(defun gnus-sieve-test-token (token)
@@ -189,7 +183,7 @@ For example:
(size :over 100K))))
=> \"anyof (header :contains [\\\"to\\\", \\\"cc\\\"] \\\"my@address.com\\\",
size :over 100K)\""
- (mapconcat 'gnus-sieve-test-token test " "))
+ (mapconcat #'gnus-sieve-test-token test " "))
(defun gnus-sieve-script (&optional method crosspost)
"Generate a Sieve script based on groups with select method METHOD
@@ -228,7 +222,7 @@ This is returned as a string."
"\tstop;\n")
"}")
script)))))
- (mapconcat 'identity script "\n")))
+ (mapconcat #'identity script "\n")))
(provide 'gnus-sieve)
diff --git a/lisp/gnus/gnus-spec.el b/lisp/gnus/gnus-spec.el
index a522855..cb60108 100644
--- a/lisp/gnus/gnus-spec.el
+++ b/lisp/gnus/gnus-spec.el
@@ -1,4 +1,4 @@
-;;; gnus-spec.el --- format spec functions for Gnus
+;;; gnus-spec.el --- format spec functions for Gnus -*- lexical-binding: t;
-*-
;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
@@ -146,14 +146,14 @@ Return a list of updated types."
(while (setq type (pop types))
;; Jump to the proper buffer to find out the value of the
;; variable, if possible. (It may be buffer-local.)
- (save-excursion
+ (save-current-buffer
(let ((buffer (intern (format "gnus-%s-buffer" type))))
(when (and (boundp buffer)
(setq val (symbol-value buffer))
(gnus-buffer-live-p val))
- (set-buffer val))
- (setq new-format (symbol-value
- (intern (format "gnus-%s-line-format" type)))))
+ (set-buffer val)))
+ (setq new-format (symbol-value
+ (intern (format "gnus-%s-line-format" type))))
(setq entry (cdr (assq type gnus-format-specs)))
(if (and (car entry)
(equal (car entry) new-format))
@@ -170,7 +170,7 @@ Return a list of updated types."
new-format
(symbol-value
(intern (format "gnus-%s-line-format-alist" type)))
- (not (string-match "mode$" (symbol-name type))))))
+ (not (string-match "mode\\'" (symbol-name type))))))
;; Enter the new format spec into the list.
(if entry
(progn
@@ -526,13 +526,13 @@ or to characters when given a pad value."
(if (eq spec ?%)
;; "%%" just results in a "%".
(insert "%")
- (cond
- ;; Do tilde forms.
- ((eq spec ?@)
- (setq elem (list tilde-form ?s)))
- ;; Treat user defined format specifiers specially.
- (user-defined
- (setq elem
+ (setq elem
+ (cond
+ ;; Do tilde forms.
+ ((eq spec ?@)
+ (list tilde-form ?s))
+ ;; Treat user defined format specifiers specially.
+ (user-defined
(list
(list (intern (format
(if (stringp user-defined)
@@ -540,14 +540,14 @@ or to characters when given a pad value."
"gnus-user-format-function-%c")
user-defined))
'gnus-tmp-header)
- ?s)))
- ;; Find the specification from `spec-alist'.
- ((setq elem (cdr (assq (or extended-spec spec) spec-alist))))
- ;; We used to use "%l" for displaying the grouplens score.
- ((eq spec ?l)
- (setq elem '("" ?s)))
- (t
- (setq elem '("*" ?s))))
+ ?s))
+ ;; Find the specification from `spec-alist'.
+ ((cdr (assq (or extended-spec spec) spec-alist)))
+ ;; We used to use "%l" for displaying the grouplens score.
+ ((eq spec ?l)
+ '("" ?s))
+ (t
+ '("*" ?s))))
(setq elem-type (cadr elem))
;; Insert the new format elements.
(when pad-width
@@ -628,8 +628,8 @@ or to characters when given a pad value."
If PROPS, insert the result."
(let ((form (gnus-parse-format format alist props)))
(if props
- (add-text-properties (point) (progn (eval form) (point)) props)
- (eval form))))
+ (add-text-properties (point) (progn (eval form t) (point)) props)
+ (eval form t))))
(defun gnus-set-format (type &optional insertable)
(set (intern (format "gnus-%s-line-format-spec" type))
diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el
index 34e5ceb..a305e34 100644
--- a/lisp/gnus/gnus-srvr.el
+++ b/lisp/gnus/gnus-srvr.el
@@ -1,4 +1,4 @@
-;;; gnus-srvr.el --- virtual server support for Gnus
+;;; gnus-srvr.el --- virtual server support for Gnus -*- lexical-binding: t;
-*-
;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
@@ -297,7 +297,7 @@ The following commands are available:
(point)
(prog1 (1+ (point))
;; Insert the text.
- (eval gnus-server-line-format-spec))
+ (eval gnus-server-line-format-spec t))
(list 'gnus-server (intern gnus-tmp-name)
'gnus-named-server (intern (gnus-method-to-server method t))))))
@@ -581,7 +581,7 @@ The following commands are available:
(defun gnus-server-add-server (how where)
(interactive
(list (intern (gnus-completing-read "Server method"
- (mapcar 'car gnus-valid-select-methods)
+ (mapcar #'car gnus-valid-select-methods)
t))
(read-string "Server name: ")))
(when (assq where gnus-server-alist)
@@ -592,7 +592,8 @@ The following commands are available:
(defun gnus-server-goto-server (server)
"Jump to a server line."
(interactive
- (list (gnus-completing-read "Goto server" (mapcar 'car gnus-server-alist)
t)))
+ (list (gnus-completing-read "Goto server"
+ (mapcar #'car gnus-server-alist) t)))
(let ((to (text-property-any (point-min) (point-max)
'gnus-server (intern server))))
(when to
@@ -611,10 +612,10 @@ The following commands are available:
(gnus-close-server info)
(gnus-edit-form
info "Editing the server."
- `(lambda (form)
- (gnus-server-set-info ,server form)
- (gnus-server-list-servers)
- (gnus-server-position-point))
+ (lambda (form)
+ (gnus-server-set-info server form)
+ (gnus-server-list-servers)
+ (gnus-server-position-point))
'edit-server)))
(defun gnus-server-show-server (server)
@@ -625,7 +626,7 @@ The following commands are available:
(let ((info (gnus-server-to-method server)))
(gnus-edit-form
info "Showing the server."
- (lambda (form)
+ (lambda (_form)
(gnus-server-position-point))
'edit-server)))
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index cf37a1c..1554635 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -259,7 +259,7 @@ not match this regexp will be removed before saving the
list."
regexp))
(defcustom gnus-ignored-newsgroups
- (mapconcat 'identity
+ (mapconcat #'identity
'("^to\\." ; not "real" groups
"^[0-9. \t]+\\( \\|$\\)" ; all digits in name
"^[\"][\"#'()]" ; bogus characters
@@ -518,7 +518,7 @@ Can be used to turn version control on or off."
;; For subscribing new newsgroup
(defun gnus-subscribe-hierarchical-interactive (groups)
- (let ((groups (sort groups 'string<))
+ (let ((groups (sort groups #'string<))
prefixes prefix start ans group starts)
(while groups
(setq prefixes (list "^"))
@@ -843,8 +843,7 @@ prompt the user for the name of an NNTP server to use."
If REGEXP is given, lines that match it will be deleted."
(when (and (not gnus-dribble-ignore)
(buffer-live-p gnus-dribble-buffer))
- (let ((obuf (current-buffer)))
- (set-buffer gnus-dribble-buffer)
+ (with-current-buffer gnus-dribble-buffer
(when regexp
(goto-char (point-min))
(let (end)
@@ -859,8 +858,7 @@ If REGEXP is given, lines that match it will be deleted."
(insert (replace-regexp-in-string "\n" "\\\\n" string) "\n")
(bury-buffer gnus-dribble-buffer)
(with-current-buffer gnus-group-buffer
- (gnus-group-set-mode-line))
- (set-buffer obuf))))
+ (gnus-group-set-mode-line)))))
(defun gnus-dribble-touch ()
"Touch the dribble buffer."
@@ -916,9 +914,8 @@ If REGEXP is given, lines that match it will be deleted."
(defun gnus-dribble-eval-file ()
(when gnus-dribble-eval-file
(setq gnus-dribble-eval-file nil)
- (save-excursion
- (let ((gnus-dribble-ignore t))
- (set-buffer gnus-dribble-buffer)
+ (let ((gnus-dribble-ignore t))
+ (with-current-buffer gnus-dribble-buffer
(eval-buffer (current-buffer))))))
(defun gnus-dribble-delete-file ()
@@ -1187,10 +1184,9 @@ for new groups, and subscribe the new groups as zombies."
gnus-override-subscribe-method method)
(when (and (gnus-check-server method)
(gnus-request-newgroups date method))
- (save-excursion
- (setq got-new t
- hashtb (gnus-make-hashtable 100))
- (set-buffer nntp-server-buffer)
+ (setq got-new t
+ hashtb (gnus-make-hashtable 100))
+ (with-current-buffer nntp-server-buffer
;; Enter all the new groups into a hashtable.
(gnus-active-to-gnus-format method hashtb 'ignore))
;; Now all new groups from `method' are in `hashtb'.
@@ -2250,9 +2246,8 @@ If FORCE is non-nil, the .newsrc file is read."
;; can find there for changing the data already read -
;; i. e., reading the .newsrc file will not trash the data
;; already read (except for read articles).
- (save-excursion
- (gnus-message 5 "Reading %s..." newsrc-file)
- (set-buffer (nnheader-find-file-noselect newsrc-file))
+ (gnus-message 5 "Reading %s..." newsrc-file)
+ (with-current-buffer (nnheader-find-file-noselect newsrc-file)
(buffer-disable-undo)
(gnus-newsrc-to-gnus-format)
(kill-buffer (current-buffer))
@@ -2342,7 +2337,7 @@ If FORCE is non-nil, the .newsrc file is read."
gnus-newsrc-file-version gnus-version)))))))
(defun gnus-convert-mark-converter-prompt (converter no-prompt)
- "Indicate whether CONVERTER requires gnus-convert-old-newsrc to
+ "Indicate whether CONVERTER requires `gnus-convert-old-newsrc' to
display the conversion prompt. NO-PROMPT may be nil (prompt),
t (no prompt), or any form that can be called as a function.
The form should return either t or nil."
@@ -2994,13 +2989,12 @@ SPECIFIC-VARIABLES, or those in `gnus-variable-list'."
;;; Child functions.
;;;
-(defvar gnus-child-mode nil)
+;; (defvar gnus-child-mode nil)
(defun gnus-child-mode ()
"Minor mode for child Gnusae."
- ;; FIXME: gnus-child-mode appears to never be set (i.e. it'll always be nil):
- ;; Remove, or fix and use define-minor-mode.
- (add-minor-mode 'gnus-child-mode " Child" (make-sparse-keymap))
+ ;; FIXME: gnus-child-mode appears to never be set (i.e. it'll always be nil).
+ ;; (add-minor-mode 'gnus-child-mode " Child" (make-sparse-keymap))
(gnus-run-hooks 'gnus-child-mode-hook))
(define-obsolete-function-alias 'gnus-slave-mode #'gnus-child-mode "28.1")
@@ -3102,50 +3096,49 @@ SPECIFIC-VARIABLES, or those in `gnus-variable-list'."
(gnus-message 1 "Couldn't read newsgroups descriptions")
nil)
(t
- (save-excursion
- ;; FIXME: Shouldn't save-restriction be done after set-buffer?
- (save-restriction
- (set-buffer nntp-server-buffer)
- (goto-char (point-min))
- (when (or (search-forward "\n.\n" nil t)
- (goto-char (point-max)))
- (beginning-of-line)
- (narrow-to-region (point-min) (point)))
- ;; If these are groups from a foreign select method, we insert the
- ;; group prefix in front of the group names.
- (and method (not (inline
- (gnus-server-equal
- (gnus-server-get-method nil method)
- (gnus-server-get-method
- nil gnus-select-method))))
- (let ((prefix (gnus-group-prefixed-name "" method)))
- (goto-char (point-min))
- (while (and (not (eobp))
- (progn (insert prefix)
- (zerop (forward-line 1)))))))
- (goto-char (point-min))
- (while (not (eobp))
- (setq group
- (condition-case ()
- (read nntp-server-buffer)
- (error nil)))
- (skip-chars-forward " \t")
- (when group
- (setq group (if (numberp group)
- (number-to-string group)
- (symbol-name group)))
- (let* ((str (buffer-substring
- (point) (progn (end-of-line) (point))))
- (charset
- (or (gnus-group-name-charset method group)
- (gnus-parameter-charset group)
- gnus-default-charset)))
- ;; Fixme: Don't decode in unibyte mode.
- ;; Double fixme: We're not in unibyte mode, are we?
- (when (and str charset)
- (setq str (decode-coding-string str charset)))
- (puthash group str gnus-description-hashtb)))
- (forward-line 1))))
+ (with-current-buffer nntp-server-buffer
+ (save-excursion ;;FIXME: Not sure if it's needed!
+ (save-restriction
+ (goto-char (point-min))
+ (when (or (search-forward "\n.\n" nil t)
+ (goto-char (point-max)))
+ (beginning-of-line)
+ (narrow-to-region (point-min) (point)))
+ ;; If these are groups from a foreign select method, we insert the
+ ;; group prefix in front of the group names.
+ (and method (not (inline
+ (gnus-server-equal
+ (gnus-server-get-method nil method)
+ (gnus-server-get-method
+ nil gnus-select-method))))
+ (let ((prefix (gnus-group-prefixed-name "" method)))
+ (goto-char (point-min))
+ (while (and (not (eobp))
+ (progn (insert prefix)
+ (zerop (forward-line 1)))))))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (setq group
+ (condition-case ()
+ (read nntp-server-buffer)
+ (error nil)))
+ (skip-chars-forward " \t")
+ (when group
+ (setq group (if (numberp group)
+ (number-to-string group)
+ (symbol-name group)))
+ (let* ((str (buffer-substring
+ (point) (progn (end-of-line) (point))))
+ (charset
+ (or (gnus-group-name-charset method group)
+ (gnus-parameter-charset group)
+ gnus-default-charset)))
+ ;; Fixme: Don't decode in unibyte mode.
+ ;; Double fixme: We're not in unibyte mode, are we?
+ (when (and str charset)
+ (setq str (decode-coding-string str charset)))
+ (puthash group str gnus-description-hashtb)))
+ (forward-line 1)))))
(gnus-message 5 "Reading descriptions file...done")
t))))
@@ -3162,7 +3155,7 @@ SPECIFIC-VARIABLES, or those in `gnus-variable-list'."
"Declare back end NAME with ABILITIES as a Gnus back end."
(setq gnus-valid-select-methods
(nconc gnus-valid-select-methods
- (list (apply 'list name abilities))))
+ (list (apply #'list name abilities))))
(gnus-redefine-select-method-widget))
(defun gnus-set-default-directory ()
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index b0f9ed4..456e7b0 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -3186,7 +3186,7 @@ The following commands are available:
;; Copy the global value of the variable.
(symbol-value (car local))
;; Use the value from the list.
- (eval (cdr local)))))
+ (eval (cdr local) t))))
(set (make-local-variable (car local)) global))
;; Simple nil-valued local variable.
(set (make-local-variable local) nil))))
@@ -3339,18 +3339,18 @@ article number."
,(or number
(inline-quote (gnus-summary-article-number)))))))
-(defmacro gnus-summary-thread-level (&optional number)
+(defsubst gnus-summary-thread-level (&optional number)
"Return the level of thread that starts with article NUMBER."
- `(if (and (eq gnus-summary-make-false-root 'dummy)
- (get-text-property (point) 'gnus-intangible))
- 0
- (gnus-data-level (gnus-data-find
- ,(or number '(gnus-summary-article-number))))))
+ (if (and (eq gnus-summary-make-false-root 'dummy)
+ (get-text-property (point) 'gnus-intangible))
+ 0
+ (gnus-data-level (gnus-data-find
+ (or number (gnus-summary-article-number))))))
-(defmacro gnus-summary-article-mark (&optional number)
+(defsubst gnus-summary-article-mark (&optional number)
"Return the mark of article NUMBER."
- `(gnus-data-mark (gnus-data-find
- ,(or number '(gnus-summary-article-number)))))
+ (gnus-data-mark (gnus-data-find
+ (or number (gnus-summary-article-number)))))
(defmacro gnus-summary-article-pos (&optional number)
"Return the position of the line of article NUMBER."
@@ -3850,7 +3850,7 @@ buffer that was in action when the last article was
fetched."
(condition-case ()
(put-text-property
(point)
- (progn (eval gnus-summary-line-format-spec) (point))
+ (progn (eval gnus-summary-line-format-spec t) (point))
'gnus-number gnus-tmp-number)
(error (gnus-message 5 "Error updating the summary line")))
(when (gnus-visual-p 'summary-highlight 'highlight)
@@ -3971,14 +3971,14 @@ Input should look like this: \"Sun, 14 Oct 2001
13:34:39 +0200\"."
(my-format "%b %d '%y"))
(let* ((difference (time-subtract now messy-date))
(templist gnus-user-date-format-alist)
- (top (eval (caar templist))))
+ (top (eval (caar templist) t)))
(while (if (numberp top) (time-less-p top difference) (not top))
(progn
(setq templist (cdr templist))
- (setq top (eval (caar templist)))))
+ (setq top (eval (caar templist) t))))
(if (stringp (cdr (car templist)))
(setq my-format (cdr (car templist)))))
- (format-time-string (eval my-format) messy-date))
+ (format-time-string (eval my-format t) messy-date))
(error " ? ")))
(defun gnus-summary-set-local-parameters (group)
@@ -3997,8 +3997,8 @@ Input should look like this: \"Sun, 14 Oct 2001 13:34:39
+0200\"."
;; buffer-local, whereas just parameters like `gcc-self',
;; `timestamp', etc. should not be bound as variables.
(if (boundp (car elem))
- (set (make-local-variable (car elem)) (eval (nth 1 elem)))
- (eval (nth 1 elem))))))))
+ (set (make-local-variable (car elem)) (eval (nth 1 elem) t))
+ (eval (nth 1 elem) t)))))))
(defun gnus-summary-read-group (group &optional show-all no-article
kill-buffer no-display backward
@@ -5557,7 +5557,7 @@ or a straight list of headers."
(setq gnus-tmp-thread thread)
(put-text-property
(point)
- (progn (eval gnus-summary-line-format-spec) (point))
+ (progn (eval gnus-summary-line-format-spec t) (point))
'gnus-number number)
(when gnus-visual-p
(forward-line -1)
@@ -6265,7 +6265,7 @@ If WHERE is `summary', the summary mode line format will
be used."
""))
bufname-length max-len
gnus-tmp-header) ;; passed as argument to any user-format-funcs
- (setq mode-string (eval mformat))
+ (setq mode-string (eval mformat t))
(setq bufname-length (if (string-match "%b" mode-string)
(- (length
(buffer-name
@@ -7863,7 +7863,7 @@ If BACKWARD, the previous article is selected instead of
the next."
(switch-to-buffer gnus-group-buffer)
(when group
(gnus-group-jump-to-group group))
- (eval (cadr (assq key keystrokes)))
+ (eval (cadr (assq key keystrokes)) t)
(setq group (gnus-group-group-name))
(switch-to-buffer obuf))
(setq ended nil))
@@ -10617,6 +10617,8 @@ confirmation before the articles are deleted."
(gnus-set-mode-line 'summary)
not-deleted))
+(defvar message-options-set-recipient)
+
(defun gnus-summary-edit-article (&optional arg)
"Edit the current article.
This will have permanent effect only in mail groups.
@@ -10674,31 +10676,32 @@ groups."
(setq mml-buffer-list mbl)
(setq-local mml-buffer-list mbl1))
(add-hook 'kill-buffer-hook #'mml-destroy-buffers t t))))
- `(lambda (no-highlight)
- (let ((mail-parse-charset ',gnus-newsgroup-charset)
- (message-options message-options)
- (message-options-set-recipient)
- (mail-parse-ignored-charsets
- ',gnus-newsgroup-ignored-charsets)
- (rfc2047-header-encoding-alist
- ',(let ((charset (gnus-group-name-charset
- (gnus-find-method-for-group
- gnus-newsgroup-name)
- gnus-newsgroup-name)))
- (append (list (cons "Newsgroups" charset)
- (cons "Followup-To" charset)
- (cons "Xref" charset))
- rfc2047-header-encoding-alist))))
- ,(if (not raw) '(progn
- (mml-to-mime)
- (mml-destroy-buffers)
- (remove-hook 'kill-buffer-hook
- #'mml-destroy-buffers t)
- (kill-local-variable 'mml-buffer-list)))
- (gnus-summary-edit-article-done
- ,(or (mail-header-references gnus-current-headers) "")
- ,(gnus-group-read-only-p)
- ,gnus-summary-buffer no-highlight))))))))
+ (let ((charset gnus-newsgroup-charset)
+ (ign-cs gnus-newsgroup-ignored-charsets)
+ (hea (let ((charset (gnus-group-name-charset
+ (gnus-find-method-for-group
+ gnus-newsgroup-name)
+ gnus-newsgroup-name)))
+ (append (list (cons "Newsgroups" charset)
+ (cons "Followup-To" charset)
+ (cons "Xref" charset))
+ rfc2047-header-encoding-alist)))
+ (gch (or (mail-header-references gnus-current-headers) ""))
+ (ro (gnus-group-read-only-p))
+ (buf gnus-summary-buffer))
+ (lambda (no-highlight)
+ (let ((mail-parse-charset charset)
+ (message-options message-options)
+ (message-options-set-recipient)
+ (mail-parse-ignored-charsets ign-cs)
+ (rfc2047-header-encoding-alist hea))
+ (unless raw
+ (mml-to-mime)
+ (mml-destroy-buffers)
+ (remove-hook 'kill-buffer-hook
+ #'mml-destroy-buffers t)
+ (kill-local-variable 'mml-buffer-list))
+ (gnus-summary-edit-article-done gch ro buf no-highlight)))))))))
(defalias 'gnus-summary-edit-article-postpone 'gnus-article-edit-exit)
@@ -12366,7 +12369,7 @@ save those articles instead."
;; Form.
(save-restriction
(widen)
- (setq result (eval match)))))
+ (setq result (eval match t)))))
(setq split-name (cdr method))
(cond ((stringp result)
(push (expand-file-name
@@ -12956,7 +12959,7 @@ treated as multipart/mixed."
(nomove "" nil nil ,keystroke)))
(let ((func (gnus-summary-make-marking-command-1
mark (car lway) lway name)))
- (setq func (eval func))
+ (setq func (eval func t))
(define-key map (nth 4 lway) func)))))
(defun gnus-summary-make-marking-command-1 (mark way lway name)
diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el
index 8a77c53..3253b78 100644
--- a/lisp/gnus/gnus-topic.el
+++ b/lisp/gnus/gnus-topic.el
@@ -1,4 +1,4 @@
-;;; gnus-topic.el --- a folding minor mode for Gnus group buffers
+;;; gnus-topic.el --- a folding minor mode for Gnus group buffers -*-
lexical-binding: t; -*-
;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
@@ -43,8 +43,7 @@
(defcustom gnus-topic-mode-hook nil
"Hook run in topic mode buffers."
- :type 'hook
- :group 'gnus-topic)
+ :type 'hook)
(defcustom gnus-topic-line-format "%i[ %(%{%n%}%) -- %A ]%v\n"
"Format of topic lines.
@@ -61,18 +60,15 @@ with some simple extensions.
General format specifiers can also be used.
See Info node `(gnus)Formatting Variables'."
:link '(custom-manual "(gnus)Formatting Variables")
- :type 'string
- :group 'gnus-topic)
+ :type 'string)
(defcustom gnus-topic-indent-level 2
"How much each subtopic should be indented."
- :type 'integer
- :group 'gnus-topic)
+ :type 'integer)
(defcustom gnus-topic-display-empty-topics t
"If non-nil, display the topic lines even of topics that have no unread
articles."
- :type 'boolean
- :group 'gnus-topic)
+ :type 'boolean)
;; Internal variables.
@@ -335,7 +331,7 @@ If RECURSIVE is t, return groups in its subtopics too."
(setq topology gnus-topic-topology
gnus-tmp-topics nil))
(push (caar topology) gnus-tmp-topics)
- (mapc 'gnus-topic-list (cdr topology))
+ (mapc #'gnus-topic-list (cdr topology))
gnus-tmp-topics)
;;; Topic parameter jazz
@@ -386,7 +382,7 @@ inheritance."
;; We probably have lots of nil elements here, so we remove them.
;; Probably faster than doing this "properly".
(delq nil (cons group-params-list
- (mapcar 'gnus-topic-parameters
+ (mapcar #'gnus-topic-parameters
(gnus-current-topics topic)))))
param out params)
;; Now we have all the parameters, so we go through them
@@ -445,7 +441,7 @@ If LOWEST is non-nil, list all newsgroups of level LOWEST
or higher."
(and (>= level gnus-level-zombie)
(<= lowest gnus-level-zombie)))
(gnus-group-prepare-flat-list-dead
- (setq gnus-zombie-list (sort gnus-zombie-list 'string<))
+ (setq gnus-zombie-list (sort gnus-zombie-list #'string<))
gnus-level-zombie ?Z
regexp))
@@ -453,7 +449,7 @@ If LOWEST is non-nil, list all newsgroups of level LOWEST
or higher."
(and (>= level gnus-level-killed)
(<= lowest gnus-level-killed)))
(gnus-group-prepare-flat-list-dead
- (setq gnus-killed-list (sort gnus-killed-list 'string<))
+ (setq gnus-killed-list (sort gnus-killed-list #'string<))
gnus-level-killed ?K regexp)
(when not-in-list
(unless gnus-killed-hashtb
@@ -631,7 +627,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))
@@ -644,7 +647,7 @@ articles in the topic and its subtopics."
(add-text-properties
(point)
(prog1 (1+ (point))
- (eval gnus-topic-line-format-spec))
+ (eval gnus-topic-line-format-spec t))
(list 'gnus-topic name
'gnus-topic-level level
'gnus-topic-unread unread
@@ -841,7 +844,7 @@ articles in the topic and its subtopics."
(pop topics)))
;; Go through all living groups and make sure that
;; they belong to some topic.
- (let* ((tgroups (apply 'append (mapcar 'cdr gnus-topic-alist)))
+ (let* ((tgroups (apply #'append (mapcar #'cdr gnus-topic-alist)))
(entry (last (assoc (caar gnus-topic-topology) gnus-topic-alist)))
(groups (cdr gnus-group-list)))
(dolist (group groups)
@@ -1128,21 +1131,21 @@ articles in the topic and its subtopics."
(when (gnus-visual-p 'topic-menu 'menu)
(gnus-topic-make-menu-bar))
(gnus-set-format 'topic t)
- (add-hook 'gnus-group-catchup-group-hook 'gnus-topic-update-topic)
+ (add-hook 'gnus-group-catchup-group-hook #'gnus-topic-update-topic)
(setq-local gnus-group-prepare-function
- 'gnus-group-prepare-topics)
+ #'gnus-group-prepare-topics)
(setq-local gnus-group-get-parameter-function
- 'gnus-group-topic-parameters)
+ #'gnus-group-topic-parameters)
(setq-local gnus-group-goto-next-group-function
- 'gnus-topic-goto-next-group)
+ #'gnus-topic-goto-next-group)
(setq-local gnus-group-indentation-function
- 'gnus-topic-group-indentation)
+ #'gnus-topic-group-indentation)
(setq-local gnus-group-update-group-function
- 'gnus-topic-update-topics-containing-group)
- (setq-local gnus-group-sort-alist-function 'gnus-group-sort-topic)
- (setq gnus-group-change-level-function 'gnus-topic-change-level)
- (setq gnus-goto-missing-group-function 'gnus-topic-goto-missing-group)
- (add-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist
+ #'gnus-topic-update-topics-containing-group)
+ (setq-local gnus-group-sort-alist-function #'gnus-group-sort-topic)
+ (setq gnus-group-change-level-function #'gnus-topic-change-level)
+ (setq gnus-goto-missing-group-function #'gnus-topic-goto-missing-group)
+ (add-hook 'gnus-check-bogus-groups-hook #'gnus-topic-clean-alist
nil 'local)
(setq gnus-topology-checked-p nil)
;; We check the topology.
@@ -1150,11 +1153,11 @@ articles in the topic and its subtopics."
(gnus-topic-check-topology)))
;; Remove topic infestation.
(unless gnus-topic-mode
- (remove-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic)
+ (remove-hook 'gnus-summary-exit-hook #'gnus-topic-update-topic)
(setq gnus-group-change-level-function nil)
- (remove-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist)
- (setq gnus-group-prepare-function 'gnus-group-prepare-flat)
- (setq gnus-group-sort-alist-function 'gnus-group-sort-flat))
+ (remove-hook 'gnus-check-bogus-groups-hook #'gnus-topic-clean-alist)
+ (setq gnus-group-prepare-function #'gnus-group-prepare-flat)
+ (setq gnus-group-sort-alist-function #'gnus-group-sort-flat))
(when (called-interactively-p 'any)
(gnus-group-list-groups))))
@@ -1213,7 +1216,7 @@ Also see `gnus-group-catchup'."
(inhibit-read-only t)
(gnus-group-marked groups))
(gnus-group-catchup-current)
- (mapcar 'gnus-topic-update-topics-containing-group groups)))))
+ (mapcar #'gnus-topic-update-topics-containing-group groups)))))
(defun gnus-topic-read-group (&optional all no-article group)
"Read news in this newsgroup.
@@ -1280,7 +1283,7 @@ When used interactively, PARENT will be the topic under
point."
If COPYP, copy the groups instead."
(interactive
(list current-prefix-arg
- (gnus-completing-read "Move to topic" (mapcar 'car gnus-topic-alist) t
+ (gnus-completing-read "Move to topic" (mapcar #'car gnus-topic-alist) t
nil 'gnus-topic-history)))
(let ((use-marked (and (not n) (not (and transient-mark-mode mark-active))
gnus-group-marked t))
@@ -1328,7 +1331,7 @@ 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-move-group n topic t))
(defun gnus-topic-kill-group (&optional n discard)
@@ -1422,7 +1425,7 @@ If PERMANENT, make it stay shown in subsequent sessions
as well."
(let ((topic
(gnus-topic-find-topology
(gnus-completing-read "Show topic"
- (mapcar 'car gnus-topic-alist) t))))
+ (mapcar #'car gnus-topic-alist) t))))
(setcar (cddr (cadr topic)) nil)
(setcar (cdr (cadr topic)) 'visible)
(gnus-group-list-groups)))))
@@ -1471,7 +1474,7 @@ If NON-RECURSIVE (which is the prefix) is t, don't unmark
its subtopics."
(nreverse
(list
(setq topic (gnus-completing-read "Move to topic"
- (mapcar 'car gnus-topic-alist) t))
+ (mapcar #'car gnus-topic-alist) t))
(read-string (format "Move to %s (regexp): " topic))))))
(gnus-group-mark-regexp regexp)
(gnus-topic-move-group nil topic copyp))
@@ -1605,8 +1608,8 @@ If performed on a topic, edit the topic parameters
instead."
(gnus-topic-parameters topic)
(format-message "Editing the topic parameters for `%s'."
(or group topic))
- `(lambda (form)
- (gnus-topic-set-parameters ,topic form)))))))
+ (lambda (form)
+ (gnus-topic-set-parameters topic form)))))))
(defun gnus-group-sort-topic (func reverse)
"Sort groups in the topics according to FUNC and REVERSE."
@@ -1690,9 +1693,8 @@ If REVERSE, sort in reverse order."
(defun gnus-topic-sort-topics-1 (top reverse)
(if (cdr top)
(let ((subtop
- (mapcar (gnus-byte-compile
- `(lambda (top)
- (gnus-topic-sort-topics-1 top ,reverse)))
+ (mapcar (lambda (top)
+ (gnus-topic-sort-topics-1 top reverse))
(sort (cdr top)
(lambda (t1 t2)
(string-lessp (caar t1) (caar t2)))))))
@@ -1704,7 +1706,7 @@ If REVERSE, sort in reverse order."
If REVERSE, reverse the sorting order."
(interactive
(list (gnus-completing-read "Sort topics in"
- (mapcar 'car gnus-topic-alist) t
+ (mapcar #'car gnus-topic-alist) t
(gnus-current-topic))
current-prefix-arg))
(let ((topic-topology (or (and topic (cdr (gnus-topic-find-topology topic)))
@@ -1719,7 +1721,7 @@ 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)))
(unless (and current to)
(error "Can't find topic"))
(let ((current-top (cdr (gnus-topic-find-topology current)))
diff --git a/lisp/gnus/gnus-undo.el b/lisp/gnus/gnus-undo.el
index b1c1fb8..64ed2bb 100644
--- a/lisp/gnus/gnus-undo.el
+++ b/lisp/gnus/gnus-undo.el
@@ -1,4 +1,4 @@
-;;; gnus-undo.el --- minor mode for undoing in Gnus
+;;; gnus-undo.el --- minor mode for undoing in Gnus -*- lexical-binding: t;
-*-
;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
@@ -52,8 +52,7 @@
(defcustom gnus-undo-limit 2000
"The number of undoable actions recorded."
- :type 'integer
- :group 'gnus-undo)
+ :type 'integer)
(defcustom gnus-undo-mode nil
;; FIXME: This is a buffer-local minor mode which requires running
@@ -61,13 +60,11 @@
;; doesn't seem very useful: setting it to non-nil via Customize
;; probably won't do the right thing.
"Minor mode for undoing in Gnus buffers."
- :type 'boolean
- :group 'gnus-undo)
+ :type 'boolean)
(defcustom gnus-undo-mode-hook nil
"Hook called in all `gnus-undo-mode' buffers."
- :type 'hook
- :group 'gnus-undo)
+ :type 'hook)
;;; Internal variables.
@@ -106,7 +103,7 @@
;; Set up the menu.
(when (gnus-visual-p 'undo-menu 'menu)
(gnus-undo-make-menu-bar))
- (add-hook 'post-command-hook 'gnus-undo-boundary nil t)))
+ (add-hook 'post-command-hook #'gnus-undo-boundary nil t)))
;;; Interface functions.
@@ -130,15 +127,10 @@
gnus-undo-boundary t))
(defun gnus-undo-register (form)
- "Register FORMS as something to be performed to undo a change.
-FORMS may use backtick quote syntax."
+ "Register FORMS as something to be performed to undo a change."
(when gnus-undo-mode
(gnus-undo-register-1
- `(lambda ()
- ,form))))
-
-(put 'gnus-undo-register 'lisp-indent-function 0)
-(put 'gnus-undo-register 'edebug-form-spec '(body))
+ `(lambda () ,form))))
(defun gnus-undo-register-1 (function)
"Register FUNCTION as something to be performed to undo a change."
@@ -161,23 +153,23 @@ FORMS may use backtick quote syntax."
;; We are not at a boundary...
(setq gnus-undo-boundary-inhibit t)))
-(defun gnus-undo (n)
+(defun gnus-undo (_n)
"Undo some previous changes in Gnus buffers.
-Repeat this command to undo more changes.
-A numeric argument serves as a repeat count."
+Repeat this command to undo more changes."
+ ;; FIXME: A numeric argument should serve as a repeat count.
(interactive "p")
(unless gnus-undo-mode
(error "Undoing is not enabled in this buffer"))
(message "%s" last-command)
- (when (or (not (eq last-command 'gnus-undo))
- (not gnus-undo-last))
+ (unless (and (eq last-command 'gnus-undo)
+ gnus-undo-last)
(setq gnus-undo-last gnus-undo-actions))
(let ((action (pop gnus-undo-last)))
(unless action
(error "Nothing further to undo"))
(setq gnus-undo-actions (delq action gnus-undo-actions))
(setq gnus-undo-boundary t)
- (mapc 'funcall action)))
+ (mapc #'funcall action)))
(provide 'gnus-undo)
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index de3c854..f80243c 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -1,4 +1,4 @@
-;;; gnus-util.el --- utility functions for Gnus
+;;; gnus-util.el --- utility functions for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
@@ -87,6 +87,7 @@ This is a compatibility function for different Emacsen."
(defmacro gnus-eval-in-buffer-window (buffer &rest forms)
"Pop to BUFFER, evaluate FORMS, and then return to the original window."
+ (declare (indent 1) (debug t))
(let ((tempvar (make-symbol "GnusStartBufferWindow"))
(w (make-symbol "w"))
(buf (make-symbol "buf")))
@@ -103,9 +104,6 @@ This is a compatibility function for different Emacsen."
,@forms)
(select-window ,tempvar)))))
-(put 'gnus-eval-in-buffer-window 'lisp-indent-function 1)
-(put 'gnus-eval-in-buffer-window 'edebug-form-spec '(form body))
-
(defsubst gnus-goto-char (point)
(and point (goto-char point)))
@@ -302,31 +300,28 @@ Symbols are also allowed; their print names are used
instead."
(defmacro gnus-local-set-keys (&rest plist)
"Set the keys in PLIST in the current keymap."
+ (declare (indent 1))
`(gnus-define-keys-1 (current-local-map) ',plist))
(defmacro gnus-define-keys (keymap &rest plist)
"Define all keys in PLIST in KEYMAP."
- `(gnus-define-keys-1 (quote ,keymap) (quote ,plist)))
+ (declare (indent 1))
+ `(gnus-define-keys-1 ,(if (symbolp keymap) keymap `',keymap) (quote ,plist)))
(defmacro gnus-define-keys-safe (keymap &rest plist)
"Define all keys in PLIST in KEYMAP without overwriting previous
definitions."
+ (declare (indent 1))
`(gnus-define-keys-1 (quote ,keymap) (quote ,plist) t))
-(put 'gnus-define-keys 'lisp-indent-function 1)
-(put 'gnus-define-keys-safe 'lisp-indent-function 1)
-(put 'gnus-local-set-keys 'lisp-indent-function 1)
-
(defmacro gnus-define-keymap (keymap &rest plist)
"Define all keys in PLIST in KEYMAP."
+ (declare (indent 1))
`(gnus-define-keys-1 ,keymap (quote ,plist)))
-(put 'gnus-define-keymap 'lisp-indent-function 1)
-
(defun gnus-define-keys-1 (keymap plist &optional safe)
(when (null keymap)
(error "Can't set keys in a null keymap"))
- (cond ((symbolp keymap)
- (setq keymap (symbol-value keymap)))
+ (cond ((symbolp keymap) (error "First arg should be a keymap object"))
((keymapp keymap))
((listp keymap)
(set (car keymap) nil)
@@ -450,7 +445,7 @@ displayed in the echo area."
`(let (str time)
(cond ((eq gnus-add-timestamp-to-message 'log)
(setq str (let (message-log-max)
- (apply 'message ,format-string ,args)))
+ (apply #'message ,format-string ,args)))
(when (and message-log-max
(> message-log-max 0)
(/= (length str) 0))
@@ -476,7 +471,7 @@ displayed in the echo area."
(message "%s" (concat ,timestamp str))
str))
(t
- (apply 'message ,format-string ,args)))))))
+ (apply #'message ,format-string ,args)))))))
(defvar gnus-action-message-log nil)
@@ -496,8 +491,8 @@ inside loops."
(if (<= level gnus-verbose)
(let ((message
(if gnus-add-timestamp-to-message
- (apply 'gnus-message-with-timestamp args)
- (apply 'message args))))
+ (apply #'gnus-message-with-timestamp args)
+ (apply #'message args))))
(when (and (consp gnus-action-message-log)
(<= level 3))
(push message gnus-action-message-log))
@@ -518,7 +513,7 @@ inside loops."
"Beep an error if LEVEL is equal to or less than `gnus-verbose'.
ARGS are passed to `message'."
(when (<= (floor level) gnus-verbose)
- (apply 'message args)
+ (apply #'message args)
(ding)
(let (duration)
(when (and (floatp level)
@@ -686,6 +681,8 @@ yield \"nnimap:yxa\"."
(define-key (symbol-value (intern (format "gnus-%s-mode-map" type)))
[menu-bar edit] 'undefined))
+(defvar print-string-length)
+
(defmacro gnus-bind-print-variables (&rest forms)
"Bind print-* variables and evaluate FORMS.
This macro is used with `prin1', `pp', etc. in order to ensure
@@ -856,64 +853,10 @@ the user are disabled, it is recommended that only the
most minimal
operations are performed by FORMS. If you wish to assign many
complicated values atomically, compute the results into temporary
variables and then do only the assignment atomically."
+ (declare (indent 0) (debug t))
`(let ((inhibit-quit gnus-atomic-be-safe))
,@forms))
-(put 'gnus-atomic-progn 'lisp-indent-function 0)
-
-(defmacro gnus-atomic-progn-assign (protect &rest forms)
- "Evaluate FORMS, but ensure that the variables listed in PROTECT
-are not changed if anything in FORMS signals an error or otherwise
-non-locally exits. The variables listed in PROTECT are updated atomically.
-It is safe to use gnus-atomic-progn-assign with long computations.
-
-Note that if any of the symbols in PROTECT were unbound, they will be
-set to nil on a successful assignment. In case of an error or other
-non-local exit, it will still be unbound."
- (let* ((temp-sym-map (mapcar (lambda (x) (list (make-symbol
- (concat (symbol-name x)
- "-tmp"))
- x))
- protect))
- (sym-temp-map (mapcar (lambda (x) (list (cadr x) (car x)))
- temp-sym-map))
- (temp-sym-let (mapcar (lambda (x) (list (car x)
- `(and (boundp ',(cadr x))
- ,(cadr x))))
- temp-sym-map))
- (sym-temp-let sym-temp-map)
- (temp-sym-assign (apply 'append temp-sym-map))
- (sym-temp-assign (apply 'append sym-temp-map))
- (result (make-symbol "result-tmp")))
- `(let (,@temp-sym-let
- ,result)
- (let ,sym-temp-let
- (setq ,result (progn ,@forms))
- (setq ,@temp-sym-assign))
- (let ((inhibit-quit gnus-atomic-be-safe))
- (setq ,@sym-temp-assign))
- ,result)))
-
-(put 'gnus-atomic-progn-assign 'lisp-indent-function 1)
-;(put 'gnus-atomic-progn-assign 'edebug-form-spec '(sexp body))
-
-(defmacro gnus-atomic-setq (&rest pairs)
- "Similar to setq, except that the real symbols are only assigned when
-there are no errors. And when the real symbols are assigned, they are
-done so atomically. If other variables might be changed via side-effect,
-see gnus-atomic-progn-assign. It is safe to use gnus-atomic-setq
-with potentially long computations."
- (let ((tpairs pairs)
- syms)
- (while tpairs
- (push (car tpairs) syms)
- (setq tpairs (cddr tpairs)))
- `(gnus-atomic-progn-assign ,syms
- (setq ,@pairs))))
-
-;(put 'gnus-atomic-setq 'edebug-form-spec '(body))
-
-
;;; Functions for saving to babyl/mail files.
(require 'rmail)
@@ -1112,19 +1055,24 @@ ARG is passed to the first function."
(defun gnus-run-hooks (&rest funcs)
"Does the same as `run-hooks', but saves the current buffer."
(save-current-buffer
- (apply 'run-hooks funcs)))
+ (apply #'run-hooks funcs)))
(defun gnus-run-hook-with-args (hook &rest args)
"Does the same as `run-hook-with-args', but saves the current buffer."
(save-current-buffer
- (apply 'run-hook-with-args hook args)))
+ (apply #'run-hook-with-args hook args)))
(defun gnus-run-mode-hooks (&rest funcs)
"Run `run-mode-hooks', saving the current buffer."
- (save-current-buffer (apply 'run-mode-hooks funcs)))
+ (save-current-buffer (apply #'run-mode-hooks funcs)))
;;; 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."
@@ -1197,6 +1145,7 @@ ARG is passed to the first function."
;; Fixme: Why not use `with-output-to-temp-buffer'?
(defmacro gnus-with-output-to-file (file &rest body)
+ (declare (indent 1) (debug t))
(let ((buffer (make-symbol "output-buffer"))
(size (make-symbol "output-buffer-size"))
(leng (make-symbol "output-buffer-length"))
@@ -1219,9 +1168,6 @@ ARG is passed to the first function."
(write-region (substring ,buffer 0 ,leng) nil ,file
,append 'no-msg))))))
-(put 'gnus-with-output-to-file 'lisp-indent-function 1)
-(put 'gnus-with-output-to-file 'edebug-form-spec '(form body))
-
(defun gnus-add-text-properties-when
(property value start end properties &optional object)
"Like `add-text-properties', only applied on where PROPERTY is VALUE."
@@ -1264,9 +1210,7 @@ ARG is passed to the first function."
(string-equal (downcase x) (downcase y)))))
(defcustom gnus-use-byte-compile t
- "If non-nil, byte-compile crucial run-time code.
-Setting it to nil has no effect after the first time `gnus-byte-compile'
-is run."
+ "If non-nil, byte-compile crucial run-time code."
:type 'boolean
:version "22.1"
:group 'gnus-various)
@@ -1274,13 +1218,8 @@ is run."
(defun gnus-byte-compile (form)
"Byte-compile FORM if `gnus-use-byte-compile' is non-nil."
(if gnus-use-byte-compile
- (progn
- (require 'bytecomp)
- (defalias 'gnus-byte-compile
- (lambda (form)
- (let ((byte-compile-warnings '(unresolved callargs redefine)))
- (byte-compile form))))
- (gnus-byte-compile form))
+ (let ((byte-compile-warnings '(unresolved callargs redefine)))
+ (byte-compile form))
form))
(defun gnus-remassoc (key alist)
@@ -1300,16 +1239,19 @@ sure of changing the value of `foo'."
(cons (cons key value) (gnus-remassoc key alist))
(gnus-remassoc key alist)))
+(defvar gnus-info-buffer)
+(declare-function gnus-configure-windows "gnus-win" (setting &optional force))
+
(defun gnus-create-info-command (node)
"Create a command that will go to info NODE."
- `(lambda ()
- (interactive)
- ,(concat "Enter the info system at node " node)
- (Info-goto-node ,node)
- (setq gnus-info-buffer (current-buffer))
- (gnus-configure-windows 'info)))
-
-(defun gnus-not-ignore (&rest args)
+ (lambda ()
+ (:documentation (format "Enter the info system at node %s." node))
+ (interactive)
+ (info node)
+ (setq gnus-info-buffer (current-buffer))
+ (gnus-configure-windows 'info)))
+
+(defun gnus-not-ignore (&rest _args)
t)
(defvar gnus-directory-sep-char-regexp "/"
@@ -1358,7 +1300,7 @@ REJECT-NEWLINES is nil, remove them; otherwise raise an
error.
If LINE-LENGTH is set and the string (or any line in the string
if REJECT-NEWLINES is nil) is longer than that number, raise an
error. Common line length for input characters are 76 plus CRLF
-(RFC 2045 MIME), 64 plus CRLF (RFC 1421 PEM), and 1000 including
+\(RFC 2045 MIME), 64 plus CRLF (RFC 1421 PEM), and 1000 including
CRLF (RFC 5321 SMTP).
If NOCHECK, don't check anything, but just repad."
@@ -1416,7 +1358,7 @@ SPEC is a predicate specifier that contains stuff like
`or', `and',
`(,spec elem))
((listp spec)
(if (memq (car spec) '(or and not))
- `(,(car spec) ,@(mapcar 'gnus-make-predicate-1 (cdr spec)))
+ `(,(car spec) ,@(mapcar #'gnus-make-predicate-1 (cdr spec)))
(error "Invalid predicate specifier: %s" spec)))))
(defun gnus-completing-read (prompt collection &optional require-match
@@ -1446,8 +1388,10 @@ SPEC is a predicate specifier that contains stuff like
`or', `and',
(declare-function iswitchb-read-buffer "iswitchb"
(prompt &optional default require-match
_predicate start matches-set))
+(declare-function iswitchb-minibuffer-setup "iswitchb")
(defvar iswitchb-temp-buflist)
(defvar iswitchb-mode)
+(defvar iswitchb-make-buflist-hook)
(defun gnus-iswitchb-completing-read (prompt collection &optional require-match
initial-input history def)
@@ -1468,16 +1412,14 @@ SPEC is a predicate specifier that contains stuff like
`or', `and',
(unwind-protect
(progn
(or iswitchb-mode
- (add-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup))
+ (add-hook 'minibuffer-setup-hook #'iswitchb-minibuffer-setup))
(iswitchb-read-buffer prompt def require-match))
(or iswitchb-mode
- (remove-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup)))))
-
-(put 'gnus-parse-without-error 'lisp-indent-function 0)
-(put 'gnus-parse-without-error 'edebug-form-spec '(body))
+ (remove-hook 'minibuffer-setup-hook #'iswitchb-minibuffer-setup)))))
(defmacro gnus-parse-without-error (&rest body)
"Allow continuing onto the next line even if an error occurs."
+ (declare (indent 0) (debug t))
`(while (not (eobp))
(condition-case ()
(progn
@@ -1512,7 +1454,8 @@ CHOICE is a list of the choice char and help message at
IDX."
prompt
(concat
(mapconcat (lambda (s) (char-to-string (car s)))
- choice ", ") ", ?"))
+ choice ", ")
+ ", ?"))
(setq tchar (read-char))
(when (not (assq tchar choice))
(setq tchar nil)
@@ -1568,7 +1511,7 @@ Return nil otherwise."
(defvar tool-bar-mode)
-(defun gnus-tool-bar-update (&rest ignore)
+(defun gnus-tool-bar-update (&rest _ignore)
"Update the tool bar."
(when (and (boundp 'tool-bar-mode)
tool-bar-mode)
@@ -1594,7 +1537,7 @@ sequence, this is like `mapcar'. With several, it is
like the Common Lisp
(if seqs2_n
(let* ((seqs (cons seq1 seqs2_n))
(cnt 0)
- (heads (mapcar (lambda (seq)
+ (heads (mapcar (lambda (_seq)
(make-symbol (concat "head"
(int-to-string
(setq cnt (1+ cnt))))))
@@ -1628,7 +1571,7 @@ sequence, this is like `mapcar'. With several, it is
like the Common Lisp
((memq 'type lst)
(symbol-name system-type))
(t nil)))
- codename)
+ ) ;; codename
(cond
((not (memq 'emacs lst))
nil)
@@ -1644,9 +1587,9 @@ sequence, this is like `mapcar'. With several, it is
like the Common Lisp
empty directories from OLD-PATH."
(when (file-exists-p old-path)
(let* ((old-dir (file-name-directory old-path))
- (old-name (file-name-nondirectory old-path))
+ ;; (old-name (file-name-nondirectory old-path))
(new-dir (file-name-directory new-path))
- (new-name (file-name-nondirectory new-path))
+ ;; (new-name (file-name-nondirectory new-path))
temp)
(gnus-make-directory new-dir)
(rename-file old-path new-path t)
@@ -1747,7 +1690,7 @@ lists of strings."
(setq props (plist-put props :foreground (face-foreground face)))
(setq props (plist-put props :background (face-background face))))
(ignore-errors
- (apply 'create-image file type data-p props))))
+ (apply #'create-image file type data-p props))))
(defun gnus-put-image (glyph &optional string category)
(let ((point (point)))
diff --git a/lisp/gnus/gnus-uu.el b/lisp/gnus/gnus-uu.el
index db0ffc6..32a8785 100644
--- a/lisp/gnus/gnus-uu.el
+++ b/lisp/gnus/gnus-uu.el
@@ -1,4 +1,4 @@
-;;; gnus-uu.el --- extract (uu)encoded files in Gnus
+;;; gnus-uu.el --- extract (uu)encoded files in Gnus -*- lexical-binding: t;
-*-
;; Copyright (C) 1985-1987, 1993-1998, 2000-2021 Free Software
;; Foundation, Inc.
@@ -356,7 +356,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")
- (gnus-uu-decode-with-method 'gnus-uu-uustrip-article n))
+ (gnus-uu-decode-with-method #'gnus-uu-uustrip-article n))
(defun gnus-uu-decode-uu-and-save (n dir)
"Decodes and saves the resulting file."
@@ -366,12 +366,12 @@ didn't work, and overwrite existing files. Otherwise,
ask each time."
(read-directory-name "Uudecode and save in dir: "
gnus-uu-default-dir
gnus-uu-default-dir t))))
- (gnus-uu-decode-with-method 'gnus-uu-uustrip-article n dir nil nil t))
+ (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")
- (gnus-uu-decode-with-method 'gnus-uu-unshar-article n nil nil 'scan t))
+ (gnus-uu-decode-with-method #'gnus-uu-unshar-article n nil nil 'scan t))
(defun gnus-uu-decode-unshar-and-save (n dir)
"Unshars and saves the current article."
@@ -381,7 +381,7 @@ didn't work, and overwrite existing files. Otherwise, ask
each time."
(read-directory-name "Unshar and save in dir: "
gnus-uu-default-dir
gnus-uu-default-dir t))))
- (gnus-uu-decode-with-method 'gnus-uu-unshar-article n dir nil 'scan t))
+ (gnus-uu-decode-with-method #'gnus-uu-unshar-article n dir nil 'scan t))
(defun gnus-uu-decode-save (n file)
"Saves the current article."
@@ -393,7 +393,7 @@ didn't work, and overwrite existing files. Otherwise, ask
each time."
(read-file-name
"Save article in file: " gnus-uu-default-dir gnus-uu-default-dir))))
(setq gnus-uu-saved-article-name file)
- (gnus-uu-decode-with-method 'gnus-uu-save-article n nil t))
+ (gnus-uu-decode-with-method #'gnus-uu-save-article n nil t))
(defun gnus-uu-decode-binhex (n dir)
"Unbinhexes the current article."
@@ -406,7 +406,7 @@ didn't work, and overwrite existing files. Otherwise, ask
each time."
(gnus-uu-initialize)
(setq gnus-uu-binhex-article-name
(make-temp-file (expand-file-name "binhex" gnus-uu-work-dir)))
- (gnus-uu-decode-with-method 'gnus-uu-binhex-article n dir))
+ (gnus-uu-decode-with-method #'gnus-uu-binhex-article n dir))
(defun gnus-uu-decode-yenc (n dir)
"Decode the yEnc-encoded current article."
@@ -417,7 +417,7 @@ didn't work, and overwrite existing files. Otherwise, ask
each time."
gnus-uu-default-dir
gnus-uu-default-dir))))
(setq gnus-uu-yenc-article-name nil)
- (gnus-uu-decode-with-method 'gnus-uu-yenc-article n dir nil t))
+ (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."
@@ -729,7 +729,7 @@ When called interactively, prompt for REGEXP."
(defun gnus-uu-decode-postscript (&optional n)
"Gets PostScript of the current article."
(interactive "P")
- (gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article n))
+ (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."
@@ -745,7 +745,7 @@ When called interactively, prompt for REGEXP."
(read-directory-name "Save in dir: "
gnus-uu-default-dir
gnus-uu-default-dir t))))
- (gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article
+ (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)
@@ -977,7 +977,7 @@ When called interactively, prompt for REGEXP."
(defvar gnus-uu-binhex-end-line
":$")
-(defun gnus-uu-binhex-article (buffer in-state)
+(defun gnus-uu-binhex-article (buffer _in-state)
(let (state start-char)
(with-current-buffer buffer
(widen)
@@ -1014,11 +1014,11 @@ When called interactively, prompt for REGEXP."
;; yEnc
-(defun gnus-uu-yenc-article (buffer in-state)
+(defun gnus-uu-yenc-article (_buffer _in-state)
(with-current-buffer gnus-original-article-buffer
(widen)
(let ((file-name (yenc-extract-filename))
- state start-char)
+ state) ;; start-char
(when (not file-name)
(setq state (list 'wrong-type)))
@@ -1046,7 +1046,7 @@ When called interactively, prompt for REGEXP."
;; PostScript
-(defun gnus-uu-decode-postscript-article (process-buffer in-state)
+(defun gnus-uu-decode-postscript-article (process-buffer _in-state)
(let ((state (list 'ok))
start-char end-char file-name)
(with-current-buffer process-buffer
@@ -1196,11 +1196,11 @@ When called interactively, prompt for REGEXP."
;; Expand numbers, sort, and return the list of article
;; numbers.
- (mapcar 'cdr
+ (mapcar #'cdr
(sort (gnus-uu-expand-numbers
list-of-subjects
(not do-not-translate))
- 'gnus-uu-string<))))))
+ #'gnus-uu-string<))))))
(defun gnus-uu-expand-numbers (string-list &optional translate)
;; Takes a list of strings and "expands" all numbers in all the
@@ -1278,13 +1278,15 @@ When called interactively, prompt for REGEXP."
(when dont-unmark-last-article
(setq gnus-uu-has-been-grabbed (list art))))))
+(defvar gnus-asynchronous)
+
;; This function takes a list of articles and a function to apply to
;; each article grabbed.
;;
;; This function returns a list of files decoded if the grabbing and
;; the process-function has been successful and nil otherwise.
(defun gnus-uu-grab-articles (articles process-function
- &optional sloppy limit no-errors)
+ &optional sloppy limit _no-errors)
(require 'gnus-async)
(let ((state 'first)
(gnus-asynchronous nil)
@@ -1452,10 +1454,10 @@ When called interactively, prompt for REGEXP."
(setq subject (substring subject (match-end 0)))))
(or part "")))
-(defun gnus-uu-uudecode-sentinel (process event)
+(defun gnus-uu-uudecode-sentinel (process _event)
(delete-process (get-process process)))
-(defun gnus-uu-uustrip-article (process-buffer in-state)
+(defun gnus-uu-uustrip-article (process-buffer _in-state)
;; Uudecodes a file asynchronously.
(with-current-buffer process-buffer
(let ((state (list 'wrong-type))
@@ -1576,7 +1578,7 @@ Gnus might fail to display all of it.")
;; This function is used by `gnus-uu-grab-articles' to treat
;; a shared article.
-(defun gnus-uu-unshar-article (process-buffer in-state)
+(defun gnus-uu-unshar-article (process-buffer _in-state)
(let ((state (list 'ok))
start-char)
(with-current-buffer process-buffer
@@ -1830,8 +1832,8 @@ Gnus might fail to display all of it.")
;; Initializing
-(add-hook 'gnus-summary-prepare-exit-hook 'gnus-uu-clean-up)
-(add-hook 'gnus-summary-prepare-exit-hook 'gnus-uu-delete-work-dir)
+(add-hook 'gnus-summary-prepare-exit-hook #'gnus-uu-clean-up)
+(add-hook 'gnus-summary-prepare-exit-hook #'gnus-uu-delete-work-dir)
@@ -1949,6 +1951,7 @@ The user will be asked for a file name."
(gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list)
file-name))
(insert (format "Content-Transfer-Encoding: %s\n\n" encoding))
+ ;; FIXME: Shouldn't we set-buffer before saving the restriction? --Stef
(save-restriction
(set-buffer gnus-message-buffer)
(goto-char (point-min))
diff --git a/lisp/gnus/gnus-vm.el b/lisp/gnus/gnus-vm.el
index 533b1e2..b7e6b2a 100644
--- a/lisp/gnus/gnus-vm.el
+++ b/lisp/gnus/gnus-vm.el
@@ -1,4 +1,4 @@
-;;; gnus-vm.el --- vm interface for Gnus
+;;; gnus-vm.el --- vm interface for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1994-2021 Free Software Foundation, Inc.
diff --git a/lisp/gnus/gnus-win.el b/lisp/gnus/gnus-win.el
index 3fb8e46..8ac4e39 100644
--- a/lisp/gnus/gnus-win.el
+++ b/lisp/gnus/gnus-win.el
@@ -1,4 +1,4 @@
-;;; gnus-win.el --- window configuration functions for Gnus
+;;; gnus-win.el --- window configuration functions for Gnus -*-
lexical-binding: t; -*-
;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
@@ -36,7 +36,6 @@
(defcustom gnus-use-full-window t
"If non-nil, use the entire Emacs screen."
- :group 'gnus-windows
:type 'boolean)
(defcustom gnus-use-atomic-windows nil
@@ -46,17 +45,14 @@
(defcustom gnus-window-min-width 2
"Minimum width of Gnus buffers."
- :group 'gnus-windows
:type 'integer)
(defcustom gnus-window-min-height 1
"Minimum height of Gnus buffers."
- :group 'gnus-windows
:type 'integer)
(defcustom gnus-always-force-window-configuration nil
"If non-nil, always force the Gnus window configurations."
- :group 'gnus-windows
:type 'boolean)
(defcustom gnus-use-frames-on-any-display nil
@@ -64,7 +60,6 @@
When nil, only frames on the same display as the selected frame will be
used to display Gnus windows."
:version "22.1"
- :group 'gnus-windows
:type 'boolean)
(defvar gnus-buffer-configuration
@@ -202,7 +197,6 @@ See the Gnus manual for an explanation of the syntax used.")
(defcustom gnus-configure-windows-hook nil
"A hook called when configuring windows."
:version "22.1"
- :group 'gnus-windows
:type 'hook)
;;; Internal variables.
@@ -252,7 +246,7 @@ See the Gnus manual for an explanation of the syntax used.")
;; return a new SPLIT.
(while (and (not (assq (car split) gnus-window-to-buffer))
(symbolp (car split)) (fboundp (car split)))
- (setq split (eval split)))
+ (setq split (eval split t)))
(let* ((type (car split))
(subs (cddr split))
(len (if (eq type 'horizontal) (window-width) (window-height)))
@@ -329,7 +323,7 @@ See the Gnus manual for an explanation of the syntax used.")
(setq sub (append (pop subs) nil))
(while (and (not (assq (car sub) gnus-window-to-buffer))
(symbolp (car sub)) (fboundp (car sub)))
- (setq sub (eval sub)))
+ (setq sub (eval sub t)))
(when sub
(push sub comp-subs)
(setq size (cadar comp-subs))
@@ -477,7 +471,7 @@ should have point."
;; return a new SPLIT.
(while (and (not (assq (car split) gnus-window-to-buffer))
(symbolp (car split)) (fboundp (car split)))
- (setq split (eval split)))
+ (setq split (eval split t)))
(setq type (elt split 0))
(cond
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index 91ab878..e8e5629 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -3212,9 +3212,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 +3273,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)
@@ -3501,7 +3500,7 @@ You should probably use `gnus-find-method-for-group'
instead."
(while (setq info (pop alist))
(when (gnus-server-equal (gnus-info-method info) server)
(push (gnus-info-group info) groups)))
- (sort groups 'string<)))
+ (sort groups #'string<)))
(defun gnus-group-foreign-p (group)
"Say whether a group is foreign or not."
@@ -3724,7 +3723,7 @@ just the host name."
depth (+ depth 1)))
depth))))
;; Separate foreign select method from group name and collapse.
- ;; If method contains a server, collapse to non-domain server name,
+ ;; If method contains a server, collapse to non-domain server name,
;; otherwise collapse to select method.
(let* ((colon (string-match ":" group))
(server (and colon (substring group 0 colon)))
diff --git a/lisp/gnus/gssapi.el b/lisp/gnus/gssapi.el
index 20562fb..6ff2a4e 100644
--- a/lisp/gnus/gssapi.el
+++ b/lisp/gnus/gssapi.el
@@ -1,4 +1,4 @@
-;;; gssapi.el --- GSSAPI/Kerberos 5 interface for Emacs
+;;; gssapi.el --- GSSAPI/Kerberos 5 interface for Emacs -*- lexical-binding:
t; -*-
;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
diff --git a/lisp/gnus/legacy-gnus-agent.el b/lisp/gnus/legacy-gnus-agent.el
index b47e69f..091e389 100644
--- a/lisp/gnus/legacy-gnus-agent.el
+++ b/lisp/gnus/legacy-gnus-agent.el
@@ -1,4 +1,4 @@
-;;; gnus-agent.el --- Legacy unplugged support for Gnus
+;;; gnus-agent.el --- Legacy unplugged support for Gnus -*- lexical-binding:
t; -*-
;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
@@ -210,7 +210,7 @@ converted to the compressed format."
;; Therefore, hide the default prompt.
(gnus-convert-mark-converter-prompt 'gnus-agent-unlist-expire-days t)
-(defun gnus-agent-unhook-expire-days (converting-to)
+(defun gnus-agent-unhook-expire-days (_converting-to)
"Remove every lambda from `gnus-group-prepare-hook' that mention the
symbol `gnus-agent-do-once' in their definition. This should NOT be
necessary as gnus-agent.el no longer adds them. However, it is
diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el
index 5247019..af0a198 100644
--- a/lisp/gnus/mail-source.el
+++ b/lisp/gnus/mail-source.el
@@ -1,4 +1,4 @@
-;;; mail-source.el --- functions for fetching mail
+;;; mail-source.el --- functions for fetching mail -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
@@ -56,7 +56,6 @@
"Where the mail backends will look for incoming mail.
This variable is a list of mail source specifiers.
See Info node `(gnus)Mail Source Specifiers'."
- :group 'mail-source
:version "24.4"
:link '(custom-manual "(gnus)Mail Source Specifiers")
:type `(choice
@@ -230,33 +229,27 @@ Leave mails for this many days" :value 14)))))
If nil, the user will be prompted when an error occurs. If non-nil,
the error will be ignored."
:version "22.1"
- :group 'mail-source
:type 'boolean)
(defcustom mail-source-primary-source nil
"Primary source for incoming mail.
If non-nil, this maildrop will be checked periodically for new mail."
- :group 'mail-source
:type 'sexp)
(defcustom mail-source-flash t
"If non-nil, flash periodically when mail is available."
- :group 'mail-source
:type 'boolean)
(defcustom mail-source-crash-box "~/.emacs-mail-crash-box"
"File where mail will be stored while processing it."
- :group 'mail-source
:type 'file)
(defcustom mail-source-directory message-directory
"Directory where incoming mail source files (if any) will be stored."
- :group 'mail-source
:type 'directory)
(defcustom mail-source-default-file-modes 384
"Set the mode bits of all new mail files to this integer."
- :group 'mail-source
:type 'integer)
(defcustom mail-source-delete-incoming
@@ -270,7 +263,6 @@ Removing of old files happens in `mail-source-callback',
i.e. no
old incoming files will be deleted unless you receive new mail.
You may also set this variable to nil and call
`mail-source-delete-old-incoming' interactively."
- :group 'mail-source
:version "22.2" ;; No Gnus / Gnus 5.10.10 (default changed)
:type '(choice (const :tag "immediately" t)
(const :tag "never" nil)
@@ -281,28 +273,23 @@ You may also set this variable to nil and call
This variable only applies when `mail-source-delete-incoming' is a positive
number."
:version "22.2" ;; No Gnus / Gnus 5.10.10 (default changed)
- :group 'mail-source
:type 'boolean)
(defcustom mail-source-incoming-file-prefix "Incoming"
"Prefix for file name for storing incoming mail."
- :group 'mail-source
:type 'string)
(defcustom mail-source-report-new-mail-interval 5
"Interval in minutes between checks for new mail."
- :group 'mail-source
:type 'number)
(defcustom mail-source-idle-time-delay 5
"Number of idle seconds to wait before checking for new mail."
- :group 'mail-source
:type 'number)
(defcustom mail-source-movemail-program "movemail"
"If non-nil, name of program for fetching new mail."
:version "26.2"
- :group 'mail-source
:type '(choice (const nil) string))
;;; Internal variables.
@@ -393,13 +380,10 @@ All keywords that can be used must be listed here."))
;; suitable for usage in a `let' form
(eval-and-compile
(defun mail-source-bind-1 (type)
- (let* ((defaults (cdr (assq type mail-source-keyword-map)))
- default bind)
- (while (setq default (pop defaults))
- (push (list (mail-source-strip-keyword (car default))
- nil)
- bind))
- bind)))
+ (mapcar (lambda (default)
+ (list (mail-source-strip-keyword (car default))
+ nil))
+ (cdr (assq type mail-source-keyword-map)))))
(defmacro mail-source-bind (type-source &rest body)
"Return a `let' form that binds all variables in source TYPE.
@@ -418,18 +402,20 @@ of the second `let' form.
The variables bound and their default values are described by
the `mail-source-keyword-map' variable."
- `(let* ,(mail-source-bind-1 (car type-source))
- (mail-source-set-1 ,(cadr type-source))
- ,@body))
-
-(put 'mail-source-bind 'lisp-indent-function 1)
-(put 'mail-source-bind 'edebug-form-spec '(sexp body))
+ (declare (indent 1) (debug (sexp body)))
+ ;; FIXME: Use lexical vars, i.e. don't initialize the vars inside
+ ;; `mail-source-set-1' via `set'.
+ (let ((bindings (mail-source-bind-1 (car type-source))))
+ `(with-suppressed-warnings ((lexical ,@(mapcar #'car bindings)))
+ (dlet ,bindings
+ (mail-source-set-1 ,(cadr type-source))
+ ,@body))))
(defun mail-source-set-1 (source)
(let* ((type (pop source))
(defaults (cdr (assq type mail-source-keyword-map)))
(search '(:max 1))
- found default value keyword auth-info user-auth pass-auth)
+ found default value keyword user-auth pass-auth) ;; auth-info
;; append to the search the useful info from the source and the defaults:
;; user, host, and port
@@ -463,21 +449,23 @@ the `mail-source-keyword-map' variable."
(cond
((and
(eq keyword :user)
- (setq user-auth (plist-get
- ;; cache the search result in `found'
- (or found
- (setq found (nth 0 (apply 'auth-source-search
- search))))
- :user)))
+ (setq user-auth
+ (plist-get
+ ;; cache the search result in `found'
+ (or found
+ (setq found (nth 0 (apply #'auth-source-search
+ search))))
+ :user)))
user-auth)
((and
(eq keyword :password)
- (setq pass-auth (plist-get
- ;; cache the search result in `found'
- (or found
- (setq found (nth 0 (apply
'auth-source-search
- search))))
- :secret)))
+ (setq pass-auth
+ (plist-get
+ ;; cache the search result in `found'
+ (or found
+ (setq found (nth 0 (apply #'auth-source-search
+ search))))
+ :secret)))
;; maybe set the password to the return of the :secret function
(if (functionp pass-auth)
(setq pass-auth (funcall pass-auth))
@@ -488,20 +476,16 @@ the `mail-source-keyword-map' variable."
(eval-and-compile
(defun mail-source-bind-common-1 ()
- (let* ((defaults mail-source-common-keyword-map)
- default bind)
- (while (setq default (pop defaults))
- (push (list (mail-source-strip-keyword (car default))
- nil)
- bind))
- bind)))
+ (mapcar (lambda (default)
+ (list (mail-source-strip-keyword (car default))
+ nil))
+ mail-source-common-keyword-map)))
(defun mail-source-set-common-1 (source)
(let* ((type (pop source))
- (defaults mail-source-common-keyword-map)
(defaults-1 (cdr (assq type mail-source-keyword-map)))
- default value keyword)
- (while (setq default (pop defaults))
+ value keyword)
+ (dolist (default mail-source-common-keyword-map)
(set (mail-source-strip-keyword (setq keyword (car default)))
(if (setq value (plist-get source keyword))
(mail-source-value value)
@@ -512,12 +496,14 @@ the `mail-source-keyword-map' variable."
(defmacro mail-source-bind-common (source &rest body)
"Return a `let' form that binds all common variables.
See `mail-source-bind'."
- `(let ,(mail-source-bind-common-1)
- (mail-source-set-common-1 source)
- ,@body))
-
-(put 'mail-source-bind-common 'lisp-indent-function 1)
-(put 'mail-source-bind-common 'edebug-form-spec '(sexp body))
+ (declare (indent 1) (debug (sexp body)))
+ ;; FIXME: AFAICT this is a Rube Goldberg'esque way to bind and initialize the
+ ;; `plugged` variable.
+ (let ((bindings (mail-source-bind-common-1)))
+ `(with-suppressed-warnings ((lexical ,@(mapcar #'car bindings)))
+ (dlet ,bindings
+ (mail-source-set-common-1 ,source)
+ ,@body))))
(defun mail-source-value (value)
"Return the value of VALUE."
@@ -527,7 +513,7 @@ See `mail-source-bind'."
value)
;; Function
((and (listp value) (symbolp (car value)) (fboundp (car value)))
- (eval value))
+ (eval value t))
;; Just return the value.
(t
value)))
@@ -688,7 +674,7 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff
bfile)
;; find "our" movemail in exec-directory.
;; Bug#31737
(apply
- 'call-process
+ #'call-process
(append
(list
mail-source-movemail-program
@@ -742,12 +728,13 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff
bfile)
(declare-function gnus-get-buffer-create "gnus" (name))
(defun mail-source-call-script (script)
(require 'gnus)
- (let ((background nil)
+ (let (;; (background nil)
(stderr (gnus-get-buffer-create " *mail-source-stderr*"))
result)
(when (string-match "& *$" script)
(setq script (substring script 0 (match-beginning 0))
- background 0))
+ ;; background 0
+ ))
(setq result
(call-process shell-file-name nil stderr nil
shell-command-switch script))
@@ -831,14 +818,14 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff
bfile)
;; The default is to use pop3.el.
(t
(require 'pop3)
- (let ((pop3-password password)
- (pop3-maildrop user)
- (pop3-mailhost server)
- (pop3-port port)
- (pop3-authentication-scheme
- (if (eq authentication 'apop) 'apop 'pass))
- (pop3-stream-type stream)
- (pop3-leave-mail-on-server leave))
+ (dlet ((pop3-password password)
+ (pop3-maildrop user)
+ (pop3-mailhost server)
+ (pop3-port port)
+ (pop3-authentication-scheme
+ (if (eq authentication 'apop) 'apop 'pass))
+ (pop3-stream-type stream)
+ (pop3-leave-mail-on-server leave))
(if (or debug-on-quit debug-on-error)
(save-excursion (pop3-movemail mail-source-crash-box))
(condition-case err
@@ -898,12 +885,12 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff
bfile)
;; The default is to use pop3.el.
(t
(require 'pop3)
- (let ((pop3-password password)
- (pop3-maildrop user)
- (pop3-mailhost server)
- (pop3-port port)
- (pop3-authentication-scheme
- (if (eq authentication 'apop) 'apop 'pass)))
+ (dlet ((pop3-password password)
+ (pop3-maildrop user)
+ (pop3-mailhost server)
+ (pop3-port port)
+ (pop3-authentication-scheme
+ (if (eq authentication 'apop) 'apop 'pass)))
(if (or debug-on-quit debug-on-error)
(save-excursion (pop3-get-message-count))
(condition-case err
@@ -933,7 +920,7 @@ authentication. To do that, you need to set the
`message-send-mail-function' variable as `message-smtpmail-send-it'
and put the following line in your ~/.gnus.el file:
-\(add-hook \\='message-send-mail-hook \\='mail-source-touch-pop)
+\(add-hook \\='message-send-mail-hook #\\='mail-source-touch-pop)
See the Gnus manual for details."
(let ((sources (if mail-source-primary-source
@@ -977,6 +964,8 @@ See the Gnus manual for details."
;; (element 0 of the vector is nil if the timer is active).
(aset mail-source-report-new-mail-idle-timer 0 nil)))
+(declare-function display-time-event-handler "time" ())
+
(defun mail-source-report-new-mail (arg)
"Toggle whether to report when new mail is available.
This only works when `display-time' is enabled."
@@ -1005,11 +994,11 @@ This only works when `display-time' is enabled."
#'mail-source-start-idle-timer))
;; When you get new mail, clear "Mail" from the mode line.
(add-hook 'nnmail-post-get-new-mail-hook
- 'display-time-event-handler)
+ #'display-time-event-handler)
(message "Mail check enabled"))
(setq display-time-mail-function nil)
(remove-hook 'nnmail-post-get-new-mail-hook
- 'display-time-event-handler)
+ #'display-time-event-handler)
(message "Mail check disabled"))))
(defun mail-source-fetch-maildir (source callback)
@@ -1089,7 +1078,8 @@ This only works when `display-time' is enabled."
(if (and (imap-open server port stream authentication buf)
(imap-authenticate
user (or (cdr (assoc from mail-source-password-cache))
- password) buf))
+ password)
+ buf))
(let ((mailbox-list (if (listp mailbox) mailbox (list mailbox))))
(dolist (mailbox mailbox-list)
(when (imap-mailbox-select mailbox nil buf)
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 1409a43..5a5dbce 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -394,9 +394,8 @@ If nil, don't insert any text in the body."
;; inspired by JoH-followup-to by Jochem Huhman <joh at gmx.de>
;; new suggestions by R. Weikusat <rw at another.de>
-(defvar message-cross-post-old-target nil
+(defvar-local message-cross-post-old-target nil
"Old target for cross-posts or follow-ups.")
-(make-variable-buffer-local 'message-cross-post-old-target)
(defcustom message-cross-post-default t
"When non-nil `message-cross-post-followup-to' will perform a crosspost.
@@ -2004,9 +2003,8 @@ You must have the \"hashcash\" binary installed, see
`hashcash-path'."
(User-Agent))
"Alist used for formatting headers.")
-(defvar message-options nil
+(defvar-local message-options nil
"Some saved answers when sending message.")
-(make-variable-buffer-local 'message-options)
(defvar message-send-mail-real-function nil
"Internal send mail function.")
@@ -2195,10 +2193,11 @@ see `message-narrow-to-headers-or-head'."
(require 'gnus-sum) ; for gnus-list-identifiers
(let ((regexp (if (stringp gnus-list-identifiers)
gnus-list-identifiers
- (mapconcat 'identity gnus-list-identifiers " *\\|"))))
+ (mapconcat #'identity gnus-list-identifiers " *\\|"))))
(if (and (not (equal regexp ""))
(string-match (concat "\\(\\(\\(Re: +\\)?\\(" regexp
- " *\\)\\)+\\(Re: +\\)?\\)") subject))
+ " *\\)\\)+\\(Re: +\\)?\\)")
+ subject))
(concat (substring subject 0 (match-beginning 1))
(or (match-string 3 subject)
(match-string 5 subject))
@@ -3173,7 +3172,7 @@ Like `text-mode', but with these additional commands:
(defun message-setup-fill-variables ()
"Setup message fill variables."
- (setq-local fill-paragraph-function 'message-fill-paragraph)
+ (setq-local fill-paragraph-function #'message-fill-paragraph)
(make-local-variable 'adaptive-fill-first-line-regexp)
(let ((quote-prefix-regexp
;; User should change message-cite-prefix-regexp if
@@ -3197,7 +3196,7 @@ Like `text-mode', but with these additional commands:
(concat quote-prefix-regexp "\\|"
adaptive-fill-first-line-regexp)))
(setq-local auto-fill-inhibit-regexp nil)
- (setq-local normal-auto-fill-function 'message-do-auto-fill))
+ (setq-local normal-auto-fill-function #'message-do-auto-fill))
@@ -3674,7 +3673,7 @@ are null."
((functionp message-signature)
(funcall message-signature))
((listp message-signature)
- (eval message-signature))
+ (eval message-signature t))
(t message-signature)))
signature-file)
(setq signature
@@ -3991,11 +3990,12 @@ Just \\[universal-argument] as argument means don't
indent, insert no
prefix, and don't delete any headers."
(interactive "P")
;; eval the let forms contained in message-cite-style
- (eval
- `(let ,(if (symbolp message-cite-style)
- (symbol-value message-cite-style)
- message-cite-style)
- (message--yank-original-internal ',arg))))
+ (let ((bindings (if (symbolp message-cite-style)
+ (symbol-value message-cite-style)
+ message-cite-style)))
+ (cl-progv (mapcar #'car bindings)
+ (mapcar (lambda (binding) (eval (cadr binding) t)) bindings)
+ (message--yank-original-internal arg))))
(defun message-yank-buffer (buffer)
"Insert BUFFER into the current buffer and quote it."
@@ -4064,7 +4064,7 @@ This function uses `mail-citation-hook' if that is
non-nil."
;; Insert a blank line if it is peeled off.
(insert "\n"))))
(goto-char start)
- (mapc 'funcall functions)
+ (mapc #'funcall functions)
(when message-citation-line-function
(unless (bolp)
(insert "\n"))
@@ -4315,6 +4315,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)
@@ -4555,7 +4559,7 @@ An address might be bogus if there's a matching entry in
(and message-bogus-addresses
(let ((re
(if (listp message-bogus-addresses)
- (mapconcat 'identity
+ (mapconcat #'identity
message-bogus-addresses
"\\|")
message-bogus-addresses)))
@@ -4626,7 +4630,7 @@ Valid types are `send', `return', `exit', `kill' and
`postpone'."
(funcall action))
;; Something to be evalled.
(t
- (eval action))))))
+ (eval action t))))))
(defun message-send-mail-partially ()
"Send mail as message/partial."
@@ -4942,7 +4946,7 @@ that instead."
;; Insert an extra newline if we need it to work around
;; Sun's bug that swallows newlines.
(goto-char (1+ delimline))
- (when (eval message-mailer-swallows-blank-line)
+ (when (eval message-mailer-swallows-blank-line t)
(newline))
(when message-interactive
(with-current-buffer errbuf
@@ -4950,7 +4954,7 @@ that instead."
(let* ((default-directory "/")
(coding-system-for-write message-send-coding-system)
(cpr (apply
- 'call-process-region
+ #'call-process-region
(append
(list (point-min) (point-max) sendmail-program
nil errbuf nil "-oi")
@@ -5002,7 +5006,7 @@ to find out how to use this."
(pcase
(let ((coding-system-for-write message-send-coding-system))
(apply
- 'call-process-region (point-min) (point-max)
+ #'call-process-region (point-min) (point-max)
message-qmail-inject-program nil nil nil
;; qmail-inject's default behavior is to look for addresses on the
;; command line; if there're none, it scans the headers.
@@ -5394,7 +5398,7 @@ Otherwise, generate and save a value for
`canlock-password' first."
"Really use %s possibly unknown group%s: %s? "
(if (= (length errors) 1) "this" "these")
(if (= (length errors) 1) "" "s")
- (mapconcat 'identity errors ", "))))
+ (mapconcat #'identity errors ", "))))
;; There were no errors.
((not errors)
t)
@@ -6061,7 +6065,7 @@ subscribed address (and not the additional To and Cc
header contents)."
(cc (message-fetch-field "cc"))
(msg-recipients (concat to (and to cc ", ") cc))
(recipients
- (mapcar 'mail-strip-quoted-names
+ (mapcar #'mail-strip-quoted-names
(message-tokenize-header msg-recipients)))
(file-regexps
(if message-subscribed-address-file
@@ -6078,11 +6082,11 @@ subscribed address (and not the additional To and Cc
header contents)."
(if re (setq re (concat re "\\|" item))
(setq re (concat "\\`\\(" item))))
(and re (list (concat re "\\)\\'"))))))))
- (mft-regexps (apply 'append message-subscribed-regexps
- (mapcar 'regexp-quote
+ (mft-regexps (apply #'append message-subscribed-regexps
+ (mapcar #'regexp-quote
message-subscribed-addresses)
file-regexps
- (mapcar 'funcall
+ (mapcar #'funcall
message-subscribed-address-functions))))
(save-match-data
(let ((list
@@ -6103,7 +6107,7 @@ subscribed address (and not the additional To and Cc
header contents)."
(dolist (rhs
(delete-dups
(mapcar (lambda (rhs) (or (cadr (split-string rhs "@")) ""))
- (mapcar 'downcase
+ (mapcar #'downcase
(mapcar
(lambda (elem)
(or (cadr elem)
@@ -6569,7 +6573,7 @@ moved to the beginning "
(if to
(concat " to "
(or (car (mail-extract-address-components to))
- to) "")
+ to))
"")
(if (and group (not (string= group ""))) (concat " on " group) "")
"*")))
@@ -6583,7 +6587,7 @@ moved to the beginning "
(if to
(concat " to "
(or (car (mail-extract-address-components to))
- to) "")
+ to))
"")
(if (and group (not (string= group ""))) (concat " on " group) "")
"*")))
@@ -6612,7 +6616,7 @@ moved to the beginning "
(cons (string-to-number (or (match-string 1 b) "1"))
b)))
(buffer-list)))
- 'car-less-than-car)))
+ #'car-less-than-car)))
new)))))
(defun message-pop-to-buffer (name &optional switch-function)
@@ -6968,8 +6972,8 @@ The function is called with one parameter, a cons cell
..."
(message-fetch-field "original-to")))
cc (message-fetch-field "cc")
extra (when message-extra-wide-headers
- (mapconcat 'identity
- (mapcar 'message-fetch-field
+ (mapconcat #'identity
+ (mapcar #'message-fetch-field
message-extra-wide-headers)
", "))
mct (message-fetch-field "mail-copies-to")
@@ -7053,7 +7057,7 @@ want to get rid of this query permanently.")))
(setq recipients
(cond ((functionp message-dont-reply-to-names)
(mapconcat
- 'identity
+ #'identity
(delq nil
(mapcar (lambda (mail)
(unless (funcall
message-dont-reply-to-names
@@ -7087,7 +7091,7 @@ want to get rid of this query permanently.")))
;; Remove hierarchical lists that are contained within each other,
;; if message-hierarchical-addresses is defined.
(when message-hierarchical-addresses
- (let ((plain-addrs (mapcar 'car recipients))
+ (let ((plain-addrs (mapcar #'car recipients))
subaddrs recip)
(while plain-addrs
(setq subaddrs (assoc (car plain-addrs)
@@ -8366,7 +8370,7 @@ The following arguments may contain lists of values."
(with-output-to-temp-buffer " *MESSAGE information message*"
(with-current-buffer " *MESSAGE information message*"
(fundamental-mode)
- (mapc 'princ text)
+ (mapc #'princ text)
(goto-char (point-min))))
(funcall ask question))
(funcall ask question)))
diff --git a/lisp/gnus/mm-archive.el b/lisp/gnus/mm-archive.el
index 635e7f4..1ecceee 100644
--- a/lisp/gnus/mm-archive.el
+++ b/lisp/gnus/mm-archive.el
@@ -1,4 +1,4 @@
-;;; mm-archive.el --- Functions for parsing archive files as MIME
+;;; mm-archive.el --- Functions for parsing archive files as MIME -*-
lexical-binding: t; -*-
;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
@@ -54,10 +54,10 @@
(write-region (point-min) (point-max) file nil 'silent)
(setq decoder (copy-sequence decoder))
(setcar (member "%f" decoder) file)
- (apply 'call-process (car decoder) nil nil nil
+ (apply #'call-process (car decoder) nil nil nil
(append (cdr decoder) (list dir)))
(delete-file file))
- (apply 'call-process-region (point-min) (point-max) (car decoder)
+ (apply #'call-process-region (point-min) (point-max) (car decoder)
nil (gnus-get-buffer-create "*tnef*")
nil (append (cdr decoder) (list dir)))))
`("multipart/mixed"
@@ -100,11 +100,11 @@
(goto-char (point-max))
(mm-handle-set-undisplayer
handle
- `(lambda ()
- (let ((inhibit-read-only t)
- (end ,(point-marker)))
- (remove-images ,start end)
- (delete-region ,start end)))))))
+ (let ((end (point-marker)))
+ (lambda ()
+ (let ((inhibit-read-only t))
+ (remove-images start end)
+ (delete-region start end))))))))
(provide 'mm-archive)
diff --git a/lisp/gnus/mm-bodies.el b/lisp/gnus/mm-bodies.el
index f35ba3a..d6b71f1 100644
--- a/lisp/gnus/mm-bodies.el
+++ b/lisp/gnus/mm-bodies.el
@@ -1,4 +1,4 @@
-;;; mm-bodies.el --- Functions for decoding MIME things
+;;; mm-bodies.el --- Functions for decoding MIME things -*- lexical-binding:
t; -*-
;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index 61946aa..02cd6af 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -40,8 +40,8 @@
(defvar gnus-current-window-configuration)
-(add-hook 'gnus-exit-gnus-hook 'mm-destroy-postponed-undisplay-list)
-(add-hook 'gnus-exit-gnus-hook 'mm-temp-files-delete)
+(add-hook 'gnus-exit-gnus-hook #'mm-destroy-postponed-undisplay-list)
+(add-hook 'gnus-exit-gnus-hook #'mm-temp-files-delete)
(defgroup mime-display ()
"Display of MIME in mail and news articles."
@@ -603,7 +603,7 @@ files left at the next time."
(if fails
;; Schedule the deletion of the files left at the next time.
(with-file-modes #o600
- (write-region (concat (mapconcat 'identity (nreverse fails) "\n")
+ (write-region (concat (mapconcat #'identity (nreverse fails) "\n")
"\n")
nil cache-file nil 'silent))
(when (file-exists-p cache-file)
@@ -1081,7 +1081,8 @@ external if displayed external."
(string= total "\"%s\""))
(setq uses-stdin nil)
(push (shell-quote-argument
- (gnus-map-function mm-path-name-rewrite-functions file)) out))
+ (gnus-map-function mm-path-name-rewrite-functions file))
+ out))
((string= total "%t")
(push (shell-quote-argument (car type-list)) out))
(t
@@ -1092,7 +1093,7 @@ external if displayed external."
(push (shell-quote-argument
(gnus-map-function mm-path-name-rewrite-functions file))
out))
- (mapconcat 'identity (nreverse out) "")))
+ (mapconcat #'identity (nreverse out) "")))
(defun mm-remove-parts (handles)
"Remove the displayed MIME parts represented by HANDLES."
@@ -1255,6 +1256,7 @@ in HANDLE."
(defmacro mm-with-part (handle &rest forms)
"Run FORMS in the temp buffer containing the contents of HANDLE."
+ (declare (indent 1) (debug t))
;; The handle-buffer's content is a sequence of bytes, not a sequence of
;; chars, so the buffer should be unibyte. It may happen that the
;; handle-buffer is multibyte for some reason, in which case now is a good
@@ -1270,8 +1272,6 @@ in HANDLE."
(mm-handle-encoding handle)
(mm-handle-media-type handle))
,@forms))))
-(put 'mm-with-part 'lisp-indent-function 1)
-(put 'mm-with-part 'edebug-form-spec '(body))
(defun mm-get-part (handle &optional no-cache)
"Return the contents of HANDLE as a string.
diff --git a/lisp/gnus/mm-encode.el b/lisp/gnus/mm-encode.el
index 8bd3e0b..84a3b0a 100644
--- a/lisp/gnus/mm-encode.el
+++ b/lisp/gnus/mm-encode.el
@@ -1,4 +1,4 @@
-;;; mm-encode.el --- Functions for encoding MIME things
+;;; mm-encode.el --- Functions for encoding MIME things -*- lexical-binding:
t; -*-
;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
@@ -98,9 +98,12 @@ This variable should never be set directly, but bound before
a call to
boundary))
;;;###autoload
-(defun mm-default-file-encoding (file)
- "Return a default encoding for FILE."
- (if (not (string-match "\\.[^.]+$" file))
+(define-obsolete-function-alias 'mm-default-file-encoding
+ #'mm-default-file-type "future") ;Old bad name.
+;;;###autoload
+(defun mm-default-file-type (file)
+ "Return a default content type for FILE."
+ (if (not (string-match "\\.[^.]+\\'" file))
"application/octet-stream"
(mailcap-extension-to-mime (match-string 0 file))))
diff --git a/lisp/gnus/mm-partial.el b/lisp/gnus/mm-partial.el
index 165c191..0c25c8f 100644
--- a/lisp/gnus/mm-partial.el
+++ b/lisp/gnus/mm-partial.el
@@ -1,4 +1,4 @@
-;;; mm-partial.el --- showing message/partial
+;;; mm-partial.el --- showing message/partial -*- lexical-binding: t; -*-
;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
@@ -39,7 +39,8 @@
gnus-newsgroup-name)
(when (search-forward id nil t)
(let ((nhandles (mm-dissect-buffer
- nil gnus-article-loose-mime)) nid)
+ nil gnus-article-loose-mime))
+ nid)
(if (consp (car nhandles))
(mm-destroy-parts nhandles)
(setq nid (cdr (assq 'id
@@ -49,6 +50,8 @@
(push nhandles phandles))))))))
phandles))
+(defvar gnus-displaying-mime)
+
;;;###autoload
(defun mm-inline-partial (handle &optional no-display)
"Show the partial part of HANDLE.
@@ -59,7 +62,7 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing
after replacing."
phandles
(b (point)) (n 1) total
phandle nn ntotal
- gnus-displaying-mime handles buffer)
+ gnus-displaying-mime handles) ;; buffer
(unless (mm-handle-cache handle)
(unless id
(error "Can not find message/partial id"))
@@ -90,7 +93,7 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing
after replacing."
(if ntotal
(if total
(unless (eq total ntotal)
- (error "The numbers of total are different"))
+ (error "The numbers of total are different"))
(setq total ntotal)))
(unless (< nn n)
(unless (eq nn n)
@@ -132,9 +135,11 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing
after replacing."
(mm-merge-handles gnus-article-mime-handles handles)))
(mm-handle-set-undisplayer
handle
- `(lambda ()
- (let (buffer-read-only)
- (delete-region ,(point-min-marker) ,(point-max-marker))))))))))
+ (let ((beg (point-min-marker))
+ (end (point-max-marker)))
+ (lambda ()
+ (let ((inhibit-read-only t))
+ (delete-region beg end))))))))))
(provide 'mm-partial)
diff --git a/lisp/gnus/mm-url.el b/lisp/gnus/mm-url.el
index 412a474..3d58738 100644
--- a/lisp/gnus/mm-url.el
+++ b/lisp/gnus/mm-url.el
@@ -1,4 +1,4 @@
-;;; mm-url.el --- a wrapper of url functions/commands for Gnus
+;;; mm-url.el --- a wrapper of url functions/commands for Gnus -*-
lexical-binding: t; -*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
@@ -44,8 +44,7 @@
(defcustom mm-url-use-external nil
"If non-nil, use external grab program `mm-url-program'."
:version "22.1"
- :type 'boolean
- :group 'mm-url)
+ :type 'boolean)
(defvar mm-url-predefined-programs
'((wget "wget" "--user-agent=mm-url" "-q" "-O" "-")
@@ -68,14 +67,12 @@ Likely values are `wget', `w3m', `lynx' and `curl'."
(symbol :tag "w3m" w3m)
(symbol :tag "lynx" lynx)
(symbol :tag "curl" curl)
- (string :tag "other"))
- :group 'mm-url)
+ (string :tag "other")))
(defcustom mm-url-arguments nil
"The arguments for `mm-url-program'."
:version "22.1"
- :type '(repeat string)
- :group 'mm-url)
+ :type '(repeat string))
;;; Internal variables
@@ -299,7 +296,7 @@ If `mm-url-use-external' is non-nil, use `mm-url-program'."
args (append (cdr item) (list url))))
(setq program mm-url-program
args (append mm-url-arguments (list url))))
- (unless (eq 0 (apply 'call-process program nil t nil args))
+ (unless (eq 0 (apply #'call-process program nil t nil args))
(error "Couldn't fetch %s" url))))
(defvar mm-url-timeout 30
diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el
index db42bfa..92e04f9 100644
--- a/lisp/gnus/mm-util.el
+++ b/lisp/gnus/mm-util.el
@@ -144,9 +144,9 @@ is not available."
;; on there being some coding system matching each `mime-charset'
;; property defined, as there should be.)
((and (mm-coding-system-p charset)
-;;; Doing this would potentially weed out incorrect charsets.
-;;; charset
-;;; (eq charset (coding-system-get charset 'mime-charset))
+ ;; Doing this would potentially weed out incorrect charsets.
+ ;; charset
+ ;; (eq charset (coding-system-get charset 'mime-charset))
)
charset)
;; Use coding system Emacs knows.
@@ -160,7 +160,7 @@ is not available."
form
(prog2
;; Avoid errors...
- (condition-case nil (eval form) (error nil))
+ (condition-case nil (eval form t) (error nil))
;; (message "Failed to eval `%s'" form))
(mm-coding-system-p cs)
(message "Added charset `%s' via `mm-charset-eval-alist'" cs))
@@ -380,7 +380,7 @@ like \"€\" to the euro sign, mainly in html messages."
"Return the MIME charset corresponding to the given Mule CHARSET."
(let ((css (sort (sort-coding-systems
(find-coding-systems-for-charsets (list charset)))
- 'mm-sort-coding-systems-predicate))
+ #'mm-sort-coding-systems-predicate))
cs mime)
(while (and (not mime)
css)
@@ -501,7 +501,7 @@ charset, and a longer list means no appropriate charset."
(let ((systems (find-coding-systems-region b e)))
(when mm-coding-system-priorities
(setq systems
- (sort systems 'mm-sort-coding-systems-predicate)))
+ (sort systems #'mm-sort-coding-systems-predicate)))
(setq systems (delq 'compound-text systems))
(unless (equal systems '(undecided))
(while systems
@@ -751,7 +751,7 @@ decompressed data. The buffer's multibyteness must be
turned off."
(insert-buffer-substring cur)
(condition-case err
(progn
- (unless (memq (apply 'call-process-region
+ (unless (memq (apply #'call-process-region
(point-min) (point-max)
prog t (list t err-file) nil args)
jka-compr-acceptable-retval-list)
diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el
index 0683703..3e36d67 100644
--- a/lisp/gnus/mm-view.el
+++ b/lisp/gnus/mm-view.el
@@ -1,4 +1,4 @@
-;;; mm-view.el --- functions for viewing MIME objects
+;;; mm-view.el --- functions for viewing MIME objects -*- lexical-binding: t;
-*-
;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
@@ -104,11 +104,10 @@ This is only used if `mm-inline-large-images' is set to
(insert "\n")
(mm-handle-set-undisplayer
handle
- `(lambda ()
- (let ((b ,b)
- (inhibit-read-only t))
- (remove-images b b)
- (delete-region b (1+ b)))))))
+ (lambda ()
+ (let ((inhibit-read-only t))
+ (remove-images b b)
+ (delete-region b (1+ b)))))))
(defvar mm-w3m-setup nil
"Whether gnus-article-mode has been setup to use emacs-w3m.")
@@ -137,7 +136,7 @@ This is only used if `mm-inline-large-images' is set to
(equal "multipart" (mm-handle-media-supertype elem)))
(mm-w3m-cid-retrieve-1 url elem)))))
-(defun mm-w3m-cid-retrieve (url &rest args)
+(defun mm-w3m-cid-retrieve (url &rest _args)
"Insert a content pointed by URL if it has the cid: scheme."
(when (string-match "\\`cid:" url)
(or (catch 'found-handle
@@ -149,6 +148,9 @@ This is only used if `mm-inline-large-images' is set to
nil
(message "Failed to find \"Content-ID: %s\"" url)))))
+(defvar w3m-force-redisplay)
+(defvar w3m-safe-url-regexp)
+
(defun mm-inline-text-html-render-with-w3m (handle)
"Render a text/html part using emacs-w3m."
(mm-setup-w3m)
@@ -199,10 +201,11 @@ This is only used if `mm-inline-large-images' is set to
'keymap w3m-minor-mode-map)))
(mm-handle-set-undisplayer
handle
- `(lambda ()
- (let ((inhibit-read-only t))
- (delete-region ,(point-min-marker)
- ,(point-max-marker)))))))))
+ (let ((beg (point-min-marker))
+ (end (point-max-marker)))
+ (lambda ()
+ (let ((inhibit-read-only t))
+ (delete-region beg end)))))))))
(defcustom mm-w3m-standalone-supports-m17n-p 'undecided
"T means the w3m command supports the m17n feature."
@@ -274,13 +277,13 @@ This is only used if `mm-inline-large-images' is set to
(write-region (point-min) (point-max) file nil 'silent))
(delete-region (point-min) (point-max))
(unwind-protect
- (apply 'call-process cmd nil t nil (mapcar 'eval args))
+ (apply #'call-process cmd nil t nil (mapcar (lambda (e) (eval e t))
args))
(delete-file file))
(and post-func (funcall post-func))))
(defun mm-inline-wash-with-stdin (post-func cmd &rest args)
(let ((coding-system-for-write 'binary))
- (apply 'call-process-region (point-min) (point-max)
+ (apply #'call-process-region (point-min) (point-max)
cmd t t nil args))
(and post-func (funcall post-func)))
@@ -290,7 +293,7 @@ This is only used if `mm-inline-large-images' is set to
handle
(mm-with-unibyte-buffer
(insert source)
- (apply 'mm-inline-wash-with-file post-func cmd args)
+ (apply #'mm-inline-wash-with-file post-func cmd args)
(buffer-string)))))
(defun mm-inline-render-with-stdin (handle post-func cmd &rest args)
@@ -299,7 +302,7 @@ This is only used if `mm-inline-large-images' is set to
handle
(mm-with-unibyte-buffer
(insert source)
- (apply 'mm-inline-wash-with-stdin post-func cmd args)
+ (apply #'mm-inline-wash-with-stdin post-func cmd args)
(buffer-string)))))
(defun mm-inline-render-with-function (handle func &rest args)
@@ -317,7 +320,7 @@ This is only used if `mm-inline-large-images' is set to
(defun mm-inline-text-html (handle)
(if (stringp (car handle))
- (mapcar 'mm-inline-text-html (cdr handle))
+ (mapcar #'mm-inline-text-html (cdr handle))
(let* ((func mm-text-html-renderer)
(entry (assq func mm-text-html-renderer-alist))
(inhibit-read-only t))
@@ -378,10 +381,11 @@ This is only used if `mm-inline-large-images' is set to
handle
(if (= (point-min) (point-max))
#'ignore
- `(lambda ()
- (let ((inhibit-read-only t))
- (delete-region ,(copy-marker (point-min) t)
- ,(point-max-marker)))))))))
+ (let ((beg (copy-marker (point-min) t))
+ (end (point-max-marker)))
+ (lambda ()
+ (let ((inhibit-read-only t))
+ (delete-region beg end)))))))))
(defun mm-insert-inline (handle text)
"Insert TEXT inline from HANDLE."
@@ -391,12 +395,13 @@ This is only used if `mm-inline-large-images' is set to
(insert "\n"))
(mm-handle-set-undisplayer
handle
- `(lambda ()
- (let ((inhibit-read-only t))
- (delete-region ,(copy-marker b t)
- ,(point-marker)))))))
+ (let ((beg (copy-marker b t))
+ (end (point-marker)))
+ (lambda ()
+ (let ((inhibit-read-only t))
+ (delete-region beg end)))))))
-(defun mm-inline-audio (handle)
+(defun mm-inline-audio (_handle)
(message "Not implemented"))
(defun mm-view-message ()
@@ -413,6 +418,10 @@ This is only used if `mm-inline-large-images' is set to
(fundamental-mode)
(goto-char (point-min)))
+(defvar gnus-original-article-buffer)
+(defvar gnus-article-prepare-hook)
+(defvar gnus-displaying-mime)
+
(defun mm-inline-message (handle)
(let ((b (point))
(bolp (bolp))
@@ -450,9 +459,11 @@ This is only used if `mm-inline-large-images' is set to
(mm-merge-handles gnus-article-mime-handles handles)))
(mm-handle-set-undisplayer
handle
- `(lambda ()
- (let ((inhibit-read-only t))
- (delete-region ,(point-min-marker) ,(point-max-marker)))))))))
+ (let ((beg (point-min-marker))
+ (end (point-max-marker)))
+ (lambda ()
+ (let ((inhibit-read-only t))
+ (delete-region beg end)))))))))
;; Shut up byte-compiler.
(defvar font-lock-mode-hook)
diff --git a/lisp/gnus/mml-sec.el b/lisp/gnus/mml-sec.el
index c117a38..d41c9dd 100644
--- a/lisp/gnus/mml-sec.el
+++ b/lisp/gnus/mml-sec.el
@@ -1,4 +1,4 @@
-;;; mml-sec.el --- A package with security functions for MML documents
+;;; mml-sec.el --- A package with security functions for MML documents -*-
lexical-binding: t; -*-
;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
@@ -236,7 +236,7 @@ You can also customize or set `mml-signencrypt-style-alist'
instead."
(re-search-forward
(concat "^" (regexp-quote mail-header-separator) "\n") nil t))
(goto-char (match-end 0))
- (apply 'mml-insert-tag 'part (cons (if sign 'sign 'encrypt)
+ (apply #'mml-insert-tag 'part (cons (if sign 'sign 'encrypt)
(cons method tags))))
(t (error "The message is corrupted. No mail header separator"))))))
@@ -298,14 +298,17 @@ Use METHOD if given. Else use `mml-secure-method' or
(interactive)
(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).
@@ -346,8 +349,8 @@ either an error is raised or not."
(concat "^" (regexp-quote mail-header-separator) "\n") nil t)
(goto-char (setq insert-loc (match-end 0)))
(unless (looking-at "<#secure")
- (apply 'mml-insert-tag
- 'secure 'method method 'mode mode tags)))
+ (apply #'mml-insert-tag
+ 'secure 'method method 'mode mode tags)))
(t (error
"The message is corrupted. No mail header separator"))))
(when (eql insert-loc (point))
@@ -558,7 +561,7 @@ Return keys."
(cl-assert keys)
(let* ((usage-prefs (mml-secure-cust-usage-lookup context usage))
(curr-fprs (cdr (assoc name (cdr usage-prefs))))
- (key-fprs (mapcar 'mml-secure-fingerprint keys))
+ (key-fprs (mapcar #'mml-secure-fingerprint keys))
(new-fprs (cl-union curr-fprs key-fprs :test 'equal)))
(if curr-fprs
(setcdr (assoc name (cdr usage-prefs)) new-fprs)
@@ -622,7 +625,7 @@ Passphrase caching in Emacs is NOT recommended. Use
gpg-agent instead."
mml-smime-passphrase-cache-expiry)
mml-secure-passphrase-cache-expiry))))
-(defun mml-secure-passphrase-callback (context key-id standard)
+(defun mml-secure-passphrase-callback (context key-id _standard)
"Ask for passphrase in CONTEXT for KEY-ID for STANDARD.
The passphrase is read and cached."
;; Based on mml2015-epg-passphrase-callback.
@@ -795,7 +798,7 @@ When `mml-secure-fail-when-key-problem' is t, fail with an
error in case of
outdated or multiple keys."
(let* ((nname (mml-secure-normalize-cust-name name))
(fprs (mml-secure-cust-fpr-lookup context usage nname))
- (usable-fprs (mapcar 'mml-secure-fingerprint keys)))
+ (usable-fprs (mapcar #'mml-secure-fingerprint keys)))
(if fprs
(if (gnus-subsetp fprs usable-fprs)
(mml-secure-filter-keys keys fprs)
@@ -906,7 +909,7 @@ If no one is selected, symmetric encryption will be
performed. "
(error "No recipient specified")))
recipients))
-(defun mml-secure-epg-encrypt (protocol cont &optional sign)
+(defun mml-secure-epg-encrypt (protocol _cont &optional sign)
;; Based on code appearing inside mml2015-epg-encrypt.
(let* ((context (epg-make-context protocol))
(config (epg-find-configuration 'OpenPGP))
diff --git a/lisp/gnus/mml-smime.el b/lisp/gnus/mml-smime.el
index 5baeaff..5c133e6 100644
--- a/lisp/gnus/mml-smime.el
+++ b/lisp/gnus/mml-smime.el
@@ -1,4 +1,4 @@
-;;; mml-smime.el --- S/MIME support for MML
+;;; mml-smime.el --- S/MIME support for MML -*- lexical-binding: t; -*-
;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
@@ -129,7 +129,7 @@ Whether the passphrase is cached at all is controlled by
(if func
(funcall func handle ctl))))
-(defun mml-smime-openssl-sign (cont)
+(defun mml-smime-openssl-sign (_cont)
(when (null smime-keys)
(customize-variable 'smime-keys)
(error "No S/MIME keys configured, use customize to add your key"))
@@ -179,7 +179,7 @@ Whether the passphrase is cached at all is controlled by
(and from (smime-get-key-by-email from)))
(smime-get-key-by-email
(gnus-completing-read "Sign this part with what signature"
- (mapcar 'car smime-keys) nil nil nil
+ (mapcar #'car smime-keys) nil nil nil
(and (listp (car-safe smime-keys))
(caar smime-keys))))))))
@@ -287,7 +287,7 @@ Whether the passphrase is cached at all is controlled by
(point-min) (point))
addresses)))
(delete-region (point-min) (point)))
- (setq addresses (mapcar 'downcase addresses))))
+ (setq addresses (mapcar #'downcase addresses))))
(if (not (member (downcase (or (mm-handle-multipart-from ctl) ""))
addresses))
(mm-sec-error 'gnus-info "Sender address forged")
@@ -299,7 +299,7 @@ Whether the passphrase is cached at all is controlled by
(concat "Sender claimed to be: " (mm-handle-multipart-from ctl) "\n"
(if addresses
(concat "Addresses in certificate: "
- (mapconcat 'identity addresses ", "))
+ (mapconcat #'identity addresses ", "))
"No addresses found in certificate. (Requires OpenSSL 0.9.6
or later.)")
"\n" "\n"
"OpenSSL output:\n"
@@ -309,7 +309,7 @@ Whether the passphrase is cached at all is controlled by
(buffer-string) "\n")))))
handle)
-(defun mml-smime-openssl-verify-test (handle ctl)
+(defun mml-smime-openssl-verify-test (_handle _ctl)
smime-openssl-program)
(defvar epg-user-id-alist)
@@ -369,8 +369,8 @@ Content-Disposition: attachment; filename=smime.p7s
(goto-char (point-max)))))
(defun mml-smime-epg-encrypt (cont)
- (let* ((inhibit-redisplay t)
- (boundary (mml-compute-boundary cont))
+ (let* ((inhibit-redisplay t) ;FIXME: Why?
+ ;; (boundary (mml-compute-boundary cont))
(cipher (mml-secure-epg-encrypt 'CMS cont)))
(delete-region (point-min) (point-max))
(goto-char (point-min))
@@ -388,7 +388,7 @@ Content-Disposition: attachment; filename=smime.p7m
(defun mml-smime-epg-verify (handle ctl)
(catch 'error
(let ((inhibit-redisplay t)
- context plain signature-file part signature)
+ context part signature) ;; plain signature-file
(when (or (null (setq part (mm-find-raw-part-by-type
ctl (or (mm-handle-multipart-ctl-parameter
ctl 'protocol)
@@ -407,19 +407,20 @@ Content-Disposition: attachment; filename=smime.p7m
(setq part (replace-regexp-in-string "\n" "\r\n" part)
context (epg-make-context 'CMS))
(condition-case error
- (setq plain (epg-verify-string context (mm-get-part signature) part))
+ ;; (setq plain
+ (epg-verify-string context (mm-get-part signature) part) ;;)
(error
(mm-sec-error 'gnus-info "Failed")
- (if (eq (car error) 'quit)
- (mm-sec-status 'gnus-details "Quit.")
- (mm-sec-status 'gnus-details (format "%S" error)))
+ (mm-sec-status 'gnus-details (if (eq (car error) 'quit)
+ "Quit."
+ (format "%S" error)))
(throw 'error handle)))
(mm-sec-status
'gnus-info
(epg-verify-result-to-string (epg-context-result-for context 'verify)))
handle)))
-(defun mml-smime-epg-verify-test (handle ctl)
+(defun mml-smime-epg-verify-test (_handle _ctl)
t)
(provide 'mml-smime)
diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el
index 424215d..f77e5c6 100644
--- a/lisp/gnus/mml.el
+++ b/lisp/gnus/mml.el
@@ -1,4 +1,4 @@
-;;; mml.el --- A package for parsing and validating MML documents
+;;; mml.el --- A package for parsing and validating MML documents -*-
lexical-binding: t; -*-
;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
@@ -206,8 +206,8 @@ part. This is for the internal use, you should never
modify the value.")
(defun mml-destroy-buffers ()
(let (kill-buffer-hook)
- (mapc 'kill-buffer mml-buffer-list)
- (setq mml-buffer-list nil)))
+ (mapc #'kill-buffer (prog1 mml-buffer-list
+ (setq mml-buffer-list nil)))))
(defun mml-parse ()
"Parse the current buffer as an MML document."
@@ -241,34 +241,37 @@ part. This is for the internal use, you should never
modify the value.")
(method (cdr (assq 'method taginfo)))
tags)
(save-excursion
- (if (re-search-forward
- "<#/?\\(multipart\\|part\\|external\\|mml\\)." nil t)
- (setq secure-mode "multipart")
- (setq secure-mode "part")))
+ (setq secure-mode
+ (if (re-search-forward
+ "<#/?\\(multipart\\|part\\|external\\|mml\\)."
+ nil t)
+ "multipart"
+ "part")))
(save-excursion
(goto-char location)
(re-search-forward "<#secure[^\n]*>\n"))
(delete-region (match-beginning 0) (match-end 0))
- (cond ((string= mode "sign")
- (setq tags (list "sign" method)))
- ((string= mode "encrypt")
- (setq tags (list "encrypt" method)))
- ((string= mode "signencrypt")
- (setq tags (list "sign" method "encrypt" method)))
- (t
- (error "Unknown secure mode %s" mode)))
- (eval `(mml-insert-tag ,secure-mode
- ,@tags
- ,(if keyfile "keyfile")
- ,keyfile
- ,@(apply #'append
- (mapcar (lambda (certfile)
- (list "certfile" certfile))
- certfiles))
- ,(if recipients "recipients")
- ,recipients
- ,(if sender "sender")
- ,sender))
+ (setq tags (cond ((string= mode "sign")
+ (list "sign" method))
+ ((string= mode "encrypt")
+ (list "encrypt" method))
+ ((string= mode "signencrypt")
+ (list "sign" method "encrypt" method))
+ (t
+ (error "Unknown secure mode %s" mode))))
+ (apply #'mml-insert-tag
+ secure-mode
+ `(,@tags
+ ,(if keyfile "keyfile")
+ ,keyfile
+ ,@(apply #'append
+ (mapcar (lambda (certfile)
+ (list "certfile" certfile))
+ certfiles))
+ ,(if recipients "recipients")
+ ,recipients
+ ,(if sender "sender")
+ ,sender))
;; restart the parse
(goto-char location)))
((looking-at "<#multipart")
@@ -499,7 +502,7 @@ type detected."
content-type)
(setcdr (assq 'type (cdr (car cont))) content-type))
(when (fboundp 'libxml-parse-html-region)
- (setq cont (mapcar 'mml-expand-all-html-into-multipart-related cont)))
+ (setq cont (mapcar #'mml-expand-all-html-into-multipart-related cont)))
(prog1
(with-temp-buffer
(set-buffer-multibyte nil)
@@ -617,7 +620,7 @@ type detected."
(filename (cdr (assq 'filename cont)))
(type (or (cdr (assq 'type cont))
(if filename
- (or (mm-default-file-encoding filename)
+ (or (mm-default-file-type filename)
"application/octet-stream")
"text/plain")))
(charset (cdr (assq 'charset cont)))
@@ -775,7 +778,7 @@ type detected."
(insert "Content-Type: "
(or (cdr (assq 'type cont))
(if name
- (or (mm-default-file-encoding name)
+ (or (mm-default-file-type name)
"application/octet-stream")
"text/plain"))
"\n")
@@ -862,7 +865,7 @@ type detected."
(cl-incf mml-multipart-number)))
(throw 'not-unique nil))))
((eq (car cont) 'multipart)
- (mapc 'mml-compute-boundary-1 (cddr cont))))
+ (mapc #'mml-compute-boundary-1 (cddr cont))))
t)
(defun mml-make-boundary (number)
@@ -1077,7 +1080,7 @@ If HANDLES is non-nil, use it instead reparsing the
buffer."
(goto-char (point-max))
(insert "<#/mml>\n"))
((stringp (car handle))
- (mapc 'mml-insert-mime (cdr handle))
+ (mapc #'mml-insert-mime (cdr handle))
(insert "<#/multipart>\n"))
(textp
(let ((charset (mail-content-type-get
@@ -1304,7 +1307,7 @@ If not set, `default-directory' will be used."
(require 'mailcap)
(mailcap-parse-mimetypes)
(let* ((default (or default
- (mm-default-file-encoding name)
+ (mm-default-file-type name)
;; Perhaps here we should check what the file
;; looks like, and offer text/plain if it looks
;; like text/plain.
@@ -1426,7 +1429,7 @@ will be computed and used."
(interactive
(let* ((file (mml-minibuffer-read-file "Attach file: "))
(type (if current-prefix-arg
- (or (mm-default-file-encoding file)
+ (or (mm-default-file-type file)
"application/octet-stream")
(mml-minibuffer-read-type file)))
(description (if current-prefix-arg
@@ -1456,7 +1459,7 @@ will be computed and used."
(file-name-nondirectory file)))
(goto-char head))))
-(defun mml-dnd-attach-file (uri action)
+(defun mml-dnd-attach-file (uri _action)
"Attach a drag and drop file.
Ask for type, description or disposition according to
@@ -1587,6 +1590,16 @@ Should be adopted if code in `message-send-mail' is
changed."
(declare-function message-generate-headers "message" (headers))
(declare-function message-sort-headers "message" ())
+(defvar gnus-newsgroup-name)
+(defvar gnus-displaying-mime)
+(defvar gnus-newsgroup-name)
+(defvar gnus-article-prepare-hook)
+(defvar gnus-newsgroup-charset)
+(defvar gnus-original-article-buffer)
+(defvar gnus-message-buffer)
+(defvar message-this-is-news)
+(defvar message-this-is-mail)
+
(defun mml-preview (&optional raw)
"Display current buffer with Gnus, in a new buffer.
If RAW, display a raw encoded MIME message.
@@ -1598,7 +1611,8 @@ or the `pop-to-buffer' function."
(interactive "P")
(setq mml-preview-buffer (generate-new-buffer
(concat (if raw "*Raw MIME preview of "
- "*MIME preview of ") (buffer-name))))
+ "*MIME preview of ")
+ (buffer-name))))
(require 'gnus-msg) ; for gnus-setup-posting-charset
(save-excursion
(let* ((buf (current-buffer))
@@ -1655,7 +1669,8 @@ or the `pop-to-buffer' function."
(use-local-map nil)
(add-hook 'kill-buffer-hook
(lambda ()
- (mm-destroy-parts gnus-article-mime-handles)) nil t)
+ (mm-destroy-parts gnus-article-mime-handles))
+ nil t)
(setq buffer-read-only t)
(local-set-key "q" (lambda () (interactive) (kill-buffer nil)))
(local-set-key "=" (lambda () (interactive) (delete-other-windows)))
@@ -1704,7 +1719,7 @@ or the `pop-to-buffer' function."
cont)
(let ((alist mml-tweak-sexp-alist))
(while alist
- (if (eval (caar alist))
+ (if (eval (caar alist) t)
(funcall (cdar alist) cont))
(setq alist (cdr alist)))))
cont)
diff --git a/lisp/gnus/mml1991.el b/lisp/gnus/mml1991.el
index a87e642..05f44a1 100644
--- a/lisp/gnus/mml1991.el
+++ b/lisp/gnus/mml1991.el
@@ -1,4 +1,4 @@
-;;; mml1991.el --- Old PGP message format (RFC 1991) support for MML
+;;; mml1991.el --- Old PGP message format (RFC 1991) support for MML -*-
lexical-binding: t; -*-
;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
@@ -82,7 +82,7 @@ Whether the passphrase is cached at all is controlled by
(defvar mml1991-decrypt-function 'mailcrypt-decrypt)
(defvar mml1991-verify-function 'mailcrypt-verify)
-(defun mml1991-mailcrypt-sign (cont)
+(defun mml1991-mailcrypt-sign (_cont)
(let ((text (current-buffer))
headers signature
(result-buffer (get-buffer-create "*GPG Result*")))
@@ -118,7 +118,7 @@ Whether the passphrase is cached at all is controlled by
(declare-function mc-encrypt-generic "ext:mc-toplev"
(&optional recipients scheme start end from sign))
-(defun mml1991-mailcrypt-encrypt (cont &optional sign)
+(defun mml1991-mailcrypt-encrypt (_cont &optional sign)
(let ((text (current-buffer))
(mc-pgp-always-sign
(or mc-pgp-always-sign
@@ -171,8 +171,9 @@ Whether the passphrase is cached at all is controlled by
(defvar pgg-default-user-id)
(defvar pgg-errors-buffer)
(defvar pgg-output-buffer)
+(defvar pgg-text-mode)
-(defun mml1991-pgg-sign (cont)
+(defun mml1991-pgg-sign (_cont)
(let ((pgg-text-mode t)
(pgg-default-user-id (or (message-options-get 'mml-sender)
pgg-default-user-id))
@@ -209,7 +210,7 @@ Whether the passphrase is cached at all is controlled by
(buffer-string)))
t))
-(defun mml1991-pgg-encrypt (cont &optional sign)
+(defun mml1991-pgg-encrypt (_cont &optional sign)
(goto-char (point-min))
(when (re-search-forward "^$" nil t)
(let ((cte (save-restriction
@@ -257,7 +258,7 @@ Whether the passphrase is cached at all is controlled by
(autoload 'epg-configuration "epg-config")
(autoload 'epg-expand-group "epg-config")
-(defun mml1991-epg-sign (cont)
+(defun mml1991-epg-sign (_cont)
(let ((inhibit-redisplay t)
headers cte)
;; Don't sign headers.
diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el
index 8eda593..1af7d10 100644
--- a/lisp/gnus/mml2015.el
+++ b/lisp/gnus/mml2015.el
@@ -1,4 +1,4 @@
-;;; mml2015.el --- MIME Security with Pretty Good Privacy (PGP)
+;;; mml2015.el --- MIME Security with Pretty Good Privacy (PGP) -*-
lexical-binding: t; -*-
;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
@@ -185,7 +185,7 @@ If set, it overrides the setting of
`mml2015-sign-with-sender'."
(cadr err)
(format "%S" (cdr err))))
-(defun mml2015-mailcrypt-decrypt (handle ctl)
+(defun mml2015-mailcrypt-decrypt (handle _ctl)
(catch 'error
(let (child handles result)
(unless (setq child (mm-find-part-by-type
@@ -479,6 +479,7 @@ If set, it overrides the setting of
`mml2015-sign-with-sender'."
(defvar pgg-default-user-id)
(defvar pgg-errors-buffer)
(defvar pgg-output-buffer)
+(defvar pgg-text-mode)
(autoload 'pgg-decrypt-region "pgg")
(autoload 'pgg-verify-region "pgg")
@@ -486,10 +487,10 @@ If set, it overrides the setting of
`mml2015-sign-with-sender'."
(autoload 'pgg-encrypt-region "pgg")
(autoload 'pgg-parse-armor "pgg-parse")
-(defun mml2015-pgg-decrypt (handle ctl)
+(defun mml2015-pgg-decrypt (handle _ctl)
(catch 'error
(let ((pgg-errors-buffer mml2015-result-buffer)
- child handles result decrypt-status)
+ child handles decrypt-status) ;; result
(unless (setq child (mm-find-part-by-type
(cdr handle)
"application/octet-stream" nil t))
@@ -751,7 +752,7 @@ If set, it overrides the setting of
`mml2015-sign-with-sender'."
(let ((key-image (mml2015-epg-key-image key-id)))
(if (not key-image)
""
- (condition-case error
+ (condition-case nil
(let ((result " "))
(put-text-property
1 2 'display
@@ -770,10 +771,10 @@ If set, it overrides the setting of
`mml2015-sign-with-sender'."
(defun mml2015-epg-verify-result-to-string (verify-result)
(mapconcat #'mml2015-epg-signature-to-string verify-result "\n"))
-(defun mml2015-epg-decrypt (handle ctl)
+(defun mml2015-epg-decrypt (handle _ctl)
(catch 'error
(let ((inhibit-redisplay t)
- context plain child handles result decrypt-status)
+ context plain child handles) ;; decrypt-status result
(unless (setq child (mm-find-part-by-type
(cdr handle)
"application/octet-stream" nil t))
@@ -851,7 +852,7 @@ If set, it overrides the setting of
`mml2015-sign-with-sender'."
(defun mml2015-epg-verify (handle ctl)
(catch 'error
(let ((inhibit-redisplay t)
- context plain signature-file part signature)
+ context part signature) ;; plain signature-file
(when (or (null (setq part (mm-find-raw-part-by-type
ctl (or (mm-handle-multipart-ctl-parameter
ctl 'protocol)
@@ -866,12 +867,13 @@ If set, it overrides the setting of
`mml2015-sign-with-sender'."
signature (mm-get-part signature)
context (epg-make-context))
(condition-case error
- (setq plain (epg-verify-string context signature part))
+ ;; (setq plain
+ (epg-verify-string context signature part) ;;)
(error
(mm-sec-error 'gnus-info "Failed")
- (if (eq (car error) 'quit)
- (mm-sec-status 'gnus-details "Quit.")
- (mm-sec-status 'gnus-details (mml2015-format-error error)))
+ (mm-sec-status 'gnus-details (if (eq (car error) 'quit)
+ "Quit."
+ (mml2015-format-error error)))
(throw 'error handle)))
(mm-sec-status 'gnus-info
(mml2015-epg-verify-result-to-string
@@ -978,7 +980,7 @@ If set, it overrides the setting of
`mml2015-sign-with-sender'."
handle)))
;;;###autoload
-(defun mml2015-decrypt-test (handle ctl)
+(defun mml2015-decrypt-test (_handle _ctl)
mml2015-use)
;;;###autoload
@@ -990,7 +992,7 @@ If set, it overrides the setting of
`mml2015-sign-with-sender'."
handle)))
;;;###autoload
-(defun mml2015-verify-test (handle ctl)
+(defun mml2015-verify-test (_handle _ctl)
mml2015-use)
;;;###autoload
diff --git a/lisp/gnus/nnagent.el b/lisp/gnus/nnagent.el
index f2acea4..76a7e21 100644
--- a/lisp/gnus/nnagent.el
+++ b/lisp/gnus/nnagent.el
@@ -1,4 +1,4 @@
-;;; nnagent.el --- offline backend for Gnus
+;;; nnagent.el --- offline backend for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
@@ -86,7 +86,7 @@
server dir)
t))))
-(deffoo nnagent-retrieve-groups (groups &optional server)
+(deffoo nnagent-retrieve-groups (_groups &optional _server)
(save-excursion
(cond
((file-exists-p (gnus-agent-lib-file "groups"))
@@ -106,13 +106,13 @@
(funcall (gnus-get-function gnus-command-method 'request-type)
(gnus-group-real-name group) article)))))
-(deffoo nnagent-request-newgroups (date server)
+(deffoo nnagent-request-newgroups (_date _server)
nil)
-(deffoo nnagent-request-update-info (group info &optional server)
+(deffoo nnagent-request-update-info (_group _info &optional _server)
nil)
-(deffoo nnagent-request-post (&optional server)
+(deffoo nnagent-request-post (&optional _server)
(gnus-agent-insert-meta-information 'news gnus-command-method)
(gnus-request-accept-article "nndraft:queue" nil t t))
@@ -138,13 +138,13 @@
group action server)))
nil)
-(deffoo nnagent-retrieve-headers (articles &optional group server fetch-old)
+(deffoo nnagent-retrieve-headers (articles &optional group _server fetch-old)
(let ((file (gnus-agent-article-name ".overview" group))
arts n first)
(save-excursion
(gnus-agent-load-alist group)
(setq arts (gnus-sorted-difference
- articles (mapcar 'car gnus-agent-article-alist)))
+ articles (mapcar #'car gnus-agent-article-alist)))
;; Assume that articles with smaller numbers than the first one
;; Agent knows are gone.
(setq first (caar gnus-agent-article-alist))
@@ -184,7 +184,7 @@
t)
'nov)))
-(deffoo nnagent-request-expire-articles (articles group &optional server force)
+(deffoo nnagent-request-expire-articles (articles _group &optional _server
_force)
articles)
(deffoo nnagent-request-group (group &optional server dont-check info)
@@ -249,7 +249,7 @@
(nnoo-parent-function 'nnagent 'nnml-request-regenerate
(list (nnagent-server server))))
-(deffoo nnagent-retrieve-group-data-early (server infos)
+(deffoo nnagent-retrieve-group-data-early (_server _infos)
nil)
;; Use nnml functions for just about everything.
diff --git a/lisp/gnus/nnbabyl.el b/lisp/gnus/nnbabyl.el
index 130f56a..3e6f9e8 100644
--- a/lisp/gnus/nnbabyl.el
+++ b/lisp/gnus/nnbabyl.el
@@ -1,4 +1,4 @@
-;;; nnbabyl.el --- rmail mbox access for Gnus
+;;; nnbabyl.el --- rmail mbox access for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
@@ -70,7 +70,7 @@
(nnoo-define-basics nnbabyl)
-(deffoo nnbabyl-retrieve-headers (articles &optional group server fetch-old)
+(deffoo nnbabyl-retrieve-headers (articles &optional group server _fetch-old)
(with-current-buffer nntp-server-buffer
(erase-buffer)
(let ((number (length articles))
@@ -185,7 +185,7 @@
(cons nnbabyl-current-group article)
(nnbabyl-article-group-number)))))))
-(deffoo nnbabyl-request-group (group &optional server dont-check info)
+(deffoo nnbabyl-request-group (group &optional server dont-check _info)
(let ((active (cadr (assoc group nnbabyl-group-alist))))
(save-excursion
(cond
@@ -224,10 +224,10 @@
(insert-buffer-substring in-buf)))
(nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))))
-(deffoo nnbabyl-close-group (group &optional server)
+(deffoo nnbabyl-close-group (_group &optional _server)
t)
-(deffoo nnbabyl-request-create-group (group &optional server args)
+(deffoo nnbabyl-request-create-group (group &optional _server _args)
(nnmail-activate 'nnbabyl)
(unless (assoc group nnbabyl-group-alist)
(push (list group (cons 1 0))
@@ -235,18 +235,20 @@
(nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))
t)
-(deffoo nnbabyl-request-list (&optional server)
+(deffoo nnbabyl-request-list (&optional _server)
(save-excursion
(nnmail-find-file nnbabyl-active-file)
(setq nnbabyl-group-alist (nnmail-get-active))
t))
-(deffoo nnbabyl-request-newgroups (date &optional server)
+(deffoo nnbabyl-request-newgroups (_date &optional server)
(nnbabyl-request-list server))
-(deffoo nnbabyl-request-list-newsgroups (&optional server)
+(deffoo nnbabyl-request-list-newsgroups (&optional _server)
(nnheader-report 'nnbabyl "nnbabyl: LIST NEWSGROUPS is not implemented."))
+(defvar nnml-current-directory)
+
(deffoo nnbabyl-request-expire-articles
(articles newsgroup &optional server force)
(nnbabyl-possibly-change-newsgroup newsgroup server)
@@ -263,7 +265,8 @@
(nnmail-expired-article-p
newsgroup
(buffer-substring
- (point) (progn (end-of-line) (point))) force))
+ (point) (progn (end-of-line) (point)))
+ force))
(progn
(unless (eq nnmail-expiry-target 'delete)
(with-temp-buffer
@@ -292,7 +295,7 @@
(nconc rest articles))))
(deffoo nnbabyl-request-move-article
- (article group server accept-form &optional last move-is-internal)
+ (article group server accept-form &optional last _move-is-internal)
(let ((buf (gnus-get-buffer-create " *nnbabyl move*"))
result)
(and
@@ -304,7 +307,7 @@
"^X-Gnus-Newsgroup:"
(save-excursion (search-forward "\n\n" nil t) (point)) t)
(delete-region (point-at-bol) (progn (forward-line 1) (point))))
- (setq result (eval accept-form))
+ (setq result (eval accept-form t))
(kill-buffer (current-buffer))
result)
(save-excursion
@@ -554,13 +557,12 @@
(with-current-buffer nnbabyl-mbox-buffer
(= (buffer-size) (nnheader-file-size nnbabyl-mbox-file))))
;; This buffer has changed since we read it last. Possibly.
- (save-excursion
- (let ((delim (concat "^" nnbabyl-mail-delimiter))
- (alist nnbabyl-group-alist)
- start end number)
- (set-buffer (setq nnbabyl-mbox-buffer
- (nnheader-find-file-noselect
- nnbabyl-mbox-file nil t)))
+ (let ((delim (concat "^" nnbabyl-mail-delimiter))
+ (alist nnbabyl-group-alist)
+ start end number)
+ (with-current-buffer (setq nnbabyl-mbox-buffer
+ (nnheader-find-file-noselect
+ nnbabyl-mbox-file nil t))
;; Save previous buffer mode.
(setq nnbabyl-previous-buffer-mode
(cons (cons (point-min) (point-max))
diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el
index b3e83e4..15003fa 100644
--- a/lisp/gnus/nndiary.el
+++ b/lisp/gnus/nndiary.el
@@ -1,4 +1,4 @@
-;;; nndiary.el --- A diary back end for Gnus
+;;; nndiary.el --- A diary back end for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
@@ -149,7 +149,6 @@ In order to make this clear, here are some examples:
- (360 . minute): for an appointment at 18:30 and 15 seconds, this would
pop up the appointment message at 12:30."
- :group 'nndiary
:type '(repeat (cons :format "%v\n"
(integer :format "%v")
(choice :format "%[%v(s)%] before...\n"
@@ -163,8 +162,7 @@ In order to make this clear, here are some examples:
(defcustom nndiary-week-starts-on-monday nil
"Whether a week starts on monday (otherwise, sunday)."
- :type 'boolean
- :group 'nndiary)
+ :type 'boolean)
(define-obsolete-variable-alias 'nndiary-request-create-group-hooks
@@ -172,7 +170,6 @@ In order to make this clear, here are some examples:
(defcustom nndiary-request-create-group-functions nil
"Hook run after `nndiary-request-create-group' is executed.
The hook functions will be called with the full group name as argument."
- :group 'nndiary
:type 'hook)
(define-obsolete-variable-alias 'nndiary-request-update-info-hooks
@@ -180,7 +177,6 @@ The hook functions will be called with the full group name
as argument."
(defcustom nndiary-request-update-info-functions nil
"Hook run after `nndiary-request-update-info' is executed.
The hook functions will be called with the full group name as argument."
- :group 'nndiary
:type 'hook)
(define-obsolete-variable-alias 'nndiary-request-accept-article-hooks
@@ -189,12 +185,10 @@ The hook functions will be called with the full group
name as argument."
"Hook run before accepting an article.
Executed near the beginning of `nndiary-request-accept-article'.
The hook functions will be called with the article in the current buffer."
- :group 'nndiary
:type 'hook)
(defcustom nndiary-check-directory-twice t
"If t, check directories twice to avoid NFS failures."
- :group 'nndiary
:type 'boolean)
@@ -475,7 +469,7 @@ all. This may very well take some time.")
(cons (if group-num (car group-num) group)
(string-to-number (file-name-nondirectory path)))))))
-(deffoo nndiary-request-group (group &optional server dont-check info)
+(deffoo nndiary-request-group (group &optional server dont-check _info)
(let ((file-name-coding-system nnmail-pathname-coding-system))
(cond
((not (nndiary-possibly-change-directory group server))
@@ -509,11 +503,11 @@ all. This may very well take some time.")
(nndiary-possibly-change-directory group server)
(nnmail-get-new-mail 'nndiary 'nndiary-save-nov nndiary-directory group)))
-(deffoo nndiary-close-group (group &optional server)
+(deffoo nndiary-close-group (_group &optional _server)
(setq nndiary-article-file-alist nil)
t)
-(deffoo nndiary-request-create-group (group &optional server args)
+(deffoo nndiary-request-create-group (group &optional server _args)
(nndiary-possibly-change-directory nil server)
(nnmail-activate 'nndiary)
(cond
@@ -532,8 +526,8 @@ all. This may very well take some time.")
(nndiary-possibly-change-directory group server)
(let ((articles (nnheader-directory-articles nndiary-current-directory)))
(when articles
- (setcar active (apply 'min articles))
- (setcdr active (apply 'max articles))))
+ (setcar active (apply #'min articles))
+ (setcdr active (apply #'max articles))))
(nnmail-save-active nndiary-group-alist nndiary-active-file)
(run-hook-with-args 'nndiary-request-create-group-functions
(gnus-group-prefixed-name group
@@ -541,7 +535,7 @@ all. This may very well take some time.")
t))
))
-(deffoo nndiary-request-list (&optional server)
+(deffoo nndiary-request-list (&optional _server)
(save-excursion
(let ((nnmail-file-coding-system nnmail-active-file-coding-system)
(file-name-coding-system nnmail-pathname-coding-system))
@@ -549,10 +543,10 @@ all. This may very well take some time.")
(setq nndiary-group-alist (nnmail-get-active))
t))
-(deffoo nndiary-request-newgroups (date &optional server)
+(deffoo nndiary-request-newgroups (_date &optional server)
(nndiary-request-list server))
-(deffoo nndiary-request-list-newsgroups (&optional server)
+(deffoo nndiary-request-list-newsgroups (&optional _server)
(save-excursion
(nnmail-find-file nndiary-newsgroups-file)))
@@ -589,14 +583,14 @@ all. This may very well take some time.")
(let ((active (nth 1 (assoc group nndiary-group-alist))))
(when active
(setcar active (or (and active-articles
- (apply 'min active-articles))
+ (apply #'min active-articles))
(1+ (cdr active)))))
(nnmail-save-active nndiary-group-alist nndiary-active-file))
(nndiary-save-nov)
(nconc rest articles)))
(deffoo nndiary-request-move-article
- (article group server accept-form &optional last move-is-internal)
+ (article group server accept-form &optional last _move-is-internal)
(let ((buf (gnus-get-buffer-create " *nndiary move*"))
result)
(nndiary-possibly-change-directory group server)
@@ -609,7 +603,7 @@ all. This may very well take some time.")
nndiary-article-file-alist)
(with-current-buffer buf
(insert-buffer-substring nntp-server-buffer)
- (setq result (eval accept-form))
+ (setq result (eval accept-form t))
(kill-buffer (current-buffer))
result))
(progn
@@ -772,7 +766,7 @@ all. This may very well take some time.")
;;; Interface optional functions ============================================
-(deffoo nndiary-request-update-info (group info &optional server)
+(deffoo nndiary-request-update-info (group info &optional _server)
(nndiary-possibly-change-directory group)
(let ((timestamp (gnus-group-parameter-value (gnus-info-params info)
'timestamp t)))
@@ -960,7 +954,7 @@ all. This may very well take some time.")
(setq nndiary-article-file-alist
(sort
(nnheader-article-to-file-alist nndiary-current-directory)
- 'car-less-than-car)))
+ #'car-less-than-car)))
(setq active
(if nndiary-article-file-alist
(cons (caar nndiary-article-file-alist)
@@ -1039,6 +1033,8 @@ all. This may very well take some time.")
;; Save the active file.
(nnmail-save-active nndiary-group-alist nndiary-active-file))
+(defvar nndiary-files) ; dynamically bound in nndiary-generate-nov-databases-1
+
(defun nndiary-generate-nov-databases-1 (dir &optional seen no-active)
"Regenerate the NOV database in DIR."
(interactive "DRegenerate NOV in: ")
@@ -1055,7 +1051,7 @@ all. This may very well take some time.")
(nndiary-generate-nov-databases-1 dir seen))))
;; Do this directory.
(let ((nndiary-files (sort (nnheader-article-to-file-alist dir)
- 'car-less-than-car)))
+ #'car-less-than-car)))
(if (not nndiary-files)
(let* ((group (nnheader-file-to-group
(directory-file-name dir) nndiary-directory))
@@ -1068,7 +1064,6 @@ all. This may very well take some time.")
(unless no-active
(nnmail-save-active nndiary-group-alist nndiary-active-file))))))
-(defvar nndiary-files) ; dynamically bound in nndiary-generate-nov-databases-1
(defun nndiary-generate-active-info (dir)
;; Update the active info for this group.
(let* ((group (nnheader-file-to-group
@@ -1245,7 +1240,7 @@ all. This may very well take some time.")
(defun nndiary-unflatten (spec)
;; opposite of flatten: build ranges if possible
- (setq spec (sort spec '<))
+ (setq spec (sort spec #'<))
(let (min max res)
(while (setq min (pop spec))
(setq max min)
@@ -1300,7 +1295,7 @@ all. This may very well take some time.")
(apply #'encode-time 0 0 0 1 1 (nthcdr 5 date-elts))
(* (car reminder) 400861056))))
res))
- (sort res 'time-less-p)))
+ (sort res #'time-less-p)))
(defun nndiary-last-occurrence (sched)
;; Returns the last occurrence of schedule SCHED as an Emacs time struct, or
@@ -1318,8 +1313,8 @@ all. This may very well take some time.")
;; bored in finding a good algorithm for doing that ;-)
;; ### FIXME: remove identical entries.
(let ((dom-list (nth 2 sched))
- (month-list (sort (nndiary-flatten (nth 3 sched) 1 12) '>))
- (year-list (sort (nndiary-flatten (nth 4 sched) 1971) '>))
+ (month-list (sort (nndiary-flatten (nth 3 sched) 1 12) #'>))
+ (year-list (sort (nndiary-flatten (nth 4 sched) 1971) #'>))
(dow-list (nth 5 sched)))
;; Special case: an asterisk in one of the days specifications means
;; that only the other should be taken into account. If both are
@@ -1370,7 +1365,7 @@ all. This may very well take some time.")
(setq day (+ 7 day))))
;; Finally, if we have some days, they are valid
(when days
- (sort days '>)
+ (sort days #'>)
(throw 'found
(encode-time 0 minute hour
(car days) month year time-zone)))
@@ -1396,12 +1391,12 @@ all. This may very well take some time.")
(this-day (decoded-time-day today))
(this-month (decoded-time-month today))
(this-year (decoded-time-year today))
- (minute-list (sort (nndiary-flatten (nth 0 sched) 0 59) '<))
- (hour-list (sort (nndiary-flatten (nth 1 sched) 0 23) '<))
+ (minute-list (sort (nndiary-flatten (nth 0 sched) 0 59) #'<))
+ (hour-list (sort (nndiary-flatten (nth 1 sched) 0 23) #'<))
(dom-list (nth 2 sched))
- (month-list (sort (nndiary-flatten (nth 3 sched) 1 12) '<))
+ (month-list (sort (nndiary-flatten (nth 3 sched) 1 12) #'<))
(years (if (nth 4 sched)
- (sort (nndiary-flatten (nth 4 sched) 1971) '<)
+ (sort (nndiary-flatten (nth 4 sched) 1971) #'<)
t))
(dow-list (nth 5 sched))
(year (1- this-year))
@@ -1474,7 +1469,7 @@ all. This may very well take some time.")
;; Aaaaaaall right. Now we have a valid list of DAYS for
;; this month and this year.
(when days
- (setq days (sort days '<))
+ (setq days (sort days #'<))
;; Remove past days for this year and this month.
(and (= year this-year)
(= month this-month)
diff --git a/lisp/gnus/nndir.el b/lisp/gnus/nndir.el
index 46351d0..bfc2283 100644
--- a/lisp/gnus/nndir.el
+++ b/lisp/gnus/nndir.el
@@ -1,4 +1,4 @@
-;;; nndir.el --- single directory newsgroup access for Gnus
+;;; nndir.el --- single directory newsgroup access for Gnus -*-
lexical-binding: t; -*-
;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
diff --git a/lisp/gnus/nndoc.el b/lisp/gnus/nndoc.el
index a3a6645..172433e 100644
--- a/lisp/gnus/nndoc.el
+++ b/lisp/gnus/nndoc.el
@@ -1,4 +1,4 @@
-;;; nndoc.el --- single file access for Gnus
+;;; nndoc.el --- single file access for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
@@ -225,7 +225,7 @@ from the document.")
(nnoo-define-basics nndoc)
-(deffoo nndoc-retrieve-headers (articles &optional newsgroup server fetch-old)
+(deffoo nndoc-retrieve-headers (articles &optional newsgroup server _fetch-old)
(when (nndoc-possibly-change-buffer newsgroup server)
(with-current-buffer nntp-server-buffer
(erase-buffer)
@@ -256,11 +256,10 @@ from the document.")
(deffoo nndoc-request-article (article &optional newsgroup server buffer)
(nndoc-possibly-change-buffer newsgroup server)
- (save-excursion
- (let ((buffer (or buffer nntp-server-buffer))
- (entry (cdr (assq article nndoc-dissection-alist)))
- beg)
- (set-buffer buffer)
+ (let ((buffer (or buffer nntp-server-buffer))
+ (entry (cdr (assq article nndoc-dissection-alist)))
+ beg)
+ (with-current-buffer buffer
(erase-buffer)
(when entry
(cond
@@ -281,7 +280,7 @@ from the document.")
(funcall nndoc-article-transform-function article))
t))))))
-(deffoo nndoc-request-group (group &optional server dont-check info)
+(deffoo nndoc-request-group (group &optional server dont-check _info)
"Select news GROUP."
(let (number)
(cond
@@ -302,7 +301,7 @@ from the document.")
(nndoc-request-group group server))
t)
-(deffoo nndoc-request-type (group &optional article)
+(deffoo nndoc-request-type (_group &optional article)
(cond ((not article) 'unknown)
(nndoc-post-type nndoc-post-type)
(t 'unknown)))
@@ -318,19 +317,19 @@ from the document.")
(setq nndoc-dissection-alist nil)
t)
-(deffoo nndoc-request-list (&optional server)
+(deffoo nndoc-request-list (&optional _server)
t)
-(deffoo nndoc-request-newgroups (date &optional server)
+(deffoo nndoc-request-newgroups (_date &optional _server)
nil)
-(deffoo nndoc-request-list-newsgroups (&optional server)
+(deffoo nndoc-request-list-newsgroups (&optional _server)
nil)
;;; Internal functions.
-(defun nndoc-possibly-change-buffer (group source)
+(defun nndoc-possibly-change-buffer (group _source)
(let (buf)
(cond
;; The current buffer is this group's buffer.
@@ -427,9 +426,9 @@ from the document.")
(setq result nil))))
(unless (or result results)
(error "Document is not of any recognized type"))
- (if result
- (car entry)
- (cadar (last (sort results 'car-less-than-car))))))
+ (car (if result
+ entry
+ (cdar (last (sort results #'car-less-than-car)))))))
;;;
;;; Built-in type predicates and functions
@@ -678,7 +677,7 @@ from the document.")
(search-forward "\ncommit " nil t)
(search-forward "\nAuthor: " nil t)))
-(defun nndoc-transform-git-article (article)
+(defun nndoc-transform-git-article (_article)
(goto-char (point-min))
(when (re-search-forward "^Author: " nil t)
(replace-match "From: " t t)))
@@ -702,7 +701,7 @@ from the document.")
(re-search-forward "^\\\\\\\\\n\\(Paper\\( (\\*cross-listing\\*)\\)?:
[a-zA-Z\\.-]+/[0-9]+\\|arXiv:\\)" nil t))
t))
-(defun nndoc-transform-lanl-gov-announce (article)
+(defun nndoc-transform-lanl-gov-announce (_article)
(let ((case-fold-search nil))
(goto-char (point-max))
(when (re-search-backward "^\\\\\\\\ +( *\\([^ ]*\\) , *\\([^ ]*\\))" nil
t)
@@ -859,7 +858,7 @@ from the document.")
nil)
(goto-char point))))
-(deffoo nndoc-request-accept-article (group &optional server last)
+(deffoo nndoc-request-accept-article (_group &optional _server _last)
nil)
;;;
diff --git a/lisp/gnus/nndraft.el b/lisp/gnus/nndraft.el
index 1f87bed..394b6fc 100644
--- a/lisp/gnus/nndraft.el
+++ b/lisp/gnus/nndraft.el
@@ -1,4 +1,4 @@
-;;; nndraft.el --- draft article access for Gnus
+;;; nndraft.el --- draft article access for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
@@ -79,7 +79,7 @@ are generated if and only if they are also in
`message-draft-headers'."
server nndraft-directory)
t)))
-(deffoo nndraft-retrieve-headers (articles &optional group server fetch-old)
+(deffoo nndraft-retrieve-headers (articles &optional group server _fetch-old)
(nndraft-possibly-change-group group)
(with-current-buffer nntp-server-buffer
(erase-buffer)
@@ -108,7 +108,7 @@ are generated if and only if they are also in
`message-draft-headers'."
(nnheader-fold-continuation-lines)
'headers))))
-(deffoo nndraft-request-article (id &optional group server buffer)
+(deffoo nndraft-request-article (id &optional group _server buffer)
(nndraft-possibly-change-group group)
(when (numberp id)
;; We get the newest file of the auto-saved file and the
@@ -145,7 +145,7 @@ are generated if and only if they are also in
`message-draft-headers'."
;;(message-remove-header "date")
t))
-(deffoo nndraft-request-update-info (group info &optional server)
+(deffoo nndraft-request-update-info (group info &optional _server)
(nndraft-possibly-change-group group)
(setf (gnus-info-read info)
(gnus-update-read-articles
@@ -204,13 +204,13 @@ are generated if and only if they are also in
`message-draft-headers'."
(setq buffer-file-name (expand-file-name file)
buffer-auto-save-file-name (make-auto-save-file-name))
(clear-visited-file-modtime)
- (add-hook 'write-contents-functions 'nndraft-generate-headers nil t)
- (add-hook 'after-save-hook 'nndraft-update-unread-articles nil t)
+ (add-hook 'write-contents-functions #'nndraft-generate-headers nil t)
+ (add-hook 'after-save-hook #'nndraft-update-unread-articles nil t)
(message-add-action '(nndraft-update-unread-articles)
'exit 'postpone 'kill)
article))
-(deffoo nndraft-request-group (group &optional server dont-check info)
+(deffoo nndraft-request-group (group &optional server dont-check _info)
(nndraft-possibly-change-group group)
(unless dont-check
(let* ((pathname (nnmail-group-pathname group nndraft-directory))
@@ -229,7 +229,7 @@ are generated if and only if they are also in
`message-draft-headers'."
(list group server dont-check)))
(deffoo nndraft-request-move-article (article group server accept-form
- &optional last move-is-internal)
+ &optional _last _move-is-internal)
(nndraft-possibly-change-group group)
(let ((buf (gnus-get-buffer-create " *nndraft move*"))
result)
@@ -238,7 +238,7 @@ are generated if and only if they are also in
`message-draft-headers'."
(with-current-buffer buf
(erase-buffer)
(insert-buffer-substring nntp-server-buffer)
- (setq result (eval accept-form))
+ (setq result (eval accept-form t))
(kill-buffer (current-buffer))
result)
(null (nndraft-request-expire-articles (list article) group server
'force))
@@ -292,7 +292,7 @@ are generated if and only if they are also in
`message-draft-headers'."
(nnoo-parent-function 'nndraft 'nnmh-request-replace-article
(list article group buffer))))
-(deffoo nndraft-request-create-group (group &optional server args)
+(deffoo nndraft-request-create-group (group &optional _server _args)
(nndraft-possibly-change-group group)
(if (file-exists-p nndraft-current-directory)
(if (file-directory-p nndraft-current-directory)
@@ -316,27 +316,25 @@ are generated if and only if they are also in
`message-draft-headers'."
(nnheader-concat nndraft-directory group))))
(defun nndraft-article-filename (article &rest args)
- (apply 'concat
+ (apply #'concat
(file-name-as-directory nndraft-current-directory)
(int-to-string article)
args))
(defun nndraft-auto-save-file-name (file)
- (save-excursion
+ (with-current-buffer (gnus-get-buffer-create " *draft tmp*")
+ (setq buffer-file-name file)
(prog1
- (progn
- (set-buffer (gnus-get-buffer-create " *draft tmp*"))
- (setq buffer-file-name file)
- (make-auto-save-file-name))
+ (make-auto-save-file-name)
(kill-buffer (current-buffer)))))
(defun nndraft-articles ()
"Return the list of messages in the group."
(gnus-make-directory nndraft-current-directory)
(sort
- (mapcar 'string-to-number
+ (mapcar #'string-to-number
(directory-files nndraft-current-directory nil "\\`[0-9]+\\'" t))
- '<))
+ #'<))
(nnoo-import nndraft
(nnmh
diff --git a/lisp/gnus/nneething.el b/lisp/gnus/nneething.el
index 014ad3a..d881d6c 100644
--- a/lisp/gnus/nneething.el
+++ b/lisp/gnus/nneething.el
@@ -1,4 +1,4 @@
-;;; nneething.el --- arbitrary file access for Gnus
+;;; nneething.el --- arbitrary file access for Gnus -*- lexical-binding: t;
-*-
;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
@@ -77,7 +77,7 @@ included.")
(nnoo-define-basics nneething)
-(deffoo nneething-retrieve-headers (articles &optional group server fetch-old)
+(deffoo nneething-retrieve-headers (articles &optional group _server
_fetch-old)
(nneething-possibly-change-directory group)
(with-current-buffer nntp-server-buffer
@@ -114,7 +114,7 @@ included.")
(nnheader-fold-continuation-lines)
'headers))))
-(deffoo nneething-request-article (id &optional group server buffer)
+(deffoo nneething-request-article (id &optional group _server buffer)
(nneething-possibly-change-directory group)
(let ((file (unless (stringp id)
(nneething-file-name id)))
@@ -143,7 +143,7 @@ included.")
(insert "\n"))
t))))
-(deffoo nneething-request-group (group &optional server dont-check info)
+(deffoo nneething-request-group (group &optional server dont-check _info)
(nneething-possibly-change-directory group server)
(unless dont-check
(nneething-create-mapping)
@@ -156,16 +156,16 @@ included.")
group)))
t)
-(deffoo nneething-request-list (&optional server dir)
+(deffoo nneething-request-list (&optional _server _dir)
(nnheader-report 'nneething "LIST is not implemented."))
-(deffoo nneething-request-newgroups (date &optional server)
+(deffoo nneething-request-newgroups (_date &optional _server)
(nnheader-report 'nneething "NEWSGROUPS is not implemented."))
-(deffoo nneething-request-type (group &optional article)
+(deffoo nneething-request-type (_group &optional _article)
'unknown)
-(deffoo nneething-close-group (group &optional server)
+(deffoo nneething-close-group (_group &optional _server)
(setq nneething-current-directory nil)
t)
diff --git a/lisp/gnus/nnfolder.el b/lisp/gnus/nnfolder.el
index 9a0219c..1dd784d 100644
--- a/lisp/gnus/nnfolder.el
+++ b/lisp/gnus/nnfolder.el
@@ -1,4 +1,4 @@
-;;; nnfolder.el --- mail folder access for Gnus
+;;; nnfolder.el --- mail folder access for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
@@ -145,7 +145,7 @@ all. This may very well take some time.")
'nov
(setq articles (gnus-sorted-intersection
;; Is ARTICLES sorted?
- (sort articles '<)
+ (sort articles #'<)
(nnfolder-existing-articles)))
(while (setq article (pop articles))
(set-buffer nnfolder-current-buffer)
@@ -261,7 +261,7 @@ all. This may very well take some time.")
(point) (point-at-eol)))
-1))))))))
-(deffoo nnfolder-request-group (group &optional server dont-check info)
+(deffoo nnfolder-request-group (group &optional server dont-check _info)
(nnfolder-possibly-change-group group server t)
(save-excursion
(cond ((not (assoc group nnfolder-group-alist))
@@ -314,7 +314,7 @@ all. This may very well take some time.")
;; over the buffer again unless we add new mail to it or modify it in some
;; way.
-(deffoo nnfolder-close-group (group &optional server force)
+(deffoo nnfolder-close-group (group &optional _server _force)
;; Make sure we _had_ the group open.
(when (or (assoc group nnfolder-buffer-alist)
(equal group nnfolder-current-group))
@@ -342,7 +342,7 @@ all. This may very well take some time.")
nnfolder-current-buffer nil)
t)
-(deffoo nnfolder-request-create-group (group &optional server args)
+(deffoo nnfolder-request-create-group (group &optional server _args)
(nnfolder-possibly-change-group nil server)
(nnmail-activate 'nnfolder)
(cond ((zerop (length group))
@@ -369,7 +369,7 @@ all. This may very well take some time.")
(setq nnfolder-group-alist (nnmail-get-active)))
t))
-(deffoo nnfolder-request-newgroups (date &optional server)
+(deffoo nnfolder-request-newgroups (_date &optional server)
(nnfolder-possibly-change-group nil server)
(nnfolder-request-list server))
@@ -383,9 +383,8 @@ all. This may very well take some time.")
;; current folder.
(defun nnfolder-existing-articles ()
- (save-excursion
- (when nnfolder-current-buffer
- (set-buffer nnfolder-current-buffer)
+ (when nnfolder-current-buffer
+ (with-current-buffer nnfolder-current-buffer
(goto-char (point-min))
(let ((marker (concat "\n" nnfolder-article-marker))
(number "[0-9]+")
@@ -395,12 +394,13 @@ all. This may very well take some time.")
(let ((newnum (string-to-number (match-string 0))))
(if (nnmail-within-headers-p)
(push newnum numbers))))
- ;; The article numbers are increasing, so this result is sorted.
+ ;; The article numbers are increasing, so this result is sorted.
(nreverse numbers)))))
(autoload 'gnus-request-group "gnus-int")
(declare-function gnus-request-create-group "gnus-int"
(group &optional gnus-command-method args))
+(defvar nnfolder-current-directory)
(deffoo nnfolder-request-expire-articles (articles newsgroup
&optional server force)
@@ -463,7 +463,7 @@ all. This may very well take some time.")
(gnus-sorted-difference articles (nreverse deleted-articles)))))
(deffoo nnfolder-request-move-article (article group server accept-form
- &optional last move-is-internal)
+ &optional last _move-is-internal)
(save-excursion
(let ((buf (gnus-get-buffer-create " *nnfolder move*"))
result)
@@ -478,7 +478,7 @@ all. This may very well take some time.")
(save-excursion (and (search-forward "\n\n" nil t) (point)))
t)
(gnus-delete-line))
- (setq result (eval accept-form))
+ (setq result (eval accept-form t))
(kill-buffer buf)
result)
(save-excursion
@@ -499,7 +499,7 @@ all. This may very well take some time.")
(save-excursion
(nnfolder-possibly-change-group group server)
(nnmail-check-syntax)
- (let ((buf (current-buffer))
+ (let (;; (buf (current-buffer))
result art-group)
(goto-char (point-min))
(when (looking-at "X-From-Line: ")
diff --git a/lisp/gnus/nngateway.el b/lisp/gnus/nngateway.el
index 15e4876..c10989a 100644
--- a/lisp/gnus/nngateway.el
+++ b/lisp/gnus/nngateway.el
@@ -1,4 +1,4 @@
-;;; nngateway.el --- posting news via mail gateways
+;;; nngateway.el --- posting news via mail gateways -*- lexical-binding: t;
-*-
;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el
index a381720..708887c 100644
--- a/lisp/gnus/nnheader.el
+++ b/lisp/gnus/nnheader.el
@@ -1,4 +1,4 @@
-;;; nnheader.el --- header access macros for Gnus and its backends
+;;; nnheader.el --- header access macros for Gnus and its backends -*-
lexical-binding: t; -*-
;; Copyright (C) 1987-1990, 1993-1998, 2000-2021 Free Software
;; Foundation, Inc.
@@ -468,7 +468,7 @@ leaving the original buffer untouched."
(defun nnheader-write-overview-file (file headers)
"Write HEADERS to FILE."
(with-temp-file file
- (mapcar 'nnheader-insert-nov headers)))
+ (mapcar #'nnheader-insert-nov headers)))
(defun nnheader-insert-header (header)
(insert
@@ -723,15 +723,15 @@ an alarming frequency on NFS mounted file systems. If it
is nil,
(defun nnheader-directory-files-safe (&rest args)
"Execute `directory-files' twice and returns the longer result."
- (let ((first (apply 'directory-files args))
- (second (apply 'directory-files args)))
+ (let ((first (apply #'directory-files args))
+ (second (apply #'directory-files args)))
(if (> (length first) (length second))
first
second)))
(defun nnheader-directory-articles (dir)
"Return a list of all article files in directory DIR."
- (mapcar 'nnheader-file-to-number
+ (mapcar #'nnheader-file-to-number
(if nnheader-directory-files-is-safe
(directory-files
dir nil nnheader-numerical-short-files t)
@@ -783,7 +783,7 @@ The first string in ARGS can be a format string."
(set (intern (format "%s-status-string" backend))
(if (< (length args) 2)
(car args)
- (apply 'format args)))
+ (apply #'format args)))
nil)
(defun nnheader-get-report-string (backend)
@@ -804,8 +804,8 @@ without formatting."
(with-current-buffer nntp-server-buffer
(erase-buffer)
(if (string-match "%" format)
- (insert (apply 'format format args))
- (apply 'insert format args))
+ (insert (apply #'format format args))
+ (apply #'insert format args))
t))
(defsubst nnheader-replace-chars-in-string (string from to)
@@ -841,12 +841,13 @@ without formatting."
(defun nnheader-message (level &rest args)
"Message if the Gnus backends are talkative."
- (if (or (not (numberp gnus-verbose-backends))
- (<= level gnus-verbose-backends))
- (if gnus-add-timestamp-to-message
- (apply 'gnus-message-with-timestamp args)
- (apply 'message args))
- (apply 'format args)))
+ (apply (cond
+ ((and (numberp gnus-verbose-backends)
+ (> level gnus-verbose-backends))
+ #'format)
+ (gnus-add-timestamp-to-message #'gnus-message-with-timestamp)
+ (t #'message))
+ args))
(defun nnheader-be-verbose (level)
"Return whether the backends should be verbose on LEVEL."
@@ -877,7 +878,7 @@ without formatting."
(defun nnheader-concat (dir &rest files)
"Concat DIR as directory to FILES."
- (apply 'concat (file-name-as-directory dir) files))
+ (apply #'concat (file-name-as-directory dir) files))
(defun nnheader-ms-strip-cr ()
"Strip ^M from the end of all lines."
@@ -915,7 +916,7 @@ first. Otherwise, find the newest one, though it may take
a time."
(setq path (cdr path))))
(if (or first (not (cdr results)))
(car results)
- (car (sort results 'file-newer-than-file-p)))))
+ (car (sort results #'file-newer-than-file-p)))))
(defvar ange-ftp-path-format)
(defvar efs-path-regexp)
@@ -961,15 +962,15 @@ find-file-hook, etc.
"Open a file with some variables bound.
See `find-file-noselect' for the arguments."
(cl-letf* ((format-alist nil)
- (auto-mode-alist (mm-auto-mode-alist))
- ((default-value 'major-mode) 'fundamental-mode)
- (enable-local-variables nil)
- (after-insert-file-functions nil)
- (enable-local-eval nil)
- (coding-system-for-read nnheader-file-coding-system)
- (version-control 'never)
- (find-file-hook nil))
- (apply 'find-file-noselect args)))
+ (auto-mode-alist (mm-auto-mode-alist))
+ ((default-value 'major-mode) 'fundamental-mode)
+ (enable-local-variables nil)
+ (after-insert-file-functions nil)
+ (enable-local-eval nil)
+ (coding-system-for-read nnheader-file-coding-system)
+ (version-control 'never)
+ (find-file-hook nil))
+ (apply #'find-file-noselect args)))
(defun nnheader-directory-regular-files (dir)
"Return a list of all regular files in DIR."
@@ -983,7 +984,7 @@ See `find-file-noselect' for the arguments."
(defun nnheader-directory-files (&rest args)
"Same as `directory-files', but prune \".\" and \"..\"."
- (let ((files (apply 'directory-files args))
+ (let ((files (apply #'directory-files args))
out)
(while files
(unless (member (file-name-nondirectory (car files)) '("." ".."))
@@ -1065,7 +1066,7 @@ See `find-file-noselect' for the arguments."
(let ((now (current-time)))
(when (time-less-p 1 (time-subtract now nnheader-last-message-time))
(setq nnheader-last-message-time now)
- (apply 'nnheader-message args))))
+ (apply #'nnheader-message args))))
(make-obsolete-variable 'nnheader-load-hook
"use `with-eval-after-load' instead." "28.1")
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index 1215131..f4f4ef8 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -1,4 +1,4 @@
-;;; nnimap.el --- IMAP interface for Gnus
+;;; nnimap.el --- IMAP interface for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
@@ -143,8 +143,7 @@ textual parts.")
(defcustom nnimap-request-articles-find-limit nil
"Limit the number of articles to look for after moving an article."
:type '(choice (const nil) integer)
- :version "24.4"
- :group 'nnimap)
+ :version "24.4")
(define-obsolete-variable-alias
'nnimap-split-download-body-default 'nnimap-split-download-body
@@ -1005,7 +1004,7 @@ during splitting, which may be slow."
internal-move-group server message-id
nnimap-request-articles-find-limit)))))
;; Move the article to a different method.
- (when-let* ((result (eval accept-form)))
+ (when-let* ((result (eval accept-form t)))
(nnimap-change-group group server)
(nnimap-delete-article article)
result))))))
@@ -1166,7 +1165,7 @@ If LIMIT, first try to limit the search to the N last
articles."
7 "Article marked for deletion, but not expunged.")
nil))))
-(deffoo nnimap-request-scan (&optional group server)
+(deffoo nnimap-request-scan (&optional _group server)
(when (and (nnimap-change-group nil server)
nnimap-inbox
nnimap-split-methods)
diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el
index d043ae1..9826bc6 100644
--- a/lisp/gnus/nnmail.el
+++ b/lisp/gnus/nnmail.el
@@ -1,4 +1,4 @@
-;;; nnmail.el --- mail support functions for the Gnus mail backends
+;;; nnmail.el --- mail support functions for the Gnus mail backends -*-
lexical-binding: t; -*-
;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
@@ -598,7 +598,7 @@ These will be logged to the \"*nnmail split*\" buffer."
-(defun nnmail-request-post (&optional server)
+(defun nnmail-request-post (&optional _server)
(mail-send-and-exit nil))
(defvar nnmail-file-coding-system 'raw-text
@@ -664,7 +664,7 @@ nn*-request-list should have been called before calling
this function."
(let ((buffer (current-buffer))
group-assoc group max min)
(while (not (eobp))
- (condition-case err
+ (condition-case nil
(progn
(narrow-to-region (point) (point-at-eol))
(setq group (read buffer)
@@ -712,7 +712,7 @@ If SOURCE is a directory spec, try to return the group name
component."
(if (eq (car source) 'directory)
(let ((file (file-name-nondirectory file)))
(mail-source-bind (directory source)
- (if (string-match (concat (regexp-quote suffix) "$") file)
+ (if (string-match (concat (regexp-quote suffix) "\\'") file)
(substring file 0 (match-beginning 0))
nil)))
nil))
@@ -1281,7 +1281,7 @@ Return the number of characters in the body."
"Remove list identifiers from Subject headers."
(let ((regexp
(if (consp nnmail-list-identifiers)
- (mapconcat 'identity nnmail-list-identifiers " *\\|")
+ (mapconcat #'identity nnmail-list-identifiers " *\\|")
nnmail-list-identifiers)))
(when regexp
(goto-char (point-min))
@@ -1321,8 +1321,8 @@ Eudora has a broken References line, but an OK
In-Reply-To."
(when (re-search-forward "^\\(In-Reply-To:[^\n]+\\)\n[ \t]+" nil t)
(replace-match "\\1" t))))
-(defalias 'nnmail-fix-eudora-headers 'nnmail-ignore-broken-references)
-(make-obsolete 'nnmail-fix-eudora-headers 'nnmail-ignore-broken-references
"Emacs 23.1")
+(defalias 'nnmail-fix-eudora-headers #'nnmail-ignore-broken-references)
+(make-obsolete 'nnmail-fix-eudora-headers #'nnmail-ignore-broken-references
"Emacs 23.1")
(custom-add-option 'nnmail-prepare-incoming-header-hook
'nnmail-ignore-broken-references)
@@ -1332,14 +1332,15 @@ Eudora has a broken References line, but an OK
In-Reply-To."
(declare-function gnus-activate-group "gnus-start"
(group &optional scan dont-check method dont-sub-check))
-(defun nnmail-do-request-post (accept-func &optional server)
+(defun nnmail-do-request-post (accept-func &optional _server)
"Utility function to directly post a message to an nnmail-derived group.
Calls ACCEPT-FUNC (which should be `nnchoke-request-accept-article')
to actually put the message in the right group."
(let ((success t))
(dolist (mbx (message-unquote-tokens
(message-tokenize-header
- (message-fetch-field "Newsgroups") ", ")) success)
+ (message-fetch-field "Newsgroups") ", "))
+ success)
(let ((to-newsgroup (gnus-group-prefixed-name mbx gnus-command-method)))
(or (gnus-active to-newsgroup)
(gnus-activate-group to-newsgroup)
@@ -1396,7 +1397,7 @@ See the documentation for the variable
`nnmail-split-fancy' for details."
;; Builtin : operation.
((eq (car split) ':)
(nnmail-log-split split)
- (nnmail-split-it (save-excursion (eval (cdr split)))))
+ (nnmail-split-it (save-excursion (eval (cdr split) t))))
;; Builtin ! operation.
((eq (car split) '!)
@@ -1433,11 +1434,11 @@ See the documentation for the variable
`nnmail-split-fancy' for details."
;; we do not exclude foo.list just because
;; the header is: ``To: x-foo, foo''
(goto-char end)
- (if (and (re-search-backward (cadr split-rest)
- after-header-name t)
- (> (match-end 0) start-of-value))
- (setq split-rest nil)
- (setq split-rest (cddr split-rest))))
+ (setq split-rest
+ (unless (and (re-search-backward (cadr split-rest)
+ after-header-name t)
+ (> (match-end 0) start-of-value))
+ (cddr split-rest))))
(when split-rest
(goto-char end)
;; Someone might want to do a \N sub on this match, so
@@ -1528,7 +1529,7 @@ See the documentation for the variable
`nnmail-split-fancy' for details."
expanded))))
(setq pos (1+ pos)))
(if did-expand
- (apply 'concat (nreverse expanded))
+ (apply #'concat (nreverse expanded))
newtext)))
;; Activate a backend only if it isn't already activated.
@@ -1623,7 +1624,7 @@ See the documentation for the variable
`nnmail-split-fancy' for details."
(gnus-methods-equal-p gnus-command-method
(nnmail-cache-primary-mail-backend)))
(let ((regexp (if (consp nnmail-cache-ignore-groups)
- (mapconcat 'identity nnmail-cache-ignore-groups
+ (mapconcat #'identity nnmail-cache-ignore-groups
"\\|")
nnmail-cache-ignore-groups)))
(unless (and regexp (string-match regexp grp))
@@ -1766,7 +1767,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more
details."
(defvar nnmail-fetched-sources nil)
(defun nnmail-get-value (&rest args)
- (let ((sym (intern (apply 'format args))))
+ (let ((sym (intern (apply #'format args))))
(when (boundp sym)
(symbol-value sym))))
@@ -1811,10 +1812,10 @@ be called once per group or once for all groups."
(setq source (append source
(list
:predicate
- (gnus-byte-compile
- `(lambda (file)
+ (let ((str (concat group suffix)))
+ (lambda (file)
(string-equal
- ,(concat group suffix)
+ str
(file-name-nondirectory file)))))))))
(when nnmail-fetched-sources
(if (member source nnmail-fetched-sources)
@@ -1835,17 +1836,19 @@ be called once per group or once for all groups."
(condition-case cond
(mail-source-fetch
source
- (gnus-byte-compile
- `(lambda (file orig-file)
+ (let ((smsym (intern (format "%s-save-mail" method)))
+ (ansym (intern (format "%s-active-number"
method)))
+ (src source))
+ (lambda (file orig-file)
(nnmail-split-incoming
- file ',(intern (format "%s-save-mail" method))
- ',spool-func
+ file smsym
+ spool-func
(or in-group
(if (equal file orig-file)
nil
(nnmail-get-split-group orig-file
- ',source)))
- ',(intern (format "%s-active-number" method))))))
+ src)))
+ ansym))))
((error quit)
(message "Mail source %s failed: %s" source cond)
0)))
@@ -1917,7 +1920,7 @@ If TIME is nil, then return the cutoff time for oldness
instead."
(cdr group-art))
(gnus-group-mark-article-read target (cdr group-art))))))))
-(defun nnmail-fancy-expiry-target (group)
+(defun nnmail-fancy-expiry-target (_group)
"Return a target expiry group determined by `nnmail-fancy-expiry-targets'."
(let* (header
(case-fold-search nil)
diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el
index 2a4c74d..46691e3 100644
--- a/lisp/gnus/nnmaildir.el
+++ b/lisp/gnus/nnmaildir.el
@@ -48,16 +48,6 @@
;;; Code:
-;; eval this before editing
-[(progn
- (put 'nnmaildir--with-nntp-buffer 'lisp-indent-function 0)
- (put 'nnmaildir--with-work-buffer 'lisp-indent-function 0)
- (put 'nnmaildir--with-nov-buffer 'lisp-indent-function 0)
- (put 'nnmaildir--with-move-buffer 'lisp-indent-function 0)
- (put 'nnmaildir--condcase 'lisp-indent-function 2)
- )
-]
-
(require 'nnheader)
(require 'gnus)
(require 'gnus-util)
@@ -111,7 +101,7 @@ SUFFIX should start with \":2,\"."
(new-flags
(concat (gnus-delete-duplicates
;; maildir flags must be sorted
- (sort (cons flag flags-as-list) '<)))))
+ (sort (cons flag flags-as-list) #'<)))))
(concat ":2," new-flags)))
(defun nnmaildir--remove-flag (flag suffix)
@@ -264,19 +254,19 @@ This variable is set by `nnmaildir-request-article'.")
(eval param t))
(defmacro nnmaildir--with-nntp-buffer (&rest body)
- (declare (debug (body)))
+ (declare (indent 0) (debug t))
`(with-current-buffer nntp-server-buffer
,@body))
(defmacro nnmaildir--with-work-buffer (&rest body)
- (declare (debug (body)))
+ (declare (indent 0) (debug t))
`(with-current-buffer (gnus-get-buffer-create " *nnmaildir work*")
,@body))
(defmacro nnmaildir--with-nov-buffer (&rest body)
- (declare (debug (body)))
+ (declare (indent 0) (debug t))
`(with-current-buffer (gnus-get-buffer-create " *nnmaildir nov*")
,@body))
(defmacro nnmaildir--with-move-buffer (&rest body)
- (declare (debug (body)))
+ (declare (indent 0) (debug t))
`(with-current-buffer (gnus-get-buffer-create " *nnmaildir move*")
,@body))
@@ -302,7 +292,7 @@ This variable is set by `nnmaildir-request-article'.")
(write-region "" nil file nil 'no-message))
(defun nnmaildir--delete-dir-files (dir ls)
(when (file-attributes dir)
- (mapc 'delete-file (funcall ls dir 'full "\\`[^.]" 'nosort))
+ (mapc #'delete-file (funcall ls dir 'full "\\`[^.]" 'nosort))
(delete-directory dir)))
(defun nnmaildir--group-maxnum (server group)
@@ -358,7 +348,7 @@ This variable is set by `nnmaildir-request-article'.")
string)
(defmacro nnmaildir--condcase (errsym body &rest handler)
- (declare (debug (sexp form body)))
+ (declare (indent 2) (debug (sexp form body)))
`(condition-case ,errsym
(let ((system-messages-locale "C")) ,body)
(error . ,handler)))
@@ -865,8 +855,8 @@ This variable is set by `nnmaildir-request-article'.")
file))
files)
files (delq nil files)
- files (mapcar 'nnmaildir--parse-filename files)
- files (sort files 'nnmaildir--sort-files))
+ files (mapcar #'nnmaildir--parse-filename files)
+ files (sort files #'nnmaildir--sort-files))
(dolist (file files)
(setq file (if (consp file) file (aref file 3))
x (make-nnmaildir--art :prefix (car file) :suffix (cdr file)))
@@ -1008,7 +998,7 @@ This variable is set by `nnmaildir-request-article'.")
always-marks (nnmaildir--param pgname 'always-marks)
never-marks (nnmaildir--param pgname 'never-marks)
existing (nnmaildir--grp-nlist group)
- existing (mapcar 'car existing)
+ existing (mapcar #'car existing)
existing (nreverse existing)
existing (gnus-compress-sequence existing 'always-list)
missing (list (cons 1 (nnmaildir--group-maxnum
@@ -1023,8 +1013,8 @@ This variable is set by `nnmaildir-request-article'.")
;; get mark names from mark dirs and from flag
;; mappings
(append
- (mapcar 'cdr nnmaildir-flag-mark-mapping)
- (mapcar 'intern (funcall ls dir nil "\\`[^.]"
'nosort))))
+ (mapcar #'cdr nnmaildir-flag-mark-mapping)
+ (mapcar #'intern (funcall ls dir nil "\\`[^.]"
'nosort))))
new-mmth (make-hash-table :size (length all-marks))
old-mmth (nnmaildir--grp-mmth group))
(dolist (mark all-marks)
@@ -1080,7 +1070,7 @@ This variable is set by `nnmaildir-request-article'.")
(let ((article (nnmaildir--flist-art flist prefix)))
(when article
(push (nnmaildir--art-num article) article-list))))))
- (setq ranges (gnus-add-to-range ranges (sort article-list '<)))))
+ (setq ranges (gnus-add-to-range ranges (sort article-list #'<)))))
(if (eq mark 'read) (setq read ranges)
(if ranges (setq marks (cons (cons mark ranges) marks)))))
(setf (gnus-info-read info) (gnus-range-add read missing))
@@ -1705,8 +1695,8 @@ This variable is set by `nnmaildir-request-article'.")
;; get mark names from mark dirs and from flag
;; mappings
(append
- (mapcar 'cdr nnmaildir-flag-mark-mapping)
- (mapcar 'intern all-marks))))
+ (mapcar #'cdr nnmaildir-flag-mark-mapping)
+ (mapcar #'intern all-marks))))
(dolist (action actions)
(setq ranges (car action)
todo-marks (caddr action))
diff --git a/lisp/gnus/nnmairix.el b/lisp/gnus/nnmairix.el
index c061031..c6aaf46 100644
--- a/lisp/gnus/nnmairix.el
+++ b/lisp/gnus/nnmairix.el
@@ -1,4 +1,4 @@
-;;; nnmairix.el --- Mairix back end for Gnus, the Emacs newsreader
+;;; nnmairix.el --- Mairix back end for Gnus, the Emacs newsreader -*-
lexical-binding: t; -*-
;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
@@ -193,8 +193,8 @@
(define-key gnus-summary-mode-map
(kbd "G G u") 'nnmairix-remove-tick-mark-original-article))
-(add-hook 'gnus-group-mode-hook 'nnmairix-group-mode-hook)
-(add-hook 'gnus-summary-mode-hook 'nnmairix-summary-mode-hook)
+(add-hook 'gnus-group-mode-hook #'nnmairix-group-mode-hook)
+(add-hook 'gnus-summary-mode-hook #'nnmairix-summary-mode-hook)
;; ;;;###autoload
;; (defun nnmairix-initialize (&optional force)
@@ -202,8 +202,8 @@
;; (if (not (or (file-readable-p "~/.mairixrc")
;; force))
;; (message "No file `~/.mairixrc', skipping nnmairix setup")
-;; (add-hook 'gnus-group-mode-hook 'nnmairix-group-mode-hook)
-;; (add-hook 'gnus-summary-mode-hook 'nnmairix-summary-mode-hook)))
+;; (add-hook 'gnus-group-mode-hook #'nnmairix-group-mode-hook)
+;; (add-hook 'gnus-summary-mode-hook #'nnmairix-summary-mode-hook)))
;; Customizable stuff
@@ -219,20 +219,17 @@ server will be this prefix plus a random number. You can
delete
unused nnmairix groups on the back end using
`nnmairix-purge-old-groups'."
:version "23.1"
- :type 'string
- :group 'nnmairix)
+ :type 'string)
(defcustom nnmairix-mairix-output-buffer "*mairix output*"
"Buffer used for mairix output."
:version "23.1"
- :type 'string
- :group 'nnmairix)
+ :type 'string)
(defcustom nnmairix-customize-query-buffer "*mairix query*"
"Name of the buffer for customizing Mairix queries."
:version "23.1"
- :type 'string
- :group 'nnmairix)
+ :type 'string)
(defcustom nnmairix-mairix-update-options '("-F" "-Q")
"Options when calling mairix for updating the database.
@@ -240,21 +237,18 @@ 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)."
:version "23.1"
- :type '(repeat string)
- :group 'nnmairix)
+ :type '(repeat string))
(defcustom nnmairix-mairix-search-options '("-Q")
"Options when calling mairix for searching.
The default is \"-Q\" for making searching faster."
:version "23.1"
- :type '(repeat string)
- :group 'nnmairix)
+ :type '(repeat string))
(defcustom nnmairix-mairix-synchronous-update nil
"Set this to t if you want Emacs to wait for mairix updating the database."
:version "23.1"
- :type 'boolean
- :group 'nnmairix)
+ :type 'boolean)
(defcustom nnmairix-rename-files-for-nnml t
"Rename nnml mail files so that they are consecutively numbered.
@@ -263,8 +257,7 @@ article numbers which will produce wrong article counts by
Gnus. This option controls whether nnmairix should rename the
files consecutively."
:version "23.1"
- :type 'boolean
- :group 'nnmairix)
+ :type 'boolean)
(defcustom nnmairix-widget-fields-list
'(("from" "f" "From") ("to" "t" "To") ("cc" "c" "Cc")
@@ -288,16 +281,14 @@ nil for disabling this)."
(const :tag "Subject" "subject")
(const :tag "Message ID" "Message-ID"))
(string :tag "Command")
- (string :tag "Description")))
- :group 'nnmairix)
+ (string :tag "Description"))))
(defcustom nnmairix-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."
:version "23.1"
- :type 'function
- :group 'nnmairix)
+ :type 'function)
(defcustom nnmairix-propagate-marks-upon-close t
"Flag if marks should be propagated upon closing a group.
@@ -308,8 +299,7 @@ call `nnmairix-propagate-marks'."
:version "23.1"
:type '(choice (const :tag "always" t)
(const :tag "ask" ask)
- (const :tag "never" nil))
- :group 'nnmairix)
+ (const :tag "never" nil)))
(defcustom nnmairix-propagate-marks-to-nnmairix-groups nil
"Flag if marks from original articles should be seen in nnmairix groups.
@@ -319,8 +309,7 @@ e.g. an IMAP server (which stores the marks in the maildir
file
name). You may safely set this to t for testing - the worst that
can happen are wrong marks in nnmairix groups."
:version "23.1"
- :type 'boolean
- :group 'nnmairix)
+ :type 'boolean)
(defcustom nnmairix-only-use-registry nil
"Use only the registry for determining original group(s).
@@ -330,16 +319,14 @@ propagating marks). If set to nil, it will also try to
determine
the group from an additional mairix search which might be slow
when propagating lots of marks."
:version "23.1"
- :type 'boolean
- :group 'nnmairix)
+ :type 'boolean)
(defcustom nnmairix-allowfast-default nil
"Whether fast entering should be the default for nnmairix groups.
You may set this to t to make entering the group faster, but note that
this might lead to problems, especially when used with marks propagation."
:version "23.1"
- :type 'boolean
- :group 'nnmairix)
+ :type 'boolean)
;; ==== Other variables
@@ -417,7 +404,7 @@ Other back ends might or might not work.")
(setq nnmairix-current-server server)
(nnoo-change-server 'nnmairix server definitions))
-(deffoo nnmairix-request-group (group &optional server fast info)
+(deffoo nnmairix-request-group (group &optional server fast _info)
;; Call mairix and request group on back end server
(when server (nnmairix-open-server server))
(let* ((qualgroup (if server
@@ -430,7 +417,7 @@ Other back ends might or might not work.")
(backendmethod (gnus-server-to-method
(format "%s:%s" (symbol-name nnmairix-backend)
nnmairix-backend-server)))
- rval mfolder folderpath args)
+ rval mfolder folderpath) ;; args
(cond
((not folder)
;; No folder parameter -> error
@@ -510,12 +497,12 @@ Other back ends might or might not work.")
nil))))))
-(deffoo nnmairix-request-create-group (group &optional server args)
+(deffoo nnmairix-request-create-group (group &optional server _args)
(let ((qualgroup (if server (gnus-group-prefixed-name group (list 'nnmairix
server))
group))
(exist t)
(count 0)
- groupname info)
+ groupname) ;; info
(when server (nnmairix-open-server server))
(gnus-group-add-parameter qualgroup '(query . nil))
(gnus-group-add-parameter qualgroup '(threads . nil))
@@ -574,7 +561,7 @@ Other back ends might or might not work.")
(deffoo nnmairix-request-list (&optional server)
(when server (nnmairix-open-server server))
(if (nnmairix-call-backend "request-list" nnmairix-backend-server)
- (let (cpoint cur qualgroup folder)
+ (let (cpoint cur qualgroup) ;; folder
(with-current-buffer nntp-server-buffer
(goto-char (point-min))
(setq cpoint (point))
@@ -603,7 +590,7 @@ Other back ends might or might not work.")
(nnmairix-open-server server))
(let* ((qualgroup (gnus-group-prefixed-name group (list 'nnmairix
nnmairix-current-server)))
(propmarks (gnus-group-get-parameter qualgroup 'propmarks))
- (propto (gnus-group-get-parameter qualgroup 'propto t))
+ ;; (propto (gnus-group-get-parameter qualgroup 'propto t))
(corr (nnmairix-get-numcorr group server))
(folder (nnmairix-get-backend-folder group server)))
(save-excursion
@@ -611,7 +598,7 @@ Other back ends might or might not work.")
(let ((type (nth 1 cur))
(cmdmarks (nth 2 cur))
(range (gnus-uncompress-range (nth 0 cur)))
- mid ogroup number method temp)
+ mid ogroup temp) ;; number method
(when (and corr
(not (zerop (cadr corr))))
(setq range (mapcar (lambda (arg)
@@ -674,7 +661,7 @@ Other back ends might or might not work.")
(nnmairix-open-server server))
(let* ((qualgroup (gnus-group-prefixed-name group (list 'nnmairix
nnmairix-current-server)))
(propmarks (gnus-group-get-parameter qualgroup 'propmarks))
- method)
+ ) ;; method
(when (and propmarks
nnmairix-marks-cache)
(when (or (eq nnmairix-propagate-marks-upon-close t)
@@ -689,9 +676,9 @@ Other back ends might or might not work.")
(autoload 'nnimap-request-update-info-internal "nnimap")
(deffoo nnmairix-request-marks (group info &optional server)
-;; propagate info from underlying IMAP folder to nnmairix group
-;; This is currently experimental and must be explicitly activated
-;; with nnmairix-propagate-marks-to-nnmairix-group
+ ;; propagate info from underlying IMAP folder to nnmairix group
+ ;; This is currently experimental and must be explicitly activated
+ ;; with nnmairix-propagate-marks-to-nnmairix-group
(when server
(nnmairix-open-server server))
(let* ((qualgroup (gnus-group-prefixed-name
@@ -703,7 +690,7 @@ Other back ends might or might not work.")
(corr (nnmairix-get-numcorr group server))
(docorr (and corr (not (zerop (cadr corr)))))
(folderinfo `(,group 1 ((1 . 1))))
- readrange marks)
+ ) ;; readrange marks
(when (and propmarks
nnmairix-propagate-marks-to-nnmairix-groups)
;; these groups are not subscribed, so we have to ask the back end
directly
@@ -714,8 +701,8 @@ Other back ends might or might not work.")
(setf (gnus-info-read info)
(if docorr
(nnmairix-map-range
- ;; FIXME: Use lexical-binding.
- `(lambda (x) (+ x ,(cadr corr)))
+ (let ((off (cadr corr)))
+ (lambda (x) (+ x off)))
(gnus-info-read folderinfo))
(gnus-info-read folderinfo)))
;; set other marks
@@ -725,8 +712,8 @@ Other back ends might or might not work.")
(cons
(car cur)
(nnmairix-map-range
- ;; FIXME: Use lexical-binding.
- `(lambda (x) (+ x ,(cadr corr)))
+ (let ((off (cadr corr)))
+ (lambda (x) (+ x off)))
(list (cadr cur)))))
(gnus-info-marks folderinfo))
(gnus-info-marks folderinfo))))
@@ -757,10 +744,9 @@ called interactively, user will be asked for parameters."
(when (not (listp query))
(setq query (list query)))
(when (and server group query)
- (save-excursion
- (let ((groupname (gnus-group-prefixed-name group server))
- info)
- (set-buffer gnus-group-buffer)
+ (let ((groupname (gnus-group-prefixed-name group server))
+ ) ;; info
+ (with-current-buffer gnus-group-buffer
(gnus-group-make-group group server)
(gnus-group-set-parameter groupname 'query query)
(gnus-group-set-parameter groupname 'threads threads)
@@ -783,7 +769,7 @@ called interactively, user will be asked for parameters."
(setq finished (not (y-or-n-p "Add another search query? "))
achar nil))
(nnmairix-search
- (mapconcat 'identity query " ")
+ (mapconcat #'identity query " ")
(car (nnmairix-get-server))
(y-or-n-p "Include whole threads? "))))
@@ -792,7 +778,7 @@ called interactively, user will be asked for parameters."
(interactive)
(let ((char-header nnmairix-interactive-query-parameters)
(server (nnmairix-backend-to-server gnus-current-select-method))
- query achar header finished group threads cq)
+ query achar header finished group threads) ;; cq
(when (or (not (gnus-buffer-live-p gnus-article-buffer))
(not (gnus-buffer-live-p gnus-summary-buffer)))
(error "No article or summary buffer"))
@@ -810,7 +796,8 @@ called interactively, user will be asked for parameters."
(setq achar nil)))
(set-buffer gnus-article-buffer)
(setq header nil)
- (when (setq cq (nth 1 (assoc achar char-header)))
+ (when ;; (setq cq
+ (nth 1 (assoc achar char-header)) ;;)
(setq header
(nnmairix-replace-illegal-chars
(gnus-fetch-field (nth 1 (assoc achar char-header))))))
@@ -824,7 +811,7 @@ called interactively, user will be asked for parameters."
(setq group (read-string "Group name: "))
(set-buffer gnus-summary-buffer)
(message "Creating group %s on server %s with query %s." group
- (gnus-method-to-server server) (mapconcat 'identity query " "))
+ (gnus-method-to-server server) (mapconcat #'identity query " "))
(nnmairix-create-search-group server group query threads)))
(defun nnmairix-create-server-and-default-group ()
@@ -841,7 +828,7 @@ All necessary information will be queried from the user."
(hidden (and (string-match "^nn\\(imap\\|maildir\\)$" backend)
(y-or-n-p
"Does the back end server work with maildir++ (i.e.
hidden directories)? ")))
- create)
+ ) ;; create
(apply (intern (format "%s-%s" backend "open-server"))
(list servername))
@@ -866,7 +853,7 @@ All necessary information will be queried from the user."
(if (eq (car method) 'nnmairix)
(progn
(when (listp oldquery)
- (setq oldquery (mapconcat 'identity oldquery " ")))
+ (setq oldquery (mapconcat #'identity oldquery " ")))
(setq query (or query
(read-string "New query: " oldquery)))
(when (stringp query)
@@ -1023,7 +1010,7 @@ before deleting a group on the back end. SERVER
specifies nnmairix server."
(if (nnmairix-open-server (nth 1 server))
(when (nnmairix-call-backend
"request-list" nnmairix-backend-server)
- (let (cur qualgroup folder)
+ (let (cur qualgroup) ;; folder
(with-current-buffer nntp-server-buffer
(goto-char (point-min))
(while (re-search-forward nnmairix-group-regexp (point-max) t)
@@ -1068,7 +1055,7 @@ with `nnmairix-mairix-update-options'."
(if (> (length commandsplit) 1)
(setq args (append args (cdr commandsplit)
nnmairix-mairix-update-options))
(setq args (append args nnmairix-mairix-update-options)))
- (apply 'call-process args)
+ (apply #'call-process args)
(nnheader-message 7 "Updating mairix database for %s... done" cur))
(progn
(setq args (append (list cur (get-buffer
nnmairix-mairix-output-buffer)
@@ -1076,7 +1063,7 @@ with `nnmairix-mairix-update-options'."
(if (> (length commandsplit) 1)
(setq args (append args (cdr commandsplit)
nnmairix-mairix-update-options))
(setq args (append args nnmairix-mairix-update-options)))
- (set-process-sentinel (apply 'start-process args)
+ (set-process-sentinel (apply #'start-process args)
'nnmairix-sentinel-mairix-update-finished))))))
(defun nnmairix-group-delete-recreate-this-group ()
@@ -1186,7 +1173,7 @@ Marks propagation has to be enabled for this to work."
(error "Not in a nnmairix group"))
(save-excursion
(let ((mid (mail-header-message-id (gnus-summary-article-header)))
- groups cur)
+ groups) ;; cur
(when mid
(setq groups (nnmairix-determine-original-group-from-registry mid))
(unless (or groups
@@ -1260,7 +1247,7 @@ If THREADS is non-nil, enable full threads."
(setq args (append args '("-c"))))
(when threads
(setq args (append args '("-t"))))
- (apply 'call-process
+ (apply #'call-process
(append args (list "-o" folder) searchquery)))))
(defun nnmairix-call-mairix-binary-raw (command query)
@@ -1272,7 +1259,7 @@ If THREADS is non-nil, enable full threads."
(when (> (length command) 1)
(setq args (append args (cdr command))))
(setq args (append args '("-r")))
- (apply 'call-process
+ (apply #'call-process
(append args query)))))
(defun nnmairix-get-server ()
@@ -1313,7 +1300,7 @@ If ALL is t, return also the unopened/failed ones."
"Return list of valid back end servers for nnmairix groups."
(let ((alist gnus-opened-servers)
(mairixservers (nnmairix-get-nnmairix-servers t))
- server mserver openedserver occ cur)
+ server mserver openedserver occ) ;; cur
;; Get list of all nnmairix backends (i.e. backends which are
;; already occupied)
(dolist (cur mairixservers)
@@ -1382,9 +1369,9 @@ This should correct problems of wrong article counts when
using
nnmairix with nnml backends."
(let* ((files
(sort
- (mapcar 'string-to-number
+ (mapcar #'string-to-number
(directory-files path nil "[0-9]+" t))
- '<))
+ #'<))
(lastplusone (car files))
(path (file-name-as-directory path)))
(dolist (cur files)
@@ -1407,7 +1394,7 @@ TYPE is either `nov' or `headers'."
(let ((buf (gnus-get-buffer-create " *nnmairix buffer*"))
(corr (not (zerop numc)))
(name (buffer-name nntp-server-buffer))
- header cur xref)
+ cur xref) ;; header
(with-current-buffer buf
(erase-buffer)
(set-buffer nntp-server-buffer)
@@ -1600,7 +1587,7 @@ search in raw mode."
(when (not (gnus-buffer-live-p gnus-article-buffer))
(error "No article buffer available"))
(let ((server (nth 1 gnus-current-select-method))
- mid rval group allgroups)
+ mid group allgroups) ;; rval
;; get message id
(with-current-buffer gnus-article-buffer
(gnus-summary-toggle-header 1)
@@ -1774,7 +1761,7 @@ If VERSION is a string: must be contained in mairix
version output."
(let* ((commandsplit (split-string nnmairix-mairix-command))
(args (append (list (car commandsplit))
'(nil t nil) (cdr commandsplit) '("-V"))))
- (apply 'call-process args)
+ (apply #'call-process args)
(goto-char (point-min))
(re-search-forward "mairix.*")
(match-string 0))))
@@ -1831,10 +1818,10 @@ MVALUES may contain values from current article."
(widget-create 'push-button
:notify
(if mvalues
- (lambda (&rest ignore)
+ (lambda (&rest _ignore)
(nnmairix-widget-send-query nnmairix-widgets
t))
- (lambda (&rest ignore)
+ (lambda (&rest _ignore)
(nnmairix-widget-send-query nnmairix-widgets
nil)))
"Send Query")
@@ -1842,16 +1829,16 @@ MVALUES may contain values from current article."
(widget-create 'push-button
:notify
(if mvalues
- (lambda (&rest ignore)
+ (lambda (&rest _ignore)
(nnmairix-widget-create-group nnmairix-widgets
t))
- (lambda (&rest ignore)
+ (lambda (&rest _ignore)
(nnmairix-widget-create-group nnmairix-widgets
nil)))
"Create permanent group")
(widget-insert " ")
(widget-create 'push-button
- :notify (lambda (&rest ignore)
+ :notify (lambda (&rest _ignore)
(kill-buffer nnmairix-customize-query-buffer))
"Cancel")
(use-local-map widget-keymap)
@@ -1920,13 +1907,13 @@ If WITHVALUES is t, query is based on current article."
(when (not (zerop (length flag)))
(push (concat "F:" flag) query)))
;; return query string
- (mapconcat 'identity query " ")))
+ (mapconcat #'identity query " ")))
(defun nnmairix-widget-create-query (&optional values)
"Create widgets for creating mairix queries.
Fill in VALUES if based on an article."
- (let (allwidgets)
+ ;;(let (allwidgets)
(when (get-buffer nnmairix-customize-query-buffer)
(kill-buffer nnmairix-customize-query-buffer))
(switch-to-buffer nnmairix-customize-query-buffer)
@@ -1957,7 +1944,7 @@ Fill in VALUES if based on an article."
(when (member 'threads nnmairix-widget-other)
(widget-insert "\n")
(nnmairix-widget-add "Threads" 'checkbox nil))
- (widget-insert " Show full threads\n\n")))
+ (widget-insert " Show full threads\n\n")) ;; )
(defun nnmairix-widget-build-editable-fields (values)
"Build editable field widgets in `nnmairix-widget-fields-list'.
@@ -1974,7 +1961,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)
(nnmairix-widget-toggle-activate
widget))
nil)))
(list
@@ -1997,7 +1984,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))
nnmairix-widgets))
(defun nnmairix-widget-toggle-activate (widget)
diff --git a/lisp/gnus/nnmbox.el b/lisp/gnus/nnmbox.el
index a4863c3..66c2267 100644
--- a/lisp/gnus/nnmbox.el
+++ b/lisp/gnus/nnmbox.el
@@ -1,4 +1,4 @@
-;;; nnmbox.el --- mail mbox access for Gnus
+;;; nnmbox.el --- mail mbox access for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
@@ -76,7 +76,7 @@
(nnoo-define-basics nnmbox)
-(deffoo nnmbox-retrieve-headers (sequence &optional newsgroup server fetch-old)
+(deffoo nnmbox-retrieve-headers (sequence &optional newsgroup server
_fetch-old)
(with-current-buffer nntp-server-buffer
(erase-buffer)
(let ((number (length sequence))
@@ -168,7 +168,7 @@
(cons nnmbox-current-group article)
(nnmbox-article-group-number nil))))))))
-(deffoo nnmbox-request-group (group &optional server dont-check info)
+(deffoo nnmbox-request-group (group &optional server dont-check _info)
(nnmbox-possibly-change-newsgroup nil server)
(let ((active (cadr (assoc group nnmbox-group-alist))))
(cond
@@ -207,17 +207,16 @@
(file-name-directory nnmbox-mbox-file)
group
(lambda ()
- (save-excursion
- (let ((in-buf (current-buffer)))
- (set-buffer nnmbox-mbox-buffer)
+ (let ((in-buf (current-buffer)))
+ (with-current-buffer nnmbox-mbox-buffer
(goto-char (point-max))
(insert-buffer-substring in-buf)))
(nnmbox-save-active nnmbox-group-alist nnmbox-active-file))))
-(deffoo nnmbox-close-group (group &optional server)
+(deffoo nnmbox-close-group (_group &optional _server)
t)
-(deffoo nnmbox-request-create-group (group &optional server args)
+(deffoo nnmbox-request-create-group (group &optional _server _args)
(nnmail-activate 'nnmbox)
(unless (assoc group nnmbox-group-alist)
(push (list group (cons 1 0))
@@ -225,7 +224,7 @@
(nnmbox-save-active nnmbox-group-alist nnmbox-active-file))
t)
-(deffoo nnmbox-request-list (&optional server)
+(deffoo nnmbox-request-list (&optional _server)
(save-excursion
(let ((nnmail-file-coding-system
nnmbox-active-file-coding-system))
@@ -233,12 +232,14 @@
(setq nnmbox-group-alist (nnmail-get-active))
t))
-(deffoo nnmbox-request-newgroups (date &optional server)
+(deffoo nnmbox-request-newgroups (_date &optional server)
(nnmbox-request-list server))
-(deffoo nnmbox-request-list-newsgroups (&optional server)
+(deffoo nnmbox-request-list-newsgroups (&optional _server)
(nnheader-report 'nnmbox "LIST NEWSGROUPS is not implemented."))
+(defvar nnml-current-directory)
+
(deffoo nnmbox-request-expire-articles
(articles newsgroup &optional server force)
(nnmbox-possibly-change-newsgroup newsgroup server)
@@ -279,7 +280,7 @@
(nconc rest articles))))
(deffoo nnmbox-request-move-article
- (article group server accept-form &optional last move-is-internal)
+ (article group server accept-form &optional last _move-is-internal)
(let ((buf (gnus-get-buffer-create " *nnmbox move*"))
result)
(and
@@ -292,7 +293,7 @@
"^X-Gnus-Newsgroup:"
(save-excursion (search-forward "\n\n" nil t) (point)) t)
(gnus-delete-line))
- (setq result (eval accept-form))
+ (setq result (eval accept-form t))
(kill-buffer buf)
result)
(save-excursion
@@ -622,16 +623,15 @@
(with-current-buffer nnmbox-mbox-buffer
(= (buffer-size) (nnheader-file-size nnmbox-mbox-file))))
()
- (save-excursion
- (let ((delim (concat "^" message-unix-mail-delimiter))
- (alist nnmbox-group-alist)
- (nnmbox-group-building-active-articles t)
- start end end-header number)
- (set-buffer (setq nnmbox-mbox-buffer
- (let ((nnheader-file-coding-system
- nnmbox-file-coding-system))
- (nnheader-find-file-noselect
- nnmbox-mbox-file t t))))
+ (let ((delim (concat "^" message-unix-mail-delimiter))
+ (alist nnmbox-group-alist)
+ (nnmbox-group-building-active-articles t)
+ start end end-header number)
+ (with-current-buffer (setq nnmbox-mbox-buffer
+ (let ((nnheader-file-coding-system
+ nnmbox-file-coding-system))
+ (nnheader-find-file-noselect
+ nnmbox-mbox-file t t)))
(mm-enable-multibyte)
(buffer-disable-undo)
(gnus-add-buffer)
diff --git a/lisp/gnus/nnmh.el b/lisp/gnus/nnmh.el
index 82ed091..231583f 100644
--- a/lisp/gnus/nnmh.el
+++ b/lisp/gnus/nnmh.el
@@ -1,4 +1,4 @@
-;;; nnmh.el --- mhspool access for Gnus
+;;; nnmh.el --- mhspool access for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
@@ -72,7 +72,7 @@ as unread by Gnus.")
(nnoo-define-basics nnmh)
-(deffoo nnmh-retrieve-headers (articles &optional newsgroup server fetch-old)
+(deffoo nnmh-retrieve-headers (articles &optional newsgroup server _fetch-old)
(with-current-buffer nntp-server-buffer
(erase-buffer)
(let* ((file nil)
@@ -147,7 +147,7 @@ as unread by Gnus.")
(save-excursion (nnmail-find-file file))
(string-to-number (file-name-nondirectory file)))))
-(deffoo nnmh-request-group (group &optional server dont-check info)
+(deffoo nnmh-request-group (group &optional server dont-check _info)
(nnheader-init-server-buffer)
(nnmh-possibly-change-directory group server)
(let ((pathname (nnmail-group-pathname group nnmh-directory))
@@ -171,9 +171,9 @@ as unread by Gnus.")
(nnheader-re-read-dir pathname)
(setq dir
(sort
- (mapcar 'string-to-number
+ (mapcar #'string-to-number
(directory-files pathname nil "\\`[0-9]+\\'" t))
- '<))
+ #'<))
(cond
(dir
(setq nnmh-group-alist
@@ -188,9 +188,11 @@ as unread by Gnus.")
(nnheader-report 'nnmh "Empty group %s" group)
(nnheader-insert (format "211 0 1 0 %s\n" group))))))))))
-(deffoo nnmh-request-scan (&optional group server)
+(deffoo nnmh-request-scan (&optional group _server)
(nnmail-get-new-mail 'nnmh nil nnmh-directory group))
+(defvar nnmh-toplev)
+
(deffoo nnmh-request-list (&optional server dir)
(nnheader-insert "")
(nnmh-possibly-change-directory nil server)
@@ -201,13 +203,12 @@ as unread by Gnus.")
(setq nnmh-group-alist (nnmail-get-active))
t)
-(defvar nnmh-toplev)
(defun nnmh-request-list-1 (dir)
(setq dir (expand-file-name dir))
;; Recurse down all directories.
(let ((files (nnheader-directory-files dir t nil t))
(max 0)
- min rdir num subdirectoriesp file)
+ min num subdirectoriesp file) ;; rdir
;; Recurse down directories.
(setq subdirectoriesp
;; link number always 1 on MS Windows :(
@@ -252,7 +253,7 @@ as unread by Gnus.")
(or min 1))))))
t)
-(deffoo nnmh-request-newgroups (date &optional server)
+(deffoo nnmh-request-newgroups (_date &optional server)
(nnmh-request-list server))
(deffoo nnmh-request-expire-articles (articles newsgroup
@@ -291,11 +292,11 @@ as unread by Gnus.")
(nnheader-message 5 "")
(nconc rest articles)))
-(deffoo nnmh-close-group (group &optional server)
+(deffoo nnmh-close-group (_group &optional _server)
t)
-(deffoo nnmh-request-move-article (article group server accept-form
- &optional last move-is-internal)
+(deffoo nnmh-request-move-article ( article group server accept-form
+ &optional _last _move-is-internal)
(let ((buf (gnus-get-buffer-create " *nnmh move*"))
result)
(and
@@ -304,7 +305,7 @@ as unread by Gnus.")
(with-current-buffer buf
(erase-buffer)
(insert-buffer-substring nntp-server-buffer)
- (setq result (eval accept-form))
+ (setq result (eval accept-form t))
(kill-buffer (current-buffer))
result)
(progn
@@ -350,7 +351,7 @@ as unread by Gnus.")
nil (if (nnheader-be-verbose 5) nil 'nomesg))
t)))
-(deffoo nnmh-request-create-group (group &optional server args)
+(deffoo nnmh-request-create-group (group &optional server _args)
(nnheader-init-server-buffer)
(unless (assoc group nnmh-group-alist)
(let (active)
@@ -358,12 +359,12 @@ as unread by Gnus.")
nnmh-group-alist)
(nnmh-possibly-create-directory group)
(nnmh-possibly-change-directory group server)
- (let ((articles (mapcar 'string-to-number
+ (let ((articles (mapcar #'string-to-number
(directory-files
nnmh-current-directory nil "\\`[0-9]+\\'"))))
(when articles
- (setcar active (apply 'min articles))
- (setcdr active (apply 'max articles))))))
+ (setcar active (apply #'min articles))
+ (setcdr active (apply #'max articles))))))
t)
(deffoo nnmh-request-delete-group (group &optional force server)
@@ -484,9 +485,9 @@ as unread by Gnus.")
(gnus-make-directory dir))
;; Find the highest number in the group.
(let ((files (sort
- (mapcar 'string-to-number
+ (mapcar #'string-to-number
(directory-files dir nil "\\`[0-9]+\\'"))
- '>)))
+ #'>)))
(when files
(setcdr active (car files)))))
(setcdr active (1+ (cdr active)))
@@ -507,10 +508,10 @@ as unread by Gnus.")
;; articles in this folder. The articles that are "new" will be
;; marked as unread by Gnus.
(let* ((dir nnmh-current-directory)
- (files (sort (mapcar 'string-to-number
+ (files (sort (mapcar #'string-to-number
(directory-files nnmh-current-directory
nil "\\`[0-9]+\\'" t))
- '<))
+ #'<))
(nnmh-file (concat dir ".nnmh-articles"))
new articles)
;; Load the .nnmh-articles file.
@@ -557,7 +558,7 @@ as unread by Gnus.")
(when new
(gnus-make-articles-unread
(gnus-group-prefixed-name group (list 'nnmh ""))
- (setq new (sort new '<))))
+ (setq new (sort new #'<))))
;; Sort the article list with highest numbers first.
(setq articles (sort articles (lambda (art1 art2)
(> (car art1) (car art2)))))
diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el
index 3cdfc74..18acc73 100644
--- a/lisp/gnus/nnml.el
+++ b/lisp/gnus/nnml.el
@@ -1,4 +1,4 @@
-;;; nnml.el --- mail spool access for Gnus
+;;; nnml.el --- mail spool access for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
@@ -111,7 +111,7 @@ non-nil.")
(nnoo-define-basics nnml)
-(defun nnml-group-pathname (group &optional file server)
+(defun nnml-group-pathname (group &optional file _server)
"Return an absolute file name of FILE for GROUP on SERVER."
(nnmail-group-pathname group nnml-directory file))
@@ -215,7 +215,7 @@ non-nil.")
(cons (if group-num (car group-num) group)
(string-to-number (file-name-nondirectory path)))))))
-(deffoo nnml-request-group (group &optional server dont-check info)
+(deffoo nnml-request-group (group &optional server dont-check _info)
(let ((file-name-coding-system nnmail-pathname-coding-system))
(cond
((not (nnml-possibly-change-directory group server))
@@ -252,11 +252,11 @@ non-nil.")
(t
(nnmail-get-new-mail 'nnml 'nnml-save-incremental-nov nnml-directory
nil))))
-(deffoo nnml-close-group (group &optional server)
+(deffoo nnml-close-group (_group &optional _server)
(setq nnml-article-file-alist nil)
t)
-(deffoo nnml-request-create-group (group &optional server args)
+(deffoo nnml-request-create-group (group &optional server _args)
(nnml-possibly-change-directory nil server)
(nnmail-activate 'nnml)
(cond
@@ -278,12 +278,12 @@ non-nil.")
(let* ((file-name-coding-system nnmail-pathname-coding-system)
(articles (nnml-directory-articles nnml-current-directory)))
(when articles
- (setcar active (apply 'min articles))
- (setcdr active (apply 'max articles))))
+ (setcar active (apply #'min articles))
+ (setcdr active (apply #'max articles))))
(nnmail-save-active nnml-group-alist nnml-active-file)
t))))
-(deffoo nnml-request-list (&optional server)
+(deffoo nnml-request-list (&optional _server)
(save-excursion
(let ((nnmail-file-coding-system nnmail-active-file-coding-system)
(file-name-coding-system nnmail-pathname-coding-system))
@@ -291,10 +291,10 @@ non-nil.")
(setq nnml-group-alist (nnmail-get-active))
t))
-(deffoo nnml-request-newgroups (date &optional server)
+(deffoo nnml-request-newgroups (_date &optional server)
(nnml-request-list server))
-(deffoo nnml-request-list-newsgroups (&optional server)
+(deffoo nnml-request-list-newsgroups (&optional _server)
(save-excursion
(nnmail-find-file nnml-newsgroups-file)))
@@ -307,7 +307,7 @@ non-nil.")
article rest mod-time number target)
(nnmail-activate 'nnml)
- (setq active-articles (sort active-articles '<))
+ (setq active-articles (sort active-articles #'<))
;; Articles not listed in active-articles are already gone,
;; so don't try to expire them.
(setq articles (gnus-sorted-intersection articles active-articles))
@@ -353,14 +353,14 @@ non-nil.")
(let ((active (nth 1 (assoc-string group nnml-group-alist))))
(when active
(setcar active (or (and active-articles
- (apply 'min active-articles))
+ (apply #'min active-articles))
(1+ (cdr active)))))
(nnmail-save-active nnml-group-alist nnml-active-file))
(nnml-save-nov)
(nconc rest articles)))
(deffoo nnml-request-move-article
- (article group server accept-form &optional last move-is-internal)
+ (article group server accept-form &optional last _move-is-internal)
(let ((buf (gnus-get-buffer-create " *nnml move*"))
(file-name-coding-system nnmail-pathname-coding-system)
result)
@@ -374,7 +374,7 @@ non-nil.")
nnml-article-file-alist)
(with-current-buffer buf
(insert-buffer-substring nntp-server-buffer)
- (setq result (eval accept-form))
+ (setq result (eval accept-form t))
(kill-buffer (current-buffer))
result))
(progn
@@ -411,8 +411,8 @@ non-nil.")
(and
(nnmail-activate 'nnml)
(if (and (not (setq result (nnmail-article-group
- `(lambda (group)
- (nnml-active-number group ,server)))))
+ (lambda (group)
+ (nnml-active-number group server)))))
(yes-or-no-p "Moved to `junk' group; delete article? "))
(setq result 'junk)
(setq result (car (nnml-save-mail result server t))))
@@ -705,7 +705,7 @@ article number. This function is called narrowed to an
article."
(setq nnml-article-file-alist
(sort
(nnml-current-group-article-to-file-alist)
- 'car-less-than-car)))
+ #'car-less-than-car)))
(setq active
(if nnml-article-file-alist
(cons (caar nnml-article-file-alist)
@@ -856,7 +856,7 @@ Unless no-active is non-nil, update the active file too."
(nnml-generate-nov-databases-directory dir seen)))
;; Do this directory.
(let ((nnml-files (sort (nnheader-article-to-file-alist dir)
- 'car-less-than-car)))
+ #'car-less-than-car)))
(if (not nnml-files)
(let* ((group (nnheader-file-to-group
(directory-file-name dir) nnml-directory))
@@ -889,7 +889,7 @@ Unless no-active is non-nil, update the active file too."
(let* ((dir (file-name-as-directory dir))
(nov (concat dir nnml-nov-file-name))
(nov-buffer (gnus-get-buffer-create " *nov*"))
- chars file headers)
+ chars headers) ;; file
(with-current-buffer nov-buffer
;; Init the nov buffer.
(buffer-disable-undo)
@@ -1010,7 +1010,7 @@ Use the nov database for the current group if available."
(unless nnml-article-file-alist
(setq nnml-article-file-alist
(sort (nnml-current-group-article-to-file-alist)
- 'car-less-than-car)))
+ #'car-less-than-car)))
(if (not nnml-article-file-alist)
;; The group is empty: do nothing but return t
t
diff --git a/lisp/gnus/nnnil.el b/lisp/gnus/nnnil.el
index 7d40079..36a8bc4 100644
--- a/lisp/gnus/nnnil.el
+++ b/lisp/gnus/nnnil.el
@@ -1,4 +1,4 @@
-;;; nnnil.el --- empty backend for Gnus
+;;; nnnil.el --- empty backend for Gnus -*- lexical-binding: t; -*-
;; This file is in the public domain.
@@ -32,31 +32,31 @@
(defvar nnnil-status-string "")
-(defun nnnil-retrieve-headers (articles &optional group server fetch-old)
+(defun nnnil-retrieve-headers (_articles &optional _group _server _fetch-old)
(with-current-buffer nntp-server-buffer
(erase-buffer))
'nov)
-(defun nnnil-open-server (server &optional definitions)
+(defun nnnil-open-server (_server &optional _definitions)
t)
-(defun nnnil-close-server (&optional server)
+(defun nnnil-close-server (&optional _server)
t)
(defun nnnil-request-close ()
t)
-(defun nnnil-server-opened (&optional server)
+(defun nnnil-server-opened (&optional _server)
t)
-(defun nnnil-status-message (&optional server)
+(defun nnnil-status-message (&optional _server)
nnnil-status-string)
-(defun nnnil-request-article (article &optional group server to-buffer)
+(defun nnnil-request-article (_article &optional _group _server _to-buffer)
(setq nnnil-status-string "No such group")
nil)
-(defun nnnil-request-group (group &optional server fast info)
+(defun nnnil-request-group (_group &optional _server _fast _info)
(let (deactivate-mark)
(with-current-buffer nntp-server-buffer
(erase-buffer)
@@ -64,15 +64,15 @@
(setq nnnil-status-string "No such group")
nil)
-(defun nnnil-close-group (group &optional server)
+(defun nnnil-close-group (_group &optional _server)
t)
-(defun nnnil-request-list (&optional server)
+(defun nnnil-request-list (&optional _server)
(with-current-buffer nntp-server-buffer
(erase-buffer))
t)
-(defun nnnil-request-post (&optional server)
+(defun nnnil-request-post (&optional _server)
(setq nnnil-status-string "Read-only server")
nil)
diff --git a/lisp/gnus/nnoo.el b/lisp/gnus/nnoo.el
index 9bb86d6..7759951 100644
--- a/lisp/gnus/nnoo.el
+++ b/lisp/gnus/nnoo.el
@@ -1,4 +1,4 @@
-;;; nnoo.el --- OO Gnus Backends
+;;; nnoo.el --- OO Gnus Backends -*- lexical-binding: t; -*-
;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
@@ -33,21 +33,24 @@
(defmacro defvoo (var init &optional doc &rest map)
"The same as `defvar', only takes list of variables to MAP to."
+ (declare (indent 2)
+ (debug (var init &optional doc &rest map)))
`(prog1
,(if doc
`(defvar ,var ,init ,(concat doc "\n\nThis is a Gnus server
variable. See Info node `(gnus)Select Methods'."))
`(defvar ,var ,init))
(nnoo-define ',var ',map)))
-(put 'defvoo 'lisp-indent-function 2)
-(put 'defvoo 'edebug-form-spec '(var init &optional doc &rest map))
(defmacro deffoo (func args &rest forms)
"The same as `defun', only register FUNC."
+ (declare (indent 2)
+ (debug (&define name lambda-list def-body)))
`(prog1
(defun ,func ,args ,@forms)
(nnoo-register-function ',func)))
-(put 'deffoo 'lisp-indent-function 2)
-(put 'deffoo 'edebug-form-spec '(&define name lambda-list def-body))
+
+(defun noo--defalias (fun val)
+ (prog1 (defalias fun val) (nnoo-register-function fun)))
(defun nnoo-register-function (func)
(let ((funcs (nthcdr 3 (assoc (nnoo-backend func)
@@ -57,18 +60,18 @@
(setcar funcs (cons func (car funcs)))))
(defmacro nnoo-declare (backend &rest parents)
+ (declare (indent 1))
`(eval-and-compile
(if (assq ',backend nnoo-definition-alist)
(setcar (cdr (assq ',backend nnoo-definition-alist))
- (mapcar 'list ',parents))
+ (mapcar #'list ',parents))
(push (list ',backend
- (mapcar 'list ',parents)
+ (mapcar #'list ',parents)
nil nil)
nnoo-definition-alist))
(unless (assq ',backend nnoo-state-alist)
(push (list ',backend "*internal-non-initialized-backend*")
nnoo-state-alist))))
-(put 'nnoo-declare 'lisp-indent-function 1)
(defun nnoo-parents (backend)
(nth 1 (assoc backend nnoo-definition-alist)))
@@ -80,25 +83,19 @@
(nth 3 (assoc backend nnoo-definition-alist)))
(defmacro nnoo-import (backend &rest imports)
+ (declare (indent 1))
`(nnoo-import-1 ',backend ',imports))
-(put 'nnoo-import 'lisp-indent-function 1)
(defun nnoo-import-1 (backend imports)
(let ((call-function
- (if (symbolp (car imports)) (pop imports) 'nnoo-parent-function))
- imp functions function)
- (while (setq imp (pop imports))
- (setq functions
- (or (cdr imp)
- (nnoo-functions (car imp))))
- (while functions
- (unless (fboundp
- (setq function
- (nnoo-symbol backend
- (nnoo-rest-symbol (car functions)))))
- (eval `(deffoo ,function (&rest args)
- (,call-function ',backend ',(car functions) args))))
- (pop functions)))))
+ (if (symbolp (car imports)) (pop imports) #'nnoo-parent-function)))
+ (dolist (imp imports)
+ (dolist (fun (or (cdr imp) (nnoo-functions (car imp))))
+ (let ((function (nnoo-symbol backend (nnoo-rest-symbol fun))))
+ (unless (fboundp function)
+ (noo--defalias function
+ (lambda (&rest args)
+ (funcall call-function backend fun args)))))))))
(defun nnoo-parent-function (backend function args)
(let ((pbackend (nnoo-backend function))
@@ -130,23 +127,22 @@
(setq vars (cdr vars)))))))
(defmacro nnoo-map-functions (backend &rest maps)
- `(nnoo-map-functions-1 ',backend ',maps))
-(put 'nnoo-map-functions 'lisp-indent-function 1)
-
-(defun nnoo-map-functions-1 (backend maps)
- (let (m margs i)
- (while (setq m (pop maps))
- (setq i 0
- margs nil)
- (while (< i (length (cdr m)))
- (if (numberp (nth i (cdr m)))
- (push `(nth ,i args) margs)
- (push (nth i (cdr m)) margs))
- (cl-incf i))
- (eval `(deffoo ,(nnoo-symbol backend (nnoo-rest-symbol (car m)))
+ (declare (indent 1))
+ `(progn
+ ,@(mapcar
+ (lambda (m)
+ (let ((margs nil))
+ (dotimes (i (length (cdr m)))
+ (push (if (numberp (nth i (cdr m)))
+ `(nth ,i args)
+ (nth i (cdr m)))
+ margs))
+ `(deffoo ,(nnoo-symbol backend (nnoo-rest-symbol (car m)))
(&rest args)
+ (ignore args) ;; Not always used!
(nnoo-parent-function ',backend ',(car m)
- ,(cons 'list (nreverse margs))))))))
+ ,(cons 'list (nreverse margs))))))
+ maps)))
(defun nnoo-backend (symbol)
(string-match "^[^-]+-" (symbol-name symbol))
@@ -264,7 +260,7 @@
nnoo-state-alist))
t)
-(defun nnoo-status-message (backend server)
+(defun nnoo-status-message (backend _server)
(nnheader-get-report backend))
(defun nnoo-server-opened (backend server)
@@ -273,19 +269,27 @@
(defmacro nnoo-define-basics (backend)
"Define `close-server', `server-opened' and `status-message'."
- `(eval-and-compile
- (nnoo-define-basics-1 ',backend)))
-
-(defun nnoo-define-basics-1 (backend)
- (dolist (function '(server-opened status-message))
- (eval `(deffoo ,(nnoo-symbol backend function) (&optional server)
- (,(nnoo-symbol 'nnoo function) ',backend server))))
- (dolist (function '(close-server))
- (eval `(deffoo ,(nnoo-symbol backend function) (&optional server defs)
- (,(nnoo-symbol 'nnoo function) ',backend server))))
- (eval `(deffoo ,(nnoo-symbol backend 'open-server)
- (server &optional defs)
- (nnoo-change-server ',backend server defs))))
+ (let ((form
+ ;; We wrap the definitions in `when t' here so that a subsequent
+ ;; "real" definition of one those doesn't trigger a "defined multiple
+ ;; times" warning.
+ `(when t
+ ,@(mapcar (lambda (fun)
+ `(deffoo ,(nnoo-symbol backend fun) (&optional server)
+ (,(nnoo-symbol 'nnoo fun) ',backend server)))
+ '(server-opened status-message))
+ (deffoo ,(nnoo-symbol backend 'close-server) (&optional server _defs)
+ (,(nnoo-symbol 'nnoo 'close-server) ',backend server))
+ (deffoo ,(nnoo-symbol backend 'open-server) (server &optional defs)
+ (nnoo-change-server ',backend server defs)))))
+ ;; Wrapping with `when' has the downside that the compiler now doesn't
+ ;; "know" that these functions are defined, so to avoid "not known to be
+ ;; defined" warnings we eagerly define them during the compilation.
+ ;; This is fairly nasty since it will override previous "real" definitions
+ ;; (e.g. when compiling this in an Emacs instance that's running Gnus), but
+ ;; that's also what the previous code did, so it sucks but is not worse.
+ (eval form t)
+ form))
(defmacro nnoo-define-skeleton (backend)
"Define all required backend functions for BACKEND.
@@ -294,17 +298,15 @@ All functions will return nil and report an error."
(nnoo-define-skeleton-1 ',backend)))
(defun nnoo-define-skeleton-1 (backend)
- (let ((functions '(retrieve-headers
- request-close request-article
- request-group close-group
- request-list request-post request-list-newsgroups))
- function fun)
- (while (setq function (pop functions))
- (when (not (fboundp (setq fun (nnoo-symbol backend function))))
- (eval `(deffoo ,fun
- (&rest args)
- (nnheader-report ',backend ,(format "%s-%s not implemented"
- backend function))))))))
+ (dolist (op '(retrieve-headers
+ request-close request-article
+ request-group close-group
+ request-list request-post request-list-newsgroups))
+ (let ((fun (nnoo-symbol backend op)))
+ (unless (fboundp fun)
+ (let ((msg (format "%s-%s not implemented" backend op)))
+ (noo--defalias fun
+ (lambda (&rest _args) (nnheader-report backend
msg))))))))
(defun nnoo-set (server &rest args)
(let ((parents (nnoo-parents (car server)))
diff --git a/lisp/gnus/nnregistry.el b/lisp/gnus/nnregistry.el
index e78f93d..15e41e9 100644
--- a/lisp/gnus/nnregistry.el
+++ b/lisp/gnus/nnregistry.el
@@ -1,5 +1,4 @@
-;;; nnregistry.el --- access to articles via Gnus' message-id registry
-;;; -*- coding: utf-8 -*-
+;;; nnregistry.el --- access to articles via Gnus' message-id registry -*-
lexical-binding: t; -*-
;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
@@ -36,21 +35,21 @@
(nnoo-declare nnregistry)
-(deffoo nnregistry-server-opened (server)
+(deffoo nnregistry-server-opened (_server)
gnus-registry-enabled)
-(deffoo nnregistry-close-server (server &optional defs)
+(deffoo nnregistry-close-server (_server &optional _defs)
t)
-(deffoo nnregistry-status-message (server)
+(deffoo nnregistry-status-message (_server)
nil)
-(deffoo nnregistry-open-server (server &optional defs)
+(deffoo nnregistry-open-server (_server &optional _defs)
gnus-registry-enabled)
(defvar nnregistry-within-nnregistry nil)
-(deffoo nnregistry-request-article (id &optional group server buffer)
+(deffoo nnregistry-request-article (id &optional _group _server buffer)
(and (not nnregistry-within-nnregistry)
(let* ((nnregistry-within-nnregistry t)
(group (nth 0 (gnus-registry-get-id-key id 'group)))
diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el
index f9e0a08..aa7c8e5 100644
--- a/lisp/gnus/nnrss.el
+++ b/lisp/gnus/nnrss.el
@@ -1,4 +1,4 @@
-;;; nnrss.el --- interfacing with RSS
+;;; nnrss.el --- interfacing with RSS -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
@@ -100,7 +100,6 @@ Note that you have to regenerate all the nnrss groups if
you change
the value. Moreover, you should be patient even if you are made to
read the same articles twice, that arises for the difference of the
versions of xml.el."
- :group 'nnrss
:type 'coding-system)
(defvar nnrss-compatible-encoding-alist
@@ -126,7 +125,7 @@ for decoding when the cdr that the data specify is not
available.")
(setq group (decode-coding-string group 'utf-8))
group))
-(deffoo nnrss-retrieve-headers (articles &optional group server fetch-old)
+(deffoo nnrss-retrieve-headers (articles &optional group server _fetch-old)
(setq group (nnrss-decode-group-name group))
(nnrss-possibly-change-group group server)
(let (e)
@@ -174,7 +173,7 @@ for decoding when the cdr that the data specify is not
available.")
"\n")))))
'nov)
-(deffoo nnrss-request-group (group &optional server dont-check info)
+(deffoo nnrss-request-group (group &optional server dont-check _info)
(setq group (nnrss-decode-group-name group))
(nnheader-message 6 "nnrss: Requesting %s..." group)
(nnrss-possibly-change-group group server)
@@ -189,7 +188,7 @@ for decoding when the cdr that the data specify is not
available.")
t))
(nnheader-message 6 "nnrss: Requesting %s...done" group)))
-(deffoo nnrss-close-group (group &optional server)
+(deffoo nnrss-close-group (_group &optional _server)
t)
(deffoo nnrss-request-article (article &optional group server buffer)
@@ -201,7 +200,7 @@ for decoding when the cdr that the data specify is not
available.")
(nnrss-possibly-change-group group server)
(let ((e (assq article nnrss-group-data))
(nntp-server-buffer (or buffer nntp-server-buffer))
- post err)
+ err) ;; post
(when e
(with-current-buffer nntp-server-buffer
(erase-buffer)
@@ -223,7 +222,7 @@ for decoding when the cdr that the data specify is not
available.")
(cons '("Newsgroups" . utf-8)
rfc2047-header-encoding-alist)
rfc2047-header-encoding-alist))
- rfc2047-encode-encoded-words body fn)
+ rfc2047-encode-encoded-words body) ;; fn
(when (or text link enclosure comments)
(insert "\n")
(insert "<#multipart type=alternative>\n"
@@ -312,7 +311,7 @@ for decoding when the cdr that the data specify is not
available.")
;; we return the article number.
(cons nnrss-group (car e))))))
-(deffoo nnrss-open-server (server &optional defs connectionless)
+(deffoo nnrss-open-server (server &optional defs _connectionless)
(nnrss-read-server-data server)
(nnoo-change-server 'nnrss server defs)
t)
@@ -336,7 +335,7 @@ for decoding when the cdr that the data specify is not
available.")
(nnrss-save-group-data group server))
not-expirable))
-(deffoo nnrss-request-delete-group (group &optional force server)
+(deffoo nnrss-request-delete-group (group &optional _force server)
(setq group (nnrss-decode-group-name group))
(nnrss-possibly-change-group group server)
(let (elem)
@@ -562,7 +561,7 @@ which RSS 2.0 allows."
;;; URL interface
-(defun nnrss-no-cache (url)
+(defun nnrss-no-cache (_url)
"")
(defun nnrss-insert (url)
@@ -614,7 +613,7 @@ which RSS 2.0 allows."
(defun nnrss-check-group (group server)
(let (file xml subject url extra changed author date feed-subject
- enclosure comments rss-ns rdf-ns content-ns dc-ns
+ enclosure comments rss-ns content-ns dc-ns ;; rdf-ns
hash-index)
(if (and nnrss-use-local
(file-exists-p (setq file (expand-file-name
@@ -638,7 +637,7 @@ which RSS 2.0 allows."
(setq changed t))
(setq xml (nnrss-fetch url)))
(setq dc-ns (nnrss-get-namespace-prefix xml
"http://purl.org/dc/elements/1.1/";)
- rdf-ns (nnrss-get-namespace-prefix xml
"http://www.w3.org/1999/02/22-rdf-syntax-ns#";)
+ ;; rdf-ns (nnrss-get-namespace-prefix xml
"http://www.w3.org/1999/02/22-rdf-syntax-ns#";)
rss-ns (nnrss-get-namespace-prefix xml "http://purl.org/rss/1.0/";)
content-ns (nnrss-get-namespace-prefix xml
"http://purl.org/rss/1.0/modules/content/";))
(dolist (item (nreverse (nnrss-find-el (intern (concat rss-ns "item"))
xml)))
@@ -798,7 +797,7 @@ It is useful when `(setq nnrss-use-local t)'."
(defun nnrss-node-just-text (node)
(if (and node (listp node))
- (mapconcat 'nnrss-node-just-text (cddr node) " ")
+ (mapconcat #'nnrss-node-just-text (cddr node) " ")
node))
(defun nnrss-find-el (tag data &optional found-list)
diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el
index ba0e60a..fffa2d2 100644
--- a/lisp/gnus/nnselect.el
+++ b/lisp/gnus/nnselect.el
@@ -81,12 +81,12 @@
"Compress ARTLIST."
(let (selection)
(pcase-dolist (`(,artgroup . ,arts)
- (nnselect-categorize artlist 'nnselect-artitem-group))
+ (nnselect-categorize artlist #'nnselect-artitem-group))
(let (list)
(pcase-dolist (`(,rsv . ,articles)
(nnselect-categorize
- arts 'nnselect-artitem-rsv 'nnselect-artitem-number))
- (push (cons rsv (gnus-compress-sequence (sort articles '<)))
+ arts #'nnselect-artitem-rsv #'nnselect-artitem-number))
+ (push (cons rsv (gnus-compress-sequence (sort articles #'<)))
list))
(push (cons artgroup list) selection)))
selection))
@@ -200,25 +200,27 @@ as `(keyfunc member)' and the corresponding element is
just
(define-inline ids-by-group (articles)
(inline-quote
- (nnselect-categorize ,articles 'nnselect-article-group
- 'nnselect-article-id)))
+ (nnselect-categorize ,articles #'nnselect-article-group
+ #'nnselect-article-id)))
(define-inline numbers-by-group (articles &optional type)
(inline-quote
(cond
((eq ,type 'range)
(nnselect-categorize (gnus-uncompress-range ,articles)
- 'nnselect-article-group 'nnselect-article-number))
+ #'nnselect-article-group #'nnselect-article-number))
((eq ,type 'tuple)
(nnselect-categorize ,articles
#'(lambda (elem)
(nnselect-article-group (car elem)))
#'(lambda (elem)
(cons (nnselect-article-number
- (car elem)) (cdr elem)))))
+ (car elem))
+ (cdr elem)))))
(t
(nnselect-categorize ,articles
- 'nnselect-article-group 'nnselect-article-number)))))
+ #'nnselect-article-group
+ #'nnselect-article-number)))))
(defmacro nnselect-add-prefix (group)
"Ensures that the GROUP has an nnselect prefix."
@@ -319,7 +321,7 @@ If this variable is nil, or if the provided function
returns nil,
headers)
(with-current-buffer nntp-server-buffer
(pcase-dolist (`(,artgroup . ,artids) gartids)
- (let ((artlist (sort (mapcar 'cdr artids) '<))
+ (let ((artlist (sort (mapcar #'cdr artids) #'<))
(gnus-override-method (gnus-find-method-for-group artgroup))
(fetch-old
(or
@@ -385,7 +387,8 @@ If this variable is nil, or if the provided function
returns nil,
(list
(gnus-method-to-server
(gnus-find-method-for-group
- (nnselect-article-group x)))) servers :test 'equal)))
+ (nnselect-article-group x))))
+ servers :test 'equal)))
(gnus-articles-in-thread thread)))))
(setq servers (list (list server))))
(setq artlist
@@ -455,7 +458,7 @@ If this variable is nil, or if the provided function
returns nil,
(if force
(let (not-expired)
(pcase-dolist (`(,artgroup . ,artids) (ids-by-group articles))
- (let ((artlist (sort (mapcar 'cdr artids) '<)))
+ (let ((artlist (sort (mapcar #'cdr artids) #'<)))
(unless (gnus-check-backend-function 'request-expire-articles
artgroup)
(error "Group %s does not support article expiration" artgroup))
@@ -467,7 +470,7 @@ If this variable is nil, or if the provided function
returns nil,
(gnus-request-expire-articles
artlist artgroup force)))
not-expired)))
- (sort (delq nil not-expired) '<))
+ (sort (delq nil not-expired) #'<))
articles))
@@ -518,11 +521,11 @@ If this variable is nil, or if the provided function
returns nil,
(mapcar
(lambda (artgroup)
(list (car artgroup)
- (gnus-compress-sequence (sort (cdr artgroup) '<))
+ (gnus-compress-sequence (sort (cdr artgroup) #'<))
action marks))
(numbers-by-group range 'range))))
actions)
- 'car 'cdr)))
+ #'car #'cdr)))
(deffoo nnselect-request-update-info (group info &optional _server)
(let* ((group (nnselect-add-prefix group))
@@ -651,8 +654,9 @@ If this variable is nil, or if the provided function
returns nil,
new-nnselect-artlist)
(setq headers
(gnus-fetch-headers
- (append (sort old-arts '<)
- (number-sequence first last)) nil t))
+ (append (sort old-arts #'<)
+ (number-sequence first last))
+ nil t))
(gnus-group-set-parameter
group
'nnselect-artlist
@@ -942,7 +946,7 @@ article came from is also searched."
(gnus-remove-from-range
old-unread
(cdr (assoc artgroup select-reads)))
- (sort (cdr (assoc artgroup select-unreads)) '<))))
+ (sort (cdr (assoc artgroup select-unreads)) #'<))))
(gnus-get-unread-articles-in-group
group-info (gnus-active artgroup) t)
(gnus-group-update-group artgroup t t)))))))
diff --git a/lisp/gnus/nnspool.el b/lisp/gnus/nnspool.el
index 9de59d8..ce9ab3c 100644
--- a/lisp/gnus/nnspool.el
+++ b/lisp/gnus/nnspool.el
@@ -1,4 +1,4 @@
-;;; nnspool.el --- spool access for GNU Emacs
+;;; nnspool.el --- spool access for GNU Emacs -*- lexical-binding: t; -*-
;; Copyright (C) 1988-1990, 1993-1998, 2000-2021 Free Software
;; Foundation, Inc.
@@ -126,7 +126,7 @@ there.")
(nnoo-define-basics nnspool)
-(deffoo nnspool-retrieve-headers (articles &optional group server fetch-old)
+(deffoo nnspool-retrieve-headers (articles &optional group _server fetch-old)
"Retrieve the headers of ARTICLES."
(with-current-buffer nntp-server-buffer
(erase-buffer)
@@ -203,7 +203,7 @@ there.")
server nnspool-spool-directory)
t)))
-(deffoo nnspool-request-article (id &optional group server buffer)
+(deffoo nnspool-request-article (id &optional group _server buffer)
"Select article by message ID (or number)."
(nnspool-possibly-change-directory group)
(let ((nntp-server-buffer (or buffer nntp-server-buffer))
@@ -222,7 +222,7 @@ there.")
(cons nnspool-current-group id)
ag))))
-(deffoo nnspool-request-body (id &optional group server)
+(deffoo nnspool-request-body (id &optional group _server)
"Select article body by message ID (or number)."
(nnspool-possibly-change-directory group)
(let ((res (nnspool-request-article id)))
@@ -233,7 +233,7 @@ there.")
(delete-region (point-min) (point)))
res))))
-(deffoo nnspool-request-head (id &optional group server)
+(deffoo nnspool-request-head (id &optional group _server)
"Select article head by message ID (or number)."
(nnspool-possibly-change-directory group)
(let ((res (nnspool-request-article id)))
@@ -245,7 +245,7 @@ there.")
(nnheader-fold-continuation-lines)))
res))
-(deffoo nnspool-request-group (group &optional server dont-check info)
+(deffoo nnspool-request-group (group &optional _server dont-check _info)
"Select news GROUP."
(let ((pathname (nnspool-article-pathname group))
dir)
@@ -261,7 +261,7 @@ there.")
;; Yes, completely empty spool directories *are* possible.
;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>
(when (setq dir (directory-files pathname nil "\\`[0-9]+\\'" t))
- (setq dir (sort (mapcar 'string-to-number dir) '<)))
+ (setq dir (sort (mapcar #'string-to-number dir) #'<)))
(if dir
(nnheader-insert
"211 %d %d %d %s\n" (length dir) (car dir)
@@ -269,26 +269,26 @@ there.")
(nnheader-report 'nnspool "Empty group %s" group)
(nnheader-insert "211 0 0 0 %s\n" group))))))
-(deffoo nnspool-request-type (group &optional article)
+(deffoo nnspool-request-type (_group &optional _article)
'news)
-(deffoo nnspool-close-group (group &optional server)
+(deffoo nnspool-close-group (_group &optional _server)
t)
-(deffoo nnspool-request-list (&optional server)
+(deffoo nnspool-request-list (&optional _server)
"List active newsgroups."
(save-excursion
(or (nnspool-find-file nnspool-active-file)
(nnheader-report 'nnspool (nnheader-file-error nnspool-active-file)))))
-(deffoo nnspool-request-list-newsgroups (&optional server)
+(deffoo nnspool-request-list-newsgroups (&optional _server)
"List newsgroups (defined in NNTP2)."
(save-excursion
(or (nnspool-find-file nnspool-newsgroups-file)
(nnheader-report 'nnspool (nnheader-file-error
nnspool-newsgroups-file)))))
-(deffoo nnspool-request-list-distributions (&optional server)
+(deffoo nnspool-request-list-distributions (&optional _server)
"List distributions (defined in NNTP2)."
(save-excursion
(or (nnspool-find-file nnspool-distributions-file)
@@ -296,7 +296,7 @@ there.")
nnspool-distributions-file)))))
;; Suggested by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
-(deffoo nnspool-request-newgroups (date &optional server)
+(deffoo nnspool-request-newgroups (date &optional _server)
"List groups created after DATE."
(if (nnspool-find-file nnspool-active-times-file)
(save-excursion
@@ -323,7 +323,7 @@ there.")
t)
nil))
-(deffoo nnspool-request-post (&optional server)
+(deffoo nnspool-request-post (&optional _server)
"Post a new news in current buffer."
(save-excursion
(let* ((process-connection-type nil) ; t bugs out on Solaris
@@ -331,7 +331,7 @@ there.")
(buf (current-buffer))
(proc
(condition-case err
- (apply 'start-process "*nnspool inews*" inews-buffer
+ (apply #'start-process "*nnspool inews*" inews-buffer
nnspool-inews-program nnspool-inews-switches)
(error
(nnheader-report 'nnspool "inews error: %S" err)))))
@@ -356,7 +356,7 @@ there.")
;;; Internal functions.
-(defun nnspool-inews-sentinel (proc status)
+(defun nnspool-inews-sentinel (proc _status)
(with-current-buffer (process-buffer proc)
(goto-char (point-min))
(if (or (zerop (buffer-size))
@@ -409,7 +409,7 @@ there.")
(<= last (car arts)))
(pop arts))
;; The articles in `arts' are missing from the buffer.
- (mapc 'nnspool-insert-nov-head arts)
+ (mapc #'nnspool-insert-nov-head arts)
t))))))))))
(defun nnspool-insert-nov-head (article)
diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el
index c2bb960..1eb604d 100644
--- a/lisp/gnus/nntp.el
+++ b/lisp/gnus/nntp.el
@@ -335,16 +335,16 @@ retried once before actually displaying the error report."
(apply #'error args)))
-(defmacro nntp-copy-to-buffer (buffer start end)
+(defsubst nntp-copy-to-buffer (buffer start end)
"Copy string from unibyte current buffer to multibyte buffer."
- `(let ((string (buffer-substring ,start ,end)))
- (with-current-buffer ,buffer
+ (let ((string (buffer-substring start end)))
+ (with-current-buffer buffer
(erase-buffer)
(insert string)
(goto-char (point-min))
nil)))
-(defsubst nntp-wait-for (process wait-for buffer &optional decode discard)
+(defun nntp-wait-for (process wait-for buffer &optional decode discard)
"Wait for WAIT-FOR to arrive from PROCESS."
(with-current-buffer (process-buffer process)
@@ -436,7 +436,7 @@ retried once before actually displaying the error report."
(when process
(process-buffer process))))
-(defsubst nntp-retrieve-data (command address _port buffer
+(defun nntp-retrieve-data (command address _port buffer
&optional wait-for callback decode)
"Use COMMAND to retrieve data into BUFFER from PORT on ADDRESS."
(let ((process (or (nntp-find-connection buffer)
@@ -469,7 +469,7 @@ retried once before actually displaying the error report."
nil)))
(nnheader-report 'nntp "Couldn't open connection to %s" address))))
-(defsubst nntp-send-command (wait-for &rest strings)
+(defun nntp-send-command (wait-for &rest strings)
"Send STRINGS to server and wait until WAIT-FOR returns."
(when (not (or nnheader-callback-function
nntp-inhibit-output))
@@ -1330,7 +1330,7 @@ If SEND-IF-FORCE, only send authinfo to the server if the
(dolist (entry nntp-server-action-alist)
(when (string-match (car entry) nntp-server-type)
(if (not (functionp (cadr entry)))
- (eval (cadr entry))
+ (eval (cadr entry) t)
(funcall (cadr entry)))))))
(defun nntp-async-wait (process wait-for buffer decode callback)
diff --git a/lisp/gnus/nnvirtual.el b/lisp/gnus/nnvirtual.el
index 1e2feda..b3b701e 100644
--- a/lisp/gnus/nnvirtual.el
+++ b/lisp/gnus/nnvirtual.el
@@ -1,4 +1,4 @@
-;;; nnvirtual.el --- virtual newsgroups access for Gnus
+;;; nnvirtual.el --- virtual newsgroups access for Gnus -*- lexical-binding:
t; -*-
;; Copyright (C) 1994-2021 Free Software Foundation, Inc.
@@ -94,8 +94,8 @@ It is computed from the marks of individual component
groups.")
(nnoo-define-basics nnvirtual)
-(deffoo nnvirtual-retrieve-headers (articles &optional newsgroup
- server fetch-old)
+(deffoo nnvirtual-retrieve-headers (articles &optional _newsgroup
+ server _fetch-old)
(when (nnvirtual-possibly-change-server server)
(with-current-buffer nntp-server-buffer
(erase-buffer)
@@ -186,7 +186,7 @@ It is computed from the marks of individual component
groups.")
(defvoo nnvirtual-last-accessed-component-group nil)
-(deffoo nnvirtual-request-article (article &optional group server buffer)
+(deffoo nnvirtual-request-article (article &optional _group server buffer)
(when (nnvirtual-possibly-change-server server)
(if (stringp article)
;; This is a fetch by Message-ID.
@@ -250,7 +250,7 @@ It is computed from the marks of individual component
groups.")
t)))
-(deffoo nnvirtual-request-group (group &optional server dont-check info)
+(deffoo nnvirtual-request-group (group &optional server dont-check _info)
(nnvirtual-possibly-change-server server)
(setq nnvirtual-component-groups
(delete (nnvirtual-current-group) nnvirtual-component-groups))
@@ -269,7 +269,7 @@ It is computed from the marks of individual component
groups.")
nnvirtual-mapping-len nnvirtual-mapping-len group))))
-(deffoo nnvirtual-request-type (group &optional article)
+(deffoo nnvirtual-request-type (_group &optional article)
(if (not article)
'unknown
(if (numberp article)
@@ -279,7 +279,7 @@ It is computed from the marks of individual component
groups.")
(gnus-request-type
nnvirtual-last-accessed-component-group nil))))
-(deffoo nnvirtual-request-update-mark (group article mark)
+(deffoo nnvirtual-request-update-mark (_group article mark)
(let* ((nart (nnvirtual-map-article article))
(cgroup (car nart)))
(when (and nart
@@ -291,22 +291,22 @@ It is computed from the marks of individual component
groups.")
mark)
-(deffoo nnvirtual-close-group (group &optional server)
+(deffoo nnvirtual-close-group (_group &optional server)
(when (and (nnvirtual-possibly-change-server server)
(not (gnus-ephemeral-group-p (nnvirtual-current-group))))
(nnvirtual-update-read-and-marked t t))
t)
-(deffoo nnvirtual-request-newgroups (date &optional server)
+(deffoo nnvirtual-request-newgroups (_date &optional _server)
(nnheader-report 'nnvirtual "NEWGROUPS is not supported."))
-(deffoo nnvirtual-request-list-newsgroups (&optional server)
+(deffoo nnvirtual-request-list-newsgroups (&optional _server)
(nnheader-report 'nnvirtual "LIST NEWSGROUPS is not implemented."))
-(deffoo nnvirtual-request-update-info (group info &optional server)
+(deffoo nnvirtual-request-update-info (_group info &optional server)
(when (and (nnvirtual-possibly-change-server server)
(not nnvirtual-info-installed))
;; Install the precomputed lists atomically, so the virtual group
@@ -321,7 +321,7 @@ It is computed from the marks of individual component
groups.")
t))
-(deffoo nnvirtual-catchup-group (group &optional server all)
+(deffoo nnvirtual-catchup-group (_group &optional server all)
(when (and (nnvirtual-possibly-change-server server)
(not (gnus-ephemeral-group-p (nnvirtual-current-group))))
;; copy over existing marks first, in case they set anything
@@ -339,12 +339,12 @@ It is computed from the marks of individual component
groups.")
(gnus-group-catchup-current nil all)))))
-(deffoo nnvirtual-find-group-art (group article)
+(deffoo nnvirtual-find-group-art (_group article)
"Return the real group and article for virtual GROUP and ARTICLE."
(nnvirtual-map-article article))
-(deffoo nnvirtual-request-post (&optional server)
+(deffoo nnvirtual-request-post (&optional _server)
(if (not gnus-message-group-art)
(nnheader-report 'nnvirtual "Can't post to an nnvirtual group")
(let ((group (car (nnvirtual-find-group-art
@@ -353,8 +353,8 @@ It is computed from the marks of individual component
groups.")
(gnus-request-post (gnus-find-method-for-group group)))))
-(deffoo nnvirtual-request-expire-articles (articles group
- &optional server force)
+(deffoo nnvirtual-request-expire-articles ( _articles _group
+ &optional server _force)
(nnvirtual-possibly-change-server server)
(setq nnvirtual-component-groups
(delete (nnvirtual-current-group) nnvirtual-component-groups))
@@ -367,7 +367,7 @@ It is computed from the marks of individual component
groups.")
group article))
(gnus-uncompress-range
(gnus-group-expire-articles-1 group))))))
- (sort (delq nil unexpired) '<)))
+ (sort (delq nil unexpired) #'<)))
;;; Internal functions.
@@ -378,7 +378,7 @@ It is computed from the marks of individual component
groups.")
(let* ((dependencies (make-hash-table :test #'equal))
(headers (gnus-get-newsgroup-headers dependencies)))
(erase-buffer)
- (mapc 'nnheader-insert-nov headers))))
+ (mapc #'nnheader-insert-nov headers))))
(defun nnvirtual-update-xref-header (group article prefix sysname)
@@ -502,7 +502,7 @@ If UPDATE-P is not nil, call gnus-group-update-group on the
components."
"Merge many sorted lists of numbers."
(if (null (cdr lists))
(car lists)
- (sort (apply 'nconc lists) '<)))
+ (sort (apply #'nconc lists) #'<)))
;; We map between virtual articles and real articles in a manner
@@ -648,7 +648,7 @@ numbers has no corresponding component article, then it is
left out of
the result."
(when (numberp (cdr-safe articles))
(setq articles (list articles)))
- (let ((carticles (mapcar 'list nnvirtual-component-groups))
+ (let ((carticles (mapcar #'list nnvirtual-component-groups))
a i j article entry)
(while (setq a (pop articles))
(if (atom a)
@@ -750,7 +750,7 @@ based on the marks on the component groups."
;; Now that the mapping tables are generated, we can convert
;; and combine the separate component unreads and marks lists
;; into single lists of virtual article numbers.
- (setq unreads (apply 'nnvirtual-merge-sorted-lists
+ (setq unreads (apply #'nnvirtual-merge-sorted-lists
(mapcar (lambda (x)
(nnvirtual-reverse-map-sequence
(car x) (cdr x)))
@@ -760,7 +760,7 @@ based on the marks on the component groups."
(cons (cdr type)
(gnus-compress-sequence
(apply
- 'nnvirtual-merge-sorted-lists
+ #'nnvirtual-merge-sorted-lists
(mapcar (lambda (x)
(nnvirtual-reverse-map-sequence
(car x)
diff --git a/lisp/gnus/nnweb.el b/lisp/gnus/nnweb.el
index b8fb4a8..f08dc47 100644
--- a/lisp/gnus/nnweb.el
+++ b/lisp/gnus/nnweb.el
@@ -1,4 +1,4 @@
-;;; nnweb.el --- retrieving articles via web search engines
+;;; nnweb.el --- retrieving articles via web search engines -*-
lexical-binding: t; -*-
;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
@@ -96,7 +96,7 @@ Valid types include `google', `dejanews', and `gmane'.")
(nnoo-define-basics nnweb)
-(deffoo nnweb-retrieve-headers (articles &optional group server fetch-old)
+(deffoo nnweb-retrieve-headers (articles &optional group server _fetch-old)
(nnweb-possibly-change-server group server)
(with-current-buffer nntp-server-buffer
(erase-buffer)
@@ -117,7 +117,7 @@ Valid types include `google', `dejanews', and `gmane'.")
(nnweb-write-active)
(nnweb-write-overview group)))
-(deffoo nnweb-request-group (group &optional server dont-check info)
+(deffoo nnweb-request-group (group &optional server dont-check _info)
(nnweb-possibly-change-server group server)
(unless (or nnweb-ephemeral-p
dont-check
@@ -154,17 +154,17 @@ Valid types include `google', `dejanews', and `gmane'.")
(and (stringp article)
(nnweb-definition 'id t)
(let ((fetch (nnweb-definition 'id))
- art active)
- (when (string-match "^<\\(.*\\)>$" article)
- (setq art (match-string 1 article)))
+ (art (when (string-match "^<\\(.*\\)>$" article)
+ (match-string 1 article)))
+ ) ;; active
(when (and fetch art)
(setq url (format fetch
(mm-url-form-encode-xwfu art)))
(mm-url-insert url)
(if (nnweb-definition 'reference t)
(setq article
- (funcall (nnweb-definition
- 'reference) article)))))))
+ (funcall (nnweb-definition 'reference)
+ article)))))))
(unless nnheader-callback-function
(funcall (nnweb-definition 'article)))
(nnheader-report 'nnweb "Fetched article %s" article)
@@ -184,19 +184,19 @@ Valid types include `google', `dejanews', and `gmane'.")
(nnmail-generate-active (list (assoc server nnweb-group-alist)))
t))
-(deffoo nnweb-request-update-info (group info &optional server))
+(deffoo nnweb-request-update-info (_group _info &optional _server))
(deffoo nnweb-asynchronous-p ()
nil)
-(deffoo nnweb-request-create-group (group &optional server args)
+(deffoo nnweb-request-create-group (group &optional server _args)
(nnweb-possibly-change-server nil server)
(nnweb-request-delete-group group)
(push `(,group ,(cons 1 0)) nnweb-group-alist)
(nnweb-write-active)
t)
-(deffoo nnweb-request-delete-group (group &optional force server)
+(deffoo nnweb-request-delete-group (group &optional _force server)
(nnweb-possibly-change-server group server)
(gnus-alist-pull group nnweb-group-alist t)
(nnweb-write-active)
@@ -317,7 +317,7 @@ Valid types include `google', `dejanews', and `gmane'.")
(let ((i 0)
(case-fold-search t)
(active (cadr (assoc nnweb-group nnweb-group-alist)))
- Subject Score Date Newsgroups From
+ Subject Date Newsgroups From
map url mid)
(unless active
(push (list nnweb-group (setq active (cons 1 0)))
@@ -411,7 +411,7 @@ Valid types include `google', `dejanews', and `gmane'.")
;; Return the articles in the right order.
(nnheader-message 7 "Searching google...done")
(setq nnweb-articles
- (sort nnweb-articles 'car-less-than-car))))))
+ (sort nnweb-articles #'car-less-than-car))))))
(defun nnweb-google-search (search)
(mm-url-insert
@@ -481,7 +481,7 @@ Valid types include `google', `dejanews', and `gmane'.")
(forward-line 1)))
(nnheader-message 7 "Searching Gmane...done")
(setq nnweb-articles
- (sort (nconc nnweb-articles map) 'car-less-than-car)))))
+ (sort (nconc nnweb-articles map) #'car-less-than-car)))))
(defun nnweb-gmane-wash-article ()
(let ((case-fold-search t))
@@ -534,7 +534,7 @@ Valid types include `google', `dejanews', and `gmane'.")
(nth 1 parse)
" "))
(insert ">\n")
- (mapc 'nnweb-insert-html (nth 2 parse))
+ (mapc #'nnweb-insert-html (nth 2 parse))
(insert "</" (symbol-name (car parse)) ">\n")))
(defun nnweb-parse-find (type parse &optional maxdepth)
diff --git a/lisp/gnus/score-mode.el b/lisp/gnus/score-mode.el
index b8726c0..d3ed360 100644
--- a/lisp/gnus/score-mode.el
+++ b/lisp/gnus/score-mode.el
@@ -1,4 +1,4 @@
-;;; score-mode.el --- mode for editing Gnus score files
+;;; score-mode.el --- mode for editing Gnus score files -*- lexical-binding:
t; -*-
;; Copyright (C) 1996, 2001-2021 Free Software Foundation, Inc.
diff --git a/lisp/gnus/smiley.el b/lisp/gnus/smiley.el
index d9e04f3..3ee5947 100644
--- a/lisp/gnus/smiley.el
+++ b/lisp/gnus/smiley.el
@@ -1,4 +1,4 @@
-;;; smiley.el --- displaying smiley faces
+;;; smiley.el --- displaying smiley faces -*- lexical-binding: t; -*-
;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
@@ -71,9 +71,8 @@
(set-default symbol value)
(setq smiley-data-directory (smiley-directory))
(smiley-update-cache))
- :initialize 'custom-initialize-default
- :version "23.1" ;; No Gnus
- :group 'smiley)
+ :initialize #'custom-initialize-default
+ :version "23.1") ;; No Gnus
;; For compatibility, honor the variable `smiley-data-directory' if the user
;; has set it.
@@ -94,9 +93,8 @@ is nil, use `smiley-style'."
:set (lambda (symbol value)
(set-default symbol value)
(smiley-update-cache))
- :initialize 'custom-initialize-default
- :type 'directory
- :group 'smiley)
+ :initialize #'custom-initialize-default
+ :type 'directory)
(defcustom smiley-emoji-regexp-alist
'(("\\(;-)\\)\\W" 1 "😉")
@@ -124,8 +122,7 @@ regexp to replace with EMOJI."
:set (lambda (symbol value)
(set-default symbol value)
(smiley-update-cache))
- :initialize 'custom-initialize-default
- :group 'smiley)
+ :initialize #'custom-initialize-default)
;; The XEmacs version has a baroque, if not rococo, set of these.
(defcustom smiley-regexp-alist
@@ -154,8 +151,7 @@ regexp to replace with IMAGE. IMAGE is the name of an
image file in
:set (lambda (symbol value)
(set-default symbol value)
(smiley-update-cache))
- :initialize 'custom-initialize-default
- :group 'smiley)
+ :initialize #'custom-initialize-default)
(defcustom gnus-smiley-file-types
(let ((types (list "pbm")))
@@ -166,8 +162,7 @@ regexp to replace with IMAGE. IMAGE is the name of an
image file in
types)
"List of suffixes on smiley file names to try."
:version "24.1"
- :type '(repeat string)
- :group 'smiley)
+ :type '(repeat string))
(defvar smiley-cached-regexp-alist nil)
diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el
index ae5d171..8900be5 100644
--- a/lisp/gnus/smime.el
+++ b/lisp/gnus/smime.el
@@ -135,8 +135,7 @@ certificates to be sent with every message to each address."
:type '(repeat (list (string :tag "Mail address")
(file :tag "File name")
(repeat :tag "Additional certificate files"
- (file :tag "File name"))))
- :group 'smime)
+ (file :tag "File name")))))
(defcustom smime-CA-directory nil
"Directory containing certificates for CAs you trust.
@@ -148,16 +147,14 @@ $ ln -s ca.pem \\=`openssl x509 -noout -hash -in
ca.pem\\=`.0
where `ca.pem' is the file containing a PEM encoded X.509 CA
certificate."
:type '(choice (const :tag "none" nil)
- directory)
- :group 'smime)
+ directory))
(defcustom smime-CA-file nil
"Files containing certificates for CAs you trust.
File should contain certificates in PEM format."
:version "22.1"
:type '(choice (const :tag "none" nil)
- file)
- :group 'smime)
+ file))
(defcustom smime-certificate-directory "~/Mail/certs/"
"Directory containing other people's certificates.
@@ -166,8 +163,7 @@ and the files themselves should be in PEM format."
;The S/MIME library provide simple functionality for fetching
;certificates into this directory, so there is no need to populate it
;manually.
- :type 'directory
- :group 'smime)
+ :type 'directory)
(defcustom smime-openssl-program
(and (condition-case ()
@@ -176,8 +172,7 @@ and the files themselves should be in PEM format."
"openssl")
"Name of OpenSSL binary or nil if none."
:type '(choice string
- (const :tag "none" nil))
- :group 'smime)
+ (const :tag "none" nil)))
;; OpenSSL option to select the encryption cipher
@@ -191,8 +186,7 @@ and the files themselves should be in PEM format."
(const :tag "AES 128 bits" "-aes128")
(const :tag "RC2 40 bits" "-rc2-40")
(const :tag "RC2 64 bits" "-rc2-64")
- (const :tag "RC2 128 bits" "-rc2-128"))
- :group 'smime)
+ (const :tag "RC2 128 bits" "-rc2-128")))
(defcustom smime-crl-check nil
"Check revocation status of signers certificate using CRLs.
@@ -212,24 +206,21 @@ certificate with .r0 as file name extension.
At least OpenSSL version 0.9.7 is required for this to work."
:type '(choice (const :tag "No check" nil)
(const :tag "Check certificate" "-crl_check")
- (const :tag "Check certificate chain" "-crl_check_all"))
- :group 'smime)
+ (const :tag "Check certificate chain" "-crl_check_all")))
(defcustom smime-dns-server nil
"DNS server to query certificates from.
If nil, use system defaults."
:version "22.1"
:type '(choice (const :tag "System defaults")
- string)
- :group 'smime)
+ string))
(defcustom smime-ldap-host-list nil
"A list of LDAP hosts with S/MIME user certificates.
If needed search base, binddn, passwd, etc. for the LDAP host
must be set in `ldap-host-parameters-alist'."
:type '(repeat (string :tag "Host name"))
- :version "23.1" ;; No Gnus
- :group 'smime)
+ :version "23.1") ;; No Gnus
(defvar smime-details-buffer "*OpenSSL output*")
@@ -282,7 +273,7 @@ key and certificate itself."
(setenv "GNUS_SMIME_PASSPHRASE" passphrase))
(prog1
(when (prog1
- (apply 'smime-call-openssl-region b e (list buffer tmpfile)
+ (apply #'smime-call-openssl-region b e (list buffer tmpfile)
"smime" "-sign" "-signer" (expand-file-name keyfile)
(append
(smime-make-certfiles certfiles)
@@ -314,9 +305,9 @@ is expected to contain of a PEM encoded certificate."
(tmpfile (make-temp-file "smime")))
(prog1
(when (prog1
- (apply 'smime-call-openssl-region b e (list buffer tmpfile)
+ (apply #'smime-call-openssl-region b e (list buffer tmpfile)
"smime" "-encrypt" smime-encrypt-cipher
- (mapcar 'expand-file-name certfiles))
+ (mapcar #'expand-file-name certfiles))
(with-current-buffer smime-details-buffer
(insert-file-contents tmpfile)
(delete-file tmpfile)))
@@ -384,7 +375,7 @@ Any details (stdout and stderr) are left in the buffer
specified by
(with-temp-buffer
(let ((result-buffer (current-buffer)))
(with-current-buffer input-buffer
- (if (apply 'smime-call-openssl-region b e (list result-buffer
+ (if (apply #'smime-call-openssl-region b e (list result-buffer
smime-details-buffer)
"smime" "-verify" "-out" "-" CAs)
(with-current-buffer result-buffer
@@ -397,7 +388,7 @@ Returns non-nil on success.
Any details (stdout and stderr) are left in the buffer specified by
`smime-details-buffer'."
(smime-new-details-buffer)
- (if (apply 'smime-call-openssl-region b e (list smime-details-buffer t)
+ (if (apply #'smime-call-openssl-region b e (list smime-details-buffer t)
"smime" "-verify" "-noverify" "-out" `(,null-device))
t
(insert-buffer-substring smime-details-buffer)
@@ -416,7 +407,7 @@ in the buffer specified by `smime-details-buffer'."
(if passphrase
(setenv "GNUS_SMIME_PASSPHRASE" passphrase))
(if (prog1
- (apply 'smime-call-openssl-region b e
+ (apply #'smime-call-openssl-region b e
(list buffer tmpfile)
"smime" "-decrypt" "-recip" (expand-file-name keyfile)
(if passphrase
diff --git a/lisp/gnus/spam-report.el b/lisp/gnus/spam-report.el
index 8c148ce..d87a6c2 100644
--- a/lisp/gnus/spam-report.el
+++ b/lisp/gnus/spam-report.el
@@ -1,4 +1,4 @@
-;;; spam-report.el --- Reporting spam
+;;; spam-report.el --- Reporting spam -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
@@ -43,8 +43,7 @@ If you are using spam.el, consider setting
gnus-spam-process-newsgroups
or the gnus-group-spam-exit-processor-report-gmane group/topic parameter
instead."
:type '(radio (const nil)
- (regexp :value "^nntp\\+.*:gmane\\."))
- :group 'spam-report)
+ (regexp :value "^nntp\\+.*:gmane\\.")))
(defcustom spam-report-gmane-use-article-number t
"Whether the article number (faster!) or the header should be used.
@@ -52,8 +51,7 @@ instead."
You must set this to nil if you don't read Gmane groups directly
from news.gmane.org, e.g. when using local newsserver such as
leafnode."
- :type 'boolean
- :group 'spam-report)
+ :type 'boolean)
(defcustom spam-report-url-ping-function
'spam-report-url-ping-plain
@@ -66,23 +64,20 @@ The function must accept the arguments `host' and `report'."
spam-report-url-ping-mm-url)
(const :tag "Store request URLs in `spam-report-requests-file'"
spam-report-url-to-file)
- (function :tag "User defined function" nil))
- :group 'spam-report)
+ (function :tag "User defined function" nil)))
(defcustom spam-report-requests-file
(nnheader-concat gnus-directory "spam/" "spam-report-requests.url")
;; Is there a convention for the extension of such a file?
;; Should we use `spam-directory'?
"File where spam report request are stored."
- :type 'file
- :group 'spam-report)
+ :type 'file)
(defcustom spam-report-resend-to nil
"Email address that spam articles are resent to when reporting.
If not set, the user will be prompted to enter a value which will be
saved for future use."
- :type '(choice (const :tag "Prompt" nil) string)
- :group 'spam-report)
+ :type '(choice (const :tag "Prompt" nil) string))
(defvar spam-report-url-ping-temp-agent-function nil
"Internal variable for `spam-report-agentize' and `spam-report-deagentize'.
@@ -232,8 +227,7 @@ the function specified by `spam-report-url-ping-function'."
This is initialized based on `user-mail-address'."
:type '(choice string
(const :tag "Don't expose address" nil))
- :version "23.1" ;; No Gnus
- :group 'spam-report)
+ :version "23.1") ;; No Gnus
(defvar spam-report-user-agent
(if spam-report-user-mail-address
@@ -345,8 +339,8 @@ Spam reports will be queued with
\\[spam-report-url-to-file] when
the Agent is unplugged, and will be submitted in a batch when the
Agent is plugged."
(interactive)
- (add-hook 'gnus-agent-plugged-hook 'spam-report-plug-agent)
- (add-hook 'gnus-agent-unplugged-hook 'spam-report-unplug-agent))
+ (add-hook 'gnus-agent-plugged-hook #'spam-report-plug-agent)
+ (add-hook 'gnus-agent-unplugged-hook #'spam-report-unplug-agent))
;;;###autoload
(defun spam-report-deagentize ()
@@ -354,8 +348,8 @@ Agent is plugged."
Spam reports will be queued with the method used when
\\[spam-report-agentize] was run."
(interactive)
- (remove-hook 'gnus-agent-plugged-hook 'spam-report-plug-agent)
- (remove-hook 'gnus-agent-unplugged-hook 'spam-report-unplug-agent))
+ (remove-hook 'gnus-agent-plugged-hook #'spam-report-plug-agent)
+ (remove-hook 'gnus-agent-unplugged-hook #'spam-report-unplug-agent))
(defun spam-report-plug-agent ()
"Adjust spam report settings for plugged state.
diff --git a/lisp/gnus/spam-stat.el b/lisp/gnus/spam-stat.el
index 3662ade..70753ca 100644
--- a/lisp/gnus/spam-stat.el
+++ b/lisp/gnus/spam-stat.el
@@ -1,4 +1,4 @@
-;;; spam-stat.el --- detecting spam based on statistics
+;;; spam-stat.el --- detecting spam based on statistics -*- lexical-binding:
t; -*-
;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
@@ -135,42 +135,35 @@ whether a buffer contains spam or not."
(defcustom spam-stat-file "~/.spam-stat.el"
"File used to save and load the dictionary.
See `spam-stat-to-hash-table' for the format of the file."
- :type 'file
- :group 'spam-stat)
+ :type 'file)
(defcustom spam-stat-unknown-word-score 0.2
"The score to use for unknown words.
Also used for words that don't appear often enough."
- :type 'number
- :group 'spam-stat)
+ :type 'number)
(defcustom spam-stat-max-word-length 15
"Only words shorter than this will be considered."
- :type 'integer
- :group 'spam-stat)
+ :type 'integer)
(defcustom spam-stat-max-buffer-length 10240
"Only the beginning of buffers will be analyzed.
This variable says how many characters this will be."
- :type 'integer
- :group 'spam-stat)
+ :type 'integer)
(defcustom spam-stat-split-fancy-spam-group "mail.spam"
"Name of the group where spam should be stored.
If `spam-stat-split-fancy' is used in fancy splitting rules. Has
no effect when spam-stat is invoked through spam.el."
- :type 'string
- :group 'spam-stat)
+ :type 'string)
(defcustom spam-stat-split-fancy-spam-threshold 0.9
"Spam score threshold in spam-stat-split-fancy."
- :type 'number
- :group 'spam-stat)
+ :type 'number)
(defcustom spam-stat-washing-hook nil
"Hook applied to each message before analysis."
- :type 'hook
- :group 'spam-stat)
+ :type 'hook)
(defcustom spam-stat-score-buffer-user-functions nil
"List of additional scoring functions.
@@ -187,8 +180,7 @@ Also be careful when defining such functions. If they take
a long
time, they will slow down your mail splitting. Thus, if the buffer is
large, don't forget to use smaller regions, by wrapping your work in,
say, `with-spam-stat-max-buffer-size'."
- :type '(repeat sexp)
- :group 'spam-stat)
+ :type '(repeat sexp))
(defcustom spam-stat-process-directory-age 90
"Max. age of files to be processed in directory, in days.
@@ -197,8 +189,7 @@ When using `spam-stat-process-spam-directory' or
been touched in this many days will be considered. Without
this filter, re-training spam-stat with several thousand messages
will start to take a very long time."
- :type 'number
- :group 'spam-stat)
+ :type 'number)
(defvar spam-stat-last-saved-at nil
"Time stamp of last change of spam-stat-file on this run")
@@ -260,9 +251,6 @@ Use `spam-stat-ngood', `spam-stat-nbad', `spam-stat-good',
(defvar spam-stat-nbad 0
"The number of bad mails in the dictionary.")
-(defvar spam-stat-error-holder nil
- "A holder for condition-case errors while scoring buffers.")
-
(defsubst spam-stat-good (entry)
"Return the number of times this word belongs to good mails."
(aref entry 0))
@@ -486,8 +474,8 @@ The default score for unknown words is stored in
These are the words whose spam-stat differs the most from 0.5.
The list returned contains elements of the form \(WORD SCORE DIFF),
where DIFF is the difference between SCORE and 0.5."
- (let (result word score)
- (maphash (lambda (word ignore)
+ (let (result score) ;; word
+ (maphash (lambda (word _ignore)
(setq score (spam-stat-score-word word)
result (cons (list word score (abs (- score 0.5)))
result)))
@@ -501,14 +489,13 @@ where DIFF is the difference between SCORE and 0.5."
Add user supplied modifications if supplied."
(interactive) ; helps in debugging.
(setq spam-stat-score-data (spam-stat-buffer-words-with-scores))
- (let* ((probs (mapcar 'cadr spam-stat-score-data))
+ (let* ((probs (mapcar #'cadr spam-stat-score-data))
(prod (apply #'* probs))
(score0
(/ prod (+ prod (apply #'* (mapcar #'(lambda (x) (- 1 x))
probs)))))
(score1s
- (condition-case
- spam-stat-error-holder
+ (condition-case nil
(spam-stat-score-buffer-user score0)
(error nil)))
(ans
@@ -531,7 +518,7 @@ Add user supplied modifications if supplied."
Use this function on `nnmail-split-fancy'. If you are interested in
the raw data used for the last run of `spam-stat-score-buffer',
check the variable `spam-stat-score-data'."
- (condition-case spam-stat-error-holder
+ (condition-case err
(progn
(set-buffer spam-stat-buffer)
(goto-char (point-min))
@@ -541,7 +528,7 @@ check the variable `spam-stat-score-data'."
(push entry nnmail-split-trace))
spam-stat-score-data))
spam-stat-split-fancy-spam-group))
- (error (message "Error in spam-stat-split-fancy: %S"
spam-stat-error-holder)
+ (error (message "Error in spam-stat-split-fancy: %S" err)
nil)))
;; Testing
@@ -652,19 +639,19 @@ COUNT defaults to 5"
"Install the spam-stat function hooks."
(interactive)
(add-hook 'nnmail-prepare-incoming-message-hook
- 'spam-stat-store-current-buffer)
+ #'spam-stat-store-current-buffer)
(add-hook 'gnus-select-article-hook
- 'spam-stat-store-gnus-article-buffer))
+ #'spam-stat-store-gnus-article-buffer))
(defun spam-stat-unload-hook ()
"Uninstall the spam-stat function hooks."
(interactive)
(remove-hook 'nnmail-prepare-incoming-message-hook
- 'spam-stat-store-current-buffer)
+ #'spam-stat-store-current-buffer)
(remove-hook 'gnus-select-article-hook
- 'spam-stat-store-gnus-article-buffer))
+ #'spam-stat-store-gnus-article-buffer))
-(add-hook 'spam-stat-unload-hook 'spam-stat-unload-hook)
+(add-hook 'spam-stat-unload-hook #'spam-stat-unload-hook)
(provide 'spam-stat)
diff --git a/lisp/gnus/spam-wash.el b/lisp/gnus/spam-wash.el
index 1d00a39..bb2a1b9 100644
--- a/lisp/gnus/spam-wash.el
+++ b/lisp/gnus/spam-wash.el
@@ -1,4 +1,4 @@
-;;; spam-wash.el --- wash spam before analysis
+;;; spam-wash.el --- wash spam before analysis -*- lexical-binding: t; -*-
;; Copyright (C) 2004, 2007-2021 Free Software Foundation, Inc.
@@ -43,7 +43,7 @@
(handles (or (mm-dissect-buffer nil gnus-article-loose-mime)
(and gnus-article-emulate-mime
(mm-uu-dissect))))
- handle)
+ ) ;; handle
(when gnus-article-mime-handles
(mm-destroy-parts gnus-article-mime-handles)
(setq gnus-article-mime-handle-alist nil))
@@ -57,7 +57,7 @@
(defun spam-treat-parts (handle)
(if (stringp (car handle))
- (mapcar 'spam-treat-parts (cdr handle))
+ (mapcar #'spam-treat-parts (cdr handle))
(if (bufferp (car handle))
(save-restriction
(narrow-to-region (point) (point))
@@ -65,7 +65,7 @@
(string-match "text" (car (mm-handle-type handle))))
(mm-insert-part handle))
(goto-char (point-max)))
- (mapcar 'spam-treat-parts handle))))
+ (mapcar #'spam-treat-parts handle))))
(provide 'spam-wash)
diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el
index 2281033..f7288c9 100644
--- a/lisp/gnus/spam.el
+++ b/lisp/gnus/spam.el
@@ -1,4 +1,4 @@
-;;; spam.el --- Identifying spam
+;;; spam.el --- Identifying spam -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
@@ -321,8 +321,8 @@ Default to t if one of the spam-use-* variables is set."
:type 'string
:group 'spam)
-;;; TODO: deprecate this variable, it's confusing since it's a list of strings,
-;;; not regular expressions
+;; TODO: deprecate this variable, it's confusing since it's a list of strings,
+;; not regular expressions
(defcustom spam-junk-mailgroups (cons
spam-split-group
'("mail.junk" "poste.pourriel"))
@@ -705,7 +705,7 @@ finds ham or spam.")
"Clear the `spam-caches' entry for a check."
(remhash symbol spam-caches))
-(define-obsolete-function-alias 'spam-xor 'xor "27.1")
+(define-obsolete-function-alias 'spam-xor #'xor "27.1")
(defun spam-set-difference (list1 list2)
"Return a set difference of LIST1 and LIST2.
@@ -727,7 +727,7 @@ When either list is nil, the other is returned."
(let* ((marks (spam-group-ham-marks group spam))
(marks (if (symbolp mark)
marks
- (mapcar 'symbol-value marks))))
+ (mapcar #'symbol-value marks))))
(memq mark marks))))
(defun spam-group-spam-mark-p (group mark)
@@ -1014,28 +1014,28 @@ backends)."
;;{{{ backend installations
(spam-install-checkonly-backend 'spam-use-blackholes
- 'spam-check-blackholes)
+ #'spam-check-blackholes)
(spam-install-checkonly-backend 'spam-use-hashcash
- 'spam-check-hashcash)
+ #'spam-check-hashcash)
(spam-install-checkonly-backend 'spam-use-spamassassin-headers
- 'spam-check-spamassassin-headers)
+ #'spam-check-spamassassin-headers)
(spam-install-checkonly-backend 'spam-use-bogofilter-headers
- 'spam-check-bogofilter-headers)
+ #'spam-check-bogofilter-headers)
(spam-install-checkonly-backend 'spam-use-bsfilter-headers
- 'spam-check-bsfilter-headers)
+ #'spam-check-bsfilter-headers)
(spam-install-checkonly-backend 'spam-use-gmane-xref
- 'spam-check-gmane-xref)
+ #'spam-check-gmane-xref)
(spam-install-checkonly-backend 'spam-use-regex-headers
- 'spam-check-regex-headers)
+ #'spam-check-regex-headers)
(spam-install-statistical-checkonly-backend 'spam-use-regex-body
- 'spam-check-regex-body)
+ #'spam-check-regex-body)
;; TODO: NOTE: spam-use-ham-copy is now obsolete, use (ham spam-use-copy)
(spam-install-mover-backend 'spam-use-move
@@ -1045,94 +1045,94 @@ backends)."
nil)
(spam-install-nocheck-backend 'spam-use-copy
- 'spam-copy-ham-routine
- 'spam-copy-spam-routine
+ #'spam-copy-ham-routine
+ #'spam-copy-spam-routine
nil
nil)
(spam-install-nocheck-backend 'spam-use-gmane
- 'spam-report-gmane-unregister-routine
- 'spam-report-gmane-register-routine
- 'spam-report-gmane-register-routine
- 'spam-report-gmane-unregister-routine)
+ #'spam-report-gmane-unregister-routine
+ #'spam-report-gmane-register-routine
+ #'spam-report-gmane-register-routine
+ #'spam-report-gmane-unregister-routine)
(spam-install-nocheck-backend 'spam-use-resend
- 'spam-report-resend-register-ham-routine
- 'spam-report-resend-register-routine
+ #'spam-report-resend-register-ham-routine
+ #'spam-report-resend-register-routine
nil
nil)
(spam-install-backend 'spam-use-BBDB
- 'spam-check-BBDB
- 'spam-BBDB-register-routine
+ #'spam-check-BBDB
+ #'spam-BBDB-register-routine
nil
- 'spam-BBDB-unregister-routine
+ #'spam-BBDB-unregister-routine
nil)
(spam-install-backend-alias 'spam-use-BBDB 'spam-use-BBDB-exclusive)
(spam-install-backend 'spam-use-blacklist
- 'spam-check-blacklist
+ #'spam-check-blacklist
nil
- 'spam-blacklist-register-routine
+ #'spam-blacklist-register-routine
nil
- 'spam-blacklist-unregister-routine)
+ #'spam-blacklist-unregister-routine)
(spam-install-backend 'spam-use-whitelist
- 'spam-check-whitelist
- 'spam-whitelist-register-routine
+ #'spam-check-whitelist
+ #'spam-whitelist-register-routine
nil
- 'spam-whitelist-unregister-routine
+ #'spam-whitelist-unregister-routine
nil)
(spam-install-statistical-backend 'spam-use-ifile
- 'spam-check-ifile
- 'spam-ifile-register-ham-routine
- 'spam-ifile-register-spam-routine
- 'spam-ifile-unregister-ham-routine
- 'spam-ifile-unregister-spam-routine)
+ #'spam-check-ifile
+ #'spam-ifile-register-ham-routine
+ #'spam-ifile-register-spam-routine
+ #'spam-ifile-unregister-ham-routine
+ #'spam-ifile-unregister-spam-routine)
(spam-install-statistical-backend 'spam-use-spamoracle
- 'spam-check-spamoracle
- 'spam-spamoracle-learn-ham
- 'spam-spamoracle-learn-spam
- 'spam-spamoracle-unlearn-ham
- 'spam-spamoracle-unlearn-spam)
+ #'spam-check-spamoracle
+ #'spam-spamoracle-learn-ham
+ #'spam-spamoracle-learn-spam
+ #'spam-spamoracle-unlearn-ham
+ #'spam-spamoracle-unlearn-spam)
(spam-install-statistical-backend 'spam-use-stat
- 'spam-check-stat
- 'spam-stat-register-ham-routine
- 'spam-stat-register-spam-routine
- 'spam-stat-unregister-ham-routine
- 'spam-stat-unregister-spam-routine)
+ #'spam-check-stat
+ #'spam-stat-register-ham-routine
+ #'spam-stat-register-spam-routine
+ #'spam-stat-unregister-ham-routine
+ #'spam-stat-unregister-spam-routine)
(spam-install-statistical-backend 'spam-use-spamassassin
- 'spam-check-spamassassin
- 'spam-spamassassin-register-ham-routine
- 'spam-spamassassin-register-spam-routine
- 'spam-spamassassin-unregister-ham-routine
- 'spam-spamassassin-unregister-spam-routine)
+ #'spam-check-spamassassin
+ #'spam-spamassassin-register-ham-routine
+ #'spam-spamassassin-register-spam-routine
+ #'spam-spamassassin-unregister-ham-routine
+ #'spam-spamassassin-unregister-spam-routine)
(spam-install-statistical-backend 'spam-use-bogofilter
- 'spam-check-bogofilter
- 'spam-bogofilter-register-ham-routine
- 'spam-bogofilter-register-spam-routine
- 'spam-bogofilter-unregister-ham-routine
- 'spam-bogofilter-unregister-spam-routine)
+ #'spam-check-bogofilter
+ #'spam-bogofilter-register-ham-routine
+ #'spam-bogofilter-register-spam-routine
+ #'spam-bogofilter-unregister-ham-routine
+ #'spam-bogofilter-unregister-spam-routine)
(spam-install-statistical-backend 'spam-use-bsfilter
- 'spam-check-bsfilter
- 'spam-bsfilter-register-ham-routine
- 'spam-bsfilter-register-spam-routine
- 'spam-bsfilter-unregister-ham-routine
- 'spam-bsfilter-unregister-spam-routine)
+ #'spam-check-bsfilter
+ #'spam-bsfilter-register-ham-routine
+ #'spam-bsfilter-register-spam-routine
+ #'spam-bsfilter-unregister-ham-routine
+ #'spam-bsfilter-unregister-spam-routine)
(spam-install-statistical-backend 'spam-use-crm114
- 'spam-check-crm114
- 'spam-crm114-register-ham-routine
- 'spam-crm114-register-spam-routine
- 'spam-crm114-unregister-ham-routine
- 'spam-crm114-unregister-spam-routine)
+ #'spam-check-crm114
+ #'spam-crm114-register-ham-routine
+ #'spam-crm114-register-spam-routine
+ #'spam-crm114-unregister-ham-routine
+ #'spam-crm114-unregister-spam-routine)
;;}}}
;;{{{ scoring and summary formatting
@@ -1387,7 +1387,7 @@ In the case of mover backends, checks the setting of
(gnus-check-backend-function
'request-move-article gnus-newsgroup-name))
(respool-method (gnus-find-method-for-group gnus-newsgroup-name))
- article mark deletep respool valid-move-destinations)
+ deletep respool valid-move-destinations) ;; article mark
(when (member 'respool groups)
(setq respool t) ; boolean for later
@@ -1709,7 +1709,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more
details."
(if (or (null first-method)
(equal first-method 'default))
(spam-split)
- (apply 'spam-split methods))))))
+ (apply #'spam-split methods))))))
(if (equal split-return 'spam)
(gnus-summary-mark-article article gnus-spam-mark))
@@ -1807,7 +1807,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more
details."
(log-function (if unregister
'spam-log-undo-registration
'spam-log-processing-to-registry))
- article articles)
+ articles) ;; article
(when run-function
;; make list of articles, using specific-articles if given
@@ -1836,7 +1836,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more
details."
;; return the number of articles processed
(length articles))))
-;;; log a ham- or spam-processor invocation to the registry
+;; log a ham- or spam-processor invocation to the registry
(defun spam-log-processing-to-registry (id type classification backend group)
(when spam-log-to-registry
(if (and (stringp id)
@@ -1855,7 +1855,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more
details."
"%s call with bad ID, type, classification, spam-backend, or group"
"spam-log-processing-to-registry")))))
-;;; check if a ham- or spam-processor registration has been done
+;; check if a ham- or spam-processor registration has been done
(defun spam-log-registered-p (id type)
(when spam-log-to-registry
(if (and (stringp id)
@@ -1868,8 +1868,8 @@ See the Info node `(gnus)Fancy Mail Splitting' for more
details."
"spam-log-registered-p"))
nil))))
-;;; check what a ham- or spam-processor registration says
-;;; returns nil if conflicting registrations are found
+;; check what a ham- or spam-processor registration says
+;; returns nil if conflicting registrations are found
(defun spam-log-registration-type (id type)
(let ((count 0)
decision)
@@ -1885,7 +1885,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more
details."
decision)))
-;;; check if a ham- or spam-processor registration needs to be undone
+;; check if a ham- or spam-processor registration needs to be undone
(defun spam-log-unregistration-needed-p (id type classification backend)
(when spam-log-to-registry
(if (and (stringp id)
@@ -1908,9 +1908,9 @@ See the Info node `(gnus)Fancy Mail Splitting' for more
details."
nil))))
-;;; undo a ham- or spam-processor registration (the group is not used)
+;; undo a ham- or spam-processor registration (the group is not used)
(defun spam-log-undo-registration (id type classification backend
- &optional group)
+ &optional _group)
(when (and spam-log-to-registry
(spam-log-unregistration-needed-p id type classification backend))
(if (and (stringp id)
@@ -1918,7 +1918,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more
details."
(spam-classification-valid-p classification)
(spam-backend-valid-p backend))
(let ((cell-list (gnus-registry-get-id-key id type))
- new-cell-list found)
+ new-cell-list) ;; found
(dolist (cell cell-list)
(unless (and (eq classification (nth 0 cell))
(eq backend (nth 1 cell)))
@@ -1981,7 +1981,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more
details."
(defun spam-reverse-ip-string (ip)
(when (stringp ip)
- (mapconcat 'identity
+ (mapconcat #'identity
(nreverse (split-string ip "\\."))
".")))
@@ -2034,94 +2034,83 @@ See the Info node `(gnus)Fancy Mail Splitting' for more
details."
;;{{{ BBDB
-;;; original idea for spam-check-BBDB from Alexander Kotelnikov
-;;; <sacha@giotto.sj.ru>
+;; original idea for spam-check-BBDB from Alexander Kotelnikov
+;; <sacha@giotto.sj.ru>
;; all this is done inside a condition-case to trap errors
;; Autoloaded in message, which we require.
(declare-function gnus-extract-address-components "gnus-util" (from))
-(eval-and-compile
- (condition-case nil
- (progn
- (require 'bbdb)
- (require 'bbdb-com))
- (file-error
- ;; `bbdb-records' should not be bound as an autoload function
- ;; before loading bbdb because of `bbdb-hashtable-size'.
- (defalias 'bbdb-buffer 'ignore)
- (defalias 'bbdb-create-internal 'ignore)
- (defalias 'bbdb-records 'ignore)
- (defalias 'spam-BBDB-register-routine 'ignore)
- (defalias 'spam-enter-ham-BBDB 'ignore)
- (defalias 'spam-exists-in-BBDB-p 'ignore)
- (defalias 'bbdb-gethash 'ignore)
- nil)))
-
-(eval-and-compile
- (when (featurep 'bbdb-com)
- ;; when the BBDB changes, we want to clear out our cache
- (defun spam-clear-cache-BBDB (&rest immaterial)
- (spam-clear-cache 'spam-use-BBDB))
-
- (add-hook 'bbdb-change-hook 'spam-clear-cache-BBDB)
-
- (defun spam-enter-ham-BBDB (addresses &optional remove)
- "Enter an address into the BBDB; implies ham (non-spam) sender"
- (dolist (from addresses)
- (when (stringp from)
- (let* ((parsed-address (gnus-extract-address-components from))
- (name (or (nth 0 parsed-address) "Ham Sender"))
- (remove-function (if remove
- 'bbdb-delete-record-internal
- 'ignore))
- (net-address (nth 1 parsed-address))
- (record (and net-address
- (spam-exists-in-BBDB-p net-address))))
- (when net-address
- (gnus-message 6 "%s address %s %s BBDB"
- (if remove "Deleting" "Adding")
- from
- (if remove "from" "to"))
- (if record
- (funcall remove-function record)
- (bbdb-create-internal name nil net-address nil nil
- "ham sender added by spam.el")))))))
-
- (defun spam-BBDB-register-routine (articles &optional unregister)
- (let (addresses)
- (dolist (article articles)
- (when (stringp (spam-fetch-field-from-fast article))
- (push (spam-fetch-field-from-fast article) addresses)))
- ;; now do the register/unregister action
- (spam-enter-ham-BBDB addresses unregister)))
-
- (defun spam-BBDB-unregister-routine (articles)
- (spam-BBDB-register-routine articles t))
-
- (defsubst spam-exists-in-BBDB-p (net)
- (when (and (stringp net) (not (zerop (length net))))
- (bbdb-records)
- (bbdb-gethash (downcase net))))
-
- (defun spam-check-BBDB ()
- "Mail from people in the BBDB is classified as ham or non-spam"
- (let ((net (message-fetch-field "from")))
- (when net
- (setq net (nth 1 (gnus-extract-address-components net)))
- (if (spam-exists-in-BBDB-p net)
- t
- (if spam-use-BBDB-exclusive
- spam-split-group
- nil)))))))
+(require 'bbdb nil 'noerror)
+(require 'bbdb-com nil 'noerror)
+
+(declare-function bbdb-records "bbdb" ())
+(declare-function bbdb-gethash "bbdb" (key &optional predicate))
+(declare-function bbdb-create-internal "bbdb-com" (&rest spec))
+
+;; when the BBDB changes, we want to clear out our cache
+(defun spam-clear-cache-BBDB (&rest _immaterial)
+ (spam-clear-cache 'spam-use-BBDB))
+
+(when (featurep 'bbdb-com)
+ (add-hook 'bbdb-change-hook #'spam-clear-cache-BBDB))
+
+(defun spam-enter-ham-BBDB (addresses &optional remove)
+ "Enter an address into the BBDB; implies ham (non-spam) sender"
+ (dolist (from addresses)
+ (when (stringp from)
+ (let* ((parsed-address (gnus-extract-address-components from))
+ (name (or (nth 0 parsed-address) "Ham Sender"))
+ (remove-function (if remove
+ 'bbdb-delete-record-internal
+ 'ignore))
+ (net-address (nth 1 parsed-address))
+ (record (and net-address
+ (spam-exists-in-BBDB-p net-address))))
+ (when net-address
+ (gnus-message 6 "%s address %s %s BBDB"
+ (if remove "Deleting" "Adding")
+ from
+ (if remove "from" "to"))
+ (if record
+ (funcall remove-function record)
+ (bbdb-create-internal name nil net-address nil nil
+ "ham sender added by spam.el")))))))
+
+(defun spam-BBDB-register-routine (articles &optional unregister)
+ (let (addresses)
+ (dolist (article articles)
+ (when (stringp (spam-fetch-field-from-fast article))
+ (push (spam-fetch-field-from-fast article) addresses)))
+ ;; now do the register/unregister action
+ (spam-enter-ham-BBDB addresses unregister)))
+
+(defun spam-BBDB-unregister-routine (articles)
+ (spam-BBDB-register-routine articles t))
+
+(defun spam-exists-in-BBDB-p (net)
+ (when (and (stringp net) (not (zerop (length net))))
+ (bbdb-records)
+ (bbdb-gethash (downcase net))))
+
+(defun spam-check-BBDB ()
+ "Mail from people in the BBDB is classified as ham or non-spam"
+ (let ((net (message-fetch-field "from")))
+ (when net
+ (setq net (nth 1 (gnus-extract-address-components net)))
+ (if (spam-exists-in-BBDB-p net)
+ t
+ (if spam-use-BBDB-exclusive
+ spam-split-group
+ nil)))))
;;}}}
;;{{{ ifile
-;;; check the ifile backend; return nil if the mail was NOT classified
-;;; as spam
+;; check the ifile backend; return nil if the mail was NOT classified
+;; as spam
(defun spam-get-ifile-database-parameter ()
@@ -2139,7 +2128,7 @@ See `spam-ifile-database'."
(let ((temp-buffer-name (buffer-name))
(db-param (spam-get-ifile-database-parameter)))
(with-current-buffer article-buffer-name
- (apply 'call-process-region
+ (apply #'call-process-region
(point-min) (point-max) spam-ifile-program
nil temp-buffer-name nil "-c"
(if db-param `(,db-param "-q") '("-q"))))
@@ -2161,13 +2150,13 @@ Uses `gnus-newsgroup-name' if category is nil (for ham
registration)."
(let ((category (or category gnus-newsgroup-name))
(add-or-delete-option (if unregister "-d" "-i"))
(db (spam-get-ifile-database-parameter))
- parameters)
+ ) ;; parameters
(with-temp-buffer
(dolist (article articles)
(let ((article-string (spam-get-article-as-string article)))
(when (stringp article-string)
(insert article-string))))
- (apply 'call-process-region
+ (apply #'call-process-region
(point-min) (point-max) spam-ifile-program
nil nil nil
add-or-delete-option category
@@ -2195,7 +2184,7 @@ Uses `gnus-newsgroup-name' if category is nil (for ham
registration)."
"Check the spam-stat backend for the classification of this message."
(let ((spam-stat-split-fancy-spam-group spam-split-group) ; override
(spam-stat-buffer (buffer-name)) ; stat the current buffer
- category return)
+ ) ;; category return
(spam-stat-split-fancy)))
(defun spam-stat-register-spam-routine (articles &optional unregister)
@@ -2240,7 +2229,7 @@ Uses `gnus-newsgroup-name' if category is nil (for ham
registration)."
(let ((kill-whole-line t))
(kill-line)))
-;;; address can be a list, too
+;; address can be a list, too
(defun spam-enter-whitelist (address &optional remove)
"Enter ADDRESS (list or single) into the whitelist.
With a non-nil REMOVE, remove them."
@@ -2249,7 +2238,7 @@ With a non-nil REMOVE, remove them."
(setq spam-whitelist-cache nil)
(spam-clear-cache 'spam-use-whitelist))
-;;; address can be a list, too
+;; address can be a list, too
(defun spam-enter-blacklist (address &optional remove)
"Enter ADDRESS (list or single) into the blacklist.
With a non-nil REMOVE, remove them."
@@ -2310,8 +2299,8 @@ With a non-nil REMOVE, remove the ADDRESSES."
(cl-return)))
found)))
-;;; returns t if the sender is in the whitelist, nil or
-;;; spam-split-group otherwise
+;; returns t if the sender is in the whitelist, nil or
+;; spam-split-group otherwise
(defun spam-check-whitelist ()
;; FIXME! Should it detect when file timestamps change?
(unless spam-whitelist-cache
@@ -2346,7 +2335,7 @@ With a non-nil REMOVE, remove the ADDRESSES."
(defun spam-from-listed-p (type)
(let ((from (message-fetch-field "from"))
- found)
+ ) ;; found
(spam-filelist-check-cache type from)))
(defun spam-filelist-register-routine (articles blacklist &optional unregister)
@@ -2356,7 +2345,7 @@ With a non-nil REMOVE, remove the ADDRESSES."
(if blacklist 'spam-enter-blacklist 'spam-enter-whitelist))
(remove-function
(if blacklist 'spam-enter-whitelist 'spam-enter-blacklist))
- from addresses unregister-list article-unregister-list)
+ addresses unregister-list article-unregister-list) ;; from
(dolist (article articles)
(let ((from (spam-fetch-field-from-fast article))
(id (spam-fetch-field-message-id-fast article))
@@ -2406,11 +2395,11 @@ With a non-nil REMOVE, remove the ADDRESSES."
;;{{{ Spam-report glue (gmane and resend reporting)
(defun spam-report-gmane-register-routine (articles)
(when articles
- (apply 'spam-report-gmane-spam articles)))
+ (apply #'spam-report-gmane-spam articles)))
(defun spam-report-gmane-unregister-routine (articles)
(when articles
- (apply 'spam-report-gmane-ham articles)))
+ (apply #'spam-report-gmane-ham articles)))
(defun spam-report-resend-register-ham-routine (articles)
(spam-report-resend-register-routine articles t))
@@ -2474,7 +2463,7 @@ With a non-nil REMOVE, remove the ADDRESSES."
(with-temp-buffer
(let ((temp-buffer-name (buffer-name)))
(with-current-buffer article-buffer-name
- (apply 'call-process-region
+ (apply #'call-process-region
(point-min) (point-max)
spam-bogofilter-program
nil temp-buffer-name nil
@@ -2502,7 +2491,7 @@ With a non-nil REMOVE, remove the ADDRESSES."
(with-temp-buffer
(insert article-string)
- (apply 'call-process-region
+ (apply #'call-process-region
(point-min) (point-max)
spam-bogofilter-program
nil nil nil switch
@@ -2532,7 +2521,7 @@ With a non-nil REMOVE, remove the ADDRESSES."
(let ((temp-buffer-name (buffer-name)))
(with-current-buffer article-buffer-name
(let ((status
- (apply 'call-process-region
+ (apply #'call-process-region
(point-min) (point-max)
spam-spamoracle-binary
nil temp-buffer-name nil
@@ -2559,7 +2548,7 @@ With a non-nil REMOVE, remove the ADDRESSES."
"-spam"
"-good"))
(status
- (apply 'call-process-region
+ (apply #'call-process-region
(point-min) (point-max)
spam-spamoracle-binary
nil temp-buffer-name nil
@@ -2573,13 +2562,13 @@ With a non-nil REMOVE, remove the ADDRESSES."
(defun spam-spamoracle-learn-ham (articles &optional unregister)
(spam-spamoracle-learn articles nil unregister))
-(defun spam-spamoracle-unlearn-ham (articles &optional unregister)
+(defun spam-spamoracle-unlearn-ham (articles &optional _unregister)
(spam-spamoracle-learn-ham articles t))
(defun spam-spamoracle-learn-spam (articles &optional unregister)
(spam-spamoracle-learn articles t unregister))
-(defun spam-spamoracle-unlearn-spam (articles &optional unregister)
+(defun spam-spamoracle-unlearn-spam (articles &optional _unregister)
(spam-spamoracle-learn-spam articles t))
;;}}}
@@ -2607,7 +2596,7 @@ With a non-nil REMOVE, remove the ADDRESSES."
(with-temp-buffer
(let ((temp-buffer-name (buffer-name)))
(with-current-buffer article-buffer-name
- (apply 'call-process-region
+ (apply #'call-process-region
(point-min) (point-max) spam-assassin-program
nil temp-buffer-name nil spam-spamassassin-arguments))
;; check the return now (we're back in the temp buffer)
@@ -2648,7 +2637,7 @@ With a non-nil REMOVE, remove the ADDRESSES."
(insert article-string)
(insert "\n"))))
;; call sa-learn on all messages at the same time
- (apply 'call-process-region
+ (apply #'call-process-region
(point-min) (point-max)
spam-sa-learn-program
nil nil nil "--mbox"
@@ -2703,7 +2692,7 @@ With a non-nil REMOVE, remove the ADDRESSES."
(with-temp-buffer
(let ((temp-buffer-name (buffer-name)))
(with-current-buffer article-buffer-name
- (apply 'call-process-region
+ (apply #'call-process-region
(point-min) (point-max)
spam-bsfilter-program
nil temp-buffer-name nil
@@ -2731,7 +2720,7 @@ With a non-nil REMOVE, remove the ADDRESSES."
(when (stringp article-string)
(with-temp-buffer
(insert article-string)
- (apply 'call-process-region
+ (apply #'call-process-region
(point-min) (point-max)
spam-bsfilter-program
nil nil nil switch
@@ -2788,7 +2777,7 @@ With a non-nil REMOVE, remove the ADDRESSES."
(with-temp-buffer
(let ((temp-buffer-name (buffer-name)))
(with-current-buffer article-buffer-name
- (apply 'call-process-region
+ (apply #'call-process-region
(point-min) (point-max)
spam-crm114-program
nil temp-buffer-name nil
@@ -2814,7 +2803,7 @@ With a non-nil REMOVE, remove the ADDRESSES."
(with-temp-buffer
(insert article-string)
- (apply 'call-process-region
+ (apply #'call-process-region
(point-min) (point-max)
spam-crm114-program
nil nil nil
@@ -2859,13 +2848,13 @@ installed through `spam-necessary-extra-headers'."
(push '((eq mark gnus-spam-mark) . spam)
gnus-summary-highlight)
;; Add hooks for loading and saving the spam stats
- (add-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save)
- (add-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load)
- (add-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load)
- (add-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit)
- (add-hook 'gnus-summary-prepare-hook 'spam-summary-prepare)
- (add-hook 'gnus-get-new-news-hook 'spam-setup-widening)
- (add-hook 'gnus-summary-prepared-hook 'spam-find-spam)
+ (add-hook 'gnus-save-newsrc-hook #'spam-maybe-spam-stat-save)
+ (add-hook 'gnus-get-top-new-news-hook #'spam-maybe-spam-stat-load)
+ (add-hook 'gnus-startup-hook #'spam-maybe-spam-stat-load)
+ (add-hook 'gnus-summary-prepare-exit-hook #'spam-summary-prepare-exit)
+ (add-hook 'gnus-summary-prepare-hook #'spam-summary-prepare)
+ (add-hook 'gnus-get-new-news-hook #'spam-setup-widening)
+ (add-hook 'gnus-summary-prepared-hook #'spam-find-spam)
;; Don't install things more than once.
(setq spam-install-hooks nil)))
@@ -2873,15 +2862,15 @@ installed through `spam-necessary-extra-headers'."
"Uninstall the spam.el hooks."
(interactive)
(spam-teardown-widening)
- (remove-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save)
- (remove-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load)
- (remove-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load)
- (remove-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit)
- (remove-hook 'gnus-summary-prepare-hook 'spam-summary-prepare)
- (remove-hook 'gnus-get-new-news-hook 'spam-setup-widening)
- (remove-hook 'gnus-summary-prepare-hook 'spam-find-spam))
-
-(add-hook 'spam-unload-hook 'spam-unload-hook)
+ (remove-hook 'gnus-save-newsrc-hook #'spam-maybe-spam-stat-save)
+ (remove-hook 'gnus-get-top-new-news-hook #'spam-maybe-spam-stat-load)
+ (remove-hook 'gnus-startup-hook #'spam-maybe-spam-stat-load)
+ (remove-hook 'gnus-summary-prepare-exit-hook #'spam-summary-prepare-exit)
+ (remove-hook 'gnus-summary-prepare-hook #'spam-summary-prepare)
+ (remove-hook 'gnus-get-new-news-hook #'spam-setup-widening)
+ (remove-hook 'gnus-summary-prepare-hook #'spam-find-spam))
+
+(add-hook 'spam-unload-hook #'spam-unload-hook)
;;}}}
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 8796530..ddbd11f 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -533,7 +533,7 @@ suitable file is found, return nil."
(format "\nMacro: %s"
(help--docstring-quote
(format-kbd-macro real-def))))
- (t "[Missing arglist. Please make a bug report.]")))
+ (t "[Missing arglist.]")))
;; Insert "`X", not "(\` X)", when documenting `X.
(use1 (replace-regexp-in-string
"\\`(\\\\=\\\\\\\\=` \\([^\n ]*\\))\\'"
@@ -841,7 +841,7 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED
REAL-DEF)."
(t "")))
(if (and aliased (not (fboundp real-def)))
- (princ ",\nwhich is not defined. Please make a bug report.")
+ (princ ",\nwhich is not defined.")
(with-current-buffer standard-output
(save-excursion
(save-match-data
diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index 7043f12..79710a1 100644
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -62,33 +62,29 @@
["Move to Next Button" forward-button
:help "Move to the Next Button in the help buffer"]))
-(defvar help-xref-stack nil
+(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'.
An element looks like (POSITION FUNCTION ARGS...).
To use the element, do (apply FUNCTION ARGS) then goto the point.")
(put 'help-xref-stack 'permanent-local t)
-(make-variable-buffer-local 'help-xref-stack)
-(defvar help-xref-forward-stack nil
+(defvar-local help-xref-forward-stack nil
"A stack used to navigate help forwards after using the back button.
Used by `help-follow' and `help-xref-go-forward'.
An element looks like (POSITION FUNCTION ARGS...).
To use the element, do (apply FUNCTION ARGS) then goto the point.")
(put 'help-xref-forward-stack 'permanent-local t)
-(make-variable-buffer-local 'help-xref-forward-stack)
-(defvar help-xref-stack-item nil
+(defvar-local help-xref-stack-item nil
"An item for `help-follow' in this buffer to push onto `help-xref-stack'.
The format is (FUNCTION ARGS...).")
(put 'help-xref-stack-item 'permanent-local t)
-(make-variable-buffer-local 'help-xref-stack-item)
-(defvar help-xref-stack-forward-item nil
+(defvar-local help-xref-stack-forward-item nil
"An item for `help-go-back' to push onto `help-xref-forward-stack'.
The format is (FUNCTION ARGS...).")
(put 'help-xref-stack-forward-item 'permanent-local t)
-(make-variable-buffer-local 'help-xref-stack-forward-item)
(setq-default help-xref-stack nil help-xref-stack-item nil)
(setq-default help-xref-forward-stack nil help-xref-forward-stack-item nil)
diff --git a/lisp/hexl.el b/lisp/hexl.el
index 8d3cfe6..85c3a53 100644
--- a/lisp/hexl.el
+++ b/lisp/hexl.el
@@ -209,12 +209,10 @@ as that will override any bit grouping options set here."
(defvar hl-line-face)
;; Variables where the original values are stored to.
-(defvar hexl-mode--old-var-vals ())
-(make-variable-buffer-local 'hexl-mode--old-var-vals)
+(defvar-local hexl-mode--old-var-vals ())
-(defvar hexl-ascii-overlay nil
+(defvar-local hexl-ascii-overlay nil
"Overlay used to highlight ASCII element corresponding to current point.")
-(make-variable-buffer-local 'hexl-ascii-overlay)
(defvar hexl-font-lock-keywords
'(("^\\([0-9a-f]+:\\)\\( \\).\\{39\\}\\( \\)\\(.+$\\)"
diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el
index e214ab6..0ad499b 100644
--- a/lisp/hi-lock.el
+++ b/lisp/hi-lock.el
@@ -381,13 +381,7 @@ Hi-lock: end is found. A mode is excluded if it's in the
list
(warn "%s"
"Possible archaic use of (hi-lock-mode).
Use (global-hi-lock-mode 1) in .emacs to enable hi-lock for all buffers,
-use (hi-lock-mode 1) for individual buffers. For compatibility with Emacs
-versions before 22 use the following in your init file:
-
- (if (functionp 'global-hi-lock-mode)
- (global-hi-lock-mode 1)
- (hi-lock-mode 1))
-")))
+use (hi-lock-mode 1) for individual buffers.")))
(if hi-lock-mode
;; Turned on.
(progn
diff --git a/lisp/hilit-chg.el b/lisp/hilit-chg.el
index fb33cd9..89a1a91 100644
--- a/lisp/hilit-chg.el
+++ b/lisp/hilit-chg.el
@@ -296,9 +296,7 @@ remove it from existing buffers."
;; These are for internal use.
(defvar hilit-chg-list nil)
-(defvar hilit-chg-string " ??")
-
-(make-variable-buffer-local 'hilit-chg-string)
+(defvar-local hilit-chg-string " ??")
diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el
index 84c53b1..6dc1c7e 100644
--- a/lisp/ibuffer.el
+++ b/lisp/ibuffer.el
@@ -303,7 +303,7 @@ This variable takes precedence over filtering, and even
in completion lists of the `ibuffer-jump-to-buffer' command."
:type 'boolean)
-(defcustom ibuffer-use-header-line (boundp 'header-line-format)
+(defcustom ibuffer-use-header-line t
"If non-nil, display a header line containing current filters."
:type 'boolean)
@@ -2129,16 +2129,13 @@ the value of point at the beginning of the line for
that buffer."
(and ibuffer-buf
(not (eq ibuffer-buf buf))))))
-;; This function is a special case; it's not defined by
-;; `define-ibuffer-sorter'.
-(defun ibuffer-do-sort-by-recency ()
- "Sort the buffers by last view time."
- (interactive)
- (setq ibuffer-sorting-mode 'recency)
- (when (eq ibuffer-last-sorting-mode 'recency)
- (setq ibuffer-sorting-reversep (not ibuffer-sorting-reversep)))
- (ibuffer-update nil t)
- (setq ibuffer-last-sorting-mode 'recency))
+(define-ibuffer-sorter recency
+ "Sort the buffers by how recently they've been used."
+ (:description "recency")
+ (time-less-p (with-current-buffer (car b)
+ (or buffer-display-time 0))
+ (with-current-buffer (car a)
+ (or buffer-display-time 0))))
(defun ibuffer-update-format ()
(when (null ibuffer-current-format)
diff --git a/lisp/ido.el b/lisp/ido.el
index 89b6a62..3ed0d95 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -1037,10 +1037,9 @@ Should never be set permanently.")
(defvar ido-completion-map nil
"Currently active keymap for Ido commands.")
-(defvar ido-eoinput 1
+(defvar-local ido-eoinput 1
"Point where minibuffer input ends and completion info begins.
Copied from `icomplete-eoinput'.")
-(make-variable-buffer-local 'ido-eoinput)
(defvar ido-common-match-string nil
"Stores the string that is common to all matching files.")
diff --git a/lisp/imenu.el b/lisp/imenu.el
index b5cd18a..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,11 +151,10 @@ 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
-(defvar imenu-generic-expression nil
+(defvar-local imenu-generic-expression nil
"List of definition matchers for creating an Imenu index.
Each element of this list should have the form
@@ -223,13 +190,10 @@ characters which normally have \"symbol\" syntax are
considered to have
\"word\" syntax during matching.")
;;;###autoload(put 'imenu-generic-expression 'risky-local-variable t)
-;;;###autoload
-(make-variable-buffer-local 'imenu-generic-expression)
-
;;;; Hooks
;;;###autoload
-(defvar imenu-create-index-function 'imenu-default-create-index-function
+(defvar-local imenu-create-index-function 'imenu-default-create-index-function
"The function to use for creating an index alist of the current buffer.
It should be a function that takes no arguments and returns
@@ -237,11 +201,9 @@ an index alist of the current buffer. The function is
called within a `save-excursion'.
See `imenu--index-alist' for the format of the buffer index alist.")
-;;;###autoload
-(make-variable-buffer-local 'imenu-create-index-function)
;;;###autoload
-(defvar imenu-prev-index-position-function 'beginning-of-defun
+(defvar-local imenu-prev-index-position-function 'beginning-of-defun
"Function for finding the next index position.
If `imenu-create-index-function' is set to
@@ -251,21 +213,17 @@ file.
The function should leave point at the place to be connected to the
index and it should return nil when it doesn't find another index.")
-;;;###autoload
-(make-variable-buffer-local 'imenu-prev-index-position-function)
;;;###autoload
-(defvar imenu-extract-index-name-function nil
+(defvar-local imenu-extract-index-name-function nil
"Function for extracting the index item name, given a position.
This function is called after `imenu-prev-index-position-function'
finds a position for an index item, with point at that position.
It should return the name for that index item.")
-;;;###autoload
-(make-variable-buffer-local 'imenu-extract-index-name-function)
;;;###autoload
-(defvar imenu-name-lookup-function nil
+(defvar-local imenu-name-lookup-function nil
"Function to compare string with index item.
This function will be called with two strings, and should return
@@ -275,15 +233,11 @@ If nil, comparison is done with `string='.
Set this to some other function for more advanced comparisons,
such as \"begins with\" or \"name matches and number of
arguments match\".")
-;;;###autoload
-(make-variable-buffer-local 'imenu-name-lookup-function)
;;;###autoload
-(defvar imenu-default-goto-function 'imenu-default-goto-function
+(defvar-local imenu-default-goto-function 'imenu-default-goto-function
"The default function called when selecting an Imenu item.
The function in this variable is called when selecting a normal index-item.")
-;;;###autoload
-(make-variable-buffer-local 'imenu-default-goto-function)
(defun imenu--subalist-p (item)
@@ -293,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)))))
)
@@ -554,7 +493,8 @@ Non-nil arguments are in recursive calls."
(setq alist nil res elt))))
res))
-(defvar imenu-syntax-alist nil
+;;;###autoload
+(defvar-local imenu-syntax-alist nil
"Alist of syntax table modifiers to use while in `imenu--generic-function'.
The car of the assocs may be either a character or a string and the
@@ -564,8 +504,6 @@ a string, all the characters in the string get the
specified syntax.
This is typically used to give word syntax to characters which
normally have symbol syntax to simplify `imenu-expression'
and speed-up matching.")
-;;;###autoload
-(make-variable-buffer-local 'imenu-syntax-alist)
(defun imenu-default-create-index-function ()
"Default function to create an index alist of the current buffer.
@@ -607,14 +545,13 @@ The alternate method, which is the one most often used,
is to call
;;; Generic index gathering function.
;;;
-(defvar imenu-case-fold-search t
+;;;###autoload
+(defvar-local imenu-case-fold-search t
"Defines whether `imenu--generic-function' should fold case when matching.
This variable should be set (only) by initialization code
for modes which use `imenu--generic-function'. If it is not set, but
`font-lock-defaults' is set, then font-lock's setting is used.")
-;;;###autoload
-(make-variable-buffer-local 'imenu-case-fold-search)
;; This function can be called with quitting disabled,
;; so it needs to be careful never to loop!
diff --git a/lisp/indent.el b/lisp/indent.el
index 5c5270b..285b8e2 100644
--- a/lisp/indent.el
+++ b/lisp/indent.el
@@ -83,22 +83,23 @@ This variable has no effect unless `tab-always-indent' is
`complete'."
(const :tag "Unless at a word, parenthesis, or punctuation."
'word-or-paren-or-punct))
:version "27.1")
+(defvar indent-line-ignored-functions '(indent-relative
+ indent-relative-maybe
+ indent-relative-first-indent-point)
+ "Values that are ignored by `indent-according-to-mode'.")
(defun indent-according-to-mode ()
"Indent line in proper way for current major mode.
Normally, this is done by calling the function specified by the
variable `indent-line-function'. However, if the value of that
-variable is `indent-relative' or `indent-relative-first-indent-point',
+variable is present in the `indent-line-ignored-functions' variable,
handle it specially (since those functions are used for tabbing);
in that case, indent by aligning to the previous non-blank line."
(interactive)
(save-restriction
(widen)
(syntax-propertize (line-end-position))
- (if (memq indent-line-function
- '(indent-relative
- indent-relative-maybe
- indent-relative-first-indent-point))
+ (if (memq indent-line-function indent-line-ignored-functions)
;; These functions are used for tabbing, but can't be used for
;; indenting. Replace with something ad-hoc.
(let ((column (save-excursion
@@ -249,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,
@@ -523,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 dec9392..7f169f4 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -1260,9 +1260,9 @@ is non-nil)."
(if Info-history
(let ((hist (car Info-history)))
(setq Info-history (cdr Info-history))
- (Info-find-node (nth 0 hist) (nth 1 hist) t)
+ (Info-find-node (nth 0 hist) (nth 1 hist) t t)
(goto-char (nth 2 hist)))
- (Info-find-node Info-current-file "Top" t)))))
+ (Info-find-node Info-current-file "Top" t t)))))
;; Cache the contents of the (virtual) dir file, once we have merged
;; it for the first time, so we can save time subsequently.
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 8202c3e..e4bdf50 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -1315,15 +1315,13 @@ Each function is called with one arg, LEIM directory
name.")
(dolist (function update-leim-list-functions)
(apply function dirs)))
-(defvar current-input-method nil
+(defvar-local current-input-method nil
"The current input method for multilingual text.
If nil, that means no input method is activated now.")
-(make-variable-buffer-local 'current-input-method)
(put 'current-input-method 'permanent-local t)
-(defvar current-input-method-title nil
+(defvar-local current-input-method-title nil
"Title string of the current input method shown in mode line.")
-(make-variable-buffer-local 'current-input-method-title)
(put 'current-input-method-title 'permanent-local t)
(define-widget 'mule-input-method-string 'string
@@ -1355,45 +1353,40 @@ This is the input method activated by the command
:set-after '(current-language-environment)
:version "28.1")
-(defvar current-transient-input-method nil
+(defvar-local current-transient-input-method nil
"Current input method temporarily enabled by
`activate-transient-input-method'.
If nil, that means no transient input method is active now.")
-(make-variable-buffer-local 'current-transient-input-method)
(put 'current-transient-input-method 'permanent-local t)
-(defvar previous-transient-input-method nil
+(defvar-local previous-transient-input-method nil
"The input method that was active before enabling the transient input method.
If nil, that means no previous input method was active.")
-(make-variable-buffer-local 'previous-transient-input-method)
(put 'previous-transient-input-method 'permanent-local t)
(put 'input-method-function 'permanent-local t)
-(defvar input-method-history nil
+(defvar-local input-method-history nil
"History list of input methods read from the minibuffer.
Maximum length of the history list is determined by the value
of `history-length', which see.")
-(make-variable-buffer-local 'input-method-history)
(put 'input-method-history 'permanent-local t)
(define-obsolete-variable-alias
'inactivate-current-input-method-function
'deactivate-current-input-method-function "24.3")
-(defvar deactivate-current-input-method-function nil
+(defvar-local deactivate-current-input-method-function nil
"Function to call for deactivating the current input method.
Every input method should set this to an appropriate value when activated.
This function is called with no argument.
This function should never change the value of `current-input-method'.
It is set to nil by the function `deactivate-input-method'.")
-(make-variable-buffer-local 'deactivate-current-input-method-function)
(put 'deactivate-current-input-method-function 'permanent-local t)
-(defvar describe-current-input-method-function nil
+(defvar-local describe-current-input-method-function nil
"Function to call for describing the current input method.
This function is called with no argument.")
-(make-variable-buffer-local 'describe-current-input-method-function)
(put 'describe-current-input-method-function 'permanent-local t)
(defvar input-method-alist nil
@@ -3084,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.
@@ -3111,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
@@ -3124,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
@@ -3137,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/international/mule.el b/lisp/international/mule.el
index dd4448d..91d18c3 100644
--- a/lisp/international/mule.el
+++ b/lisp/international/mule.el
@@ -1192,12 +1192,11 @@ FORM is a form to evaluate to define the coding-system."
;; `last-coding-system-used'. (It used to set it unconditionally, but
;; that seems unnecessary; see Bug#4533.)
-(defvar buffer-file-coding-system-explicit nil
+(defvar-local buffer-file-coding-system-explicit nil
"The file coding system explicitly specified for the current buffer.
The value is a cons of coding systems for reading (decoding) and
writing (encoding).
Internal use only.")
-(make-variable-buffer-local 'buffer-file-coding-system-explicit)
(put 'buffer-file-coding-system-explicit 'permanent-local t)
(defun read-buffer-file-coding-system ()
diff --git a/lisp/international/quail.el b/lisp/international/quail.el
index 0901115..67ea006 100644
--- a/lisp/international/quail.el
+++ b/lisp/international/quail.el
@@ -61,15 +61,14 @@
;; Buffer local variables
-(defvar quail-current-package nil
+(defvar-local quail-current-package nil
"The current Quail package, which depends on the current input method.
See the documentation of `quail-package-alist' for the format.")
-(make-variable-buffer-local 'quail-current-package)
(put 'quail-current-package 'permanent-local t)
;; Quail uses the following variables to assist users.
;; A string containing available key sequences or translation list.
-(defvar quail-guidance-str nil)
+(defvar-local quail-guidance-str nil)
;; A buffer to show completion list of the current key sequence.
(defvar quail-completion-buf nil)
;; We may display the guidance string in a buffer on a one-line frame.
@@ -78,41 +77,34 @@ See the documentation of `quail-package-alist' for the
format.")
;; Each buffer in which Quail is activated should use different
;; guidance string.
-(make-variable-buffer-local 'quail-guidance-str)
(put 'quail-guidance-str 'permanent-local t)
-(defvar quail-overlay nil
+(defvar-local quail-overlay nil
"Overlay which covers the current translation region of Quail.")
-(make-variable-buffer-local 'quail-overlay)
-(defvar quail-conv-overlay nil
+(defvar-local quail-conv-overlay nil
"Overlay which covers the text to be converted in Quail mode.")
-(make-variable-buffer-local 'quail-conv-overlay)
-(defvar quail-current-key nil
+(defvar-local quail-current-key nil
"Current key for translation in Quail mode.")
-(make-variable-buffer-local 'quail-current-key)
-(defvar quail-current-str nil
+(defvar-local quail-current-str nil
"Currently selected translation of the current key.")
-(make-variable-buffer-local 'quail-current-str)
-(defvar quail-current-translations nil
+(defvar-local quail-current-translations nil
"Cons of indices and vector of possible translations of the current key.
Indices is a list of (CURRENT START END BLOCK BLOCKS), where
CURRENT is an index of the current translation,
START and END are indices of the start and end of the current block,
BLOCK is the current block index,
BLOCKS is a number of blocks of translation.")
-(make-variable-buffer-local 'quail-current-translations)
-(defvar quail-current-data nil
+(defvar-local quail-current-data nil
"Any Lisp object holding information of current translation status.
When a key sequence is mapped to TRANS and TRANS is a cons
of actual translation and some Lisp object to be referred
for translating the longer key sequence, this variable is set
to that Lisp object.")
-(make-variable-buffer-local 'quail-current-data)
;; Quail package handlers.
@@ -2027,10 +2019,15 @@ minibuffer and the selected frame has no other
windows)."
(bury-buffer quail-completion-buf)
;; Then, show the guidance.
- (when (and (quail-require-guidance-buf)
- (not input-method-use-echo-area)
- (null unread-command-events)
- (null unread-post-input-method-events))
+ (when (and
+ ;; Don't try to display guidance on an expired minibuffer. This
+ ;; would go into an infinite wait rather than executing the user's
+ ;; command. Bug #45792.
+ (not (eq major-mode 'minibuffer-inactive-mode))
+ (quail-require-guidance-buf)
+ (not input-method-use-echo-area)
+ (null unread-command-events)
+ (null unread-post-input-method-events))
(if (minibufferp)
(if (eq (minibuffer-window) (frame-root-window))
;; Use another frame. It is sure that we are using some
diff --git a/lisp/international/robin.el b/lisp/international/robin.el
index 55390df..e4a1180 100644
--- a/lisp/international/robin.el
+++ b/lisp/international/robin.el
@@ -371,14 +371,12 @@ Internal use only."
;;; Interactive use
-(defvar robin-mode nil
+(defvar-local robin-mode nil
"If non-nil, `robin-input-method' is active.")
-(make-variable-buffer-local 'robin-mode)
-(defvar robin-current-package-name nil
+(defvar-local robin-current-package-name nil
"String representing the name of the current robin package.
A nil value means no package is selected.")
-(make-variable-buffer-local 'robin-current-package-name)
;;;###autoload
(defun robin-use-package (name)
diff --git a/lisp/isearch.el b/lisp/isearch.el
index a1e3fe2..b58ca8a 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -320,7 +320,8 @@ matching the current search string is highlighted lazily
When multiple windows display the current buffer, the
highlighting is displayed only on the selected window, unless
this variable is set to the symbol `all-windows'."
- :type '(choice boolean
+ :type '(choice (const :tag "Off" nil)
+ (const :tag "On, and applied to current window" t)
(const :tag "On, and applied to all windows" all-windows))
:group 'lazy-highlight
:group 'isearch)
@@ -352,10 +353,20 @@ If this is nil, extra highlighting can be \"manually\"
removed with
:group 'lazy-highlight)
(defcustom lazy-highlight-initial-delay 0.25
- "Seconds to wait before beginning to lazily highlight all matches."
+ "Seconds to wait before beginning to lazily highlight all matches.
+This setting only has effect when the search string is less than
+`lazy-highlight-no-delay-length' characters long."
:type 'number
:group 'lazy-highlight)
+(defcustom lazy-highlight-no-delay-length 3
+ "For search strings at least this long, lazy highlight starts immediately.
+For shorter search strings, `lazy-highlight-initial-delay'
+applies."
+ :type 'integer
+ :group 'lazy-highlight
+ :version "28.1")
+
(defcustom lazy-highlight-interval 0 ; 0.0625
"Seconds between lazily highlighting successive matches."
:type 'number
@@ -3356,7 +3367,7 @@ isearch-message-suffix prompt. Otherwise, for
isearch-message-prefix."
(not isearch-error)
(not isearch-suspended))
(format format-string
- (if isearch-forward
+ (if isearch-lazy-highlight-forward
isearch-lazy-count-current
(if (eq isearch-lazy-count-current 0)
0
@@ -3916,7 +3927,8 @@ by other Emacs features."
(clrhash isearch-lazy-count-hash)
(setq isearch-lazy-count-current nil
isearch-lazy-count-total nil)
- (isearch-message)))
+ ;; Delay updating the message if possible, to avoid flicker
+ (when (string-equal isearch-string "") (isearch-message))))
(setq isearch-lazy-highlight-window-start-changed nil)
(setq isearch-lazy-highlight-window-end-changed nil)
(setq isearch-lazy-highlight-error isearch-error)
@@ -3961,7 +3973,11 @@ by other Emacs features."
(point-min))))
(unless (equal isearch-string "")
(setq isearch-lazy-highlight-timer
- (run-with-idle-timer lazy-highlight-initial-delay nil
+ (run-with-idle-timer (if (>= (length isearch-string)
+ lazy-highlight-no-delay-length)
+ 0
+ lazy-highlight-initial-delay)
+ nil
'isearch-lazy-highlight-start))))
;; Update the current match number only in isearch-mode and
;; unless isearch-mode is used specially with isearch-message-function
diff --git a/lisp/jka-compr.el b/lisp/jka-compr.el
index 877f2eb..8aebcd0 100644
--- a/lisp/jka-compr.el
+++ b/lisp/jka-compr.el
@@ -101,11 +101,10 @@ NOTE: Not used in MS-DOS and Windows systems."
(defvar jka-compr-use-shell
(not (memq system-type '(ms-dos windows-nt))))
-(defvar jka-compr-really-do-compress nil
+(defvar-local jka-compr-really-do-compress nil
"Non-nil in a buffer whose visited file was uncompressed on visiting it.
This means compress the data on writing the file, even if the
data appears to be compressed already.")
-(make-variable-buffer-local 'jka-compr-really-do-compress)
(put 'jka-compr-really-do-compress 'permanent-local t)
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/language/ethio-util.el b/lisp/language/ethio-util.el
index 9b5fdf2..fa31cd5 100644
--- a/lisp/language/ethio-util.el
+++ b/lisp/language/ethio-util.el
@@ -972,8 +972,7 @@ Otherwise, [0-9A-F]."
;; Ethiopic word separator vs. ASCII space
;;
-(defvar ethio-prefer-ascii-space t)
-(make-variable-buffer-local 'ethio-prefer-ascii-space)
+(defvar-local ethio-prefer-ascii-space t)
(defun ethio-toggle-space nil
"Toggle ASCII space and Ethiopic separator for keyboard input."
diff --git a/lisp/language/korea-util.el b/lisp/language/korea-util.el
index c99ff3c..b999eff 100644
--- a/lisp/language/korea-util.el
+++ b/lisp/language/korea-util.el
@@ -32,13 +32,15 @@
(purecopy (if (string-match "3" (or (getenv "HANGUL_KEYBOARD_TYPE") ""))
"3"
""))
- "The kind of Korean keyboard for Korean input method.
-\"\" for 2, \"3\" for 3.")
+ "The kind of Korean keyboard for Korean (Hangul) input method.
+\"\" for 2, \"3\" for 3, and \"3f\" for 3f.")
;; functions useful for Korean text input
(defun toggle-korean-input-method ()
- "Turn on or off a Korean text input method for the current buffer."
+ "Turn on or off a Korean text input method for the current buffer.
+The keyboard layout variation used is determined by
+`default-korean-keyboard'."
(interactive)
(if current-input-method
(deactivate-input-method)
@@ -46,7 +48,9 @@
(concat "korean-hangul" default-korean-keyboard))))
(defun quail-hangul-switch-symbol-ksc (&rest _ignore)
- "Switch to/from Korean symbol package."
+ "Switch to/from Korean symbol package.
+The keyboard layout variation used is determined by
+`default-korean-keyboard'."
(interactive "i")
(and current-input-method
(if (string-equal current-input-method "korean-symbol")
@@ -55,7 +59,9 @@
(activate-input-method "korean-symbol"))))
(defun quail-hangul-switch-hanja (&rest _ignore)
- "Switch to/from Korean hanja package."
+ "Switch to/from Korean hanja package.
+The keyboard layout variation used is determined by
+`default-korean-keyboard'."
(interactive "i")
(and current-input-method
(if (string-match "korean-hanja" current-input-method)
diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el
index c6fa497..9924d62 100644
--- a/lisp/ldefs-boot.el
+++ b/lisp/ldefs-boot.el
@@ -8415,9 +8415,6 @@ strings when pressed twice. See `double-map' for details.
(autoload 'dunnet "dunnet" "\
Switch to *dungeon* buffer and start game." t nil)
-(autoload 'dun-batch "dunnet" "\
-Start `dunnet' in batch mode." nil nil)
-
(register-definition-prefixes "dunnet" '("dun" "obj-special"))
;;;***
@@ -12945,7 +12942,7 @@ lines.
;;;### (autoloads nil "flymake" "progmodes/flymake.el" (0 0 0 0))
;;; Generated autoloads from progmodes/flymake.el
-(push (purecopy '(flymake 1 0 9)) package--builtin-versions)
+(push (purecopy '(flymake 1 1 1)) package--builtin-versions)
(autoload 'flymake-log "flymake" "\
Log, at level LEVEL, the message MSG formatted with ARGS.
@@ -15889,7 +15886,7 @@ Produce a texinfo buffer with sorted doc-strings from
the DOC file.
\(fn FILE)" t nil)
-(register-definition-prefixes "help-fns" '("describe-" "help-"))
+(register-definition-prefixes "help-fns" '("describe-" "help-"
"keymap-name-history"))
;;;***
@@ -16672,9 +16669,7 @@ non-selected window. Hl-Line mode uses the function
`hl-line-highlight' on `post-command-hook' in this case.
When `hl-line-sticky-flag' is nil, Hl-Line mode highlights the
-line about point in the selected window only. In this case, it
-uses the function `hl-line-maybe-unhighlight' in
-addition to `hl-line-highlight' on `post-command-hook'.
+line about point in the selected window only.
\(fn &optional ARG)" t nil)
@@ -16706,8 +16701,8 @@ If `global-hl-line-sticky-flag' is non-nil, Global
Hl-Line mode
highlights the line about the current buffer's point in all live
windows.
-Global-Hl-Line mode uses the functions `global-hl-line-highlight'
-and `global-hl-line-maybe-unhighlight' on `post-command-hook'.
+Global-Hl-Line mode uses the function `global-hl-line-highlight'
+on `post-command-hook'.
\(fn &optional ARG)" t nil)
@@ -18387,7 +18382,9 @@ the environment variable INFOPATH is set.
Although this is a customizable variable, that is mainly for technical
reasons. Normally, you should either set INFOPATH or customize
-`Info-additional-directory-list', rather than changing this variable."
:initialize 'custom-initialize-delay :type '(repeat directory))
+`Info-additional-directory-list', rather than changing this variable."
:initialize #'custom-initialize-delay :type '(repeat directory))
+
+(custom-autoload 'Info-default-directory-list "info" t)
(autoload 'info-other-window "info" "\
Like `info' but show the Info buffer in another window.
@@ -19539,7 +19536,7 @@ Create lambda form for macro bound to symbol or key.
\(fn MAC &optional COUNTER FORMAT)" nil nil)
-(register-definition-prefixes "kmacro" '("kmacro-"))
+(register-definition-prefixes "kmacro" '("kdb-macro-redisplay" "kmacro-"))
;;;***
@@ -19548,8 +19545,8 @@ Create lambda form for macro bound to symbol or key.
;;; Generated autoloads from language/korea-util.el
(defvar default-korean-keyboard (purecopy (if (string-match "3" (or (getenv
"HANGUL_KEYBOARD_TYPE") "")) "3" "")) "\
-The kind of Korean keyboard for Korean input method.
-\"\" for 2, \"3\" for 3.")
+The kind of Korean keyboard for Korean (Hangul) input method.
+\"\" for 2, \"3\" for 3, and \"3f\" for 3f.")
(autoload 'setup-korean-environment-internal "korea-util" nil nil nil)
@@ -21586,8 +21583,10 @@ Major mode for the mixal asm language.
;;;### (autoloads nil "mm-encode" "gnus/mm-encode.el" (0 0 0 0))
;;; Generated autoloads from gnus/mm-encode.el
-(autoload 'mm-default-file-encoding "mm-encode" "\
-Return a default encoding for FILE.
+(define-obsolete-function-alias 'mm-default-file-encoding
#'mm-default-file-type "future")
+
+(autoload 'mm-default-file-type "mm-encode" "\
+Return a default content type for FILE.
\(fn FILE)" nil nil)
@@ -22746,7 +22745,7 @@ Generate NOV databases in all nnml directories.
;;;### (autoloads nil "nnoo" "gnus/nnoo.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnoo.el
-(register-definition-prefixes "nnoo" '("deffoo" "defvoo" "nnoo-"))
+(register-definition-prefixes "nnoo" '("deffoo" "defvoo" "nnoo-"
"noo--defalias"))
;;;***
@@ -24246,10 +24245,27 @@ with \"-q\").
Even if the value is nil, you can type \\[package-initialize] to
make installed packages available at any time, or you can
-call (package-initialize) in your init-file.")
+call (package-activate-all) in your init-file.")
(custom-autoload 'package-enable-at-startup "package" t)
+(defcustom package-user-dir (locate-user-emacs-file "elpa") "\
+Directory containing the user's Emacs Lisp packages.
+The directory name should be absolute.
+Apart from this directory, Emacs also looks for system-wide
+packages in `package-directory-list'." :type 'directory :initialize
#'custom-initialize-delay :risky t :version "24.1")
+
+(custom-autoload 'package-user-dir "package" t)
+
+(defcustom package-directory-list (let (result) (dolist (f load-path) (and
(stringp f) (equal (file-name-nondirectory f) "site-lisp") (push
(expand-file-name "elpa" f) result))) (nreverse result)) "\
+List of additional directories containing Emacs Lisp packages.
+Each directory name should be absolute.
+
+These directories contain packages intended for system-wide; in
+contrast, `package-user-dir' contains packages for personal use." :type
'(repeat directory) :initialize #'custom-initialize-delay :risky t :version
"24.1")
+
+(custom-autoload 'package-directory-list "package" t)
+
(defvar package--activated nil "\
Non-nil if `package-activate-all' has been run.")
@@ -24271,9 +24287,9 @@ that code in the early init-file.
\(fn &optional NO-ACTIVATE)" t nil)
-(autoload 'package-activate-all "package" "\
+(defun package-activate-all nil "\
Activate all installed packages.
-The variable `package-load-list' controls which packages to load." nil nil)
+The variable `package-load-list' controls which packages to load." (setq
package--activated t) (let* ((elc (concat package-quickstart-file "c")) (qs (if
(file-readable-p elc) elc (if (file-readable-p package-quickstart-file)
package-quickstart-file)))) (if qs (let ((load-source-file-function nil))
(unless (boundp 'package-activated-list) (setq package-activated-list nil))
(load qs nil 'nomessage)) (require 'package) (package--activate-all))))
(autoload 'package-import-keyring "package" "\
Import keys from FILE.
@@ -24370,6 +24386,11 @@ The return value is a string (or nil in case we can't
find it)." nil nil)
(function-put 'package-get-version 'pure 't)
+(defcustom package-quickstart-file (locate-user-emacs-file
"package-quickstart.el") "\
+Location of the file used to speed up activation of packages at startup."
:type 'file :initialize #'custom-initialize-delay :version "27.1")
+
+(custom-autoload 'package-quickstart-file "package" t)
+
(register-definition-prefixes "package" '("bad-signature" "define-package"
"describe-package-1" "package-"))
;;;***
@@ -24561,6 +24582,7 @@ PATTERN matches. PATTERN can take one of the forms:
If a SYMBOL is used twice in the same pattern
the second occurrence becomes an `eq'uality test.
(pred FUN) matches if FUN called on EXPVAL returns non-nil.
+ (pred (not FUN)) matches if FUN called on EXPVAL returns nil.
(app FUN PAT) matches if FUN called on EXPVAL matches PAT.
(guard BOOLEXP) matches if BOOLEXP evaluates to non-nil.
(let PAT EXPR) matches if EXPR matches PAT.
@@ -25851,7 +25873,7 @@ Open profile FILENAME.
;;;### (autoloads nil "project" "progmodes/project.el" (0 0 0 0))
;;; Generated autoloads from progmodes/project.el
-(push (purecopy '(project 0 5 3)) package--builtin-versions)
+(push (purecopy '(project 0 5 4)) package--builtin-versions)
(autoload 'project-current "project" "\
Return the project instance in DIRECTORY, defaulting to `default-directory'.
@@ -25956,9 +25978,13 @@ if one already exists." t nil)
(autoload 'project-async-shell-command "project" "\
Run `async-shell-command' in the current project's root directory." t nil)
+(function-put 'project-async-shell-command 'interactive-only
'async-shell-command)
+
(autoload 'project-shell-command "project" "\
Run `shell-command' in the current project's root directory." t nil)
+(function-put 'project-shell-command 'interactive-only 'shell-command)
+
(autoload 'project-search "project" "\
Search for REGEXP in all the files of the project.
Stops when a match is found.
@@ -25976,10 +26002,9 @@ loop using the command \\[fileloop-continue].
\(fn FROM TO)" t nil)
(autoload 'project-compile "project" "\
-Run `compile' in the project root.
-Arguments the same as in `compile'.
+Run `compile' in the project root." t nil)
-\(fn COMMAND &optional COMINT)" t nil)
+(function-put 'project-compile 'interactive-only 'compile)
(autoload 'project-switch-to-buffer "project" "\
Display buffer BUFFER-OR-NAME in the selected window.
@@ -26967,6 +26992,13 @@ When Recentf mode is enabled, a \"Open Recent\"
submenu is
displayed in the \"File\" menu, containing a list of files that
were operated on recently, in the most-recently-used order.
+By default, only operations like opening a file, writing a buffer
+to a file, and killing a buffer is counted as \"operating\" on
+the file. If instead you want to prioritize files that appear in
+buffers you switch to a lot, you can say something like the following:
+
+ (add-hook 'buffer-list-update-hook 'recentf-track-opened-file)
+
\(fn &optional ARG)" t nil)
(register-definition-prefixes "recentf" '("recentf-"))
@@ -27347,7 +27379,7 @@ Remember the contents of the current clipboard.
Most useful for remembering things from other applications." t nil)
(autoload 'remember-diary-extract-entries "remember" "\
-Extract diary entries from the region." nil nil)
+Extract diary entries from the region based on `remember-diary-regexp'." nil
nil)
(autoload 'remember-notes "remember" "\
Return the notes buffer, creating it if needed, and maybe switch to it.
@@ -27637,14 +27669,11 @@ Name of user's primary mail file.")
(custom-autoload 'rmail-file-name "rmail" t)
-(put 'rmail-spool-directory 'standard-value '((cond ((file-exists-p
"/var/mail") "/var/mail/") ((file-exists-p "/var/spool/mail")
"/var/spool/mail/") ((memq system-type '(hpux usg-unix-v)) "/usr/mail/") (t
"/usr/spool/mail/"))))
-
-(defvar rmail-spool-directory (purecopy (cond ((file-exists-p "/var/mail")
"/var/mail/") ((file-exists-p "/var/spool/mail") "/var/spool/mail/") ((memq
system-type '(hpux usg-unix-v)) "/usr/mail/") (t "/usr/spool/mail/"))) "\
+(defcustom rmail-spool-directory (purecopy (cond ((file-exists-p "/var/mail")
"/var/mail/") ((file-exists-p "/var/spool/mail") "/var/spool/mail/") ((memq
system-type '(hpux usg-unix-v)) "/usr/mail/") (t "/usr/spool/mail/"))) "\
Name of directory used by system mailer for delivering new mail.
-Its name should end with a slash.")
+Its name should end with a slash." :initialize #'custom-initialize-delay :type
'directory :group 'rmail)
(custom-autoload 'rmail-spool-directory "rmail" t)
-(custom-initialize-delay 'rmail-spool-directory nil)
(autoload 'rmail-movemail-variant-p "rmail" "\
Return t if the current movemail variant is any of VARIANTS.
@@ -29076,7 +29105,9 @@ variable `feedmail-deduce-envelope-from'.")
(defvar mail-self-blind nil "\
Non-nil means insert Bcc to self in messages to be sent.
This is done when the message is initialized,
-so you can remove or alter the Bcc field to override the default.")
+so you can remove or alter the Bcc field to override the default.
+If you are using `message-mode' to compose messages, customize the
+variable `message-default-mail-headers' instead.")
(custom-autoload 'mail-self-blind "sendmail" t)
@@ -29104,14 +29135,18 @@ Line used to separate headers from text in messages
being composed.")
(defvar mail-archive-file-name nil "\
Name of file to write all outgoing messages in, or nil for none.
This is normally an mbox file, but for backwards compatibility may also
-be a Babyl file.")
+be a Babyl file.
+If you are using `message-mode' to compose messages, customize the
+variable `message-default-mail-headers' instead.")
(custom-autoload 'mail-archive-file-name "sendmail" t)
(defvar mail-default-reply-to nil "\
Address to insert as default Reply-To field of outgoing messages.
If nil, it will be initialized from the REPLYTO environment variable
-when you first send mail.")
+when you first send mail.
+If you are using `message-mode' to compose messages, customize the
+variable `message-default-mail-headers' instead.")
(custom-autoload 'mail-default-reply-to "sendmail" t)
@@ -29198,7 +29233,9 @@ in `message-auto-save-directory'.")
(defvar mail-default-headers nil "\
A string containing header lines, to be inserted in outgoing messages.
It can contain newlines, and should end in one. It is inserted
-before you edit the message, so you can edit or delete the lines.")
+before you edit the message, so you can edit or delete the lines.
+If you are using `message-mode' to compose messages, customize the
+variable `message-default-mail-headers' instead.")
(custom-autoload 'mail-default-headers "sendmail" t)
@@ -29887,10 +29924,6 @@ DOM should be a parse tree as generated by
(autoload 'sieve-mode "sieve-mode" "\
Major mode for editing Sieve code.
-This is much like C mode except for the syntax of comments. Its keymap
-inherits from C mode's and it has the same variables for customizing
-indentation. It has its own abbrev table and its own syntax table.
-
Turning on Sieve mode runs `sieve-mode-hook'.
\(fn)" t nil)
@@ -31532,7 +31565,7 @@ Truncate STRING to LENGTH, replacing initial surplus
with \"...\".
\(fn STRING LENGTH)" nil nil)
-(register-definition-prefixes "subr-x" '("and-let*" "hash-table-" "if-let*"
"internal--" "replace-region-contents" "string-" "thread-" "when-let*"))
+(register-definition-prefixes "subr-x" '("and-let*" "hash-table-" "if-let*"
"internal--" "named-let" "replace-region-contents" "string-" "thread-"
"when-let*"))
;;;***
@@ -34174,7 +34207,7 @@ Add archive file name handler to
`file-name-handler-alist'." (when tramp-archive
;;;### (autoloads nil "trampver" "net/trampver.el" (0 0 0 0))
;;; Generated autoloads from net/trampver.el
-(push (purecopy '(tramp 2 5 0)) package--builtin-versions)
+(push (purecopy '(tramp 2 5 1 -1)) package--builtin-versions)
(register-definition-prefixes "trampver" '("tramp-"))
@@ -34542,9 +34575,9 @@ The variable `unrmail-mbox-format' controls which mbox
format to use.
(autoload 'unsafep "unsafep" "\
Return nil if evaluating FORM couldn't possibly do any harm.
Otherwise result is a reason why FORM is unsafe.
-UNSAFEP-VARS is a list of symbols with local bindings.
+VARS is a list of symbols with local bindings like `unsafep-vars'.
-\(fn FORM &optional UNSAFEP-VARS)" nil nil)
+\(fn FORM &optional VARS)" nil nil)
(register-definition-prefixes "unsafep" '("safe-functions" "unsafep-"))
@@ -38493,43 +38526,43 @@ Zone out, completely." t nil)
;;;;;; "leim/quail/Punct-b5.el" "leim/quail/Punct.el" "leim/quail/QJ-b5.el"
;;;;;; "leim/quail/QJ.el" "leim/quail/SW.el" "leim/quail/TONEPY.el"
;;;;;; "leim/quail/ZIRANMA.el" "leim/quail/ZOZY.el" "leim/quail/arabic.el"
-;;;;;; "leim/quail/compose.el" "leim/quail/croatian.el"
"leim/quail/cyril-jis.el"
-;;;;;; "leim/quail/cyrillic.el" "leim/quail/czech.el" "leim/quail/georgian.el"
-;;;;;; "leim/quail/greek.el" "leim/quail/hanja-jis.el" "leim/quail/hanja.el"
-;;;;;; "leim/quail/hanja3.el" "leim/quail/hebrew.el" "leim/quail/ipa-praat.el"
-;;;;;; "leim/quail/latin-alt.el" "leim/quail/latin-ltx.el"
"leim/quail/latin-post.el"
-;;;;;; "leim/quail/latin-pre.el" "leim/quail/persian.el"
"leim/quail/programmer-dvorak.el"
-;;;;;; "leim/quail/py-punct.el" "leim/quail/pypunct-b5.el"
"leim/quail/quick-b5.el"
-;;;;;; "leim/quail/quick-cns.el" "leim/quail/rfc1345.el" "leim/quail/sami.el"
-;;;;;; "leim/quail/sgml-input.el" "leim/quail/slovak.el"
"leim/quail/symbol-ksc.el"
-;;;;;; "leim/quail/tamil-dvorak.el" "leim/quail/tsang-b5.el"
"leim/quail/tsang-cns.el"
-;;;;;; "leim/quail/vntelex.el" "leim/quail/vnvni.el" "leim/quail/welsh.el"
-;;;;;; "loadup.el" "mail/blessmail.el" "mail/rmailedit.el" "mail/rmailkwd.el"
-;;;;;; "mail/rmailmm.el" "mail/rmailmsc.el" "mail/rmailsort.el"
-;;;;;; "mail/rmailsum.el" "mail/undigest.el" "menu-bar.el" "mh-e/mh-gnus.el"
-;;;;;; "mh-e/mh-loaddefs.el" "minibuffer.el" "mouse.el"
"net/tramp-loaddefs.el"
-;;;;;; "newcomment.el" "obarray.el" "org/ob-core.el" "org/ob-lob.el"
-;;;;;; "org/ob-matlab.el" "org/ob-tangle.el" "org/ob.el" "org/ol-bbdb.el"
-;;;;;; "org/ol-irc.el" "org/ol.el" "org/org-archive.el" "org/org-attach.el"
-;;;;;; "org/org-clock.el" "org/org-colview.el" "org/org-compat.el"
-;;;;;; "org/org-datetree.el" "org/org-duration.el" "org/org-element.el"
-;;;;;; "org/org-feed.el" "org/org-footnote.el" "org/org-goto.el"
-;;;;;; "org/org-id.el" "org/org-indent.el" "org/org-install.el"
-;;;;;; "org/org-keys.el" "org/org-lint.el" "org/org-list.el" "org/org-macs.el"
-;;;;;; "org/org-mobile.el" "org/org-num.el" "org/org-plot.el"
"org/org-refile.el"
-;;;;;; "org/org-table.el" "org/org-timer.el" "org/ox-ascii.el"
"org/ox-beamer.el"
-;;;;;; "org/ox-html.el" "org/ox-icalendar.el" "org/ox-latex.el"
-;;;;;; "org/ox-md.el" "org/ox-odt.el" "org/ox-org.el" "org/ox-publish.el"
-;;;;;; "org/ox-texinfo.el" "org/ox.el" "progmodes/elisp-mode.el"
-;;;;;; "progmodes/prog-mode.el" "ps-mule.el" "register.el" "replace.el"
-;;;;;; "rfn-eshadow.el" "select.el" "simple.el" "startup.el" "subdirs.el"
-;;;;;; "subr.el" "tab-bar.el" "textmodes/fill.el" "textmodes/page.el"
-;;;;;; "textmodes/paragraphs.el" "textmodes/reftex-auc.el"
"textmodes/reftex-cite.el"
-;;;;;; "textmodes/reftex-dcr.el" "textmodes/reftex-global.el"
"textmodes/reftex-index.el"
-;;;;;; "textmodes/reftex-parse.el" "textmodes/reftex-ref.el"
"textmodes/reftex-sel.el"
-;;;;;; "textmodes/reftex-toc.el" "textmodes/text-mode.el" "uniquify.el"
-;;;;;; "vc/ediff-hook.el" "vc/vc-hooks.el" "version.el" "widget.el"
-;;;;;; "window.el") (0 0 0 0))
+;;;;;; "leim/quail/cham.el" "leim/quail/compose.el" "leim/quail/croatian.el"
+;;;;;; "leim/quail/cyril-jis.el" "leim/quail/cyrillic.el"
"leim/quail/czech.el"
+;;;;;; "leim/quail/georgian.el" "leim/quail/greek.el"
"leim/quail/hanja-jis.el"
+;;;;;; "leim/quail/hanja.el" "leim/quail/hanja3.el" "leim/quail/hebrew.el"
+;;;;;; "leim/quail/ipa-praat.el" "leim/quail/latin-alt.el"
"leim/quail/latin-ltx.el"
+;;;;;; "leim/quail/latin-post.el" "leim/quail/latin-pre.el"
"leim/quail/persian.el"
+;;;;;; "leim/quail/programmer-dvorak.el" "leim/quail/py-punct.el"
+;;;;;; "leim/quail/pypunct-b5.el" "leim/quail/quick-b5.el"
"leim/quail/quick-cns.el"
+;;;;;; "leim/quail/rfc1345.el" "leim/quail/sami.el" "leim/quail/sgml-input.el"
+;;;;;; "leim/quail/slovak.el" "leim/quail/symbol-ksc.el"
"leim/quail/tamil-dvorak.el"
+;;;;;; "leim/quail/tsang-b5.el" "leim/quail/tsang-cns.el"
"leim/quail/vntelex.el"
+;;;;;; "leim/quail/vnvni.el" "leim/quail/welsh.el" "loadup.el"
"mail/blessmail.el"
+;;;;;; "mail/rmailedit.el" "mail/rmailkwd.el" "mail/rmailmm.el"
+;;;;;; "mail/rmailmsc.el" "mail/rmailsort.el" "mail/rmailsum.el"
+;;;;;; "mail/undigest.el" "menu-bar.el" "mh-e/mh-gnus.el"
"mh-e/mh-loaddefs.el"
+;;;;;; "minibuffer.el" "mouse.el" "net/tramp-loaddefs.el" "newcomment.el"
+;;;;;; "obarray.el" "org/ob-core.el" "org/ob-lob.el" "org/ob-matlab.el"
+;;;;;; "org/ob-tangle.el" "org/ob.el" "org/ol-bbdb.el" "org/ol-irc.el"
+;;;;;; "org/ol.el" "org/org-archive.el" "org/org-attach.el" "org/org-clock.el"
+;;;;;; "org/org-colview.el" "org/org-compat.el" "org/org-datetree.el"
+;;;;;; "org/org-duration.el" "org/org-element.el" "org/org-feed.el"
+;;;;;; "org/org-footnote.el" "org/org-goto.el" "org/org-id.el"
"org/org-indent.el"
+;;;;;; "org/org-install.el" "org/org-keys.el" "org/org-lint.el"
+;;;;;; "org/org-list.el" "org/org-macs.el" "org/org-mobile.el"
"org/org-num.el"
+;;;;;; "org/org-plot.el" "org/org-refile.el" "org/org-table.el"
+;;;;;; "org/org-timer.el" "org/ox-ascii.el" "org/ox-beamer.el"
"org/ox-html.el"
+;;;;;; "org/ox-icalendar.el" "org/ox-latex.el" "org/ox-md.el" "org/ox-odt.el"
+;;;;;; "org/ox-org.el" "org/ox-publish.el" "org/ox-texinfo.el" "org/ox.el"
+;;;;;; "progmodes/elisp-mode.el" "progmodes/prog-mode.el" "ps-mule.el"
+;;;;;; "register.el" "replace.el" "rfn-eshadow.el" "select.el" "simple.el"
+;;;;;; "startup.el" "subdirs.el" "subr.el" "tab-bar.el" "textmodes/fill.el"
+;;;;;; "textmodes/page.el" "textmodes/paragraphs.el" "textmodes/reftex-auc.el"
+;;;;;; "textmodes/reftex-cite.el" "textmodes/reftex-dcr.el"
"textmodes/reftex-global.el"
+;;;;;; "textmodes/reftex-index.el" "textmodes/reftex-parse.el"
"textmodes/reftex-ref.el"
+;;;;;; "textmodes/reftex-sel.el" "textmodes/reftex-toc.el"
"textmodes/text-mode.el"
+;;;;;; "uniquify.el" "vc/ediff-hook.el" "vc/vc-hooks.el" "version.el"
+;;;;;; "widget.el" "window.el") (0 0 0 0))
;;;***
diff --git a/lisp/leim/quail/hangul.el b/lisp/leim/quail/hangul.el
index 20762d3..ca1aae7 100644
--- a/lisp/leim/quail/hangul.el
+++ b/lisp/leim/quail/hangul.el
@@ -511,8 +511,7 @@ When a Korean input method is off, convert the following
hangul character."
;; Text shown by describe-input-method. Set to a proper text by
;; hangul-input-method-activate.
-(defvar hangul-input-method-help-text nil)
-(make-variable-buffer-local 'hangul-input-method-help-text)
+(defvar-local hangul-input-method-help-text nil)
;;;###autoload
(defun hangul-input-method-activate (input-method func help-text &rest args)
diff --git a/lisp/leim/quail/japanese.el b/lisp/leim/quail/japanese.el
index d7249d2..a4ea550 100644
--- a/lisp/leim/quail/japanese.el
+++ b/lisp/leim/quail/japanese.el
@@ -113,8 +113,7 @@
(?h . "japanese")
(?q . ("japanese-ascii"))))
-(defvar quail-japanese-package-saved nil)
-(make-variable-buffer-local 'quail-japanese-package-saved)
+(defvar-local quail-japanese-package-saved nil)
(put 'quail-japanese-package-saved 'permanent-local t)
(defun quail-japanese-switch-package (key idx)
diff --git a/lisp/linum.el b/lisp/linum.el
index 824f016..f9761d2 100644
--- a/lisp/linum.el
+++ b/lisp/linum.el
@@ -34,13 +34,11 @@
(defconst linum-version "0.9x")
(make-obsolete-variable 'linum-version nil "28.1")
-(defvar linum-overlays nil "Overlays used in this buffer.")
-(defvar linum-available nil "Overlays available for reuse.")
+(defvar-local linum-overlays nil "Overlays used in this buffer.")
+(defvar-local linum-available nil "Overlays available for reuse.")
(defvar linum-before-numbering-hook nil
"Functions run in each buffer before line numbering starts.")
-(mapc #'make-variable-buffer-local '(linum-overlays linum-available))
-
(defgroup linum nil
"Show line numbers in the left margin."
:group 'convenience)
diff --git a/lisp/loadup.el b/lisp/loadup.el
index aefe914..cafde7c 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")
@@ -505,6 +503,30 @@ 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))
+
+
(if dump-mode
(let ((output (cond ((equal dump-mode "pdump") "emacs.pdmp")
((equal dump-mode "dump") "emacs")
diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el
index fa9e89e..4d88da5 100644
--- a/lisp/mail/emacsbug.el
+++ b/lisp/mail/emacsbug.el
@@ -58,13 +58,11 @@
(defvar report-emacs-bug-orig-text nil
"The automatically-created initial text of the bug report.")
-(defvar report-emacs-bug-send-command nil
+(defvar-local report-emacs-bug-send-command nil
"Name of the command to send the bug report, as a string.")
-(make-variable-buffer-local 'report-emacs-bug-send-command)
-(defvar report-emacs-bug-send-hook nil
+(defvar-local report-emacs-bug-send-hook nil
"Hook run before sending the bug report.")
-(make-variable-buffer-local 'report-emacs-bug-send-hook)
(declare-function x-server-vendor "xfns.c" (&optional terminal))
(declare-function x-server-version "xfns.c" (&optional terminal))
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/mail/reporter.el b/lisp/mail/reporter.el
index 2e583a4..4b70582 100644
--- a/lisp/mail/reporter.el
+++ b/lisp/mail/reporter.el
@@ -100,9 +100,8 @@ This is necessary to properly support the printing of
buffer-local
variables. Current buffer will always be the mail buffer being
composed.")
-(defvar reporter-initial-text nil
+(defvar-local reporter-initial-text nil
"The automatically created initial text of a bug report.")
-(make-variable-buffer-local 'reporter-initial-text)
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index 9f95b62..8ccf1bf 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -620,14 +620,12 @@ Element N specifies the summary line for message N+1.")
;; Rmail buffer swapping variables.
-(defvar rmail-buffer-swapped nil
+(defvar-local rmail-buffer-swapped nil
"If non-nil, `rmail-buffer' is swapped with `rmail-view-buffer'.")
-(make-variable-buffer-local 'rmail-buffer-swapped)
(put 'rmail-buffer-swapped 'permanent-local t)
-(defvar rmail-view-buffer nil
+(defvar-local rmail-view-buffer nil
"Buffer which holds RMAIL message for MIME displaying.")
-(make-variable-buffer-local 'rmail-view-buffer)
(put 'rmail-view-buffer 'permanent-local t)
;; `Sticky' default variables.
diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el
index 7f99ecd..f53e6e7 100644
--- a/lisp/mail/rmailsum.el
+++ b/lisp/mail/rmailsum.el
@@ -930,10 +930,11 @@ a negative argument means to delete and move backward."
(unless (numberp count) (setq count 1))
(let (del-msg
(backward (< count 0)))
- (while (and (/= count 0)
- ;; Don't waste time if we are at the beginning
- ;; and trying to go backward.
- (not (and backward (bobp))))
+ (while (/= count 0)
+ ;; Don't waste time counting down without doing anything if we
+ ;; are at the beginning and trying to go backward.
+ (if (and backward (bobp))
+ (setq count -1))
(rmail-summary-goto-msg)
(with-current-buffer rmail-buffer
(setq del-msg rmail-current-message)
diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el
index d2601c3..cd07166 100644
--- a/lisp/mail/sendmail.el
+++ b/lisp/mail/sendmail.el
@@ -1800,14 +1800,14 @@ If the current line has `mail-yank-prefix', insert it
on the new line."
(declare-function mml-attach-file "mml"
(file &optional type description disposition))
-(declare-function mm-default-file-encoding "mm-encode" (file))
(defun mail-add-attachment (file)
"Add FILE as a MIME attachment to the end of the mail message being
composed."
(interactive "fAttach file: ")
(mml-attach-file file
- (or (mm-default-file-encoding file)
- "application/octet-stream") nil)
+ (or (mm-default-file-type file)
+ "application/octet-stream")
+ nil)
(setq mail-encode-mml t))
diff --git a/lisp/mail/supercite.el b/lisp/mail/supercite.el
index 5766c79..99ac41d 100644
--- a/lisp/mail/supercite.el
+++ b/lisp/mail/supercite.el
@@ -509,9 +509,9 @@ string."
;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
;; end user configuration variables
-(defvar sc-mail-info nil
+(defvar-local sc-mail-info nil
"Alist of mail header information gleaned from reply buffer.")
-(defvar sc-attributions nil
+(defvar-local sc-attributions nil
"Alist of attributions for use when citing.")
(defvar sc-tmp-nested-regexp nil
@@ -521,9 +521,6 @@ string."
(defvar sc-tmp-dumb-regexp nil
"Temp regexp describing non-nested citation cited with a nesting citer.")
-(make-variable-buffer-local 'sc-mail-info)
-(make-variable-buffer-local 'sc-attributions)
-
;; ======================================================================
;; supercite keymaps
diff --git a/lisp/man.el b/lisp/man.el
index ca50b3a..1fded38 100644
--- a/lisp/man.el
+++ b/lisp/man.el
@@ -97,8 +97,6 @@
:group 'external
:group 'help)
-(defvar Man-notify)
-
(defcustom Man-filter-list nil
"Manpage cleaning filter command phrases.
This variable contains a list of the following form:
@@ -149,8 +147,7 @@ the manpage buffer."
(ansi-color-make-color-map))
"The value used here for `ansi-color-map'.")
-;; Use the value of the obsolete user option Man-notify, if set.
-(defcustom Man-notify-method (if (boundp 'Man-notify) Man-notify 'friendly)
+(defcustom Man-notify-method 'friendly
"Selects the behavior when manpage is ready.
This variable may have one of the following values, where (sf) means
that the frames are switched, so the manpage is displayed in the frame
@@ -399,22 +396,15 @@ Otherwise, the value is whatever the function
;; other variables and keymap initializations
-(defvar Man-original-frame)
-(make-variable-buffer-local 'Man-original-frame)
-(defvar Man-arguments)
-(make-variable-buffer-local 'Man-arguments)
+(defvar-local Man-original-frame nil)
+(defvar-local Man-arguments nil)
(put 'Man-arguments 'permanent-local t)
-(defvar Man--sections nil)
-(make-variable-buffer-local 'Man--sections)
-(defvar Man--refpages nil)
-(make-variable-buffer-local 'Man--refpages)
-(defvar Man-page-list nil)
-(make-variable-buffer-local 'Man-page-list)
-(defvar Man-current-page 0)
-(make-variable-buffer-local 'Man-current-page)
-(defvar Man-page-mode-string "1 of 1")
-(make-variable-buffer-local 'Man-page-mode-string)
+(defvar-local Man--sections nil)
+(defvar-local Man--refpages nil)
+(defvar-local Man-page-list nil)
+(defvar-local Man-current-page 0)
+(defvar-local Man-page-mode-string "1 of 1")
(defconst Man-sysv-sed-script "\
/\b/ { s/_\b//g
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index 526491f..133df65 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"))
@@ -2240,9 +2240,8 @@ Buffers menu is regenerated."
:type 'boolean
:group 'menu)
-(defvar list-buffers-directory nil
+(defvar-local list-buffers-directory nil
"String to display in buffer listings for buffers not visiting a file.")
-(make-variable-buffer-local 'list-buffers-directory)
(defun menu-bar-select-buffer ()
(interactive)
diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el
index 9185c2a..2eb7fba 100644
--- a/lisp/mh-e/mh-e.el
+++ b/lisp/mh-e/mh-e.el
@@ -3412,6 +3412,7 @@ sequence."
;;; Faces (:group 'mh-faces + group where faces described)
(if (boundp 'facemenu-unlisted-faces)
+ ;; This variable was removed in Emacs 22.1.
(add-to-list 'facemenu-unlisted-faces "^mh-"))
;; To add a new face:
diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el
index 7bdf743f..70df9e6 100644
--- a/lisp/mh-e/mh-mime.el
+++ b/lisp/mh-e/mh-mime.el
@@ -1725,14 +1725,14 @@ a type (see `mailcap-mime-types').
Optional argument DEFAULT is returned if a type isn't entered."
(mailcap-parse-mimetypes)
(let* ((default (or default
- (mm-default-file-encoding filename)
+ (mm-default-file-type filename)
"application/octet-stream"))
(probed-type (mh-file-mime-type filename))
(type (or (and (not (equal probed-type "application/octet-stream"))
probed-type)
(completing-read
(format "Content type (default %s): " default)
- (mapcar 'list (mailcap-mime-types))))))
+ (mapcar #'list (mailcap-mime-types))))))
(if (not (equal type ""))
type
default)))
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 315f2d3..a899a94 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -122,7 +122,8 @@ This metadata is an alist. Currently understood keys are:
returns a string to append to STRING.
- `affixation-function': function to prepend/append a prefix/suffix to
entries. Takes one argument (COMPLETIONS) and should return a list
- of completions with a list of three elements: completion, its prefix
+ of completions with a list of either two elements: completion
+ and suffix, or three elements: completion, its prefix
and suffix. This function takes priority over `annotation-function'
when both are provided, so only this function is used.
- `display-sort-function': function to sort entries in *Completions*.
@@ -1785,22 +1786,17 @@ It also eliminates runs of equal strings."
(when prefix
(let ((beg (point))
(end (progn (insert prefix) (point))))
- (put-text-property beg end 'mouse-face nil)
- ;; When both prefix and suffix are added
- ;; by the caller via affixation-function,
- ;; then allow the caller to decide
- ;; what faces to put on prefix and suffix.
- (unless prefix
- (font-lock-prepend-text-property
- beg end 'face 'completions-annotations))))
+ (put-text-property beg end 'mouse-face nil)))
(put-text-property (point) (progn (insert (car str)) (point))
'mouse-face 'highlight)
(let ((beg (point))
(end (progn (insert suffix) (point))))
(put-text-property beg end 'mouse-face nil)
;; Put the predefined face only when suffix
- ;; is added via annotation-function.
- (unless prefix
+ ;; is added via annotation-function without prefix,
+ ;; and when the caller doesn't use own face.
+ (unless (or prefix (text-property-not-all
+ 0 (length suffix) 'face nil suffix))
(font-lock-prepend-text-property
beg end 'face 'completions-annotations)))))
(cond
@@ -1927,6 +1923,7 @@ These include:
`:affixation-function': Function to prepend/append a prefix/suffix to
completions. The function must accept one argument, a list of
completions, and return a list where each element is a list of
+ either two elements: a completion, and a suffix, or
three elements: a completion, a prefix and a suffix.
This function takes priority over `:annotation-function'
when both are provided, so only this function is used.
@@ -2119,13 +2116,15 @@ variables.")
(defun exit-minibuffer ()
"Terminate this minibuffer argument."
(interactive)
+ (when (or
+ (innermost-minibuffer-p)
+ (not (minibufferp)))
;; 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"))
diff --git a/lisp/mouse-copy.el b/lisp/mouse-copy.el
index e48722e..8155c9d 100644
--- a/lisp/mouse-copy.el
+++ b/lisp/mouse-copy.el
@@ -55,9 +55,6 @@
;; <twurgler@goodyear.com> is similar to mouse-drag-throw, but
;; doesn't pass clicks through.
;;
-;; These functions have been tested in emacs version 19.30,
-;; and this package has run in the past on 19.25-19.29.
-;;
;; Originally mouse-copy was part of a larger package.
;; As of 11 July 96 the scrolling functions were split out
;; in preparation for incorporation into (the future) emacs-19.32.
diff --git a/lisp/mouse-drag.el b/lisp/mouse-drag.el
index 907ef06..b2960a4 100644
--- a/lisp/mouse-drag.el
+++ b/lisp/mouse-drag.el
@@ -70,9 +70,6 @@
;; <twurgler@goodyear.com> is similar to mouse-drag-throw, but
;; doesn't pass clicks through.
;;
-;; These functions have been tested in emacs version 19.30,
-;; and this package has run in the past on 19.25-19.29.
-;;
;; Originally mouse-drag was part of a larger package.
;; As of 11 July 96 the scrolling functions were split out
;; in preparation for incorporation into (the future) emacs-19.32.
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index 7b72a71..58f01d5 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -481,8 +481,7 @@ Used by the `browse-url-of-file' command."
"Hook run after `browse-url-of-file' has asked a browser to load a file."
:type 'hook)
-(defvar browse-url-temp-file-name nil)
-(make-variable-buffer-local 'browse-url-temp-file-name)
+(defvar-local browse-url-temp-file-name nil)
(defcustom browse-url-xterm-program "xterm"
"The name of the terminal emulator used by `browse-url-text-xterm'.
diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el
index 195ddc6..a9de35c 100644
--- a/lisp/net/dbus.el
+++ b/lisp/net/dbus.el
@@ -2171,6 +2171,23 @@ has been handled by this function."
(when eobp
(goto-char (point-max))))))
+;;;###autoload
+(defun dbus-monitor (&optional bus)
+ "Invoke `dbus-register-monitor' interactively, and switch to the buffer.
+BUS is either a Lisp keyword, `:system' or `:session', or a
+string denoting the bus address. The value nil defaults to `:session'."
+ (interactive
+ (list
+ (let ((input
+ (completing-read
+ (format-prompt "Enter bus symbol or name" :session)
+ '(:system :session) nil nil nil nil :session)))
+ (if (and (stringp input)
+ (string-match-p "^\\(:session\\|:system\\)$" input))
+ (intern input) input))))
+ (dbus-register-monitor (or bus :session))
+ (switch-to-buffer (get-buffer-create "*D-Bus Monitor*")))
+
(defun dbus-handle-bus-disconnect ()
"React to a bus disconnection.
BUS is the bus that disconnected. This routine unregisters all
diff --git a/lisp/net/dictionary-connection.el
b/lisp/net/dictionary-connection.el
index d88c0b4..8ad4fe4 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 are exchanged. There is
;; special support for handling CR LF (and the usual CR LF . CR LF
;; terminater).
;;; 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)
@@ -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..6f08605 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")
@@ -144,8 +145,7 @@ 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")
@@ -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 dictonary 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))
@@ -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
@@ -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
@@ -1234,7 +1257,7 @@ allows editing it."
(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/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..b95cd0f 100644
--- a/lisp/net/mailcap.el
+++ b/lisp/net/mailcap.el
@@ -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-backend.el b/lisp/net/newst-backend.el
index 3b120be..ea96012 100644
--- a/lisp/net/newst-backend.el
+++ b/lisp/net/newst-backend.el
@@ -34,7 +34,6 @@
;; ======================================================================
;;; Code:
-(require 'derived)
(require 'xml)
(require 'url-parse)
(require 'iso8601)
diff --git a/lisp/net/newst-plainview.el b/lisp/net/newst-plainview.el
index 44d2fd6..21d47b8 100644
--- a/lisp/net/newst-plainview.el
+++ b/lisp/net/newst-plainview.el
@@ -34,7 +34,6 @@
(require 'newst-ticker)
(require 'newst-reader)
-(require 'derived)
(require 'xml)
;; Silence warnings
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index 22348a1..58cc8b1 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -178,13 +178,11 @@ If nil, no maximum is applied."
:type '(choice (const :tag "No maximum" nil)
(integer :tag "Number of characters")))
-(defvar rcirc-ignore-buffer-activity-flag nil
+(defvar-local rcirc-ignore-buffer-activity-flag nil
"If non-nil, ignore activity in this buffer.")
-(make-variable-buffer-local 'rcirc-ignore-buffer-activity-flag)
-(defvar rcirc-low-priority-flag nil
+(defvar-local rcirc-low-priority-flag nil
"If non-nil, activity in this buffer is considered low priority.")
-(make-variable-buffer-local 'rcirc-low-priority-flag)
(defcustom rcirc-omit-responses
'("JOIN" "PART" "QUIT" "NICK")
@@ -1328,8 +1326,7 @@ Create the buffer if it doesn't exist."
(rcirc-send-string process
(concat command " :" args)))))))
-(defvar rcirc-parent-buffer nil)
-(make-variable-buffer-local 'rcirc-parent-buffer)
+(defvar-local rcirc-parent-buffer nil)
(put 'rcirc-parent-buffer 'permanent-local t)
(defvar rcirc-window-configuration nil)
(defun rcirc-edit-multiline ()
@@ -1501,10 +1498,8 @@ is found by looking up RESPONSE in
`rcirc-response-formats'."
((or (rcirc-get-buffer process target)
(rcirc-any-buffer process))))))
-(defvar rcirc-activity-types nil)
-(make-variable-buffer-local 'rcirc-activity-types)
-(defvar rcirc-last-sender nil)
-(make-variable-buffer-local 'rcirc-last-sender)
+(defvar-local rcirc-activity-types nil)
+(defvar-local rcirc-last-sender nil)
(defcustom rcirc-omit-threshold 100
"Lines since last activity from a nick before `rcirc-omit-responses' are
omitted."
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/soap-inspect.el b/lisp/net/soap-inspect.el
index 604e35c..9d4e440 100644
--- a/lisp/net/soap-inspect.el
+++ b/lisp/net/soap-inspect.el
@@ -206,17 +206,13 @@ This is a specialization of `soap-sample-value' for
;;; soap-inspect
-(defvar soap-inspect-previous-items nil
+(defvar-local soap-inspect-previous-items nil
"A stack of previously inspected items in the *soap-inspect* buffer.
Used to implement the BACK button.")
-(defvar soap-inspect-current-item nil
+(defvar-local soap-inspect-current-item nil
"The current item being inspected in the *soap-inspect* buffer.")
-(progn
- (make-variable-buffer-local 'soap-inspect-previous-items)
- (make-variable-buffer-local 'soap-inspect-current-item))
-
(defun soap-inspect (element)
"Inspect a SOAP ELEMENT in the *soap-inspect* buffer.
The buffer is populated with information about ELEMENT with links
diff --git a/lisp/net/telnet.el b/lisp/net/telnet.el
index 67f8444..44f535f 100644
--- a/lisp/net/telnet.el
+++ b/lisp/net/telnet.el
@@ -72,15 +72,12 @@ LOGIN-NAME, which is optional, says what to log in as on
that machine.")
(defvar telnet-prompt-pattern "^[^#$%>\n]*[#$%>] *")
(defvar telnet-replace-c-g nil)
-(make-variable-buffer-local
- (defvar telnet-remote-echoes t
- "True if the telnet process will echo input."))
-(make-variable-buffer-local
- (defvar telnet-interrupt-string "\C-c" "String sent by C-c."))
+(defvar-local telnet-remote-echoes t
+ "True if the telnet process will echo input.")
+(defvar-local telnet-interrupt-string "\C-c" "String sent by C-c.")
-(defvar telnet-count 0
+(defvar-local telnet-count 0
"Number of output strings from telnet process while looking for password.")
-(make-variable-buffer-local 'telnet-count)
(defvar telnet-program "telnet"
"Program to run to open a telnet connection.")
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 73dffe1..6ec4d1f 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -197,13 +197,13 @@ It is used for TCP/IP devices."
tramp-adb-method)))
;;;###tramp-autoload
-(defun tramp-adb-file-name-handler (operation &rest arguments)
+(defun tramp-adb-file-name-handler (operation &rest args)
"Invoke the ADB handler for OPERATION.
First arg specifies the OPERATION, second arg is a list of
-ARGUMENTS to pass to the OPERATION."
+arguments to pass to the OPERATION."
(if-let ((fn (assoc operation tramp-adb-file-name-handler-alist)))
- (save-match-data (apply (cdr fn) arguments))
- (tramp-run-real-handler operation arguments)))
+ (save-match-data (apply (cdr fn) args))
+ (tramp-run-real-handler operation args)))
;;;###tramp-autoload
(tramp--with-startup
@@ -305,9 +305,7 @@ ARGUMENTS to pass to the OPERATION."
(directory &optional full match nosort id-format count)
"Like `directory-files-and-attributes' for Tramp files."
(unless (file-exists-p directory)
- (tramp-error
- (tramp-dissect-file-name directory) tramp-file-missing
- "No such file or directory" directory))
+ (tramp-compat-file-missing (tramp-dissect-file-name directory) directory))
(when (file-directory-p directory)
(with-parsed-tramp-file-name (expand-file-name directory) nil
(copy-tree
@@ -435,7 +433,7 @@ Emacs dired can't find files."
(setq dir (expand-file-name dir))
(with-parsed-tramp-file-name dir nil
(when (and (null parents) (file-exists-p dir))
- (tramp-error v 'file-already-exists "Directory already exists %s" dir))
+ (tramp-error v 'file-already-exists dir))
(when parents
(let ((par (expand-file-name ".." dir)))
(unless (file-directory-p par)
@@ -498,9 +496,7 @@ Emacs dired can't find files."
"Like `file-local-copy' for Tramp files."
(with-parsed-tramp-file-name filename nil
(unless (file-exists-p (file-truename filename))
- (tramp-error
- v tramp-file-missing
- "Cannot make local copy of non-existing file `%s'" filename))
+ (tramp-compat-file-missing v filename))
(let ((tmpfile (tramp-compat-make-temp-file filename)))
(with-tramp-progress-reporter
v 3 (format "Fetching %s to tmp file %s" filename tmpfile)
@@ -642,9 +638,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(jka-compr-inhibit t))
(with-parsed-tramp-file-name (if t1 filename newname) nil
(unless (file-exists-p filename)
- (tramp-error
- v tramp-file-missing
- "Copying file" "No such file or directory" filename))
+ (tramp-compat-file-missing v filename))
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
@@ -726,9 +720,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(jka-compr-inhibit t))
(with-parsed-tramp-file-name (if t1 filename newname) nil
(unless (file-exists-p filename)
- (tramp-error
- v tramp-file-missing
- "Renaming file" "No such file or directory" filename))
+ (tramp-compat-file-missing v filename))
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index 87e5378..27461e6 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -41,6 +41,7 @@
(require 'shell)
(require 'subr-x)
+(declare-function tramp-error "tramp")
;; `temporary-file-directory' as function is introduced with Emacs 26.1.
(declare-function tramp-handle-temporary-file-directory "tramp")
(declare-function tramp-tramp-file-p "tramp")
@@ -178,6 +179,12 @@ This is a string of ten letters or dashes as in ls -l."
(if (get 'file-missing 'error-conditions) 'file-missing 'file-error)
"The error symbol for the `file-missing' error.")
+(defsubst tramp-compat-file-missing (vec file)
+ "Emit the `file-missing' error."
+ (if (get 'file-missing 'error-conditions)
+ (tramp-error vec tramp-file-missing file)
+ (tramp-error vec tramp-file-missing "No such file or directory: %s" file)))
+
;; `file-local-name', `file-name-quoted-p', `file-name-quote' and
;; `file-name-unquote' are introduced in Emacs 26.1.
(defalias 'tramp-compat-file-local-name
diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el
index dfe5462..f8de708 100644
--- a/lisp/net/tramp-crypt.el
+++ b/lisp/net/tramp-crypt.el
@@ -249,7 +249,7 @@ arguments to pass to the OPERATION."
;;;###tramp-autoload
(defun tramp-crypt-file-name-handler (operation &rest args)
"Invoke the crypted remote file related OPERATION.
-First arg specifies the OPERATION, second arg ARGS is a list of
+First arg specifies the OPERATION, second arg is a list of
arguments to pass to the OPERATION."
(if-let ((filename
(apply #'tramp-crypt-file-name-for-operation operation args))
@@ -568,9 +568,7 @@ absolute file names."
(with-parsed-tramp-file-name (if t1 filename newname) nil
(unless (file-exists-p filename)
- (tramp-error
- v tramp-file-missing
- "%s file" msg-operation "No such file or directory" filename))
+ (tramp-compat-file-missing v filename))
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
@@ -672,9 +670,7 @@ absolute file names."
(directory &optional full match nosort count)
"Like `directory-files' for Tramp files."
(unless (file-exists-p directory)
- (tramp-error
- (tramp-dissect-file-name directory) tramp-file-missing
- "No such file or directory" directory))
+ (tramp-compat-file-missing (tramp-dissect-file-name directory) directory))
(when (file-directory-p directory)
(setq directory (file-name-as-directory (expand-file-name directory)))
(let* (tramp-crypt-enabled
@@ -781,7 +777,7 @@ WILDCARD is not supported."
"Like `make-directory' for Tramp files."
(with-parsed-tramp-file-name (expand-file-name dir) nil
(when (and (null parents) (file-exists-p dir))
- (tramp-error v 'file-already-exists "Directory already exists %s" dir))
+ (tramp-error v 'file-already-exists dir))
(let (tramp-crypt-enabled)
(make-directory (tramp-crypt-encrypt-file-name dir) parents))
;; When PARENTS is non-nil, DIR could be a chain of non-existent
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index f882636..e946d73 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -841,8 +841,8 @@ Operations not mentioned here will be handled by the
default Emacs primitives.")
;;;###tramp-autoload
(defun tramp-gvfs-file-name-handler (operation &rest args)
"Invoke the GVFS related OPERATION and ARGS.
-First arg specifies the OPERATION, second arg is a list of arguments to
-pass to the OPERATION."
+First arg specifies the OPERATION, second arg is a list of
+arguments to pass to the OPERATION."
(unless tramp-gvfs-enabled
(tramp-user-error nil "Package `tramp-gvfs' not supported"))
(if-let ((fn (assoc operation tramp-gvfs-file-name-handler-alist)))
@@ -945,7 +945,7 @@ is no information where to trace the message.")
"Called when a D-Bus error message arrives, see
`dbus-event-error-functions'."
(when tramp-gvfs-dbus-event-vector
(tramp-message tramp-gvfs-dbus-event-vector 6 "%S" event)
- (tramp-error tramp-gvfs-dbus-event-vector 'file-error "%s" (cadr err))))
+ (tramp-error tramp-gvfs-dbus-event-vector 'file-error (cadr err))))
(add-hook 'dbus-event-error-functions #'tramp-gvfs-dbus-event-error)
(add-hook 'tramp-gvfs-unload-hook
@@ -985,83 +985,97 @@ file names."
(let ((t1 (tramp-tramp-file-p filename))
(t2 (tramp-tramp-file-p newname))
(equal-remote (tramp-equal-remote filename newname))
+ (volatile
+ (and (eq op 'rename) (tramp-gvfs-file-name-p filename)
+ (equal
+ (cdr
+ (assoc
+ "standard::is-volatile"
+ (tramp-gvfs-get-file-attributes filename)))
+ "TRUE")))
;; "gvfs-rename" is not trustworthy.
(gvfs-operation (if (eq op 'copy) "gvfs-copy" "gvfs-move"))
(msg-operation (if (eq op 'copy) "Copying" "Renaming")))
(with-parsed-tramp-file-name (if t1 filename newname) nil
(unless (file-exists-p filename)
- (tramp-error
- v tramp-file-missing
- "%s file" msg-operation "No such file or directory" filename))
+ (tramp-compat-file-missing v filename))
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
(not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" newname))
- (if (or (and equal-remote
- (tramp-get-connection-property v "direct-copy-failed" nil))
- (and t1 (not (tramp-gvfs-file-name-p filename)))
- (and t2 (not (tramp-gvfs-file-name-p newname))))
-
- ;; We cannot copy or rename directly.
- (let ((tmpfile (tramp-compat-make-temp-file filename)))
- (if (eq op 'copy)
- (copy-file
- filename tmpfile t keep-date preserve-uid-gid
- preserve-extended-attributes)
- (rename-file filename tmpfile t))
- (rename-file tmpfile newname ok-if-already-exists))
-
- ;; Direct action.
- (with-tramp-progress-reporter
- v 0 (format "%s %s to %s" msg-operation filename newname)
- (unless
- (and (apply
- #'tramp-gvfs-send-command v gvfs-operation
- (append
- (and (eq op 'copy) (or keep-date preserve-uid-gid)
- '("--preserve"))
- (list
- (tramp-gvfs-url-file-name filename)
- (tramp-gvfs-url-file-name newname))))
- ;; Some backends do not return a proper error
- ;; code in case of direct copy/move. Apply sanity checks.
- (or (not equal-remote)
- (tramp-gvfs-send-command
- v "gvfs-info" (tramp-gvfs-url-file-name newname))
- (eq op 'copy)
- (not (tramp-gvfs-send-command
- v "gvfs-info"
- (tramp-gvfs-url-file-name filename)))))
-
- (if (or (not equal-remote)
- (and equal-remote
- (tramp-get-connection-property
- v "direct-copy-failed" nil)))
- ;; Propagate the error.
- (with-current-buffer (tramp-get-connection-buffer v)
- (goto-char (point-min))
- (tramp-error-with-buffer
- nil v 'file-error
- "%s failed, see buffer `%s' for details."
- msg-operation (buffer-name)))
-
- ;; Some WebDAV server, like the one from QNAP, do not
- ;; support direct copy/move. Try a fallback.
- (tramp-set-connection-property v "direct-copy-failed" t)
- (tramp-gvfs-do-copy-or-rename-file
- op filename newname ok-if-already-exists keep-date
- preserve-uid-gid preserve-extended-attributes))))
-
- (when (and t1 (eq op 'rename))
- (with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v localname)))
-
- (when t2
- (with-parsed-tramp-file-name newname nil
- (tramp-flush-file-properties v localname))))))))
+ (cond
+ ;; We cannot rename volatile files, as used by Google-drive.
+ ((and (not equal-remote) volatile)
+ (prog1 (copy-file
+ filename newname ok-if-already-exists keep-date
+ preserve-uid-gid preserve-extended-attributes)
+ (delete-file filename)))
+
+ ;; We cannot copy or rename directly.
+ ((or (and equal-remote
+ (tramp-get-connection-property v "direct-copy-failed" nil))
+ (and t1 (not (tramp-gvfs-file-name-p filename)))
+ (and t2 (not (tramp-gvfs-file-name-p newname))))
+ (let ((tmpfile (tramp-compat-make-temp-file filename)))
+ (if (eq op 'copy)
+ (copy-file
+ filename tmpfile t keep-date preserve-uid-gid
+ preserve-extended-attributes)
+ (rename-file filename tmpfile t))
+ (rename-file tmpfile newname ok-if-already-exists)))
+
+ ;; Direct action.
+ (t (with-tramp-progress-reporter
+ v 0 (format "%s %s to %s" msg-operation filename newname)
+ (unless
+ (and (apply
+ #'tramp-gvfs-send-command v gvfs-operation
+ (append
+ (and (eq op 'copy) (or keep-date preserve-uid-gid)
+ '("--preserve"))
+ (list
+ (tramp-gvfs-url-file-name filename)
+ (tramp-gvfs-url-file-name newname))))
+ ;; Some backends do not return a proper error
+ ;; code in case of direct copy/move. Apply
+ ;; sanity checks.
+ (or (not equal-remote)
+ (tramp-gvfs-send-command
+ v "gvfs-info" (tramp-gvfs-url-file-name newname))
+ (eq op 'copy)
+ (not (tramp-gvfs-send-command
+ v "gvfs-info"
+ (tramp-gvfs-url-file-name filename)))))
+
+ (if (or (not equal-remote)
+ (and equal-remote
+ (tramp-get-connection-property
+ v "direct-copy-failed" nil)))
+ ;; Propagate the error.
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (goto-char (point-min))
+ (tramp-error-with-buffer
+ nil v 'file-error
+ "%s failed, see buffer `%s' for details."
+ msg-operation (buffer-name)))
+
+ ;; Some WebDAV server, like the one from QNAP, do
+ ;; not support direct copy/move. Try a fallback.
+ (tramp-set-connection-property v "direct-copy-failed" t)
+ (tramp-gvfs-do-copy-or-rename-file
+ op filename newname ok-if-already-exists keep-date
+ preserve-uid-gid preserve-extended-attributes))))
+
+ (when (and t1 (eq op 'rename))
+ (with-parsed-tramp-file-name filename nil
+ (tramp-flush-file-properties v localname)))
+
+ (when t2
+ (with-parsed-tramp-file-name newname nil
+ (tramp-flush-file-properties v localname)))))))))
(defun tramp-gvfs-handle-copy-file
(filename newname &optional ok-if-already-exists keep-date
@@ -1545,7 +1559,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(setq dir (directory-file-name (expand-file-name dir)))
(with-parsed-tramp-file-name dir nil
(when (and (null parents) (file-exists-p dir))
- (tramp-error v 'file-already-exists "Directory already exists %s" dir))
+ (tramp-error v 'file-already-exists dir))
(tramp-flush-directory-properties v localname)
(save-match-data
(let ((ldir (file-name-directory dir)))
@@ -1575,20 +1589,31 @@ If FILE-SYSTEM is non-nil, return file system
attributes."
(tramp-run-real-handler
#'rename-file (list filename newname ok-if-already-exists))))
+(defun tramp-gvfs-set-attribute (vec &rest args)
+ "Call \"gio set ...\" if possible."
+ (let ((key (concat "gvfs-set-attribute-" (nth 3 args))))
+ (when (tramp-get-connection-property vec key t)
+ (or (apply #'tramp-gvfs-send-command vec "gvfs-set-attribute" args)
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (goto-char (point-min))
+ (when (looking-at-p "gio: Operation not supported")
+ (tramp-set-connection-property vec key nil)))
+ nil))))
+
(defun tramp-gvfs-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-properties v localname)
- (tramp-gvfs-send-command
- v "gvfs-set-attribute" (if (eq flag 'nofollow) "-nt" "-t") "uint32"
+ (tramp-gvfs-set-attribute
+ v (if (eq flag 'nofollow) "-nt" "-t") "uint32"
(tramp-gvfs-url-file-name filename) "unix::mode" (number-to-string
mode))))
(defun tramp-gvfs-handle-set-file-times (filename &optional time flag)
"Like `set-file-times' for Tramp files."
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-properties v localname)
- (tramp-gvfs-send-command
- v "gvfs-set-attribute" (if (eq flag 'nofollow) "-nt" "-t") "uint64"
+ (tramp-gvfs-set-attribute
+ v (if (eq flag 'nofollow) "-nt" "-t") "uint64"
(tramp-gvfs-url-file-name filename) "time::modified"
(format-time-string
"%s" (if (or (null time)
@@ -1622,12 +1647,12 @@ ID-FORMAT valid values are `string' and `integer'."
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-properties v localname)
(when (natnump uid)
- (tramp-gvfs-send-command
- v "gvfs-set-attribute" "-t" "uint32"
+ (tramp-gvfs-set-attribute
+ v "-t" "uint32"
(tramp-gvfs-url-file-name filename) "unix::uid" (number-to-string uid)))
(when (natnump gid)
- (tramp-gvfs-send-command
- v "gvfs-set-attribute" "-t" "uint32"
+ (tramp-gvfs-set-attribute
+ v "-t" "uint32"
(tramp-gvfs-url-file-name filename)
"unix::gid" (number-to-string gid)))))
diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el
index 8638bb4..96f7d9a 100644
--- a/lisp/net/tramp-rclone.el
+++ b/lisp/net/tramp-rclone.el
@@ -157,8 +157,8 @@ Operations not mentioned here will be handled by the
default Emacs primitives.")
;;;###tramp-autoload
(defun tramp-rclone-file-name-handler (operation &rest args)
"Invoke the rclone handler for OPERATION and ARGS.
-First arg specifies the OPERATION, second arg is a list of arguments to
-pass to the OPERATION."
+First arg specifies the OPERATION, second arg is a list of
+arguments to pass to the OPERATION."
(if-let ((fn (assoc operation tramp-rclone-file-name-handler-alist)))
(save-match-data (apply (cdr fn) args))
(tramp-run-real-handler operation args)))
@@ -215,9 +215,7 @@ file names."
(with-parsed-tramp-file-name (if t1 filename newname) nil
(unless (file-exists-p filename)
- (tramp-error
- v tramp-file-missing
- "%s file" msg-operation "No such file or directory" filename))
+ (tramp-compat-file-missing v filename))
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
@@ -304,9 +302,7 @@ file names."
(directory &optional full match nosort count)
"Like `directory-files' for Tramp files."
(unless (file-exists-p directory)
- (tramp-error
- (tramp-dissect-file-name directory) tramp-file-missing
- "No such file or directory" directory))
+ (tramp-compat-file-missing (tramp-dissect-file-name directory) directory))
(when (file-directory-p directory)
(setq directory (file-name-as-directory (expand-file-name directory)))
(with-parsed-tramp-file-name directory nil
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 2274efd..bcdc014 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -1094,7 +1094,8 @@ component is used as the target of the symlink."
(unless ln
(tramp-error
v 'file-error
- "Making a symbolic link. ln(1) does not exist on the remote host."))
+ (concat "Making a symbolic link. "
+ "ln(1) does not exist on the remote host.")))
;; Do the 'confirm if exists' thing.
(when (file-exists-p linkname)
@@ -1724,9 +1725,8 @@ ID-FORMAT valid values are `string' and `integer'."
"Like `directory-files-and-attributes' for Tramp files."
(unless id-format (setq id-format 'integer))
(unless (file-exists-p directory)
- (tramp-error
- (tramp-dissect-file-name directory) tramp-file-missing
- "No such file or directory" directory))
+ (tramp-compat-file-missing
+ (tramp-dissect-file-name directory) directory))
(when (file-directory-p directory)
(setq directory (expand-file-name directory))
(let* ((temp
@@ -1877,8 +1877,9 @@ ID-FORMAT valid values are `string' and `integer'."
;; side.
(unless (looking-at-p "^ok$")
(tramp-error
- v 'file-error "\
-tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'"
+ v 'file-error
+ (concat "tramp-sh-handle-file-name-all-completions: "
+ "internal error accessing `%s': `%s'")
(tramp-shell-quote-argument localname) (buffer-string))))
(while (zerop (forward-line -1))
@@ -1944,9 +1945,7 @@ tramp-sh-handle-file-name-all-completions: internal error
accessing `%s': `%s'"
(t2 (tramp-tramp-file-p newname)))
(with-parsed-tramp-file-name (if t1 dirname newname) nil
(unless (file-exists-p dirname)
- (tramp-error
- v tramp-file-missing
- "Copying directory" "No such file or directory" dirname))
+ (tramp-compat-file-missing v dirname))
(if (and (not copy-contents)
(tramp-get-method-parameter v 'tramp-copy-recursive)
;; When DIRNAME and NEWNAME are remote, they must have
@@ -2032,12 +2031,12 @@ file names."
(length (tramp-compat-file-attribute-size
(file-attributes (file-truename filename))))
(attributes (and preserve-extended-attributes
- (apply #'file-extended-attributes (list filename)))))
+ (apply #'file-extended-attributes (list filename))))
+ (msg-operation (if (eq op 'copy) "Copying" "Renaming")))
(with-parsed-tramp-file-name (if t1 filename newname) nil
(unless (file-exists-p filename)
- (tramp-error
- v tramp-file-missing "No such file or directory" filename))
+ (tramp-compat-file-missing v filename))
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
@@ -2045,9 +2044,7 @@ file names."
(tramp-error v 'file-error "File is a directory %s" newname))
(with-tramp-progress-reporter
- v 0 (format "%s %s to %s"
- (if (eq op 'copy) "Copying" "Renaming")
- filename newname)
+ v 0 (format "%s %s to %s" msg-operation filename newname)
(cond
;; Both are Tramp files.
@@ -2536,7 +2533,7 @@ The method used must be an out-of-band method."
(setq dir (expand-file-name dir))
(with-parsed-tramp-file-name dir nil
(when (and (null parents) (file-exists-p dir))
- (tramp-error v 'file-already-exists "Directory already exists %s" dir))
+ (tramp-error v 'file-already-exists dir))
;; When PARENTS is non-nil, DIR could be a chain of non-existent
;; directories a/b/c/... Instead of checking, we simply flush the
;; whole cache.
@@ -3278,9 +3275,7 @@ alternative implementation will be used."
"Like `file-local-copy' for Tramp files."
(with-parsed-tramp-file-name filename nil
(unless (file-exists-p (file-truename filename))
- (tramp-error
- v tramp-file-missing
- "Cannot make local copy of non-existing file `%s'" filename))
+ (tramp-compat-file-missing v filename))
(let* ((size (tramp-compat-file-attribute-size
(file-attributes (file-truename filename))))
@@ -3969,7 +3964,7 @@ Fall back to normal file name handler if no Tramp handler
exists."
"[[:blank:]]+\\([^[:blank:]]+\\)"
"\\([[:blank:]]+\\([^\n\r]+\\)\\)?")
line)
- (tramp-error proc 'file-notify-error "%s" line))
+ (tramp-error proc 'file-notify-error line))
(let ((object
(list
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index c5a74a5..26ec910 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -342,8 +342,8 @@ This can be used to disable echo etc."
;;;###tramp-autoload
(defun tramp-smb-file-name-handler (operation &rest args)
"Invoke the SMB related OPERATION and ARGS.
-First arg specifies the OPERATION, second arg is a list of arguments to
-pass to the OPERATION."
+First arg specifies the OPERATION, second arg is a list of
+arguments to pass to the OPERATION."
(if-let ((fn (assoc operation tramp-smb-file-name-handler-alist)))
(save-match-data (apply (cdr fn) args))
(tramp-run-real-handler operation args)))
@@ -430,9 +430,7 @@ pass to the OPERATION."
(with-tramp-progress-reporter
v 0 (format "Copying %s to %s" dirname newname)
(unless (file-exists-p dirname)
- (tramp-error
- v tramp-file-missing
- "Copying directory" "No such file or directory" dirname))
+ (tramp-compat-file-missing v dirname))
(when (and (file-directory-p newname)
(not (directory-name-p newname)))
(tramp-error v 'file-already-exists newname))
@@ -588,11 +586,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(copy-directory filename newname keep-date 'parents 'copy-contents)
(unless (file-exists-p filename)
- (tramp-error
+ (tramp-compat-file-missing
(tramp-dissect-file-name
(if (tramp-tramp-file-p filename) filename newname))
- tramp-file-missing
- "Copying file" "No such file or directory" filename))
+ filename))
(if-let ((tmpfile (file-local-copy filename)))
;; Remote filename.
@@ -693,9 +690,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(directory &optional full match nosort count)
"Like `directory-files' for Tramp files."
(unless (file-exists-p directory)
- (tramp-error
- (tramp-dissect-file-name directory) tramp-file-missing
- "No such file or directory" directory))
+ (tramp-compat-file-missing (tramp-dissect-file-name directory) directory))
(let ((result (mapcar #'directory-file-name
(file-name-all-completions "" directory))))
;; Discriminate with regexp.
@@ -962,9 +957,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
"Like `file-local-copy' for Tramp files."
(with-parsed-tramp-file-name (file-truename filename) nil
(unless (file-exists-p (file-truename filename))
- (tramp-error
- v tramp-file-missing
- "Cannot make local copy of non-existing file `%s'" filename))
+ (tramp-compat-file-missing v filename))
(let ((tmpfile (tramp-compat-make-temp-file filename)))
(with-tramp-progress-reporter
v 3 (format "Fetching %s to tmp file %s" filename tmpfile)
@@ -1153,12 +1146,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
;; of `default-directory'.
(let ((start (point)))
(insert
- (format
- "%s"
- (file-relative-name
- (expand-file-name
- (nth 0 x) (file-name-directory filename))
- (when full-directory-p (file-name-directory filename)))))
+ (file-relative-name
+ (expand-file-name
+ (nth 0 x) (file-name-directory filename))
+ (when full-directory-p (file-name-directory filename))))
(put-text-property start (point) 'dired-filename t))
;; Insert symlink.
@@ -1177,7 +1168,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(setq dir (expand-file-name dir default-directory)))
(with-parsed-tramp-file-name dir nil
(when (and (null parents) (file-exists-p dir))
- (tramp-error v 'file-already-exists "Directory already exists %s" dir))
+ (tramp-error v 'file-already-exists dir))
(let* ((ldir (file-name-directory dir)))
;; Make missing directory parts.
(when (and parents
@@ -1386,9 +1377,7 @@ component is used as the target of the symlink."
(with-parsed-tramp-file-name
(if (tramp-tramp-file-p filename) filename newname) nil
(unless (file-exists-p filename)
- (tramp-error
- v tramp-file-missing
- "Renaming file" "No such file or directory" filename))
+ (tramp-compat-file-missing v filename))
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
@@ -2010,10 +1999,8 @@ If ARGUMENT is non-nil, use it as argument for
(when port (setq args (append args (list "-p" port))))
(when tramp-smb-conf
(setq args (append args (list "-s" tramp-smb-conf))))
- (while options
- (setq args
- (append args `("--option" ,(format "%s" (car options))))
- options (cdr options)))
+ (dolist (option options)
+ (setq args (append args (list "--option" option))))
(when argument
(setq args (append args (list argument))))
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index 5bb1546..0a60b79 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -153,8 +153,8 @@ See `tramp-actions-before-shell' for more info.")
;;;###tramp-autoload
(defun tramp-sudoedit-file-name-handler (operation &rest args)
"Invoke the SUDOEDIT handler for OPERATION and ARGS.
-First arg specifies the OPERATION, second arg is a list of arguments to
-pass to the OPERATION."
+First arg specifies the OPERATION, second arg is a list of
+arguments to pass to the OPERATION."
(if-let ((fn (assoc operation tramp-sudoedit-file-name-handler-alist)))
(save-match-data (apply (cdr fn) args))
(tramp-run-real-handler operation args)))
@@ -243,9 +243,7 @@ absolute file names."
(with-parsed-tramp-file-name (if t1 filename newname) nil
(unless (file-exists-p filename)
- (tramp-error
- v tramp-file-missing
- "%s file" msg-operation "No such file or directory" filename))
+ (tramp-compat-file-missing v filename))
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 7b34a74..690dd99 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -2001,7 +2001,7 @@ the resulting error message."
(unless (eq error-symbol 'void-variable)
(tramp-error
(car tramp-current-connection) error-symbol
- "%s" (mapconcat (lambda (x) (format "%s" x)) data " "))))
+ (mapconcat (lambda (x) (format "%s" x)) data " "))))
(put #'tramp-signal-hook-function 'tramp-suppress-trace t)
@@ -3058,9 +3058,9 @@ User is always nil."
(defun tramp-handle-access-file (filename string)
"Like `access-file' for Tramp files."
(unless (file-readable-p (file-truename filename))
- (tramp-error
- (tramp-dissect-file-name filename) tramp-file-missing
- "%s: No such file or directory %s" string filename)))
+ (tramp-compat-file-missing
+ (tramp-dissect-file-name filename)
+ (format "%s: %s" string filename))))
(defun tramp-handle-add-name-to-file
(filename newname &optional ok-if-already-exists)
@@ -3094,9 +3094,7 @@ User is always nil."
;; `copy-directory' creates NEWNAME before running this check. So
;; we do it ourselves.
(unless (file-exists-p directory)
- (tramp-error
- (tramp-dissect-file-name directory) tramp-file-missing
- "No such file or directory" directory))
+ (tramp-compat-file-missing (tramp-dissect-file-name directory) directory))
;; We must do it file-wise.
(tramp-run-real-handler
'copy-directory
@@ -3117,9 +3115,7 @@ User is always nil."
(defun tramp-handle-directory-files (directory &optional full match nosort
count)
"Like `directory-files' for Tramp files."
(unless (file-exists-p directory)
- (tramp-error
- (tramp-dissect-file-name directory) tramp-file-missing
- "No such file or directory" directory))
+ (tramp-compat-file-missing (tramp-dissect-file-name directory) directory))
(when (file-directory-p directory)
(setq directory (file-name-as-directory (expand-file-name directory)))
(let ((temp (nreverse (file-name-all-completions "" directory)))
@@ -3216,9 +3212,7 @@ User is always nil."
"Like `file-local-copy' for Tramp files."
(with-parsed-tramp-file-name filename nil
(unless (file-exists-p filename)
- (tramp-error
- v tramp-file-missing
- "Cannot make local copy of non-existing file `%s'" filename))
+ (tramp-compat-file-missing v filename))
(let ((tmpfile (tramp-compat-make-temp-file filename)))
(copy-file filename tmpfile 'ok-if-already-exists 'keep-time)
tmpfile)))
@@ -3428,8 +3422,10 @@ User is always nil."
(if (stringp symlink-target)
(if (file-remote-p symlink-target)
(tramp-compat-file-name-quote symlink-target 'top)
- (expand-file-name
- symlink-target (file-name-directory v2-localname)))
+ (tramp-drop-volume-letter
+ (expand-file-name
+ symlink-target
+ (file-name-directory v2-localname))))
v2-localname)
'nohop)))
(when (>= numchase numchase-limit)
@@ -3511,9 +3507,7 @@ User is always nil."
(with-parsed-tramp-file-name filename nil
(unwind-protect
(if (not (file-exists-p filename))
- (tramp-error
- v tramp-file-missing
- "File `%s' not found on remote host" filename)
+ (tramp-compat-file-missing v filename)
(with-tramp-progress-reporter
v 3 (format-message "Inserting `%s'" filename)
@@ -3636,8 +3630,7 @@ User is always nil."
v 'file-error
"File `%s' does not include a `.el' or `.elc' suffix" file)))
(unless (or noerror (file-exists-p file))
- (tramp-error
- v tramp-file-missing "Cannot load nonexistent file `%s'" file))
+ (tramp-compat-file-missing v file))
(if (not (file-exists-p file))
nil
(let ((signal-hook-function (unless noerror signal-hook-function))
diff --git a/lisp/nxml/rng-cmpct.el b/lisp/nxml/rng-cmpct.el
index dcbd7ed..45a69a7 100644
--- a/lisp/nxml/rng-cmpct.el
+++ b/lisp/nxml/rng-cmpct.el
@@ -123,8 +123,7 @@ Return a pattern."
(set-buffer-multibyte t)
(set-syntax-table rng-c-syntax-table))
-(defvar rng-c-current-token nil)
-(make-variable-buffer-local 'rng-c-current-token)
+(defvar-local rng-c-current-token nil)
(defun rng-c-advance ()
(cond ((looking-at rng-c-token-re)
@@ -334,11 +333,9 @@ OVERRIDE is either nil, require or t."
;;; Parsing
-(defvar rng-c-escape-positions nil)
-(make-variable-buffer-local 'rng-c-escape-positions)
+(defvar-local rng-c-escape-positions nil)
-(defvar rng-c-file-name nil)
-(make-variable-buffer-local 'rng-c-file-name)
+(defvar-local rng-c-file-name nil)
(defvar rng-c-file-index nil)
diff --git a/lisp/nxml/rng-pttrn.el b/lisp/nxml/rng-pttrn.el
index 12ffa57..034671f 100644
--- a/lisp/nxml/rng-pttrn.el
+++ b/lisp/nxml/rng-pttrn.el
@@ -66,9 +66,8 @@
(defvar rng-schema-change-hook nil
"Hook to be run after `rng-current-schema' changes.")
-(defvar rng-current-schema nil
+(defvar-local rng-current-schema nil
"Pattern to be used as schema for the current buffer.")
-(make-variable-buffer-local 'rng-current-schema)
(defun rng-make-ref (name)
(list 'ref nil name))
diff --git a/lisp/nxml/rng-valid.el b/lisp/nxml/rng-valid.el
index 6ea8934..a5eb893 100644
--- a/lisp/nxml/rng-valid.el
+++ b/lisp/nxml/rng-valid.el
@@ -132,36 +132,30 @@ A quick validation validates at most one chunk."
;; Global variables
-(defvar rng-validate-timer nil)
-(make-variable-buffer-local 'rng-validate-timer)
+(defvar-local rng-validate-timer nil)
;; ensure that we can cancel the timer even after a kill-all-local-variables
(put 'rng-validate-timer 'permanent-local t)
-(defvar rng-validate-quick-timer nil)
-(make-variable-buffer-local 'rng-validate-quick-timer)
+(defvar-local rng-validate-quick-timer nil)
;; ensure that we can cancel the timer even after a kill-all-local-variables
(put 'rng-validate-quick-timer 'permanent-local t)
-(defvar rng-error-count nil
+(defvar-local rng-error-count nil
"Number of errors in the current buffer.
Always equal to number of overlays with category `rng-error'.")
-(make-variable-buffer-local 'rng-error-count)
-(defvar rng-message-overlay nil
+(defvar-local rng-message-overlay nil
"Overlay in this buffer whose `help-echo' property was last printed.
It is nil if none.")
-(make-variable-buffer-local 'rng-message-overlay)
-(defvar rng-message-overlay-inhibit-point nil
+(defvar-local rng-message-overlay-inhibit-point nil
"Position at which message from overlay should be inhibited.
If point is equal to this and the error overlay around
point is `rng-message-overlay', then the `help-echo' property
of the error overlay should not be printed with `message'.")
-(make-variable-buffer-local 'rng-message-overlay-inhibit-point)
-(defvar rng-message-overlay-current nil
+(defvar-local rng-message-overlay-current nil
"Non-nil if `rng-message-overlay' is still the current message.")
-(make-variable-buffer-local 'rng-message-overlay-current)
(defvar rng-open-elements nil
"Stack of names of open elements represented as a list.
@@ -178,11 +172,10 @@ indicating an unresolvable entity or character
reference.")
(defvar rng-collecting-text nil)
-(defvar rng-validate-up-to-date-end nil
+(defvar-local rng-validate-up-to-date-end nil
"Last position where validation is known to be up to date.")
-(make-variable-buffer-local 'rng-validate-up-to-date-end)
-(defvar rng-conditional-up-to-date-start nil
+(defvar-local rng-conditional-up-to-date-start nil
"Marker for the start of the conditionally up-to-date region.
It is nil if there is no conditionally up-to-date region. The
conditionally up-to-date region must be such that for any cached
@@ -191,20 +184,17 @@ if at some point it is determined that S becomes correct
for P,
then all states with position >= P in the conditionally up to
date region must also then be correct and all errors between P
and the end of the region must then be correctly marked.")
-(make-variable-buffer-local 'rng-conditional-up-to-date-start)
-(defvar rng-conditional-up-to-date-end nil
+(defvar-local rng-conditional-up-to-date-end nil
"Marker for the end of the conditionally up-to-date region.
It is nil if there is no conditionally up-to-date region.
See the variable `rng-conditional-up-to-date-start'.")
-(make-variable-buffer-local 'rng-conditional-up-to-date-end)
(defvar rng-parsing-for-state nil
"Non-nil means we are currently parsing just to compute the state.
Should be dynamically bound.")
-(defvar rng-dtd nil)
-(make-variable-buffer-local 'rng-dtd)
+(defvar-local rng-dtd nil)
;;;###autoload
(define-minor-mode rng-validate-mode
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-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/org/org-table.el b/lisp/org/org-table.el
index ef4672e..1248efa 100644
--- a/lisp/org/org-table.el
+++ b/lisp/org/org-table.el
@@ -2008,7 +2008,7 @@ toggle `org-table-follow-field-mode'."
(let ((b (save-excursion (skip-chars-backward "^|") (point)))
(e (save-excursion (skip-chars-forward "^|\r\n") (point))))
(remove-text-properties b e '(invisible t intangible t))
- (if (and (boundp 'font-lock-mode) font-lock-mode)
+ (if font-lock-mode
(font-lock-fontify-block))))
(t
(let ((pos (point-marker))
diff --git a/lisp/org/org.el b/lisp/org/org.el
index 2d21a44..e6a5cca 100644
--- a/lisp/org/org.el
+++ b/lisp/org/org.el
@@ -5520,7 +5520,7 @@ highlighting was done, nil otherwise."
(defun org-restart-font-lock ()
"Restart `font-lock-mode', to force refontification."
- (when (and (boundp 'font-lock-mode) font-lock-mode)
+ (when font-lock-mode
(font-lock-mode -1)
(font-lock-mode 1)))
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
index 0dd99ce..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.
@@ -330,19 +327,12 @@ modified to be an empty string, or the desired separation
string."
;;; Internal Variables:
;; for cycling completion support
-(defvar pcomplete-current-completions nil)
-(defvar pcomplete-last-completion-length)
-(defvar pcomplete-last-completion-stub)
-(defvar pcomplete-last-completion-raw)
-(defvar pcomplete-last-window-config nil)
-(defvar pcomplete-window-restore-timer nil)
-
-(make-variable-buffer-local 'pcomplete-current-completions)
-(make-variable-buffer-local 'pcomplete-last-completion-length)
-(make-variable-buffer-local 'pcomplete-last-completion-stub)
-(make-variable-buffer-local 'pcomplete-last-completion-raw)
-(make-variable-buffer-local 'pcomplete-last-window-config)
-(make-variable-buffer-local 'pcomplete-window-restore-timer)
+(defvar-local pcomplete-current-completions nil)
+(defvar-local pcomplete-last-completion-length nil)
+(defvar-local pcomplete-last-completion-stub nil)
+(defvar-local pcomplete-last-completion-raw nil)
+(defvar-local pcomplete-last-window-config nil)
+(defvar-local pcomplete-window-restore-timer nil)
;; used for altering pcomplete's behavior. These global variables
;; should always be nil.
@@ -479,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
@@ -872,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))))))
@@ -1123,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
@@ -1201,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 07ef30c..891a5f6 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.
@@ -84,23 +84,24 @@
(defmacro 5x5-defvar-local (var value doc)
"Define VAR to VALUE with documentation DOC and make it buffer local."
+ (declare (obsolete defvar-local "28.1"))
`(progn
(defvar ,var ,value ,doc)
(make-variable-buffer-local (quote ,var))))
-(5x5-defvar-local 5x5-grid nil
+(defvar-local 5x5-grid nil
"5x5 grid contents.")
-(5x5-defvar-local 5x5-x-pos 2
+(defvar-local 5x5-x-pos 2
"X position of cursor.")
-(5x5-defvar-local 5x5-y-pos 2
+(defvar-local 5x5-y-pos 2
"Y position of cursor.")
-(5x5-defvar-local 5x5-moves 0
+(defvar-local 5x5-moves 0
"Moves made.")
-(5x5-defvar-local 5x5-cracking nil
+(defvar-local 5x5-cracking nil
"Are we in cracking mode?")
(defvar 5x5-buffer-name "*5x5*"
@@ -140,7 +141,7 @@
map)
"Local keymap for the 5x5 game.")
-(5x5-defvar-local 5x5-solver-output nil
+(defvar-local 5x5-solver-output nil
"List that is the output of an arithmetic solver.
This list L is such that
@@ -288,7 +289,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 "-+ "))
@@ -296,11 +297,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) "| " " ")
@@ -330,7 +331,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))))
@@ -474,11 +475,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))))
@@ -502,7 +503,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))
@@ -514,7 +517,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))
@@ -532,6 +535,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.
@@ -670,16 +677,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.
@@ -695,8 +702,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);
@@ -769,7 +776,7 @@ 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."
diff --git a/lisp/play/blackbox.el b/lisp/play/blackbox.el
index e3854b5..61b0878 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.
diff --git a/lisp/play/bubbles.el b/lisp/play/bubbles.el
index f317ad5..dc93ef9 100644
--- a/lisp/play/bubbles.el
+++ b/lisp/play/bubbles.el
@@ -82,6 +82,10 @@
;; Careful with that axe, Eugene! Order does matter in the custom
;; section below.
+(defgroup bubbles nil
+ "Bubbles, a puzzle game."
+ :group 'games)
+
(defcustom bubbles-game-theme
'easy
"Overall game theme.
@@ -91,8 +95,7 @@ and a shift mode."
(const :tag "Medium" medium)
(const :tag "Difficult" difficult)
(const :tag "Hard" hard)
- (const :tag "User defined" user-defined))
- :group 'bubbles)
+ (const :tag "User defined" user-defined)))
(defun bubbles-set-game-easy ()
"Set game theme to `easy'."
@@ -124,10 +127,6 @@ and a shift mode."
(setq bubbles-game-theme 'user-defined)
(bubbles))
-(defgroup bubbles nil
- "Bubbles, a puzzle game."
- :group 'games)
-
(defcustom bubbles-graphics-theme
'circles
"Graphics theme.
diff --git a/lisp/play/cookie1.el b/lisp/play/cookie1.el
index 9cecb70..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.
@@ -60,7 +60,6 @@
(defcustom cookie-file nil
"Default phrase file for cookie functions."
:type '(choice (const nil) file)
- :group 'cookie
:version "24.4")
(defconst cookie-delimiter "\n%%\n\\|\n%\n\\|\0"
@@ -178,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")
@@ -205,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 a7a4b89..524ca81 100644
--- a/lisp/play/decipher.el
+++ b/lisp/play/decipher.el
@@ -99,8 +99,7 @@
"Non-nil means to convert ciphertext to uppercase.
nil means the case of the ciphertext is preserved.
This variable must be set before typing `\\[decipher]'."
- :type 'boolean
- :group 'decipher)
+ :type 'boolean)
(defcustom decipher-ignore-spaces nil
@@ -108,21 +107,18 @@ This variable must be set before typing `\\[decipher]'."
You should set this to nil if the cipher message is divided into words,
or t if it is not.
This variable is buffer-local."
- :type 'boolean
- :group 'decipher)
+ :type 'boolean)
(make-variable-buffer-local 'decipher-ignore-spaces)
(defcustom decipher-undo-limit 5000
"The maximum number of entries in the undo list.
When the undo list exceeds this number, 100 entries are deleted from
the tail of the list."
- :type 'integer
- :group 'decipher)
+ :type 'integer)
(defcustom decipher-mode-hook nil
"Hook to run upon entry to decipher."
- :type 'hook
- :group 'decipher)
+ :type 'hook)
;; End of user modifiable variables
;;--------------------------------------------------------------------
@@ -184,28 +180,24 @@ the tail of the list."
(cl-incf c))
(setq decipher-mode-syntax-table table)))
-(defvar decipher-alphabet nil)
+(defvar-local decipher-alphabet nil)
;; This is an alist containing entries (PLAIN-CHAR . CIPHER-CHAR),
;; where PLAIN-CHAR runs from ?a to ?z and CIPHER-CHAR is an uppercase
;; letter or space (which means no mapping is known for that letter).
;; This *must* contain entries for all lowercase characters.
-(make-variable-buffer-local 'decipher-alphabet)
-(defvar decipher-stats-buffer nil
+(defvar-local decipher-stats-buffer nil
"The buffer which displays statistics for this ciphertext.
Do not access this variable directly, use the function
`decipher-stats-buffer' instead.")
-(make-variable-buffer-local 'decipher-stats-buffer)
-(defvar decipher-undo-list-size 0
+(defvar-local decipher-undo-list-size 0
"The number of entries in the undo list.")
-(make-variable-buffer-local 'decipher-undo-list-size)
-(defvar decipher-undo-list nil
+(defvar-local decipher-undo-list nil
"The undo list for this buffer.
Each element is either a cons cell (PLAIN-CHAR . CIPHER-CHAR) or a
list of such cons cells.")
-(make-variable-buffer-local 'decipher-undo-list)
(defvar decipher-pending-undo-list nil)
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/dunnet.el b/lisp/play/dunnet.el
index 3916e35..c3be029 100644
--- a/lisp/play/dunnet.el
+++ b/lisp/play/dunnet.el
@@ -42,8 +42,7 @@
(locate-user-emacs-file "games/")))
"Name of file to store score information for dunnet."
:version "26.1"
- :type 'file
- :group 'dunnet)
+ :type 'file)
;;;;
;;;; This section defines the globals that are used in dunnet.
diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el
index e540ca7..8b64dfd 100644
--- a/lisp/play/gamegrid.el
+++ b/lisp/play/gamegrid.el
@@ -28,36 +28,35 @@
;; ;;;;;;;;;;;;; buffer-local variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defvar gamegrid-use-glyphs t
+(defvar-local gamegrid-use-glyphs t
"Non-nil means use glyphs when available.")
-(defvar gamegrid-use-color t
+(defvar-local gamegrid-use-color t
"Non-nil means use color when available.")
-(defvar gamegrid-font "-*-courier-medium-r-*-*-*-140-100-75-*-*-iso8859-*"
+(defvar-local gamegrid-font
"-*-courier-medium-r-*-*-*-140-100-75-*-*-iso8859-*"
"Name of the font used in X mode.")
-(defvar gamegrid-face nil
+(defvar-local gamegrid-face nil
"Indicates the face to use as a default.")
-(make-variable-buffer-local 'gamegrid-face)
-(defvar gamegrid-display-options nil)
+(defvar-local gamegrid-display-options nil)
-(defvar gamegrid-buffer-width 0)
-(defvar gamegrid-buffer-height 0)
-(defvar gamegrid-blank 0)
+(defvar-local gamegrid-buffer-width 0)
+(defvar-local gamegrid-buffer-height 0)
+(defvar-local gamegrid-blank 0)
-(defvar gamegrid-timer nil)
+(defvar-local gamegrid-timer nil)
-(defvar gamegrid-display-mode nil)
+(defvar-local gamegrid-display-mode nil)
-(defvar gamegrid-display-table)
+(defvar-local gamegrid-display-table nil)
-(defvar gamegrid-face-table nil)
+(defvar-local gamegrid-face-table nil)
-(defvar gamegrid-buffer-start 1)
+(defvar-local gamegrid-buffer-start 1)
-(defvar gamegrid-score-file-length 50
+(defvar-local gamegrid-score-file-length 50
"Number of high scores to keep.")
(defvar gamegrid-user-score-file-directory
@@ -66,19 +65,6 @@
If Emacs was built without support for shared game scores, then this
directory will be used.")
-(make-variable-buffer-local 'gamegrid-use-glyphs)
-(make-variable-buffer-local 'gamegrid-use-color)
-(make-variable-buffer-local 'gamegrid-font)
-(make-variable-buffer-local 'gamegrid-display-options)
-(make-variable-buffer-local 'gamegrid-buffer-width)
-(make-variable-buffer-local 'gamegrid-buffer-height)
-(make-variable-buffer-local 'gamegrid-blank)
-(make-variable-buffer-local 'gamegrid-timer)
-(make-variable-buffer-local 'gamegrid-display-mode)
-(make-variable-buffer-local 'gamegrid-display-table)
-(make-variable-buffer-local 'gamegrid-face-table)
-(make-variable-buffer-local 'gamegrid-buffer-start)
-(make-variable-buffer-local 'gamegrid-score-file-length)
;; ;;;;;;;;;;;;; global variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff --git a/lisp/play/gametree.el b/lisp/play/gametree.el
index 1a1d2d7..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.
@@ -79,7 +79,6 @@
;;; Code:
-(require 'derived)
(require 'outline)
;;;; Configuration variables
@@ -98,35 +97,30 @@ numbers of moves by Black (if considered in isolation) by
the ellipsis
conflicts with the use of ellipsis by Outline mode to denote collapsed
subtrees. The author uses \":\" because it agrees nicely with a set of
LaTeX macros he uses for typesetting annotated games."
- :type 'regexp
- :group 'gametree)
+ :type 'regexp)
(defcustom gametree-full-ply-regexp (regexp-quote ".")
"Matches ends of numbers of moves by the \"first\" player.
For instance, it is an almost universal convention in chess to postfix
numbers of moves by White (if considered in isolation) by the dot \".\"."
- :type 'regexp
- :group 'gametree)
+ :type 'regexp)
(defcustom gametree-half-ply-format "%d:"
"Output format for move numbers of moves by the \"second\" player.
Has to contain \"%d\" to output the actual number."
- :type 'string
- :group 'gametree)
+ :type 'string)
(defcustom gametree-full-ply-format "%d."
"Output format for move numbers of moves by the \"first\" player.
Has to contain \"%d\" to output the actual number."
- :type 'string
- :group 'gametree)
+ :type 'string)
(defcustom gametree-make-heading-function
(lambda (level)
(insert (make-string level ?*)))
"A function of one numeric argument, LEVEL, to insert a heading at point.
You should change this if you change `outline-regexp'."
- :type 'function
- :group 'gametree)
+ :type 'function)
(defvar gametree-local-layout nil
"A list encoding the layout (i.e. the show or hide state) of the file.
@@ -138,18 +132,15 @@ the file is visited (subject to the usual restriction via
(defcustom gametree-score-opener "{score="
"The string which opens a score tag, and precedes the actual score."
- :type 'string
- :group 'gametree)
+ :type 'string)
(defcustom gametree-score-manual-flag "!"
"String marking the line as manually (as opposed to automatically) scored."
- :type 'string
- :group 'gametree)
+ :type 'string)
(defcustom gametree-score-closer "}"
"The string which closes a score tag, and follows the actual score."
- :type 'string
- :group 'gametree)
+ :type 'string)
(defcustom gametree-score-regexp
(concat "[^\n\^M]*\\("
@@ -167,13 +158,11 @@ line as *manually* (as opposed to automatically) scored,
which
prevents the program from recursively applying the scoring algorithm
on the subtree headed by the marked line, and makes it use the manual
score instead."
- :type 'regexp
- :group 'gametree)
+ :type 'regexp)
(defcustom gametree-default-score 0
"Score to assume for branches lacking score tags."
- :type 'integer
- :group 'gametree)
+ :type 'integer)
;;;; Helper functions
diff --git a/lisp/play/gomoku.el b/lisp/play/gomoku.el
index 1856db8..8db40d7 100644
--- a/lisp/play/gomoku.el
+++ b/lisp/play/gomoku.el
@@ -76,8 +76,7 @@
(defcustom gomoku-mode-hook nil
"If non-nil, its value is called on entry to Gomoku mode.
One useful value to include is `turn-on-font-lock' to highlight the pieces."
- :type 'hook
- :group 'gomoku)
+ :type 'hook)
;;;
;;; CONSTANTS FOR BOARD
@@ -168,13 +167,11 @@ One useful value to include is `turn-on-font-lock' to
highlight the pieces."
(defface gomoku-O
'((((class color)) (:foreground "red" :weight bold)))
- "Face to use for Emacs's O."
- :group 'gomoku)
+ "Face to use for Emacs's O.")
(defface gomoku-X
'((((class color)) (:foreground "green" :weight bold)))
- "Face to use for your X."
- :group 'gomoku)
+ "Face to use for your X.")
(defvar gomoku-font-lock-keywords
'(("O" . 'gomoku-O)
diff --git a/lisp/play/hanoi.el b/lisp/play/hanoi.el
index d762290..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
@@ -71,33 +71,33 @@
(defcustom hanoi-horizontal-flag nil
"If non-nil, hanoi poles are oriented horizontally."
- :group 'hanoi :type 'boolean)
+ :type 'boolean)
(defcustom hanoi-move-period 1.0
"Time, in seconds, for each pole-to-pole move of a ring.
If nil, move rings as fast as possible while displaying all
intermediate positions."
- :group 'hanoi :type '(restricted-sexp :match-alternatives (numberp 'nil)))
+ :type '(restricted-sexp :match-alternatives (numberp 'nil)))
(defcustom hanoi-use-faces nil
"If nil, all hanoi-*-face variables are ignored."
- :group 'hanoi :type 'boolean)
+ :type 'boolean)
(defcustom hanoi-pole-face 'highlight
"Face for poles. Ignored if hanoi-use-faces is nil."
- :group 'hanoi :type 'face)
+ :type 'face)
(defcustom hanoi-base-face 'highlight
"Face for base. Ignored if hanoi-use-faces is nil."
- :group 'hanoi :type 'face)
+ :type 'face)
(defcustom hanoi-even-ring-face 'region
"Face for even-numbered rings. Ignored if hanoi-use-faces is nil."
- :group 'hanoi :type 'face)
+ :type 'face)
(defcustom hanoi-odd-ring-face 'secondary-selection
"Face for odd-numbered rings. Ignored if hanoi-use-faces is nil."
- :group 'hanoi :type 'face)
+ :type 'face)
;;;
diff --git a/lisp/play/snake.el b/lisp/play/snake.el
index 5584bf8..bed7cea 100644
--- a/lisp/play/snake.el
+++ b/lisp/play/snake.el
@@ -140,14 +140,14 @@
;; ;;;;;;;;;;;;; variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defvar snake-length 0)
-(defvar snake-velocity-x 1)
-(defvar snake-velocity-y 0)
-(defvar snake-positions nil)
-(defvar snake-score 0)
-(defvar snake-paused nil)
-(defvar snake-moved-p nil)
-(defvar snake-velocity-queue nil
+(defvar-local snake-length 0)
+(defvar-local snake-velocity-x 1)
+(defvar-local snake-velocity-y 0)
+(defvar-local snake-positions nil)
+(defvar-local snake-score 0)
+(defvar-local snake-paused nil)
+(defvar-local snake-moved-p nil)
+(defvar-local snake-velocity-queue nil
"This queue stores the velocities requested too quickly by user.
They will take effect one at a time at each clock-interval.
This is necessary for proper behavior.
@@ -158,16 +158,6 @@ we implemented all your keystrokes immediately, the snake
would
effectively never move up. Thus, we need to move it up for one turn
and then start moving it leftwards.")
-
-(make-variable-buffer-local 'snake-length)
-(make-variable-buffer-local 'snake-velocity-x)
-(make-variable-buffer-local 'snake-velocity-y)
-(make-variable-buffer-local 'snake-positions)
-(make-variable-buffer-local 'snake-score)
-(make-variable-buffer-local 'snake-paused)
-(make-variable-buffer-local 'snake-moved-p)
-(make-variable-buffer-local 'snake-velocity-queue)
-
;; ;;;;;;;;;;;;; keymaps ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar snake-mode-map
diff --git a/lisp/play/tetris.el b/lisp/play/tetris.el
index 8205d3f..05e4ffe 100644
--- a/lisp/play/tetris.el
+++ b/lisp/play/tetris.el
@@ -224,25 +224,15 @@ each one of its four blocks.")
;; ;;;;;;;;;;;;; variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defvar tetris-shape 0)
-(defvar tetris-rot 0)
-(defvar tetris-next-shape 0)
-(defvar tetris-n-shapes 0)
-(defvar tetris-n-rows 0)
-(defvar tetris-score 0)
-(defvar tetris-pos-x 0)
-(defvar tetris-pos-y 0)
-(defvar tetris-paused nil)
-
-(make-variable-buffer-local 'tetris-shape)
-(make-variable-buffer-local 'tetris-rot)
-(make-variable-buffer-local 'tetris-next-shape)
-(make-variable-buffer-local 'tetris-n-shapes)
-(make-variable-buffer-local 'tetris-n-rows)
-(make-variable-buffer-local 'tetris-score)
-(make-variable-buffer-local 'tetris-pos-x)
-(make-variable-buffer-local 'tetris-pos-y)
-(make-variable-buffer-local 'tetris-paused)
+(defvar-local tetris-shape 0)
+(defvar-local tetris-rot 0)
+(defvar-local tetris-next-shape 0)
+(defvar-local tetris-n-shapes 0)
+(defvar-local tetris-n-rows 0)
+(defvar-local tetris-score 0)
+(defvar-local tetris-pos-x 0)
+(defvar-local tetris-pos-y 0)
+(defvar-local tetris-paused nil)
;; ;;;;;;;;;;;;; keymaps ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el
index 527cb03..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))
@@ -2047,7 +2046,7 @@ Called in PHASE `after-insertion', see
`antlr-options-alists'."
(let ((new-language (antlr-language-option t)))
(or (null new-language)
(eq new-language antlr-language)
- (let ((font-lock (and (boundp 'font-lock-mode) font-lock-mode)))
+ (let ((font-lock font-lock-mode))
(if font-lock (font-lock-mode 0))
(antlr-mode)
(and font-lock (null font-lock-mode) (font-lock-mode 1)))))))
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index 3fce7db..484624b 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -9021,14 +9021,15 @@ point unchanged and return nil."
(c-forward-noise-clause))
((and (looking-at c-type-decl-prefix-key)
(if (and (c-major-mode-is 'c++-mode)
- (match-beginning 3))
+ (match-beginning 4)) ; Was 3 - 2021-01-01
;; If the third submatch matches in C++ then
;; we're looking at an identifier that's a
;; prefix only if it specifies a member pointer.
(progn
(setq id-start (point))
(c-forward-name)
- (if (looking-at "\\(::\\)")
+ (if (save-match-data
+ (looking-at "\\(::\\)"))
;; We only check for a trailing "::" and
;; let the "*" that should follow be
;; matched in the next round.
@@ -9038,13 +9039,15 @@ point unchanged and return nil."
(setq got-identifier t)
nil))
t))
- (if (looking-at c-type-decl-operator-prefix-key)
+ (if (save-match-data
+ (looking-at c-type-decl-operator-prefix-key))
(setq decorated t))
(if (eq (char-after) ?\()
(progn
(setq paren-depth (1+ paren-depth))
(forward-char))
- (goto-char (match-end 1)))
+ (goto-char (or (match-end 1)
+ (match-end 2))))
(c-forward-syntactic-ws)
t)))
@@ -9721,14 +9724,15 @@ This function might do hidden buffer changes."
(setq after-paren-pos (point))))
(while (and (looking-at c-type-decl-prefix-key)
(if (and (c-major-mode-is 'c++-mode)
- (match-beginning 3))
- ;; If the third submatch matches in C++ then
+ (match-beginning 4))
+ ;; If the fourth submatch matches in C++ then
;; we're looking at an identifier that's a
;; prefix only if it specifies a member pointer.
(when (progn (setq pos (point))
(setq got-identifier (c-forward-name)))
(setq name-start pos)
- (if (looking-at "\\(::\\)")
+ (if (save-match-data
+ (looking-at "\\(::\\)"))
;; We only check for a trailing "::" and
;; let the "*" that should follow be
;; matched in the next round.
@@ -9749,7 +9753,8 @@ This function might do hidden buffer changes."
(when (save-match-data
(looking-at c-type-decl-operator-prefix-key))
(setq got-function-name-prefix t))
- (goto-char (match-end 1)))
+ (goto-char (or (match-end 1)
+ (match-end 2))))
(c-forward-syntactic-ws)))
(setq got-parens (> paren-depth 0))
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el
index a5a6780..1938cc8 100644
--- a/lisp/progmodes/cc-langs.el
+++ b/lisp/progmodes/cc-langs.el
@@ -3434,41 +3434,47 @@ possible for good performance."
t (c-make-bare-char-alt (c-lang-const c-block-prefix-disallowed-chars) t))
(c-lang-defvar c-block-prefix-charset (c-lang-const c-block-prefix-charset))
-(c-lang-defconst c-type-decl-prefix-key
- "Regexp matching any declarator operator that might precede the
-identifier in a declaration, e.g. the \"*\" in \"char *argv\". This
-regexp should match \"(\" if parentheses are valid in declarators.
-The end of the first submatch is taken as the end of the operator.
-Identifier syntax is in effect when this is matched (see
-`c-identifier-syntax-table')."
+(c-lang-defconst c-type-decl-prefix-keywords-key
+ ;; Regexp matching any keyword operator that might precede the identifier in
+ ;; a declaration, e.g. "const" or nil. It doesn't test there is no "_"
+ ;; following the keyword.
t (if (or (c-lang-const c-type-modifier-kwds) (c-lang-const c-modifier-kwds))
- (concat
+ (concat
(regexp-opt (c--delete-duplicates
(append (c-lang-const c-type-modifier-kwds)
(c-lang-const c-modifier-kwds))
:test 'string-equal)
t)
- "\\>")
- ;; Default to a regexp that never matches.
- regexp-unmatchable)
+ "\\>")))
+
+(c-lang-defconst c-type-decl-prefix-key
+ "Regexp matching any declarator operator that might precede the
+identifier in a declaration, e.g. the \"*\" in \"char *argv\". This
+regexp should match \"(\" if parentheses are valid in declarators.
+The operator found is either the first submatch (if it is not a
+keyword) or the second submatch (if it is)."
+ t (if (c-lang-const c-type-decl-prefix-keywords-key)
+ (concat "\\(\\`a\\`\\)\\|" ; 1 - will never match.
+ (c-lang-const c-type-decl-prefix-keywords-key) ; 2
+ "\\([^_]\\|$\\)") ; 3
+ "\\`a\\`") ;; Default to a regexp that never matches.
;; Check that there's no "=" afterwards to avoid matching tokens
;; like "*=".
- (c objc) (concat "\\("
+ (c objc) (concat "\\(" ; 1
"[*(]"
- "\\|"
- (c-lang-const c-type-decl-prefix-key)
- "\\)"
- "\\([^=]\\|$\\)")
- c++ (concat "\\("
+ "\\)\\|"
+ (c-lang-const c-type-decl-prefix-keywords-key) ; 2
+ "\\([^=_]\\|$\\)") ; 3
+ c++ (concat "\\(" ; 1
"&&"
"\\|"
"\\.\\.\\."
"\\|"
"[*(&~]"
+ "\\)\\|\\(" ; 2
+ (c-lang-const c-type-decl-prefix-keywords-key) ; 3
"\\|"
- (c-lang-const c-type-decl-prefix-key)
- "\\|"
- (concat "\\(" ; 3
+ (concat "\\(" ; 4
;; If this matches there's special treatment in
;; `c-font-lock-declarators' and
;; `c-font-lock-declarations' that check for a
@@ -3476,8 +3482,9 @@ Identifier syntax is in effect when this is matched (see
(c-lang-const c-identifier-start)
"\\)")
"\\)"
- "\\([^=]\\|$\\)")
+ "\\([^=_]\\|$\\)") ; 5
pike "\\(\\*\\)\\([^=]\\|$\\)")
+
(c-lang-defvar c-type-decl-prefix-key (c-lang-const c-type-decl-prefix-key)
'dont-doc)
diff --git a/lisp/progmodes/cmacexp.el b/lisp/progmodes/cmacexp.el
index d3a33bd..1a45b1c 100644
--- a/lisp/progmodes/cmacexp.el
+++ b/lisp/progmodes/cmacexp.el
@@ -72,15 +72,6 @@
;; Please report bugs, suggestions, complaints and so on to
;; bug-gnu-emacs@gnu.org and pot@gnu.org (Francesco Potortì).
-;; IMPROVEMENTS OVER emacs 18.xx cmacexp.el ==========================
-
-;; - A lot of user and programmer visible changes. See above.
-;; - #line directives are inserted, so __LINE__ and __FILE__ are
-;; correctly expanded. Works even with START inside a string, a
-;; comment or a region #ifdef'd away by cpp. cpp is invoked with -C,
-;; making comments visible in the expansion.
-;; - All work is done in core memory, no need for temporary files.
-
;; ACKNOWLEDGMENTS ===================================================
;; A lot of thanks to Don Maszle who did a great work of testing, bug
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 2c1e6ff..48b5ee9 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -953,13 +953,11 @@ Faces `compilation-error-face',
`compilation-warning-face',
:type 'boolean
:version "23.1")
-(defvar compilation-auto-jump-to-next nil
+(defvar-local compilation-auto-jump-to-next nil
"If non-nil, automatically jump to the next error encountered.")
-(make-variable-buffer-local 'compilation-auto-jump-to-next)
-;; (defvar compilation-buffer-modtime nil
+;; (defvar-local compilation-buffer-modtime nil
;; "The buffer modification time, for buffers not associated with files.")
-;; (make-variable-buffer-local 'compilation-buffer-modtime)
(defvar compilation-skip-to-next-location t
"If non-nil, skip multiple error messages for the same source location.")
@@ -1087,13 +1085,12 @@ from a different message."
(:conc-name compilation--message->))
loc type end-loc rule)
-(defvar compilation--previous-directory-cache nil
+(defvar-local compilation--previous-directory-cache nil
"A pair (POS . RES) caching the result of previous directory search.
Basically, this pair says that calling
(previous-single-property-change POS \\='compilation-directory)
returned RES, i.e. there is no change of `compilation-directory' between
POS and RES.")
-(make-variable-buffer-local 'compilation--previous-directory-cache)
(defun compilation--flush-directory-cache (start _end)
(cond
@@ -1600,8 +1597,7 @@ to `compilation-error-regexp-alist' if RULES is nil."
(match-beginning mn) (match-end mn)
'font-lock-face (cadr props)))))))))
-(defvar compilation--parsed -1)
-(make-variable-buffer-local 'compilation--parsed)
+(defvar-local compilation--parsed -1)
(defun compilation--ensure-parse (limit)
"Make sure the text has been parsed up to LIMIT."
@@ -2073,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]
@@ -2673,9 +2673,8 @@ This is the value of `next-error-function' in Compilation
buffers."
(compilation--loc->marker end-loc))
(setf (compilation--loc->visited loc) t)))
-(defvar compilation-gcpro nil
+(defvar-local compilation-gcpro nil
"Internal variable used to keep some values from being GC'd.")
-(make-variable-buffer-local 'compilation-gcpro)
(defun compilation-fake-loc (marker file &optional line col)
"Preassociate MARKER with FILE.
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index d401513..a70e8e3 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -1157,25 +1157,25 @@ versions of Emacs."
(get-text-property (point-min) 'in-pod)
(< (progn
(and cperl-syntaxify-for-menu
- (cperl-update-syntaxification (point-max) (point-max)))
+ (cperl-update-syntaxification (point-max)))
(next-single-property-change (point-min) 'in-pod nil
(point-max)))
(point-max)))]
["Ispell HERE-DOCs" cperl-here-doc-spell
(< (progn
(and cperl-syntaxify-for-menu
- (cperl-update-syntaxification (point-max) (point-max)))
+ (cperl-update-syntaxification (point-max)))
(next-single-property-change (point-min) 'here-doc-group nil
(point-max)))
(point-max))]
["Narrow to this HERE-DOC" cperl-narrow-to-here-doc
(eq 'here-doc (progn
(and cperl-syntaxify-for-menu
- (cperl-update-syntaxification (point) (point)))
+ (cperl-update-syntaxification (point)))
(get-text-property (point) 'syntax-type)))]
["Select this HERE-DOC or POD section"
cperl-select-this-pod-or-here-doc
(memq (progn
(and cperl-syntaxify-for-menu
- (cperl-update-syntaxification (point) (point)))
+ (cperl-update-syntaxification (point)))
(get-text-property (point) 'syntax-type))
'(here-doc pod))]
"----"
@@ -1659,36 +1659,18 @@ or as help on variables `cperl-tips', `cperl-problems',
nil nil ((?_ . "w"))))
;; Reset syntaxification cache.
(setq-local cperl-syntax-state nil)
- (if cperl-use-syntax-table-text-property
- (if (eval-when-compile (fboundp 'syntax-propertize-rules))
- (progn
- ;; Reset syntaxification cache.
- (setq-local cperl-syntax-done-to nil)
- (setq-local syntax-propertize-function
- (lambda (start end)
- (goto-char start)
- ;; Even if cperl-fontify-syntaxically 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))))
- ;; Do not introduce variable if not needed, we check it!
- (setq-local parse-sexp-lookup-properties t)
- ;; Our: just a plug for wrong font-lock
- (setq-local font-lock-unfontify-region-function
- ;; not present with old Emacs
- #'cperl-font-lock-unfontify-region-function)
- ;; Reset syntaxification cache.
- (setq-local cperl-syntax-done-to nil)
- (setq-local font-lock-syntactic-keywords
- (if cperl-syntaxify-by-font-lock
- '((cperl-fontify-syntaxically))
- ;; unless font-lock-syntactic-keywords, font-lock
(pre-22.1)
- ;; used to ignore syntax-table text-properties. (t) is
a hack
- ;; to make font-lock think that
font-lock-syntactic-keywords
- ;; are defined.
- '(t)))))
+ (when cperl-use-syntax-table-text-property
+ ;; Reset syntaxification cache.
+ (setq-local cperl-syntax-done-to nil)
+ (setq-local syntax-propertize-function
+ (lambda (start end)
+ (goto-char start)
+ ;; Even if cperl-fontify-syntaxically 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))))
(setq cperl-font-lock-multiline t) ; Not localized...
(setq-local font-lock-multiline t)
(setq-local font-lock-fontify-region-function
@@ -2405,7 +2387,7 @@ means indent rigidly all the lines of the expression
starting after point
so that this line becomes properly indented.
The relative indentation among the lines of the expression are preserved."
(interactive "P")
- (cperl-update-syntaxification (point) (point))
+ (cperl-update-syntaxification (point))
(if whole-exp
;; If arg, always indent this line as Perl
;; and shift remaining lines of expression the same amount.
@@ -2533,7 +2515,7 @@ Will not look before LIM."
(defun cperl-sniff-for-indent (&optional parse-data) ; was parse-start
;; the sniffer logic to understand what the current line MEANS.
- (cperl-update-syntaxification (point) (point))
+ (cperl-update-syntaxification (point))
(let ((res (get-text-property (point) 'syntax-type)))
(save-excursion
(cond
@@ -3025,7 +3007,7 @@ Returns true if comment is found. In POD will not move
the point."
;; then looks for literal # or end-of-line.
(let (state stop-in cpoint (lim (point-at-eol)) pr e)
(or cperl-font-locking
- (cperl-update-syntaxification lim lim))
+ (cperl-update-syntaxification lim))
(beginning-of-line)
(if (setq pr (get-text-property (point) 'syntax-type))
(setq e (next-single-property-change (point) 'syntax-type nil
(point-max))))
@@ -4640,7 +4622,7 @@ CHARS is a string that contains good characters to have
before us (however,
`}' is treated \"smartly\" if it is not in the list)."
(let ((lim (or lim (point-min)))
stop p)
- (cperl-update-syntaxification (point) (point))
+ (cperl-update-syntaxification (point))
(save-excursion
(while (and (not stop) (> (point) lim))
(skip-chars-backward " \t\n\f" lim)
@@ -5027,7 +5009,7 @@ inclusive.
If `cperl-indent-region-fix-constructs', will improve spacing on
conditional/loop constructs."
(interactive "r")
- (cperl-update-syntaxification end end)
+ (cperl-update-syntaxification end)
(save-excursion
(let (cperl-update-start cperl-update-end (h-a-c after-change-functions))
(let ((indent-info (list nil nil nil) ; Cannot use '(), since will
modify
@@ -5233,7 +5215,7 @@ indentation and initial hashes. Behaves usually outside
of comment."
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) (point-max))
+ (cperl-update-syntaxification (point-max))
;; Search for the function
(progn ;;save-match-data
(while (re-search-forward
@@ -8209,7 +8191,7 @@ function returns nil."
(or prop (setq prop 'in-pod))
(or s (setq s (point-min)))
(or end (setq end (point-max)))
- (cperl-update-syntaxification end end)
+ (cperl-update-syntaxification end)
(save-excursion
(goto-char (setq pos s))
(while (and cont (< pos end))
@@ -8225,7 +8207,7 @@ function returns nil."
Return nil if the point is not in a HERE document region. If POD is non-nil,
will return a POD section if point is in a POD section."
(or pos (setq pos (point)))
- (cperl-update-syntaxification pos pos)
+ (cperl-update-syntaxification pos)
(if (or (eq 'here-doc (get-text-property pos 'syntax-type))
(and pod
(eq 'pod (get-text-property pos 'syntax-type))))
@@ -8295,7 +8277,7 @@ start with default arguments, then refine the slowdown
regions."
(forward-line step)
(setq l (+ l step))
(setq c (1+ c))
- (cperl-update-syntaxification (point) (point))
+ (cperl-update-syntaxification (point))
(setq delta (- (- tt (setq tt (funcall timems)))) tot (+ tot delta))
(message "to %s:%6s,%7s" l delta tot))
tot))
@@ -8405,19 +8387,12 @@ do extra unwind via `cperl-unwind-to-safe'."
(setq end (point)))
(font-lock-default-fontify-region beg end loudly))
-(defvar cperl-d-l nil)
-(defvar edebug-backtrace-buffer) ;FIXME: Why?
(defun cperl-fontify-syntaxically (end)
;; Some vars for debugging only
;; (message "Syntaxifying...")
(let ((dbg (point)) (iend end) (idone cperl-syntax-done-to)
(istate (car cperl-syntax-state))
- start from-start edebug-backtrace-buffer)
- (if (eq cperl-syntaxify-by-font-lock 'backtrace)
- (progn
- (require 'edebug)
- (let ((f 'edebug-backtrace))
- (funcall f)))) ; Avoid compile-time warning
+ start from-start)
(or cperl-syntax-done-to
(setq cperl-syntax-done-to (point-min)
from-start t))
@@ -8473,16 +8448,9 @@ do extra unwind via `cperl-unwind-to-safe'."
(if cperl-syntax-done-to
(setq cperl-syntax-done-to (min cperl-syntax-done-to beg))))
-(defun cperl-update-syntaxification (from to)
- (cond
- ((not cperl-use-syntax-table-text-property) nil)
- ((fboundp 'syntax-propertize) (syntax-propertize to))
- ((and cperl-syntaxify-by-font-lock
- (or (null cperl-syntax-done-to)
- (< cperl-syntax-done-to to)))
- (save-excursion
- (goto-char from)
- (cperl-fontify-syntaxically to)))))
+(defun cperl-update-syntaxification (to)
+ (when cperl-use-syntax-table-text-property
+ (syntax-propertize to)))
(defvar cperl-version
(let ((v "Revision: 6.2"))
diff --git a/lisp/progmodes/cpp.el b/lisp/progmodes/cpp.el
index 4ea1674..b2c2e8d 100644
--- a/lisp/progmodes/cpp.el
+++ b/lisp/progmodes/cpp.el
@@ -112,9 +112,8 @@ If nil, `cpp-progress-message' prints no progress messages."
:group 'cpp
:version "26.1")
-(defvar cpp-overlay-list nil)
-;; List of cpp overlays active in the current buffer.
-(make-variable-buffer-local 'cpp-overlay-list)
+(defvar-local cpp-overlay-list nil
+ "List of cpp overlays active in the current buffer.")
(defvar cpp-callback-data)
(defvar cpp-state-stack)
@@ -134,9 +133,8 @@ If nil, `cpp-progress-message' prints no progress messages."
(defvar cpp-button-event nil)
;; This will be t in the callback for `cpp-make-button'.
-(defvar cpp-edit-buffer nil)
-;; Real buffer whose cpp display information we are editing.
-(make-variable-buffer-local 'cpp-edit-buffer)
+(defvar-local cpp-edit-buffer nil
+ "Real buffer whose cpp display information we are editing.")
(defconst cpp-branch-list
;; Alist of branches.
@@ -211,9 +209,8 @@ or a cons cell (background-color . COLOR)."
;;; Parse Buffer:
-(defvar cpp-parse-symbols nil
+(defvar-local cpp-parse-symbols nil
"List of cpp macros used in the local buffer.")
-(make-variable-buffer-local 'cpp-parse-symbols)
(defconst cpp-parse-regexp
;; Regexp matching all tokens needed to find conditionals.
@@ -471,9 +468,8 @@ A prefix arg suppresses display of that buffer."
-(defvar cpp-edit-symbols nil)
-;; Symbols defined in the edit buffer.
-(make-variable-buffer-local 'cpp-edit-symbols)
+(defvar-local cpp-edit-symbols nil
+ "Symbols defined in the edit buffer.")
(define-derived-mode cpp-edit-mode fundamental-mode "CPP Edit"
"Major mode for editing the criteria for highlighting cpp conditionals.
diff --git a/lisp/progmodes/dcl-mode.el b/lisp/progmodes/dcl-mode.el
index 3815b17..8943d8b 100644
--- a/lisp/progmodes/dcl-mode.el
+++ b/lisp/progmodes/dcl-mode.el
@@ -30,21 +30,14 @@
;; Type `C-h m' when you are editing a .COM file to get more
;; information about this mode.
;;
-;; To use templates you will need a version of tempo.el that is at
-;; least later than the buggy 1.1.1, which was included with my versions of
-;; Emacs. I used version 1.2.4.
-;; The latest tempo.el distribution can be fetched from
-;; ftp.lysator.liu.se in the directory /pub/emacs.
+;; Support for templates is based on the built-in tempo.el.
;; I recommend setting (setq tempo-interactive t). This will make
;; tempo prompt you for values to put in the blank spots in the templates.
;;
-;; There is limited support for imenu. The limitation is that you need
-;; a version of imenu.el that uses imenu-generic-expression. I found
-;; the version I use in Emacs 19.30. (It was *so* much easier to hook
-;; into that version than the one in 19.27...)
+;; There is limited support for imenu.
;;
;; Any feedback will be welcomed. If you write functions for
-;; dcl-calc-command-indent-function or dcl-calc-cont-indent-function,
+;; `dcl-calc-command-indent-function' or `dcl-calc-cont-indent-function',
;; please send them to the maintainer.
;;
;;
@@ -349,13 +342,10 @@ See `imenu-generic-expression' for details."
'("End of statement" . dcl-forward-command))
(define-key map [menu-bar dcl dcl-backward-command]
'("Beginning of statement" . dcl-backward-command))
- ;; imenu is only supported for versions with imenu-generic-expression
- (if (boundp 'imenu-generic-expression)
- (progn
- (define-key map [menu-bar dcl dcl-separator-movement]
- '("--"))
- (define-key map [menu-bar dcl imenu]
- '("Buffer index menu" . imenu))))
+ (define-key map [menu-bar dcl dcl-separator-movement]
+ '("--"))
+ (define-key map [menu-bar dcl imenu]
+ '("Buffer index menu" . imenu))
map)
"Keymap used in DCL-mode buffers.")
@@ -463,8 +453,7 @@ Preloaded with all known option names from
dcl-option-alist")
;The default includes SUBROUTINE labels in the main listing and
;sub-listings for other labels, CALL, GOTO and GOSUB statements.
-;See `imenu-generic-expression' in a recent (e.g. Emacs 19.30) imenu.el
-;for details.")
+;See `imenu-generic-expression' for details.")
;;; *** Mode initialization *************************************************
@@ -600,9 +589,8 @@ There is some minimal font-lock support (see vars
;; and something inappropriate might be interpreted as a comment.
(setq-local comment-start-skip "\\$[ \t]*![ \t]*")
- (if (boundp 'imenu-generic-expression)
- (progn (setq imenu-generic-expression dcl-imenu-generic-expression)
- (setq imenu-case-fold-search t)))
+ (setq imenu-generic-expression dcl-imenu-generic-expression)
+ (setq imenu-case-fold-search t)
(setq imenu-create-index-function 'dcl-imenu-create-index-function)
(make-local-variable 'dcl-comment-line-regexp)
diff --git a/lisp/progmodes/ebnf2ps.el b/lisp/progmodes/ebnf2ps.el
index 6f9509d..b376423 100644
--- a/lisp/progmodes/ebnf2ps.el
+++ b/lisp/progmodes/ebnf2ps.el
@@ -2941,16 +2941,11 @@ See `ebnf-style-database' documentation."
(defvar ebnf-eps-executing nil)
(defvar ebnf-eps-header-comment nil)
(defvar ebnf-eps-footer-comment nil)
-(defvar ebnf-eps-upper-x 0.0)
-(make-variable-buffer-local 'ebnf-eps-upper-x)
-(defvar ebnf-eps-upper-y 0.0)
-(make-variable-buffer-local 'ebnf-eps-upper-y)
-(defvar ebnf-eps-prod-width 0.0)
-(make-variable-buffer-local 'ebnf-eps-prod-width)
-(defvar ebnf-eps-max-height 0.0)
-(make-variable-buffer-local 'ebnf-eps-max-height)
-(defvar ebnf-eps-max-width 0.0)
-(make-variable-buffer-local 'ebnf-eps-max-width)
+(defvar-local ebnf-eps-upper-x 0.0)
+(defvar-local ebnf-eps-upper-y 0.0)
+(defvar-local ebnf-eps-prod-width 0.0)
+(defvar-local ebnf-eps-max-height 0.0)
+(defvar-local ebnf-eps-max-width 0.0)
(defvar ebnf-eps-context nil
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index 017e8c5..431daec 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -1284,7 +1284,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)
@@ -1353,7 +1354,8 @@ Return the result of evaluation."
;; printing, not while evaluating.
(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
@@ -1369,17 +1371,18 @@ Return the result of evaluation."
(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
+ `(setq elisp--eval-defun-result ,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))
+ 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/f90.el b/lisp/progmodes/f90.el
index 2641387..5c0b788 100644
--- a/lisp/progmodes/f90.el
+++ b/lisp/progmodes/f90.el
@@ -117,11 +117,10 @@
;; correctly, but I imagine them to be rare.
;; 3) Regexps for hilit19 are no longer supported.
;; 4) For FIXED FORMAT code, use fortran mode.
-;; 5) This mode does not work under emacs-18.x.
-;; 6) Preprocessor directives, i.e., lines starting with # are left-justified
+;; 5) Preprocessor directives, i.e., lines starting with # are left-justified
;; and are untouched by all case-changing commands. There is, at present, no
;; mechanism for treating multi-line directives (continued by \ ).
-;; 7) f77 do-loops do 10 i=.. ; ; 10 continue are not correctly indented.
+;; 6) f77 do-loops do 10 i=.. ; ; 10 continue are not correctly indented.
;; You are urged to use f90-do loops (with labels if you wish).
;; List of user commands
@@ -718,10 +717,7 @@ Can be overridden by the value of
`font-lock-maximum-decoration'.")
(modify-syntax-entry ?* "." table)
(modify-syntax-entry ?/ "." table)
(modify-syntax-entry ?% "." table) ; bug#8820
- ;; I think that the f95 standard leaves the behavior of \
- ;; unspecified, but that f2k will require it to be non-special.
- ;; Use `f90-backslash-not-special' to change.
- (modify-syntax-entry ?\\ "\\" table) ; escape chars
+ (modify-syntax-entry ?\\ "." table)
table)
"Syntax table used in F90 mode.")
@@ -926,9 +922,8 @@ then the presence of the token here allows a line-break
before or
after the other character, where a break would not normally be
allowed. This minor issue currently only affects \"(/\" and \"/)\".")
-(defvar f90-cache-position nil
+(defvar-local f90-cache-position nil
"Temporary position used to speed up region operations.")
-(make-variable-buffer-local 'f90-cache-position)
;; Hideshow support.
@@ -2396,9 +2391,11 @@ CHANGE-WORD should be one of `upcase-word',
`downcase-word', `capitalize-word'."
(defun f90-backslash-not-special (&optional all)
"Make the backslash character (\\) be non-special in the current buffer.
+This is the default in `f90-mode'.
+
With optional argument ALL, change the default for all present
-and future F90 buffers. F90 mode normally treats backslash as an
-escape character."
+and future F90 buffers."
+ (declare (obsolete nil "28.1"))
(or (derived-mode-p 'f90-mode)
(user-error "This function should only be used in F90 buffers"))
(when (equal (char-syntax ?\\ ) ?\\ )
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 259da2f..eb114ac 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -638,8 +638,7 @@ The option \"--fullname\" must be included in this value."
;; receive a chunk of text which looks like it might contain the
;; beginning of a marker, we save it here between calls to the
;; filter.
-(defvar gud-marker-acc "")
-(make-variable-buffer-local 'gud-marker-acc)
+(defvar-local gud-marker-acc "")
(defun gud-gdb-marker-filter (string)
(setq gud-marker-acc (concat gud-marker-acc string))
diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el
index c118924..e8e55ae 100644
--- a/lisp/progmodes/idlwave.el
+++ b/lisp/progmodes/idlwave.el
@@ -6876,7 +6876,6 @@ sort the list before displaying."
(let ((completion-ignore-case t)) ; install correct value
(apply function args))
(if (and (derived-mode-p 'idlwave-shell-mode)
- (boundp 'font-lock-mode)
(not font-lock-mode))
;; For the shell, remove the fontification of the word before point
(let ((beg (save-excursion
diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el
index 33bea59..cdf6536 100644
--- a/lisp/progmodes/js.el
+++ b/lisp/progmodes/js.el
@@ -717,26 +717,20 @@ This variable is like `sgml-attribute-offset'."
table)
"Syntax table for `js-mode'.")
-(defvar js--quick-match-re nil
+(defvar-local js--quick-match-re nil
"Autogenerated regexp used by `js-mode' to match buffer constructs.")
-(defvar js--quick-match-re-func nil
+(defvar-local js--quick-match-re-func nil
"Autogenerated regexp used by `js-mode' to match constructs and functions.")
-(make-variable-buffer-local 'js--quick-match-re)
-(make-variable-buffer-local 'js--quick-match-re-func)
-
-(defvar js--cache-end 1
+(defvar-local js--cache-end 1
"Last valid buffer position for the `js-mode' function cache.")
-(make-variable-buffer-local 'js--cache-end)
-(defvar js--last-parse-pos nil
+(defvar-local js--last-parse-pos nil
"Latest parse position reached by `js--ensure-cache'.")
-(make-variable-buffer-local 'js--last-parse-pos)
-(defvar js--state-at-last-parse-pos nil
+(defvar-local js--state-at-last-parse-pos nil
"Parse state at `js--last-parse-pos'.")
-(make-variable-buffer-local 'js--state-at-last-parse-pos)
(defun js--maybe-join (prefix separator suffix &rest list)
"Helper function for `js--update-quick-match-re'.
@@ -1505,8 +1499,7 @@ REGEXPS, but only if FRAMEWORK is in
`js-enabled-frameworks'."
(when (memq (quote ,framework) js-enabled-frameworks)
(re-search-forward ,regexps limit t)))))
-(defvar js--tmp-location nil)
-(make-variable-buffer-local 'js--tmp-location)
+(defvar-local js--tmp-location nil)
(defun js--forward-destructuring-spec (&optional func)
"Move forward over a JavaScript destructuring spec.
diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el
index a0e09f5..e382d6e 100644
--- a/lisp/progmodes/make-mode.el
+++ b/lisp/progmodes/make-mode.el
@@ -435,6 +435,9 @@ not be enclosed in { } or ( )."
'("[^$]\\(\\$[({][@%*][DF][})]\\)"
1 'makefile-targets append)
+ ;; Automatic variables.
+ '("[^$]\\(\\$[@%*?+^|]\\)" 1 'makefile-targets append)
+
;; $(function ...) ${function ...}
'("[^$]\\$[({]\\([-a-zA-Z0-9_.]+\\s \\)"
1 font-lock-function-name-face prepend)
diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el
index a14a8d7..ddcc6f5 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)
@@ -964,8 +964,7 @@ output is passed to the filter
`inferior-octave-output-digest'."
(setq list (cdr list)))
(set-process-filter proc filter))))
-(defvar inferior-octave-directory-tracker-resync nil)
-(make-variable-buffer-local 'inferior-octave-directory-tracker-resync)
+(defvar-local inferior-octave-directory-tracker-resync nil)
(defun inferior-octave-directory-tracker (string)
"Tracks `cd' commands issued to the inferior Octave process.
@@ -1517,7 +1516,8 @@ current buffer file unless called with a prefix arg
\\[universal-argument]."
;; https://lists.gnu.org/r/emacs-devel/2013-10/msg00095.html
(compilation-forget-errors)
(insert-before-markers string "\n")
- (comint-send-string proc (concat string "\n"))))
+ (comint-send-string proc (concat string "\n")))
+ (deactivate-mark))
(if octave-send-show-buffer
(display-buffer inferior-octave-buffer)))
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index fc5e301..abe563b 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -725,6 +725,7 @@ requires quoting, e.g. `\\[quoted-insert]<space>'."
(require 'xref)
(require 'grep)
(let* ((pr (project-current t))
+ (default-directory (project-root pr))
(files
(if (not current-prefix-arg)
(project-files pr)
@@ -756,6 +757,7 @@ pattern to search for."
(interactive (list (project--read-regexp)))
(require 'xref)
(let* ((pr (project-current t))
+ (default-directory (project-root pr))
(files
(project-files pr (cons
(project-root pr)
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index d6c0a4d..afb9697 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -3273,7 +3273,8 @@ process running; defaults to t when called interactively."
;; lines have been removed/added.
(with-current-buffer (process-buffer process)
(compilation-forget-errors))
- (python-shell-send-string string process)))
+ (python-shell-send-string string process)
+ (deactivate-mark)))
(defun python-shell-send-statement (&optional send-main msg)
"Send the statement at point to inferior Python process.
diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el
index a8667ac..e7f407b 100644
--- a/lisp/progmodes/ruby-mode.el
+++ b/lisp/progmodes/ruby-mode.el
@@ -1869,8 +1869,8 @@ It will be properly highlighted even when the call omits
parens.")
;; Symbols with special characters.
(":\\([-+~]@?\\|[/%&|^`]\\|\\*\\*?\\|<\\(<\\|=>?\\)?\\|>[>=]?\\|===?\\|=~\\|![~=]?\\|\\[\\]=?\\)"
(1 (unless (or
- (eq (char-before (match-beginning 0)) ?:)
- (nth 8 (syntax-ppss (match-beginning 1))))
+ (nth 8 (syntax-ppss (match-beginning 1)))
+ (eq (char-before (match-beginning 0)) ?:))
(goto-char (match-end 0))
(string-to-syntax "_"))))
;; Symbols ending with '=' (bug#42846).
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index fd68952..f588ad9 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -541,10 +541,9 @@ sign. See `sh-feature'."
:group 'sh-script)
-(defvar sh-header-marker nil
+(defvar-local sh-header-marker nil
"When non-nil is the end of header for prepending by \\[sh-execute-region].
That command is also used for setting this variable.")
-(make-variable-buffer-local 'sh-header-marker)
(defcustom sh-beginning-of-command
"\\([;({`|&]\\|\\`\\|[^\\]\n\\)[ \t]*\\([/~[:alnum:]:]\\)"
diff --git a/lisp/progmodes/simula.el b/lisp/progmodes/simula.el
index 7806a6b..a863e7e 100644
--- a/lisp/progmodes/simula.el
+++ b/lisp/progmodes/simula.el
@@ -281,7 +281,7 @@ for SIMULA mode to function correctly."
(define-key map ":" 'simula-electric-label)
(define-key map "\e\C-q" 'simula-indent-exp)
(define-key map "\t" 'simula-indent-command)
- ;; Emacs 19 defines menus in the mode map
+
(define-key map [menu-bar simula]
(cons "SIMULA" (make-sparse-keymap "SIMULA")))
(define-key map [menu-bar simula indent-exp]
diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el
index 4d027f3..f1f4d61 100644
--- a/lisp/progmodes/sql.el
+++ b/lisp/progmodes/sql.el
@@ -2829,9 +2829,7 @@ configured."
;; Force font lock to reinitialize if it is already on
;; Otherwise, we can wait until it can be started.
- (when (and (fboundp 'font-lock-mode)
- (boundp 'font-lock-mode)
- font-lock-mode)
+ (when font-lock-mode
(font-lock-mode-internal nil)
(font-lock-mode-internal t))
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 8dddcf0..f934ef7 100644
--- a/lisp/progmodes/verilog-mode.el
+++ b/lisp/progmodes/verilog-mode.el
@@ -9,7 +9,7 @@
;; Keywords: languages
;; The "Version" is the date followed by the decimal rendition of the Git
;; commit hex.
-;; Version: 2020.06.27.014326051
+;; Version: 2021.02.02.263931197
;; Yoni Rabkin <yoni@rabkins.net> contacted the maintainer of this
;; file on 19/3/2008, and the maintainer agreed that when a bug is
@@ -124,7 +124,7 @@
;;
;; This variable will always hold the version number of the mode
-(defconst verilog-mode-version "2020-06-27-0da9923-vpo-GNU"
+(defconst verilog-mode-version "2021-02-02-fbb453d-vpo-GNU"
"Version of this Verilog mode.")
(defconst verilog-mode-release-emacs t
"If non-nil, this version of Verilog mode was released with Emacs itself.")
@@ -134,6 +134,16 @@
(interactive)
(message "Using verilog-mode version %s" verilog-mode-version))
+(defmacro verilog--supressed-warnings (warnings &rest body)
+ (declare (indent 1) (debug t))
+ (cond
+ ((fboundp 'with-suppressed-warnings)
+ `(with-suppressed-warnings ,warnings ,@body))
+ ((fboundp 'with-no-warnings)
+ `(with-no-warnings ,@body))
+ (t
+ `(progn ,@body))))
+
;; Insure we have certain packages, and deal with it if we don't
;; Be sure to note which Emacs flavor and version added each feature.
(eval-when-compile
@@ -220,7 +230,7 @@ STRING should be given if the last search was by
`string-match' on STRING."
)
(if (fboundp 'defface)
nil ; great!
- (defmacro defface (var values doc &rest _args)
+ (defmacro defface (var _values _doc &rest _args)
`(make-face ,var))
)
@@ -339,7 +349,7 @@ wherever possible, since it is slow."
((fboundp 'quit-window)
(defalias 'verilog-quit-window 'quit-window))
(t
- (defun verilog-quit-window (kill-ignored window)
+ (defun verilog-quit-window (_kill-ignored window)
"Quit WINDOW and bury its buffer. KILL-IGNORED is ignored."
(delete-window window)))))
@@ -407,7 +417,7 @@ wherever possible, since it is slow."
"Filter `define-abbrev-table' TABLENAME DEFINITIONS
Provides DOCSTRING PROPS in newer Emacs (23.1)."
(condition-case nil
- (apply 'define-abbrev-table tablename definitions docstring props)
+ (apply #'define-abbrev-table tablename definitions docstring props)
(error
(define-abbrev-table tablename definitions))))
@@ -572,7 +582,7 @@ entry \"Fontify Buffer\"). XEmacs: turn off and on font
locking."
:type 'boolean
:group 'verilog-mode-indent)
;; Note we don't use :safe, as that would break on Emacsen before 22.0.
-(put 'verilog-highlight-translate-off 'safe-local-variable 'verilog-booleanp)
+(put 'verilog-highlight-translate-off 'safe-local-variable #'verilog-booleanp)
(defcustom verilog-auto-lineup 'declarations
"Type of statements to lineup across multiple lines.
@@ -611,7 +621,7 @@ are lineup only when \\[verilog-pretty-declarations] is
typed."
"Indentation of Verilog statements with respect to containing block."
:group 'verilog-mode-indent
:type 'integer)
-(put 'verilog-indent-level 'safe-local-variable 'integerp)
+(put 'verilog-indent-level 'safe-local-variable #'integerp)
(defcustom verilog-indent-level-module 3
"Indentation of Module level Verilog statements (eg always, initial).
@@ -619,14 +629,14 @@ Set to 0 to get initial and always statements lined up on
the left side of
your screen."
:group 'verilog-mode-indent
:type 'integer)
-(put 'verilog-indent-level-module 'safe-local-variable 'integerp)
+(put 'verilog-indent-level-module 'safe-local-variable #'integerp)
(defcustom verilog-indent-level-declaration 3
"Indentation of declarations with respect to containing block.
Set to 0 to get them list right under containing block."
:group 'verilog-mode-indent
:type 'integer)
-(put 'verilog-indent-level-declaration 'safe-local-variable 'integerp)
+(put 'verilog-indent-level-declaration 'safe-local-variable #'integerp)
(defcustom verilog-indent-declaration-macros nil
"How to treat macro expansions in a declaration.
@@ -640,7 +650,7 @@ If non-nil, treat as:
output c;"
:group 'verilog-mode-indent
:type 'boolean)
-(put 'verilog-indent-declaration-macros 'safe-local-variable 'verilog-booleanp)
+(put 'verilog-indent-declaration-macros 'safe-local-variable
#'verilog-booleanp)
(defcustom verilog-indent-lists t
"How to treat indenting items in a list.
@@ -653,72 +663,72 @@ If nil, treat as:
reset ) begin"
:group 'verilog-mode-indent
:type 'boolean)
-(put 'verilog-indent-lists 'safe-local-variable 'verilog-booleanp)
+(put 'verilog-indent-lists 'safe-local-variable #'verilog-booleanp)
(defcustom verilog-indent-level-behavioral 3
"Absolute indentation of first begin in a task or function block.
Set to 0 to get such code to start at the left side of the screen."
:group 'verilog-mode-indent
:type 'integer)
-(put 'verilog-indent-level-behavioral 'safe-local-variable 'integerp)
+(put 'verilog-indent-level-behavioral 'safe-local-variable #'integerp)
(defcustom verilog-indent-level-directive 1
"Indentation to add to each level of \\=`ifdef declarations.
Set to 0 to have all directives start at the left side of the screen."
:group 'verilog-mode-indent
:type 'integer)
-(put 'verilog-indent-level-directive 'safe-local-variable 'integerp)
+(put 'verilog-indent-level-directive 'safe-local-variable #'integerp)
(defcustom verilog-cexp-indent 2
"Indentation of Verilog statements split across lines."
:group 'verilog-mode-indent
:type 'integer)
-(put 'verilog-cexp-indent 'safe-local-variable 'integerp)
+(put 'verilog-cexp-indent 'safe-local-variable #'integerp)
(defcustom verilog-case-indent 2
"Indentation for case statements."
:group 'verilog-mode-indent
:type 'integer)
-(put 'verilog-case-indent 'safe-local-variable 'integerp)
+(put 'verilog-case-indent 'safe-local-variable #'integerp)
(defcustom verilog-auto-newline t
"Non-nil means automatically newline after semicolons."
:group 'verilog-mode-indent
:type 'boolean)
-(put 'verilog-auto-newline 'safe-local-variable 'verilog-booleanp)
+(put 'verilog-auto-newline 'safe-local-variable #'verilog-booleanp)
(defcustom verilog-auto-indent-on-newline t
"Non-nil means automatically indent line after newline."
:group 'verilog-mode-indent
:type 'boolean)
-(put 'verilog-auto-indent-on-newline 'safe-local-variable 'verilog-booleanp)
+(put 'verilog-auto-indent-on-newline 'safe-local-variable #'verilog-booleanp)
(defcustom verilog-tab-always-indent t
"Non-nil means TAB should always re-indent the current line.
A nil value means TAB will only reindent when at the beginning of the line."
:group 'verilog-mode-indent
:type 'boolean)
-(put 'verilog-tab-always-indent 'safe-local-variable 'verilog-booleanp)
+(put 'verilog-tab-always-indent 'safe-local-variable #'verilog-booleanp)
(defcustom verilog-tab-to-comment nil
"Non-nil means TAB moves to the right hand column in preparation for a
comment."
:group 'verilog-mode-actions
:type 'boolean)
-(put 'verilog-tab-to-comment 'safe-local-variable 'verilog-booleanp)
+(put 'verilog-tab-to-comment 'safe-local-variable #'verilog-booleanp)
(defcustom verilog-indent-begin-after-if t
"Non-nil means indent begin statements following if, else, while, etc.
Otherwise, line them up."
:group 'verilog-mode-indent
:type 'boolean)
-(put 'verilog-indent-begin-after-if 'safe-local-variable 'verilog-booleanp)
+(put 'verilog-indent-begin-after-if 'safe-local-variable #'verilog-booleanp)
(defcustom verilog-align-ifelse nil
"Non-nil means align `else' under matching `if'.
Otherwise else is lined up with first character on line holding matching if."
:group 'verilog-mode-indent
:type 'boolean)
-(put 'verilog-align-ifelse 'safe-local-variable 'verilog-booleanp)
+(put 'verilog-align-ifelse 'safe-local-variable #'verilog-booleanp)
(defcustom verilog-minimum-comment-distance 10
"Minimum distance (in lines) between begin and end required before a comment.
@@ -726,7 +736,7 @@ Setting this variable to zero results in every end
acquiring a comment; the
default avoids too many redundant comments in tight quarters."
:group 'verilog-mode-indent
:type 'integer)
-(put 'verilog-minimum-comment-distance 'safe-local-variable 'integerp)
+(put 'verilog-minimum-comment-distance 'safe-local-variable #'integerp)
(defcustom verilog-highlight-p1800-keywords nil
"Obsolete.
@@ -734,7 +744,7 @@ Was non-nil means highlight SystemVerilog IEEE-1800
differently.
All code is now highlighted as if SystemVerilog IEEE-1800."
:group 'verilog-mode-indent
:type 'boolean)
-(put 'verilog-highlight-p1800-keywords 'safe-local-variable 'verilog-booleanp)
+(put 'verilog-highlight-p1800-keywords 'safe-local-variable #'verilog-booleanp)
(make-obsolete-variable 'verilog-highlight-p1800-keywords nil "27.1")
(defcustom verilog-highlight-grouping-keywords nil
@@ -745,7 +755,7 @@ Some find that special highlighting on these grouping
constructs
allow the structure of the code to be understood at a glance."
:group 'verilog-mode-indent
:type 'boolean)
-(put 'verilog-highlight-grouping-keywords 'safe-local-variable
'verilog-booleanp)
+(put 'verilog-highlight-grouping-keywords 'safe-local-variable
#'verilog-booleanp)
(defcustom verilog-highlight-modules nil
"Non-nil means highlight module statements for `verilog-load-file-at-point'.
@@ -754,7 +764,7 @@ module definition. If false, this is not supported.
Setting
this is experimental, and may lead to bad performance."
:group 'verilog-mode-indent
:type 'boolean)
-(put 'verilog-highlight-modules 'safe-local-variable 'verilog-booleanp)
+(put 'verilog-highlight-modules 'safe-local-variable #'verilog-booleanp)
(defcustom verilog-highlight-includes t
"Non-nil means highlight module statements for `verilog-load-file-at-point'.
@@ -762,7 +772,17 @@ When true, mousing over include file names will allow
jumping to the
file referenced. If false, this is not supported."
:group 'verilog-mode-indent
:type 'boolean)
-(put 'verilog-highlight-includes 'safe-local-variable 'verilog-booleanp)
+(put 'verilog-highlight-includes 'safe-local-variable #'verilog-booleanp)
+
+(defcustom verilog-highlight-max-lookahead 10000
+ "Maximum size of declaration statement that undergoes highlighting.
+Highlighting is performed only on the first `verilog-highlight-max-lookahead'
+characters in a declaration statement.
+Setting this variable to zero would remove this limit. Note that removing
+the limit can greatly slow down highlighting for very large files."
+ :group 'verilog-mode-indent
+ :type 'integer)
+(put 'verilog-highlight-max-lookahead 'safe-local-variable #'integerp)
(defcustom verilog-auto-declare-nettype nil
"Non-nil specifies the data type to use with `verilog-auto-input' etc.
@@ -772,14 +792,14 @@ mode is experimental."
:version "24.1" ; rev670
:group 'verilog-mode-actions
:type 'boolean)
-(put 'verilog-auto-declare-nettype 'safe-local-variable 'stringp)
+(put 'verilog-auto-declare-nettype 'safe-local-variable #'stringp)
(defcustom verilog-auto-wire-comment t
"Non-nil indicates to insert to/from comments with `verilog-auto-wire' etc."
:version "25.1"
:group 'verilog-mode-actions
:type 'boolean)
-(put 'verilog-auto-wire-comment 'safe-local-variable 'verilog-booleanp)
+(put 'verilog-auto-wire-comment 'safe-local-variable #'verilog-booleanp)
(defcustom verilog-auto-wire-type nil
"Non-nil specifies the data type to use with `verilog-auto-wire' etc.
@@ -790,21 +810,21 @@ containing SystemVerilog cells."
:version "24.1" ; rev673
:group 'verilog-mode-actions
:type '(choice (const nil) string))
-(put 'verilog-auto-wire-type 'safe-local-variable 'stringp)
+(put 'verilog-auto-wire-type 'safe-local-variable #'stringp)
(defcustom verilog-auto-endcomments t
"Non-nil means insert a comment /* ... */ after `end's.
The name of the function or case will be set between the braces."
:group 'verilog-mode-actions
:type 'boolean)
-(put 'verilog-auto-endcomments 'safe-local-variable 'verilog-booleanp)
+(put 'verilog-auto-endcomments 'safe-local-variable #'verilog-booleanp)
(defcustom verilog-auto-delete-trailing-whitespace nil
"Non-nil means to `delete-trailing-whitespace' in `verilog-auto'."
:version "24.1" ; rev703
:group 'verilog-mode-actions
:type 'boolean)
-(put 'verilog-auto-delete-trailing-whitespace 'safe-local-variable
'verilog-booleanp)
+(put 'verilog-auto-delete-trailing-whitespace 'safe-local-variable
#'verilog-booleanp)
(defcustom verilog-auto-ignore-concat nil
"Non-nil means ignore signals in {...} concatenations for AUTOWIRE etc.
@@ -812,7 +832,7 @@ This will exclude signals referenced as pin connections in
{...}
or (...) from AUTOWIRE, AUTOOUTPUT and friends."
:group 'verilog-mode-actions
:type 'boolean)
-(put 'verilog-auto-ignore-concat 'safe-local-variable 'verilog-booleanp)
+(put 'verilog-auto-ignore-concat 'safe-local-variable #'verilog-booleanp)
(defcustom verilog-auto-read-includes nil
"Non-nil means to automatically read includes before AUTOs.
@@ -822,7 +842,7 @@ but can result in very slow reading times if there are many
or large
include files."
:group 'verilog-mode-actions
:type 'boolean)
-(put 'verilog-auto-read-includes 'safe-local-variable 'verilog-booleanp)
+(put 'verilog-auto-read-includes 'safe-local-variable #'verilog-booleanp)
(defcustom verilog-auto-save-policy nil
"Non-nil indicates action to take when saving a Verilog buffer with AUTOs.
@@ -843,7 +863,7 @@ They will be expanded in the same way as if there was an
AUTOINST in the
instantiation. See also `verilog-auto-star' and `verilog-auto-star-save'."
:group 'verilog-mode-actions
:type 'boolean)
-(put 'verilog-auto-star-expand 'safe-local-variable 'verilog-booleanp)
+(put 'verilog-auto-star-expand 'safe-local-variable #'verilog-booleanp)
(defcustom verilog-auto-star-save nil
"Non-nil means save to disk SystemVerilog .* instance expansions.
@@ -854,7 +874,7 @@ Instead of setting this, you may want to use /*AUTOINST*/,
which will
always be saved."
:group 'verilog-mode-actions
:type 'boolean)
-(put 'verilog-auto-star-save 'safe-local-variable 'verilog-booleanp)
+(put 'verilog-auto-star-save 'safe-local-variable #'verilog-booleanp)
(defvar verilog-auto-update-tick nil
"Modification tick at which autos were last performed.")
@@ -862,7 +882,7 @@ always be saved."
(defvar verilog-auto-last-file-locals nil
"Text from file-local-variables during last evaluation.")
-(defvar verilog-diff-function 'verilog-diff-report
+(defvar verilog-diff-function #'verilog-diff-report
"Function to run when `verilog-diff-auto' detects differences.
Function takes three arguments, the original buffer, the
difference buffer, and the point in original buffer with the
@@ -917,7 +937,7 @@ See `compilation-error-regexp-alist' for the formatting.
For Emacs 22+.")
;; Emacs form is '((v-tool "re" 1 2) ...)
;; XEmacs form is '(verilog ("re" 1 2) ...)
;; So we can just map from Emacs to XEmacs
- (cons 'verilog (mapcar 'cdr verilog-error-regexp-emacs-alist))
+ (cons 'verilog (mapcar #'cdr verilog-error-regexp-emacs-alist))
"List of regexps for Verilog compilers.
See `compilation-error-regexp-alist-alist' for the formatting. For XEmacs.")
@@ -997,7 +1017,7 @@ have problems, use \\[find-alternate-file] RET to have
these take effect.
See also the variables mentioned above."
:group 'verilog-mode-auto
:type '(repeat string))
-(put 'verilog-library-flags 'safe-local-variable 'listp)
+(put 'verilog-library-flags 'safe-local-variable #'listp)
(defcustom verilog-library-directories '(".")
"List of directories when looking for files for /*AUTOINST*/.
@@ -1020,7 +1040,7 @@ See also `verilog-library-flags', `verilog-library-files'
and `verilog-library-extensions'."
:group 'verilog-mode-auto
:type '(repeat file))
-(put 'verilog-library-directories 'safe-local-variable 'listp)
+(put 'verilog-library-directories 'safe-local-variable #'listp)
(defcustom verilog-library-files '()
"List of files to search for modules.
@@ -1042,14 +1062,14 @@ have problems, use \\[find-alternate-file] RET to have
these take effect.
See also `verilog-library-flags', `verilog-library-directories'."
:group 'verilog-mode-auto
:type '(repeat directory))
-(put 'verilog-library-files 'safe-local-variable 'listp)
+(put 'verilog-library-files 'safe-local-variable #'listp)
(defcustom verilog-library-extensions '(".v" ".va" ".sv")
"List of extensions to use when looking for files for /*AUTOINST*/.
See also `verilog-library-flags', `verilog-library-directories'."
:type '(repeat string)
:group 'verilog-mode-auto)
-(put 'verilog-library-extensions 'safe-local-variable 'listp)
+(put 'verilog-library-extensions 'safe-local-variable #'listp)
(defcustom verilog-active-low-regexp nil
"If true, treat signals matching this regexp as active low.
@@ -1057,7 +1077,7 @@ This is used for AUTORESET and AUTOTIEOFF. For proper
behavior,
you will probably also need `verilog-auto-reset-widths' set."
:group 'verilog-mode-auto
:type '(choice (const nil) regexp))
-(put 'verilog-active-low-regexp 'safe-local-variable 'stringp)
+(put 'verilog-active-low-regexp 'safe-local-variable #'stringp)
(defcustom verilog-auto-sense-include-inputs nil
"Non-nil means AUTOSENSE should include all inputs.
@@ -1065,7 +1085,7 @@ If nil, only inputs that are NOT output signals in the
same block are
included."
:group 'verilog-mode-auto
:type 'boolean)
-(put 'verilog-auto-sense-include-inputs 'safe-local-variable 'verilog-booleanp)
+(put 'verilog-auto-sense-include-inputs 'safe-local-variable
#'verilog-booleanp)
(defcustom verilog-auto-sense-defines-constant nil
"Non-nil means AUTOSENSE should assume all defines represent constants.
@@ -1074,7 +1094,7 @@ maintain compatibility with other sites, this should be
set at the bottom
of each Verilog file that requires it, rather than being set globally."
:group 'verilog-mode-auto
:type 'boolean)
-(put 'verilog-auto-sense-defines-constant 'safe-local-variable
'verilog-booleanp)
+(put 'verilog-auto-sense-defines-constant 'safe-local-variable
#'verilog-booleanp)
(defcustom verilog-auto-simplify-expressions t
"Non-nil means AUTOs will simplify expressions when calculating bit ranges.
@@ -1086,7 +1106,7 @@ file that requires it, rather than being set globally."
:version "27.1"
:group 'verilog-mode-auto
:type 'boolean)
-(put 'verilog-auto-simplify-expressions 'safe-local-variable 'verilog-booleanp)
+(put 'verilog-auto-simplify-expressions 'safe-local-variable
#'verilog-booleanp)
(defcustom verilog-auto-reset-blocking-in-non t
"Non-nil means AUTORESET will reset blocking statements.
@@ -1101,7 +1121,7 @@ those temporaries reset. See example in
`verilog-auto-reset'."
:version "24.1" ; rev718
:type 'boolean
:group 'verilog-mode-auto)
-(put 'verilog-auto-reset-blocking-in-non 'safe-local-variable
'verilog-booleanp)
+(put 'verilog-auto-reset-blocking-in-non 'safe-local-variable
#'verilog-booleanp)
(defcustom verilog-auto-reset-widths t
"True means AUTORESET should determine the width of signals.
@@ -1124,7 +1144,7 @@ SystemVerilog designs."
"Text used for delays in delayed assignments. Add a trailing space if set."
:group 'verilog-mode-auto
:type 'string)
-(put 'verilog-assignment-delay 'safe-local-variable 'stringp)
+(put 'verilog-assignment-delay 'safe-local-variable #'stringp)
(defcustom verilog-auto-arg-format 'packed
"Formatting to use for AUTOARG signal names.
@@ -1150,7 +1170,7 @@ it's bad practice to rely on order based instantiations
anyhow.
See also `verilog-auto-inst-sort'."
:group 'verilog-mode-auto
:type 'boolean)
-(put 'verilog-auto-arg-sort 'safe-local-variable 'verilog-booleanp)
+(put 'verilog-auto-arg-sort 'safe-local-variable #'verilog-booleanp)
(defcustom verilog-auto-inst-dot-name nil
"Non-nil means when creating ports with AUTOINST, use .name syntax.
@@ -1160,7 +1180,7 @@ simulators. Setting `verilog-auto-inst-vector' to nil
may also
be desirable to increase how often .name will be used."
:group 'verilog-mode-auto
:type 'boolean)
-(put 'verilog-auto-inst-dot-name 'safe-local-variable 'verilog-booleanp)
+(put 'verilog-auto-inst-dot-name 'safe-local-variable #'verilog-booleanp)
(defcustom verilog-auto-inst-param-value nil
"Non-nil means AUTOINST will replace parameters with the parameter value.
@@ -1227,7 +1247,7 @@ This second expansion of parameter types can be
overridden with
`verilog-auto-inst-param-value-type'."
:group 'verilog-mode-auto
:type 'boolean)
-(put 'verilog-auto-inst-param-value 'safe-local-variable 'verilog-booleanp)
+(put 'verilog-auto-inst-param-value 'safe-local-variable #'verilog-booleanp)
(defcustom verilog-auto-inst-param-value-type t
"Non-nil means expand parameter type in instantiations.
@@ -1237,7 +1257,7 @@ See `verilog-auto-inst-param-value'."
:version "25.1"
:group 'verilog-mode-auto
:type 'boolean)
-(put 'verilog-auto-inst-param-value-type 'safe-local-variable
'verilog-booleanp)
+(put 'verilog-auto-inst-param-value-type 'safe-local-variable
#'verilog-booleanp)
(defcustom verilog-auto-inst-sort nil
"Non-nil means AUTOINST signals will be sorted, not in declaration order.
@@ -1250,7 +1270,7 @@ See also `verilog-auto-arg-sort'."
:version "24.1" ; rev688
:group 'verilog-mode-auto
:type 'boolean)
-(put 'verilog-auto-inst-sort 'safe-local-variable 'verilog-booleanp)
+(put 'verilog-auto-inst-sort 'safe-local-variable #'verilog-booleanp)
(defcustom verilog-auto-inst-vector t
"True means when creating default ports with AUTOINST, use bus subscripts.
@@ -1292,48 +1312,48 @@ to a net with the same name as the port."
:version "28.0"
:group 'verilog-mode-auto
:type 'boolean)
-(put 'verilog-auto-inst-template-required 'safe-local-variable
'verilog-booleanp)
+(put 'verilog-auto-inst-template-required 'safe-local-variable
#'verilog-booleanp)
(defcustom verilog-auto-inst-column 40
"Indent-to column number for net name part of AUTOINST created pin."
:group 'verilog-mode-indent
:type 'integer)
-(put 'verilog-auto-inst-column 'safe-local-variable 'integerp)
+(put 'verilog-auto-inst-column 'safe-local-variable #'integerp)
(defcustom verilog-auto-inst-interfaced-ports nil
"Non-nil means include interfaced ports in AUTOINST expansions."
:version "24.3" ; rev773, default change rev815
:group 'verilog-mode-auto
:type 'boolean)
-(put 'verilog-auto-inst-interfaced-ports 'safe-local-variable
'verilog-booleanp)
+(put 'verilog-auto-inst-interfaced-ports 'safe-local-variable
#'verilog-booleanp)
(defcustom verilog-auto-input-ignore-regexp nil
"If non-nil, when creating AUTOINPUT, ignore signals matching this regexp.
See the \\[verilog-faq] for examples on using this."
:group 'verilog-mode-auto
:type '(choice (const nil) regexp))
-(put 'verilog-auto-input-ignore-regexp 'safe-local-variable 'stringp)
+(put 'verilog-auto-input-ignore-regexp 'safe-local-variable #'stringp)
(defcustom verilog-auto-reg-input-assigned-ignore-regexp nil
"If non-nil, when creating AUTOINPUTREG, ignore signals matching this
regexp."
:version "27.1"
:group 'verilog-mode-auto
:type '(choice (const nil) regexp))
-(put 'verilog-auto-reg-input-assigned-ignore-regexp 'safe-local-variable
'stringp)
+(put 'verilog-auto-reg-input-assigned-ignore-regexp 'safe-local-variable
#'stringp)
(defcustom verilog-auto-inout-ignore-regexp nil
"If non-nil, when creating AUTOINOUT, ignore signals matching this regexp.
See the \\[verilog-faq] for examples on using this."
:group 'verilog-mode-auto
:type '(choice (const nil) regexp))
-(put 'verilog-auto-inout-ignore-regexp 'safe-local-variable 'stringp)
+(put 'verilog-auto-inout-ignore-regexp 'safe-local-variable #'stringp)
(defcustom verilog-auto-output-ignore-regexp nil
"If non-nil, when creating AUTOOUTPUT, ignore signals matching this regexp.
See the \\[verilog-faq] for examples on using this."
:group 'verilog-mode-auto
:type '(choice (const nil) regexp))
-(put 'verilog-auto-output-ignore-regexp 'safe-local-variable 'stringp)
+(put 'verilog-auto-output-ignore-regexp 'safe-local-variable #'stringp)
(defcustom verilog-auto-template-warn-unused nil
"Non-nil means report warning if an AUTO_TEMPLATE line is not used.
@@ -1341,7 +1361,7 @@ This feature is not supported before Emacs 21.1 or XEmacs
21.4."
:version "24.3" ; rev787
:group 'verilog-mode-auto
:type 'boolean)
-(put 'verilog-auto-template-warn-unused 'safe-local-variable 'verilog-booleanp)
+(put 'verilog-auto-template-warn-unused 'safe-local-variable
#'verilog-booleanp)
(defcustom verilog-auto-tieoff-declaration "wire"
"Data type used for the declaration for AUTOTIEOFF.
@@ -1350,21 +1370,21 @@ assignment, else the data type for variable creation."
:version "24.1" ; rev713
:group 'verilog-mode-auto
:type 'string)
-(put 'verilog-auto-tieoff-declaration 'safe-local-variable 'stringp)
+(put 'verilog-auto-tieoff-declaration 'safe-local-variable #'stringp)
(defcustom verilog-auto-tieoff-ignore-regexp nil
"If non-nil, when creating AUTOTIEOFF, ignore signals matching this regexp.
See the \\[verilog-faq] for examples on using this."
:group 'verilog-mode-auto
:type '(choice (const nil) regexp))
-(put 'verilog-auto-tieoff-ignore-regexp 'safe-local-variable 'stringp)
+(put 'verilog-auto-tieoff-ignore-regexp 'safe-local-variable #'stringp)
(defcustom verilog-auto-unused-ignore-regexp nil
"If non-nil, when creating AUTOUNUSED, ignore signals matching this regexp.
See the \\[verilog-faq] for examples on using this."
:group 'verilog-mode-auto
:type '(choice (const nil) regexp))
-(put 'verilog-auto-unused-ignore-regexp 'safe-local-variable 'stringp)
+(put 'verilog-auto-unused-ignore-regexp 'safe-local-variable #'stringp)
(defcustom verilog-case-fold t
"Non-nil means `verilog-mode' regexps should ignore case.
@@ -1372,7 +1392,7 @@ This variable is t for backward compatibility; nil is
suggested."
:version "24.4"
:group 'verilog-mode
:type 'boolean)
-(put 'verilog-case-fold 'safe-local-variable 'verilog-booleanp)
+(put 'verilog-case-fold 'safe-local-variable #'verilog-booleanp)
(defcustom verilog-typedef-regexp nil
"If non-nil, regular expression that matches Verilog-2001 typedef names.
@@ -1380,9 +1400,9 @@ For example, \"_t$\" matches typedefs named with _t, as
in the C language.
See also `verilog-case-fold'."
:group 'verilog-mode-auto
:type '(choice (const nil) regexp))
-(put 'verilog-typedef-regexp 'safe-local-variable 'stringp)
+(put 'verilog-typedef-regexp 'safe-local-variable #'stringp)
-(defcustom verilog-mode-hook 'verilog-set-compile-command
+(defcustom verilog-mode-hook (list #'verilog-set-compile-command)
"Hook run after Verilog mode is loaded."
:type 'hook
:group 'verilog-mode)
@@ -2035,17 +2055,25 @@ be substituted."
(set (make-local-variable 'verilog-compile-command-post-mod)
compile-command))))
-(if (featurep 'xemacs)
+(when (featurep 'xemacs)
+ (defvar compilation-error-regexp-systems-alist)
+ (if (not (and (= emacs-major-version 21) (<= emacs-minor-version 4)))
+ ;; XEmacs 21.5 and newer match GNU, see bug1700
+ (defun verilog-error-regexp-add-xemacs ()
+ (interactive)
+ (verilog-error-regexp-add-xemacs))
+ ;; XEmacs 21.4 and older
;; Following code only gets called from compilation-mode-hook on XEmacs to
add error handling.
(defun verilog-error-regexp-add-xemacs ()
- "Teach XEmacs about verilog errors.
+ "Teach XEmacs about Verilog errors.
Called by `compilation-mode-hook'. This allows \\[next-error] to
find the errors."
(interactive)
(if (boundp 'compilation-error-regexp-systems-alist)
(if (and
(not (equal compilation-error-regexp-systems-list 'all))
- (not (member compilation-error-regexp-systems-list 'verilog)))
+ ;; eval required due to bug1700, XEmacs otherwise errors on
compile
+ (not (eval "(member compilation-error-regexp-systems-list
'verilog)")))
(push 'verilog compilation-error-regexp-systems-list)))
(if (boundp 'compilation-error-regexp-alist-alist)
(if (not (assoc 'verilog compilation-error-regexp-alist-alist))
@@ -2060,7 +2088,7 @@ find the errors."
;; Need to re-run compilation-error-regexp builder
(if (fboundp 'compilation-build-compilation-error-regexp-alist)
(compilation-build-compilation-error-regexp-alist))
- ))
+ )))
;; Following code only gets called from compilation-mode-hook on Emacs to add
error handling.
(defun verilog-error-regexp-add-emacs ()
@@ -2076,8 +2104,10 @@ find the errors."
(push item compilation-error-regexp-alist-alist))
verilog-error-regexp-emacs-alist))))
-(if (featurep 'xemacs) (add-hook 'compilation-mode-hook
'verilog-error-regexp-add-xemacs))
-(if (featurep 'emacs) (add-hook 'compilation-mode-hook
'verilog-error-regexp-add-emacs))
+(add-hook 'compilation-mode-hook
+ (if (featurep 'xemacs)
+ #'verilog-error-regexp-add-xemacs
+ #'verilog-error-regexp-add-emacs))
(defconst verilog-compiler-directives
(eval-when-compile
@@ -2285,7 +2315,8 @@ find the errors."
"`ovm_update_sequence_lib_and_item"
"`ovm_warning"
"`static_dut_error"
- "`static_message") nil )))
+ "`static_message")
+ nil )))
(defconst verilog-uvm-statement-re
(eval-when-compile
@@ -2424,7 +2455,8 @@ find the errors."
"`uvm_update_sequence_lib" ; Deprecated in 1.1
"`uvm_update_sequence_lib_and_item" ; Deprecated in 1.1
"`uvm_warning"
- "`uvm_warning_context") nil )))
+ "`uvm_warning_context")
+ nil )))
;;
@@ -2566,10 +2598,10 @@ find the errors."
"\\(property\\)\\|" ; 16
"\\(connectmodule\\)\\|" ; 17
"\\)\\>\\)"))
+
(defconst verilog-end-block-re
(eval-when-compile
(verilog-regexp-words
-
'("end" ; closes begin
"endcase" ; closes any of case, casex casez or randcase
"join" "join_any" "join_none" ; closes fork
@@ -2606,7 +2638,6 @@ find the errors."
"`vmm_xactor_member_end"
))))
-
(defconst verilog-endcomment-reason-re
;; Parenthesis indicate type of keyword found
(concat
@@ -2775,6 +2806,8 @@ find the errors."
"shortreal" "real" "realtime"
;; net_type
"supply0" "supply1" "tri" "triand" "trior" "trireg" "tri0" "tri1"
"uwire" "wire" "wand" "wor"
+ ;; parameters
+ "localparam" "parameter" "var"
;; misc
"string" "event" "chandle" "virtual" "enum" "genvar"
"struct" "union"
@@ -3310,13 +3343,20 @@ See also `verilog-font-lock-extra-types'.")
'("\\<function\\>\\s-+\\(\\sw+\\)"
1 'font-lock-constant-face append)
;; Fontify variable names in declarations
- (list ;; Implemented as an anchored-matcher
- (concat verilog-declaration-re
- " *\\(" verilog-range-re "\\)?")
- (list ;; anchored-highlighter
- (concat "\\_<\\(" verilog-symbol-re "\\)"
- " *\\(" verilog-range-re "\\)?*")
- nil nil '(1 font-lock-variable-name-face))))))
+ (list
+ verilog-declaration-re
+ (list
+ ;; Anchored matcher (lookup Search-Based Fontification)
+ 'verilog-declaration-varname-matcher
+ ;; Pre-form for this anchored matcher:
+ ;; First, avoid declaration keywords written in comments,
+ ;; which can also trigger this anchor.
+ '(if (not (verilog-in-comment-p))
+ (verilog-single-declaration-end
verilog-highlight-max-lookahead)
+ (point)) ;; => current declaration statement is of 0
length
+ nil ;; Post-form: nothing to be done
+ '(0 font-lock-variable-name-face t t)))
+ )))
(setq verilog-font-lock-keywords-2
@@ -3402,7 +3442,7 @@ For insignificant changes, see instead
`verilog-save-buffer-state'."
(verilog-run-hooks 'verilog-before-save-font-hook)
(let* ((verilog-save-font-mod-hooked (- (point-max) (point-min)))
;; Significant speed savings with no font-lock properties
- (fontlocked (when (and (boundp 'font-lock-mode) font-lock-mode)
+ (fontlocked (when font-lock-mode
(font-lock-mode 0)
t)))
(run-hook-with-args 'before-change-functions (point-min) (point-max))
@@ -3564,6 +3604,87 @@ inserted using a single call to `verilog-insert'."
(defun verilog-declaration-end ()
(search-forward ";"))
+(defun verilog-single-declaration-end (limit)
+ "Returns pos where current (single) declaration statement ends.
+Also, this function moves POINT forward to the start of a variable name
+(skipping the range-part and whitespace).
+Function expected to be called with POINT just after a declaration keyword.
+LIMIT sets the max POINT for searching and moving to. No such limit if LIMIT
+is 0.
+
+Meaning of *single* declaration:
+ Eg. In a module's port-list -
+ module test(input clk, rst, x, output [1:0] y);
+ Here 'input clk, rst, x' is 1 *single* declaration statement,
+and 'output [1:0] y' is the other single declaration. In the 1st single
+declaration, POINT is moved to start of 'clk'. And in the 2nd declaration,
+POINT is moved to 'y'."
+
+
+ (let (maxpoint old-point)
+ ;; maxpoint = min(curr-point + limit, buffer-size)
+ (setq maxpoint (if (eq limit 0)
+ (point-max) ;; no bounds if search-bound is zero
+ (+ (point) limit)))
+ (if (> maxpoint (buffer-size)) (setq maxpoint (buffer-size)))
+
+ ;; Skip comment - range - comment
+ (verilog-forward-ws&directives maxpoint)
+ (when (eq (char-after) ?\[)
+ (re-search-forward verilog-range-re maxpoint t))
+ (verilog-forward-ws&directives maxpoint)
+
+ ;; Move forward until a delimiter is reached which marks end of current
+ ;; single declaration. Return point at found delimiter
+ (save-excursion
+ (while (and (< (point) maxpoint)
+ (not (eq old-point (point)))
+ (not (eq (char-after) ?\; ))
+ (not (eq (char-after) ?\) ))
+ (not (looking-at verilog-declaration-re)))
+ (setq old-point (point))
+ (ignore-errors
+ (forward-sexp)
+ (verilog-forward-ws&directives maxpoint)
+ (when (eq (char-after) ?,)
+ (forward-char)
+ (verilog-forward-ws&directives maxpoint))))
+ (point))))
+
+(defun verilog-declaration-varname-matcher (limit)
+ "Match first variable name b/w POINT & LIMIT, move POINT to next variable.
+Expected to be called within a declaration statement, with POINT already beyond
+the declaration keyword and range ([a:b])
+This function moves POINT to the next variable within the same declaration (if
+it exists).
+LIMIT is expected to be the pos at which current single-declaration ends,
+obtained using `verilog-single-declaration-end'."
+
+ (let (found-var old-point)
+
+ ;; Remove starting whitespace
+ (verilog-forward-ws&directives limit)
+
+ (when (< (point) limit) ;; no matching if this is violated
+
+ ;; Find the variable name (match-data is set here)
+ (setq found-var (re-search-forward verilog-symbol-re limit t))
+
+ ;; Walk to this variable's delimiter
+ (save-match-data
+ (verilog-forward-ws&directives limit)
+ (setq old-point nil)
+ (while (and (< (point) limit)
+ (not (member (char-after) '(?, ?\) ?\;)))
+ (not (eq old-point (point))))
+ (setq old-point (point))
+ (verilog-forward-ws&directives limit)
+ (forward-sexp)
+ (verilog-forward-ws&directives limit))
+ ;; Only a comma or semicolon expected at this point
+ (skip-syntax-forward "."))
+ found-var)))
+
(defun verilog-point-text (&optional pointnum)
"Return text describing where POINTNUM or current point is (for errors).
Use filename, if current buffer being edited shorten to just buffer name."
@@ -3934,13 +4055,13 @@ Key bindings specific to `verilog-mode-map' are:
\\{verilog-mode-map}"
:abbrev-table verilog-mode-abbrev-table
(set (make-local-variable 'beginning-of-defun-function)
- 'verilog-beg-of-defun)
+ #'verilog-beg-of-defun)
(set (make-local-variable 'end-of-defun-function)
- 'verilog-end-of-defun)
+ #'verilog-end-of-defun)
(set-syntax-table verilog-mode-syntax-table)
(set (make-local-variable 'indent-line-function)
#'verilog-indent-line-relative)
- (set (make-local-variable 'comment-indent-function) 'verilog-comment-indent)
+ (set (make-local-variable 'comment-indent-function) #'verilog-comment-indent)
(set (make-local-variable 'parse-sexp-ignore-comments) nil)
(set (make-local-variable 'comment-start) "// ")
(set (make-local-variable 'comment-end) "")
@@ -3951,7 +4072,7 @@ Key bindings specific to `verilog-mode-map' are:
(setq verilog-tool 'verilog-linter)
(verilog-set-compile-command)
(when (boundp 'hack-local-variables-hook) ; Also modify any
file-local-variables
- (add-hook 'hack-local-variables-hook 'verilog-modify-compile-command t))
+ (add-hook 'hack-local-variables-hook #'verilog-modify-compile-command t))
;; Setting up menus
(when (featurep 'xemacs)
@@ -3973,6 +4094,10 @@ Key bindings specific to `verilog-mode-map' are:
;; verilog-beg-of-defun.
nil
'verilog-beg-of-defun)))
+
+ ;; Stuff for multiline font-lock
+ (set (make-local-variable 'font-lock-multiline) t)
+
;;------------------------------------------------------------
;; now hook in 'verilog-highlight-include-files (eldo-mode.el&spice-mode.el)
;; all buffer local:
@@ -3981,9 +4106,9 @@ Key bindings specific to `verilog-mode-map' are:
(make-local-hook 'font-lock-mode-hook)
(make-local-hook 'font-lock-after-fontify-buffer-hook); doesn't exist in
Emacs
(make-local-hook 'after-change-functions))
- (add-hook 'font-lock-mode-hook 'verilog-highlight-buffer t t)
- (add-hook 'font-lock-after-fontify-buffer-hook 'verilog-highlight-buffer t
t) ; not in Emacs
- (add-hook 'after-change-functions 'verilog-highlight-region t t))
+ (add-hook 'font-lock-mode-hook #'verilog-highlight-buffer t t)
+ (add-hook 'font-lock-after-fontify-buffer-hook #'verilog-highlight-buffer
t t) ; not in Emacs
+ (add-hook 'after-change-functions #'verilog-highlight-region t t))
;; Tell imenu how to handle Verilog.
(set (make-local-variable 'imenu-generic-expression)
@@ -4005,7 +4130,7 @@ Key bindings specific to `verilog-mode-map' are:
;; Stuff for autos
(add-hook (if (boundp 'write-contents-hooks) 'write-contents-hooks
'write-contents-functions) ; Emacs >= 22.1
- 'verilog-auto-save-check nil 'local)
+ #'verilog-auto-save-check nil 'local)
;; verilog-mode-hook call added by define-derived-mode
)
@@ -5410,7 +5535,7 @@ FILENAME to find directory to run in, or defaults to
`buffer-file-name'."
default nil nil
'verilog-preprocess-history default)))))
(unless command (setq command (verilog-expand-command verilog-preprocessor)))
- (let* ((fontlocked (and (boundp 'font-lock-mode) font-lock-mode))
+ (let* ((fontlocked font-lock-mode)
(dir (file-name-directory (or filename buffer-file-name)))
(cmd (concat "cd " dir "; " command)))
(with-output-to-temp-buffer "*Verilog-Preprocessed*"
@@ -5424,22 +5549,23 @@ FILENAME to find directory to run in, or defaults to
`buffer-file-name'."
;; We should use font-lock-ensure in preference to
;; font-lock-fontify-buffer, but IIUC the problem this is supposed to
;; solve only appears in Emacsen older than font-lock-ensure anyway.
- ;; So avoid bytecomp's interactive-only by going through intern.
- (when fontlocked (funcall (intern "font-lock-fontify-buffer"))))))))
+ (when fontlocked
+ (verilog--supressed-warnings
+ ((interactive-only font-lock-fontify-buffer))
+ (font-lock-fontify-buffer))))))))
;;; Batch:
;;
(defun verilog-warn (string &rest args)
"Print a warning with `format' using STRING and optional ARGS."
- (apply 'message (concat "%%Warning: " string) args))
+ (apply #'message (concat "%%Warning: " string) args))
(defun verilog-warn-error (string &rest args)
"Call `error' using STRING and optional ARGS.
If `verilog-warn-fatal' is non-nil, call `verilog-warn' instead."
- (if verilog-warn-fatal
- (apply 'error string args)
- (apply 'verilog-warn string args)))
+ (apply (if verilog-warn-fatal #'error #'verilog-warn)
+ string args))
(defmacro verilog-batch-error-wrapper (&rest body)
"Execute BODY and add error prefix to any errors found.
@@ -6452,6 +6578,7 @@ Return >0 for nested struct."
(let ((p (point)))
(and
(equal (char-after) ?\{)
+ (not (verilog-at-streaming-op-p))
(ignore-errors (forward-list))
(progn (backward-char 1)
(verilog-backward-ws&directives)
@@ -6489,6 +6616,18 @@ Return >0 for nested struct."
;; not
nil))
+(defconst verilog-streaming-op-re
+ ;; Regexp to detect Streaming Operator expressions
+ (concat
+ "{" "\\s-*"
+ "\\(<<\\|>>\\)" ".*"
+ "{" ".*" "}" "\\s-*" "}"
+ ))
+
+(defun verilog-at-streaming-op-p ()
+ "If at the { of a streaming operator, return t."
+ (looking-at verilog-streaming-op-re))
+
(defun verilog-at-struct-p ()
"If at the { of a struct, return true, not moving point."
(save-excursion
@@ -7961,6 +8100,8 @@ See also `verilog-sk-header' for an alternative format."
;; Unfortunately we use 'assoc' on this, so can't be a vector
(defsubst verilog-sig-new (name bits comment mem enum signed type multidim
modport)
(list name bits comment mem enum signed type multidim modport))
+(defsubst verilog-sig-new-renamed (name old-sig)
+ (cons name (cdr old-sig)))
(defsubst verilog-sig-name (sig)
(car sig))
(defsubst verilog-sig-bits (sig) ; First element of packed array (pre
signal-name)
@@ -8315,7 +8456,7 @@ Tieoff value uses `verilog-active-low-regexp' and
(t
(let* ((width (verilog-sig-width sig)))
(cond ((not width)
- "`0/*NOWIDTH*/")
+ "'0/*NOWIDTH*/")
((string-match "^[0-9]+$" width)
(concat width (if (verilog-sig-signed sig) "'sh0" "'h0")))
(t
@@ -8497,9 +8638,25 @@ Optional NUM-PARAM and MAX-PARAM check for a specific
number of parameters."
(error "%s: Expected <= %d parameters" (verilog-point-text) max-param))
(nreverse olist)))
+;; Prevent compile warnings; these are let's, not globals.
+(defvar sigs-in)
+(defvar sigs-inout)
+(defvar sigs-intf)
+(defvar sigs-intfd)
+(defvar sigs-out)
+(defvar sigs-out-d)
+(defvar sigs-out-i)
+(defvar sigs-out-unk)
+(defvar sigs-temp)
+;; These are known to be from other packages and may not be defined
+(defvar diff-command)
+;; There are known to be from newer versions of Emacs
+(defvar create-lockfiles)
+(defvar which-func-modes)
+
(defun verilog-read-decls ()
"Compute signal declaration information for the current module at point.
-Return an array of [outputs inouts inputs wire reg assign const]."
+Return an array of [outputs inouts inputs wire reg assign const gparam intf]."
(let ((end-mod-point (or (verilog-get-end-of-defun) (point-max)))
(functask 0) (paren 0) (sig-paren 0) (v2kargs-ok t)
in-modport in-clocking in-ign-to-semi ptype ign-prop
@@ -8777,25 +8934,6 @@ Return an array of [outputs inouts inputs wire reg
assign const]."
(defvar verilog-read-sub-decls-gate-ios nil
"For `verilog-read-sub-decls', gate IO pins remaining, nil if
non-primitive.")
-(eval-when-compile
- ;; Prevent compile warnings; these are let's, not globals
- ;; Do not remove the eval-when-compile
- ;; - we want an error when we are debugging this code if they are refed.
- (defvar sigs-in)
- (defvar sigs-inout)
- (defvar sigs-intf)
- (defvar sigs-intfd)
- (defvar sigs-out)
- (defvar sigs-out-d)
- (defvar sigs-out-i)
- (defvar sigs-out-unk)
- (defvar sigs-temp)
- ;; These are known to be from other packages and may not be defined
- (defvar diff-command)
- ;; There are known to be from newer versions of Emacs
- (defvar create-lockfiles)
- (defvar which-func-modes))
-
(defun verilog-read-sub-decls-type (par-values portdata)
"For `verilog-read-sub-decls-line', decode a signal type."
(let* ((type (verilog-sig-type portdata))
@@ -8894,7 +9032,8 @@ Return an array of [outputs inouts inputs wire reg assign
const]."
"For `verilog-read-sub-decls-line', parse a subexpression and add signals."
;;(message "vrsde: `%s'" expr)
;; Replace special /*[....]*/ comments inserted by verilog-auto-inst-port
- (setq expr (verilog-string-replace-matches "/\\*\\(\\.?\\[[^*]+\\]\\)\\*/"
"\\1" nil nil expr))
+ (setq expr (verilog-string-replace-matches
+ "/\\*\\(\\.?\\[\\([^*]+\\|[*][^/]\\)+\\]\\)\\*/" "\\1" nil nil
expr))
;; Remove front operators
(setq expr (verilog-string-replace-matches "^\\s-*[---+~!|&]+\\s-*" "" nil
nil expr))
;;
@@ -9809,10 +9948,10 @@ Use DEFAULT-DIR to anchor paths if non-nil."
"Convert `verilog-library-flags' into standard library variables."
;; If the flags are local, then all the outputs should be local also
(when (local-variable-p 'verilog-library-flags (current-buffer))
- (mapc 'make-local-variable '(verilog-library-extensions
- verilog-library-directories
- verilog-library-files
- verilog-library-flags)))
+ (mapc #'make-local-variable '(verilog-library-extensions
+ verilog-library-directories
+ verilog-library-files
+ verilog-library-flags)))
;; Allow user to customize
(verilog-run-hooks 'verilog-before-getopt-flags-hook)
;; Process arguments
@@ -10017,7 +10156,7 @@ Or, just the existing dirnames themselves if there are
no wildcards."
(setq dirnames (reverse dirnames)) ; not nreverse
(let ((dirlist nil)
pattern dirfile dirfiles dirname root filename rest basefile)
- (setq dirnames (mapcar 'substitute-in-file-name dirnames))
+ (setq dirnames (mapcar #'substitute-in-file-name dirnames))
(while dirnames
(setq dirname (car dirnames)
dirnames (cdr dirnames))
@@ -10210,7 +10349,7 @@ Return modi if successful, else print message unless
IGNORE-ERROR is true."
(if (not (equal module realname))
(concat " (Expanded macro to " realname ")")
"")
- (mapconcat 'concat orig-filenames "\n\t")))
+ (mapconcat #'concat orig-filenames "\n\t")))
(when (eval-when-compile (fboundp 'make-hash-table))
(unless verilog-modi-lookup-cache
(setq verilog-modi-lookup-cache
@@ -10348,42 +10487,47 @@ those clocking block's signals."
(defun verilog-signals-matching-enum (in-list enum)
"Return all signals in IN-LIST matching the given ENUM."
(let (out-list)
- (while in-list
- (if (equal (verilog-sig-enum (car in-list)) enum)
- (setq out-list (cons (car in-list) out-list)))
- (setq in-list (cdr in-list)))
+ (dolist (sig in-list)
+ (if (equal (verilog-sig-enum sig) enum)
+ (push sig out-list)))
;; New scheme
;; Namespace intentionally short for AUTOs and compatibility
- (let* ((enumvar (intern (concat "venum-" enum)))
- (enumlist (and (boundp enumvar) (eval enumvar))))
- (while enumlist
- (add-to-list 'out-list (list (car enumlist)))
- (setq enumlist (cdr enumlist))))
+ (let* ((enumvar (intern (concat "venum-" enum))))
+ (dolist (en (and (boundp enumvar) (eval enumvar)))
+ (let ((sig (list en)))
+ (unless (member sig out-list)
+ (push sig out-list)))))
(nreverse out-list)))
(defun verilog-signals-matching-regexp (in-list regexp)
- "Return all signals in IN-LIST matching the given REGEXP, if non-nil."
+ "Return all signals in IN-LIST matching the given REGEXP, if non-nil.
+Allow regexp inversion if REGEXP begins with ?!."
(if (or (not regexp) (equal regexp ""))
in-list
- (let ((case-fold-search verilog-case-fold)
- out-list)
- (while in-list
- (if (string-match regexp (verilog-sig-name (car in-list)))
- (setq out-list (cons (car in-list) out-list)))
- (setq in-list (cdr in-list)))
- (nreverse out-list))))
+ (if (string-match "^\\?!" regexp)
+ (verilog-signals-not-matching-regexp in-list (substring regexp 2))
+ (let ((case-fold-search verilog-case-fold)
+ out-list)
+ (while in-list
+ (if (string-match regexp (verilog-sig-name (car in-list)))
+ (setq out-list (cons (car in-list) out-list)))
+ (setq in-list (cdr in-list)))
+ (nreverse out-list)))))
(defun verilog-signals-not-matching-regexp (in-list regexp)
- "Return all signals in IN-LIST not matching the given REGEXP, if non-nil."
+ "Return all signals in IN-LIST not matching the given REGEXP, if non-nil.
+Allow regexp inversion if REGEXP begins with ?!."
(if (or (not regexp) (equal regexp ""))
in-list
- (let ((case-fold-search verilog-case-fold)
- out-list)
- (while in-list
- (if (not (string-match regexp (verilog-sig-name (car in-list))))
- (setq out-list (cons (car in-list) out-list)))
- (setq in-list (cdr in-list)))
- (nreverse out-list))))
+ (if (string-match "^\\?!" regexp)
+ (verilog-signals-matching-regexp in-list (substring regexp 2))
+ (let ((case-fold-search verilog-case-fold)
+ out-list)
+ (while in-list
+ (if (not (string-match regexp (verilog-sig-name (car in-list))))
+ (setq out-list (cons (car in-list) out-list)))
+ (setq in-list (cdr in-list)))
+ (nreverse out-list)))))
(defun verilog-signals-matching-dir-re (in-list decl-type regexp)
"Return all signals in IN-LIST matching the given DECL-TYPE and REGEXP,
@@ -10396,7 +10540,7 @@ if non-nil."
(setq to-match (concat
decl-type
" " (verilog-sig-signed (car in-list))
- " " (verilog-sig-multidim (car in-list))
+ " " (verilog-sig-multidim-string (car in-list))
(verilog-sig-bits (car in-list))))
(if (string-match regexp to-match)
(setq out-list (cons (car in-list) out-list)))
@@ -10410,6 +10554,20 @@ if non-nil."
(verilog-sig-type-set sig nil))
sig) in-list))
+(defun verilog-signals-add-prefix (in-list prefix)
+ "Return all signals in IN-LIST with PREFIX added."
+ (if (or (not prefix) (equal prefix ""))
+ in-list
+ (let (out-list)
+ (while in-list
+ (setq out-list (cons (verilog-sig-new-renamed
+ (concat prefix (verilog-sig-name (car in-list)))
+ (car in-list))
+ out-list))
+ (setq in-list (cdr in-list)))
+ (nreverse out-list))))
+;(verilog-signals-add-prefix (list (list "foo" "...") (list "bar" "...")) "p_")
+
;; Combined
(defun verilog-decls-get-signals (decls)
"Return all declared signals in DECLS, excluding `assign' statements."
@@ -10450,7 +10608,7 @@ if non-nil."
;;
(defun verilog-auto-re-search-do (search-for func)
- "Search for given auto text regexp SEARCH-FOR, and perform FUNC where it
occurs."
+ "Given start brace BRA, and end brace KET, expand one line into many lines."
(goto-char (point-min))
(while (verilog-re-search-forward-quick search-for nil t)
(funcall func)))
@@ -10540,9 +10698,7 @@ When MODI is non-null, also add to modi-cache, for
tracking."
(verilog-insert "// " (verilog-sig-comment sig) "\n"))
(setq sigs (cdr sigs)))))
-(eval-when-compile
- (if (not (boundp 'indent-pt))
- (defvar indent-pt nil "Local used by `verilog-insert-indent'.")))
+(defvar indent-pt) ;; Local used by `verilog-insert-indent'.
(defun verilog-insert-indent (&rest stuff)
"Indent to position stored in local `indent-pt' variable, then insert STUFF.
@@ -10649,11 +10805,15 @@ This repairs those mis-inserted by an AUTOARG."
(match-string 3 out))
nil nil out)))
;; For precedence do *,/ before +,-,>>,<<
- (while (string-match
- (concat "\\([[({:*/<>+-]\\)"
- "\\([0-9]+\\)\\s *\\([*/]\\)\\s *\\([0-9]+\\)"
- "\\([])}:*/<>+-]\\)")
- out)
+ (while (and
+ (string-match
+ (concat "\\([[({:*/<>+-]\\)"
+ "\\([0-9]+\\)\\s *\\([*/]\\)\\s *\\([0-9]+\\)"
+ "\\([])}:*/<>+-]\\)")
+ out)
+ (not (and (equal (match-string 3 out) "/")
+ (not (equal 0 (% (string-to-number (match-string 2
out))
+ (string-to-number (match-string 4
out))))))))
(setq out (replace-match
(concat (match-string 1 out)
(if (equal (match-string 3 out) "/")
@@ -10725,6 +10885,7 @@ This repairs those mis-inserted by an AUTOARG."
;;(verilog-simplify-range-expression "[(TEST[1])-1:0]")
;;(verilog-simplify-range-expression "[1<<2:8>>2]") ; [4:2]
;;(verilog-simplify-range-expression "[2*4/(4-2) +2+4 <<4 >>2]")
+;;(verilog-simplify-range-expression "[WIDTH*2/8-1:0]")
(defun verilog-clog2 (value)
"Compute $clog2 - ceiling log2 of VALUE."
@@ -11336,6 +11497,8 @@ making verification modules that connect to UVM
interfaces.
The optional fourth parameter is a regular expression, and only
signals matching the regular expression will be included.
+ The optional fifth parameter is a prefix to add to the signals.
+
Limitations:
Interface names must be resolvable to filenames. See `verilog-auto-inst'.
@@ -11349,11 +11512,12 @@ Limitations:
See the example in `verilog-auto-inout-modport'."
(save-excursion
- (let* ((params (verilog-read-auto-params 3 4))
+ (let* ((params (verilog-read-auto-params 3 5))
(submod (nth 0 params))
(modport-re (nth 1 params))
(inst-name (nth 2 params))
(regexp (nth 3 params))
+ (prefix (nth 4 params))
direction-re submodi) ; direction argument not supported until
requested
;; Lookup position, etc of co-module
;; Note this may raise an error
@@ -11387,15 +11551,18 @@ See the example in `verilog-auto-inout-modport'."
;; Don't sort them so an upper AUTOINST will match the main module
(let ((sigs sig-list-o))
(while sigs
- (verilog-insert-indent "assign " (verilog-sig-name (car sigs))
- " = " inst-name
- "." (verilog-sig-name (car sigs)) ";\n")
+ (verilog-insert-indent "assign "
+ (concat prefix (verilog-sig-name (car
sigs)))
+ " = " inst-name
+ "." (verilog-sig-name (car sigs)) ";\n")
(setq sigs (cdr sigs))))
(let ((sigs sig-list-i))
(while sigs
- (verilog-insert-indent "assign " inst-name
- "." (verilog-sig-name (car sigs))
- " = " (verilog-sig-name (car sigs))
";\n")
+ (verilog-insert-indent "assign " inst-name
+ "." (verilog-sig-name (car sigs))
+ " = "
+ (concat prefix (verilog-sig-name (car
sigs)))
+ ";\n")
(setq sigs (cdr sigs))))
(verilog-insert-indent "// End of automatics\n")))))))
@@ -11611,7 +11778,9 @@ declaration with ones automatically derived from the
module or
interface header of the instantiated item.
You may also provide an optional regular expression, in which
-case only I/O matching the regular expression will be included.
+case only I/O matching the regular expression will be included,
+or excluded if the regexp begins with ?! (question-mark
+exclamation-mark).
If `verilog-auto-star-expand' is set, also expand SystemVerilog .* ports,
and delete them before saving unless `verilog-auto-star-save' is set.
@@ -12047,7 +12216,8 @@ automatically derived from the module header of the
instantiated netlist.
You may also provide an optional regular expression, in which
case only parameters matching the regular expression will be
-included.
+included, or excluded if the regexp begins with ?! (question-mark
+exclamation-mark).
See \\[verilog-auto-inst] for limitations, and templates to customize the
output.
@@ -12466,9 +12636,11 @@ Typing \\[verilog-auto] will make this into:
wire o = tempb;
endmodule
-You may also provide an optional regular expression, in which case only
-signals matching the regular expression will be included. For example the
-same expansion will result from only extracting outputs starting with ov:
+You may also provide an optional regular expression, in which
+case only signals matching the regular expression will be
+included,or excluded if the regexp begins with ?! (question-mark
+exclamation-mark). For example the same expansion will result
+from only extracting outputs starting with ov:
/*AUTOOUTPUTEVERY(\"^ov\")*/"
(save-excursion
@@ -12544,9 +12716,12 @@ Typing \\[verilog-auto] will make this into:
.i (i));
endmodule
-You may also provide an optional regular expression, in which case only
-signals matching the regular expression will be included. For example the
-same expansion will result from only extracting inputs starting with i:
+You may also provide an optional regular expression, in which
+case only signals matching the regular expression will be
+included. or excluded if the regexp begins with
+?! (question-mark exclamation-mark). For example the same
+expansion will result from only extracting inputs starting with
+i:
/*AUTOINPUT(\"^i\")*/"
(save-excursion
@@ -12628,9 +12803,11 @@ Typing \\[verilog-auto] will make this into:
.io (io));
endmodule
-You may also provide an optional regular expression, in which case only
-signals matching the regular expression will be included. For example the
-same expansion will result from only extracting inouts starting with i:
+You may also provide an optional regular expression, in which
+case only signals matching the regular expression will be
+included, or excluded if the regexp begins with ?! (question-mark
+exclamation-mark). For example the same expansion will result
+from only extracting inouts starting with i:
/*AUTOINOUT(\"^i\")*/"
(save-excursion
@@ -12711,9 +12888,11 @@ Typing \\[verilog-auto] will make this into:
// End of automatics
endmodule
-You may also provide an optional regular expression, in which case only
-signals matching the regular expression will be included. For example the
-same expansion will result from only extracting signals starting with i:
+You may also provide an optional regular expression, in which
+case only signals matching the regular expression will be
+included, or excluded if the regexp begins with ?! (question-mark
+exclamation-mark). For example the same expansion will result
+from only extracting signals starting with i:
/*AUTOINOUTMODULE(\"ExampMain\",\"^i\")*/
@@ -12919,9 +13098,11 @@ Typing \\[verilog-auto] will make this into:
// End of automatics
endmodule
-You may also provide an optional regular expression, in which case only
-signals matching the regular expression will be included. For example the
-same expansion will result from only extracting signals starting with i:
+You may also provide an optional regular expression, in which
+case only signals matching the regular expression will be
+included, or excluded if the regexp begins with ?! (question-mark
+exclamation-mark). For example the same expansion will result
+from only extracting signals starting with i:
/*AUTOINOUTIN(\"ExampMain\",\"^i\")*/"
(verilog-auto-inout-module nil t))
@@ -13009,6 +13190,8 @@ for making verification modules that connect to UVM
interfaces.
The optional third parameter is a regular expression, and only
signals matching the regular expression will be included.
+ The optional fourth parameter is a prefix to add to the signals.
+
Limitations:
If placed inside the parenthesis of a module declaration, it creates
Verilog 2001 style, else uses Verilog 1995 style.
@@ -13032,10 +13215,16 @@ An example:
modport mp(clocking mon_clkblk);
endinterface
+
module ExampMain
( input clk,
/*AUTOINOUTMODPORT(\"ExampIf\", \"mp\")*/
);
+
+ ExampleIf i;
+
+ /*AUTOASSIGNMODPORT(\"ExampIf\", \"mp\", \"i\")*/
+
endmodule
Typing \\[verilog-auto] will make this into:
@@ -13048,16 +13237,26 @@ Typing \\[verilog-auto] will make this into:
input [7:0] req_dat
// End of automatics
);
+
+ ExampleIf i;
+
+ /*AUTOASSIGNMODPORT(\"ExampIf\", \"mp\", \"i\")*/
+ // Beginning of automatic assignments from modport
+ assign i.req_dat = req_dat;
+ assign i.req_val = req_val;
+ // End of automatics
+
endmodule
If the modport is part of a UVM monitor/driver class, this
creates a wrapper module that may be used to instantiate the
driver/monitor using AUTOINST in the testbench."
(save-excursion
- (let* ((params (verilog-read-auto-params 2 3))
+ (let* ((params (verilog-read-auto-params 2 4))
(submod (nth 0 params))
(modport-re (nth 1 params))
(regexp (nth 2 params))
+ (prefix (nth 3 params))
direction-re submodi) ; direction argument not supported until
requested
;; Lookup position, etc of co-module
;; Note this may raise an error
@@ -13072,33 +13271,42 @@ driver/monitor using AUTOINST in the testbench."
(verilog-decls-get-vars submoddecls)
(verilog-signals-not-in
(verilog-decls-get-inputs submodportdecls)
- (append (verilog-decls-get-ports submoddecls)
- (verilog-decls-get-ports moddecls)))))
+ (verilog-decls-get-ports submoddecls))))
(sig-list-o (verilog-signals-in ; Decls doesn't have data
types, must resolve
(verilog-decls-get-vars submoddecls)
(verilog-signals-not-in
(verilog-decls-get-outputs submodportdecls)
- (append (verilog-decls-get-ports submoddecls)
- (verilog-decls-get-ports moddecls)))))
+ (verilog-decls-get-ports submoddecls))))
(sig-list-io (verilog-signals-in ; Decls doesn't have data
types, must resolve
(verilog-decls-get-vars submoddecls)
(verilog-signals-not-in
(verilog-decls-get-inouts submodportdecls)
- (append (verilog-decls-get-ports submoddecls)
- (verilog-decls-get-ports moddecls))))))
+ (verilog-decls-get-ports submoddecls)))))
(forward-line 1)
(setq sig-list-i (verilog-signals-edit-wire-reg
- (verilog-signals-matching-dir-re
- (verilog-signals-matching-regexp sig-list-i
regexp)
- "input" direction-re))
+ (verilog-signals-not-in
+ (verilog-signals-add-prefix
+ (verilog-signals-matching-dir-re
+ (verilog-signals-matching-regexp sig-list-i
regexp)
+ "input" direction-re)
+ prefix)
+ (verilog-decls-get-ports moddecls)))
sig-list-o (verilog-signals-edit-wire-reg
- (verilog-signals-matching-dir-re
- (verilog-signals-matching-regexp sig-list-o
regexp)
- "output" direction-re))
+ (verilog-signals-not-in
+ (verilog-signals-add-prefix
+ (verilog-signals-matching-dir-re
+ (verilog-signals-matching-regexp sig-list-o
regexp)
+ "output" direction-re)
+ prefix)
+ (verilog-decls-get-ports moddecls)))
sig-list-io (verilog-signals-edit-wire-reg
- (verilog-signals-matching-dir-re
- (verilog-signals-matching-regexp sig-list-io
regexp)
- "inout" direction-re)))
+ (verilog-signals-not-in
+ (verilog-signals-add-prefix
+ (verilog-signals-matching-dir-re
+ (verilog-signals-matching-regexp sig-list-io
regexp)
+ "inout" direction-re)
+ prefix)
+ (verilog-decls-get-ports moddecls))))
(when v2k (verilog-repair-open-comma))
(when (or sig-list-i sig-list-o sig-list-io)
(verilog-insert-indent "// Beginning of automatic in/out/inouts
(from modport)\n")
@@ -13335,7 +13543,7 @@ them to a one.
AUTORESET may try to reset arrays or structures that cannot be
reset by a simple assignment, resulting in compile errors. This
is a feature to be taken as a hint that you need to reset these
-signals manually (or put them into a \"\\=`ifdef NEVER signal<=\\=`0;
+signals manually (or put them into a \"\\=`ifdef NEVER signal<=\\='0;
\\=`endif\" so Verilog-Mode ignores them.)
An example:
@@ -13559,7 +13767,7 @@ defines the regular expression will be undefed."
(t
(setq defs (delete (match-string-no-properties 2) defs))))))
;; Insert
- (setq defs (sort defs 'string<))
+ (setq defs (sort defs #'string<))
(when defs
(verilog-forward-or-insert-line)
(verilog-insert-indent "// Beginning of automatic undefs\n")
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 d488889..795577c 100644
--- a/lisp/repeat.el
+++ b/lisp/repeat.el
@@ -239,9 +239,7 @@ recently executed command not bound to an input event\"."
(car (memq last-command-event
(listify-key-sequence
repeat-on-final-keystroke))))))
- (if (memq last-repeatable-command '(exit-minibuffer
- minibuffer-complete-and-exit
- self-insert-and-exit))
+ (if (eq last-repeatable-command (caar command-history))
(let ((repeat-command (car command-history)))
(repeat-message "Repeating %S" repeat-command)
(eval repeat-command))
diff --git a/lisp/replace.el b/lisp/replace.el
index f13d27a..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)
@@ -1545,7 +1546,10 @@ You can add this to `occur-hook' if you always want a
separate
(with-current-buffer
(if (eq major-mode 'occur-mode) (current-buffer) (get-buffer "*Occur*"))
(rename-buffer (concat "*Occur: "
- (mapconcat #'buffer-name
+ (mapconcat (lambda (boo)
+ (buffer-name (if (overlayp boo)
+ (overlay-buffer boo)
+ boo)))
(car (cddr occur-revert-arguments)) "/")
"*")
(or unique-p (not interactive-p)))))
@@ -1779,7 +1783,8 @@ See also `multi-occur'."
42)
(window-width))
"" (occur-regexp-descr regexp))))
- (occur--garbage-collect-revert-args)
+ (unless (eq bufs (nth 2 occur-revert-arguments))
+ (occur--garbage-collect-revert-args))
(setq occur-revert-arguments (list regexp nlines bufs))
(if (= count 0)
(kill-buffer occur-buf)
diff --git a/lisp/reveal.el b/lisp/reveal.el
index c01afd9..697df45 100644
--- a/lisp/reveal.el
+++ b/lisp/reveal.el
@@ -67,13 +67,11 @@ revealed text manually."
:type 'boolean
:version "28.1")
-(defvar reveal-open-spots nil
+(defvar-local reveal-open-spots nil
"List of spots in the buffer which are open.
Each element has the form (WINDOW . OVERLAY).")
-(make-variable-buffer-local 'reveal-open-spots)
-(defvar reveal-last-tick nil)
-(make-variable-buffer-local 'reveal-last-tick)
+(defvar-local reveal-last-tick nil)
;; Actual code
diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el
index 1e81904..38283a5 100644
--- a/lisp/ruler-mode.el
+++ b/lisp/ruler-mode.el
@@ -572,10 +572,9 @@ This variable is expected to be made buffer-local by
modes.")
Call `ruler-mode-ruler-function' to compute the ruler value.")
;;;###autoload
-(defvar ruler-mode nil
+(defvar-local ruler-mode nil
"Non-nil if Ruler mode is enabled.
Use the command `ruler-mode' to change this variable.")
-(make-variable-buffer-local 'ruler-mode)
(defun ruler--save-header-line-format ()
"Install the header line format for Ruler mode.
diff --git a/lisp/scroll-lock.el b/lisp/scroll-lock.el
index e8f69b2..d283b80 100644
--- a/lisp/scroll-lock.el
+++ b/lisp/scroll-lock.el
@@ -40,9 +40,8 @@
map)
"Keymap for Scroll Lock mode.")
-(defvar scroll-lock-preserve-screen-pos-save scroll-preserve-screen-position
+(defvar-local scroll-lock-preserve-screen-pos-save
scroll-preserve-screen-position
"Used for saving the state of `scroll-preserve-screen-position'.")
-(make-variable-buffer-local 'scroll-lock-preserve-screen-pos-save)
(defvar scroll-lock-temporary-goal-column 0
"Like `temporary-goal-column' but for scroll-lock-* commands.")
diff --git a/lisp/server.el b/lisp/server.el
index b82e301..220694f 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -197,9 +197,8 @@ The created frame is selected when the hook is called."
"List of current server clients.
Each element is a process.")
-(defvar server-buffer-clients nil
+(defvar-local server-buffer-clients nil
"List of client processes requesting editing of current buffer.")
-(make-variable-buffer-local 'server-buffer-clients)
;; Changing major modes should not erase this local.
(put 'server-buffer-clients 'permanent-local t)
@@ -239,11 +238,10 @@ in this way."
:type 'boolean
:version "21.1")
-(defvar server-existing-buffer nil
+(defvar-local server-existing-buffer nil
"Non-nil means the buffer existed before the server was asked to visit it.
This means that the server should not kill the buffer when you say you
are done with it in the server.")
-(make-variable-buffer-local 'server-existing-buffer)
(defvar server--external-socket-initialized nil
"When an external socket is passed into Emacs, we need to call
diff --git a/lisp/shell.el b/lisp/shell.el
index 0f86615..3212824 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -26,9 +26,7 @@
;;; Commentary:
;; This file defines a shell-in-a-buffer package (shell mode) built on
-;; top of comint mode. This is actually cmushell with things renamed
-;; to replace its counterpart in Emacs 18. cmushell is more
-;; featureful, robust, and uniform than the Emacs 18 version.
+;; top of comint mode.
;; Since this mode is built on top of the general command-interpreter-in-
;; a-buffer mode (comint mode), it shares a common base functionality,
@@ -785,8 +783,7 @@ Make the shell buffer the current buffer, and return it.
;; that tracks cd, pushd, and popd commands issued to the shell, and
;; changes the current directory of the shell buffer accordingly.
;;
-;; This is basically a fragile hack, although it's more accurate than
-;; the version in Emacs 18's shell.el. It has the following failings:
+;; This is basically a fragile hack. It has the following failings:
;; 1. It doesn't know about the cdpath shell variable.
;; 2. It cannot infallibly deal with command sequences, though it does well
;; with these and with ignoring commands forked in another shell with ()s.
diff --git a/lisp/simple.el b/lisp/simple.el
index 742fc50..0c5bcb6 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -134,10 +134,9 @@ messages are highlighted; this helps to see what messages
were visited."
:group 'next-error
:version "28.1")
-(defvar next-error--message-highlight-overlay
+(defvar-local next-error--message-highlight-overlay
nil
"Overlay highlighting the current error message in the `next-error' buffer.")
-(make-variable-buffer-local 'next-error--message-highlight-overlay)
(defcustom next-error-hook nil
"List of hook functions run by `next-error' after visiting source file."
@@ -165,15 +164,14 @@ A buffer becomes most recent when its compilation, grep,
or
similar mode is started, or when it is used with \\[next-error]
or \\[compile-goto-error].")
-(defvar next-error-buffer nil
+(defvar-local next-error-buffer nil
"The buffer-local value of the most recent `next-error' buffer.")
;; next-error-buffer is made buffer-local to keep the reference
;; to the parent buffer used to navigate to the current buffer, so the
;; next call of next-buffer will use the same parent buffer to
;; continue navigation from it.
-(make-variable-buffer-local 'next-error-buffer)
-(defvar next-error-function nil
+(defvar-local next-error-function nil
"Function to use to find the next error in the current buffer.
The function is called with 2 parameters:
ARG is an integer specifying by how many errors to move.
@@ -182,15 +180,13 @@ of the errors before moving.
Major modes providing compile-like functionality should set this variable
to indicate to `next-error' that this is a candidate buffer and how
to navigate in it.")
-(make-variable-buffer-local 'next-error-function)
-(defvar next-error-move-function nil
+(defvar-local next-error-move-function nil
"Function to use to move to an error locus.
It takes two arguments, a buffer position in the error buffer
and a buffer position in the error locus buffer.
The buffer for the error locus should already be current.
nil means use goto-char using the second argument position.")
-(make-variable-buffer-local 'next-error-move-function)
(defsubst next-error-buffer-p (buffer
&optional avoid-current
@@ -496,6 +492,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))))
;;;
@@ -1268,9 +1274,8 @@ that uses or sets the mark."
;; Counting lines, one way or another.
-(defvar goto-line-history nil
+(defvar-local goto-line-history nil
"History of values entered with `goto-line'.")
-(make-variable-buffer-local 'goto-line-history)
(defun goto-line-read-args (&optional relative)
"Read arguments for `goto-line' related commands."
@@ -1448,9 +1453,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)
@@ -1463,6 +1468,7 @@ included in the count."
(1+ done)
done))))
(ignore-invisible-lines
+ (goto-char (point-min))
(save-match-data
(- (buffer-size)
(forward-line (buffer-size))
@@ -1477,27 +1483,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'."
@@ -1819,31 +1809,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.
@@ -2309,14 +2302,12 @@ once. In special cases, when this function needs to be
called more
than once, it can set `minibuffer-default-add-done' to nil explicitly,
overriding the setting of this variable to t in `goto-history-element'.")
-(defvar minibuffer-default-add-done nil
+(defvar-local minibuffer-default-add-done nil
"When nil, add more elements to the end of the list of default values.
The value nil causes `goto-history-element' to add more elements to
the list of defaults when it reaches the end of this list. It does
this by calling a function defined by `minibuffer-default-add-function'.")
-(make-variable-buffer-local 'minibuffer-default-add-done)
-
(defun minibuffer-default-add-completions ()
"Return a list of all completions without the default value.
This function is used to add all elements of the completion table to
@@ -3480,13 +3471,12 @@ excessively long before answering the question."
:group 'undo
:version "22.1")
-(defvar undo-extra-outer-limit nil
+(defvar-local undo-extra-outer-limit nil
"If non-nil, an extra level of size that's ok in an undo item.
We don't ask the user about truncating the undo list until the
current item gets bigger than this amount.
This variable matters only if `undo-ask-before-discard' is non-nil.")
-(make-variable-buffer-local 'undo-extra-outer-limit)
;; When the first undo batch in an undo list is longer than
;; undo-outer-limit, this function gets called to warn the user that
diff --git a/lisp/speedbar.el b/lisp/speedbar.el
index 7f751ec..e43978f 100644
--- a/lisp/speedbar.el
+++ b/lisp/speedbar.el
@@ -5,15 +5,6 @@
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: file, tags, tools
-(defvar speedbar-version "1.0"
- "The current version of speedbar.")
-(make-obsolete-variable 'speedbar-version nil "28.1")
-(defvar speedbar-incompatible-version "0.14beta4"
- "This version of speedbar is incompatible with this version.
-Due to massive API changes (removing the use of the word PATH)
-this version is not backward compatible to 0.14 or earlier.")
-(make-obsolete-variable 'speedbar-incompatible-version nil "28.1")
-
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
@@ -4087,6 +4078,19 @@ See `speedbar-expand-image-button-alist' for details."
(setq ia (cdr ia)))))))
+;; Obsolete
+
+(defvar speedbar-version "1.0"
+ "The current version of speedbar.")
+(make-obsolete-variable 'speedbar-version 'emacs-version "28.1")
+
+(defvar speedbar-incompatible-version "0.14beta4"
+ "This version of speedbar is incompatible with this version.
+Due to massive API changes (removing the use of the word PATH)
+this version is not backward compatible to 0.14 or earlier.")
+(make-obsolete-variable 'speedbar-incompatible-version nil "28.1")
+
+
(provide 'speedbar)
;; run load-time hooks
diff --git a/lisp/startup.el b/lisp/startup.el
index ec58418..ae0ac3c 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -1394,7 +1394,7 @@ please check its value")
(equal user-mail-address
(let (mail-host-address)
(ignore-errors
- (eval (car (get 'user-mail-address 'standard-value))))))
+ (custom--standard-value 'user-mail-address))))
(custom-reevaluate-setting 'user-mail-address))
;; If parameter have been changed in the init file which influence
diff --git a/lisp/subr.el b/lisp/subr.el
index b5f7dfd..8559be6 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1660,6 +1660,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.
@@ -1699,13 +1705,13 @@ be a list of the form returned by `event-start' and
`event-end'."
;;;; Obsolescence declarations for variables, and aliases.
-(make-obsolete-variable 'define-key-rebound-commands nil "23.2")
(make-obsolete-variable 'redisplay-end-trigger-functions 'jit-lock-register
"23.1")
(make-obsolete-variable 'deferred-action-list 'post-command-hook "24.1")
(make-obsolete-variable 'deferred-action-function 'post-command-hook "24.1")
(make-obsolete-variable 'redisplay-dont-pause nil "24.5")
(make-obsolete 'window-redisplay-end-trigger nil "23.1")
(make-obsolete 'set-window-redisplay-end-trigger nil "23.1")
+(make-obsolete-variable 'operating-system-release nil "28.1")
(make-obsolete 'run-window-configuration-change-hook nil "27.1")
@@ -1726,6 +1732,10 @@ 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.
@@ -2233,9 +2243,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))
diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el
index 7e55655..6720d82 100644
--- a/lisp/tab-bar.el
+++ b/lisp/tab-bar.el
@@ -1308,8 +1308,7 @@ For more information, see the function `tab-switcher'."
(setq buffer-read-only t)
(current-buffer))))
-(defvar tab-switcher-column 3)
-(make-variable-buffer-local 'tab-switcher-column)
+(defvar-local tab-switcher-column 3)
(defvar tab-switcher-mode-map
(let ((map (make-keymap)))
diff --git a/lisp/tab-line.el b/lisp/tab-line.el
index 9209f2d..1bdddc2 100644
--- a/lisp/tab-line.el
+++ b/lisp/tab-line.el
@@ -810,9 +810,7 @@ from the tab line."
:version "27.1")
;;;###autoload
-(defvar tab-line-exclude nil)
-;;;###autoload
-(make-variable-buffer-local 'tab-line-exclude)
+(defvar-local tab-line-exclude nil)
(defun tab-line-mode--turn-on ()
"Turn on `tab-line-mode'."
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el
index cd53d7b..89a71ac 100644
--- a/lisp/tar-mode.el
+++ b/lisp/tar-mode.el
@@ -149,12 +149,11 @@ This information is useful, but it takes screen space
away from file names."
;; So instead, we now keep the two pieces of data in separate buffers, and
;; use the new buffer-swap-text primitive when we need to change which data
;; is associated with "the" buffer.
-(defvar tar-data-buffer nil "Buffer that holds the actual raw tar bytes.")
-(make-variable-buffer-local 'tar-data-buffer)
+(defvar-local tar-data-buffer nil
+ "Buffer that holds the actual raw tar bytes.")
-(defvar tar-data-swapped nil
+(defvar-local tar-data-swapped nil
"If non-nil, `tar-data-buffer' indeed holds raw tar bytes.")
-(make-variable-buffer-local 'tar-data-swapped)
(defun tar-data-swapped-p ()
"Return non-nil if the tar-data is in `tar-data-buffer'."
diff --git a/lisp/term.el b/lisp/term.el
index 8a560e8..6beb17f 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -683,8 +683,7 @@ Buffer local variable.")
"Index of last matched history element.")
(defvar term-matching-input-from-input-string ""
"Input previously used to match input history.")
-; This argument to set-process-filter disables reading from the process,
-; assuming this is Emacs 19.20 or newer.
+; This argument to set-process-filter disables reading from the process.
(defvar term-pager-filter t)
(put 'term-input-ring 'permanent-local t)
@@ -2813,333 +2812,334 @@ See `term-prompt-regexp'."
"[\032\e]")
(defun term-emulate-terminal (proc str)
- (with-current-buffer (process-buffer proc)
- (let* ((i 0) funny
- decoded-substring
- save-point save-marker win
- (inhibit-read-only t)
- (buffer-undo-list t)
- (selected (selected-window))
- last-win
- (str-length (length str)))
- (save-selected-window
-
- (when (marker-buffer term-pending-delete-marker)
- ;; Delete text following term-pending-delete-marker.
- (delete-region term-pending-delete-marker (process-mark proc))
- (set-marker term-pending-delete-marker nil))
-
- (when (/= (point) (process-mark proc))
- (setq save-point (point-marker)))
-
- (setf term-vertical-motion
- (if (eq (window-buffer) (current-buffer))
- 'vertical-motion
- 'term-buffer-vertical-motion))
- (setq save-marker (copy-marker (process-mark proc)))
- (goto-char (process-mark proc))
-
- (save-restriction
- ;; If the buffer is in line mode, and there is a partial
- ;; input line, save the line (by narrowing to leave it
- ;; outside the restriction ) until we're done with output.
- (when (and (> (point-max) (process-mark proc))
- (term-in-line-mode))
- (narrow-to-region (point-min) (process-mark proc)))
-
- (when term-log-buffer
- (princ str term-log-buffer))
- (when term-terminal-undecoded-bytes
- (setq str (concat term-terminal-undecoded-bytes str))
- (setq str-length (length str))
- (setq term-terminal-undecoded-bytes nil))
-
- (while (< i str-length)
- (setq funny (string-match term-control-seq-regexp str i))
- (let ((ctl-params (and funny (match-string 1 str)))
- (ctl-params-end (and funny (match-end 1)))
- (ctl-end (if funny (match-end 0)
- (setq funny (string-match
term-control-seq-prefix-regexp str i))
- (if funny
- (setq term-terminal-undecoded-bytes
- (substring str funny))
- (setq funny str-length))
- ;; The control sequence ends somewhere
- ;; past the end of this string.
- (1+ str-length))))
- (when (> funny i)
- (when term-do-line-wrapping
- (term-down 1 t)
- (term-move-to-column 0)
- (setq term-do-line-wrapping nil))
- ;; Handle non-control data. Decode the string before
- ;; counting characters, to avoid garbling of certain
- ;; multibyte characters (bug#1006).
- (setq decoded-substring
- (decode-coding-string
- (substring str i funny)
- locale-coding-system t))
- ;; Check for multibyte characters that ends
- ;; before end of string, and save it for
- ;; next time.
- (when (= funny str-length)
- (let ((partial 0)
- (count (length decoded-substring)))
- (while (and (< partial count)
- (eq (char-charset (aref decoded-substring
- (- count 1 partial)))
- 'eight-bit))
- (cl-incf partial))
- (when (> count partial 0)
- (setq term-terminal-undecoded-bytes
- (substring decoded-substring (- partial)))
- (setq decoded-substring
- (substring decoded-substring 0 (- partial)))
- (cl-decf str-length partial)
- (cl-decf funny partial))))
-
- ;; Insert a string, check how many columns
- ;; we moved, then delete that many columns
- ;; following point if not eob nor insert-mode.
- (let ((old-column (term-horizontal-column))
- (old-point (point))
- columns)
- (unless term-suppress-hard-newline
- (while (> (+ (length decoded-substring) old-column)
- term-width)
- (insert (substring decoded-substring 0
- (- term-width old-column)))
- ;; Since we've enough text to fill the whole line,
- ;; delete previous text regardless of
- ;; `term-insert-mode's value.
- (delete-region (point) (line-end-position))
- (term-down 1 t)
- (term-move-columns (- (term-current-column)))
- (add-text-properties (1- (point)) (point)
- '(term-line-wrap t rear-nonsticky
t))
- (setq decoded-substring
- (substring decoded-substring (- term-width
old-column)))
- (setq old-column 0)))
- (insert decoded-substring)
- (setq term-current-column (current-column)
- columns (- term-current-column old-column))
- (when (not (or (eobp) term-insert-mode))
- (let ((pos (point)))
- (term-move-columns columns)
- (delete-region pos (point))
- (setq term-current-column nil)))
- ;; In insert mode if the current line
- ;; has become too long it needs to be
- ;; chopped off.
- (when term-insert-mode
- (let ((pos (point)))
- (end-of-line)
- (when (> (current-column) term-width)
- (delete-region (- (point) (- (current-column)
term-width))
- (point)))
- (goto-char pos)))
-
- (put-text-property old-point (point)
- 'font-lock-face term-current-face))
- ;; If the last char was written in last column,
- ;; back up one column, but remember we did so.
- ;; Thus we emulate xterm/vt100-style line-wrapping.
- (when (eq (term-current-column) term-width)
- (term-move-columns -1)
- ;; We check after ctrl sequence handling if point
- ;; was moved (and leave line-wrapping state if so).
- (setq term-do-line-wrapping (point)))
- (setq term-current-column nil)
- (setq i funny))
- (pcase-exhaustive (and (<= ctl-end str-length) (aref str i))
- (?\t ;; TAB (terminfo: ht)
- ;; The line cannot exceed term-width. TAB at
- ;; the end of a line should not cause wrapping.
- (let ((col (term-current-column)))
- (term-move-to-column
- (min (1- term-width)
- (+ col 8 (- (mod col 8)))))))
- (?\r ;; (terminfo: cr)
- (term-vertical-motion 0)
- (setq term-current-column term-start-line-column))
- (?\n ;; (terminfo: cud1, ind)
- (unless (and term-kill-echo-list
- (term-check-kill-echo-list))
- (term-down 1 t)))
- (?\b ;; (terminfo: cub1)
- (term-move-columns -1))
- (?\C-g ;; (terminfo: bel)
- (beep t))
- (?\032 ; Emacs specific control sequence.
- (funcall term-command-function
- (decode-coding-string
- (substring str (1+ i)
- (- ctl-end
- (if (eq (aref str (- ctl-end 2)) ?\r)
- 2 1)))
- locale-coding-system t)))
- (?\e
- (pcase (aref str (1+ i))
- (?\[
- ;; We only handle control sequences with a single
- ;; "Final" byte (see [ECMA-48] section 5.4).
- (when (eq ctl-params-end (1- ctl-end))
- (term-handle-ansi-escape
- proc
- (mapcar ;; We don't distinguish empty params
- ;; from 0 (according to [ECMA-48] we
- ;; should, but all commands we support
- ;; default to 0 values anyway).
- #'string-to-number
- (split-string ctl-params ";"))
- (aref str (1- ctl-end)))))
- (?D ;; Scroll forward (apparently not documented in
- ;; [ECMA-48], [ctlseqs] mentions it as C1
- ;; character "Index" though).
- (term-handle-deferred-scroll)
- (term-down 1 t))
- (?M ;; Scroll reversed (terminfo: ri, ECMA-48
- ;; "Reverse Linefeed").
- (if (or (< (term-current-row) term-scroll-start)
- (>= (1- (term-current-row))
- term-scroll-start))
- ;; Scrolling up will not move outside
- ;; the scroll region.
- (term-down -1)
- ;; Scrolling the scroll region is needed.
- (term-down -1 t)))
- (?7 ;; Save cursor (terminfo: sc, not in [ECMA-48],
- ;; [ctlseqs] has it as "DECSC").
- (term-handle-deferred-scroll)
- (setq term-saved-cursor
- (list (term-current-row)
- (term-horizontal-column)
- term-ansi-current-bg-color
- term-ansi-current-bold
- term-ansi-current-color
- term-ansi-current-invisible
- term-ansi-current-reverse
- term-ansi-current-underline
- term-current-face)))
- (?8 ;; Restore cursor (terminfo: rc, [ctlseqs]
- ;; "DECRC").
- (when term-saved-cursor
- (term-goto (nth 0 term-saved-cursor)
- (nth 1 term-saved-cursor))
- (setq term-ansi-current-bg-color
- (nth 2 term-saved-cursor)
- term-ansi-current-bold
- (nth 3 term-saved-cursor)
- term-ansi-current-color
- (nth 4 term-saved-cursor)
- term-ansi-current-invisible
- (nth 5 term-saved-cursor)
- term-ansi-current-reverse
- (nth 6 term-saved-cursor)
- term-ansi-current-underline
- (nth 7 term-saved-cursor)
- term-current-face
- (nth 8 term-saved-cursor))))
- (?c ;; \Ec - Reset (terminfo: rs1, [ctlseqs] "RIS").
- ;; This is used by the "clear" program.
- (term-reset-terminal))
- (?A ;; An \eAnSiT sequence (Emacs specific).
- (term-handle-ansi-terminal-messages
- (substring str i ctl-end)))))
- ;; Ignore NUL, Shift Out, Shift In.
- ((or ?\0 #xE #xF 'nil) nil))
- ;; Leave line-wrapping state if point was moved.
- (unless (eq term-do-line-wrapping (point))
- (setq term-do-line-wrapping nil))
- (if (term-handling-pager)
- (progn
- ;; Finish stuff to get ready to handle PAGER.
- (if (> (% (current-column) term-width) 0)
+ (when (buffer-live-p (process-buffer proc))
+ (with-current-buffer (process-buffer proc)
+ (let* ((i 0) funny
+ decoded-substring
+ save-point save-marker win
+ (inhibit-read-only t)
+ (buffer-undo-list t)
+ (selected (selected-window))
+ last-win
+ (str-length (length str)))
+ (save-selected-window
+
+ (when (marker-buffer term-pending-delete-marker)
+ ;; Delete text following term-pending-delete-marker.
+ (delete-region term-pending-delete-marker (process-mark proc))
+ (set-marker term-pending-delete-marker nil))
+
+ (when (/= (point) (process-mark proc))
+ (setq save-point (point-marker)))
+
+ (setf term-vertical-motion
+ (if (eq (window-buffer) (current-buffer))
+ 'vertical-motion
+ 'term-buffer-vertical-motion))
+ (setq save-marker (copy-marker (process-mark proc)))
+ (goto-char (process-mark proc))
+
+ (save-restriction
+ ;; If the buffer is in line mode, and there is a partial
+ ;; input line, save the line (by narrowing to leave it
+ ;; outside the restriction ) until we're done with output.
+ (when (and (> (point-max) (process-mark proc))
+ (term-in-line-mode))
+ (narrow-to-region (point-min) (process-mark proc)))
+
+ (when term-log-buffer
+ (princ str term-log-buffer))
+ (when term-terminal-undecoded-bytes
+ (setq str (concat term-terminal-undecoded-bytes str))
+ (setq str-length (length str))
+ (setq term-terminal-undecoded-bytes nil))
+
+ (while (< i str-length)
+ (setq funny (string-match term-control-seq-regexp str i))
+ (let ((ctl-params (and funny (match-string 1 str)))
+ (ctl-params-end (and funny (match-end 1)))
+ (ctl-end (if funny (match-end 0)
+ (setq funny (string-match
term-control-seq-prefix-regexp str i))
+ (if funny
+ (setq term-terminal-undecoded-bytes
+ (substring str funny))
+ (setq funny str-length))
+ ;; The control sequence ends somewhere
+ ;; past the end of this string.
+ (1+ str-length))))
+ (when (> funny i)
+ (when term-do-line-wrapping
+ (term-down 1 t)
+ (term-move-to-column 0)
+ (setq term-do-line-wrapping nil))
+ ;; Handle non-control data. Decode the string before
+ ;; counting characters, to avoid garbling of certain
+ ;; multibyte characters (bug#1006).
+ (setq decoded-substring
+ (decode-coding-string
+ (substring str i funny)
+ locale-coding-system t))
+ ;; Check for multibyte characters that ends
+ ;; before end of string, and save it for
+ ;; next time.
+ (when (= funny str-length)
+ (let ((partial 0)
+ (count (length decoded-substring)))
+ (while (and (< partial count)
+ (eq (char-charset (aref decoded-substring
+ (- count 1 partial)))
+ 'eight-bit))
+ (cl-incf partial))
+ (when (> count partial 0)
(setq term-terminal-undecoded-bytes
- (substring str i))
- ;; We're at column 0. Goto end of buffer; to compensate,
- ;; prepend a ?\r for later. This looks more consistent.
- (if (zerop i)
+ (substring decoded-substring (- partial)))
+ (setq decoded-substring
+ (substring decoded-substring 0 (- partial)))
+ (cl-decf str-length partial)
+ (cl-decf funny partial))))
+
+ ;; Insert a string, check how many columns
+ ;; we moved, then delete that many columns
+ ;; following point if not eob nor insert-mode.
+ (let ((old-column (term-horizontal-column))
+ (old-point (point))
+ columns)
+ (unless term-suppress-hard-newline
+ (while (> (+ (length decoded-substring) old-column)
+ term-width)
+ (insert (substring decoded-substring 0
+ (- term-width old-column)))
+ ;; Since we've enough text to fill the whole line,
+ ;; delete previous text regardless of
+ ;; `term-insert-mode's value.
+ (delete-region (point) (line-end-position))
+ (term-down 1 t)
+ (term-move-columns (- (term-current-column)))
+ (add-text-properties (1- (point)) (point)
+ '(term-line-wrap t rear-nonsticky
t))
+ (setq decoded-substring
+ (substring decoded-substring (- term-width
old-column)))
+ (setq old-column 0)))
+ (insert decoded-substring)
+ (setq term-current-column (current-column)
+ columns (- term-current-column old-column))
+ (when (not (or (eobp) term-insert-mode))
+ (let ((pos (point)))
+ (term-move-columns columns)
+ (delete-region pos (point))
+ (setq term-current-column nil)))
+ ;; In insert mode if the current line
+ ;; has become too long it needs to be
+ ;; chopped off.
+ (when term-insert-mode
+ (let ((pos (point)))
+ (end-of-line)
+ (when (> (current-column) term-width)
+ (delete-region (- (point) (- (current-column)
term-width))
+ (point)))
+ (goto-char pos)))
+
+ (put-text-property old-point (point)
+ 'font-lock-face term-current-face))
+ ;; If the last char was written in last column,
+ ;; back up one column, but remember we did so.
+ ;; Thus we emulate xterm/vt100-style line-wrapping.
+ (when (eq (term-current-column) term-width)
+ (term-move-columns -1)
+ ;; We check after ctrl sequence handling if point
+ ;; was moved (and leave line-wrapping state if so).
+ (setq term-do-line-wrapping (point)))
+ (setq term-current-column nil)
+ (setq i funny))
+ (pcase-exhaustive (and (<= ctl-end str-length) (aref str i))
+ (?\t ;; TAB (terminfo: ht)
+ ;; The line cannot exceed term-width. TAB at
+ ;; the end of a line should not cause wrapping.
+ (let ((col (term-current-column)))
+ (term-move-to-column
+ (min (1- term-width)
+ (+ col 8 (- (mod col 8)))))))
+ (?\r ;; (terminfo: cr)
+ (term-vertical-motion 0)
+ (setq term-current-column term-start-line-column))
+ (?\n ;; (terminfo: cud1, ind)
+ (unless (and term-kill-echo-list
+ (term-check-kill-echo-list))
+ (term-down 1 t)))
+ (?\b ;; (terminfo: cub1)
+ (term-move-columns -1))
+ (?\C-g ;; (terminfo: bel)
+ (beep t))
+ (?\032 ; Emacs specific control sequence.
+ (funcall term-command-function
+ (decode-coding-string
+ (substring str (1+ i)
+ (- ctl-end
+ (if (eq (aref str (- ctl-end 2))
?\r)
+ 2 1)))
+ locale-coding-system t)))
+ (?\e
+ (pcase (aref str (1+ i))
+ (?\[
+ ;; We only handle control sequences with a single
+ ;; "Final" byte (see [ECMA-48] section 5.4).
+ (when (eq ctl-params-end (1- ctl-end))
+ (term-handle-ansi-escape
+ proc
+ (mapcar ;; We don't distinguish empty params
+ ;; from 0 (according to [ECMA-48] we
+ ;; should, but all commands we support
+ ;; default to 0 values anyway).
+ #'string-to-number
+ (split-string ctl-params ";"))
+ (aref str (1- ctl-end)))))
+ (?D ;; Scroll forward (apparently not documented in
+ ;; [ECMA-48], [ctlseqs] mentions it as C1
+ ;; character "Index" though).
+ (term-handle-deferred-scroll)
+ (term-down 1 t))
+ (?M ;; Scroll reversed (terminfo: ri, ECMA-48
+ ;; "Reverse Linefeed").
+ (if (or (< (term-current-row) term-scroll-start)
+ (>= (1- (term-current-row))
+ term-scroll-start))
+ ;; Scrolling up will not move outside
+ ;; the scroll region.
+ (term-down -1)
+ ;; Scrolling the scroll region is needed.
+ (term-down -1 t)))
+ (?7 ;; Save cursor (terminfo: sc, not in [ECMA-48],
+ ;; [ctlseqs] has it as "DECSC").
+ (term-handle-deferred-scroll)
+ (setq term-saved-cursor
+ (list (term-current-row)
+ (term-horizontal-column)
+ term-ansi-current-bg-color
+ term-ansi-current-bold
+ term-ansi-current-color
+ term-ansi-current-invisible
+ term-ansi-current-reverse
+ term-ansi-current-underline
+ term-current-face)))
+ (?8 ;; Restore cursor (terminfo: rc, [ctlseqs]
+ ;; "DECRC").
+ (when term-saved-cursor
+ (term-goto (nth 0 term-saved-cursor)
+ (nth 1 term-saved-cursor))
+ (setq term-ansi-current-bg-color
+ (nth 2 term-saved-cursor)
+ term-ansi-current-bold
+ (nth 3 term-saved-cursor)
+ term-ansi-current-color
+ (nth 4 term-saved-cursor)
+ term-ansi-current-invisible
+ (nth 5 term-saved-cursor)
+ term-ansi-current-reverse
+ (nth 6 term-saved-cursor)
+ term-ansi-current-underline
+ (nth 7 term-saved-cursor)
+ term-current-face
+ (nth 8 term-saved-cursor))))
+ (?c ;; \Ec - Reset (terminfo: rs1, [ctlseqs] "RIS").
+ ;; This is used by the "clear" program.
+ (term-reset-terminal))
+ (?A ;; An \eAnSiT sequence (Emacs specific).
+ (term-handle-ansi-terminal-messages
+ (substring str i ctl-end)))))
+ ;; Ignore NUL, Shift Out, Shift In.
+ ((or ?\0 #xE #xF 'nil) nil))
+ ;; Leave line-wrapping state if point was moved.
+ (unless (eq term-do-line-wrapping (point))
+ (setq term-do-line-wrapping nil))
+ (if (term-handling-pager)
+ (progn
+ ;; Finish stuff to get ready to handle PAGER.
+ (if (> (% (current-column) term-width) 0)
(setq term-terminal-undecoded-bytes
- (concat "\r" (substring str i)))
- (setq term-terminal-undecoded-bytes (substring str (1-
i)))
- (aset term-terminal-undecoded-bytes 0 ?\r))
- (goto-char (point-max)))
- ;; FIXME: Use (add-function :override (process-filter proc)
- (setq-local term-pager-old-filter (process-filter proc))
- ;; FIXME: Where is `term-pager-filter' set to a function?!
- (set-process-filter proc term-pager-filter)
- (setq i str-length))
- (setq i ctl-end)))))
-
- (when (>= (term-current-row) term-height)
- (term-handle-deferred-scroll))
-
- (set-marker (process-mark proc) (point))
- (when (stringp decoded-substring)
- (term-watch-for-password-prompt decoded-substring))
- (when save-point
- (goto-char save-point)
- (set-marker save-point nil))
-
- ;; Check for a pending filename-and-line number to display.
- ;; We do this before scrolling, because we might create a new window.
- (when (and term-pending-frame
- (eq (window-buffer selected) (current-buffer)))
- (term-display-line (car term-pending-frame)
- (cdr term-pending-frame))
- (setq term-pending-frame nil))
-
- ;; Scroll each window displaying the buffer but (by default)
- ;; only if the point matches the process-mark we started with.
- (setq win selected)
- ;; Avoid infinite loop in strange case where minibuffer window
- ;; is selected but not active.
- (while (window-minibuffer-p win)
- (setq win (next-window win nil t)))
- (setq last-win win)
- (while (progn
- (setq win (next-window win nil t))
- (when (eq (window-buffer win) (process-buffer proc))
- (let ((scroll term-scroll-to-bottom-on-output))
- (select-window win)
- (when (or (= (point) save-marker)
- (eq scroll t) (eq scroll 'all)
- ;; Maybe user wants point to jump to the end.
- (and (eq selected win)
- (or (eq scroll 'this) (not save-point)))
- (and (eq scroll 'others)
- (not (eq selected win))))
- (when term-scroll-snap-to-bottom
- (goto-char term-home-marker)
- (recenter 0))
- (goto-char (process-mark proc))
- (if (not (pos-visible-in-window-p (point) win))
- (recenter -1)))
- ;; Optionally scroll so that the text
- ;; ends at the bottom of the window.
- (when (and term-scroll-show-maximum-output
- (>= (point) (process-mark proc))
- (or term-scroll-snap-to-bottom
- (not (pos-visible-in-window-p
- (point-max) win))))
- (save-excursion
- (goto-char (point-max))
- (recenter -1)))))
- (not (eq win last-win))))
-
- ;; Stolen from comint.el and adapted -mm
- (when (> term-buffer-maximum-size 0)
- (save-excursion
- (goto-char (process-mark (get-buffer-process (current-buffer))))
- (forward-line (- term-buffer-maximum-size))
- (beginning-of-line)
- (delete-region (point-min) (point))))
- (set-marker save-marker nil)))
- ;; This might be expensive, but we need it to handle something
- ;; like `sleep 5 | less -c' in more-or-less real time.
- (when (get-buffer-window (current-buffer))
- (redisplay))))
+ (substring str i))
+ ;; We're at column 0. Goto end of buffer; to
compensate,
+ ;; prepend a ?\r for later. This looks more
consistent.
+ (if (zerop i)
+ (setq term-terminal-undecoded-bytes
+ (concat "\r" (substring str i)))
+ (setq term-terminal-undecoded-bytes (substring str
(1- i)))
+ (aset term-terminal-undecoded-bytes 0 ?\r))
+ (goto-char (point-max)))
+ ;; FIXME: Use (add-function :override (process-filter
proc)
+ (setq-local term-pager-old-filter (process-filter proc))
+ ;; FIXME: Where is `term-pager-filter' set to a
function?!
+ (set-process-filter proc term-pager-filter)
+ (setq i str-length))
+ (setq i ctl-end)))))
+
+ (when (>= (term-current-row) term-height)
+ (term-handle-deferred-scroll))
+
+ (set-marker (process-mark proc) (point))
+ (when (stringp decoded-substring)
+ (term-watch-for-password-prompt decoded-substring))
+ (when save-point
+ (goto-char save-point)
+ (set-marker save-point nil))
+
+ ;; Check for a pending filename-and-line number to display.
+ ;; We do this before scrolling, because we might create a new window.
+ (when (and term-pending-frame
+ (eq (window-buffer selected) (current-buffer)))
+ (term-display-line (car term-pending-frame)
+ (cdr term-pending-frame))
+ (setq term-pending-frame nil))
+
+ ;; Scroll each window displaying the buffer but (by default)
+ ;; only if the point matches the process-mark we started with.
+ (setq win selected)
+ ;; Avoid infinite loop in strange case where minibuffer window
+ ;; is selected but not active.
+ (while (window-minibuffer-p win)
+ (setq win (next-window win nil t)))
+ (setq last-win win)
+ (while (progn
+ (setq win (next-window win nil t))
+ (when (eq (window-buffer win) (process-buffer proc))
+ (let ((scroll term-scroll-to-bottom-on-output))
+ (select-window win)
+ (when (or (= (point) save-marker)
+ (eq scroll t) (eq scroll 'all)
+ ;; Maybe user wants point to jump to the end.
+ (and (eq selected win)
+ (or (eq scroll 'this) (not save-point)))
+ (and (eq scroll 'others)
+ (not (eq selected win))))
+ (when term-scroll-snap-to-bottom
+ (goto-char term-home-marker)
+ (recenter 0))
+ (goto-char (process-mark proc))
+ (if (not (pos-visible-in-window-p (point) win))
+ (recenter -1)))
+ ;; Optionally scroll so that the text
+ ;; ends at the bottom of the window.
+ (when (and term-scroll-show-maximum-output
+ (>= (point) (process-mark proc))
+ (or term-scroll-snap-to-bottom
+ (not (pos-visible-in-window-p
+ (point-max) win))))
+ (save-excursion
+ (goto-char (point-max))
+ (recenter -1)))))
+ (not (eq win last-win))))
+
+ ;; Stolen from comint.el and adapted -mm
+ (when (> term-buffer-maximum-size 0)
+ (save-excursion
+ (goto-char (process-mark (get-buffer-process (current-buffer))))
+ (forward-line (- term-buffer-maximum-size))
+ (beginning-of-line)
+ (delete-region (point-min) (point))))
+ (set-marker save-marker nil)))
+ ;; This might be expensive, but we need it to handle something
+ ;; like `sleep 5 | less -c' in more-or-less real time.
+ (when (get-buffer-window (current-buffer))
+ (redisplay)))))
(defvar-local term-goto-process-mark t
"Whether to reset point to the current process mark after this command.
diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el
index 94e9d5c..af1e388 100644
--- a/lisp/term/ns-win.el
+++ b/lisp/term/ns-win.el
@@ -374,9 +374,8 @@ prompting. If file is a directory perform a `find-file' on
it."
(find-file f)
(push-mark (+ (point) (cadr (insert-file-contents f)))))))
-(defvar ns-select-overlay nil
+(defvar-local ns-select-overlay nil
"Overlay used to highlight areas in files requested by Nextstep apps.")
-(make-variable-buffer-local 'ns-select-overlay)
(defvar ns-input-line) ; nsterm.m
diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el
index 50c00c9..e66adb4 100644
--- a/lisp/textmodes/artist.el
+++ b/lisp/textmodes/artist.el
@@ -408,57 +408,43 @@ be in `artist-spray-chars', or spraying will behave
strangely.")
;; Internal variables
;;
-(defvar artist-mode nil
- "Non-nil to enable `artist-mode' and nil to disable.")
-(make-variable-buffer-local 'artist-mode)
-
(defvar artist-mode-name " Artist"
"Name of Artist mode beginning with a space (appears in the mode-line).")
-(defvar artist-curr-go 'pen-line
+(defvar-local artist-curr-go 'pen-line
"Current selected graphics operation.")
-(make-variable-buffer-local 'artist-curr-go)
-(defvar artist-line-char-set nil
+(defvar-local artist-line-char-set nil
"Boolean to tell whether user has set some char to use when drawing lines.")
-(make-variable-buffer-local 'artist-line-char-set)
-(defvar artist-line-char nil
+(defvar-local artist-line-char nil
"Char to use when drawing lines.")
-(make-variable-buffer-local 'artist-line-char)
-(defvar artist-fill-char-set nil
+(defvar-local artist-fill-char-set nil
"Boolean to tell whether user has set some char to use when filling.")
-(make-variable-buffer-local 'artist-fill-char-set)
-(defvar artist-fill-char nil
+(defvar-local artist-fill-char nil
"Char to use when filling.")
-(make-variable-buffer-local 'artist-fill-char)
-(defvar artist-erase-char ?\s
+(defvar-local artist-erase-char ?\s
"Char to use when erasing.")
-(make-variable-buffer-local 'artist-erase-char)
-(defvar artist-default-fill-char ?.
+(defvar-local artist-default-fill-char ?.
"Char to use when a fill-char is required but none is set.")
-(make-variable-buffer-local 'artist-default-fill-char)
; This variable is not buffer local
(defvar artist-copy-buffer nil
"Copy buffer.")
-(defvar artist-draw-region-min-y 0
+(defvar-local artist-draw-region-min-y 0
"Line-number for top-most visited line for draw operation.")
-(make-variable-buffer-local 'artist-draw-region-min-y)
-(defvar artist-draw-region-max-y 0
+(defvar-local artist-draw-region-max-y 0
"Line-number for bottom-most visited line for draw operation.")
-(make-variable-buffer-local 'artist-draw-region-max-y)
-(defvar artist-borderless-shapes nil
+(defvar-local artist-borderless-shapes nil
"When non-nil, draw shapes without border.
The fill char is used instead, if it is set.")
-(make-variable-buffer-local 'artist-borderless-shapes)
(defvar artist-prev-next-op-alist nil
"Assoc list for looking up next and/or previous draw operation.
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/css-mode.el b/lisp/textmodes/css-mode.el
index 9186e52..622853d 100644
--- a/lisp/textmodes/css-mode.el
+++ b/lisp/textmodes/css-mode.el
@@ -71,9 +71,8 @@
"while")
"Additional identifiers that appear in the form @foo in SCSS.")
-(defvar css--at-ids css-at-ids
+(defvar-local css--at-ids css-at-ids
"List of at-rules for the current mode.")
-(make-variable-buffer-local 'css--at-ids)
(defconst css-bang-ids
'("important")
@@ -83,9 +82,8 @@
'("default" "global" "optional")
"Additional identifiers that appear in the form !foo in SCSS.")
-(defvar css--bang-ids css-bang-ids
+(defvar-local css--bang-ids css-bang-ids
"List of bang-rules for the current mode.")
-(make-variable-buffer-local 'css--bang-ids)
(defconst css-descriptor-ids
'("ascent" "baseline" "bbox" "cap-height" "centerline" "definition-src"
@@ -1374,9 +1372,8 @@ the string PROPERTY."
"List of HTML tags.
Used to provide completion of HTML tags in selectors.")
-(defvar css--nested-selectors-allowed nil
+(defvar-local css--nested-selectors-allowed nil
"Non-nil if nested selectors are allowed in the current mode.")
-(make-variable-buffer-local 'css--nested-selectors-allowed)
(defvar css-class-list-function #'ignore
"Called to provide completions of class names.
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 1aac964..fe92d60 100644
--- a/lisp/textmodes/enriched.el
+++ b/lisp/textmodes/enriched.el
@@ -165,10 +165,9 @@ execute malicious Lisp code, if that code came from an
external source."
:version "26.1"
:group 'enriched)
-(defvar enriched-old-bindings nil
+(defvar-local enriched-old-bindings nil
"Store old variable values that we change when entering mode.
The value is a list of \(VAR VALUE VAR VALUE...).")
-(make-variable-buffer-local 'enriched-old-bindings)
;; The next variable is buffer local if and only if Enriched mode is
;; enabled. The buffer local value records whether
@@ -187,7 +186,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/flyspell.el b/lisp/textmodes/flyspell.el
index d850316..83dba71 100644
--- a/lisp/textmodes/flyspell.el
+++ b/lisp/textmodes/flyspell.el
@@ -304,12 +304,11 @@ If this variable is nil, all regions are treated as
small."
(define-obsolete-variable-alias 'flyspell-generic-check-word-p
'flyspell-generic-check-word-predicate "25.1")
-(defvar flyspell-generic-check-word-predicate nil
+(defvar-local flyspell-generic-check-word-predicate nil
"Function providing per-mode customization over which words are flyspelled.
Returns t to continue checking, nil otherwise.
Flyspell mode sets this variable to whatever is the `flyspell-mode-predicate'
property of the major mode name.")
-(make-variable-buffer-local 'flyspell-generic-check-word-predicate)
;;*--- mail mode -------------------------------------------------------*/
(put 'mail-mode 'flyspell-mode-predicate 'mail-mode-flyspell-verify)
@@ -466,13 +465,10 @@ If this is set, also unbind `mouse-2'."
:version "28.1")
;; dash character machinery
-(defvar flyspell-consider-dash-as-word-delimiter-flag nil
+(defvar-local flyspell-consider-dash-as-word-delimiter-flag nil
"Non-nil means that the `-' char is considered as a word delimiter.")
-(make-variable-buffer-local 'flyspell-consider-dash-as-word-delimiter-flag)
-(defvar flyspell-dash-dictionary nil)
-(make-variable-buffer-local 'flyspell-dash-dictionary)
-(defvar flyspell-dash-local-dictionary nil)
-(make-variable-buffer-local 'flyspell-dash-local-dictionary)
+(defvar-local flyspell-dash-dictionary nil)
+(defvar-local flyspell-dash-local-dictionary nil)
;;*---------------------------------------------------------------------*/
;;* Highlighting */
@@ -714,14 +710,10 @@ has been used, the current word is not checked."
;;*---------------------------------------------------------------------*/
;;* flyspell-word-cache ... */
;;*---------------------------------------------------------------------*/
-(defvar flyspell-word-cache-start nil)
-(defvar flyspell-word-cache-end nil)
-(defvar flyspell-word-cache-word nil)
-(defvar flyspell-word-cache-result '_)
-(make-variable-buffer-local 'flyspell-word-cache-start)
-(make-variable-buffer-local 'flyspell-word-cache-end)
-(make-variable-buffer-local 'flyspell-word-cache-word)
-(make-variable-buffer-local 'flyspell-word-cache-result)
+(defvar-local flyspell-word-cache-start nil)
+(defvar-local flyspell-word-cache-end nil)
+(defvar-local flyspell-word-cache-word nil)
+(defvar-local flyspell-word-cache-result '_)
;;*---------------------------------------------------------------------*/
;;* The flyspell pre-hook, store the current position. In the */
@@ -827,8 +819,7 @@ before the current command."
;;* the post command hook, we will check, if the word at this */
;;* position has to be spell checked. */
;;*---------------------------------------------------------------------*/
-(defvar flyspell-changes nil)
-(make-variable-buffer-local 'flyspell-changes)
+(defvar-local flyspell-changes nil)
;;*---------------------------------------------------------------------*/
;;* flyspell-after-change-function ... */
@@ -1894,14 +1885,10 @@ as returned by `ispell-parse-output'."
;;*---------------------------------------------------------------------*/
;;* flyspell-auto-correct-cache ... */
;;*---------------------------------------------------------------------*/
-(defvar flyspell-auto-correct-pos nil)
-(defvar flyspell-auto-correct-region nil)
-(defvar flyspell-auto-correct-ring nil)
-(defvar flyspell-auto-correct-word nil)
-(make-variable-buffer-local 'flyspell-auto-correct-pos)
-(make-variable-buffer-local 'flyspell-auto-correct-region)
-(make-variable-buffer-local 'flyspell-auto-correct-ring)
-(make-variable-buffer-local 'flyspell-auto-correct-word)
+(defvar-local flyspell-auto-correct-pos nil)
+(defvar-local flyspell-auto-correct-region nil)
+(defvar-local flyspell-auto-correct-ring nil)
+(defvar-local flyspell-auto-correct-word nil)
;;*---------------------------------------------------------------------*/
;;* flyspell-check-previous-highlighted-word ... */
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index 8d49a7c..ea46270 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -351,9 +351,8 @@ If nil, the default personal dictionary for your spelling
checker is used."
:type 'boolean
:group 'ispell)
-(defvar ispell-local-dictionary-overridden nil
+(defvar-local ispell-local-dictionary-overridden nil
"Non-nil means the user has explicitly set this buffer's Ispell dictionary.")
-(make-variable-buffer-local 'ispell-local-dictionary-overridden)
(defcustom ispell-local-dictionary nil
"If non-nil, the dictionary to be used for Ispell commands in this buffer.
@@ -1748,7 +1747,7 @@ Note - substrings of other matches must come last
(e.g. \"<[tT][tT]/\" and \"<[^ \\t\\n>]\").")
(put 'ispell-html-skip-alists 'risky-local-variable t)
-(defvar ispell-local-pdict ispell-personal-dictionary
+(defvar-local ispell-local-pdict ispell-personal-dictionary
"A buffer local variable containing the current personal dictionary.
If non-nil, the value must be a string, which is a file name.
@@ -1758,18 +1757,15 @@ to calling \\[ispell-change-dictionary]. This variable
is automatically
set when defined in the file with either `ispell-pdict-keyword' or the
local variable syntax.")
-(make-variable-buffer-local 'ispell-local-pdict)
;;;###autoload(put 'ispell-local-pdict 'safe-local-variable 'stringp)
(defvar ispell-buffer-local-name nil
"Contains the buffer name if local word definitions were used.
Ispell is then restarted because the local words could conflict.")
-(defvar ispell-buffer-session-localwords nil
+(defvar-local ispell-buffer-session-localwords nil
"List of words accepted for session in this buffer.")
-(make-variable-buffer-local 'ispell-buffer-session-localwords)
-
(defvar ispell-parser 'use-mode-name
"Indicates whether ispell should parse the current buffer as TeX Code.
Special value `use-mode-name' tries to guess using the name of `major-mode'.
diff --git a/lisp/textmodes/less-css-mode.el b/lisp/textmodes/less-css-mode.el
index 9cacc17..24ccb3c 100644
--- a/lisp/textmodes/less-css-mode.el
+++ b/lisp/textmodes/less-css-mode.el
@@ -73,7 +73,6 @@
(require 'compile)
(require 'css-mode)
-(require 'derived)
(eval-when-compile (require 'subr-x))
(defgroup less-css nil
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/refill.el b/lisp/textmodes/refill.el
index 6edd9ae..8f4f3c5 100644
--- a/lisp/textmodes/refill.el
+++ b/lisp/textmodes/refill.el
@@ -88,10 +88,9 @@
;;; "Refilling paragraphs on changes."
;;; :group 'fill)
-(defvar refill-ignorable-overlay nil
+(defvar-local refill-ignorable-overlay nil
"Portion of the most recently filled paragraph not needing filling.
This is used to optimize refilling.")
-(make-variable-buffer-local 'refill-ignorable-overlay)
(defun refill-adjust-ignorable-overlay (overlay afterp beg end &optional len)
"Adjust OVERLAY to not include the about-to-be-modified region."
@@ -149,7 +148,7 @@ This is used to optimize refilling.")
"Like `fill-paragraph' but don't delete whitespace at paragraph end."
(refill-fill-paragraph-at (point) arg))
-(defvar refill-doit nil
+(defvar-local refill-doit nil
"Non-nil tells `refill-post-command-function' to do its processing.
Set by `refill-after-change-function' in `after-change-functions' and
unset by `refill-post-command-function' in `post-command-hook', and
@@ -157,7 +156,6 @@ sometimes `refill-pre-command-function' in
`pre-command-hook'. This
ensures refilling is only done once per command that causes a change,
regardless of the number of after-change calls from commands doing
complex processing.")
-(make-variable-buffer-local 'refill-doit)
(defun refill-after-change-function (beg end len)
"Function for `after-change-functions' which just sets `refill-doit'."
diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el
index 1834171..2b31e7e 100644
--- a/lisp/textmodes/rst.el
+++ b/lisp/textmodes/rst.el
@@ -3627,10 +3627,7 @@ Region is from BEG to END. With WITH-EMPTY prefix empty
lines too."
"customize the face `rst-definition' instead."
"24.1")
-;; XEmacs compatibility (?).
-(defface rst-directive (if (boundp 'font-lock-builtin-face)
- '((t :inherit font-lock-builtin-face))
- '((t :inherit font-lock-preprocessor-face)))
+(defface rst-directive '((t :inherit font-lock-builtin-face))
"Face used for directives and roles."
:version "24.1"
:group 'rst-faces)
diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el
index c50c544..7051f52 100644
--- a/lisp/textmodes/sgml-mode.el
+++ b/lisp/textmodes/sgml-mode.el
@@ -510,10 +510,12 @@ an optional alist of possible values."
(with-no-warnings (defvar v2)) ; free for skeleton
(defun sgml-comment-indent-new-line (&optional soft)
- (let ((comment-start "-- ")
- (comment-start-skip "\\(<!\\)?--[ \t]*")
- (comment-end " --")
- (comment-style 'plain))
+ (if (ppss-comment-depth (syntax-ppss))
+ (let ((comment-start "-- ")
+ (comment-start-skip "\\(<!\\)?--[ \t]*")
+ (comment-end " --")
+ (comment-style 'plain))
+ (comment-indent-new-line soft))
(comment-indent-new-line soft)))
(defun sgml-mode-facemenu-add-face-function (face _end)
@@ -2290,19 +2292,17 @@ This takes effect when first loading the library.")
nil t)
(match-string-no-properties 1))))
-(defvar html--buffer-classes-cache nil
+(defvar-local html--buffer-classes-cache nil
"Cache for `html-current-buffer-classes'.
When set, this should be a cons cell where the CAR is the
buffer's tick counter (as produced by `buffer-modified-tick'),
and the CDR is the list of class names found in the buffer.")
-(make-variable-buffer-local 'html--buffer-classes-cache)
-(defvar html--buffer-ids-cache nil
+(defvar-local html--buffer-ids-cache nil
"Cache for `html-current-buffer-ids'.
When set, this should be a cons cell where the CAR is the
buffer's tick counter (as produced by `buffer-modified-tick'),
and the CDR is the list of class names found in the buffer.")
-(make-variable-buffer-local 'html--buffer-ids-cache)
(declare-function libxml-parse-html-region "xml.c"
(start end &optional base-url discard-comments))
diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el
index 071684d..06785e4 100644
--- a/lisp/textmodes/table.el
+++ b/lisp/textmodes/table.el
@@ -859,11 +859,10 @@ cell to cache and cache to cell.")
"Non-nil inhibits auto fill paragraph when `table-with-cache-buffer' exits.
This is always set to nil at the entry to `table-with-cache-buffer' before
executing body forms.")
-(defvar table-mode-indicator nil
+(defvar-local table-mode-indicator nil
"For mode line indicator")
;; This is not a real minor-mode but placed in the minor-mode-alist
;; so that we can show the indicator on the mode line handy.
-(make-variable-buffer-local 'table-mode-indicator)
(unless (assq table-mode-indicator minor-mode-alist)
(push '(table-mode-indicator (table-fixed-width-mode " Fixed-Table" "
Table"))
minor-mode-alist))
diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el
index ce665e6..d5a79ad 100644
--- a/lisp/textmodes/tex-mode.el
+++ b/lisp/textmodes/tex-mode.el
@@ -2044,8 +2044,7 @@ In the tex shell buffer this command behaves like
`comint-send-input'."
(with-current-buffer buffer
(setq default-directory directory))))
-(defvar tex-send-command-modified-tick 0)
-(make-variable-buffer-local 'tex-send-command-modified-tick)
+(defvar-local tex-send-command-modified-tick 0)
(defun tex-shell-proc ()
(or (tex-shell-running) (error "No TeX subprocess")))
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/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/two-column.el b/lisp/textmodes/two-column.el
index 36aad84..d072ab1 100644
--- a/lisp/textmodes/two-column.el
+++ b/lisp/textmodes/two-column.el
@@ -218,15 +218,13 @@ minus this value."
;; Markers seem to be the only buffer-id not affected by renaming a buffer.
;; This nevertheless loses when a buffer is killed. The variable-name is
;; required by `describe-mode'.
-(defvar 2C-mode nil
+(defvar-local 2C-mode nil
"Marker to the associated buffer, if non-nil.")
-(make-variable-buffer-local '2C-mode)
(put '2C-mode 'permanent-local t)
(setq minor-mode-alist (cons '(2C-mode " 2C") minor-mode-alist))
-(defvar 2C-autoscroll-start nil)
-(make-variable-buffer-local '2C-autoscroll-start)
+(defvar-local 2C-autoscroll-start nil)
;;;;; base functions ;;;;;
diff --git a/lisp/thumbs.el b/lisp/thumbs.el
index 7d6558d..465d097 100644
--- a/lisp/thumbs.el
+++ b/lisp/thumbs.el
@@ -148,36 +148,30 @@ this value can let another user see some of your images."
:group 'thumbs)
;; Initialize some variable, for later use.
-(defvar thumbs-current-tmp-filename nil
+(defvar-local thumbs-current-tmp-filename nil
"Temporary filename of current image.")
-(make-variable-buffer-local 'thumbs-current-tmp-filename)
-(defvar thumbs-current-image-filename nil
+(defvar-local thumbs-current-image-filename nil
"Filename of current image.")
-(make-variable-buffer-local 'thumbs-current-image-filename)
-(defvar thumbs-extra-images 1
+(defvar-local thumbs-extra-images 1
"Counter for showing extra images in thumbs buffer.")
-(make-variable-buffer-local 'thumbs-extra-images)
(put 'thumbs-extra-images 'permanent-local t)
(defvar thumbs-current-image-size nil
"Size of current image.")
-(defvar thumbs-image-num nil
+(defvar-local thumbs-image-num nil
"Number of current image.")
-(make-variable-buffer-local 'thumbs-image-num)
-(defvar thumbs-buffer nil
+(defvar-local thumbs-buffer nil
"Name of buffer containing thumbnails associated with image.")
-(make-variable-buffer-local 'thumbs-buffer)
(defvar thumbs-current-dir nil
"Current directory.")
-(defvar thumbs-marked-list nil
+(defvar-local thumbs-marked-list nil
"List of marked files.")
-(make-variable-buffer-local 'thumbs-marked-list)
(put 'thumbs-marked-list 'permanent-local t)
(defsubst thumbs-temp-dir ()
diff --git a/lisp/tutorial.el b/lisp/tutorial.el
index 6bda1ab..57e5570 100644
--- a/lisp/tutorial.el
+++ b/lisp/tutorial.el
@@ -38,17 +38,14 @@
"Face used to highlight warnings in the tutorial."
:group 'help)
-(defvar tutorial--point-before-chkeys 0
+(defvar-local tutorial--point-before-chkeys 0
"Point before display of key changes.")
-(make-variable-buffer-local 'tutorial--point-before-chkeys)
-(defvar tutorial--point-after-chkeys 0
+(defvar-local tutorial--point-after-chkeys 0
"Point after display of key changes.")
-(make-variable-buffer-local 'tutorial--point-after-chkeys)
-(defvar tutorial--lang nil
+(defvar-local tutorial--lang nil
"Tutorial language.")
-(make-variable-buffer-local 'tutorial--lang)
(defvar tutorial--buffer nil
"The selected tutorial buffer.")
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index 61e07a0..8cebd4e 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -461,8 +461,10 @@ Return the number of characters removed."
;; headers, then this means that we've already tried sending
;; credentials to the server, and they were wrong, so just give
;; up.
- (when (assoc "Authorization" url-http-extra-headers)
- (error "Wrong authorization used for %s" url))
+ (let ((authorization (assoc "Authorization" url-http-extra-headers)))
+ (when (and authorization
+ (not (string-match "^NTLM " (cdr authorization))))
+ (error "Wrong authorization used for %s" url)))
;; find strongest supported auth
(dolist (this-auth auths)
diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el
index 6493abf..8c836f8 100644
--- a/lisp/url/url-vars.el
+++ b/lisp/url/url-vars.el
@@ -55,26 +55,19 @@
:group 'url)
-(defvar url-current-object nil
+(defvar-local url-current-object nil
"A parsed representation of the current URL.")
-(defvar url-current-mime-headers nil
+(defvar-local url-current-mime-headers nil
"A parsed representation of the MIME headers for the current URL.")
-(defvar url-current-lastloc nil
+(defvar-local url-current-lastloc nil
"A parsed representation of the URL to be considered as the last location.
Use of this value on outbound connections is subject to
`url-privacy-level' and `url-lastloc-privacy-level'. This is never set
by the url library, applications are expected to set this
variable in buffers representing a displayed location.")
-(mapc 'make-variable-buffer-local
- '(
- url-current-object
- url-current-mime-headers
- url-current-lastloc
- ))
-
(defcustom url-honor-refresh-requests t
"Whether to do automatic page reloads.
These are done at the request of the document author or the server via
diff --git a/lisp/vc/cvs-status.el b/lisp/vc/cvs-status.el
index ff3a294..26fb620 100644
--- a/lisp/vc/cvs-status.el
+++ b/lisp/vc/cvs-status.el
@@ -356,9 +356,8 @@ the list is a three-string list TAG, KIND, REV."
(defvar font-lock-mode)
;; (defun cvs-refontify (beg end)
-;; (when (and (boundp 'font-lock-mode)
-;; font-lock-mode
-;; (fboundp 'font-lock-fontify-region))
+;; (when (and font-lock-mode
+;; (fboundp 'font-lock-fontify-region))
;; (font-lock-fontify-region (1- beg) (1+ end))))
(defun cvs-status-trees ()
diff --git a/lisp/vc/ediff-diff.el b/lisp/vc/ediff-diff.el
index e90eaa1..fde9d43 100644
--- a/lisp/vc/ediff-diff.el
+++ b/lisp/vc/ediff-diff.el
@@ -1230,35 +1230,30 @@ are ignored."
Used for splitting difference regions into individual words.")
;; \240 is Unicode symbol for nonbreakable whitespace
-(defvar ediff-whitespace " \n\t\f\r\240"
+(defvar-local ediff-whitespace " \n\t\f\r\240"
"Characters constituting white space.
These characters are ignored when differing regions are split into words.")
-(make-variable-buffer-local 'ediff-whitespace)
-(defvar ediff-word-1 "-[:word:]_"
+(defvar-local ediff-word-1 "-[:word:]_"
"Characters that constitute words of type 1.
More precisely, [ediff-word-1] is a regexp that matches type 1 words.
See `ediff-forward-word' for more details.")
-(make-variable-buffer-local 'ediff-word-1)
-(defvar ediff-word-2 "0-9.,"
+(defvar-local ediff-word-2 "0-9.,"
"Characters that constitute words of type 2.
More precisely, [ediff-word-2] is a regexp that matches type 2 words.
See `ediff-forward-word' for more details.")
-(make-variable-buffer-local 'ediff-word-2)
-(defvar ediff-word-3 "`'?!:;\"{}[]()"
+(defvar-local ediff-word-3 "`'?!:;\"{}[]()"
"Characters that constitute words of type 3.
More precisely, [ediff-word-3] is a regexp that matches type 3 words.
See `ediff-forward-word' for more details.")
-(make-variable-buffer-local 'ediff-word-3)
-(defvar ediff-word-4
+(defvar-local ediff-word-4
(concat "^" ediff-word-1 ediff-word-2 ediff-word-3 ediff-whitespace)
"Characters that constitute words of type 4.
More precisely, [ediff-word-4] is a regexp that matches type 4 words.
See `ediff-forward-word' for more details.")
-(make-variable-buffer-local 'ediff-word-4)
;; Split region along word boundaries. Each word will be on its own line.
;; Output to buffer out-buffer.
diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el
index 0865ac5..3f33e6a 100644
--- a/lisp/vc/ediff-init.el
+++ b/lisp/vc/ediff-init.el
@@ -80,13 +80,12 @@ that Ediff doesn't know about.")
;; so that `kill-all-local-variables' (called by major-mode setting
;; commands) won't destroy Ediff control variables.
;;
-;; Plagiarized from `emerge-defvar-local' for XEmacs.
+;; Plagiarized from `emerge-defvar-local'.
(defmacro ediff-defvar-local (var value doc)
"Defines VAR as a local variable."
(declare (indent defun) (doc-string 3))
`(progn
- (defvar ,var ,value ,doc)
- (make-variable-buffer-local ',var)
+ (defvar-local ,var ,value ,doc)
(put ',var 'permanent-local t)))
@@ -798,13 +797,6 @@ to temp files in buffer jobs and when Ediff needs to find
fine differences."
(message "Pixmap not found for %S: %s" (face-name face) pixmap)
(sit-for 1)))))
-(defun ediff-hide-face (face)
- (if (and (ediff-has-face-support-p)
- (boundp 'add-to-list)
- (boundp 'facemenu-unlisted-faces))
- (add-to-list 'facemenu-unlisted-faces face)))
-
-
(defface ediff-current-diff-A
'((((class color) (min-colors 88) (background light))
@@ -825,7 +817,6 @@ to temp files in buffer jobs and when Ediff needs to find
fine differences."
DO NOT CHANGE this variable. Instead, use the customization
widget to customize the actual face object `ediff-current-diff-A'
this variable represents.")
-(ediff-hide-face ediff-current-diff-face-A)
(defface ediff-current-diff-B
'((((class color) (min-colors 88) (background light))
@@ -847,7 +838,6 @@ this variable represents.")
this variable. Instead, use the customization
widget to customize the actual face `ediff-current-diff-B'
this variable represents.")
-(ediff-hide-face ediff-current-diff-face-B)
(defface ediff-current-diff-C
'((((class color) (min-colors 88) (background light))
@@ -868,7 +858,6 @@ this variable represents.")
DO NOT CHANGE this variable. Instead, use the customization
widget to customize the actual face object `ediff-current-diff-C'
this variable represents.")
-(ediff-hide-face ediff-current-diff-face-C)
(defface ediff-current-diff-Ancestor
'((((class color) (min-colors 88) (background light))
@@ -891,7 +880,6 @@ this variable represents.")
DO NOT CHANGE this variable. Instead, use the customization
widget to customize the actual face object `ediff-current-diff-Ancestor'
this variable represents.")
-(ediff-hide-face ediff-current-diff-face-Ancestor)
(defface ediff-fine-diff-A
'((((class color) (min-colors 88) (background light))
@@ -912,7 +900,6 @@ this variable represents.")
DO NOT CHANGE this variable. Instead, use the customization
widget to customize the actual face object `ediff-fine-diff-A'
this variable represents.")
-(ediff-hide-face ediff-fine-diff-face-A)
(defface ediff-fine-diff-B
'((((class color) (min-colors 88) (background light))
@@ -933,7 +920,6 @@ this variable represents.")
DO NOT CHANGE this variable. Instead, use the customization
widget to customize the actual face object `ediff-fine-diff-B'
this variable represents.")
-(ediff-hide-face ediff-fine-diff-face-B)
(defface ediff-fine-diff-C
'((((class color) (min-colors 88) (background light))
@@ -957,7 +943,6 @@ this variable represents.")
DO NOT CHANGE this variable. Instead, use the customization
widget to customize the actual face object `ediff-fine-diff-C'
this variable represents.")
-(ediff-hide-face ediff-fine-diff-face-C)
(defface ediff-fine-diff-Ancestor
'((((class color) (min-colors 88) (background light))
@@ -982,7 +967,6 @@ ancestor buffer."
DO NOT CHANGE this variable. Instead, use the customization
widget to customize the actual face object `ediff-fine-diff-Ancestor'
this variable represents.")
-(ediff-hide-face ediff-fine-diff-face-Ancestor)
;; Some installs don't have stipple or Stipple. So, try them in turn.
(defvar stipple-pixmap
@@ -996,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))
@@ -1013,11 +999,12 @@ this variable represents.")
DO NOT CHANGE this variable. Instead, use the customization
widget to customize the actual face object `ediff-even-diff-A'
this variable represents.")
-(ediff-hide-face ediff-even-diff-face-A)
(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))
@@ -1032,13 +1019,14 @@ this variable represents.")
DO NOT CHANGE this variable. Instead, use the customization
widget to customize the actual face object `ediff-even-diff-B'
this variable represents.")
-(ediff-hide-face ediff-even-diff-face-B)
(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))
@@ -1054,13 +1042,14 @@ this variable represents.")
DO NOT CHANGE this variable. Instead, use the customization
widget to customize the actual face object `ediff-even-diff-C'
this variable represents.")
-(ediff-hide-face ediff-even-diff-face-C)
(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))
@@ -1076,7 +1065,6 @@ this variable represents.")
DO NOT CHANGE this variable. Instead, use the customization
widget to customize the actual face object `ediff-even-diff-Ancestor'
this variable represents.")
-(ediff-hide-face ediff-even-diff-face-Ancestor)
;; Association between buffer types and even-diff-face symbols
(defconst ediff-even-diff-face-alist
@@ -1088,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))
@@ -1104,14 +1094,14 @@ this variable represents.")
DO NOT CHANGE this variable. Instead, use the customization
widget to customize the actual face object `ediff-odd-diff-A'
this variable represents.")
-(ediff-hide-face ediff-odd-diff-face-A)
-
(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))
@@ -1126,13 +1116,14 @@ this variable represents.")
DO NOT CHANGE this variable. Instead, use the customization
widget to customize the actual face object `ediff-odd-diff-B'
this variable represents.")
-(ediff-hide-face ediff-odd-diff-face-B)
(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))
@@ -1147,7 +1138,6 @@ this variable represents.")
DO NOT CHANGE this variable. Instead, use the customization
widget to customize the actual face object `ediff-odd-diff-C'
this variable represents.")
-(ediff-hide-face ediff-odd-diff-face-C)
(defface ediff-odd-diff-Ancestor
'((((class color) (min-colors 88))
@@ -1166,7 +1156,6 @@ this variable represents.")
DO NOT CHANGE this variable. Instead, use the customization
widget to customize the actual face object `ediff-odd-diff-Ancestor'
this variable represents.")
-(ediff-hide-face ediff-odd-diff-face-Ancestor)
;; Association between buffer types and odd-diff-face symbols
(defconst ediff-odd-diff-face-alist
@@ -1572,6 +1561,8 @@ This default should work without changes."
(ediff-file-attributes filename 5))
+;;; Obsolete
+
(defun ediff-convert-standard-filename (fname)
(declare (obsolete convert-standard-filename "28.1"))
(convert-standard-filename fname))
@@ -1579,5 +1570,7 @@ This default should work without changes."
(define-obsolete-function-alias 'ediff-with-syntax-table
#'with-syntax-table "27.1")
+(define-obsolete-function-alias 'ediff-hide-face #'ignore "28.1")
+
(provide 'ediff-init)
;;; ediff-init.el ends here
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/smerge-mode.el b/lisp/vc/smerge-mode.el
index 3b09dfe..c66a4fb 100644
--- a/lisp/vc/smerge-mode.el
+++ b/lisp/vc/smerge-mode.el
@@ -173,8 +173,7 @@ Used in `smerge-diff-base-upper' and related functions."
`((,smerge-command-prefix . ,smerge-basic-map))
"Keymap for `smerge-mode'.")
-(defvar smerge-check-cache nil)
-(make-variable-buffer-local 'smerge-check-cache)
+(defvar-local smerge-check-cache nil)
(defun smerge-check (n)
(condition-case nil
(let ((state (cons (point) (buffer-modified-tick))))
@@ -1411,7 +1410,7 @@ with a \\[universal-argument] prefix, makes up a 3-way
conflict."
\\{smerge-mode-map}"
:group 'smerge :lighter " SMerge"
- (when (and (boundp 'font-lock-mode) font-lock-mode)
+ (when font-lock-mode
(save-excursion
(if smerge-mode
(font-lock-add-keywords nil smerge-font-lock-keywords 'append)
diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index e4eff48..d1385ea 100644
--- a/lisp/vc/vc-bzr.el
+++ b/lisp/vc/vc-bzr.el
@@ -860,9 +860,8 @@ If LIMIT is non-nil, show no more than this many entries."
(vc-bzr-command "mv" nil 0 new old)
(message "Renamed %s => %s" old new))
-(defvar vc-bzr-annotation-table nil
+(defvar-local vc-bzr-annotation-table nil
"Internal use.")
-(make-variable-buffer-local 'vc-bzr-annotation-table)
(defun vc-bzr-annotate-command (file buffer &optional revision)
"Prepare BUFFER for `vc-annotate' on FILE.
@@ -1077,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-dispatcher.el b/lisp/vc/vc-dispatcher.el
index 6b17f2a..2573964 100644
--- a/lisp/vc/vc-dispatcher.el
+++ b/lisp/vc/vc-dispatcher.el
@@ -531,8 +531,7 @@ ARG and NO-CONFIRM are passed on to `revert-buffer'."
(revert-buffer arg no-confirm t))
(vc-restore-buffer-context context)))
-(defvar vc-mode-line-hook nil)
-(make-variable-buffer-local 'vc-mode-line-hook)
+(defvar-local vc-mode-line-hook nil)
(put 'vc-mode-line-hook 'permanent-local t)
(defvar view-old-buffer-read-only)
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 94fac3a..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) '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/vc/vc.el b/lisp/vc/vc.el
index bc9f112..00976a0 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -1549,6 +1549,9 @@ After check-out, runs the normal hook `vc-checkout-hook'."
(vc-call-backend backend 'mark-resolved files)
;; FIXME: Is this TRTD? Might not be.
`((vc-state . edited)))
+ ;; Recompute mode lines.
+ (dolist (file files)
+ (vc-mode-line file backend))
(message
(substitute-command-keys
"Conflicts have been resolved in %s. \
diff --git a/lisp/vcursor.el b/lisp/vcursor.el
index e699df4..595a253 100644
--- a/lisp/vcursor.el
+++ b/lisp/vcursor.el
@@ -38,7 +38,7 @@
;; or t), which means that copying from the vcursor will be turned
;; off after any operation not involving the vcursor, but the
;; vcursor itself will be left alone.
-;; - works on dumb terminals with Emacs 19.29 and later
+;; - works on dumb terminals
;; - new keymap vcursor-map for binding to a prefix key
;; - vcursor-compare-windows substantially improved
;; - vcursor-execute-{key,command} much better about using the
@@ -50,11 +50,7 @@
;; ============
;;
;; Virtual cursor commands. I got this idea from the old BBC micro.
-;; You need Emacs 19 or 20 and a window system for the best effects.
-;; For character terminals, at least Emacs 19.29 is required
-;; (special behavior for the overlay property
-;; "before-string" must be implemented). Search for "dumb terminals"
-;; for more information.
+;; You need a window system for the best effects.
;;
;; This is much easier to use than the instructions are to read.
;; First, you need to let vcursor define some keys: setting
diff --git a/lisp/view.el b/lisp/view.el
index 5a2f2fa..026c1ec 100644
--- a/lisp/view.el
+++ b/lisp/view.el
@@ -96,38 +96,31 @@ interactive command; otherwise the help message is not
shown."
:version "22.1")
;;;###autoload
-(defvar view-mode nil
+(defvar-local view-mode nil
"Non-nil if View mode is enabled.
Don't change this variable directly, you must change it by one of the
functions that enable or disable view mode.")
-;;;###autoload
-(make-variable-buffer-local 'view-mode)
(defcustom view-mode-hook nil
"Normal hook run when starting to view a buffer or file."
:type 'hook
:group 'view)
-(defvar view-old-buffer-read-only nil)
-(make-variable-buffer-local 'view-old-buffer-read-only)
+(defvar-local view-old-buffer-read-only nil)
-(defvar view-old-Helper-return-blurb)
-(make-variable-buffer-local 'view-old-Helper-return-blurb)
+(defvar-local view-old-Helper-return-blurb nil)
-(defvar view-page-size nil
+(defvar-local view-page-size nil
"Default number of lines to scroll by View page commands.
If nil that means use the window size.")
-(make-variable-buffer-local 'view-page-size)
-(defvar view-half-page-size nil
+(defvar-local view-half-page-size nil
"Default number of lines to scroll by View half page commands.
If nil that means use half the window size.")
-(make-variable-buffer-local 'view-half-page-size)
-(defvar view-last-regexp nil)
-(make-variable-buffer-local 'view-last-regexp) ; Global is better???
+(defvar-local view-last-regexp nil) ; Global is better???
-(defvar view-return-to-alist nil
+(defvar-local view-return-to-alist nil
"What to do with used windows and where to go when finished viewing buffer.
This is local in each buffer being viewed.
It is added to by `view-mode-enter' when starting to view a buffer and
@@ -136,18 +129,16 @@ subtracted from by `view-mode-exit' when finished viewing
the buffer.
See RETURN-TO-ALIST argument of function `view-mode-exit' for the format of
`view-return-to-alist'.")
(make-obsolete-variable
- 'view-return-to-alist "this variable is no more used." "24.1")
-(make-variable-buffer-local 'view-return-to-alist)
+ 'view-return-to-alist "this variable is no longer used." "24.1")
(put 'view-return-to-alist 'permanent-local t)
-(defvar view-exit-action nil
+(defvar-local view-exit-action nil
"If non-nil, a function called when finished viewing.
The function should take one argument (a buffer).
Commands like \\[view-file] and \\[view-file-other-window] may
set this to bury or kill the viewed buffer.
Observe that the buffer viewed might not appear in any window at
the time this function is called.")
-(make-variable-buffer-local 'view-exit-action)
(defvar view-no-disable-on-exit nil
"If non-nil, View mode \"exit\" commands don't actually disable View mode.
@@ -155,10 +146,9 @@ Instead, these commands just switch buffers or windows.
This is set in certain buffers by specialized features such as help commands
that use View mode automatically.")
-(defvar view-overlay nil
+(defvar-local view-overlay nil
"Overlay used to display where a search operation found its match.
This is local in each buffer, once it is used.")
-(make-variable-buffer-local 'view-overlay)
;; Define keymap inside defvar to make it easier to load changes.
;; Some redundant "less"-like key bindings below have been commented out.
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 68a0d3d..de2b5d4 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -1019,9 +1019,8 @@ button end points."
Recommended as a parent keymap for modes using widgets.
Note that such modes will need to require wid-edit.")
-(defvar widget-global-map global-map
+(defvar-local widget-global-map global-map
"Keymap used for events a widget does not handle itself.")
-(make-variable-buffer-local 'widget-global-map)
(defvar widget-field-keymap
(let ((map (copy-keymap widget-keymap)))
@@ -1326,13 +1325,11 @@ When not inside a field, signal an error."
;;; Setting up the buffer.
-(defvar widget-field-new nil
+(defvar-local widget-field-new nil
"List of all newly created editable fields in the buffer.")
-(make-variable-buffer-local 'widget-field-new)
-(defvar widget-field-list nil
+(defvar-local widget-field-list nil
"List of all editable fields in the buffer.")
-(make-variable-buffer-local 'widget-field-list)
(defun widget-at (&optional pos)
"The button or field at POS (default, point)."
@@ -1359,13 +1356,11 @@ When not inside a field, signal an error."
(widget-clear-undo)
(widget-add-change))
-(defvar widget-field-last nil)
-;; Last field containing point.
-(make-variable-buffer-local 'widget-field-last)
+(defvar-local widget-field-last nil
+ "Last field containing point.")
-(defvar widget-field-was nil)
-;; The widget data before the change.
-(make-variable-buffer-local 'widget-field-was)
+(defvar-local widget-field-was nil
+ "The widget data before the change.")
(defun widget-field-at (pos)
"Return the widget field at POS, or nil if none."
diff --git a/lisp/window.el b/lisp/window.el
index d587691..2d0a73b 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -1500,7 +1500,7 @@ otherwise."
(window-pixel-height window)
(window-total-height window round))))
-(defvar window-size-fixed nil
+(defvar-local window-size-fixed nil
"Non-nil in a buffer means windows displaying the buffer are fixed-size.
If the value is `height', then only the window's height is fixed.
If the value is `width', then only the window's width is fixed.
@@ -1509,7 +1509,6 @@ Any other non-nil value fixes both the width and the
height.
Emacs won't change the size of any window displaying that buffer,
unless it has no other choice (like when deleting a neighboring
window).")
-(make-variable-buffer-local 'window-size-fixed)
(defun window--preservable-size (window &optional horizontal)
"Return height of WINDOW as `window-preserve-size' would preserve it.
@@ -5753,11 +5752,10 @@ nil (i.e. any), `height' or `width'."
'((height . width) (width . height))))))))
;;; A different solution to balance-windows.
-(defvar window-area-factor 1
+(defvar-local window-area-factor 1
"Factor by which the window area should be over-estimated.
This is used by `balance-windows-area'.
Changing this globally has no effect.")
-(make-variable-buffer-local 'window-area-factor)
(defun balance-windows-area-adjust (window delta horizontal pixelwise)
"Wrapper around `window-resize' with error checking.
@@ -9580,8 +9578,7 @@ buffers displaying right to left text."
;; status is undone only when explicitly programmed, not when a buffer
;; is reverted or a mode function is called.
-(defvar window-group-start-function nil)
-(make-variable-buffer-local 'window-group-start-function)
+(defvar-local window-group-start-function nil)
(put 'window-group-start-function 'permanent-local t)
(defun window-group-start (&optional window)
"Return position at which display currently starts in the group of
@@ -9594,8 +9591,7 @@ This is updated by redisplay or by calling
`set-window*-start'."
(funcall window-group-start-function window)
(window-start window)))
-(defvar window-group-end-function nil)
-(make-variable-buffer-local 'window-group-end-function)
+(defvar-local window-group-end-function nil)
(put 'window-group-end-function 'permanent-local t)
(defun window-group-end (&optional window update)
"Return position at which display currently ends in the group of
@@ -9614,8 +9610,7 @@ if it isn't already recorded."
(funcall window-group-end-function window update)
(window-end window update)))
-(defvar set-window-group-start-function nil)
-(make-variable-buffer-local 'set-window-group-start-function)
+(defvar-local set-window-group-start-function nil)
(put 'set-window-group-start-function 'permanent-local t)
(defun set-window-group-start (window pos &optional noforce)
"Make display in the group of windows containing WINDOW start at
@@ -9629,8 +9624,7 @@ overriding motion of point in order to display at this
exact start."
(funcall set-window-group-start-function window pos noforce)
(set-window-start window pos noforce)))
-(defvar recenter-window-group-function nil)
-(make-variable-buffer-local 'recenter-window-group-function)
+(defvar-local recenter-window-group-function nil)
(put 'recenter-window-group-function 'permanent-local t)
(defun recenter-window-group (&optional arg)
"Center point in the group of windows containing the selected window
@@ -9656,8 +9650,7 @@ and redisplay normally--don't erase and redraw the frame."
(funcall recenter-window-group-function arg)
(recenter arg)))
-(defvar pos-visible-in-window-group-p-function nil)
-(make-variable-buffer-local 'pos-visible-in-window-group-p-function)
+(defvar-local pos-visible-in-window-group-p-function nil)
(put 'pos-visible-in-window-group-p-function 'permanent-local t)
(defun pos-visible-in-window-group-p (&optional pos window partially)
"Return non-nil if position POS is currently on the frame in the
@@ -9687,8 +9680,7 @@ POS, ROWH is the visible height of that row, and VPOS is
the row number
(funcall pos-visible-in-window-group-p-function pos window partially)
(pos-visible-in-window-p pos window partially)))
-(defvar selected-window-group-function nil)
-(make-variable-buffer-local 'selected-window-group-function)
+(defvar-local selected-window-group-function nil)
(put 'selected-window-group-function 'permanent-local t)
(defun selected-window-group ()
"Return the list of windows in the group containing the selected window.
@@ -9698,8 +9690,7 @@ result is a list containing only the selected window."
(funcall selected-window-group-function)
(list (selected-window))))
-(defvar move-to-window-group-line-function nil)
-(make-variable-buffer-local 'move-to-window-group-line-function)
+(defvar-local move-to-window-group-line-function nil)
(put 'move-to-window-group-line-function 'permanent-local t)
(defun move-to-window-group-line (arg)
"Position point relative to the current group of windows.
@@ -9742,13 +9733,16 @@ cycling order is middle -> top -> bottom."
:group 'windows)
(defun recenter-top-bottom (&optional arg)
- "Move current buffer line to the specified window line.
-With no prefix argument, successive calls place point according
-to the cycling order defined by `recenter-positions'.
-
-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."
+ "Scroll the window so that current line is in the middle of the window.
+Successive invocations scroll the window in a cyclical order to put
+the current line at certain places within the window, as determined by
+`recenter-positions'. By default, the second invocation puts the
+current line at the top-most window line, the third invocation puts it
+on the bottom-most window line, and then the order is reused in a
+cyclical manner.
+
+With numeric prefix ARG, move current line ARG lines below the window top.
+With plain \\[universal-argument], move current line to window center."
(interactive "P")
(cond
(arg (recenter arg t)) ; Always respect ARG.
@@ -9774,6 +9768,19 @@ A prefix argument is handled like `recenter':
(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.
diff --git a/lisp/woman.el b/lisp/woman.el
index 0e4c1c1..9a03d30 100644
--- a/lisp/woman.el
+++ b/lisp/woman.el
@@ -1078,9 +1078,8 @@ Set by `.ns' request; reset by any output or `.rs'
request")
;; Could end with "\\( +\\|$\\)" instead of " *"
"Regexp to match a ?roff request plus trailing white space.")
-(defvar woman-imenu-done nil
+(defvar-local woman-imenu-done nil
"Buffer-local: set to true if function `woman-imenu' has been called.")
-(make-variable-buffer-local 'woman-imenu-done)
;; From imenu.el -- needed when reformatting a file in its old buffer.
;; The latest buffer index used to update the menu bar menu.
@@ -2115,7 +2114,7 @@ No external programs are used."
(interactive) ; mainly for testing
(WoMan-log-begin)
(run-hooks 'woman-pre-format-hook)
- (and (boundp 'font-lock-mode) font-lock-mode (font-lock-mode -1))
+ (and font-lock-mode (font-lock-mode -1))
;; (fundamental-mode)
(let ((start-time (current-time))
time)
diff --git a/src/data.c b/src/data.c
index 0dc21c8..2fa92fe 100644
--- a/src/data.c
+++ b/src/data.c
@@ -1893,7 +1893,9 @@ a variable local to the current buffer for one particular
use, use
while setting up a new major mode, unless they have a `permanent-local'
property.
-The function `default-value' gets the default value and `set-default' sets it.
*/)
+The function `default-value' gets the default value and `set-default' sets it.
+
+See also `defvar-local'. */)
(register Lisp_Object variable)
{
struct Lisp_Symbol *sym;
diff --git a/src/editfns.c b/src/editfns.c
index e328549..991f79a 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -3134,6 +3134,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool
message)
char *format_start = SSDATA (args[0]);
bool multibyte_format = STRING_MULTIBYTE (args[0]);
ptrdiff_t formatlen = SBYTES (args[0]);
+ bool fmt_props = string_intervals (args[0]);
/* Upper bound on number of format specs. Each uses at least 2 chars. */
ptrdiff_t nspec_bound = SCHARS (args[0]) >> 1;
@@ -3406,13 +3407,20 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool
message)
convbytes += padding;
if (convbytes <= buf + bufsize - p)
{
+ /* If the format spec has properties, we should account
+ for the padding on the left in the info[] array. */
+ if (fmt_props)
+ spec->start = nchars;
if (! minus_flag)
{
memset (p, ' ', padding);
p += padding;
nchars += padding;
}
- spec->start = nchars;
+ /* If the properties will come from the argument, we
+ don't extend them to the left due to padding. */
+ if (!fmt_props)
+ spec->start = nchars;
if (p > buf
&& multibyte
diff --git a/src/eval.c b/src/eval.c
index cef9407..bf5f699 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -827,6 +827,8 @@ The optional argument DOCSTRING is a documentation string
for the
variable.
To define a user option, use `defcustom' instead of `defvar'.
+
+To define a buffer-local variable, use `defvar-local'.
usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
(Lisp_Object args)
{
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/frame.c b/src/frame.c
index a2167ce..635fc94 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -898,6 +898,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;
@@ -3544,10 +3545,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,
@@ -4311,7 +4319,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,
diff --git a/src/frame.h b/src/frame.h
index 9b0852c..9ddcb4c 100644
--- a/src/frame.h
+++ b/src/frame.h
@@ -1449,11 +1449,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
@@ -1707,7 +1707,7 @@ extern Lisp_Object gui_display_get_resource (Display_Info
*,
Lisp_Object component,
Lisp_Object subclass);
-extern void set_frame_menubar (struct frame *f, bool first_time, bool deep_p);
+extern void set_frame_menubar (struct frame *f, bool deep_p);
extern void frame_set_mouse_pixel_position (struct frame *f, int pix_x, int
pix_y);
extern void free_frame_menubar (struct frame *);
extern bool frame_ancestor_p (struct frame *af, struct frame *df);
diff --git a/src/keymap.c b/src/keymap.c
index de9b2b5..782931f 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -1065,9 +1065,6 @@ binding KEY to DEF is added at the front of KEYMAP. */)
if (length == 0)
return Qnil;
- if (SYMBOLP (def) && !EQ (Vdefine_key_rebound_commands, Qt))
- Vdefine_key_rebound_commands = Fcons (def, Vdefine_key_rebound_commands);
-
int meta_bit = (VECTORP (key) || (STRINGP (key) && STRING_MULTIBYTE (key))
? meta_modifier : 0x80);
@@ -3132,12 +3129,6 @@ syms_of_keymap (void)
pure_cons (build_pure_c_string ("SPC"), build_pure_c_string (" ")));
staticpro (&exclude_keys);
- DEFVAR_LISP ("define-key-rebound-commands", Vdefine_key_rebound_commands,
- doc: /* List of commands given new key bindings recently.
-This is used for internal purposes during Emacs startup;
-don't alter it yourself. */);
- Vdefine_key_rebound_commands = Qt;
-
DEFVAR_LISP ("minibuffer-local-map", Vminibuffer_local_map,
doc: /* Default keymap to use when reading from the minibuffer.
*/);
Vminibuffer_local_map = Fmake_sparse_keymap (Qnil);
diff --git a/src/lisp.h b/src/lisp.h
index 296f9af..1d4f16b 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3752,6 +3752,7 @@ extern void message_log_maybe_newline (void);
extern void update_echo_area (void);
extern void truncate_echo_area (ptrdiff_t);
extern void redisplay (void);
+extern ptrdiff_t count_lines (ptrdiff_t start_byte, ptrdiff_t end_byte);
void set_frame_cursor_types (struct frame *, Lisp_Object);
extern void syms_of_xdisp (void);
diff --git a/src/lread.c b/src/lread.c
index 4cf4f8c..d947c4e 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -537,6 +537,33 @@ readbyte_from_string (int c, Lisp_Object readcharfun)
}
+/* Signal Qinvalid_read_syntax error.
+ S is error string of length N (if > 0) */
+
+static AVOID
+invalid_syntax_lisp (Lisp_Object s, Lisp_Object readcharfun)
+{
+ if (BUFFERP (readcharfun))
+ {
+ xsignal (Qinvalid_read_syntax,
+ list3 (s,
+ /* We should already be in the readcharfun
+ buffer when this error is called, so no need
+ to switch to it first. */
+ make_fixnum (count_lines (BEGV_BYTE, PT_BYTE) + 1),
+ make_fixnum (current_column ())));
+ }
+ else
+ xsignal1 (Qinvalid_read_syntax, s);
+}
+
+static AVOID
+invalid_syntax (const char *s, Lisp_Object readcharfun)
+{
+ invalid_syntax_lisp (build_string (s), readcharfun);
+}
+
+
/* Read one non-ASCII character from INFILE. The character is
encoded in `emacs-mule' and the first byte is already read in
C. */
@@ -594,8 +621,7 @@ read_emacs_mule_char (int c, int (*readbyte) (int,
Lisp_Object), Lisp_Object rea
}
c = DECODE_CHAR (charset, code);
if (c < 0)
- Fsignal (Qinvalid_read_syntax,
- list1 (build_string ("invalid multibyte form")));
+ invalid_syntax ("invalid multibyte form", readcharfun);
return c;
}
@@ -778,7 +804,10 @@ If `inhibit-interaction' is non-nil, this function will
signal an
barf_if_interaction_inhibited ();
if (! NILP (prompt))
- message_with_string ("%s", prompt, 0);
+ {
+ cancel_echoing ();
+ message_with_string ("%s", prompt, 0);
+ }
val = read_filtered_event (1, 1, 1, ! NILP (inherit_input_method), seconds);
return (NILP (val) ? Qnil
@@ -813,7 +842,10 @@ If `inhibit-interaction' is non-nil, this function will
signal an
barf_if_interaction_inhibited ();
if (! NILP (prompt))
- message_with_string ("%s", prompt, 0);
+ {
+ cancel_echoing ();
+ message_with_string ("%s", prompt, 0);
+ }
return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method), seconds);
}
@@ -849,7 +881,10 @@ If `inhibit-interaction' is non-nil, this function will
signal an
barf_if_interaction_inhibited ();
if (! NILP (prompt))
- message_with_string ("%s", prompt, 0);
+ {
+ cancel_echoing ();
+ message_with_string ("%s", prompt, 0);
+ }
val = read_filtered_event (1, 1, 0, ! NILP (inherit_input_method), seconds);
@@ -2424,16 +2459,6 @@ read_internal_start (Lisp_Object stream, Lisp_Object
start, Lisp_Object end)
}
-/* Signal Qinvalid_read_syntax error.
- S is error string of length N (if > 0) */
-
-static AVOID
-invalid_syntax (const char *s)
-{
- xsignal1 (Qinvalid_read_syntax, build_string (s));
-}
-
-
/* Use this for recursive reads, in contexts where internal tokens
are not allowed. */
@@ -2447,8 +2472,8 @@ read0 (Lisp_Object readcharfun)
if (!c)
return val;
- xsignal1 (Qinvalid_read_syntax,
- Fmake_string (make_fixnum (1), make_fixnum (c), Qnil));
+ invalid_syntax_lisp (Fmake_string (make_fixnum (1), make_fixnum (c), Qnil),
+ readcharfun);
}
/* Grow a read buffer BUF that contains OFFSET useful bytes of data,
@@ -2478,7 +2503,8 @@ grow_read_buffer (char *buf, ptrdiff_t offset,
/* Return the scalar value that has the Unicode character name NAME.
Raise 'invalid-read-syntax' if there is no such character. */
static int
-character_name_to_code (char const *name, ptrdiff_t name_len)
+character_name_to_code (char const *name, ptrdiff_t name_len,
+ Lisp_Object readcharfun)
{
/* For "U+XXXX", pass the leading '+' to string_to_number to reject
monstrosities like "U+-0000". */
@@ -2494,7 +2520,7 @@ character_name_to_code (char const *name, ptrdiff_t
name_len)
{
AUTO_STRING (format, "\\N{%s}");
AUTO_STRING_WITH_LEN (namestr, name, name_len);
- xsignal1 (Qinvalid_read_syntax, CALLN (Fformat, format, namestr));
+ invalid_syntax_lisp (CALLN (Fformat, format, namestr), readcharfun);
}
return XFIXNUM (code);
@@ -2713,7 +2739,7 @@ read_escape (Lisp_Object readcharfun, bool stringp)
{
c = READCHAR;
if (c != '{')
- invalid_syntax ("Expected opening brace after \\N");
+ invalid_syntax ("Expected opening brace after \\N", readcharfun);
char name[UNICODE_CHARACTER_NAME_LENGTH_BOUND + 1];
bool whitespace = false;
ptrdiff_t length = 0;
@@ -2728,8 +2754,9 @@ read_escape (Lisp_Object readcharfun, bool stringp)
{
AUTO_STRING (format,
"Invalid character U+%04X in character name");
- xsignal1 (Qinvalid_read_syntax,
- CALLN (Fformat, format, make_fixed_natnum (c)));
+ invalid_syntax_lisp (CALLN (Fformat, format,
+ make_fixed_natnum (c)),
+ readcharfun);
}
/* Treat multiple adjacent whitespace characters as a
single space character. This makes it easier to use
@@ -2745,15 +2772,15 @@ read_escape (Lisp_Object readcharfun, bool stringp)
whitespace = false;
name[length++] = c;
if (length >= sizeof name)
- invalid_syntax ("Character name too long");
+ invalid_syntax ("Character name too long", readcharfun);
}
if (length == 0)
- invalid_syntax ("Empty character name");
+ invalid_syntax ("Empty character name", readcharfun);
name[length] = '\0';
/* character_name_to_code can invoke read1, recursively.
This is why read1's buffer is not static. */
- return character_name_to_code (name, length);
+ return character_name_to_code (name, length, readcharfun);
}
default:
@@ -2791,10 +2818,11 @@ enum { stackbufsize = max (64,
+ INT_STRLEN_BOUND (EMACS_INT) + 1)) };
static void
-invalid_radix_integer (EMACS_INT radix, char stackbuf[VLA_ELEMS
(stackbufsize)])
+invalid_radix_integer (EMACS_INT radix, char stackbuf[VLA_ELEMS
(stackbufsize)],
+ Lisp_Object readcharfun)
{
sprintf (stackbuf, invalid_radix_integer_format, radix);
- invalid_syntax (stackbuf);
+ invalid_syntax (stackbuf, readcharfun);
}
/* Read an integer in radix RADIX using READCHARFUN to read
@@ -2854,7 +2882,7 @@ read_integer (Lisp_Object readcharfun, int radix,
UNREAD (c);
if (valid != 1)
- invalid_radix_integer (radix, stackbuf);
+ invalid_radix_integer (radix, stackbuf, readcharfun);
*p = '\0';
return unbind_to (count, string_to_number (read_buffer, radix, NULL));
@@ -2990,7 +3018,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool
first_in_list)
return ht;
}
UNREAD (c);
- invalid_syntax ("#");
+ invalid_syntax ("#", readcharfun);
}
if (c == '^')
{
@@ -3042,9 +3070,9 @@ read1 (Lisp_Object readcharfun, int *pch, bool
first_in_list)
}
return tbl;
}
- invalid_syntax ("#^^");
+ invalid_syntax ("#^^", readcharfun);
}
- invalid_syntax ("#^");
+ invalid_syntax ("#^", readcharfun);
}
if (c == '&')
{
@@ -3067,7 +3095,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool
first_in_list)
version. */
&& ! (XFIXNAT (length)
== (SCHARS (tmp) - 1) * BOOL_VECTOR_BITS_PER_CHAR)))
- invalid_syntax ("#&...");
+ invalid_syntax ("#&...", readcharfun);
val = make_uninit_bool_vector (XFIXNAT (length));
data = bool_vector_uchar_data (val);
@@ -3078,7 +3106,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool
first_in_list)
&= (1 << (XFIXNUM (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
return val;
}
- invalid_syntax ("#&...");
+ invalid_syntax ("#&...", readcharfun);
}
if (c == '[')
{
@@ -3096,7 +3124,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool
first_in_list)
&& VECTORP (AREF (tmp, COMPILED_CONSTANTS)))
|| CONSP (AREF (tmp, COMPILED_BYTECODE)))
&& FIXNATP (AREF (tmp, COMPILED_STACK_DEPTH))))
- invalid_syntax ("Invalid byte-code object");
+ invalid_syntax ("Invalid byte-code object", readcharfun);
if (STRINGP (AREF (tmp, COMPILED_BYTECODE))
&& STRING_MULTIBYTE (AREF (tmp, COMPILED_BYTECODE)))
@@ -3138,7 +3166,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool
first_in_list)
/* Read the string itself. */
tmp = read1 (readcharfun, &ch, 0);
if (ch != 0 || !STRINGP (tmp))
- invalid_syntax ("#");
+ invalid_syntax ("#", readcharfun);
/* Read the intervals and their properties. */
while (1)
{
@@ -3153,7 +3181,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool
first_in_list)
if (ch == 0)
plist = read1 (readcharfun, &ch, 0);
if (ch)
- invalid_syntax ("Invalid string property list");
+ invalid_syntax ("Invalid string property list", readcharfun);
Fset_text_properties (beg, end, plist, tmp);
}
@@ -3301,7 +3329,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool
first_in_list)
if (c == 'r' || c == 'R')
{
if (! (2 <= n && n <= 36))
- invalid_radix_integer (n, stackbuf);
+ invalid_radix_integer (n, stackbuf, readcharfun);
return read_integer (readcharfun, n, stackbuf);
}
@@ -3395,7 +3423,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool
first_in_list)
return read_integer (readcharfun, 2, stackbuf);
UNREAD (c);
- invalid_syntax ("#");
+ invalid_syntax ("#", readcharfun);
case ';':
while ((c = READCHAR) >= 0 && c != '\n');
@@ -3467,7 +3495,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool
first_in_list)
if (ok)
return make_fixnum (c);
- invalid_syntax ("?");
+ invalid_syntax ("?", readcharfun);
}
case '"':
@@ -3553,7 +3581,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool
first_in_list)
/* Any modifiers remaining are invalid. */
if (modifiers)
- invalid_syntax ("Invalid modifier in string");
+ invalid_syntax ("Invalid modifier in string", readcharfun);
p += CHAR_STRING (ch, (unsigned char *) p);
}
else
@@ -4093,7 +4121,7 @@ read_list (bool flag, Lisp_Object readcharfun)
{
if (ch == ']')
return val;
- invalid_syntax (") or . in a vector");
+ invalid_syntax (") or . in a vector", readcharfun);
}
if (ch == ')')
return val;
@@ -4173,9 +4201,9 @@ read_list (bool flag, Lisp_Object readcharfun)
return val;
}
- invalid_syntax (". in wrong context");
+ invalid_syntax (". in wrong context", readcharfun);
}
- invalid_syntax ("] in a list");
+ invalid_syntax ("] in a list", readcharfun);
}
tem = list1 (elt);
if (!NILP (tail))
@@ -4908,7 +4936,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/macros.c b/src/macros.c
index c8ce94e..60d0766 100644
--- a/src/macros.c
+++ b/src/macros.c
@@ -279,7 +279,10 @@ its function definition is used.
COUNT is a repeat count, or nil for once, or 0 for infinite loop.
Optional third arg LOOPFUNC may be a function that is called prior to
-each iteration of the macro. Iteration stops if LOOPFUNC returns nil. */)
+each iteration of the macro. Iteration stops if LOOPFUNC returns nil.
+
+The buffer shown in the currently selected window will be made the current
+buffer before the macro is executed. */)
(Lisp_Object macro, Lisp_Object count, Lisp_Object loopfunc)
{
Lisp_Object final;
diff --git a/src/minibuf.c b/src/minibuf.c
index 5df1045..949c3d9 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -594,6 +594,18 @@ read_minibuf (Lisp_Object map, Lisp_Object initial,
Lisp_Object prompt,
record_unwind_protect (restore_buffer, Fcurrent_buffer ());
choose_minibuf_frame ();
+ mini_frame = WINDOW_FRAME (XWINDOW (minibuf_window));
+
+ if (minibuf_level > 1
+ && minibuf_moves_frame_when_opened ()
+ && !minibuf_follows_frame ())
+ {
+ EMACS_INT i;
+
+ /* Stack up the existing minibuffers on the current mini-window */
+ for (i = 1; i < minibuf_level; i++)
+ set_window_buffer (minibuf_window, nth_minibuffer (i), 0, 0);
+ }
record_unwind_protect_void (choose_minibuf_frame);
@@ -602,7 +614,6 @@ read_minibuf (Lisp_Object map, Lisp_Object initial,
Lisp_Object prompt,
/* If the minibuffer window is on a different frame, save that
frame's configuration too. */
- mini_frame = WINDOW_FRAME (XWINDOW (minibuf_window));
if (!EQ (mini_frame, selected_frame))
record_unwind_protect (restore_window_configuration,
Fcons (/* Arrange for the frame later to be
@@ -745,17 +756,6 @@ read_minibuf (Lisp_Object map, Lisp_Object initial,
Lisp_Object prompt,
}
}
- if (minibuf_moves_frame_when_opened ())
- {
- EMACS_INT i;
-
- /* Stack up all the (recursively) open minibuffers on the selected
- mini_window. */
- for (i = 1; i < minibuf_level; i++)
- set_window_buffer (XFRAME (mini_frame)->minibuffer_window,
- nth_minibuffer (i), 0, 0);
- }
-
/* Display this minibuffer in the proper window. */
/* Use set_window_buffer instead of Fset_window_buffer (see
discussion of bug#11984, bug#12025, bug#12026). */
@@ -926,6 +926,31 @@ nth_minibuffer (EMACS_INT depth)
return XCAR (tail);
}
+/* Set the major mode of the minibuffer BUF, depending on DEPTH, the
+ minibuffer depth. */
+
+static void
+set_minibuffer_mode (Lisp_Object buf, EMACS_INT depth)
+{
+ ptrdiff_t count = SPECPDL_INDEX ();
+
+ record_unwind_current_buffer ();
+ Fset_buffer (buf);
+ if (depth > 0)
+ {
+ if (!NILP (Ffboundp (intern ("fundamental-mode"))))
+ call0 (intern ("fundamental-mode"));
+ }
+ else
+ {
+ if (!NILP (Ffboundp (intern ("minibuffer-inactive-mode"))))
+ call0 (intern ("minibuffer-inactive-mode"));
+ else
+ Fkill_all_local_variables ();
+ }
+ buf = unbind_to (count, buf);
+}
+
/* Return a buffer to be used as the minibuffer at depth `depth'.
depth = 0 is the lowest allowed argument, and that is the value
used for nonrecursive minibuffer invocations. */
@@ -946,28 +971,21 @@ get_minibuffer (EMACS_INT depth)
char name[sizeof name_fmt + INT_STRLEN_BOUND (EMACS_INT)];
AUTO_STRING_WITH_LEN (lname, name, sprintf (name, name_fmt, 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);
-
- XSETCAR (tail, buf);
}
else
{
- ptrdiff_t count = SPECPDL_INDEX ();
/* We have to empty both overlay lists. Otherwise we end
up with overlays that think they belong to this buffer
while the buffer doesn't know about them any more. */
delete_all_overlays (XBUFFER (buf));
reset_buffer (XBUFFER (buf));
- record_unwind_current_buffer ();
- Fset_buffer (buf);
- if (!NILP (Ffboundp (intern ("minibuffer-inactive-mode"))))
- call0 (intern ("minibuffer-inactive-mode"));
- else
- Fkill_all_local_variables ();
- buf = unbind_to (count, buf);
+ set_minibuffer_mode (buf, depth);
}
return buf;
diff --git a/src/nsfns.m b/src/nsfns.m
index c383e2f..5c4cc91 100644
--- a/src/nsfns.m
+++ b/src/nsfns.m
@@ -482,7 +482,7 @@ ns_set_represented_filename (struct frame *f)
#if defined (NS_IMPL_COCOA) && defined (MAC_OS_X_VERSION_10_7)
/* Work around for Mach port leaks on macOS 10.15 (bug#38618). */
NSURL *fileURL = [NSURL fileURLWithPath:fstr isDirectory:NO];
- NSNumber *isUbiquitousItem = @YES;
+ NSNumber *isUbiquitousItem = [NSNumber numberWithBool:YES];
[fileURL getResourceValue:(id *)&isUbiquitousItem
forKey:NSURLIsUbiquitousItemKey
error:nil];
@@ -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/nsmenu.m b/src/nsmenu.m
index f8219d2..24aa5a0 100644
--- a/src/nsmenu.m
+++ b/src/nsmenu.m
@@ -405,7 +405,7 @@ ns_update_menubar (struct frame *f, bool deep_p)
frame's menus have changed, and the *step representation should be updated
from Lisp. */
void
-set_frame_menubar (struct frame *f, bool first_time, bool deep_p)
+set_frame_menubar (struct frame *f, bool deep_p)
{
ns_update_menubar (f, deep_p);
}
@@ -1795,7 +1795,7 @@ DEFUN ("ns-reset-menu", Fns_reset_menu, Sns_reset_menu,
0, 0, 0,
doc: /* Cause the NS menu to be re-calculated. */)
(void)
{
- set_frame_menubar (SELECTED_FRAME (), 1, 0);
+ set_frame_menubar (SELECTED_FRAME (), 0);
return Qnil;
}
diff --git a/src/w32fns.c b/src/w32fns.c
index e93a0b8..86c3db6 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))
{
@@ -1637,7 +1643,7 @@ w32_set_menu_bar_lines (struct frame *f, Lisp_Object
value, Lisp_Object oldval)
if (!old)
/* Make menu bar when there was none. Emacs 25 waited until
the next redisplay for this to take effect. */
- set_frame_menubar (f, false, true);
+ set_frame_menubar (f, true);
else
{
/* Remove menu bar. */
@@ -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/w32menu.c b/src/w32menu.c
index 8bf0c46..3bf7666 100644
--- a/src/w32menu.c
+++ b/src/w32menu.c
@@ -155,7 +155,7 @@ w32_popup_dialog (struct frame *f, Lisp_Object header,
Lisp_Object contents)
void
w32_activate_menubar (struct frame *f)
{
- set_frame_menubar (f, false, true);
+ set_frame_menubar (f, true);
/* Lock out further menubar changes while active. */
f->output_data.w32->menubar_active = 1;
@@ -258,12 +258,10 @@ menubar_selection_callback (struct frame *f, void *
client_data)
}
-/* Set the contents of the menubar widgets of frame F.
- The argument FIRST_TIME is currently ignored;
- it is set the first time this is called, from initialize_frame_menubar. */
+/* Set the contents of the menubar widgets of frame F. */
void
-set_frame_menubar (struct frame *f, bool first_time, bool deep_p)
+set_frame_menubar (struct frame *f, bool deep_p)
{
HMENU menubar_widget = f->output_data.w32->menubar_widget;
Lisp_Object items;
@@ -511,7 +509,7 @@ initialize_frame_menubar (struct frame *f)
/* This function is called before the first chance to redisplay
the frame. It has to be, so the frame will have the right size. */
fset_menu_bar_items (f, menu_bar_items (FRAME_MENU_BAR_ITEMS (f)));
- set_frame_menubar (f, true, true);
+ set_frame_menubar (f, true);
}
/* Get rid of the menu bar of frame F, and free its storage.
diff --git a/src/xdisp.c b/src/xdisp.c
index 11b9e1b..fb8eaf4 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -10706,6 +10706,7 @@ include the height of both, if present, in the return
value. */)
itdata = bidi_shelve_cache ();
start_display (&it, w, startp);
+ int start_y = it.current_y;
/* It makes no sense to measure dimensions of region of text that
crosses the point where bidi reordering changes scan direction.
By using unidirectional movement here we at least support the use
@@ -10714,8 +10715,23 @@ include the height of both, if present, in the return
value. */)
same directionality. */
it.bidi_p = false;
+ /* Start at the beginning of the line containing FROM. Otherwise
+ IT.current_x will be incorrectly set to zero at some arbitrary
+ non-zero X coordinate. */
+ reseat_at_previous_visible_line_start (&it);
+ it.current_x = it.hpos = 0;
+ if (IT_CHARPOS (it) != start)
+ move_it_to (&it, start, -1, -1, -1, MOVE_TO_POS);
+
+ /* Now move to TO. */
+ int start_x = it.current_x;
int move_op = MOVE_TO_POS | MOVE_TO_Y;
int to_x = -1;
+ it.current_y = start_y;
+ /* If FROM is on a newline, pretend that we start at the beginning
+ of the next line, because the newline takes no place on display. */
+ if (FETCH_BYTE (start) == '\n')
+ it.current_x = 0;
if (!NILP (x_limit))
{
it.last_visible_x = max_x;
@@ -10758,8 +10774,14 @@ include the height of both, if present, in the return
value. */)
x = max_x;
}
- /* Subtract height of header-line which was counted automatically by
- start_display. */
+ /* If text spans more than one screen line, we don't need to adjust
+ the x-span for start_x, since the second and subsequent lines
+ will begin at zero X coordinate. */
+ if (it.current_y > start_y)
+ start_x = 0;
+
+ /* Subtract height of header-line and tab-line which was counted
+ automatically by start_display. */
y = it.current_y + it.max_ascent + it.max_descent
- WINDOW_TAB_LINE_HEIGHT (w) - WINDOW_HEADER_LINE_HEIGHT (w);
/* Don't return more than Y-LIMIT. */
@@ -10786,7 +10808,7 @@ include the height of both, if present, in the return
value. */)
if (old_b)
set_buffer_internal (old_b);
- return Fcons (make_fixnum (x), make_fixnum (y));
+ return Fcons (make_fixnum (x - start_x), make_fixnum (y));
}
/***********************************************************************
@@ -12876,7 +12898,7 @@ update_menu_bar (struct frame *f, bool save_match_data,
bool hooks_run)
the selected frame should be allowed to set it. */
if (f == SELECTED_FRAME ())
#endif
- set_frame_menubar (f, false, false);
+ set_frame_menubar (f, false);
}
else
/* On a terminal screen, the menu bar is an ordinary screen
@@ -19430,8 +19452,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);
@@ -19440,7 +19465,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
@@ -26969,6 +26994,15 @@ decode_mode_spec (struct window *w, register int c,
int field_width,
return "";
}
+/* Return the number of lines between start_byte and end_byte in the
+ current buffer. */
+
+ptrdiff_t
+count_lines (ptrdiff_t start_byte, ptrdiff_t end_byte)
+{
+ ptrdiff_t ignored;
+ return display_count_lines (start_byte, end_byte, ZV, &ignored);
+}
/* Count up to COUNT lines starting from START_BYTE. COUNT negative
means count lines back from START_BYTE. But don't go beyond
@@ -35101,7 +35135,8 @@ of your window manager. */);
This dynamically changes the tab-bar's height to the minimum height
that is needed to make all tab-bar items visible.
If value is `grow-only', the tab-bar's height is only increased
-automatically; to decrease the tab-bar height, use \\[recenter]. */);
+automatically; to decrease the tab-bar height, use \\[recenter],
+after setting `recenter-redisplay' to the value of t. */);
Vauto_resize_tab_bars = Qt;
DEFVAR_BOOL ("auto-raise-tab-bar-buttons", auto_raise_tab_bar_buttons_p,
@@ -35113,7 +35148,8 @@ automatically; to decrease the tab-bar height, use
\\[recenter]. */);
This dynamically changes the tool-bar's height to the minimum height
that is needed to make all tool-bar items visible.
If value is `grow-only', the tool-bar's height is only increased
-automatically; to decrease the tool-bar height, use \\[recenter]. */);
+automatically; to decrease the tool-bar height, use \\[recenter],
+after setting `recenter-redisplay' to the value of t. */);
Vauto_resize_tool_bars = Qt;
DEFVAR_BOOL ("auto-raise-tool-bar-buttons", auto_raise_tool_bar_buttons_p,
diff --git a/src/xfaces.c b/src/xfaces.c
index 1208713..4b02000 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -289,7 +289,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..481ee0e 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),
diff --git a/src/xmenu.c b/src/xmenu.c
index ea3813a..a83fffb 100644
--- a/src/xmenu.c
+++ b/src/xmenu.c
@@ -289,7 +289,7 @@ DEFUN ("x-menu-bar-open-internal",
Fx_menu_bar_open_internal, Sx_menu_bar_open_i
block_input ();
if (FRAME_EXTERNAL_MENU_BAR (f))
- set_frame_menubar (f, false, true);
+ set_frame_menubar (f, true);
menubar = FRAME_X_OUTPUT (f)->menubar_widget;
if (menubar)
@@ -368,7 +368,7 @@ If FRAME is nil or not given, use the selected frame. */)
f = decode_window_system_frame (frame);
if (FRAME_EXTERNAL_MENU_BAR (f))
- set_frame_menubar (f, false, true);
+ set_frame_menubar (f, true);
menubar = FRAME_X_OUTPUT (f)->menubar_widget;
if (menubar)
@@ -433,7 +433,7 @@ x_activate_menubar (struct frame *f)
return;
#endif
- set_frame_menubar (f, false, true);
+ set_frame_menubar (f, true);
block_input ();
popup_activated_flag = 1;
#ifdef USE_GTK
@@ -677,12 +677,10 @@ apply_systemfont_to_menu (struct frame *f, Widget w)
#endif
-/* Set the contents of the menubar widgets of frame F.
- The argument FIRST_TIME is currently ignored;
- it is set the first time this is called, from initialize_frame_menubar. */
+/* Set the contents of the menubar widgets of frame F. */
void
-set_frame_menubar (struct frame *f, bool first_time, bool deep_p)
+set_frame_menubar (struct frame *f, bool deep_p)
{
xt_or_gtk_widget menubar_widget, old_widget;
#ifdef USE_X_TOOLKIT
@@ -1029,7 +1027,7 @@ initialize_frame_menubar (struct frame *f)
/* This function is called before the first chance to redisplay
the frame. It has to be, so the frame will have the right size. */
fset_menu_bar_items (f, menu_bar_items (FRAME_MENU_BAR_ITEMS (f)));
- set_frame_menubar (f, true, true);
+ set_frame_menubar (f, true);
}
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/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-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..f8ca39c 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:
diff --git a/test/lisp/emacs-lisp/edebug-tests.el
b/test/lisp/emacs-lisp/edebug-tests.el
index d60a6cb..6a6080d 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:
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/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/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/minibuffer-tests.el b/test/lisp/minibuffer-tests.el
index 3ebca14..7349b19 100644
--- a/test/lisp/minibuffer-tests.el
+++ b/test/lisp/minibuffer-tests.el
@@ -1,4 +1,4 @@
-;;; completion-tests.el --- Tests for completion functions -*-
lexical-binding: t; -*-
+;;; minibuffer-tests.el --- Tests for completion functions -*-
lexical-binding: t; -*-
;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
@@ -107,5 +107,23 @@
nil (length input))
(cons output (length output)))))))
-(provide 'completion-tests)
-;;; completion-tests.el ends here
+(ert-deftest completion--insert-strings-faces ()
+ (with-temp-buffer
+ (completion--insert-strings
+ '(("completion1" "suffix1")))
+ (should (equal (get-text-property 12 'face) '(completions-annotations))))
+ (with-temp-buffer
+ (completion--insert-strings
+ '(("completion1" #("suffix1" 0 7 (face shadow)))))
+ (should (equal (get-text-property 12 'face) 'shadow)))
+ (with-temp-buffer
+ (completion--insert-strings
+ '(("completion1" "prefix1" "suffix1")))
+ (should (equal (get-text-property 19 'face) nil)))
+ (with-temp-buffer
+ (completion--insert-strings
+ '(("completion1" "prefix1" #("suffix1" 0 7 (face shadow)))))
+ (should (equal (get-text-property 19 'face) 'shadow))))
+
+(provide 'minibuffer-tests)
+;;; minibuffer-tests.el ends here
diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el
index 34a2af1..53c786a 100644
--- a/test/lisp/net/dbus-tests.el
+++ b/test/lisp/net/dbus-tests.el
@@ -465,6 +465,14 @@
(should (eq (dbus-unregister-service bus dbus--test-service) :non-existent))
(should-not (member dbus--test-service (dbus-list-known-names bus)))
+ ;; A service name is a string, constructed of at least two words
+ ;; separated by ".".
+ (should
+ (equal
+ (butlast
+ (should-error (dbus-register-service bus "s")))
+ `(dbus-error ,dbus-error-invalid-args)))
+
;; `dbus-service-dbus' is reserved for the BUS itself.
(should
(equal
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 19a40fd..f488392 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -5739,6 +5739,11 @@ This does not support globbing characters in file names
(yet)."
(string-match-p
"ftp$" (file-remote-p tramp-test-temporary-file-directory 'method)))
+(defun tramp--test-gdrive-p ()
+ "Check, whether the gdrive method is used."
+ (string-equal
+ "gdrive" (file-remote-p tramp-test-temporary-file-directory 'method)))
+
(defun tramp--test-gvfs-p (&optional method)
"Check, whether the remote host runs a GVFS based method.
This requires restrictions of file name syntax.
@@ -5769,11 +5774,6 @@ This does not support external Emacs calls."
(string-equal
"mock" (file-remote-p tramp-test-temporary-file-directory 'method)))
-(defun tramp--test-nextcloud-p ()
- "Check, whether the nextcloud method is used."
- (string-equal
- "nextcloud" (file-remote-p tramp-test-temporary-file-directory 'method)))
-
(defun tramp--test-rclone-p ()
"Check, whether the remote host is offered by rclone.
This requires restrictions of file name syntax."
@@ -6144,7 +6144,6 @@ Use the `ls' command."
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-rsync-p)))
- (skip-unless (not (tramp--test-windows-nt-and-batch-p)))
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
(skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
@@ -6214,6 +6213,7 @@ Use the `ls' command."
(skip-unless (not (tramp--test-windows-nt-and-batch-p)))
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
(skip-unless (not (tramp--test-ksh-p)))
+ (skip-unless (not (tramp--test-gdrive-p)))
(skip-unless (not (tramp--test-crypt-p)))
(skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
@@ -6747,8 +6747,6 @@ If INTERACTIVE is non-nil, the tests are run
interactively."
;; * Work on skipped tests. Make a comment, when it is impossible.
;; * Revisit expensive tests, once problems in `tramp-error' are solved.
;; * Fix `tramp-test06-directory-file-name' for `ftp'.
-;; * Investigate, why `tramp-test11-copy-file' and `tramp-test12-rename-file'
-;; do not work properly for `nextcloud'.
;; * Implement `tramp-test31-interrupt-process' for `adb' and for
;; direct async processes.
;; * Fix `tramp-test44-threads'.
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/ruby-mode-resources/ruby.rb
b/test/lisp/progmodes/ruby-mode-resources/ruby.rb
index 434237c..8c698e4 100644
--- a/test/lisp/progmodes/ruby-mode-resources/ruby.rb
+++ b/test/lisp/progmodes/ruby-mode-resources/ruby.rb
@@ -108,7 +108,7 @@ foo( # ruby-deep-indent-disabled
# Multiline regexp.
/bars
tees # toots
- nfoos/
+ nfoos::/
def test1(arg)
puts "hello"
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..92b6cc9 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/editfns-tests.el b/test/src/editfns-tests.el
index 64f9137..dcec971 100644
--- a/test/src/editfns-tests.el
+++ b/test/src/editfns-tests.el
@@ -106,7 +106,27 @@
#("foobar" 3 6 (face error))))
(should (ert-equal-including-properties
(format (concat "%s " (propertize "%s" 'face 'error)) "foo" "bar")
- #("foo bar" 4 7 (face error)))))
+ #("foo bar" 4 7 (face error))))
+ ;; Bug #46317
+ (let ((s (propertize "X" 'prop "val")))
+ (should (ert-equal-including-properties
+ (format (concat "%3s/" s) 12)
+ #(" 12/X" 4 5 (prop "val"))))
+ (should (ert-equal-including-properties
+ (format (concat "%3S/" s) 12)
+ #(" 12/X" 4 5 (prop "val"))))
+ (should (ert-equal-including-properties
+ (format (concat "%3d/" s) 12)
+ #(" 12/X" 4 5 (prop "val"))))
+ (should (ert-equal-including-properties
+ (format (concat "%-3s/" s) 12)
+ #("12 /X" 4 5 (prop "val"))))
+ (should (ert-equal-including-properties
+ (format (concat "%-3S/" s) 12)
+ #("12 /X" 4 5 (prop "val"))))
+ (should (ert-equal-including-properties
+ (format (concat "%-3d/" s) 12)
+ #("12 /X" 4 5 (prop "val"))))))
;; Tests for bug#5131.
(defun transpose-test-reverse-word (start end)
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/minibuf-tests.el b/test/src/minibuf-tests.el
index 28119fc..c55611e 100644
--- a/test/src/minibuf-tests.el
+++ b/test/src/minibuf-tests.el
@@ -412,11 +412,11 @@
(ert-deftest test-inhibit-interaction ()
(let ((inhibit-interaction t))
- (should-error (read-from-minibuffer "foo: "))
+ (should-error (read-from-minibuffer "foo: ") :type 'inhibited-interaction)
- (should-error (y-or-n-p "foo: "))
- (should-error (yes-or-no-p "foo: "))
- (should-error (read-blanks-no-input "foo: "))
+ (should-error (y-or-n-p "foo: ") :type 'inhibited-interaction)
+ (should-error (yes-or-no-p "foo: ") :type 'inhibited-interaction)
+ (should-error (read-no-blanks-input "foo: ") :type 'inhibited-interaction)
;; See that we get the expected error.
(should (eq (condition-case nil
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