summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSean Whitton <spwhitton@spwhitton.name>2021-01-31 22:34:48 -0700
committerSean Whitton <spwhitton@spwhitton.name>2021-01-31 22:34:48 -0700
commitd4d613629b59d2eadd80026cab6c9dabc92cab24 (patch)
treed31086a817251dddb847d027661d218c1ecd6540
parentfdb813e529602914360fc2d0cf22e42e32e6905f (diff)
parenta5438ee11ad052e71334dcfb2db51fb9123411e5 (diff)
downloademacs-d4d613629b59d2eadd80026cab6c9dabc92cab24.tar.gz
Merge remote-tracking branch 'origin/master' into athena/unstable
-rw-r--r--.clang-format2
-rw-r--r--admin/admin.el18
-rw-r--r--admin/authors.el20
-rw-r--r--admin/cus-test.el17
-rw-r--r--admin/find-gc.el25
-rw-r--r--admin/gitmerge.el6
-rw-r--r--admin/notes/unicode10
-rw-r--r--admin/unidata/unidata-gen.el6
-rwxr-xr-xbuild-aux/config.guess8
-rwxr-xr-xbuild-aux/config.sub10
-rw-r--r--configure.ac2
-rw-r--r--doc/emacs/glossary.texi8
-rw-r--r--doc/emacs/kmacro.texi8
-rw-r--r--doc/emacs/maintaining.texi22
-rw-r--r--doc/emacs/search.texi7
-rw-r--r--doc/lispref/frames.texi50
-rw-r--r--doc/lispref/keymaps.texi5
-rw-r--r--doc/lispref/markers.texi4
-rw-r--r--doc/lispref/minibuf.texi19
-rw-r--r--doc/lispref/text.texi37
-rw-r--r--doc/misc/message.texi6
-rw-r--r--doc/misc/org.texi6
-rw-r--r--doc/misc/texinfo.tex163
-rw-r--r--doc/misc/tramp.texi30
-rw-r--r--etc/MACHINES5
-rw-r--r--etc/NEWS71
-rw-r--r--leim/leim-ext.el12
-rw-r--r--lib/_Noreturn.h16
-rw-r--r--lib/canonicalize-lgpl.c25
-rw-r--r--lib/cdefs.h192
-rw-r--r--lib/dirent.in.h3
-rw-r--r--lib/dynarray.h31
-rw-r--r--lib/explicit_bzero.c16
-rw-r--r--lib/fchmodat.c17
-rw-r--r--lib/free.c14
-rw-r--r--lib/gnulib.mk.in27
-rw-r--r--lib/libc-config.h171
-rw-r--r--lib/malloc/dynarray-skeleton.c525
-rw-r--r--lib/malloc/dynarray.h178
-rw-r--r--lib/malloc/dynarray_at_failure.c35
-rw-r--r--lib/malloc/dynarray_emplace_enlarge.c73
-rw-r--r--lib/malloc/dynarray_finalize.c62
-rw-r--r--lib/malloc/dynarray_resize.c64
-rw-r--r--lib/malloc/dynarray_resize_clear.c35
-rw-r--r--lib/malloc/scratch_buffer_grow.c2
-rw-r--r--lib/malloc/scratch_buffer_grow_preserve.c2
-rw-r--r--lib/malloc/scratch_buffer_set_array_size.c2
-rw-r--r--lib/mini-gmp.c2
-rw-r--r--lib/mktime-internal.h2
-rw-r--r--lib/nstrftime.c6
-rw-r--r--lib/regex.c2
-rw-r--r--lib/regex_internal.h26
-rw-r--r--lib/regexec.c117
-rw-r--r--lib/scratch_buffer.h1
-rw-r--r--lib/stddef.in.h23
-rw-r--r--lib/string.in.h20
-rw-r--r--lib/sys_stat.in.h30
-rw-r--r--lib/tempname.c27
-rw-r--r--lib/time-internal.h2
-rw-r--r--lib/time.in.h19
-rw-r--r--lib/time_rz.c16
-rw-r--r--lib/timegm.c2
-rw-r--r--lib/utimens.c19
-rw-r--r--lib/utimensat.c101
-rw-r--r--lib/verify.h28
-rw-r--r--lisp/abbrev.el3
-rw-r--r--lisp/allout-widgets.el36
-rw-r--r--lisp/allout.el79
-rw-r--r--lisp/auth-source.el2
-rw-r--r--lisp/autorevert.el105
-rw-r--r--lisp/bindings.el15
-rw-r--r--lisp/buff-menu.el3
-rw-r--r--lisp/calc/calc-graph.el6
-rw-r--r--lisp/calc/calccomp.el13
-rw-r--r--lisp/calendar/cal-bahai.el28
-rw-r--r--lisp/calendar/cal-china.el45
-rw-r--r--lisp/calendar/cal-coptic.el56
-rw-r--r--lisp/calendar/cal-french.el76
-rw-r--r--lisp/calendar/cal-hebrew.el68
-rw-r--r--lisp/calendar/cal-html.el19
-rw-r--r--lisp/calendar/cal-islam.el25
-rw-r--r--lisp/calendar/cal-iso.el21
-rw-r--r--lisp/calendar/cal-julian.el26
-rw-r--r--lisp/calendar/cal-mayan.el10
-rw-r--r--lisp/calendar/cal-menu.el4
-rw-r--r--lisp/calendar/cal-move.el17
-rw-r--r--lisp/calendar/cal-persia.el30
-rw-r--r--lisp/calendar/cal-tex.el85
-rw-r--r--lisp/calendar/cal-x.el2
-rw-r--r--lisp/calendar/calendar.el57
-rw-r--r--lisp/calendar/diary-lib.el4
-rw-r--r--lisp/calendar/holidays.el15
-rw-r--r--lisp/cedet/ede.el9
-rw-r--r--lisp/cedet/mode-local.el3
-rw-r--r--lisp/cedet/semantic.el36
-rw-r--r--lisp/cedet/semantic/bovine.el3
-rw-r--r--lisp/cedet/semantic/complete.el3
-rw-r--r--lisp/cedet/semantic/ctxt.el6
-rw-r--r--lisp/cedet/semantic/db-find.el6
-rw-r--r--lisp/cedet/semantic/db.el18
-rw-r--r--lisp/cedet/semantic/debug.el12
-rw-r--r--lisp/cedet/semantic/dep.el6
-rw-r--r--lisp/cedet/semantic/format.el6
-rw-r--r--lisp/cedet/semantic/fw.el3
-rw-r--r--lisp/cedet/semantic/grammar.el9
-rw-r--r--lisp/cedet/semantic/idle.el3
-rw-r--r--lisp/cedet/semantic/imenu.el3
-rw-r--r--lisp/cedet/semantic/lex-spp.el12
-rw-r--r--lisp/cedet/semantic/lex.el48
-rw-r--r--lisp/cedet/semantic/senator.el3
-rw-r--r--lisp/cedet/semantic/sort.el3
-rw-r--r--lisp/cedet/semantic/tag.el3
-rw-r--r--lisp/cedet/semantic/util-modes.el9
-rw-r--r--lisp/cedet/semantic/util.el6
-rw-r--r--lisp/cedet/semantic/wisent.el6
-rw-r--r--lisp/dired-aux.el7
-rw-r--r--lisp/dired.el21
-rw-r--r--lisp/double.el6
-rw-r--r--lisp/emacs-lisp/bindat.el112
-rw-r--r--lisp/emacs-lisp/byte-opt.el1050
-rw-r--r--lisp/emacs-lisp/byte-run.el16
-rw-r--r--lisp/emacs-lisp/bytecomp.el3
-rw-r--r--lisp/emacs-lisp/chart.el3
-rw-r--r--lisp/emacs-lisp/checkdoc.el11
-rw-r--r--lisp/emacs-lisp/crm.el2
-rw-r--r--lisp/emacs-lisp/derived.el2
-rw-r--r--lisp/emacs-lisp/easy-mmode.el8
-rw-r--r--lisp/emacs-lisp/edebug.el3
-rw-r--r--lisp/emacs-lisp/eieio-opt.el2
-rw-r--r--lisp/emacs-lisp/generic.el12
-rw-r--r--lisp/emacs-lisp/helper.el29
-rw-r--r--lisp/emacs-lisp/lisp-mode.el80
-rw-r--r--lisp/emacs-lisp/macroexp.el53
-rw-r--r--lisp/emacs-lisp/package-x.el2
-rw-r--r--lisp/emacs-lisp/package.el2
-rw-r--r--lisp/emacs-lisp/pcase.el44
-rw-r--r--lisp/emacs-lisp/re-builder.el10
-rw-r--r--lisp/emacs-lisp/regi.el55
-rw-r--r--lisp/emacs-lisp/shadow.el22
-rw-r--r--lisp/emacs-lisp/subr-x.el22
-rw-r--r--lisp/emacs-lisp/syntax.el3
-rw-r--r--lisp/emacs-lisp/tcover-ses.el28
-rw-r--r--lisp/emacs-lisp/unsafep.el9
-rw-r--r--lisp/emulation/cua-base.el8
-rw-r--r--lisp/emulation/cua-gmrk.el8
-rw-r--r--lisp/emulation/cua-rect.el6
-rw-r--r--lisp/emulation/viper-cmd.el2
-rw-r--r--lisp/emulation/viper-init.el117
-rw-r--r--lisp/emulation/viper-keym.el22
-rw-r--r--lisp/emulation/viper-mous.el11
-rw-r--r--lisp/emulation/viper-util.el10
-rw-r--r--lisp/emulation/viper.el5
-rw-r--r--lisp/erc/erc-backend.el84
-rw-r--r--lisp/erc/erc-capab.el6
-rw-r--r--lisp/erc/erc-dcc.el9
-rw-r--r--lisp/erc/erc-ezbounce.el3
-rw-r--r--lisp/erc/erc-join.el3
-rw-r--r--lisp/erc/erc-netsplit.el3
-rw-r--r--lisp/erc/erc-networks.el3
-rw-r--r--lisp/erc/erc-notify.el6
-rw-r--r--lisp/erc/erc-ring.el6
-rw-r--r--lisp/erc/erc-stamp.el9
-rw-r--r--lisp/erc/erc.el75
-rw-r--r--lisp/eshell/em-cmpl.el185
-rw-r--r--lisp/ezimage.el2
-rw-r--r--lisp/faces.el13
-rw-r--r--lisp/files.el28
-rw-r--r--lisp/find-cmd.el4
-rw-r--r--lisp/flow-ctrl.el13
-rw-r--r--lisp/font-core.el3
-rw-r--r--lisp/font-lock.el17
-rw-r--r--lisp/generic-x.el109
-rw-r--r--lisp/gnus/canlock.el13
-rw-r--r--lisp/gnus/deuglify.el38
-rw-r--r--lisp/gnus/gmm-utils.el24
-rw-r--r--lisp/gnus/gnus-agent.el487
-rw-r--r--lisp/gnus/gnus-art.el671
-rw-r--r--lisp/gnus/gnus-async.el9
-rw-r--r--lisp/gnus/gnus-bcklg.el2
-rw-r--r--lisp/gnus/gnus-bookmark.el33
-rw-r--r--lisp/gnus/gnus-cache.el144
-rw-r--r--lisp/gnus/gnus-cite.el80
-rw-r--r--lisp/gnus/gnus-cloud.el32
-rw-r--r--lisp/gnus/gnus-cus.el13
-rw-r--r--lisp/gnus/gnus-delay.el20
-rw-r--r--lisp/gnus/gnus-demon.el4
-rw-r--r--lisp/gnus/gnus-diary.el16
-rw-r--r--lisp/gnus/gnus-dired.el10
-rw-r--r--lisp/gnus/gnus-draft.el17
-rw-r--r--lisp/gnus/gnus-dup.el3
-rw-r--r--lisp/gnus/gnus-eform.el4
-rw-r--r--lisp/gnus/gnus-fun.el8
-rw-r--r--lisp/gnus/gnus-gravatar.el9
-rw-r--r--lisp/gnus/gnus-group.el158
-rw-r--r--lisp/gnus/gnus-html.el130
-rw-r--r--lisp/gnus/gnus-icalendar.el1
-rw-r--r--lisp/gnus/gnus-int.el400
-rw-r--r--lisp/gnus/gnus-kill.el26
-rw-r--r--lisp/gnus/gnus-logic.el2
-rw-r--r--lisp/gnus/gnus-mh.el6
-rw-r--r--lisp/gnus/gnus-ml.el2
-rw-r--r--lisp/gnus/gnus-mlspl.el6
-rw-r--r--lisp/gnus/gnus-msg.el287
-rw-r--r--lisp/gnus/gnus-notifications.el16
-rw-r--r--lisp/gnus/gnus-picon.el25
-rw-r--r--lisp/gnus/gnus-range.el4
-rw-r--r--lisp/gnus/gnus-registry.el15
-rw-r--r--lisp/gnus/gnus-rfc1843.el8
-rw-r--r--lisp/gnus/gnus-salt.el8
-rw-r--r--lisp/gnus/gnus-score.el131
-rw-r--r--lisp/gnus/gnus-search.el99
-rw-r--r--lisp/gnus/gnus-sieve.el28
-rw-r--r--lisp/gnus/gnus-spec.el46
-rw-r--r--lisp/gnus/gnus-srvr.el19
-rw-r--r--lisp/gnus/gnus-start.el135
-rw-r--r--lisp/gnus/gnus-sum.el160
-rw-r--r--lisp/gnus/gnus-topic.el84
-rw-r--r--lisp/gnus/gnus-undo.el34
-rw-r--r--lisp/gnus/gnus-util.el160
-rw-r--r--lisp/gnus/gnus-uu.el47
-rw-r--r--lisp/gnus/gnus-vm.el2
-rw-r--r--lisp/gnus/gnus-win.el14
-rw-r--r--lisp/gnus/gnus.el13
-rw-r--r--lisp/gnus/gssapi.el2
-rw-r--r--lisp/gnus/legacy-gnus-agent.el4
-rw-r--r--lisp/gnus/mail-source.el146
-rw-r--r--lisp/gnus/message.el127
-rw-r--r--lisp/gnus/mm-archive.el16
-rw-r--r--lisp/gnus/mm-bodies.el2
-rw-r--r--lisp/gnus/mm-decode.el14
-rw-r--r--lisp/gnus/mm-encode.el11
-rw-r--r--lisp/gnus/mm-partial.el19
-rw-r--r--lisp/gnus/mm-url.el13
-rw-r--r--lisp/gnus/mm-util.el14
-rw-r--r--lisp/gnus/mm-view.el67
-rw-r--r--lisp/gnus/mml-sec.el16
-rw-r--r--lisp/gnus/mml-smime.el29
-rw-r--r--lisp/gnus/mml.el91
-rw-r--r--lisp/gnus/mml1991.el13
-rw-r--r--lisp/gnus/mml2015.el30
-rw-r--r--lisp/gnus/nnagent.el18
-rw-r--r--lisp/gnus/nnbabyl.el38
-rw-r--r--lisp/gnus/nndiary.el61
-rw-r--r--lisp/gnus/nndir.el2
-rw-r--r--lisp/gnus/nndoc.el37
-rw-r--r--lisp/gnus/nndraft.el34
-rw-r--r--lisp/gnus/nneething.el16
-rw-r--r--lisp/gnus/nnfolder.el26
-rw-r--r--lisp/gnus/nngateway.el2
-rw-r--r--lisp/gnus/nnheader.el55
-rw-r--r--lisp/gnus/nnimap.el9
-rw-r--r--lisp/gnus/nnmail.el59
-rw-r--r--lisp/gnus/nnmaildir.el40
-rw-r--r--lisp/gnus/nnmairix.el145
-rw-r--r--lisp/gnus/nnmbox.el46
-rw-r--r--lisp/gnus/nnmh.el45
-rw-r--r--lisp/gnus/nnml.el56
-rw-r--r--lisp/gnus/nnnil.el22
-rw-r--r--lisp/gnus/nnoo.el128
-rw-r--r--lisp/gnus/nnregistry.el13
-rw-r--r--lisp/gnus/nnrss.el25
-rw-r--r--lisp/gnus/nnselect.el38
-rw-r--r--lisp/gnus/nnspool.el34
-rw-r--r--lisp/gnus/nntp.el14
-rw-r--r--lisp/gnus/nnvirtual.el214
-rw-r--r--lisp/gnus/nnweb.el30
-rw-r--r--lisp/gnus/score-mode.el2
-rw-r--r--lisp/gnus/smiley.el21
-rw-r--r--lisp/gnus/smime.el39
-rw-r--r--lisp/gnus/spam-report.el28
-rw-r--r--lisp/gnus/spam-stat.el55
-rw-r--r--lisp/gnus/spam-wash.el8
-rw-r--r--lisp/gnus/spam.el377
-rw-r--r--lisp/hl-line.el58
-rw-r--r--lisp/ibuf-ext.el4
-rw-r--r--lisp/image.el2
-rw-r--r--lisp/image/gravatar.el15
-rw-r--r--lisp/international/isearch-x.el5
-rw-r--r--lisp/international/iso-cvt.el24
-rw-r--r--lisp/international/ja-dic-cnv.el11
-rw-r--r--lisp/international/ja-dic-utl.el2
-rw-r--r--lisp/international/kinsoku.el2
-rw-r--r--lisp/international/kkc.el2
-rw-r--r--lisp/international/latexenc.el4
-rw-r--r--lisp/international/latin1-disp.el19
-rw-r--r--lisp/international/mule-cmds.el23
-rw-r--r--lisp/international/mule-diag.el27
-rw-r--r--lisp/international/mule.el3
-rw-r--r--lisp/international/ogonek.el2
-rw-r--r--lisp/international/quail.el55
-rw-r--r--lisp/international/robin.el8
-rw-r--r--lisp/international/titdic-cnv.el254
-rw-r--r--lisp/international/utf-7.el2
-rw-r--r--lisp/isearch.el26
-rw-r--r--lisp/kmacro.el11
-rw-r--r--lisp/language/burmese.el4
-rw-r--r--lisp/language/cham.el4
-rw-r--r--lisp/language/china-util.el2
-rw-r--r--lisp/language/cyril-util.el2
-rw-r--r--lisp/language/ethio-util.el11
-rw-r--r--lisp/language/ethiopic.el4
-rw-r--r--lisp/language/hanja-util.el2
-rw-r--r--lisp/language/hebrew.el6
-rw-r--r--lisp/language/ind-util.el14
-rw-r--r--lisp/language/indian.el2
-rw-r--r--lisp/language/japan-util.el8
-rw-r--r--lisp/language/khmer.el2
-rw-r--r--lisp/language/korea-util.el22
-rw-r--r--lisp/language/korean.el4
-rw-r--r--lisp/language/lao-util.el8
-rw-r--r--lisp/language/lao.el2
-rw-r--r--lisp/language/misc-lang.el8
-rw-r--r--lisp/language/sinhala.el2
-rw-r--r--lisp/language/tai-viet.el2
-rw-r--r--lisp/language/thai-util.el8
-rw-r--r--lisp/language/thai-word.el5
-rw-r--r--lisp/language/tibet-util.el66
-rw-r--r--lisp/language/tibetan.el2
-rw-r--r--lisp/language/tv-util.el4
-rw-r--r--lisp/language/viet-util.el2
-rw-r--r--lisp/leim/quail/compose.el2
-rw-r--r--lisp/leim/quail/viqr.el2
-rw-r--r--lisp/mail/emacsbug.el6
-rw-r--r--lisp/mail/flow-fill.el2
-rw-r--r--lisp/mail/footnote.el26
-rw-r--r--lisp/mail/reporter.el3
-rw-r--r--lisp/mail/rmail.el14
-rw-r--r--lisp/mail/rmailedit.el9
-rw-r--r--lisp/mail/rmailsum.el5
-rw-r--r--lisp/mail/sendmail.el22
-rw-r--r--lisp/mail/supercite.el7
-rw-r--r--lisp/menu-bar.el3
-rw-r--r--lisp/mh-e/mh-mime.el4
-rw-r--r--lisp/mh-e/mh-speed.el6
-rw-r--r--lisp/minibuffer.el19
-rw-r--r--lisp/net/ange-ftp.el2
-rw-r--r--lisp/net/browse-url.el3
-rw-r--r--lisp/net/dbus.el1
-rw-r--r--lisp/net/eww.el7
-rw-r--r--lisp/net/newst-backend.el1
-rw-r--r--lisp/net/newst-plainview.el1
-rw-r--r--lisp/net/rcirc.el15
-rw-r--r--lisp/net/sasl-cram.el2
-rw-r--r--lisp/net/sasl-digest.el2
-rw-r--r--lisp/net/sasl-ntlm.el4
-rw-r--r--lisp/net/sasl.el19
-rw-r--r--lisp/net/sieve-mode.el18
-rw-r--r--lisp/net/soap-inspect.el8
-rw-r--r--lisp/net/telnet.el11
-rw-r--r--lisp/net/tramp-adb.el10
-rw-r--r--lisp/net/tramp-sh.el25
-rw-r--r--lisp/net/tramp-smb.el24
-rw-r--r--lisp/net/tramp.el21
-rw-r--r--lisp/net/webjump.el10
-rw-r--r--lisp/newcomment.el47
-rw-r--r--lisp/nxml/rng-cmpct.el9
-rw-r--r--lisp/nxml/rng-pttrn.el3
-rw-r--r--lisp/nxml/rng-util.el2
-rw-r--r--lisp/nxml/rng-valid.el30
-rw-r--r--lisp/obsolete/nnir.el1
-rw-r--r--lisp/org/ol.el8
-rw-r--r--lisp/org/org.el2
-rw-r--r--lisp/play/5x5.el13
-rw-r--r--lisp/play/decipher.el12
-rw-r--r--lisp/play/gamegrid.el42
-rw-r--r--lisp/play/gametree.el1
-rw-r--r--lisp/play/handwrite.el86
-rw-r--r--lisp/play/mpuz.el30
-rw-r--r--lisp/play/snake.el26
-rw-r--r--lisp/play/tetris.el28
-rw-r--r--lisp/progmodes/asm-mode.el3
-rw-r--r--lisp/progmodes/bat-mode.el2
-rw-r--r--lisp/progmodes/compile.el22
-rw-r--r--lisp/progmodes/cpp.el18
-rw-r--r--lisp/progmodes/ebnf2ps.el15
-rw-r--r--lisp/progmodes/f90.el3
-rw-r--r--lisp/progmodes/flymake.el16
-rw-r--r--lisp/progmodes/gud.el3
-rw-r--r--lisp/progmodes/js.el19
-rw-r--r--lisp/progmodes/octave.el3
-rw-r--r--lisp/progmodes/perl-mode.el7
-rw-r--r--lisp/progmodes/project.el10
-rw-r--r--lisp/progmodes/sh-script.el21
-rw-r--r--lisp/progmodes/xref.el12
-rw-r--r--lisp/recentf.el9
-rw-r--r--lisp/replace.el80
-rw-r--r--lisp/simple.el64
-rw-r--r--lisp/startup.el2
-rw-r--r--lisp/subr.el11
-rw-r--r--lisp/tab-bar.el3
-rw-r--r--lisp/tab-line.el4
-rw-r--r--lisp/term/ns-win.el12
-rw-r--r--lisp/term/w32console.el2
-rw-r--r--lisp/textmodes/artist.el34
-rw-r--r--lisp/textmodes/css-mode.el9
-rw-r--r--lisp/textmodes/enriched.el3
-rw-r--r--lisp/textmodes/flyspell.el39
-rw-r--r--lisp/textmodes/ispell.el10
-rw-r--r--lisp/textmodes/less-css-mode.el1
-rw-r--r--lisp/textmodes/nroff-mode.el9
-rw-r--r--lisp/textmodes/refill.el6
-rw-r--r--lisp/textmodes/remember.el37
-rw-r--r--lisp/textmodes/sgml-mode.el10
-rw-r--r--lisp/textmodes/table.el3
-rw-r--r--lisp/textmodes/tex-mode.el10
-rw-r--r--lisp/textmodes/two-column.el6
-rw-r--r--lisp/thingatpt.el44
-rw-r--r--lisp/tmm.el14
-rw-r--r--lisp/type-break.el4
-rw-r--r--lisp/url/url-about.el10
-rw-r--r--lisp/url/url-cache.el2
-rw-r--r--lisp/url/url-cid.el2
-rw-r--r--lisp/url/url-dav.el18
-rw-r--r--lisp/url/url-expand.el2
-rw-r--r--lisp/url/url-file.el2
-rw-r--r--lisp/url/url-gw.el15
-rw-r--r--lisp/url/url-http.el25
-rw-r--r--lisp/url/url-imap.el5
-rw-r--r--lisp/url/url-ldap.el2
-rw-r--r--lisp/url/url-mailto.el11
-rw-r--r--lisp/url/url-methods.el4
-rw-r--r--lisp/url/url-misc.el2
-rw-r--r--lisp/url/url-news.el4
-rw-r--r--lisp/url/url-nfs.el2
-rw-r--r--lisp/url/url-privacy.el4
-rw-r--r--lisp/url/url-proxy.el2
-rw-r--r--lisp/url/url-tramp.el2
-rw-r--r--lisp/url/url.el22
-rw-r--r--lisp/vc/ediff-diff.el15
-rw-r--r--lisp/vc/ediff-init.el5
-rw-r--r--lisp/vc/smerge-mode.el3
-rw-r--r--lisp/vc/vc-bzr.el3
-rw-r--r--lisp/vc/vc-dir.el11
-rw-r--r--lisp/vc/vc-dispatcher.el3
-rw-r--r--lisp/vc/vc-git.el7
-rw-r--r--lisp/vc/vc-hg.el3
-rw-r--r--lisp/vc/vc.el3
-rw-r--r--lisp/wdired.el24
-rw-r--r--lisp/whitespace.el4
-rw-r--r--lisp/window.el36
-rw-r--r--m4/canonicalize.m460
-rw-r--r--m4/extensions.m414
-rw-r--r--m4/fchmodat.m448
-rw-r--r--m4/gnulib-common.m415
-rw-r--r--m4/gnulib-comp.m420
-rw-r--r--m4/nstrftime.m44
-rw-r--r--m4/stddef_h.m416
-rw-r--r--m4/string_h.m43
-rw-r--r--m4/sys_stat_h.m44
-rw-r--r--m4/time_h.m420
-rw-r--r--m4/utimensat.m457
-rw-r--r--src/alloc.c6
-rw-r--r--src/cmds.c1
-rw-r--r--src/conf_post.h4
-rw-r--r--src/dispextern.h1
-rw-r--r--src/editfns.c11
-rw-r--r--src/emacs-module.h.in4
-rw-r--r--src/emacs.c10
-rw-r--r--src/fns.c34
-rw-r--r--src/frame.c12
-rw-r--r--src/frame.h24
-rw-r--r--src/macros.c5
-rw-r--r--src/minibuf.c64
-rw-r--r--src/nsfns.m20
-rw-r--r--src/nsmenu.m5
-rw-r--r--src/nsterm.m41
-rw-r--r--src/process.c31
-rw-r--r--src/term.c39
-rw-r--r--src/w32common.h5
-rw-r--r--src/w32fns.c73
-rw-r--r--src/w32menu.c10
-rw-r--r--src/w32term.c27
-rw-r--r--src/window.c2
-rw-r--r--src/xdisp.c8
-rw-r--r--src/xfaces.c3
-rw-r--r--src/xfns.c46
-rw-r--r--src/xmenu.c14
-rw-r--r--src/xterm.c47
-rw-r--r--test/Makefile.in5
-rw-r--r--test/infra/gitlab-ci.yml4
-rw-r--r--test/lisp/autorevert-tests.el25
-rw-r--r--test/lisp/electric-tests.el15
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/foo-inlinable.el6
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/nowarn-inline-after-defvar.el17
-rw-r--r--test/lisp/emacs-lisp/bytecomp-tests.el4
-rw-r--r--test/lisp/emacs-lisp/cl-lib-tests.el9
-rw-r--r--test/lisp/emacs-lisp/seq-tests.el23
-rw-r--r--test/lisp/faces-tests.el8
-rw-r--r--test/lisp/find-cmd-tests.el45
-rw-r--r--test/lisp/minibuffer-tests.el24
-rw-r--r--test/lisp/net/sasl-cram-tests.el46
-rw-r--r--test/lisp/net/sasl-tests.el59
-rw-r--r--test/lisp/net/tramp-tests.el52
-rw-r--r--test/lisp/progmodes/asm-mode-tests.el10
-rw-r--r--test/lisp/progmodes/elisp-mode-tests.el56
-rw-r--r--test/lisp/replace-tests.el13
-rw-r--r--test/lisp/thingatpt-tests.el44
-rwxr-xr-xtest/manual/indent/shell.sh7
-rw-r--r--test/src/process-tests.el30
499 files changed, 8953 insertions, 6616 deletions
diff --git a/.clang-format b/.clang-format
index 9ab09a86ff2..44200a39952 100644
--- a/.clang-format
+++ b/.clang-format
@@ -1,5 +1,5 @@
Language: Cpp
-BasedOnStyle: LLVM
+BasedOnStyle: GNU
AlignEscapedNewlinesLeft: true
AlwaysBreakAfterReturnType: TopLevelDefinitions
BreakBeforeBinaryOperators: All
diff --git a/admin/admin.el b/admin/admin.el
index fa96b7e5cac..d032c1ceb85 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 0180ffea250..6c81c7872fc 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 aca7b68aa7a..995586f9c71 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 c70a051bfb5..1cce54ef142 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 1364bdc67ac..b92ecc7c78f 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.
@@ -390,7 +390,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 +422,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/admin/notes/unicode b/admin/notes/unicode
index 45455d897f3..bcede9c6ed1 100644
--- a/admin/notes/unicode
+++ b/admin/notes/unicode
@@ -256,15 +256,6 @@ nontrivial changes to the build process.
etc/tutorials/TUTORIAL.ja
- * iso-2022-7bit
-
- This file contains multiple Chinese charsets, and converting it
- to UTF-8 would lose the charset property and would change the
- code's behavior. Although this could be worked around by
- propertizing the strings, that hasn't been done.
-
- lisp/international/titdic-cnv.el
-
* utf-8-emacs
These files contain characters that cannot be encoded in UTF-8.
@@ -276,6 +267,7 @@ nontrivial changes to the build process.
lisp/language/tibetan.el
lisp/leim/quail/ethiopic.el
lisp/leim/quail/tibetan.el
+ lisp/international/titdic-cnv.el
* binary files
diff --git a/admin/unidata/unidata-gen.el b/admin/unidata/unidata-gen.el
index 3918853088f..221c9b104e0 100644
--- a/admin/unidata/unidata-gen.el
+++ b/admin/unidata/unidata-gen.el
@@ -1416,7 +1416,8 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
(or elt (user-error "Unknown output file: %s" basename))
(or noninteractive (message "Generating %s..." file))
(with-temp-file file
- (insert ";; " copyright "
+ (insert ";;; " basename " -*- lexical-binding:t -*-
+;; " copyright "
;; Generated from Unicode data files by unidata-gen.el.
;; The sources for this file are found in the admin/unidata/ directory in
;; the Emacs sources. The Unicode data files are used under the
@@ -1451,7 +1452,8 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
(defun unidata-gen-charprop (&optional charprop-file)
(or charprop-file (setq charprop-file (pop command-line-args-left)))
(with-temp-file charprop-file
- (insert ";; Automatically generated by unidata-gen.el.\n"
+ (insert ";; Automatically generated by unidata-gen.el."
+ " -*- lexical-binding: t -*-\n"
";; See the admin/unidata/ directory in the Emacs sources.\n")
(dolist (elt unidata-file-alist)
(dolist (proplist (cdr elt))
diff --git a/build-aux/config.guess b/build-aux/config.guess
index 7f748177972..f7727026b70 100755
--- a/build-aux/config.guess
+++ b/build-aux/config.guess
@@ -1,8 +1,8 @@
#! /bin/sh
# Attempt to guess a canonical system name.
-# Copyright 1992-2020 Free Software Foundation, Inc.
+# Copyright 1992-2021 Free Software Foundation, Inc.
-timestamp='2020-12-22'
+timestamp='2021-01-01'
# This file is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
@@ -50,7 +50,7 @@ version="\
GNU config.guess ($timestamp)
Originally written by Per Bothner.
-Copyright 1992-2020 Free Software Foundation, Inc.
+Copyright 1992-2021 Free Software Foundation, Inc.
This is free software; see the source for copying conditions. There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
@@ -1087,7 +1087,7 @@ EOF
ppcle:Linux:*:*)
echo powerpcle-unknown-linux-"$LIBC"
exit ;;
- riscv32:Linux:*:* | riscv64:Linux:*:*)
+ riscv32:Linux:*:* | riscv32be:Linux:*:* | riscv64:Linux:*:* | riscv64be:Linux:*:*)
echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
exit ;;
s390:Linux:*:* | s390x:Linux:*:*)
diff --git a/build-aux/config.sub b/build-aux/config.sub
index 90bb8aeda63..b0f8492348d 100755
--- a/build-aux/config.sub
+++ b/build-aux/config.sub
@@ -1,8 +1,8 @@
#! /bin/sh
# Configuration validation subroutine script.
-# Copyright 1992-2020 Free Software Foundation, Inc.
+# Copyright 1992-2021 Free Software Foundation, Inc.
-timestamp='2020-12-22'
+timestamp='2021-01-07'
# This file is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
@@ -67,7 +67,7 @@ Report bugs and patches to <config-patches@gnu.org>."
version="\
GNU config.sub ($timestamp)
-Copyright 1992-2020 Free Software Foundation, Inc.
+Copyright 1992-2021 Free Software Foundation, Inc.
This is free software; see the source for copying conditions. There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
@@ -1230,7 +1230,7 @@ case $cpu-$vendor in
| powerpc | powerpc64 | powerpc64le | powerpcle | powerpcspe \
| pru \
| pyramid \
- | riscv | riscv32 | riscv64 \
+ | riscv | riscv32 | riscv32be | riscv64 | riscv64be \
| rl78 | romp | rs6000 | rx \
| s390 | s390x \
| score \
@@ -1687,7 +1687,7 @@ case $os in
musl* | newlib* | uclibc*)
;;
# Likewise for "kernel-libc"
- eabi | eabihf | gnueabi | gnueabihf)
+ eabi* | gnueabi*)
;;
# Now accept the basic system types.
# The portable systems comes first.
diff --git a/configure.ac b/configure.ac
index bea28338090..08f3c0cd857 100644
--- a/configure.ac
+++ b/configure.ac
@@ -5898,7 +5898,7 @@ if test $AUTO_DEPEND = yes; then
AS_MKDIR_P([$dir/deps])
done
fi
-if $gl_gnulib_enabled_scratch_buffer; then
+if $gl_gnulib_enabled_dynarray || $gl_gnulib_enabled_scratch_buffer; then
AS_MKDIR_P([lib/malloc])
if test $AUTO_DEPEND = yes; then
AS_MKDIR_P([lib/deps/malloc])
diff --git a/doc/emacs/glossary.texi b/doc/emacs/glossary.texi
index 35df06591eb..4f971eb1e01 100644
--- a/doc/emacs/glossary.texi
+++ b/doc/emacs/glossary.texi
@@ -1369,10 +1369,14 @@ configurations. @xref{Tab Bars}.
The tab line is a line of tabs at the top of an Emacs window.
Clicking on one of these tabs switches window buffers. @xref{Tab Line}.
+@item Tag
+A tag is an identifier in a program source. @xref{Xref}.
+
@anchor{Glossary---Tags Table}
@item Tags Table
-A tags table is a file that serves as an index to the function
-definitions in one or more other files. @xref{Tags Tables}.
+A tags table is a file that serves as an index to identifiers: definitions
+of functions, macros, data structures, etc., in one or more other files.
+@xref{Tags Tables}.
@item Termscript File
A termscript file contains a record of all characters sent by Emacs to
diff --git a/doc/emacs/kmacro.texi b/doc/emacs/kmacro.texi
index adb2ab8d561..e713c6ef8c0 100644
--- a/doc/emacs/kmacro.texi
+++ b/doc/emacs/kmacro.texi
@@ -179,6 +179,14 @@ itself counts as the first repetition, since it is executed as you
define it, so @kbd{C-u 4 C-x )} executes the macro immediately 3
additional times.
+@findex kdb-macro-redisplay
+@kindex C-x C-k Q
+ While executing a long-running keyboard macro, it can sometimes be
+useful to trigger a redisplay (to show how far we've gotten). The
+@kbd{C-x C-k Q} can be used for this. As a not very useful example,
+@kbd{C-x ( M-f C-x C-k Q C-x )} will create a macro that will
+redisplay once per iteration when saying @kbd{C-u 42 C-x e}.
+
@node Keyboard Macro Ring
@section The Keyboard Macro Ring
diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi
index 415815473e5..bc276c49046 100644
--- a/doc/emacs/maintaining.texi
+++ b/doc/emacs/maintaining.texi
@@ -1994,19 +1994,21 @@ Of course, you should substitute the proper years and copyright holder.
@section Find Identifier References
@cindex xref
+@cindex tag
An @dfn{identifier} is a name of a syntactical subunit of the
program: a function, a subroutine, a method, a class, a data type, a
macro, etc. In a programming language, each identifier is a symbol in
-the language's syntax. Program development and maintenance requires
-capabilities to quickly find where each identifier was defined and
-referenced, to rename identifiers across the entire project, etc.
-
-These capabilities are also useful for finding references in major
-modes other than those defined to support programming languages. For
-example, chapters, sections, appendices, etc.@: of a text or a @TeX{}
-document can be treated as subunits as well, and their names can be
-used as identifiers. In this chapter, we use the term ``identifiers''
-to collectively refer to the names of any kind of subunits, in program
+the language's syntax. Identifiers are also known as @dfn{tags}.
+
+Program development and maintenance requires capabilities to quickly
+find where each identifier was defined and referenced, to rename
+identifiers across the entire project, etc. These capabilities are
+also useful for finding references in major modes other than those
+defined to support programming languages. For example, chapters,
+sections, appendices, etc.@: of a text or a @TeX{} document can be
+treated as subunits as well, and their names can be used as
+identifiers. In this chapter, we use the term ``identifiers'' to
+collectively refer to the names of any kind of subunits, in program
source and in other kinds of text alike.
Emacs provides a unified interface to these capabilities, called
diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi
index 637867b8115..f3c42bcea7f 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/lispref/frames.texi b/doc/lispref/frames.texi
index 7f2a6f75422..a15511dc9f5 100644
--- a/doc/lispref/frames.texi
+++ b/doc/lispref/frames.texi
@@ -694,9 +694,17 @@ parameter (@pxref{Management Parameters}).
@item Internal Border
The internal border is a border drawn by Emacs around the inner frame
-(see below). Its width is specified by the @code{internal-border-width}
-frame parameter (@pxref{Layout Parameters}). Its color is specified by
-the background of the @code{internal-border} face.
+(see below). The specification of its appearance depends on whether
+or not the given frame is a child frame (@pxref{Child Frames}).
+
+For normal frames its width is specified by the @code{internal-border-width}
+frame parameter (@pxref{Layout Parameters}), and its color is specified by the
+background of the @code{internal-border} face.
+
+For child frames its width is specified by the @code{child-frame-border-width}
+frame parameter (but will use the @code{internal-border-width} parameter as
+fallback), and its color is specified by the background of the
+@code{child-frame-border} face.
@item Inner Frame
@cindex inner frame
@@ -1790,6 +1798,11 @@ The width in pixels of the frame's outer border (@pxref{Frame Geometry}).
The width in pixels of the frame's internal border (@pxref{Frame
Geometry}).
+@vindex child-frame-border-width@r{, a frame parameter}
+@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}).
+
@vindex vertical-scroll-bars@r{, a frame parameter}
@item vertical-scroll-bars
Whether the frame has scroll bars (@pxref{Scroll Bars}) for vertical
@@ -2398,7 +2411,7 @@ attribute of the @code{default} face.
@vindex foreground-color@r{, a frame parameter}
@item foreground-color
-The color to use for the image of a character. It is equivalent to
+The color to use for characters. It is equivalent to
the @code{:foreground} attribute of the @code{default} face.
@vindex background-color@r{, a frame parameter}
@@ -3748,10 +3761,31 @@ for instance using the window manager, then this produces a quit and
You can specify the mouse pointer style for particular text or
images using the @code{pointer} text property, and for images with the
@code{:pointer} and @code{:map} image properties. The values you can
-use in these properties are @code{text} (or @code{nil}), @code{arrow},
-@code{hand}, @code{vdrag}, @code{hdrag}, @code{modeline}, and
-@code{hourglass}. @code{text} stands for the usual mouse pointer
-style used over text.
+use in these properties are in the table below. The actual shapes
+may vary between systems; the descriptions are examples.
+
+@table @code
+@item text
+@itemx nil
+The usual mouse pointer style used over text (an ``I''-like shape).
+
+@item arrow
+@itemx vdrag
+@itemx modeline
+An arrow that points north-west.
+
+@item hand
+A hand that points upwards.
+
+@item hdrag
+A right-left arrow.
+
+@item nhdrag
+An up-down arrow.
+
+@item hourglass
+A rotating ring.
+@end table
Over void parts of the window (parts that do not correspond to any
of the buffer contents), the mouse pointer usually uses the
diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi
index 37bab7ea9bc..55d179b8753 100644
--- a/doc/lispref/keymaps.texi
+++ b/doc/lispref/keymaps.texi
@@ -2852,9 +2852,8 @@ Here is how to insert an item called @samp{Work} in the @samp{Signals}
menu of Shell mode, after the item @code{break}:
@example
-(define-key-after
- (lookup-key shell-mode-map [menu-bar signals])
- [work] '("Work" . work-command) 'break)
+(define-key-after shell-mode-map [menu-bar signals work]
+ '("Work" . work-command) 'break)
@end example
@end defun
diff --git a/doc/lispref/markers.texi b/doc/lispref/markers.texi
index cdd0938b458..b39373f0727 100644
--- a/doc/lispref/markers.texi
+++ b/doc/lispref/markers.texi
@@ -560,7 +560,9 @@ deactivate the mark. If the value is @w{@code{(only . @var{oldval})}},
then @code{transient-mark-mode} is set to the value @var{oldval} after
any subsequent command that moves point and is not shift-translated
(@pxref{Key Sequence Input, shift-translation}), or after any other
-action that would normally deactivate the mark.
+action that would normally deactivate the mark. (Marking a region
+with the mouse will temporarily enable @code{transient-mark-mode} in
+this way.)
@end defopt
@defopt mark-even-if-inactive
diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index 0ce17ed571a..185d355ba70 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
diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 0b567d82c61..b3673465240 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -334,6 +334,25 @@ but there is no peace.
(thing-at-point 'whitespace)
@result{} nil
@end example
+
+@defvar thing-at-point-provider-alist
+This variable allows users and modes to tweak how
+@code{thing-at-point} works. It's an association list of @var{thing}s
+and functions (called with zero parameters) to return that thing.
+Entries for @var{thing} will be evaluated in turn until a
+non-@code{nil} result is returned.
+
+For instance, a major mode could say:
+
+@lisp
+(setq-local thing-at-point-provider-alist
+ (append thing-at-point-provider-alist
+ '((url . my-mode--url-at-point))))
+@end lisp
+
+If no providers have a non-@code{nil} return, the @var{thing} will be
+computed the standard way.
+@end defvar
@end defun
@node Comparing Text
@@ -1422,6 +1441,11 @@ the @code{amalgamating-undo-limit} variable. If this variable is 1,
no changes are amalgamated.
@end defun
+A Lisp program can amalgamate a series of changes into a single change
+group by calling @code{undo-amalgamate-change-group} (@pxref{Atomic
+Changes}). Note that @code{amalgamating-undo-limit} has no effect on
+the groups produced by that function.
+
@defvar undo-auto-current-boundary-timer
Some buffers, such as process buffers, can change even when no
commands are executing. In these cases, @code{undo-boundary} is
@@ -5610,6 +5634,19 @@ This function cancels and undoes all the changes in the change group
specified by @var{handle}.
@end defun
+ You can cause some or all of the changes in a change group to be
+considered as a single unit for the purposes of the @code{undo}
+commands (@pxref{Undo}) by using @code{undo-amalgamate-change-group}.
+
+@defun undo-amalgamate-change-group
+Amalgamate all the changes made in the change-group since the state
+identified by @var{handle}. This function removes all undo boundaries
+between undo records of changes since the state described by
+@var{handle}. Usually, @var{handle} is the handle returned by
+@code{prepare-change-group}, in which case all the changes since the
+beginning of the change-group are amalgamated into a single undo unit.
+@end defun
+
Your code should use @code{unwind-protect} to make sure the group is
always finished. The call to @code{activate-change-group} should be
inside the @code{unwind-protect}, in case the user types @kbd{C-g}
diff --git a/doc/misc/message.texi b/doc/misc/message.texi
index f2680b4a797..be6c9a419b2 100644
--- a/doc/misc/message.texi
+++ b/doc/misc/message.texi
@@ -317,6 +317,12 @@ when forwarding a message.
In non-@code{nil}, only headers that match this regexp will be kept
when forwarding a message. This can also be a list of regexps.
+@item message-forward-included-mime-headers
+@vindex message-forward-included-mime-headers
+In non-@code{nil}, headers that match this regexp will be kept when
+forwarding a message as @acronym{MIME}, but @acronym{MML} isn't used.
+This can also be a list of regexps.
+
@item message-make-forward-subject-function
@vindex message-make-forward-subject-function
A list of functions that are called to generate a subject header for
diff --git a/doc/misc/org.texi b/doc/misc/org.texi
index 5eeb098cc72..8902d628875 100644
--- a/doc/misc/org.texi
+++ b/doc/misc/org.texi
@@ -4071,7 +4071,7 @@ the link. Such a function will be called with the tag as the only
argument.
With the above setting, you could link to a specific bug with
-@samp{[[bugzilla:129]]}, search the web for @samp{OrgMode} with @samp{[[google:OrgMode]]},
+@samp{[[bugzilla:129]]}, search the web for @samp{OrgMode} with @samp{[[duckduckgo:OrgMode]]},
show the map location of the Free Software Foundation @samp{[[gmap:51
Franklin Street, Boston]]} or of Carsten office @samp{[[omap:Science Park 904,
Amsterdam, The Netherlands]]} and find out what the Org author is doing
@@ -4082,8 +4082,8 @@ can define them in the file with
@cindex @samp{LINK}, keyword
@example
-#+LINK: bugzilla http://10.1.2.9/bugzilla/show_bug.cgi?id=
-#+LINK: google http://www.google.com/search?q=%s
+#+LINK: bugzilla http://10.1.2.9/bugzilla/show_bug.cgi?id=
+#+LINK: duckduckgo https://duckduckgo.com/?q=%s
@end example
In-buffer completion (see @ref{Completion}) can be used after @samp{[} to
diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex
index 3c7051d1c74..dac7ae3d199 100644
--- a/doc/misc/texinfo.tex
+++ b/doc/misc/texinfo.tex
@@ -3,7 +3,7 @@
% Load plain if necessary, i.e., if running under initex.
\expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi
%
-\def\texinfoversion{2020-10-24.12}
+\def\texinfoversion{2020-11-25.18}
%
% Copyright 1985, 1986, 1988, 1990-2020 Free Software Foundation, Inc.
%
@@ -572,10 +572,9 @@
\fi
}
-% @end foo executes the definition of \Efoo.
-% But first, it executes a specialized version of \checkenv
-%
-\parseargdef\end{%
+
+% @end foo calls \checkenv and executes the definition of \Efoo.
+\parseargdef\end{
\if 1\csname iscond.#1\endcsname
\else
% The general wording of \badenverr may not be ideal.
@@ -2673,8 +2672,6 @@ end
\definetextfontsizexi
-\message{markup,}
-
% Check if we are currently using a typewriter font. Since all the
% Computer Modern typewriter fonts have zero interword stretch (and
% shrink), and it is reasonable to expect all typewriter fonts to have
@@ -2682,68 +2679,14 @@ end
%
\def\ifmonospace{\ifdim\fontdimen3\font=0pt }
-% Markup style infrastructure. \defmarkupstylesetup\INITMACRO will
-% define and register \INITMACRO to be called on markup style changes.
-% \INITMACRO can check \currentmarkupstyle for the innermost
-% style.
-
-\let\currentmarkupstyle\empty
-
-\def\setupmarkupstyle#1{%
- \def\currentmarkupstyle{#1}%
- \markupstylesetup
-}
-
-\let\markupstylesetup\empty
-
-\def\defmarkupstylesetup#1{%
- \expandafter\def\expandafter\markupstylesetup
- \expandafter{\markupstylesetup #1}%
- \def#1%
-}
-
-% Markup style setup for left and right quotes.
-\defmarkupstylesetup\markupsetuplq{%
- \expandafter\let\expandafter \temp
- \csname markupsetuplq\currentmarkupstyle\endcsname
- \ifx\temp\relax \markupsetuplqdefault \else \temp \fi
-}
-
-\defmarkupstylesetup\markupsetuprq{%
- \expandafter\let\expandafter \temp
- \csname markupsetuprq\currentmarkupstyle\endcsname
- \ifx\temp\relax \markupsetuprqdefault \else \temp \fi
-}
-
{
\catcode`\'=\active
\catcode`\`=\active
-\gdef\markupsetuplqdefault{\let`\lq}
-\gdef\markupsetuprqdefault{\let'\rq}
-
-\gdef\markupsetcodequoteleft{\let`\codequoteleft}
-\gdef\markupsetcodequoteright{\let'\codequoteright}
+\gdef\setcodequotes{\let`\codequoteleft \let'\codequoteright}
+\gdef\setregularquotes{\let`\lq \let'\rq}
}
-\let\markupsetuplqcode \markupsetcodequoteleft
-\let\markupsetuprqcode \markupsetcodequoteright
-%
-\let\markupsetuplqexample \markupsetcodequoteleft
-\let\markupsetuprqexample \markupsetcodequoteright
-%
-\let\markupsetuplqkbd \markupsetcodequoteleft
-\let\markupsetuprqkbd \markupsetcodequoteright
-%
-\let\markupsetuplqsamp \markupsetcodequoteleft
-\let\markupsetuprqsamp \markupsetcodequoteright
-%
-\let\markupsetuplqverb \markupsetcodequoteleft
-\let\markupsetuprqverb \markupsetcodequoteright
-%
-\let\markupsetuplqverbatim \markupsetcodequoteleft
-\let\markupsetuprqverbatim \markupsetcodequoteright
-
% Allow an option to not use regular directed right quote/apostrophe
% (char 0x27), but instead the undirected quote from cmtt (char 0x0d).
% The undirected quote is ugly, so don't make it the default, but it
@@ -2906,7 +2849,7 @@ end
}
% @samp.
-\def\samp#1{{\setupmarkupstyle{samp}\lq\tclose{#1}\rq\null}}
+\def\samp#1{{\setcodequotes\lq\tclose{#1}\rq\null}}
% @indicateurl is \samp, that is, with quotes.
\let\indicateurl=\samp
@@ -2949,8 +2892,7 @@ end
\global\let'=\rq \global\let`=\lq % default definitions
%
\global\def\code{\begingroup
- \setupmarkupstyle{code}%
- % The following should really be moved into \setupmarkupstyle handlers.
+ \setcodequotes
\catcode\dashChar=\active \catcode\underChar=\active
\ifallowcodebreaks
\let-\codedash
@@ -3104,7 +3046,7 @@ end
\urefcatcodes
%
\global\def\urefcode{\begingroup
- \setupmarkupstyle{code}%
+ \setcodequotes
\urefcatcodes
\let&\urefcodeamp
\let.\urefcodedot
@@ -3225,8 +3167,8 @@ end
\def\kbdsub#1#2#3\par{%
\def\one{#1}\def\three{#3}\def\threex{??}%
\ifx\one\xkey\ifx\threex\three \key{#2}%
- \else{\tclose{\kbdfont\setupmarkupstyle{kbd}\look}}\fi
- \else{\tclose{\kbdfont\setupmarkupstyle{kbd}\look}}\fi
+ \else{\tclose{\kbdfont\setcodequotes\look}}\fi
+ \else{\tclose{\kbdfont\setcodequotes\look}}\fi
}
% definition of @key that produces a lozenge. Doesn't adjust to text size.
@@ -3243,7 +3185,7 @@ end
% monospace, don't change it; that way, we respect @kbdinputstyle. But
% if it isn't monospace, then use \tt.
%
-\def\key#1{{\setupmarkupstyle{key}%
+\def\key#1{{\setregularquotes
\nohyphenation
\ifmonospace\else\tt\fi
#1}\null}
@@ -3373,16 +3315,20 @@ end
{\obeylines
\globaldefs=1
\envdef\displaymath{%
-\tex
+\tex%
\def\thisenv{\displaymath}%
+\begingroup\let\end\displaymathend%
$$%
}
-\def\Edisplaymath{$$
+\def\displaymathend{$$\endgroup\end}%
+
+\def\Edisplaymath{%
\def\thisenv{\tex}%
\end tex
}}
+
% @inlinefmt{FMTNAME,PROCESSED-TEXT} and @inlineraw{FMTNAME,RAW-TEXT}.
% Ignore unless FMTNAME == tex; then it is like @iftex and @tex,
% except specified as a normal braced arg, so no newlines to worry about.
@@ -7144,7 +7090,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% But \@ or @@ will get a plain @ character.
\envdef\tex{%
- \setupmarkupstyle{tex}%
+ \setregularquotes
\catcode `\\=0 \catcode `\{=1 \catcode `\}=2
\catcode `\$=3 \catcode `\&=4 \catcode `\#=6
\catcode `\^=7 \catcode `\_=8 \catcode `\~=\active \let~=\tie
@@ -7370,7 +7316,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% If you want all examples etc. small: @set dispenvsize small.
% If you want even small examples the full size: @set dispenvsize nosmall.
% This affects the following displayed environments:
-% @example, @display, @format, @lisp
+% @example, @display, @format, @lisp, @verbatim
%
\def\smallword{small}
\def\nosmallword{nosmall}
@@ -7416,9 +7362,9 @@ might help (with 'rm \jobname.?? \jobname.??s')%
%
\maketwodispenvdef{lisp}{example}{%
\nonfillstart
- \tt\setupmarkupstyle{example}%
+ \tt\setcodequotes
\let\kbdfont = \kbdexamplefont % Allow @kbd to do something special.
- \gobble % eat return
+ \parsearg\gobble
}
% @display/@smalldisplay: same as @lisp except keep current font.
%
@@ -7576,7 +7522,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\def\setupverb{%
\tt % easiest (and conventionally used) font for verbatim
\def\par{\leavevmode\endgraf}%
- \setupmarkupstyle{verb}%
+ \setcodequotes
\tabeightspaces
% Respect line breaks,
% print special symbols as themselves, and
@@ -7617,7 +7563,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\tt % easiest (and conventionally used) font for verbatim
\def\par{\egroup\leavevmode\box\verbbox\endgraf\starttabbox}%
\tabexpand
- \setupmarkupstyle{verbatim}%
+ \setcodequotes
% Respect line breaks,
% print special symbols as themselves, and
% make each space count.
@@ -8036,7 +7982,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% leave the code in, but it's strange for @var to lead to typewriter.
% Nowadays we recommend @code, since the difference between a ttsl hyphen
% and a tt hyphen is pretty tiny. @code also disables ?` !`.
- \def\var##1{{\setupmarkupstyle{var}\ttslanted{##1}}}%
+ \def\var##1{{\setregularquotes\ttslanted{##1}}}%
#1%
\sl\hyphenchar\font=45
}
@@ -8145,11 +8091,18 @@ might help (with 'rm \jobname.?? \jobname.??s')%
}
\fi
+\let\E=\expandafter
+
% Used at the time of macro expansion.
% Argument is macro body with arguments substituted
\def\scanmacro#1{%
\newlinechar`\^^M
- \def\xeatspaces{\eatspaces}%
+ % expand the expansion of \eatleadingcr twice to maybe remove a leading
+ % newline (and \else and \fi tokens), then call \eatspaces on the result.
+ \def\xeatspaces##1{%
+ \E\E\E\E\E\E\E\eatspaces\E\E\E\E\E\E\E{\eatleadingcr##1%
+ }}%
+ \def\xempty##1{}%
%
% Process the macro body under the current catcode regime.
\scantokens{#1@comment}%
@@ -8202,6 +8155,11 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\unbrace{\gdef\trim@@@ #1 } #2@{#1}
}
+{\catcode`\^^M=\other%
+\gdef\eatleadingcr#1{\if\noexpand#1\noexpand^^M\else\E#1\fi}}%
+% Warning: this won't work for a delimited argument
+% or for an empty argument
+
% Trim a single trailing ^^M off a string.
{\catcode`\^^M=\other \catcode`\Q=3%
\gdef\eatcr #1{\eatcra #1Q^^MQ}%
@@ -8368,6 +8326,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\let\hash\relax
% \hash is redefined to `#' later to get it into definitions
\let\xeatspaces\relax
+ \let\xempty\relax
\parsemargdefxxx#1,;,%
\ifnum\paramno<10\relax\else
\paramno0\relax
@@ -8379,9 +8338,11 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\else \let\next=\parsemargdefxxx
\advance\paramno by 1
\expandafter\edef\csname macarg.\eatspaces{#1}\endcsname
- {\xeatspaces{\hash\the\paramno}}%
+ {\xeatspaces{\hash\the\paramno\noexpand\xempty{}}}%
\edef\paramlist{\paramlist\hash\the\paramno,}%
\fi\next}
+% the \xempty{} is to give \eatleadingcr an argument in the case of an
+% empty macro argument.
% \parsemacbody, \parsermacbody
%
@@ -9107,20 +9068,22 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% output the `[mynode]' via the macro below so it can be overridden.
\xrefprintnodename\printedrefname
%
- % But we always want a comma and a space:
- ,\space
- %
- % output the `page 3'.
- \turnoffactive \putwordpage\tie\refx{#1-pg}{}%
- % Add a , if xref followed by a space
- \if\space\noexpand\tokenafterxref ,%
- \else\ifx\ \tokenafterxref ,% @TAB
- \else\ifx\*\tokenafterxref ,% @*
- \else\ifx\ \tokenafterxref ,% @SPACE
- \else\ifx\
- \tokenafterxref ,% @NL
- \else\ifx\tie\tokenafterxref ,% @tie
- \fi\fi\fi\fi\fi\fi
+ \expandafter\ifx\csname SETtxiomitxrefpg\endcsname\relax
+ % But we always want a comma and a space:
+ ,\space
+ %
+ % output the `page 3'.
+ \turnoffactive \putwordpage\tie\refx{#1-pg}{}%
+ % Add a , if xref followed by a space
+ \if\space\noexpand\tokenafterxref ,%
+ \else\ifx\ \tokenafterxref ,% @TAB
+ \else\ifx\*\tokenafterxref ,% @*
+ \else\ifx\ \tokenafterxref ,% @SPACE
+ \else\ifx\
+ \tokenafterxref ,% @NL
+ \else\ifx\tie\tokenafterxref ,% @tie
+ \fi\fi\fi\fi\fi\fi
+ \fi
\fi\fi
\fi
\endlink
@@ -9550,7 +9513,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\def\imagexxx#1,#2,#3,#4,#5,#6\finish{\begingroup
\catcode`\^^M = 5 % in case we're inside an example
\normalturnoffactive % allow _ et al. in names
- \def\xprocessmacroarg{\eatspaces}% in case we are being used via a macro
+ \makevalueexpandable
% If the image is by itself, center it.
\ifvmode
\imagevmodetrue
@@ -11603,7 +11566,7 @@ directory should work if nowhere else does.}
\let> = \activegtr
\let~ = \activetilde
\let^ = \activehat
- \markupsetuplqdefault \markupsetuprqdefault
+ \setregularquotes
\let\b = \strong
\let\i = \smartitalic
% in principle, all other definitions in \tex have to be undone too.
@@ -11662,8 +11625,7 @@ directory should work if nowhere else does.}
@let|=@normalverticalbar
@let~=@normaltilde
@let\=@ttbackslash
- @markupsetuplqdefault
- @markupsetuprqdefault
+ @setregularquotes
@unsepspaces
}
}
@@ -11756,8 +11718,7 @@ directory should work if nowhere else does.}
@c Do this last of all since we use ` in the previous @catcode assignments.
@catcode`@'=@active
@catcode`@`=@active
-@markupsetuplqdefault
-@markupsetuprqdefault
+@setregularquotes
@c Local variables:
@c eval: (add-hook 'before-save-hook 'time-stamp)
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index e9ffd6a8c43..efe839574d2 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -810,9 +810,10 @@ behavior.
@cindex @option{sshx} method
Works like @option{ssh} but without the extra authentication prompts.
-@option{sshx} uses @samp{ssh -t -t @var{host} -l @var{user} /bin/sh}
-to open a connection with a ``standard'' login shell. It supports
-changing the remote login shell @command{/bin/sh}.
+@option{sshx} uses @samp{ssh -t -t -l @var{user} -o
+RemoteCommand='/bin/sh -i' @var{host}} to open a connection with a
+``standard'' login shell. It supports changing the remote login shell
+@command{/bin/sh}.
@strong{Note} that @option{sshx} does not bypass authentication
questions. For example, if the host key of the remote host is not
@@ -935,9 +936,10 @@ This method supports the @samp{-p} argument.
@cindex @command{ssh} (with @option{scpx} method)
@option{scpx} is useful to avoid login shell questions. It is similar
-in performance to @option{scp}. @option{scpx} uses @samp{ssh -t -t
-@var{host} -l @var{user} /bin/sh} to open a connection. It supports
-changing the remote login shell @command{/bin/sh}.
+in performance to @option{scp}. @option{scpx} uses @samp{ssh -t -t -l
+@var{user} -o RemoteCommand='/bin/sh -i' @var{host}} to open a
+connection. It supports changing the remote login shell
+@command{/bin/sh}.
@option{scpx} is useful for MS Windows users when @command{ssh}
triggers an error about allocating a pseudo tty. This happens due to
@@ -1284,6 +1286,9 @@ This method uses @command{sftp} in order to securely access remote
hosts. @command{sftp} is a more secure option for connecting to hosts
that for security reasons refuse @command{ssh} connections.
+When there is a respective entry in your @command{ssh} configuration,
+do @emph{not} set the @option{RemoteCommand} option.
+
@end table
@defopt tramp-gvfs-methods
@@ -2220,7 +2225,10 @@ This uses also the settings in @code{tramp-sh-extra-args}.
@vindex RemoteCommand@r{, ssh option}
@strong{Note}: If you use an @option{ssh}-based method for connection,
do @emph{not} set the @option{RemoteCommand} option in your
-@command{ssh} configuration, for example to @command{screen}.
+@command{ssh} configuration, for example to @command{screen}. On the
+other hand, some @option{ssh}-based methods, like @option{sshx} or
+@option{scpx}, silently overwrite a @option{RemoteCommand} option of
+the configuration file.
@subsection Other remote shell setup hints
@@ -3580,7 +3588,6 @@ Furthermore, this approach has the following limitations:
It works only for connection methods defined in @file{tramp-sh.el} and
@file{tramp-adb.el}.
-@vindex ControlMaster@r{, ssh option}
@item
It does not support interactive user authentication. With
@option{ssh}-based methods, this can be avoided by using a password
@@ -3588,6 +3595,10 @@ agent like @command{ssh-agent}, using public key authentication, or
using @option{ControlMaster} options.
@item
+It cannot be applied for @option{ssh}-based methods, which use the
+@option{RemoteCommand} option.
+
+@item
It cannot be killed via @code{interrupt-process}.
@item
@@ -3597,8 +3608,7 @@ It does not report the remote terminal name via @code{process-tty-name}.
It does not set process property @code{remote-pid}.
@item
-It does not use @code{tramp-remote-path} and
-@code{tramp-remote-process-environment}.
+It does not use @code{tramp-remote-path}.
@end itemize
In order to gain even more performance, it is recommended to bind
diff --git a/etc/MACHINES b/etc/MACHINES
index 97995777370..d8d0b86fb4d 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 7a012b48912..29499639e70 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -226,6 +226,13 @@ 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.
+
* Editing Changes in Emacs 28.1
@@ -504,6 +511,12 @@ time zones will use a form like "+0100" instead of "CET".
** Dired
+---
+*** 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.
+
+++
*** New user option 'dired-switches-in-mode-line'.
This user option controls how 'ls' switches are displayed in the mode
@@ -721,9 +734,11 @@ not.
---
*** Respect 'message-forward-ignored-headers' more.
Previously, this variable would not be consulted if
-'message-forward-show-mml' was nil. It's now always used, except if
-'message-forward-show-mml' is 'best', and we're forwarding an
-encrypted/signed message.
+'message-forward-show-mml' was nil and forwarding as MIME.
+
++++
+*** New user option 'message-forward-included-mime-headers'.
+This is used when forwarding messages as MIME, but not using MML.
+++
*** Message now supports the OpenPGP header.
@@ -1096,6 +1111,11 @@ If present in 'whitespace-style' (as it is by default), the final
character in the buffer will be highlighted if the buffer doesn't end
with a newline.
+---
+*** The default 'whitespace-enable-predicate' predicate has changed.
+It used to check elements in the list version of
+'whitespace-global-modes' with 'eq', but now uses 'derived-mode-p'.
+
** Texinfo
---
@@ -1125,6 +1145,11 @@ bindings, will be aborted, and Emacs will not ask you whether to
enlarge 'max-specpdl-size' to complete the rendering. The default is
t, which preserves the original behavior.
+---
+*** New user option 'rmail-show-message-set-modified'.
+If set non-nil, showing an unseen message will set the Rmail buffer's
+modified flag.
+
** Apropos
*** New commands 'apropos-next-symbol' and 'apropos-previous-symbol'.
@@ -1554,9 +1579,31 @@ buttons in it.
This function takes a string and returns a string propertized in a way
that makes it a valid button.
+** subr-x
++++
+*** A number of new string manipulation functions have been added.
+'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
+
+** thingatpt
+
++++
+*** New variable 'thing-at-point-provider-alist'.
+This allows mode-specific alterations to how `thing-at-point' works.
** Miscellaneous
++++
+*** New command `C-x C-k Q' to force redisplay in keyboard macros.
+
+---
+*** New user option 'remember-diary-regexp'.
+
+---
+*** New user option 'remember-text-format-function'.
+
*** New function 'buffer-line-statistics'.
This function returns some statistics about the line lengths in a buffer.
@@ -1588,11 +1635,6 @@ length to a number).
This can be set to nil to inhibit hiding passwords in ".authinfo" files.
+++
-*** A number of new string manipulation functions have been added.
-'string-clean-whitespace', 'string-fill', 'string-limit',
-'string-lines', 'string-pad' and 'string-chop-newline'.
-
-+++
*** New variable 'current-minibuffer-command'.
This is like 'this-command', but it is bound recursively when entering
the minibuffer.
@@ -1975,6 +2017,9 @@ directory instead of the default directory.
* Incompatible Lisp Changes in Emacs 28.1
+** '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.
@@ -2002,6 +2047,14 @@ hooks 'kill-buffer-hook', 'kill-buffer-query-functions', and
'buffer-list-update-hook' for the temporary buffers they create. This
avoids slowing them down when a lot of these hooks are defined.
+** New face 'child-frame-border' and frame parameter 'child-frame-border-width'.
+The face and width of child frames borders can now be determined
+separately from those of normal frames. To minimize backward
+incompatibility, child frames without a 'child-frame-border-width'
+parameter will fall back to using 'internal-border-width'. However,
+the new 'child-frame-border' face does constitute a breaking change
+since child frames' borders no longer use the 'internal-border' face.
+
---
** The obsolete function 'thread-alive-p' has been removed.
@@ -2117,6 +2170,8 @@ 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
+
* Lisp Changes in Emacs 28.1
diff --git a/leim/leim-ext.el b/leim/leim-ext.el
index 2378f6fdb4f..687379db9f0 100644
--- a/leim/leim-ext.el
+++ b/leim/leim-ext.el
@@ -1,4 +1,4 @@
-;; leim-ext.el -- extra leim configuration -*- coding:utf-8; -*-
+;; leim-ext.el -- extra leim configuration -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
@@ -39,13 +39,13 @@
(eval-after-load "quail/Punct-b5"
'(quail-defrule " " ?  nil t))
-(register-input-method "ucs" "UTF-8" 'ucs-input-activate "U+"
+(register-input-method "ucs" "UTF-8" #'ucs-input-activate "U+"
"Unicode input as hex in the form Uxxxx.")
(register-input-method
"korean-hangul"
"UTF-8"
- 'hangul-input-method-activate
+ #'hangul-input-method-activate
"한2"
"Hangul 2-Bulsik Input"
'hangul2-input-method
@@ -54,7 +54,7 @@
(register-input-method
"korean-hangul3f"
"UTF-8"
- 'hangul-input-method-activate
+ #'hangul-input-method-activate
"한3f"
"Hangul 3-Bulsik final Input"
'hangul3-input-method
@@ -63,7 +63,7 @@
(register-input-method
"korean-hangul390"
"UTF-8"
- 'hangul-input-method-activate
+ #'hangul-input-method-activate
"한390"
"Hangul 3-Bulsik 390 Input"
'hangul390-input-method
@@ -72,7 +72,7 @@
(register-input-method
"korean-hangul3"
"UTF-8"
- 'hangul-input-method-activate
+ #'hangul-input-method-activate
"한390"
"Hangul 3-Bulsik 390 Input"
'hangul390-input-method
diff --git a/lib/_Noreturn.h b/lib/_Noreturn.h
index 38afe1d5672..fb718bc0691 100644
--- a/lib/_Noreturn.h
+++ b/lib/_Noreturn.h
@@ -26,14 +26,16 @@
AIX system header files and several gnulib header files use precisely
this syntax with 'extern'. */
# define _Noreturn [[noreturn]]
-# elif ((!defined __cplusplus || defined __clang__) \
- && (201112 <= (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) \
- || 4 < __GNUC__ + (7 <= __GNUC_MINOR__) \
- || (defined __apple_build_version__ \
- ? 6000000 <= __apple_build_version__ \
- : 3 < __clang_major__ + (5 <= __clang_minor__))))
+# elif ((!defined __cplusplus || defined __clang__) \
+ && (201112 <= (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) \
+ || (!defined __STRICT_ANSI__ \
+ && (__4 < __GNUC__ + (7 <= __GNUC_MINOR__) \
+ || (defined __apple_build_version__ \
+ ? 6000000 <= __apple_build_version__ \
+ : 3 < __clang_major__ + (5 <= __clang_minor__))))))
/* _Noreturn works as-is. */
-# elif 2 < __GNUC__ + (8 <= __GNUC_MINOR__) || 0x5110 <= __SUNPRO_C
+# elif (2 < __GNUC__ + (8 <= __GNUC_MINOR__) || defined __clang__ \
+ || 0x5110 <= __SUNPRO_C)
# define _Noreturn __attribute__ ((__noreturn__))
# elif 1200 <= (defined _MSC_VER ? _MSC_VER : 0)
# define _Noreturn __declspec (noreturn)
diff --git a/lib/canonicalize-lgpl.c b/lib/canonicalize-lgpl.c
index b6dc3a447ab..b7dba08994d 100644
--- a/lib/canonicalize-lgpl.c
+++ b/lib/canonicalize-lgpl.c
@@ -85,10 +85,6 @@
# define IF_LINT(Code) /* empty */
#endif
-/* True if adding two valid object sizes might overflow idx_t.
- As a practical matter, this cannot happen on 64-bit machines. */
-enum { NARROW_ADDRESSES = IDX_MAX >> 31 >> 31 == 0 };
-
#ifndef DOUBLE_SLASH_IS_DISTINCT_ROOT
# define DOUBLE_SLASH_IS_DISTINCT_ROOT false
#endif
@@ -145,11 +141,11 @@ suffix_requires_dir_check (char const *end)
macOS 10.13 <https://bugs.gnu.org/30350>, and should also work on
platforms like AIX 7.2 that need at least "/.". */
-#if defined _LIBC || defined LSTAT_FOLLOWS_SLASHED_SYMLINK
+# if defined _LIBC || defined LSTAT_FOLLOWS_SLASHED_SYMLINK
static char const dir_suffix[] = "/";
-#else
+# else
static char const dir_suffix[] = "/./";
-#endif
+# endif
/* Return true if DIR is a searchable dir, false (setting errno) otherwise.
DIREND points to the NUL byte at the end of the DIR string.
@@ -191,13 +187,13 @@ get_path_max (void)
to pacify GCC is known; even an explicit #pragma does not pacify GCC.
When the GCC bug is fixed this workaround should be limited to the
broken GCC versions. */
-#if __GNUC_PREREQ (10, 1)
-# if defined GCC_LINT || defined lint
+# if __GNUC_PREREQ (10, 1)
+# if defined GCC_LINT || defined lint
__attribute__ ((__noinline__))
-# elif __OPTIMIZE__ && !__NO_INLINE__
-# define GCC_BOGUS_WRETURN_LOCAL_ADDR
+# elif __OPTIMIZE__ && !__NO_INLINE__
+# define GCC_BOGUS_WRETURN_LOCAL_ADDR
+# endif
# endif
-#endif
static char *
realpath_stk (const char *name, char *resolved,
struct scratch_buffer *rname_buf)
@@ -343,7 +339,7 @@ realpath_stk (const char *name, char *resolved,
if (end_in_extra_buffer)
end_idx = end - extra_buf;
size_t len = strlen (end);
- if (NARROW_ADDRESSES && INT_ADD_OVERFLOW (len, n))
+ if (INT_ADD_OVERFLOW (len, n))
{
__set_errno (ENOMEM);
goto error_nomem;
@@ -443,7 +439,8 @@ __realpath (const char *name, char *resolved)
}
libc_hidden_def (__realpath)
versioned_symbol (libc, __realpath, realpath, GLIBC_2_3);
-#endif /* !FUNC_REALPATH_WORKS || defined _LIBC */
+
+#endif /* defined _LIBC || !FUNC_REALPATH_WORKS */
#if SHLIB_COMPAT(libc, GLIBC_2_0, GLIBC_2_3)
diff --git a/lib/cdefs.h b/lib/cdefs.h
index 2a3dc9666b9..17a0919cd83 100644
--- a/lib/cdefs.h
+++ b/lib/cdefs.h
@@ -25,7 +25,7 @@
/* The GNU libc does not support any K&R compilers or the traditional mode
of ISO C compilers anymore. Check for some of the combinations not
- anymore supported. */
+ supported anymore. */
#if defined __GNUC__ && !defined __STDC__
# error "You need a ISO C conforming compiler to use the glibc headers"
#endif
@@ -34,31 +34,26 @@
#undef __P
#undef __PMT
-/* Compilers that are not clang may object to
- #if defined __clang__ && __has_attribute(...)
- even though they do not need to evaluate the right-hand side of the &&. */
-#if defined __clang__ && defined __has_attribute
-# define __glibc_clang_has_attribute(name) __has_attribute (name)
+/* Compilers that lack __has_attribute may object to
+ #if defined __has_attribute && __has_attribute (...)
+ even though they do not need to evaluate the right-hand side of the &&.
+ Similarly for __has_builtin, etc. */
+#if (defined __has_attribute \
+ && (!defined __clang_minor__ \
+ || 3 < __clang_major__ + (5 <= __clang_minor__)))
+# define __glibc_has_attribute(attr) __has_attribute (attr)
#else
-# define __glibc_clang_has_attribute(name) 0
+# define __glibc_has_attribute(attr) 0
#endif
-
-/* Compilers that are not clang may object to
- #if defined __clang__ && __has_builtin(...)
- even though they do not need to evaluate the right-hand side of the &&. */
-#if defined __clang__ && defined __has_builtin
-# define __glibc_clang_has_builtin(name) __has_builtin (name)
+#ifdef __has_builtin
+# define __glibc_has_builtin(name) __has_builtin (name)
#else
-# define __glibc_clang_has_builtin(name) 0
+# define __glibc_has_builtin(name) 0
#endif
-
-/* Compilers that are not clang may object to
- #if defined __clang__ && __has_extension(...)
- even though they do not need to evaluate the right-hand side of the &&. */
-#if defined __clang__ && defined __has_extension
-# define __glibc_clang_has_extension(ext) __has_extension (ext)
+#ifdef __has_extension
+# define __glibc_has_extension(ext) __has_extension (ext)
#else
-# define __glibc_clang_has_extension(ext) 0
+# define __glibc_has_extension(ext) 0
#endif
#if defined __GNUC__ || defined __clang__
@@ -74,22 +69,26 @@
# endif
/* GCC can always grok prototypes. For C++ programs we add throw()
- to help it optimize the function calls. But this works only with
+ to help it optimize the function calls. But this only works with
gcc 2.8.x and egcs. For gcc 3.4 and up we even mark C functions
as non-throwing using a function attribute since programs can use
the -fexceptions options for C code as well. */
# if !defined __cplusplus \
- && (__GNUC_PREREQ (3, 4) || __glibc_clang_has_attribute (__nothrow__))
+ && (__GNUC_PREREQ (3, 4) || __glibc_has_attribute (__nothrow__))
# define __THROW __attribute__ ((__nothrow__ __LEAF))
# define __THROWNL __attribute__ ((__nothrow__))
# define __NTH(fct) __attribute__ ((__nothrow__ __LEAF)) fct
# define __NTHNL(fct) __attribute__ ((__nothrow__)) fct
# else
# if defined __cplusplus && (__GNUC_PREREQ (2,8) || __clang_major >= 4)
-# define __THROW throw ()
-# define __THROWNL throw ()
-# define __NTH(fct) __LEAF_ATTR fct throw ()
-# define __NTHNL(fct) fct throw ()
+# if __cplusplus >= 201103L
+# define __THROW noexcept (true)
+# else
+# define __THROW throw ()
+# endif
+# define __THROWNL __THROW
+# define __NTH(fct) __LEAF_ATTR fct __THROW
+# define __NTHNL(fct) fct __THROW
# else
# define __THROW
# define __THROWNL
@@ -142,24 +141,20 @@
#define __bos(ptr) __builtin_object_size (ptr, __USE_FORTIFY_LEVEL > 1)
#define __bos0(ptr) __builtin_object_size (ptr, 0)
+/* Use __builtin_dynamic_object_size at _FORTIFY_SOURCE=3 when available. */
+#if __USE_FORTIFY_LEVEL == 3 && __glibc_clang_prereq (9, 0)
+# define __glibc_objsize0(__o) __builtin_dynamic_object_size (__o, 0)
+# define __glibc_objsize(__o) __builtin_dynamic_object_size (__o, 1)
+#else
+# define __glibc_objsize0(__o) __bos0 (__o)
+# define __glibc_objsize(__o) __bos (__o)
+#endif
+
#if __GNUC_PREREQ (4,3)
-# define __warndecl(name, msg) \
- extern void name (void) __attribute__((__warning__ (msg)))
# define __warnattr(msg) __attribute__((__warning__ (msg)))
# define __errordecl(name, msg) \
extern void name (void) __attribute__((__error__ (msg)))
-#elif __glibc_clang_has_attribute (__diagnose_if__) && 0
-/* These definitions are not enabled, because they produce bogus warnings
- in the glibc Fortify functions. These functions are written in a style
- that works with GCC. In order to work with clang, these functions would
- need to be modified. */
-# define __warndecl(name, msg) \
- extern void name (void) __attribute__((__diagnose_if__ (1, msg, "warning")))
-# define __warnattr(msg) __attribute__((__diagnose_if__ (1, msg, "warning")))
-# define __errordecl(name, msg) \
- extern void name (void) __attribute__((__diagnose_if__ (1, msg, "error")))
#else
-# define __warndecl(name, msg) extern void name (void)
# define __warnattr(msg)
# define __errordecl(name, msg) extern void name (void)
#endif
@@ -233,7 +228,7 @@
/* At some point during the gcc 2.96 development the `malloc' attribute
for functions was introduced. We don't want to use it unconditionally
(although this would be possible) since it generates warnings. */
-#if __GNUC_PREREQ (2,96) || __glibc_clang_has_attribute (__malloc__)
+#if __GNUC_PREREQ (2,96) || __glibc_has_attribute (__malloc__)
# define __attribute_malloc__ __attribute__ ((__malloc__))
#else
# define __attribute_malloc__ /* Ignore */
@@ -251,23 +246,31 @@
/* At some point during the gcc 2.96 development the `pure' attribute
for functions was introduced. We don't want to use it unconditionally
(although this would be possible) since it generates warnings. */
-#if __GNUC_PREREQ (2,96) || __glibc_clang_has_attribute (__pure__)
+#if __GNUC_PREREQ (2,96) || __glibc_has_attribute (__pure__)
# define __attribute_pure__ __attribute__ ((__pure__))
#else
# define __attribute_pure__ /* Ignore */
#endif
/* This declaration tells the compiler that the value is constant. */
-#if __GNUC_PREREQ (2,5) || __glibc_clang_has_attribute (__const__)
+#if __GNUC_PREREQ (2,5) || __glibc_has_attribute (__const__)
# define __attribute_const__ __attribute__ ((__const__))
#else
# define __attribute_const__ /* Ignore */
#endif
+#if defined __STDC_VERSION__ && 201710L < __STDC_VERSION__
+# define __attribute_maybe_unused__ [[__maybe_unused__]]
+#elif __GNUC_PREREQ (2,7) || __glibc_has_attribute (__unused__)
+# define __attribute_maybe_unused__ __attribute__ ((__unused__))
+#else
+# define __attribute_maybe_unused__ /* Ignore */
+#endif
+
/* At some point during the gcc 3.1 development the `used' attribute
for functions was introduced. We don't want to use it unconditionally
(although this would be possible) since it generates warnings. */
-#if __GNUC_PREREQ (3,1) || __glibc_clang_has_attribute (__used__)
+#if __GNUC_PREREQ (3,1) || __glibc_has_attribute (__used__)
# define __attribute_used__ __attribute__ ((__used__))
# define __attribute_noinline__ __attribute__ ((__noinline__))
#else
@@ -276,7 +279,7 @@
#endif
/* Since version 3.2, gcc allows marking deprecated functions. */
-#if __GNUC_PREREQ (3,2) || __glibc_clang_has_attribute (__deprecated__)
+#if __GNUC_PREREQ (3,2) || __glibc_has_attribute (__deprecated__)
# define __attribute_deprecated__ __attribute__ ((__deprecated__))
#else
# define __attribute_deprecated__ /* Ignore */
@@ -285,8 +288,8 @@
/* Since version 4.5, gcc also allows one to specify the message printed
when a deprecated function is used. clang claims to be gcc 4.2, but
may also support this feature. */
-#if __GNUC_PREREQ (4,5) || \
- __glibc_clang_has_extension (__attribute_deprecated_with_message__)
+#if __GNUC_PREREQ (4,5) \
+ || __glibc_has_extension (__attribute_deprecated_with_message__)
# define __attribute_deprecated_msg__(msg) \
__attribute__ ((__deprecated__ (msg)))
#else
@@ -299,7 +302,7 @@
If several `format_arg' attributes are given for the same function, in
gcc-3.0 and older, all but the last one are ignored. In newer gccs,
all designated arguments are considered. */
-#if __GNUC_PREREQ (2,8) || __glibc_clang_has_attribute (__format_arg__)
+#if __GNUC_PREREQ (2,8) || __glibc_has_attribute (__format_arg__)
# define __attribute_format_arg__(x) __attribute__ ((__format_arg__ (x)))
#else
# define __attribute_format_arg__(x) /* Ignore */
@@ -309,7 +312,7 @@
attribute for functions was introduced. We don't want to use it
unconditionally (although this would be possible) since it
generates warnings. */
-#if __GNUC_PREREQ (2,97) || __glibc_clang_has_attribute (__format__)
+#if __GNUC_PREREQ (2,97) || __glibc_has_attribute (__format__)
# define __attribute_format_strfmon__(a,b) \
__attribute__ ((__format__ (__strfmon__, a, b)))
#else
@@ -317,19 +320,21 @@
#endif
/* The nonnull function attribute marks pointer parameters that
- must not be NULL. Do not define __nonnull if it is already defined,
- for portability when this file is used in Gnulib. */
+ must not be NULL. */
#ifndef __nonnull
-# if __GNUC_PREREQ (3,3) || __glibc_clang_has_attribute (__nonnull__)
+# if __GNUC_PREREQ (3,3) || __glibc_has_attribute (__nonnull__)
# define __nonnull(params) __attribute__ ((__nonnull__ params))
# else
# define __nonnull(params)
# endif
+#elif !defined __GLIBC__
+# undef __nonnull
+# define __nonnull(params) _GL_ATTRIBUTE_NONNULL (params)
#endif
/* If fortification mode, we warn about unused results of certain
function calls which can lead to problems. */
-#if __GNUC_PREREQ (3,4) || __glibc_clang_has_attribute (__warn_unused_result__)
+#if __GNUC_PREREQ (3,4) || __glibc_has_attribute (__warn_unused_result__)
# define __attribute_warn_unused_result__ \
__attribute__ ((__warn_unused_result__))
# if defined __USE_FORTIFY_LEVEL && __USE_FORTIFY_LEVEL > 0
@@ -343,7 +348,7 @@
#endif
/* Forces a function to be always inlined. */
-#if __GNUC_PREREQ (3,2) || __glibc_clang_has_attribute (__always_inline__)
+#if __GNUC_PREREQ (3,2) || __glibc_has_attribute (__always_inline__)
/* The Linux kernel defines __always_inline in stddef.h (283d7573), and
it conflicts with this definition. Therefore undefine it first to
allow either header to be included first. */
@@ -356,7 +361,7 @@
/* Associate error messages with the source location of the call site rather
than with the source location inside the function. */
-#if __GNUC_PREREQ (4,3) || __glibc_clang_has_attribute (__artificial__)
+#if __GNUC_PREREQ (4,3) || __glibc_has_attribute (__artificial__)
# define __attribute_artificial__ __attribute__ ((__artificial__))
#else
# define __attribute_artificial__ /* Ignore */
@@ -433,7 +438,7 @@
# endif
#endif
-#if (__GNUC__ >= 3) || __glibc_clang_has_builtin (__builtin_expect)
+#if (__GNUC__ >= 3) || __glibc_has_builtin (__builtin_expect)
# define __glibc_unlikely(cond) __builtin_expect ((cond), 0)
# define __glibc_likely(cond) __builtin_expect ((cond), 1)
#else
@@ -441,12 +446,6 @@
# define __glibc_likely(cond) (cond)
#endif
-#ifdef __has_attribute
-# define __glibc_has_attribute(attr) __has_attribute (attr)
-#else
-# define __glibc_has_attribute(attr) 0
-#endif
-
#if (!defined _Noreturn \
&& (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) < 201112 \
&& !(__GNUC_PREREQ (4,7) \
@@ -467,6 +466,16 @@
# define __attribute_nonstring__
#endif
+/* Undefine (also defined in libc-symbols.h). */
+#undef __attribute_copy__
+#if __GNUC_PREREQ (9, 0)
+/* Copies attributes from the declaration or type referenced by
+ the argument. */
+# define __attribute_copy__(arg) __attribute__ ((__copy__ (arg)))
+#else
+# define __attribute_copy__(arg)
+#endif
+
#if (!defined _Static_assert && !defined __cplusplus \
&& (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) < 201112 \
&& (!(__GNUC_PREREQ (4, 6) || __clang_major__ >= 4) \
@@ -483,7 +492,37 @@
# include <bits/long-double.h>
#endif
-#if defined __LONG_DOUBLE_MATH_OPTIONAL && defined __NO_LONG_DOUBLE_MATH
+#if __LDOUBLE_REDIRECTS_TO_FLOAT128_ABI == 1
+# ifdef __REDIRECT
+
+/* Alias name defined automatically. */
+# define __LDBL_REDIR(name, proto) ... unused__ldbl_redir
+# define __LDBL_REDIR_DECL(name) \
+ extern __typeof (name) name __asm (__ASMNAME ("__" #name "ieee128"));
+
+/* Alias name defined automatically, with leading underscores. */
+# define __LDBL_REDIR2_DECL(name) \
+ extern __typeof (__##name) __##name \
+ __asm (__ASMNAME ("__" #name "ieee128"));
+
+/* Alias name defined manually. */
+# define __LDBL_REDIR1(name, proto, alias) ... unused__ldbl_redir1
+# define __LDBL_REDIR1_DECL(name, alias) \
+ extern __typeof (name) name __asm (__ASMNAME (#alias));
+
+# define __LDBL_REDIR1_NTH(name, proto, alias) \
+ __REDIRECT_NTH (name, proto, alias)
+# define __REDIRECT_NTH_LDBL(name, proto, alias) \
+ __LDBL_REDIR1_NTH (name, proto, __##alias##ieee128)
+
+/* Unused. */
+# define __REDIRECT_LDBL(name, proto, alias) ... unused__redirect_ldbl
+# define __LDBL_REDIR_NTH(name, proto) ... unused__ldbl_redir_nth
+
+# else
+_Static_assert (0, "IEEE 128-bits long double requires redirection on this platform");
+# endif
+#elif defined __LONG_DOUBLE_MATH_OPTIONAL && defined __NO_LONG_DOUBLE_MATH
# define __LDBL_COMPAT 1
# ifdef __REDIRECT
# define __LDBL_REDIR1(name, proto, alias) __REDIRECT (name, proto, alias)
@@ -492,6 +531,8 @@
# define __LDBL_REDIR1_NTH(name, proto, alias) __REDIRECT_NTH (name, proto, alias)
# define __LDBL_REDIR_NTH(name, proto) \
__LDBL_REDIR1_NTH (name, proto, __nldbl_##name)
+# define __LDBL_REDIR2_DECL(name) \
+ extern __typeof (__##name) __##name __asm (__ASMNAME ("__nldbl___" #name));
# define __LDBL_REDIR1_DECL(name, alias) \
extern __typeof (name) name __asm (__ASMNAME (#alias));
# define __LDBL_REDIR_DECL(name) \
@@ -502,11 +543,13 @@
__LDBL_REDIR1_NTH (name, proto, __nldbl_##alias)
# endif
#endif
-#if !defined __LDBL_COMPAT || !defined __REDIRECT
+#if (!defined __LDBL_COMPAT && __LDOUBLE_REDIRECTS_TO_FLOAT128_ABI == 0) \
+ || !defined __REDIRECT
# define __LDBL_REDIR1(name, proto, alias) name proto
# define __LDBL_REDIR(name, proto) name proto
# define __LDBL_REDIR1_NTH(name, proto, alias) name proto __THROW
# define __LDBL_REDIR_NTH(name, proto) name proto __THROW
+# define __LDBL_REDIR2_DECL(name)
# define __LDBL_REDIR_DECL(name)
# ifdef __REDIRECT
# define __REDIRECT_LDBL(name, proto, alias) __REDIRECT (name, proto, alias)
@@ -537,7 +580,7 @@
check is required to enable the use of generic selection. */
#if !defined __cplusplus \
&& (__GNUC_PREREQ (4, 9) \
- || __glibc_clang_has_extension (c_generic_selections) \
+ || __glibc_has_extension (c_generic_selections) \
|| (!defined __GNUC__ && defined __STDC_VERSION__ \
&& __STDC_VERSION__ >= 201112L))
# define __HAVE_GENERIC_SELECTION 1
@@ -545,4 +588,23 @@
# define __HAVE_GENERIC_SELECTION 0
#endif
+#if __GNUC_PREREQ (10, 0)
+/* Designates a 1-based positional argument ref-index of pointer type
+ that can be used to access size-index elements of the pointed-to
+ array according to access mode, or at least one element when
+ size-index is not provided:
+ access (access-mode, <ref-index> [, <size-index>]) */
+#define __attr_access(x) __attribute__ ((__access__ x))
+#else
+# define __attr_access(x)
+#endif
+
+/* Specify that a function such as setjmp or vfork may return
+ twice. */
+#if __GNUC_PREREQ (4, 1)
+# define __attribute_returns_twice__ __attribute__ ((__returns_twice__))
+#else
+# define __attribute_returns_twice__ /* Ignore. */
+#endif
+
#endif /* sys/cdefs.h */
diff --git a/lib/dirent.in.h b/lib/dirent.in.h
index 2e2c5119a11..4666972b150 100644
--- a/lib/dirent.in.h
+++ b/lib/dirent.in.h
@@ -154,7 +154,8 @@ _GL_WARN_ON_USE (closedir, "closedir is not portable - "
/* Return the file descriptor associated with the given directory stream,
or -1 if none exists. */
# if @REPLACE_DIRFD@
-# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+/* On kLIBC, dirfd() is a macro that does not work. Undefine it. */
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE) || defined dirfd
# undef dirfd
# define dirfd rpl_dirfd
# endif
diff --git a/lib/dynarray.h b/lib/dynarray.h
new file mode 100644
index 00000000000..6da3e87e55f
--- /dev/null
+++ b/lib/dynarray.h
@@ -0,0 +1,31 @@
+/* Type-safe arrays which grow dynamically.
+ Copyright 2021 Free Software Foundation, Inc.
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 3 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
+
+/* Written by Paul Eggert, 2021. */
+
+#ifndef _GL_DYNARRAY_H
+#define _GL_DYNARRAY_H
+
+#include <libc-config.h>
+
+#define __libc_dynarray_at_failure gl_dynarray_at_failure
+#define __libc_dynarray_emplace_enlarge gl_dynarray_emplace_enlarge
+#define __libc_dynarray_finalize gl_dynarray_finalize
+#define __libc_dynarray_resize_clear gl_dynarray_resize_clear
+#define __libc_dynarray_resize gl_dynarray_resize
+#include <malloc/dynarray.h>
+
+#endif /* _GL_DYNARRAY_H */
diff --git a/lib/explicit_bzero.c b/lib/explicit_bzero.c
index feea4446c06..f50ed0875d7 100644
--- a/lib/explicit_bzero.c
+++ b/lib/explicit_bzero.c
@@ -54,11 +54,21 @@ explicit_bzero (void *s, size_t len)
explicit_memset (s, '\0', len);
#elif HAVE_MEMSET_S
(void) memset_s (s, len, '\0', len);
-#else
+#elif defined __GNUC__ && !defined __clang__
memset (s, '\0', len);
-# if defined __GNUC__ && !defined __clang__
/* Compiler barrier. */
asm volatile ("" ::: "memory");
-# endif
+#elif defined __clang__
+ memset (s, '\0', len);
+ /* Compiler barrier. */
+ /* With asm ("" ::: "memory") LLVM analyzes uses of 's' and finds that the
+ whole thing is dead and eliminates it. Use 'g' to work around this
+ problem. See <https://bugs.llvm.org/show_bug.cgi?id=15495#c11>. */
+ __asm__ volatile ("" : : "g"(s) : "memory");
+#else
+ /* Invoke memset through a volatile function pointer. This defeats compiler
+ optimizations. */
+ void * (* const volatile volatile_memset) (void *, int, size_t) = memset;
+ (void) volatile_memset (s, '\0', len);
#endif
}
diff --git a/lib/fchmodat.c b/lib/fchmodat.c
index d27c0d7734a..eb6e2242fdd 100644
--- a/lib/fchmodat.c
+++ b/lib/fchmodat.c
@@ -38,6 +38,7 @@ orig_fchmodat (int dir, char const *file, mode_t mode, int flags)
#include <fcntl.h>
#include <stdio.h>
#include <stdlib.h>
+#include <string.h>
#include <unistd.h>
#ifdef __osf__
@@ -63,6 +64,22 @@ orig_fchmodat (int dir, char const *file, mode_t mode, int flags)
int
fchmodat (int dir, char const *file, mode_t mode, int flags)
{
+# if HAVE_NEARLY_WORKING_FCHMODAT
+ /* Correct the trailing slash handling. */
+ size_t len = strlen (file);
+ if (len && file[len - 1] == '/')
+ {
+ struct stat st;
+ if (fstatat (dir, file, &st, flags & AT_SYMLINK_NOFOLLOW) < 0)
+ return -1;
+ if (!S_ISDIR (st.st_mode))
+ {
+ errno = ENOTDIR;
+ return -1;
+ }
+ }
+# endif
+
# if NEED_FCHMODAT_NONSYMLINK_FIX
if (flags == AT_SYMLINK_NOFOLLOW)
{
diff --git a/lib/free.c b/lib/free.c
index 135c3eb16bc..5c89787aba1 100644
--- a/lib/free.c
+++ b/lib/free.c
@@ -27,7 +27,21 @@ void
rpl_free (void *p)
#undef free
{
+#if defined __GNUC__ && !defined __clang__
+ /* An invalid GCC optimization
+ <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=98396>
+ would optimize away the assignments in the code below, when link-time
+ optimization (LTO) is enabled. Make the code more complicated, so that
+ GCC does not grok how to optimize it. */
+ int err[2];
+ err[0] = errno;
+ err[1] = errno;
+ errno = 0;
+ free (p);
+ errno = err[errno == 0];
+#else
int err = errno;
free (p);
errno = err;
+#endif
}
diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in
index c457ac61209..07736f9b8bc 100644
--- a/lib/gnulib.mk.in
+++ b/lib/gnulib.mk.in
@@ -516,6 +516,7 @@ GNULIB_SYMLINK = @GNULIB_SYMLINK@
GNULIB_SYMLINKAT = @GNULIB_SYMLINKAT@
GNULIB_SYSTEM_POSIX = @GNULIB_SYSTEM_POSIX@
GNULIB_TIMEGM = @GNULIB_TIMEGM@
+GNULIB_TIMESPEC_GET = @GNULIB_TIMESPEC_GET@
GNULIB_TIME_R = @GNULIB_TIME_R@
GNULIB_TIME_RZ = @GNULIB_TIME_RZ@
GNULIB_TMPFILE = @GNULIB_TMPFILE@
@@ -746,6 +747,7 @@ HAVE_SYS_SELECT_H = @HAVE_SYS_SELECT_H@
HAVE_SYS_TIME_H = @HAVE_SYS_TIME_H@
HAVE_SYS_TYPES_H = @HAVE_SYS_TYPES_H@
HAVE_TIMEGM = @HAVE_TIMEGM@
+HAVE_TIMESPEC_GET = @HAVE_TIMESPEC_GET@
HAVE_TIMEZONE_T = @HAVE_TIMEZONE_T@
HAVE_TYPE_VOLATILE_SIG_ATOMIC_T = @HAVE_TYPE_VOLATILE_SIG_ATOMIC_T@
HAVE_UNISTD_H = @HAVE_UNISTD_H@
@@ -949,6 +951,7 @@ REPLACE_FCNTL = @REPLACE_FCNTL@
REPLACE_FDOPEN = @REPLACE_FDOPEN@
REPLACE_FDOPENDIR = @REPLACE_FDOPENDIR@
REPLACE_FFLUSH = @REPLACE_FFLUSH@
+REPLACE_FFSLL = @REPLACE_FFSLL@
REPLACE_FOPEN = @REPLACE_FOPEN@
REPLACE_FPRINTF = @REPLACE_FPRINTF@
REPLACE_FPURGE = @REPLACE_FPURGE@
@@ -989,7 +992,9 @@ REPLACE_MEMCHR = @REPLACE_MEMCHR@
REPLACE_MEMMEM = @REPLACE_MEMMEM@
REPLACE_MKDIR = @REPLACE_MKDIR@
REPLACE_MKFIFO = @REPLACE_MKFIFO@
+REPLACE_MKFIFOAT = @REPLACE_MKFIFOAT@
REPLACE_MKNOD = @REPLACE_MKNOD@
+REPLACE_MKNODAT = @REPLACE_MKNODAT@
REPLACE_MKSTEMP = @REPLACE_MKSTEMP@
REPLACE_MKTIME = @REPLACE_MKTIME@
REPLACE_NANOSLEEP = @REPLACE_NANOSLEEP@
@@ -1087,6 +1092,7 @@ SYSTEM_TYPE = @SYSTEM_TYPE@
SYS_TIME_H_DEFINES_STRUCT_TIMESPEC = @SYS_TIME_H_DEFINES_STRUCT_TIMESPEC@
TERMCAP_OBJ = @TERMCAP_OBJ@
TIME_H_DEFINES_STRUCT_TIMESPEC = @TIME_H_DEFINES_STRUCT_TIMESPEC@
+TIME_H_DEFINES_TIME_UTC = @TIME_H_DEFINES_TIME_UTC@
TOOLKIT_LIBW = @TOOLKIT_LIBW@
UINT32_MAX_LT_UINTMAX_MAX = @UINT32_MAX_LT_UINTMAX_MAX@
UINT64_MAX_EQ_ULONG_MAX = @UINT64_MAX_EQ_ULONG_MAX@
@@ -1171,6 +1177,7 @@ gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1 = @gl_GNULIB_ENABLED_a9786850
gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36 = @gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36@
gl_GNULIB_ENABLED_cloexec = @gl_GNULIB_ENABLED_cloexec@
gl_GNULIB_ENABLED_dirfd = @gl_GNULIB_ENABLED_dirfd@
+gl_GNULIB_ENABLED_dynarray = @gl_GNULIB_ENABLED_dynarray@
gl_GNULIB_ENABLED_euidaccess = @gl_GNULIB_ENABLED_euidaccess@
gl_GNULIB_ENABLED_getdtablesize = @gl_GNULIB_ENABLED_getdtablesize@
gl_GNULIB_ENABLED_getgroups = @gl_GNULIB_ENABLED_getgroups@
@@ -1584,6 +1591,20 @@ EXTRA_libgnu_a_SOURCES += dup2.c
endif
## end gnulib module dup2
+## begin gnulib module dynarray
+ifeq (,$(OMIT_GNULIB_MODULE_dynarray))
+
+ifneq (,$(gl_GNULIB_ENABLED_dynarray))
+libgnu_a_SOURCES += malloc/dynarray_at_failure.c malloc/dynarray_emplace_enlarge.c malloc/dynarray_finalize.c malloc/dynarray_resize.c malloc/dynarray_resize_clear.c
+
+endif
+EXTRA_DIST += dynarray.h malloc/dynarray-skeleton.c malloc/dynarray.h
+
+EXTRA_libgnu_a_SOURCES += malloc/dynarray-skeleton.c
+
+endif
+## end gnulib module dynarray
+
## begin gnulib module eloop-threshold
ifeq (,$(OMIT_GNULIB_MODULE_eloop-threshold))
@@ -3036,6 +3057,7 @@ string.h: string.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H
-e 's|@''HAVE_SIGDESCR_NP''@|$(HAVE_SIGDESCR_NP)|g' \
-e 's|@''HAVE_DECL_STRSIGNAL''@|$(HAVE_DECL_STRSIGNAL)|g' \
-e 's|@''HAVE_STRVERSCMP''@|$(HAVE_STRVERSCMP)|g' \
+ -e 's|@''REPLACE_FFSLL''@|$(REPLACE_FFSLL)|g' \
-e 's|@''REPLACE_MEMCHR''@|$(REPLACE_MEMCHR)|g' \
-e 's|@''REPLACE_MEMMEM''@|$(REPLACE_MEMMEM)|g' \
-e 's|@''REPLACE_STPNCPY''@|$(REPLACE_STPNCPY)|g' \
@@ -3237,7 +3259,9 @@ sys/stat.h: sys_stat.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNU
-e 's|@''REPLACE_LSTAT''@|$(REPLACE_LSTAT)|g' \
-e 's|@''REPLACE_MKDIR''@|$(REPLACE_MKDIR)|g' \
-e 's|@''REPLACE_MKFIFO''@|$(REPLACE_MKFIFO)|g' \
+ -e 's|@''REPLACE_MKFIFOAT''@|$(REPLACE_MKFIFOAT)|g' \
-e 's|@''REPLACE_MKNOD''@|$(REPLACE_MKNOD)|g' \
+ -e 's|@''REPLACE_MKNODAT''@|$(REPLACE_MKNODAT)|g' \
-e 's|@''REPLACE_STAT''@|$(REPLACE_STAT)|g' \
-e 's|@''REPLACE_UTIMENSAT''@|$(REPLACE_UTIMENSAT)|g' \
-e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \
@@ -3350,6 +3374,7 @@ time.h: time.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(
-e 's/@''GNULIB_STRFTIME''@/$(GNULIB_STRFTIME)/g' \
-e 's/@''GNULIB_STRPTIME''@/$(GNULIB_STRPTIME)/g' \
-e 's/@''GNULIB_TIMEGM''@/$(GNULIB_TIMEGM)/g' \
+ -e 's/@''GNULIB_TIMESPEC_GET''@/$(GNULIB_TIMESPEC_GET)/g' \
-e 's/@''GNULIB_TIME_R''@/$(GNULIB_TIME_R)/g' \
-e 's/@''GNULIB_TIME_RZ''@/$(GNULIB_TIME_RZ)/g' \
-e 's/@''GNULIB_TZSET''@/$(GNULIB_TZSET)/g' \
@@ -3358,6 +3383,7 @@ time.h: time.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(
-e 's|@''HAVE_NANOSLEEP''@|$(HAVE_NANOSLEEP)|g' \
-e 's|@''HAVE_STRPTIME''@|$(HAVE_STRPTIME)|g' \
-e 's|@''HAVE_TIMEGM''@|$(HAVE_TIMEGM)|g' \
+ -e 's|@''HAVE_TIMESPEC_GET''@|$(HAVE_TIMESPEC_GET)|g' \
-e 's|@''HAVE_TIMEZONE_T''@|$(HAVE_TIMEZONE_T)|g' \
-e 's|@''REPLACE_CTIME''@|$(REPLACE_CTIME)|g' \
-e 's|@''REPLACE_GMTIME''@|$(REPLACE_GMTIME)|g' \
@@ -3372,6 +3398,7 @@ time.h: time.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(
-e 's|@''SYS_TIME_H_DEFINES_STRUCT_TIMESPEC''@|$(SYS_TIME_H_DEFINES_STRUCT_TIMESPEC)|g' \
-e 's|@''TIME_H_DEFINES_STRUCT_TIMESPEC''@|$(TIME_H_DEFINES_STRUCT_TIMESPEC)|g' \
-e 's|@''UNISTD_H_DEFINES_STRUCT_TIMESPEC''@|$(UNISTD_H_DEFINES_STRUCT_TIMESPEC)|g' \
+ -e 's|@''TIME_H_DEFINES_TIME_UTC''@|$(TIME_H_DEFINES_TIME_UTC)|g' \
-e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \
-e '/definition of _GL_ARG_NONNULL/r $(ARG_NONNULL_H)' \
-e '/definition of _GL_WARN_ON_USE/r $(WARN_ON_USE_H)' \
diff --git a/lib/libc-config.h b/lib/libc-config.h
index d4e29951f35..c0eac707cfd 100644
--- a/lib/libc-config.h
+++ b/lib/libc-config.h
@@ -71,107 +71,112 @@
# endif
#endif
-
-/* Prepare to include <cdefs.h>, which is our copy of glibc
- <sys/cdefs.h>. */
+#ifndef __attribute_maybe_unused__
+/* <sys/cdefs.h> either does not exist, or is too old for Gnulib.
+ Prepare to include <cdefs.h>, which is Gnulib's version of a
+ more-recent glibc <sys/cdefs.h>. */
/* Define _FEATURES_H so that <cdefs.h> does not include <features.h>. */
-#ifndef _FEATURES_H
-# define _FEATURES_H 1
-#endif
+# ifndef _FEATURES_H
+# define _FEATURES_H 1
+# endif
/* Define __WORDSIZE so that <cdefs.h> does not attempt to include
nonexistent files. Make it a syntax error, since Gnulib does not
use __WORDSIZE now, and if Gnulib uses it later the syntax error
will let us know that __WORDSIZE needs configuring. */
-#ifndef __WORDSIZE
-# define __WORDSIZE %%%
-#endif
+# ifndef __WORDSIZE
+# define __WORDSIZE %%%
+# endif
/* Undef the macros unconditionally defined by our copy of glibc
<sys/cdefs.h>, so that they do not clash with any system-defined
versions. */
-#undef _SYS_CDEFS_H
-#undef __ASMNAME
-#undef __ASMNAME2
-#undef __BEGIN_DECLS
-#undef __CONCAT
-#undef __END_DECLS
-#undef __HAVE_GENERIC_SELECTION
-#undef __LDBL_COMPAT
-#undef __LDBL_REDIR
-#undef __LDBL_REDIR1
-#undef __LDBL_REDIR1_DECL
-#undef __LDBL_REDIR1_NTH
-#undef __LDBL_REDIR_DECL
-#undef __LDBL_REDIR_NTH
-#undef __LEAF
-#undef __LEAF_ATTR
-#undef __NTH
-#undef __NTHNL
-#undef __P
-#undef __PMT
-#undef __REDIRECT
-#undef __REDIRECT_LDBL
-#undef __REDIRECT_NTH
-#undef __REDIRECT_NTHNL
-#undef __REDIRECT_NTH_LDBL
-#undef __STRING
-#undef __THROW
-#undef __THROWNL
-#undef __always_inline
-#undef __attribute__
-#undef __attribute_alloc_size__
-#undef __attribute_artificial__
-#undef __attribute_const__
-#undef __attribute_deprecated__
-#undef __attribute_deprecated_msg__
-#undef __attribute_format_arg__
-#undef __attribute_format_strfmon__
-#undef __attribute_malloc__
-#undef __attribute_noinline__
-#undef __attribute_nonstring__
-#undef __attribute_pure__
-#undef __attribute_used__
-#undef __attribute_warn_unused_result__
-#undef __bos
-#undef __bos0
-#undef __errordecl
-#undef __extension__
-#undef __extern_always_inline
-#undef __extern_inline
-#undef __flexarr
-#undef __fortify_function
-#undef __glibc_c99_flexarr_available
-#undef __glibc_clang_has_extension
-#undef __glibc_likely
-#undef __glibc_macro_warning
-#undef __glibc_macro_warning1
-#undef __glibc_unlikely
-#undef __inline
-#undef __ptr_t
-#undef __restrict
-#undef __restrict_arr
-#undef __va_arg_pack
-#undef __va_arg_pack_len
-#undef __warnattr
-#undef __warndecl
+# undef _SYS_CDEFS_H
+# undef __ASMNAME
+# undef __ASMNAME2
+# undef __BEGIN_DECLS
+# undef __CONCAT
+# undef __END_DECLS
+# undef __HAVE_GENERIC_SELECTION
+# undef __LDBL_COMPAT
+# undef __LDBL_REDIR
+# undef __LDBL_REDIR1
+# undef __LDBL_REDIR1_DECL
+# undef __LDBL_REDIR1_NTH
+# undef __LDBL_REDIR2_DECL
+# undef __LDBL_REDIR_DECL
+# undef __LDBL_REDIR_NTH
+# undef __LEAF
+# undef __LEAF_ATTR
+# undef __NTH
+# undef __NTHNL
+# undef __REDIRECT
+# undef __REDIRECT_LDBL
+# undef __REDIRECT_NTH
+# undef __REDIRECT_NTHNL
+# undef __REDIRECT_NTH_LDBL
+# undef __STRING
+# undef __THROW
+# undef __THROWNL
+# undef __attr_access
+# undef __attribute__
+# undef __attribute_alloc_size__
+# undef __attribute_artificial__
+# undef __attribute_const__
+# undef __attribute_deprecated__
+# undef __attribute_deprecated_msg__
+# undef __attribute_format_arg__
+# undef __attribute_format_strfmon__
+# undef __attribute_malloc__
+# undef __attribute_noinline__
+# undef __attribute_nonstring__
+# undef __attribute_pure__
+# undef __attribute_returns_twice__
+# undef __attribute_used__
+# undef __attribute_warn_unused_result__
+# undef __bos
+# undef __bos0
+# undef __errordecl
+# undef __extension__
+# undef __extern_always_inline
+# undef __extern_inline
+# undef __flexarr
+# undef __fortify_function
+# undef __glibc_c99_flexarr_available
+# undef __glibc_has_attribute
+# undef __glibc_has_builtin
+# undef __glibc_has_extension
+# undef __glibc_macro_warning
+# undef __glibc_macro_warning1
+# undef __glibc_objsize
+# undef __glibc_objsize0
+# undef __glibc_unlikely
+# undef __inline
+# undef __ptr_t
+# undef __restrict
+# undef __restrict_arr
+# undef __va_arg_pack
+# undef __va_arg_pack_len
+# undef __warnattr
/* Include our copy of glibc <sys/cdefs.h>. */
-#include <cdefs.h>
+# include <cdefs.h>
/* <cdefs.h> __inline is too pessimistic for non-GCC. */
-#undef __inline
-#ifndef HAVE___INLINE
-# if 199901 <= __STDC_VERSION__ || defined inline
-# define __inline inline
-# else
-# define __inline
+# undef __inline
+# ifndef HAVE___INLINE
+# if 199901 <= __STDC_VERSION__ || defined inline
+# define __inline inline
+# else
+# define __inline
+# endif
# endif
-#endif
+
+#endif /* defined __glibc_likely */
/* A substitute for glibc <libc-symbols.h>, good enough for Gnulib. */
#define attribute_hidden
-#define libc_hidden_proto(name, ...)
+#define libc_hidden_proto(name)
#define libc_hidden_def(name)
#define libc_hidden_weak(name)
#define libc_hidden_ver(local, name)
diff --git a/lib/malloc/dynarray-skeleton.c b/lib/malloc/dynarray-skeleton.c
new file mode 100644
index 00000000000..4995fd1c049
--- /dev/null
+++ b/lib/malloc/dynarray-skeleton.c
@@ -0,0 +1,525 @@
+/* Type-safe arrays which grow dynamically.
+ Copyright (C) 2017-2021 Free Software Foundation, Inc.
+ This file is part of the GNU C Library.
+
+ The GNU C Library 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.
+
+ The GNU C Library 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 the GNU C Library; if not, see
+ <https://www.gnu.org/licenses/>. */
+
+/* Pre-processor macros which act as parameters:
+
+ DYNARRAY_STRUCT
+ The struct tag of dynamic array to be defined.
+ DYNARRAY_ELEMENT
+ The type name of the element type. Elements are copied
+ as if by memcpy, and can change address as the dynamic
+ array grows.
+ DYNARRAY_PREFIX
+ The prefix of the functions which are defined.
+
+ The following parameters are optional:
+
+ DYNARRAY_ELEMENT_FREE
+ DYNARRAY_ELEMENT_FREE (E) is evaluated to deallocate the
+ contents of elements. E is of type DYNARRAY_ELEMENT *.
+ DYNARRAY_ELEMENT_INIT
+ DYNARRAY_ELEMENT_INIT (E) is evaluated to initialize a new
+ element. E is of type DYNARRAY_ELEMENT *.
+ If DYNARRAY_ELEMENT_FREE but not DYNARRAY_ELEMENT_INIT is
+ defined, new elements are automatically zero-initialized.
+ Otherwise, new elements have undefined contents.
+ DYNARRAY_INITIAL_SIZE
+ The size of the statically allocated array (default:
+ at least 2, more elements if they fit into 128 bytes).
+ Must be a preprocessor constant. If DYNARRAY_INITIAL_SIZE is 0,
+ there is no statically allocated array at, and all non-empty
+ arrays are heap-allocated.
+ DYNARRAY_FINAL_TYPE
+ The name of the type which holds the final array. If not
+ defined, is PREFIX##finalize not provided. DYNARRAY_FINAL_TYPE
+ must be a struct type, with members of type DYNARRAY_ELEMENT and
+ size_t at the start (in this order).
+
+ These macros are undefined after this header file has been
+ included.
+
+ The following types are provided (their members are private to the
+ dynarray implementation):
+
+ struct DYNARRAY_STRUCT
+
+ The following functions are provided:
+
+ void DYNARRAY_PREFIX##init (struct DYNARRAY_STRUCT *);
+ void DYNARRAY_PREFIX##free (struct DYNARRAY_STRUCT *);
+ bool DYNARRAY_PREFIX##has_failed (const struct DYNARRAY_STRUCT *);
+ void DYNARRAY_PREFIX##mark_failed (struct DYNARRAY_STRUCT *);
+ size_t DYNARRAY_PREFIX##size (const struct DYNARRAY_STRUCT *);
+ DYNARRAY_ELEMENT *DYNARRAY_PREFIX##begin (const struct DYNARRAY_STRUCT *);
+ DYNARRAY_ELEMENT *DYNARRAY_PREFIX##end (const struct DYNARRAY_STRUCT *);
+ DYNARRAY_ELEMENT *DYNARRAY_PREFIX##at (struct DYNARRAY_STRUCT *, size_t);
+ void DYNARRAY_PREFIX##add (struct DYNARRAY_STRUCT *, DYNARRAY_ELEMENT);
+ DYNARRAY_ELEMENT *DYNARRAY_PREFIX##emplace (struct DYNARRAY_STRUCT *);
+ bool DYNARRAY_PREFIX##resize (struct DYNARRAY_STRUCT *, size_t);
+ void DYNARRAY_PREFIX##remove_last (struct DYNARRAY_STRUCT *);
+ void DYNARRAY_PREFIX##clear (struct DYNARRAY_STRUCT *);
+
+ The following functions are provided are provided if the
+ prerequisites are met:
+
+ bool DYNARRAY_PREFIX##finalize (struct DYNARRAY_STRUCT *,
+ DYNARRAY_FINAL_TYPE *);
+ (if DYNARRAY_FINAL_TYPE is defined)
+ DYNARRAY_ELEMENT *DYNARRAY_PREFIX##finalize (struct DYNARRAY_STRUCT *,
+ size_t *);
+ (if DYNARRAY_FINAL_TYPE is not defined)
+*/
+
+#include <malloc/dynarray.h>
+
+#include <errno.h>
+#include <stdlib.h>
+#include <string.h>
+
+#ifndef DYNARRAY_STRUCT
+# error "DYNARRAY_STRUCT must be defined"
+#endif
+
+#ifndef DYNARRAY_ELEMENT
+# error "DYNARRAY_ELEMENT must be defined"
+#endif
+
+#ifndef DYNARRAY_PREFIX
+# error "DYNARRAY_PREFIX must be defined"
+#endif
+
+#ifdef DYNARRAY_INITIAL_SIZE
+# if DYNARRAY_INITIAL_SIZE < 0
+# error "DYNARRAY_INITIAL_SIZE must be non-negative"
+# endif
+# if DYNARRAY_INITIAL_SIZE > 0
+# define DYNARRAY_HAVE_SCRATCH 1
+# else
+# define DYNARRAY_HAVE_SCRATCH 0
+# endif
+#else
+/* Provide a reasonable default which limits the size of
+ DYNARRAY_STRUCT. */
+# define DYNARRAY_INITIAL_SIZE \
+ (sizeof (DYNARRAY_ELEMENT) > 64 ? 2 : 128 / sizeof (DYNARRAY_ELEMENT))
+# define DYNARRAY_HAVE_SCRATCH 1
+#endif
+
+/* Public type definitions. */
+
+/* All fields of this struct are private to the implementation. */
+struct DYNARRAY_STRUCT
+{
+ union
+ {
+ struct dynarray_header dynarray_abstract;
+ struct
+ {
+ /* These fields must match struct dynarray_header. */
+ size_t used;
+ size_t allocated;
+ DYNARRAY_ELEMENT *array;
+ } dynarray_header;
+ } u;
+
+#if DYNARRAY_HAVE_SCRATCH
+ /* Initial inline allocation. */
+ DYNARRAY_ELEMENT scratch[DYNARRAY_INITIAL_SIZE];
+#endif
+};
+
+/* Internal use only: Helper macros. */
+
+/* Ensure macro-expansion of DYNARRAY_PREFIX. */
+#define DYNARRAY_CONCAT0(prefix, name) prefix##name
+#define DYNARRAY_CONCAT1(prefix, name) DYNARRAY_CONCAT0(prefix, name)
+#define DYNARRAY_NAME(name) DYNARRAY_CONCAT1(DYNARRAY_PREFIX, name)
+
+/* Use DYNARRAY_FREE instead of DYNARRAY_NAME (free),
+ so that Gnulib does not change 'free' to 'rpl_free'. */
+#define DYNARRAY_FREE DYNARRAY_CONCAT1 (DYNARRAY_NAME (f), ree)
+
+/* Address of the scratch buffer if any. */
+#if DYNARRAY_HAVE_SCRATCH
+# define DYNARRAY_SCRATCH(list) (list)->scratch
+#else
+# define DYNARRAY_SCRATCH(list) NULL
+#endif
+
+/* Internal use only: Helper functions. */
+
+/* Internal function. Call DYNARRAY_ELEMENT_FREE with the array
+ elements. Name mangling needed due to the DYNARRAY_ELEMENT_FREE
+ macro expansion. */
+static inline void
+DYNARRAY_NAME (free__elements__) (DYNARRAY_ELEMENT *__dynarray_array,
+ size_t __dynarray_used)
+{
+#ifdef DYNARRAY_ELEMENT_FREE
+ for (size_t __dynarray_i = 0; __dynarray_i < __dynarray_used; ++__dynarray_i)
+ DYNARRAY_ELEMENT_FREE (&__dynarray_array[__dynarray_i]);
+#endif /* DYNARRAY_ELEMENT_FREE */
+}
+
+/* Internal function. Free the non-scratch array allocation. */
+static inline void
+DYNARRAY_NAME (free__array__) (struct DYNARRAY_STRUCT *list)
+{
+#if DYNARRAY_HAVE_SCRATCH
+ if (list->u.dynarray_header.array != list->scratch)
+ free (list->u.dynarray_header.array);
+#else
+ free (list->u.dynarray_header.array);
+#endif
+}
+
+/* Public functions. */
+
+/* Initialize a dynamic array object. This must be called before any
+ use of the object. */
+__nonnull ((1))
+static void
+DYNARRAY_NAME (init) (struct DYNARRAY_STRUCT *list)
+{
+ list->u.dynarray_header.used = 0;
+ list->u.dynarray_header.allocated = DYNARRAY_INITIAL_SIZE;
+ list->u.dynarray_header.array = DYNARRAY_SCRATCH (list);
+}
+
+/* Deallocate the dynamic array and its elements. */
+__attribute_maybe_unused__ __nonnull ((1))
+static void
+DYNARRAY_FREE (struct DYNARRAY_STRUCT *list)
+{
+ DYNARRAY_NAME (free__elements__)
+ (list->u.dynarray_header.array, list->u.dynarray_header.used);
+ DYNARRAY_NAME (free__array__) (list);
+ DYNARRAY_NAME (init) (list);
+}
+
+/* Return true if the dynamic array is in an error state. */
+__nonnull ((1))
+static inline bool
+DYNARRAY_NAME (has_failed) (const struct DYNARRAY_STRUCT *list)
+{
+ return list->u.dynarray_header.allocated == __dynarray_error_marker ();
+}
+
+/* Mark the dynamic array as failed. All elements are deallocated as
+ a side effect. */
+__nonnull ((1))
+static void
+DYNARRAY_NAME (mark_failed) (struct DYNARRAY_STRUCT *list)
+{
+ DYNARRAY_NAME (free__elements__)
+ (list->u.dynarray_header.array, list->u.dynarray_header.used);
+ DYNARRAY_NAME (free__array__) (list);
+ list->u.dynarray_header.array = DYNARRAY_SCRATCH (list);
+ list->u.dynarray_header.used = 0;
+ list->u.dynarray_header.allocated = __dynarray_error_marker ();
+}
+
+/* Return the number of elements which have been added to the dynamic
+ array. */
+__nonnull ((1))
+static inline size_t
+DYNARRAY_NAME (size) (const struct DYNARRAY_STRUCT *list)
+{
+ return list->u.dynarray_header.used;
+}
+
+/* Return a pointer to the array element at INDEX. Terminate the
+ process if INDEX is out of bounds. */
+__nonnull ((1))
+static inline DYNARRAY_ELEMENT *
+DYNARRAY_NAME (at) (struct DYNARRAY_STRUCT *list, size_t index)
+{
+ if (__glibc_unlikely (index >= DYNARRAY_NAME (size) (list)))
+ __libc_dynarray_at_failure (DYNARRAY_NAME (size) (list), index);
+ return list->u.dynarray_header.array + index;
+}
+
+/* Return a pointer to the first array element, if any. For a
+ zero-length array, the pointer can be NULL even though the dynamic
+ array has not entered the failure state. */
+__nonnull ((1))
+static inline DYNARRAY_ELEMENT *
+DYNARRAY_NAME (begin) (struct DYNARRAY_STRUCT *list)
+{
+ return list->u.dynarray_header.array;
+}
+
+/* Return a pointer one element past the last array element. For a
+ zero-length array, the pointer can be NULL even though the dynamic
+ array has not entered the failure state. */
+__nonnull ((1))
+static inline DYNARRAY_ELEMENT *
+DYNARRAY_NAME (end) (struct DYNARRAY_STRUCT *list)
+{
+ return list->u.dynarray_header.array + list->u.dynarray_header.used;
+}
+
+/* Internal function. Slow path for the add function below. */
+static void
+DYNARRAY_NAME (add__) (struct DYNARRAY_STRUCT *list, DYNARRAY_ELEMENT item)
+{
+ if (__glibc_unlikely
+ (!__libc_dynarray_emplace_enlarge (&list->u.dynarray_abstract,
+ DYNARRAY_SCRATCH (list),
+ sizeof (DYNARRAY_ELEMENT))))
+ {
+ DYNARRAY_NAME (mark_failed) (list);
+ return;
+ }
+
+ /* Copy the new element and increase the array length. */
+ list->u.dynarray_header.array[list->u.dynarray_header.used++] = item;
+}
+
+/* Add ITEM at the end of the array, enlarging it by one element.
+ Mark *LIST as failed if the dynamic array allocation size cannot be
+ increased. */
+__nonnull ((1))
+static inline void
+DYNARRAY_NAME (add) (struct DYNARRAY_STRUCT *list, DYNARRAY_ELEMENT item)
+{
+ /* Do nothing in case of previous error. */
+ if (DYNARRAY_NAME (has_failed) (list))
+ return;
+
+ /* Enlarge the array if necessary. */
+ if (__glibc_unlikely (list->u.dynarray_header.used
+ == list->u.dynarray_header.allocated))
+ {
+ DYNARRAY_NAME (add__) (list, item);
+ return;
+ }
+
+ /* Copy the new element and increase the array length. */
+ list->u.dynarray_header.array[list->u.dynarray_header.used++] = item;
+}
+
+/* Internal function. Building block for the emplace functions below.
+ Assumes space for one more element in *LIST. */
+static inline DYNARRAY_ELEMENT *
+DYNARRAY_NAME (emplace__tail__) (struct DYNARRAY_STRUCT *list)
+{
+ DYNARRAY_ELEMENT *result
+ = &list->u.dynarray_header.array[list->u.dynarray_header.used];
+ ++list->u.dynarray_header.used;
+#if defined (DYNARRAY_ELEMENT_INIT)
+ DYNARRAY_ELEMENT_INIT (result);
+#elif defined (DYNARRAY_ELEMENT_FREE)
+ memset (result, 0, sizeof (*result));
+#endif
+ return result;
+}
+
+/* Internal function. Slow path for the emplace function below. */
+static DYNARRAY_ELEMENT *
+DYNARRAY_NAME (emplace__) (struct DYNARRAY_STRUCT *list)
+{
+ if (__glibc_unlikely
+ (!__libc_dynarray_emplace_enlarge (&list->u.dynarray_abstract,
+ DYNARRAY_SCRATCH (list),
+ sizeof (DYNARRAY_ELEMENT))))
+ {
+ DYNARRAY_NAME (mark_failed) (list);
+ return NULL;
+ }
+ return DYNARRAY_NAME (emplace__tail__) (list);
+}
+
+/* Allocate a place for a new element in *LIST and return a pointer to
+ it. The pointer can be NULL if the dynamic array cannot be
+ enlarged due to a memory allocation failure. */
+__attribute_maybe_unused__ __attribute_warn_unused_result__ __nonnull ((1))
+static
+/* Avoid inlining with the larger initialization code. */
+#if !(defined (DYNARRAY_ELEMENT_INIT) || defined (DYNARRAY_ELEMENT_FREE))
+inline
+#endif
+DYNARRAY_ELEMENT *
+DYNARRAY_NAME (emplace) (struct DYNARRAY_STRUCT *list)
+{
+ /* Do nothing in case of previous error. */
+ if (DYNARRAY_NAME (has_failed) (list))
+ return NULL;
+
+ /* Enlarge the array if necessary. */
+ if (__glibc_unlikely (list->u.dynarray_header.used
+ == list->u.dynarray_header.allocated))
+ return (DYNARRAY_NAME (emplace__) (list));
+ return DYNARRAY_NAME (emplace__tail__) (list);
+}
+
+/* Change the size of *LIST to SIZE. If SIZE is larger than the
+ existing size, new elements are added (which can be initialized).
+ Otherwise, the list is truncated, and elements are freed. Return
+ false on memory allocation failure (and mark *LIST as failed). */
+__attribute_maybe_unused__ __nonnull ((1))
+static bool
+DYNARRAY_NAME (resize) (struct DYNARRAY_STRUCT *list, size_t size)
+{
+ if (size > list->u.dynarray_header.used)
+ {
+ bool ok;
+#if defined (DYNARRAY_ELEMENT_INIT)
+ /* The new elements have to be initialized. */
+ size_t old_size = list->u.dynarray_header.used;
+ ok = __libc_dynarray_resize (&list->u.dynarray_abstract,
+ size, DYNARRAY_SCRATCH (list),
+ sizeof (DYNARRAY_ELEMENT));
+ if (ok)
+ for (size_t i = old_size; i < size; ++i)
+ {
+ DYNARRAY_ELEMENT_INIT (&list->u.dynarray_header.array[i]);
+ }
+#elif defined (DYNARRAY_ELEMENT_FREE)
+ /* Zero initialization is needed so that the elements can be
+ safely freed. */
+ ok = __libc_dynarray_resize_clear
+ (&list->u.dynarray_abstract, size,
+ DYNARRAY_SCRATCH (list), sizeof (DYNARRAY_ELEMENT));
+#else
+ ok = __libc_dynarray_resize (&list->u.dynarray_abstract,
+ size, DYNARRAY_SCRATCH (list),
+ sizeof (DYNARRAY_ELEMENT));
+#endif
+ if (__glibc_unlikely (!ok))
+ DYNARRAY_NAME (mark_failed) (list);
+ return ok;
+ }
+ else
+ {
+ /* The list has shrunk in size. Free the removed elements. */
+ DYNARRAY_NAME (free__elements__)
+ (list->u.dynarray_header.array + size,
+ list->u.dynarray_header.used - size);
+ list->u.dynarray_header.used = size;
+ return true;
+ }
+}
+
+/* Remove the last element of LIST if it is present. */
+__attribute_maybe_unused__ __nonnull ((1))
+static void
+DYNARRAY_NAME (remove_last) (struct DYNARRAY_STRUCT *list)
+{
+ /* used > 0 implies that the array is the non-failed state. */
+ if (list->u.dynarray_header.used > 0)
+ {
+ size_t new_length = list->u.dynarray_header.used - 1;
+#ifdef DYNARRAY_ELEMENT_FREE
+ DYNARRAY_ELEMENT_FREE (&list->u.dynarray_header.array[new_length]);
+#endif
+ list->u.dynarray_header.used = new_length;
+ }
+}
+
+/* Remove all elements from the list. The elements are freed, but the
+ list itself is not. */
+__attribute_maybe_unused__ __nonnull ((1))
+static void
+DYNARRAY_NAME (clear) (struct DYNARRAY_STRUCT *list)
+{
+ /* free__elements__ does nothing if the list is in the failed
+ state. */
+ DYNARRAY_NAME (free__elements__)
+ (list->u.dynarray_header.array, list->u.dynarray_header.used);
+ list->u.dynarray_header.used = 0;
+}
+
+#ifdef DYNARRAY_FINAL_TYPE
+/* Transfer the dynamic array to a permanent location at *RESULT.
+ Returns true on success on false on allocation failure. In either
+ case, *LIST is re-initialized and can be reused. A NULL pointer is
+ stored in *RESULT if LIST refers to an empty list. On success, the
+ pointer in *RESULT is heap-allocated and must be deallocated using
+ free. */
+__attribute_maybe_unused__ __attribute_warn_unused_result__ __nonnull ((1, 2))
+static bool
+DYNARRAY_NAME (finalize) (struct DYNARRAY_STRUCT *list,
+ DYNARRAY_FINAL_TYPE *result)
+{
+ struct dynarray_finalize_result res;
+ if (__libc_dynarray_finalize (&list->u.dynarray_abstract,
+ DYNARRAY_SCRATCH (list),
+ sizeof (DYNARRAY_ELEMENT), &res))
+ {
+ /* On success, the result owns all the data. */
+ DYNARRAY_NAME (init) (list);
+ *result = (DYNARRAY_FINAL_TYPE) { res.array, res.length };
+ return true;
+ }
+ else
+ {
+ /* On error, we need to free all data. */
+ DYNARRAY_FREE (list);
+ errno = ENOMEM;
+ return false;
+ }
+}
+#else /* !DYNARRAY_FINAL_TYPE */
+/* Transfer the dynamic array to a heap-allocated array and return a
+ pointer to it. The pointer is NULL if memory allocation fails, or
+ if the array is empty, so this function should be used only for
+ arrays which are known not be empty (usually because they always
+ have a sentinel at the end). If LENGTHP is not NULL, the array
+ length is written to *LENGTHP. *LIST is re-initialized and can be
+ reused. */
+__attribute_maybe_unused__ __attribute_warn_unused_result__ __nonnull ((1))
+static DYNARRAY_ELEMENT *
+DYNARRAY_NAME (finalize) (struct DYNARRAY_STRUCT *list, size_t *lengthp)
+{
+ struct dynarray_finalize_result res;
+ if (__libc_dynarray_finalize (&list->u.dynarray_abstract,
+ DYNARRAY_SCRATCH (list),
+ sizeof (DYNARRAY_ELEMENT), &res))
+ {
+ /* On success, the result owns all the data. */
+ DYNARRAY_NAME (init) (list);
+ if (lengthp != NULL)
+ *lengthp = res.length;
+ return res.array;
+ }
+ else
+ {
+ /* On error, we need to free all data. */
+ DYNARRAY_FREE (list);
+ errno = ENOMEM;
+ return NULL;
+ }
+}
+#endif /* !DYNARRAY_FINAL_TYPE */
+
+/* Undo macro definitions. */
+
+#undef DYNARRAY_CONCAT0
+#undef DYNARRAY_CONCAT1
+#undef DYNARRAY_NAME
+#undef DYNARRAY_SCRATCH
+#undef DYNARRAY_HAVE_SCRATCH
+
+#undef DYNARRAY_STRUCT
+#undef DYNARRAY_ELEMENT
+#undef DYNARRAY_PREFIX
+#undef DYNARRAY_ELEMENT_FREE
+#undef DYNARRAY_ELEMENT_INIT
+#undef DYNARRAY_INITIAL_SIZE
+#undef DYNARRAY_FINAL_TYPE
diff --git a/lib/malloc/dynarray.h b/lib/malloc/dynarray.h
new file mode 100644
index 00000000000..84e4394bf32
--- /dev/null
+++ b/lib/malloc/dynarray.h
@@ -0,0 +1,178 @@
+/* Type-safe arrays which grow dynamically. Shared definitions.
+ Copyright (C) 2017-2021 Free Software Foundation, Inc.
+ This file is part of the GNU C Library.
+
+ The GNU C Library 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.
+
+ The GNU C Library 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 the GNU C Library; if not, see
+ <https://www.gnu.org/licenses/>. */
+
+/* To use the dynarray facility, you need to include
+ <malloc/dynarray-skeleton.c> and define the parameter macros
+ documented in that file.
+
+ A minimal example which provides a growing list of integers can be
+ defined like this:
+
+ struct int_array
+ {
+ // Pointer to result array followed by its length,
+ // as required by DYNARRAY_FINAL_TYPE.
+ int *array;
+ size_t length;
+ };
+
+ #define DYNARRAY_STRUCT dynarray_int
+ #define DYNARRAY_ELEMENT int
+ #define DYNARRAY_PREFIX dynarray_int_
+ #define DYNARRAY_FINAL_TYPE struct int_array
+ #include <malloc/dynarray-skeleton.c>
+
+ To create a three-element array with elements 1, 2, 3, use this
+ code:
+
+ struct dynarray_int dyn;
+ dynarray_int_init (&dyn);
+ for (int i = 1; i <= 3; ++i)
+ {
+ int *place = dynarray_int_emplace (&dyn);
+ assert (place != NULL);
+ *place = i;
+ }
+ struct int_array result;
+ bool ok = dynarray_int_finalize (&dyn, &result);
+ assert (ok);
+ assert (result.length == 3);
+ assert (result.array[0] == 1);
+ assert (result.array[1] == 2);
+ assert (result.array[2] == 3);
+ free (result.array);
+
+ If the elements contain resources which must be freed, define
+ DYNARRAY_ELEMENT_FREE appropriately, like this:
+
+ struct str_array
+ {
+ char **array;
+ size_t length;
+ };
+
+ #define DYNARRAY_STRUCT dynarray_str
+ #define DYNARRAY_ELEMENT char *
+ #define DYNARRAY_ELEMENT_FREE(ptr) free (*ptr)
+ #define DYNARRAY_PREFIX dynarray_str_
+ #define DYNARRAY_FINAL_TYPE struct str_array
+ #include <malloc/dynarray-skeleton.c>
+
+ Compared to scratch buffers, dynamic arrays have the following
+ features:
+
+ - They have an element type, and are not just an untyped buffer of
+ bytes.
+
+ - When growing, previously stored elements are preserved. (It is
+ expected that scratch_buffer_grow_preserve and
+ scratch_buffer_set_array_size eventually go away because all
+ current users are moved to dynamic arrays.)
+
+ - Scratch buffers have a more aggressive growth policy because
+ growing them typically means a retry of an operation (across an
+ NSS service module boundary), which is expensive.
+
+ - For the same reason, scratch buffers have a much larger initial
+ stack allocation. */
+
+#ifndef _DYNARRAY_H
+#define _DYNARRAY_H
+
+#include <stdbool.h>
+#include <stddef.h>
+#include <string.h>
+
+struct dynarray_header
+{
+ size_t used;
+ size_t allocated;
+ void *array;
+};
+
+/* Marker used in the allocated member to indicate that an error was
+ encountered. */
+static inline size_t
+__dynarray_error_marker (void)
+{
+ return -1;
+}
+
+/* Internal function. See the has_failed function in
+ dynarray-skeleton.c. */
+static inline bool
+__dynarray_error (struct dynarray_header *list)
+{
+ return list->allocated == __dynarray_error_marker ();
+}
+
+/* Internal function. Enlarge the dynamically allocated area of the
+ array to make room for one more element. SCRATCH is a pointer to
+ the scratch area (which is not heap-allocated and must not be
+ freed). ELEMENT_SIZE is the size, in bytes, of one element.
+ Return false on failure, true on success. */
+bool __libc_dynarray_emplace_enlarge (struct dynarray_header *,
+ void *scratch, size_t element_size);
+
+/* Internal function. Enlarge the dynamically allocated area of the
+ array to make room for at least SIZE elements (which must be larger
+ than the existing used part of the dynamic array). SCRATCH is a
+ pointer to the scratch area (which is not heap-allocated and must
+ not be freed). ELEMENT_SIZE is the size, in bytes, of one element.
+ Return false on failure, true on success. */
+bool __libc_dynarray_resize (struct dynarray_header *, size_t size,
+ void *scratch, size_t element_size);
+
+/* Internal function. Like __libc_dynarray_resize, but clear the new
+ part of the dynamic array. */
+bool __libc_dynarray_resize_clear (struct dynarray_header *, size_t size,
+ void *scratch, size_t element_size);
+
+/* Internal type. */
+struct dynarray_finalize_result
+{
+ void *array;
+ size_t length;
+};
+
+/* Internal function. Copy the dynamically-allocated area to an
+ explicitly-sized heap allocation. SCRATCH is a pointer to the
+ embedded scratch space. ELEMENT_SIZE is the size, in bytes, of the
+ element type. On success, true is returned, and pointer and length
+ are written to *RESULT. On failure, false is returned. The caller
+ has to take care of some of the memory management; this function is
+ expected to be called from dynarray-skeleton.c. */
+bool __libc_dynarray_finalize (struct dynarray_header *list, void *scratch,
+ size_t element_size,
+ struct dynarray_finalize_result *result);
+
+
+/* Internal function. Terminate the process after an index error.
+ SIZE is the number of elements of the dynamic array. INDEX is the
+ lookup index which triggered the failure. */
+_Noreturn void __libc_dynarray_at_failure (size_t size, size_t index);
+
+#ifndef _ISOMAC
+libc_hidden_proto (__libc_dynarray_emplace_enlarge)
+libc_hidden_proto (__libc_dynarray_resize)
+libc_hidden_proto (__libc_dynarray_resize_clear)
+libc_hidden_proto (__libc_dynarray_finalize)
+libc_hidden_proto (__libc_dynarray_at_failure)
+#endif
+
+#endif /* _DYNARRAY_H */
diff --git a/lib/malloc/dynarray_at_failure.c b/lib/malloc/dynarray_at_failure.c
new file mode 100644
index 00000000000..a4424593748
--- /dev/null
+++ b/lib/malloc/dynarray_at_failure.c
@@ -0,0 +1,35 @@
+/* Report an dynamic array index out of bounds condition.
+ Copyright (C) 2017-2021 Free Software Foundation, Inc.
+ This file is part of the GNU C Library.
+
+ The GNU C Library 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.
+
+ The GNU C Library 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 the GNU C Library; if not, see
+ <https://www.gnu.org/licenses/>. */
+
+#include <dynarray.h>
+#include <stdio.h>
+#include <stdlib.h>
+
+void
+__libc_dynarray_at_failure (size_t size, size_t index)
+{
+#ifdef _LIBC
+ char buf[200];
+ __snprintf (buf, sizeof (buf), "Fatal glibc error: "
+ "array index %zu not less than array length %zu\n",
+ index, size);
+#else
+ abort ();
+#endif
+}
+libc_hidden_def (__libc_dynarray_at_failure)
diff --git a/lib/malloc/dynarray_emplace_enlarge.c b/lib/malloc/dynarray_emplace_enlarge.c
new file mode 100644
index 00000000000..7ac4b6db403
--- /dev/null
+++ b/lib/malloc/dynarray_emplace_enlarge.c
@@ -0,0 +1,73 @@
+/* Increase the size of a dynamic array in preparation of an emplace operation.
+ Copyright (C) 2017-2021 Free Software Foundation, Inc.
+ This file is part of the GNU C Library.
+
+ The GNU C Library 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.
+
+ The GNU C Library 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 the GNU C Library; if not, see
+ <https://www.gnu.org/licenses/>. */
+
+#include <dynarray.h>
+#include <errno.h>
+#include <intprops.h>
+#include <stdlib.h>
+#include <string.h>
+
+bool
+__libc_dynarray_emplace_enlarge (struct dynarray_header *list,
+ void *scratch, size_t element_size)
+{
+ size_t new_allocated;
+ if (list->allocated == 0)
+ {
+ /* No scratch buffer provided. Choose a reasonable default
+ size. */
+ if (element_size < 4)
+ new_allocated = 16;
+ else if (element_size < 8)
+ new_allocated = 8;
+ else
+ new_allocated = 4;
+ }
+ else
+ /* Increase the allocated size, using an exponential growth
+ policy. */
+ {
+ new_allocated = list->allocated + list->allocated / 2 + 1;
+ if (new_allocated <= list->allocated)
+ {
+ /* Overflow. */
+ __set_errno (ENOMEM);
+ return false;
+ }
+ }
+
+ size_t new_size;
+ if (INT_MULTIPLY_WRAPV (new_allocated, element_size, &new_size))
+ return false;
+ void *new_array;
+ if (list->array == scratch)
+ {
+ /* The previous array was not heap-allocated. */
+ new_array = malloc (new_size);
+ if (new_array != NULL && list->array != NULL)
+ memcpy (new_array, list->array, list->used * element_size);
+ }
+ else
+ new_array = realloc (list->array, new_size);
+ if (new_array == NULL)
+ return false;
+ list->array = new_array;
+ list->allocated = new_allocated;
+ return true;
+}
+libc_hidden_def (__libc_dynarray_emplace_enlarge)
diff --git a/lib/malloc/dynarray_finalize.c b/lib/malloc/dynarray_finalize.c
new file mode 100644
index 00000000000..be9441e313d
--- /dev/null
+++ b/lib/malloc/dynarray_finalize.c
@@ -0,0 +1,62 @@
+/* Copy the dynamically-allocated area to an explicitly-sized heap allocation.
+ Copyright (C) 2017-2021 Free Software Foundation, Inc.
+ This file is part of the GNU C Library.
+
+ The GNU C Library 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.
+
+ The GNU C Library 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 the GNU C Library; if not, see
+ <https://www.gnu.org/licenses/>. */
+
+#include <dynarray.h>
+#include <stdlib.h>
+#include <string.h>
+
+bool
+__libc_dynarray_finalize (struct dynarray_header *list,
+ void *scratch, size_t element_size,
+ struct dynarray_finalize_result *result)
+{
+ if (__dynarray_error (list))
+ /* The caller will reported the deferred error. */
+ return false;
+
+ size_t used = list->used;
+
+ /* Empty list. */
+ if (used == 0)
+ {
+ /* An empty list could still be backed by a heap-allocated
+ array. Free it if necessary. */
+ if (list->array != scratch)
+ free (list->array);
+ *result = (struct dynarray_finalize_result) { NULL, 0 };
+ return true;
+ }
+
+ size_t allocation_size = used * element_size;
+ void *heap_array = malloc (allocation_size);
+ if (heap_array != NULL)
+ {
+ /* The new array takes ownership of the strings. */
+ if (list->array != NULL)
+ memcpy (heap_array, list->array, allocation_size);
+ if (list->array != scratch)
+ free (list->array);
+ *result = (struct dynarray_finalize_result)
+ { .array = heap_array, .length = used };
+ return true;
+ }
+ else
+ /* The caller will perform the freeing operation. */
+ return false;
+}
+libc_hidden_def (__libc_dynarray_finalize)
diff --git a/lib/malloc/dynarray_resize.c b/lib/malloc/dynarray_resize.c
new file mode 100644
index 00000000000..92bbddd4461
--- /dev/null
+++ b/lib/malloc/dynarray_resize.c
@@ -0,0 +1,64 @@
+/* Increase the size of a dynamic array.
+ Copyright (C) 2017-2021 Free Software Foundation, Inc.
+ This file is part of the GNU C Library.
+
+ The GNU C Library 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.
+
+ The GNU C Library 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 the GNU C Library; if not, see
+ <https://www.gnu.org/licenses/>. */
+
+#include <dynarray.h>
+#include <errno.h>
+#include <intprops.h>
+#include <stdlib.h>
+#include <string.h>
+
+bool
+__libc_dynarray_resize (struct dynarray_header *list, size_t size,
+ void *scratch, size_t element_size)
+{
+ /* The existing allocation provides sufficient room. */
+ if (size <= list->allocated)
+ {
+ list->used = size;
+ return true;
+ }
+
+ /* Otherwise, use size as the new allocation size. The caller is
+ expected to provide the final size of the array, so there is no
+ over-allocation here. */
+
+ size_t new_size_bytes;
+ if (INT_MULTIPLY_WRAPV (size, element_size, &new_size_bytes))
+ {
+ /* Overflow. */
+ __set_errno (ENOMEM);
+ return false;
+ }
+ void *new_array;
+ if (list->array == scratch)
+ {
+ /* The previous array was not heap-allocated. */
+ new_array = malloc (new_size_bytes);
+ if (new_array != NULL && list->array != NULL)
+ memcpy (new_array, list->array, list->used * element_size);
+ }
+ else
+ new_array = realloc (list->array, new_size_bytes);
+ if (new_array == NULL)
+ return false;
+ list->array = new_array;
+ list->allocated = size;
+ list->used = size;
+ return true;
+}
+libc_hidden_def (__libc_dynarray_resize)
diff --git a/lib/malloc/dynarray_resize_clear.c b/lib/malloc/dynarray_resize_clear.c
new file mode 100644
index 00000000000..99c2cc87c31
--- /dev/null
+++ b/lib/malloc/dynarray_resize_clear.c
@@ -0,0 +1,35 @@
+/* Increase the size of a dynamic array and clear the new part.
+ Copyright (C) 2017-2021 Free Software Foundation, Inc.
+ This file is part of the GNU C Library.
+
+ The GNU C Library 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.
+
+ The GNU C Library 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 the GNU C Library; if not, see
+ <https://www.gnu.org/licenses/>. */
+
+#include <dynarray.h>
+#include <string.h>
+
+bool
+__libc_dynarray_resize_clear (struct dynarray_header *list, size_t size,
+ void *scratch, size_t element_size)
+{
+ size_t old_size = list->used;
+ if (!__libc_dynarray_resize (list, size, scratch, element_size))
+ return false;
+ /* __libc_dynarray_resize already checked for overflow. */
+ char *array = list->array;
+ memset (array + (old_size * element_size), 0,
+ (size - old_size) * element_size);
+ return true;
+}
+libc_hidden_def (__libc_dynarray_resize_clear)
diff --git a/lib/malloc/scratch_buffer_grow.c b/lib/malloc/scratch_buffer_grow.c
index 41befe3d65f..e7606d81cd7 100644
--- a/lib/malloc/scratch_buffer_grow.c
+++ b/lib/malloc/scratch_buffer_grow.c
@@ -1,5 +1,5 @@
/* Variable-sized buffer with on-stack default allocation.
- Copyright (C) 2015-2020 Free Software Foundation, Inc.
+ Copyright (C) 2015-2021 Free Software Foundation, Inc.
This file is part of the GNU C Library.
The GNU C Library is free software; you can redistribute it and/or
diff --git a/lib/malloc/scratch_buffer_grow_preserve.c b/lib/malloc/scratch_buffer_grow_preserve.c
index aef232938d5..59f8c710001 100644
--- a/lib/malloc/scratch_buffer_grow_preserve.c
+++ b/lib/malloc/scratch_buffer_grow_preserve.c
@@ -1,5 +1,5 @@
/* Variable-sized buffer with on-stack default allocation.
- Copyright (C) 2015-2020 Free Software Foundation, Inc.
+ Copyright (C) 2015-2021 Free Software Foundation, Inc.
This file is part of the GNU C Library.
The GNU C Library is free software; you can redistribute it and/or
diff --git a/lib/malloc/scratch_buffer_set_array_size.c b/lib/malloc/scratch_buffer_set_array_size.c
index 5f5e4c24f5a..e2b9f31211a 100644
--- a/lib/malloc/scratch_buffer_set_array_size.c
+++ b/lib/malloc/scratch_buffer_set_array_size.c
@@ -1,5 +1,5 @@
/* Variable-sized buffer with on-stack default allocation.
- Copyright (C) 2015-2020 Free Software Foundation, Inc.
+ Copyright (C) 2015-2021 Free Software Foundation, Inc.
This file is part of the GNU C Library.
The GNU C Library is free software; you can redistribute it and/or
diff --git a/lib/mini-gmp.c b/lib/mini-gmp.c
index d34fe525e4c..de061e673ac 100644
--- a/lib/mini-gmp.c
+++ b/lib/mini-gmp.c
@@ -4521,7 +4521,7 @@ mpz_export (void *r, size_t *countp, int order, size_t size, int endian,
mp_size_t un;
if (nails != 0)
- gmp_die ("mpz_import: Nails not supported.");
+ gmp_die ("mpz_export: Nails not supported.");
assert (order == 1 || order == -1);
assert (endian >= -1 && endian <= 1);
diff --git a/lib/mktime-internal.h b/lib/mktime-internal.h
index b765a37ee34..9c447bd7b05 100644
--- a/lib/mktime-internal.h
+++ b/lib/mktime-internal.h
@@ -1,5 +1,5 @@
/* Internals of mktime and related functions
- Copyright 2016-2020 Free Software Foundation, Inc.
+ Copyright 2016-2021 Free Software Foundation, Inc.
This file is part of the GNU C Library.
Contributed by Paul Eggert <eggert@cs.ucla.edu>.
diff --git a/lib/nstrftime.c b/lib/nstrftime.c
index 8ba6975552b..2f5e4fbe639 100644
--- a/lib/nstrftime.c
+++ b/lib/nstrftime.c
@@ -19,7 +19,7 @@
# define USE_IN_EXTENDED_LOCALE_MODEL 1
# define HAVE_STRUCT_ERA_ENTRY 1
# define HAVE_TM_GMTOFF 1
-# define HAVE_TM_ZONE 1
+# define HAVE_STRUCT_TM_TM_ZONE 1
# define HAVE_TZNAME 1
# include "../locale/localeinfo.h"
#else
@@ -499,7 +499,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize)
#endif
zone = NULL;
-#if HAVE_TM_ZONE
+#if HAVE_STRUCT_TM_TM_ZONE
/* The POSIX test suite assumes that setting
the environment variable TZ to a new value before calling strftime()
will influence the result (the %Z format) even if the information in
@@ -516,7 +516,7 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize)
}
else
{
-# if !HAVE_TM_ZONE
+# if !HAVE_STRUCT_TM_TM_ZONE
/* Infer the zone name from *TZ instead of from TZNAME. */
tzname_vec = tz->tzname_copy;
# endif
diff --git a/lib/regex.c b/lib/regex.c
index 88173bb1052..f76a416b3b5 100644
--- a/lib/regex.c
+++ b/lib/regex.c
@@ -1,5 +1,5 @@
/* Extended regular expression matching and search library.
- Copyright (C) 2002-2020 Free Software Foundation, Inc.
+ Copyright (C) 2002-2021 Free Software Foundation, Inc.
This file is part of the GNU C Library.
Contributed by Isamu Hasegawa <isamu@yamato.ibm.com>.
diff --git a/lib/regex_internal.h b/lib/regex_internal.h
index be2fa4fe78e..4c634edcbfa 100644
--- a/lib/regex_internal.h
+++ b/lib/regex_internal.h
@@ -32,6 +32,7 @@
#include <stdbool.h>
#include <stdint.h>
+#include <dynarray.h>
#include <intprops.h>
#include <verify.h>
@@ -444,25 +445,6 @@ typedef struct re_dfa_t re_dfa_t;
#define re_string_skip_bytes(pstr,idx) ((pstr)->cur_idx += (idx))
#define re_string_set_index(pstr,idx) ((pstr)->cur_idx = (idx))
-#if defined _LIBC || HAVE_ALLOCA
-# include <alloca.h>
-#endif
-
-#ifndef _LIBC
-# if HAVE_ALLOCA
-/* The OS usually guarantees only one guard page at the bottom of the stack,
- and a page size can be as small as 4096 bytes. So we cannot safely
- allocate anything larger than 4096 bytes. Also care for the possibility
- of a few compiler-allocated temporary stack slots. */
-# define __libc_use_alloca(n) ((n) < 4032)
-# else
-/* alloca is implemented with malloc, so just use malloc. */
-# define __libc_use_alloca(n) 0
-# undef alloca
-# define alloca(n) malloc (n)
-# endif
-#endif
-
#ifdef _LIBC
# define MALLOC_0_IS_NONNULL 1
#elif !defined MALLOC_0_IS_NONNULL
@@ -848,12 +830,14 @@ re_string_elem_size_at (const re_string_t *pstr, Idx idx)
}
#endif /* RE_ENABLE_I18N */
-#ifndef FALLTHROUGH
-# if (__GNUC__ >= 7) || (__clang_major__ >= 10)
+#ifdef _LIBC
+# if __GNUC__ >= 7
# define FALLTHROUGH __attribute__ ((__fallthrough__))
# else
# define FALLTHROUGH ((void) 0)
# endif
+#else
+# include "attribute.h"
#endif
#endif /* _REGEX_INTERNAL_H */
diff --git a/lib/regexec.c b/lib/regexec.c
index 395e37db591..15dc57bd0e6 100644
--- a/lib/regexec.c
+++ b/lib/regexec.c
@@ -1,5 +1,5 @@
/* Extended regular expression matching and search library.
- Copyright (C) 2002-2020 Free Software Foundation, Inc.
+ Copyright (C) 2002-2021 Free Software Foundation, Inc.
This file is part of the GNU C Library.
Contributed by Isamu Hasegawa <isamu@yamato.ibm.com>.
@@ -1355,6 +1355,12 @@ pop_fail_stack (struct re_fail_stack_t *fs, Idx *pidx, Idx nregs,
return fs->stack[num].node;
}
+
+#define DYNARRAY_STRUCT regmatch_list
+#define DYNARRAY_ELEMENT regmatch_t
+#define DYNARRAY_PREFIX regmatch_list_
+#include <malloc/dynarray-skeleton.c>
+
/* Set the positions where the subexpressions are starts/ends to registers
PMATCH.
Note: We assume that pmatch[0] is already set, and
@@ -1370,8 +1376,8 @@ set_regs (const regex_t *preg, const re_match_context_t *mctx, size_t nmatch,
re_node_set eps_via_nodes;
struct re_fail_stack_t *fs;
struct re_fail_stack_t fs_body = { 0, 2, NULL };
- regmatch_t *prev_idx_match;
- bool prev_idx_match_malloced = false;
+ struct regmatch_list prev_match;
+ regmatch_list_init (&prev_match);
DEBUG_ASSERT (nmatch > 1);
DEBUG_ASSERT (mctx->state_log != NULL);
@@ -1388,18 +1394,13 @@ set_regs (const regex_t *preg, const re_match_context_t *mctx, size_t nmatch,
cur_node = dfa->init_node;
re_node_set_init_empty (&eps_via_nodes);
- if (__libc_use_alloca (nmatch * sizeof (regmatch_t)))
- prev_idx_match = (regmatch_t *) alloca (nmatch * sizeof (regmatch_t));
- else
+ if (!regmatch_list_resize (&prev_match, nmatch))
{
- prev_idx_match = re_malloc (regmatch_t, nmatch);
- if (prev_idx_match == NULL)
- {
- free_fail_stack_return (fs);
- return REG_ESPACE;
- }
- prev_idx_match_malloced = true;
+ regmatch_list_free (&prev_match);
+ free_fail_stack_return (fs);
+ return REG_ESPACE;
}
+ regmatch_t *prev_idx_match = regmatch_list_begin (&prev_match);
memcpy (prev_idx_match, pmatch, sizeof (regmatch_t) * nmatch);
for (idx = pmatch[0].rm_so; idx <= pmatch[0].rm_eo ;)
@@ -1417,8 +1418,7 @@ set_regs (const regex_t *preg, const re_match_context_t *mctx, size_t nmatch,
if (reg_idx == nmatch)
{
re_node_set_free (&eps_via_nodes);
- if (prev_idx_match_malloced)
- re_free (prev_idx_match);
+ regmatch_list_free (&prev_match);
return free_fail_stack_return (fs);
}
cur_node = pop_fail_stack (fs, &idx, nmatch, pmatch,
@@ -1427,8 +1427,7 @@ set_regs (const regex_t *preg, const re_match_context_t *mctx, size_t nmatch,
else
{
re_node_set_free (&eps_via_nodes);
- if (prev_idx_match_malloced)
- re_free (prev_idx_match);
+ regmatch_list_free (&prev_match);
return REG_NOERROR;
}
}
@@ -1442,8 +1441,7 @@ set_regs (const regex_t *preg, const re_match_context_t *mctx, size_t nmatch,
if (__glibc_unlikely (cur_node == -2))
{
re_node_set_free (&eps_via_nodes);
- if (prev_idx_match_malloced)
- re_free (prev_idx_match);
+ regmatch_list_free (&prev_match);
free_fail_stack_return (fs);
return REG_ESPACE;
}
@@ -1453,15 +1451,13 @@ set_regs (const regex_t *preg, const re_match_context_t *mctx, size_t nmatch,
else
{
re_node_set_free (&eps_via_nodes);
- if (prev_idx_match_malloced)
- re_free (prev_idx_match);
+ regmatch_list_free (&prev_match);
return REG_NOMATCH;
}
}
}
re_node_set_free (&eps_via_nodes);
- if (prev_idx_match_malloced)
- re_free (prev_idx_match);
+ regmatch_list_free (&prev_match);
return free_fail_stack_return (fs);
}
@@ -3251,7 +3247,7 @@ expand_bkref_cache (re_match_context_t *mctx, re_node_set *cur_nodes,
/* Build transition table for the state.
Return true if successful. */
-static bool
+static bool __attribute_noinline__
build_trtable (const re_dfa_t *dfa, re_dfastate_t *state)
{
reg_errcode_t err;
@@ -3259,36 +3255,20 @@ build_trtable (const re_dfa_t *dfa, re_dfastate_t *state)
int ch;
bool need_word_trtable = false;
bitset_word_t elem, mask;
- bool dests_node_malloced = false;
- bool dest_states_malloced = false;
Idx ndests; /* Number of the destination states from 'state'. */
re_dfastate_t **trtable;
- re_dfastate_t **dest_states = NULL, **dest_states_word, **dest_states_nl;
- re_node_set follows, *dests_node;
- bitset_t *dests_ch;
+ re_dfastate_t *dest_states[SBC_MAX];
+ re_dfastate_t *dest_states_word[SBC_MAX];
+ re_dfastate_t *dest_states_nl[SBC_MAX];
+ re_node_set follows;
bitset_t acceptable;
- struct dests_alloc
- {
- re_node_set dests_node[SBC_MAX];
- bitset_t dests_ch[SBC_MAX];
- } *dests_alloc;
-
/* We build DFA states which corresponds to the destination nodes
from 'state'. 'dests_node[i]' represents the nodes which i-th
destination state contains, and 'dests_ch[i]' represents the
characters which i-th destination state accepts. */
- if (__libc_use_alloca (sizeof (struct dests_alloc)))
- dests_alloc = (struct dests_alloc *) alloca (sizeof (struct dests_alloc));
- else
- {
- dests_alloc = re_malloc (struct dests_alloc, 1);
- if (__glibc_unlikely (dests_alloc == NULL))
- return false;
- dests_node_malloced = true;
- }
- dests_node = dests_alloc->dests_node;
- dests_ch = dests_alloc->dests_ch;
+ re_node_set dests_node[SBC_MAX];
+ bitset_t dests_ch[SBC_MAX];
/* Initialize transition table. */
state->word_trtable = state->trtable = NULL;
@@ -3298,8 +3278,6 @@ build_trtable (const re_dfa_t *dfa, re_dfastate_t *state)
ndests = group_nodes_into_DFAstates (dfa, state, dests_node, dests_ch);
if (__glibc_unlikely (ndests <= 0))
{
- if (dests_node_malloced)
- re_free (dests_alloc);
/* Return false in case of an error, true otherwise. */
if (ndests == 0)
{
@@ -3314,38 +3292,14 @@ build_trtable (const re_dfa_t *dfa, re_dfastate_t *state)
err = re_node_set_alloc (&follows, ndests + 1);
if (__glibc_unlikely (err != REG_NOERROR))
- goto out_free;
-
- /* Avoid arithmetic overflow in size calculation. */
- size_t ndests_max
- = ((SIZE_MAX - (sizeof (re_node_set) + sizeof (bitset_t)) * SBC_MAX)
- / (3 * sizeof (re_dfastate_t *)));
- if (__glibc_unlikely (ndests_max < ndests))
- goto out_free;
-
- if (__libc_use_alloca ((sizeof (re_node_set) + sizeof (bitset_t)) * SBC_MAX
- + ndests * 3 * sizeof (re_dfastate_t *)))
- dest_states = (re_dfastate_t **)
- alloca (ndests * 3 * sizeof (re_dfastate_t *));
- else
{
- dest_states = re_malloc (re_dfastate_t *, ndests * 3);
- if (__glibc_unlikely (dest_states == NULL))
- {
-out_free:
- if (dest_states_malloced)
- re_free (dest_states);
- re_node_set_free (&follows);
- for (i = 0; i < ndests; ++i)
- re_node_set_free (dests_node + i);
- if (dests_node_malloced)
- re_free (dests_alloc);
- return false;
- }
- dest_states_malloced = true;
+ out_free:
+ re_node_set_free (&follows);
+ for (i = 0; i < ndests; ++i)
+ re_node_set_free (dests_node + i);
+ return false;
}
- dest_states_word = dest_states + ndests;
- dest_states_nl = dest_states_word + ndests;
+
bitset_empty (acceptable);
/* Then build the states for all destinations. */
@@ -3470,16 +3424,9 @@ out_free:
}
}
- if (dest_states_malloced)
- re_free (dest_states);
-
re_node_set_free (&follows);
for (i = 0; i < ndests; ++i)
re_node_set_free (dests_node + i);
-
- if (dests_node_malloced)
- re_free (dests_alloc);
-
return true;
}
diff --git a/lib/scratch_buffer.h b/lib/scratch_buffer.h
index 3e2b5ef27db..603b0d65d0a 100644
--- a/lib/scratch_buffer.h
+++ b/lib/scratch_buffer.h
@@ -21,6 +21,7 @@
#include <libc-config.h>
+#define __libc_scratch_buffer_dupfree gl_scratch_buffer_dupfree
#define __libc_scratch_buffer_grow gl_scratch_buffer_grow
#define __libc_scratch_buffer_grow_preserve gl_scratch_buffer_grow_preserve
#define __libc_scratch_buffer_set_array_size gl_scratch_buffer_set_array_size
diff --git a/lib/stddef.in.h b/lib/stddef.in.h
index ba7195a9102..0f506a5b18b 100644
--- a/lib/stddef.in.h
+++ b/lib/stddef.in.h
@@ -49,6 +49,23 @@
# ifndef _@GUARD_PREFIX@_STDDEF_H
+/* On AIX 7.2, with xlc in 64-bit mode, <stddef.h> defines max_align_t to a
+ type with alignment 4, but 'long' has alignment 8. */
+# if defined _AIX && defined _ARCH_PPC64
+# if !GNULIB_defined_max_align_t
+# ifdef _MAX_ALIGN_T
+/* /usr/include/stddef.h has already defined max_align_t. Override it. */
+typedef long rpl_max_align_t;
+# define max_align_t rpl_max_align_t
+# else
+/* Prevent /usr/include/stddef.h from defining max_align_t. */
+typedef long max_align_t;
+# define _MAX_ALIGN_T
+# endif
+# define GNULIB_defined_max_align_t 1
+# endif
+# endif
+
/* The include_next requires a split double-inclusion guard. */
# @INCLUDE_NEXT@ @NEXT_STDDEF_H@
@@ -86,8 +103,10 @@
we are currently compiling with gcc.
On MSVC, max_align_t is defined only in C++ mode, after <cstddef> was
included. Its definition is good since it has an alignment of 8 (on x86
- and x86_64). */
-#if defined _MSC_VER && defined __cplusplus
+ and x86_64).
+ Similarly on OS/2 kLIBC. */
+#if (defined _MSC_VER || (defined __KLIBC__ && !defined __LIBCN__)) \
+ && defined __cplusplus
# include <cstddef>
#else
# if ! (@HAVE_MAX_ALIGN_T@ || defined _GCC_MAX_ALIGN_T)
diff --git a/lib/string.in.h b/lib/string.in.h
index 9f68e77c767..c76c1820b36 100644
--- a/lib/string.in.h
+++ b/lib/string.in.h
@@ -69,6 +69,14 @@
# include <unistd.h>
#endif
+/* AIX 7.2 declares ffsl and ffsll in <strings.h>, not in <string.h>. */
+/* But in any case avoid namespace pollution on glibc systems. */
+#if ((@GNULIB_FFSL@ || @GNULIB_FFSLL@ || defined GNULIB_POSIXCHECK) \
+ && defined _AIX) \
+ && ! defined __GLIBC__
+# include <strings.h>
+#endif
+
/* The definitions of _GL_FUNCDECL_RPL etc. are copied here. */
/* The definition of _GL_ARG_NONNULL is copied here. */
@@ -110,10 +118,18 @@ _GL_WARN_ON_USE (ffsl, "ffsl is not portable - use the ffsl module");
/* Find the index of the least-significant set bit. */
#if @GNULIB_FFSLL@
-# if !@HAVE_FFSLL@
+# if @REPLACE_FFSLL@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# define ffsll rpl_ffsll
+# endif
+_GL_FUNCDECL_RPL (ffsll, int, (long long int i));
+_GL_CXXALIAS_RPL (ffsll, int, (long long int i));
+# else
+# if !@HAVE_FFSLL@
_GL_FUNCDECL_SYS (ffsll, int, (long long int i));
-# endif
+# endif
_GL_CXXALIAS_SYS (ffsll, int, (long long int i));
+# endif
_GL_CXXALIASWARN (ffsll);
#elif defined GNULIB_POSIXCHECK
# undef ffsll
diff --git a/lib/sys_stat.in.h b/lib/sys_stat.in.h
index ccdb5cbd143..13d12943cd0 100644
--- a/lib/sys_stat.in.h
+++ b/lib/sys_stat.in.h
@@ -713,11 +713,21 @@ _GL_WARN_ON_USE (mkfifo, "mkfifo is not portable - "
#if @GNULIB_MKFIFOAT@
-# if !@HAVE_MKFIFOAT@
+# if @REPLACE_MKFIFOAT@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef mkfifoat
+# define mkfifoat rpl_mkfifoat
+# endif
+_GL_FUNCDECL_RPL (mkfifoat, int, (int fd, char const *file, mode_t mode)
+ _GL_ARG_NONNULL ((2)));
+_GL_CXXALIAS_RPL (mkfifoat, int, (int fd, char const *file, mode_t mode));
+# else
+# if !@HAVE_MKFIFOAT@
_GL_FUNCDECL_SYS (mkfifoat, int, (int fd, char const *file, mode_t mode)
_GL_ARG_NONNULL ((2)));
-# endif
+# endif
_GL_CXXALIAS_SYS (mkfifoat, int, (int fd, char const *file, mode_t mode));
+# endif
_GL_CXXALIASWARN (mkfifoat);
#elif defined GNULIB_POSIXCHECK
# undef mkfifoat
@@ -756,13 +766,25 @@ _GL_WARN_ON_USE (mknod, "mknod is not portable - "
#if @GNULIB_MKNODAT@
-# if !@HAVE_MKNODAT@
+# if @REPLACE_MKNODAT@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef mknodat
+# define mknodat rpl_mknodat
+# endif
+_GL_FUNCDECL_RPL (mknodat, int,
+ (int fd, char const *file, mode_t mode, dev_t dev)
+ _GL_ARG_NONNULL ((2)));
+_GL_CXXALIAS_RPL (mknodat, int,
+ (int fd, char const *file, mode_t mode, dev_t dev));
+# else
+# if !@HAVE_MKNODAT@
_GL_FUNCDECL_SYS (mknodat, int,
(int fd, char const *file, mode_t mode, dev_t dev)
_GL_ARG_NONNULL ((2)));
-# endif
+# endif
_GL_CXXALIAS_SYS (mknodat, int,
(int fd, char const *file, mode_t mode, dev_t dev));
+# endif
_GL_CXXALIASWARN (mknodat);
#elif defined GNULIB_POSIXCHECK
# undef mknodat
diff --git a/lib/tempname.c b/lib/tempname.c
index 3d91deef1e1..e243483eaf8 100644
--- a/lib/tempname.c
+++ b/lib/tempname.c
@@ -22,6 +22,7 @@
#include <sys/types.h>
#include <assert.h>
+#include <stdbool.h>
#include <errno.h>
@@ -61,7 +62,8 @@
# define __gen_tempname gen_tempname
# define __mkdir mkdir
# define __open open
-# define __lxstat64(version, file, buf) lstat (file, buf)
+# define __lstat64(file, buf) lstat (file, buf)
+# define __stat64(file, buf) stat (file, buf)
# define __getrandom getrandom
# define __clock_gettime64 clock_gettime
# define __timespec64 timespec
@@ -76,13 +78,14 @@ typedef uint_fast64_t random_value;
#define BASE_62_POWER (62LL * 62 * 62 * 62 * 62 * 62 * 62 * 62 * 62 * 62)
static random_value
-random_bits (random_value var)
+random_bits (random_value var, bool use_getrandom)
{
random_value r;
- if (__getrandom (&r, sizeof r, 0) == sizeof r)
+ /* Without GRND_NONBLOCK it can be blocked for minutes on some systems. */
+ if (use_getrandom && __getrandom (&r, sizeof r, GRND_NONBLOCK) == sizeof r)
return r;
#if _LIBC || (defined CLOCK_MONOTONIC && HAVE_CLOCK_GETTIME)
- /* Add entropy if getrandom is not supported. */
+ /* Add entropy if getrandom did not work. */
struct __timespec64 tv;
__clock_gettime64 (CLOCK_MONOTONIC, &tv);
var ^= tv.tv_nsec;
@@ -96,7 +99,7 @@ static int
direxists (const char *dir)
{
struct_stat64 buf;
- return __xstat64 (_STAT_VER, dir, &buf) == 0 && S_ISDIR (buf.st_mode);
+ return __stat64 (dir, &buf) == 0 && S_ISDIR (buf.st_mode);
}
/* Path search algorithm, for tmpnam, tmpfile, etc. If DIR is
@@ -188,7 +191,7 @@ try_nocreate (char *tmpl, void *flags _GL_UNUSED)
{
struct_stat64 st;
- if (__lxstat64 (_STAT_VER, tmpl, &st) == 0 || errno == EOVERFLOW)
+ if (__lstat64 (tmpl, &st) == 0 || errno == EOVERFLOW)
__set_errno (EEXIST);
return errno == ENOENT ? 0 : -1;
}
@@ -267,6 +270,13 @@ try_tempname_len (char *tmpl, int suffixlen, void *args,
/* How many random base-62 digits can currently be extracted from V. */
int vdigits = 0;
+ /* Whether to consume entropy when acquiring random bits. On the
+ first try it's worth the entropy cost with __GT_NOCREATE, which
+ is inherently insecure and can use the entropy to make it a bit
+ less secure. On the (rare) second and later attempts it might
+ help against DoS attacks. */
+ bool use_getrandom = tryfunc == try_nocreate;
+
/* Least unfair value for V. If V is less than this, V can generate
BASE_62_DIGITS digits fairly. Otherwise it might be biased. */
random_value const unfair_min
@@ -290,7 +300,10 @@ try_tempname_len (char *tmpl, int suffixlen, void *args,
if (vdigits == 0)
{
do
- v = random_bits (v);
+ {
+ v = random_bits (v, use_getrandom);
+ use_getrandom = true;
+ }
while (unfair_min <= v);
vdigits = BASE_62_DIGITS;
diff --git a/lib/time-internal.h b/lib/time-internal.h
index 63a3f9e3db1..067ee729eda 100644
--- a/lib/time-internal.h
+++ b/lib/time-internal.h
@@ -24,7 +24,7 @@ struct tm_zone
members are zero. */
struct tm_zone *next;
-#if HAVE_TZNAME && !HAVE_TM_ZONE
+#if HAVE_TZNAME && !HAVE_STRUCT_TM_TM_ZONE
/* Copies of recent strings taken from tzname[0] and tzname[1].
The copies are in ABBRS, so that they survive tzset. Null if unknown. */
char *tzname_copy[2];
diff --git a/lib/time.in.h b/lib/time.in.h
index 958dc0bd292..1385980cdf5 100644
--- a/lib/time.in.h
+++ b/lib/time.in.h
@@ -101,6 +101,25 @@ struct __time_t_must_be_integral {
# define GNULIB_defined_struct_time_t_must_be_integral 1
# endif
+/* Define TIME_UTC, a positive integer constant used for timespec_get(). */
+# if ! @TIME_H_DEFINES_TIME_UTC@
+# if !GNULIB_defined_TIME_UTC
+# define TIME_UTC 1
+# define GNULIB_defined_TIME_UTC 1
+# endif
+# endif
+
+/* Set *TS to the current time, and return BASE.
+ Upon failure, return 0. */
+# if @GNULIB_TIMESPEC_GET@
+# if ! @HAVE_TIMESPEC_GET@
+_GL_FUNCDECL_SYS (timespec_get, int, (struct timespec *ts, int base)
+ _GL_ARG_NONNULL ((1)));
+# endif
+_GL_CXXALIAS_SYS (timespec_get, int, (struct timespec *ts, int base));
+_GL_CXXALIASWARN (timespec_get);
+# endif
+
/* Sleep for at least RQTP seconds unless interrupted, If interrupted,
return -1 and store the remaining time into RMTP. See
<https://pubs.opengroup.org/onlinepubs/9699919799/functions/nanosleep.html>. */
diff --git a/lib/time_rz.c b/lib/time_rz.c
index 65e20cc5661..3ac053c6219 100644
--- a/lib/time_rz.c
+++ b/lib/time_rz.c
@@ -71,7 +71,7 @@ tzalloc (char const *name)
if (tz)
{
tz->next = NULL;
-#if HAVE_TZNAME && !HAVE_TM_ZONE
+#if HAVE_TZNAME && !HAVE_STRUCT_TM_TM_ZONE
tz->tzname_copy[0] = tz->tzname_copy[1] = NULL;
#endif
tz->tz_is_set = !!name;
@@ -83,13 +83,13 @@ tzalloc (char const *name)
}
/* Save into TZ any nontrivial time zone abbreviation used by TM, and
- update *TM (if HAVE_TM_ZONE) or *TZ (if !HAVE_TM_ZONE &&
- HAVE_TZNAME) if they use the abbreviation. Return true if
- successful, false (setting errno) otherwise. */
+ update *TM (if HAVE_STRUCT_TM_TM_ZONE) or *TZ (if
+ !HAVE_STRUCT_TM_TM_ZONE && HAVE_TZNAME) if they use the abbreviation.
+ Return true if successful, false (setting errno) otherwise. */
static bool
save_abbr (timezone_t tz, struct tm *tm)
{
-#if HAVE_TM_ZONE || HAVE_TZNAME
+#if HAVE_STRUCT_TM_TM_ZONE || HAVE_TZNAME
char const *zone = NULL;
char *zone_copy = (char *) "";
@@ -97,7 +97,7 @@ save_abbr (timezone_t tz, struct tm *tm)
int tzname_index = -1;
# endif
-# if HAVE_TM_ZONE
+# if HAVE_STRUCT_TM_TM_ZONE
zone = tm->tm_zone;
# endif
@@ -145,7 +145,7 @@ save_abbr (timezone_t tz, struct tm *tm)
}
/* Replace the zone name so that its lifetime matches that of TZ. */
-# if HAVE_TM_ZONE
+# if HAVE_STRUCT_TM_TM_ZONE
tm->tm_zone = zone_copy;
# else
if (0 <= tzname_index)
@@ -303,7 +303,7 @@ mktime_z (timezone_t tz, struct tm *tm)
tm_1.tm_isdst = tm->tm_isdst;
time_t t = mktime (&tm_1);
bool ok = 0 <= tm_1.tm_yday;
-#if HAVE_TM_ZONE || HAVE_TZNAME
+#if HAVE_STRUCT_TM_TM_ZONE || HAVE_TZNAME
ok = ok && save_abbr (tz, &tm_1);
#endif
if (revert_tz (old_tz) && ok)
diff --git a/lib/timegm.c b/lib/timegm.c
index fa30943084d..e4127e71c0b 100644
--- a/lib/timegm.c
+++ b/lib/timegm.c
@@ -1,6 +1,6 @@
/* Convert UTC calendar time to simple time. Like mktime but assumes UTC.
- Copyright (C) 1994-2020 Free Software Foundation, Inc.
+ Copyright (C) 1994-2021 Free Software Foundation, Inc.
This file is part of the GNU C Library.
The GNU C Library is free software; you can redistribute it and/or
diff --git a/lib/utimens.c b/lib/utimens.c
index 5bbae058132..44d1ea003e2 100644
--- a/lib/utimens.c
+++ b/lib/utimens.c
@@ -27,6 +27,7 @@
#include <errno.h>
#include <fcntl.h>
#include <stdbool.h>
+#include <string.h>
#include <sys/stat.h>
#include <sys/time.h>
#include <unistd.h>
@@ -52,7 +53,9 @@
/* Avoid recursion with rpl_futimens or rpl_utimensat. */
#undef futimens
-#undef utimensat
+#if !HAVE_NEARLY_WORKING_UTIMENSAT
+# undef utimensat
+#endif
/* Solaris 9 mistakenly succeeds when given a non-directory with a
trailing slash. Force the use of rpl_stat for a fix. */
@@ -246,6 +249,20 @@ fdutimens (int fd, char const *file, struct timespec const timespec[2])
# if HAVE_UTIMENSAT
if (fd < 0)
{
+# if defined __APPLE__ && defined __MACH__
+ size_t len = strlen (file);
+ if (len > 0 && file[len - 1] == '/')
+ {
+ struct stat statbuf;
+ if (stat (file, &statbuf) < 0)
+ return -1;
+ if (!S_ISDIR (statbuf.st_mode))
+ {
+ errno = ENOTDIR;
+ return -1;
+ }
+ }
+# endif
result = utimensat (AT_FDCWD, file, ts, 0);
# ifdef __linux__
/* Work around a kernel bug:
diff --git a/lib/utimensat.c b/lib/utimensat.c
index 2cea64f6982..9fdecd681f6 100644
--- a/lib/utimensat.c
+++ b/lib/utimensat.c
@@ -24,14 +24,40 @@
#include <errno.h>
#include <fcntl.h>
#include <stdlib.h>
+#include <string.h>
+#include <sys/stat.h>
#include "stat-time.h"
#include "timespec.h"
#include "utimens.h"
-#if HAVE_UTIMENSAT
+#if HAVE_NEARLY_WORKING_UTIMENSAT
+/* Use the original utimensat(), but correct the trailing slash handling. */
+int
+rpl_utimensat (int fd, char const *file, struct timespec const times[2],
+ int flag)
# undef utimensat
+{
+ size_t len = strlen (file);
+ if (len && file[len - 1] == '/')
+ {
+ struct stat st;
+ if (fstatat (fd, file, &st, flag & AT_SYMLINK_NOFOLLOW) < 0)
+ return -1;
+ if (!S_ISDIR (st.st_mode))
+ {
+ errno = ENOTDIR;
+ return -1;
+ }
+ }
+
+ return utimensat (fd, file, times, flag);
+}
+
+#else
+
+# if HAVE_UTIMENSAT
/* If we have a native utimensat, but are compiling this file, then
utimensat was defined to rpl_utimensat by our replacement
@@ -42,24 +68,25 @@
local_utimensat provides the fallback manipulation. */
static int local_utimensat (int, char const *, struct timespec const[2], int);
-# define AT_FUNC_NAME local_utimensat
+# define AT_FUNC_NAME local_utimensat
/* Like utimensat, but work around native bugs. */
int
rpl_utimensat (int fd, char const *file, struct timespec const times[2],
int flag)
+# undef utimensat
{
-# if defined __linux__ || defined __sun
+# if defined __linux__ || defined __sun
struct timespec ts[2];
-# endif
+# endif
/* See comments in utimens.c for details. */
static int utimensat_works_really; /* 0 = unknown, 1 = yes, -1 = no. */
if (0 <= utimensat_works_really)
{
int result;
-# if defined __linux__ || defined __sun
+# if defined __linux__ || defined __sun
struct stat st;
/* As recently as Linux kernel 2.6.32 (Dec 2009), several file
systems (xfs, ntfs-3g) have bugs with a single UTIME_OMIT,
@@ -90,7 +117,7 @@ rpl_utimensat (int fd, char const *file, struct timespec const times[2],
ts[1] = times[1];
times = ts;
}
-# ifdef __hppa__
+# ifdef __hppa__
/* Linux kernel 2.6.22.19 on hppa does not reject invalid tv_nsec
values. */
else if (times
@@ -104,8 +131,36 @@ rpl_utimensat (int fd, char const *file, struct timespec const times[2],
errno = EINVAL;
return -1;
}
+# endif
+# endif
+# if defined __APPLE__ && defined __MACH__
+ /* macOS 10.13 does not reject invalid tv_nsec values either. */
+ if (times
+ && ((times[0].tv_nsec != UTIME_OMIT
+ && times[0].tv_nsec != UTIME_NOW
+ && ! (0 <= times[0].tv_nsec
+ && times[0].tv_nsec < TIMESPEC_HZ))
+ || (times[1].tv_nsec != UTIME_OMIT
+ && times[1].tv_nsec != UTIME_NOW
+ && ! (0 <= times[1].tv_nsec
+ && times[1].tv_nsec < TIMESPEC_HZ))))
+ {
+ errno = EINVAL;
+ return -1;
+ }
+ size_t len = strlen (file);
+ if (len > 0 && file[len - 1] == '/')
+ {
+ struct stat statbuf;
+ if (fstatat (fd, file, &statbuf, 0) < 0)
+ return -1;
+ if (!S_ISDIR (statbuf.st_mode))
+ {
+ errno = ENOTDIR;
+ return -1;
+ }
+ }
# endif
-# endif
result = utimensat (fd, file, times, flag);
/* Linux kernel 2.6.25 has a bug where it returns EINVAL for
UTIME_NOW or UTIME_OMIT with non-zero tv_sec, which
@@ -129,11 +184,11 @@ rpl_utimensat (int fd, char const *file, struct timespec const times[2],
return local_utimensat (fd, file, times, flag);
}
-#else /* !HAVE_UTIMENSAT */
+# else /* !HAVE_UTIMENSAT */
-# define AT_FUNC_NAME utimensat
+# define AT_FUNC_NAME utimensat
-#endif /* !HAVE_UTIMENSAT */
+# endif /* !HAVE_UTIMENSAT */
/* Set the access and modification timestamps of FILE to be
TIMESPEC[0] and TIMESPEC[1], respectively; relative to directory
@@ -146,15 +201,17 @@ rpl_utimensat (int fd, char const *file, struct timespec const times[2],
Return 0 on success, -1 (setting errno) on failure. */
/* AT_FUNC_NAME is now utimensat or local_utimensat. */
-#define AT_FUNC_F1 lutimens
-#define AT_FUNC_F2 utimens
-#define AT_FUNC_USE_F1_COND AT_SYMLINK_NOFOLLOW
-#define AT_FUNC_POST_FILE_PARAM_DECLS , struct timespec const ts[2], int flag
-#define AT_FUNC_POST_FILE_ARGS , ts
-#include "at-func.c"
-#undef AT_FUNC_NAME
-#undef AT_FUNC_F1
-#undef AT_FUNC_F2
-#undef AT_FUNC_USE_F1_COND
-#undef AT_FUNC_POST_FILE_PARAM_DECLS
-#undef AT_FUNC_POST_FILE_ARGS
+# define AT_FUNC_F1 lutimens
+# define AT_FUNC_F2 utimens
+# define AT_FUNC_USE_F1_COND AT_SYMLINK_NOFOLLOW
+# define AT_FUNC_POST_FILE_PARAM_DECLS , struct timespec const ts[2], int flag
+# define AT_FUNC_POST_FILE_ARGS , ts
+# include "at-func.c"
+# undef AT_FUNC_NAME
+# undef AT_FUNC_F1
+# undef AT_FUNC_F2
+# undef AT_FUNC_USE_F1_COND
+# undef AT_FUNC_POST_FILE_PARAM_DECLS
+# undef AT_FUNC_POST_FILE_ARGS
+
+#endif /* !HAVE_NEARLY_WORKING_UTIMENSAT */
diff --git a/lib/verify.h b/lib/verify.h
index 3cdcdca5671..65514c34b9e 100644
--- a/lib/verify.h
+++ b/lib/verify.h
@@ -22,16 +22,10 @@
/* Define _GL_HAVE__STATIC_ASSERT to 1 if _Static_assert (R, DIAGNOSTIC)
- works as per C11. This is supported by GCC 4.6.0 and later, in C
- mode, and by clang (also in C++ mode).
+ works as per C11. This is supported by GCC 4.6.0+ and by clang 4+.
Define _GL_HAVE__STATIC_ASSERT1 to 1 if _Static_assert (R) works as
- per C2X. This is supported by GCC 9.1 and later, and by clang in
- C++1z mode.
-
- Define _GL_HAVE_STATIC_ASSERT1 if static_assert (R) works as per
- C++17. This is supported by GCC 9.1 and later, and by clang in
- C++1z mode.
+ per C2X. This is supported by GCC 9.1+.
Support compilers claiming conformance to the relevant standard,
and also support GCC when not pedantic. If we were willing to slow
@@ -47,18 +41,6 @@
|| (!defined __STRICT_ANSI__ && 9 <= __GNUC__))
# define _GL_HAVE__STATIC_ASSERT1 1
# endif
-#else
-# if 4 <= __clang_major__
-# define _GL_HAVE__STATIC_ASSERT 1
-# endif
-# if 4 <= __clang_major__ && 201411 <= __cpp_static_assert
-# define _GL_HAVE__STATIC_ASSERT1 1
-# endif
-# if 201703L <= __cplusplus \
- || 9 <= __GNUC__ \
- || (4 <= __clang_major__ && 201411 <= __cpp_static_assert)
-# define _GL_HAVE_STATIC_ASSERT1 1
-# endif
#endif
/* FreeBSD 9.1 <sys/cdefs.h>, included by <stddef.h> and lots of other
@@ -225,7 +207,9 @@ template <int w>
Unfortunately, unlike C11, this implementation must appear as an
ordinary declaration, and cannot appear inside struct { ... }. */
-#if defined _GL_HAVE__STATIC_ASSERT
+#if 200410 <= __cpp_static_assert
+# define _GL_VERIFY(R, DIAGNOSTIC, ...) static_assert (R, DIAGNOSTIC)
+#elif defined _GL_HAVE__STATIC_ASSERT
# define _GL_VERIFY(R, DIAGNOSTIC, ...) _Static_assert (R, DIAGNOSTIC)
#else
# define _GL_VERIFY(R, DIAGNOSTIC, ...) \
@@ -239,7 +223,7 @@ template <int w>
# define _Static_assert(...) \
_GL_VERIFY (__VA_ARGS__, "static assertion failed", -)
# endif
-# if !defined _GL_HAVE_STATIC_ASSERT1 && !defined static_assert
+# if __cpp_static_assert < 201411 && !defined static_assert
# define static_assert _Static_assert /* C11 requires this #define. */
# endif
#endif
diff --git a/lisp/abbrev.el b/lisp/abbrev.el
index 65f71183856..54783db2c3e 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/allout-widgets.el b/lisp/allout-widgets.el
index d31083e4271..7dcf36851f2 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)
diff --git a/lisp/allout.el b/lisp/allout.el
index 39aa29b664a..ff0b67556e0 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 ad3b690dfa6..2494040457b 100644
--- a/lisp/auth-source.el
+++ b/lisp/auth-source.el
@@ -588,7 +588,7 @@ Here's an example:
\(let ((auth-source-creation-defaults \\='((user . \"defaultUser\")
(A . \"default A\")))
(auth-source-creation-prompts
- \\='((password . \"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)))
diff --git a/lisp/autorevert.el b/lisp/autorevert.el
index 1b2d68939ad..57258f9c833 100644
--- a/lisp/autorevert.el
+++ b/lisp/autorevert.el
@@ -355,10 +355,9 @@ the list of old buffers.")
(add-hook 'after-set-visited-file-name-hook
#'auto-revert-set-visited-file-name)
-(defvar auto-revert--buffers-by-watch-descriptor
- (make-hash-table :test 'equal)
- "A hash table mapping notification descriptors to lists of buffers.
-The buffers use that descriptor for auto-revert notifications.
+(defvar auto-revert--buffer-by-watch-descriptor nil
+ "An association list mapping notification descriptors to buffers.
+The buffer uses that descriptor for auto-revert notifications.
The key is equal to `auto-revert-notify-watch-descriptor' in each
buffer.")
@@ -630,16 +629,12 @@ will use an up-to-date value of `auto-revert-interval'."
(defun auto-revert-notify-rm-watch ()
"Disable file notification for current buffer's associated file."
- (let ((desc auto-revert-notify-watch-descriptor)
- (table auto-revert--buffers-by-watch-descriptor))
- (when desc
- (let ((buffers (delq (current-buffer) (gethash desc table))))
- (if buffers
- (puthash desc buffers table)
- (remhash desc table)))
- (ignore-errors
- (file-notify-rm-watch desc))
- (remove-hook 'kill-buffer-hook #'auto-revert-notify-rm-watch t)))
+ (when-let ((desc auto-revert-notify-watch-descriptor))
+ (setq auto-revert--buffer-by-watch-descriptor
+ (assoc-delete-all desc auto-revert--buffer-by-watch-descriptor))
+ (ignore-errors
+ (file-notify-rm-watch desc))
+ (remove-hook 'kill-buffer-hook #'auto-revert-notify-rm-watch t))
(setq auto-revert-notify-watch-descriptor nil
auto-revert-notify-modified-p nil))
@@ -660,13 +655,10 @@ will use an up-to-date value of `auto-revert-interval'."
(if buffer-file-name '(change attribute-change) '(change))
'auto-revert-notify-handler))))
(when auto-revert-notify-watch-descriptor
- (setq auto-revert-notify-modified-p t)
- (puthash
- auto-revert-notify-watch-descriptor
- (cons (current-buffer)
- (gethash auto-revert-notify-watch-descriptor
- auto-revert--buffers-by-watch-descriptor))
- auto-revert--buffers-by-watch-descriptor)
+ (setq auto-revert-notify-modified-p t
+ auto-revert--buffer-by-watch-descriptor
+ (cons (cons auto-revert-notify-watch-descriptor (current-buffer))
+ auto-revert--buffer-by-watch-descriptor))
(add-hook 'kill-buffer-hook #'auto-revert-notify-rm-watch nil t))))
;; If we have file notifications, we want to update the auto-revert buffers
@@ -696,8 +688,8 @@ system.")
(action (nth 1 event))
(file (nth 2 event))
(file1 (nth 3 event)) ;; Target of `renamed'.
- (buffers (gethash descriptor
- auto-revert--buffers-by-watch-descriptor)))
+ (buffer (alist-get descriptor auto-revert--buffer-by-watch-descriptor
+ nil nil #'equal)))
;; Check, that event is meant for us.
(cl-assert descriptor)
;; Since we watch a directory, a file name must be returned.
@@ -706,9 +698,9 @@ system.")
(when auto-revert-debug
(message "auto-revert-notify-handler %S" event))
- (if (eq action 'stopped)
- ;; File notification has stopped. Continue with polling.
- (cl-dolist (buffer buffers)
+ (when (buffer-live-p buffer)
+ (if (eq action 'stopped)
+ ;; File notification has stopped. Continue with polling.
(with-current-buffer buffer
(when (or
;; A buffer associated with a file.
@@ -721,38 +713,35 @@ system.")
(auto-revert-notify-rm-watch)
;; Restart the timer if it wasn't running.
(unless auto-revert-timer
- (auto-revert-set-timer)))))
-
- ;; Loop over all buffers, in order to find the intended one.
- (cl-dolist (buffer buffers)
- (when (buffer-live-p buffer)
- (with-current-buffer buffer
- (when (or
- ;; A buffer associated with a file.
- (and (stringp buffer-file-name)
- (or
- (and (memq
- action '(attribute-changed changed created))
- (string-equal
- (file-name-nondirectory file)
- (file-name-nondirectory buffer-file-name)))
- (and (eq action 'renamed)
- (string-equal
- (file-name-nondirectory file1)
- (file-name-nondirectory buffer-file-name)))))
- ;; A buffer w/o a file, like dired.
- (and (null buffer-file-name)
- (memq action '(created renamed deleted))))
- ;; Mark buffer modified.
- (setq auto-revert-notify-modified-p t)
-
- ;; Revert the buffer now if we're not locked out.
- (unless auto-revert--lockout-timer
- (auto-revert-handler)
- (setq auto-revert--lockout-timer
- (run-with-timer
- auto-revert--lockout-interval nil
- #'auto-revert--end-lockout buffer)))))))))))
+ (auto-revert-set-timer))))
+
+ (with-current-buffer buffer
+ (when (or
+ ;; A buffer associated with a file.
+ (and (stringp buffer-file-name)
+ (or
+ (and (memq
+ action '(attribute-changed changed created))
+ (string-equal
+ (file-name-nondirectory file)
+ (file-name-nondirectory buffer-file-name)))
+ (and (eq action 'renamed)
+ (string-equal
+ (file-name-nondirectory file1)
+ (file-name-nondirectory buffer-file-name)))))
+ ;; A buffer w/o a file, like dired.
+ (and (null buffer-file-name)
+ (memq action '(created renamed deleted))))
+ ;; Mark buffer modified.
+ (setq auto-revert-notify-modified-p t)
+
+ ;; Revert the buffer now if we're not locked out.
+ (unless auto-revert--lockout-timer
+ (auto-revert-handler)
+ (setq auto-revert--lockout-timer
+ (run-with-timer
+ auto-revert--lockout-interval nil
+ #'auto-revert--end-lockout buffer))))))))))
(defun auto-revert--end-lockout (buffer)
"End the lockout period after a notification.
diff --git a/lisp/bindings.el b/lisp/bindings.el
index 187444af664..43b62f9bbfc 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 " ")))
diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el
index 49f8604f52e..bb39e1f5795 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-graph.el b/lisp/calc/calc-graph.el
index 4785fb7fba2..423d1e64126 100644
--- a/lisp/calc/calc-graph.el
+++ b/lisp/calc/calc-graph.el
@@ -1136,11 +1136,11 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
(if penbl "linespoints" "lines")
(if penbl "points" "dots"))))
(if (and pstyle (> pstyle 0))
- (insert " "
+ (insert " ls "
(if (and lstyle (> lstyle 0)) (int-to-string lstyle) "1")
- " " (int-to-string pstyle))
+ " ps " (int-to-string pstyle))
(if (and lstyle (> lstyle 0))
- (insert " " (int-to-string lstyle)))))))
+ (insert " ls " (int-to-string lstyle)))))))
(calc-graph-view-commands))
(defun calc-graph-zero-x (flag)
diff --git a/lisp/calc/calccomp.el b/lisp/calc/calccomp.el
index 5f38ee71c78..bd81d7fe406 100644
--- a/lisp/calc/calccomp.el
+++ b/lisp/calc/calccomp.el
@@ -822,9 +822,16 @@
(if (setq spfn (get calc-language 'math-func-formatter))
(funcall spfn func a)
- (list 'horiz func calc-function-open
- (math-compose-vector (cdr a) ", " 0)
- calc-function-close))))))))))
+ (let ((args (math-compose-vector (cdr a) ", " 0)))
+ (if (and (member calc-function-open '("(" "[" "{"))
+ (member calc-function-close '(")" "]" "}")))
+ (list 'horiz func
+ (math--comp-bracket
+ (string-to-char calc-function-open)
+ (string-to-char calc-function-close)
+ args))
+ (list 'horiz func calc-function-open
+ args calc-function-close))))))))))))
(defun math-prod-first-term (x)
diff --git a/lisp/calendar/cal-bahai.el b/lisp/calendar/cal-bahai.el
index 22e4cdbcd52..c2e4205c0bc 100644
--- a/lisp/calendar/cal-bahai.el
+++ b/lisp/calendar/cal-bahai.el
@@ -1,4 +1,4 @@
-;;; cal-bahai.el --- calendar functions for the Bahá’í calendar.
+;;; cal-bahai.el --- calendar functions for the Bahá’í calendar. -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
@@ -124,9 +124,10 @@ Defaults to today's date if DATE is not given."
(y (calendar-extract-year bahai-date)))
(if (< y 1)
"" ; pre-Bahai
- (let* ((m (calendar-extract-month bahai-date))
- (d (calendar-extract-day bahai-date))
- (monthname (if (and (= m 19)
+ (let ((m (calendar-extract-month bahai-date))
+ (d (calendar-extract-day bahai-date)))
+ (calendar-dlet*
+ ((monthname (if (and (= m 19)
(<= d 0))
"Ayyám-i-Há"
(aref calendar-bahai-month-name-array (1- m))))
@@ -137,8 +138,8 @@ Defaults to today's date if DATE is not given."
(year (number-to-string y))
(month (number-to-string m))
dayname)
- ;; Can't call calendar-date-string because of monthname oddity.
- (mapconcat 'eval calendar-date-display-form "")))))
+ ;; Can't call calendar-date-string because of monthname oddity.
+ (mapconcat #'eval calendar-date-display-form ""))))))
;;;###cal-autoload
(defun calendar-bahai-print-date ()
@@ -153,13 +154,12 @@ Defaults to today's date if DATE is not given."
"Interactively read the arguments for a Bahá’í date command.
Reads a year, month and day."
(let* ((today (calendar-current-date))
- (year (calendar-read
- "Bahá’í calendar year (not 0): "
+ (year (calendar-read-sexp
+ "Bahá’í calendar year (not 0)"
(lambda (x) (not (zerop x)))
- (number-to-string
- (calendar-extract-year
- (calendar-bahai-from-absolute
- (calendar-absolute-from-gregorian today))))))
+ (calendar-extract-year
+ (calendar-bahai-from-absolute
+ (calendar-absolute-from-gregorian today)))))
(completion-ignore-case t)
(month (cdr (assoc
(completing-read
@@ -169,8 +169,8 @@ Reads a year, month and day."
nil t)
(calendar-make-alist calendar-bahai-month-name-array
1))))
- (day (calendar-read "Bahá’í calendar day (1-19): "
- (lambda (x) (and (< 0 x) (<= x 19))))))
+ (day (calendar-read-sexp "Bahá’í calendar day (1-19)"
+ (lambda (x) (and (< 0 x) (<= x 19))))))
(list (list month day year))))
;;;###cal-autoload
diff --git a/lisp/calendar/cal-china.el b/lisp/calendar/cal-china.el
index 7e5d0c46e11..9a28984a7ab 100644
--- a/lisp/calendar/cal-china.el
+++ b/lisp/calendar/cal-china.el
@@ -1,4 +1,4 @@
-;;; cal-china.el --- calendar functions for the Chinese calendar
+;;; cal-china.el --- calendar functions for the Chinese calendar -*- lexical-binding: t; -*-
;; Copyright (C) 1995, 1997, 2001-2021 Free Software Foundation, Inc.
@@ -185,7 +185,9 @@ N congruent to 1 gives the first name, N congruent to 2 gives the second name,
(defun calendar-chinese-zodiac-sign-on-or-after (d)
"Absolute date of first new Zodiac sign on or after absolute date D.
The Zodiac signs begin when the sun's longitude is a multiple of 30 degrees."
- (let* ((year (calendar-extract-year (calendar-gregorian-from-absolute d)))
+ (with-suppressed-warnings ((lexical year))
+ (defvar year))
+ (let* ((year (calendar-extract-year (calendar-gregorian-from-absolute d)))
(calendar-time-zone (eval calendar-chinese-time-zone)) ; uses year
(calendar-daylight-time-offset
calendar-chinese-daylight-time-offset)
@@ -207,6 +209,8 @@ The Zodiac signs begin when the sun's longitude is a multiple of 30 degrees."
(defun calendar-chinese-new-moon-on-or-after (d)
"Absolute date of first new moon on or after absolute date D."
+ (with-suppressed-warnings ((lexical year))
+ (defvar year))
(let* ((year (calendar-extract-year (calendar-gregorian-from-absolute d)))
(calendar-time-zone (eval calendar-chinese-time-zone))
(calendar-daylight-time-offset
@@ -602,14 +606,14 @@ Echo Chinese date unless NOECHO is non-nil."
(interactive
(let* ((c (calendar-chinese-from-absolute
(calendar-absolute-from-gregorian (calendar-current-date))))
- (cycle (calendar-read
- "Chinese calendar cycle number (>44): "
+ (cycle (calendar-read-sexp
+ "Chinese calendar cycle number (>44)"
(lambda (x) (> x 44))
- (number-to-string (car c))))
- (year (calendar-read
- "Year in Chinese cycle (1..60): "
+ (car c)))
+ (year (calendar-read-sexp
+ "Year in Chinese cycle (1..60)"
(lambda (x) (and (<= 1 x) (<= x 60)))
- (number-to-string (cadr c))))
+ (cadr c)))
(month-list (calendar-chinese-months-to-alist
(calendar-chinese-months cycle year)))
(month (cdr (assoc
@@ -624,9 +628,11 @@ Echo Chinese date unless NOECHO is non-nil."
(list cycle year month 1))))))
30
29))
- (day (calendar-read
- (format "Chinese calendar day (1-%d): " last)
- (lambda (x) (and (<= 1 x) (<= x last))))))
+ (day (calendar-read-sexp
+ "Chinese calendar day (1-%d)"
+ (lambda (x) (and (<= 1 x) (<= x last)))
+ nil
+ last)))
(list (list cycle year month day))))
(calendar-goto-date (calendar-gregorian-from-absolute
(calendar-chinese-to-absolute date)))
@@ -663,17 +669,17 @@ Echo Chinese date unless NOECHO is non-nil."
["正月" "二月" "三月" "四月" "五月" "六月"
"七月" "八月" "ä¹æœˆ" "å月" "冬月" "臘月"])
-;;; NOTE: In the diary the cycle and year of a Chinese date is
-;;; combined using this formula: (+ (* cycle 100) year).
+;; NOTE: In the diary the cycle and year of a Chinese date is
+;; combined using this formula: (+ (* cycle 100) year).
;;;
-;;; These two functions convert to and back from this representation.
-(defun calendar-chinese-from-absolute-for-diary (date)
- (pcase-let ((`(,c ,y ,m ,d) (calendar-chinese-from-absolute date)))
+;; These two functions convert to and back from this representation.
+(defun calendar-chinese-from-absolute-for-diary (thedate)
+ (pcase-let ((`(,c ,y ,m ,d) (calendar-chinese-from-absolute thedate)))
;; Note: For leap months M is a float.
(list (floor m) d (+ (* c 100) y))))
-(defun calendar-chinese-to-absolute-for-diary (date &optional prefer-leap)
- (pcase-let* ((`(,m ,d ,y) date)
+(defun calendar-chinese-to-absolute-for-diary (thedate &optional prefer-leap)
+ (pcase-let* ((`(,m ,d ,y) thedate)
(cycle (floor y 100))
(year (mod y 100))
(months (calendar-chinese-months cycle year))
@@ -691,7 +697,8 @@ Echo Chinese date unless NOECHO is non-nil."
(unless (zerop month)
(calendar-mark-1 month day year
#'calendar-chinese-from-absolute-for-diary
- (lambda (date) (calendar-chinese-to-absolute-for-diary date t))
+ (lambda (thedate)
+ (calendar-chinese-to-absolute-for-diary thedate t))
color)))
;;;###cal-autoload
diff --git a/lisp/calendar/cal-coptic.el b/lisp/calendar/cal-coptic.el
index 3461f3259b9..346585e1817 100644
--- a/lisp/calendar/cal-coptic.el
+++ b/lisp/calendar/cal-coptic.el
@@ -1,4 +1,4 @@
-;;; cal-coptic.el --- calendar functions for the Coptic/Ethiopic calendars
+;;; cal-coptic.el --- calendar functions for the Coptic/Ethiopic calendars -*- lexical-binding: t; -*-
;; Copyright (C) 1995, 1997, 2001-2021 Free Software Foundation, Inc.
@@ -116,12 +116,13 @@ Defaults to today's date if DATE is not given."
(m (calendar-extract-month coptic-date)))
(if (< y 1)
""
- (let ((monthname (aref calendar-coptic-month-name-array (1- m)))
- (day (number-to-string (calendar-extract-day coptic-date)))
- (dayname nil)
- (month (number-to-string m))
- (year (number-to-string y)))
- (mapconcat 'eval calendar-date-display-form "")))))
+ (calendar-dlet*
+ ((monthname (aref calendar-coptic-month-name-array (1- m)))
+ (day (number-to-string (calendar-extract-day coptic-date)))
+ (dayname nil)
+ (month (number-to-string m))
+ (year (number-to-string y)))
+ (mapconcat #'eval calendar-date-display-form "")))))
;;;###cal-autoload
(defun calendar-coptic-print-date ()
@@ -136,13 +137,13 @@ Defaults to today's date if DATE is not given."
"Interactively read the arguments for a Coptic date command.
Reads a year, month, and day."
(let* ((today (calendar-current-date))
- (year (calendar-read
- (format "%s calendar year (>0): " calendar-coptic-name)
+ (year (calendar-read-sexp
+ "%s calendar year (>0)"
(lambda (x) (> x 0))
- (number-to-string
- (calendar-extract-year
- (calendar-coptic-from-absolute
- (calendar-absolute-from-gregorian today))))))
+ (calendar-extract-year
+ (calendar-coptic-from-absolute
+ (calendar-absolute-from-gregorian today)))
+ calendar-coptic-name))
(completion-ignore-case t)
(month (cdr (assoc-string
(completing-read
@@ -151,11 +152,14 @@ Reads a year, month, and day."
(append calendar-coptic-month-name-array nil))
nil t)
(calendar-make-alist calendar-coptic-month-name-array
- 1) t)))
+ 1)
+ t)))
(last (calendar-coptic-last-day-of-month month year))
- (day (calendar-read
- (format "%s calendar day (1-%d): " calendar-coptic-name last)
- (lambda (x) (and (< 0 x) (<= x last))))))
+ (day (calendar-read-sexp
+ "%s calendar day (1-%d)"
+ (lambda (x) (and (< 0 x) (<= x last)))
+ nil
+ calendar-coptic-name last)))
(list (list month day year))))
;;;###cal-autoload
@@ -194,30 +198,30 @@ Echo Coptic date unless NOECHO is t."
(defconst calendar-ethiopic-name "Ethiopic"
"Used in some message strings.")
-(defun calendar-ethiopic-to-absolute (date)
+(defun calendar-ethiopic-to-absolute (thedate)
"Compute absolute date from Ethiopic date DATE.
The absolute date is the number of days elapsed since the (imaginary)
Gregorian date Sunday, December 31, 1 BC."
(let ((calendar-coptic-epoch calendar-ethiopic-epoch))
- (calendar-coptic-to-absolute date)))
+ (calendar-coptic-to-absolute thedate)))
-(defun calendar-ethiopic-from-absolute (date)
+(defun calendar-ethiopic-from-absolute (thedate)
"Compute the Ethiopic equivalent for absolute date DATE.
The result is a list of the form (MONTH DAY YEAR).
The absolute date is the number of days elapsed since the imaginary
Gregorian date Sunday, December 31, 1 BC."
(let ((calendar-coptic-epoch calendar-ethiopic-epoch))
- (calendar-coptic-from-absolute date)))
+ (calendar-coptic-from-absolute thedate)))
;;;###cal-autoload
-(defun calendar-ethiopic-date-string (&optional date)
+(defun calendar-ethiopic-date-string (&optional thedate)
"String of Ethiopic date of Gregorian DATE.
Returns the empty string if DATE is pre-Ethiopic calendar.
Defaults to today's date if DATE is not given."
(let ((calendar-coptic-epoch calendar-ethiopic-epoch)
(calendar-coptic-name calendar-ethiopic-name)
(calendar-coptic-month-name-array calendar-ethiopic-month-name-array))
- (calendar-coptic-date-string date)))
+ (calendar-coptic-date-string thedate)))
;;;###cal-autoload
(defun calendar-ethiopic-print-date ()
@@ -229,8 +233,8 @@ Defaults to today's date if DATE is not given."
(call-interactively 'calendar-coptic-print-date)))
;;;###cal-autoload
-(defun calendar-ethiopic-goto-date (date &optional noecho)
- "Move cursor to Ethiopic date DATE.
+(defun calendar-ethiopic-goto-date (thedate &optional noecho)
+ "Move cursor to Ethiopic date THEDATE.
Echo Ethiopic date unless NOECHO is t."
(interactive
(let ((calendar-coptic-epoch calendar-ethiopic-epoch)
@@ -238,7 +242,7 @@ Echo Ethiopic date unless NOECHO is t."
(calendar-coptic-month-name-array calendar-ethiopic-month-name-array))
(calendar-coptic-read-date)))
(calendar-goto-date (calendar-gregorian-from-absolute
- (calendar-ethiopic-to-absolute date)))
+ (calendar-ethiopic-to-absolute thedate)))
(or noecho (calendar-ethiopic-print-date)))
;; To be called from diary-list-sexp-entries, where DATE is bound.
diff --git a/lisp/calendar/cal-french.el b/lisp/calendar/cal-french.el
index e759b5dad95..639bae700cc 100644
--- a/lisp/calendar/cal-french.el
+++ b/lisp/calendar/cal-french.el
@@ -1,4 +1,4 @@
-;;; cal-french.el --- calendar functions for the French Revolutionary calendar
+;;; cal-french.el --- calendar functions for the French Revolutionary calendar -*- lexical-binding: t; -*-
;; Copyright (C) 1988-1989, 1992, 1994-1995, 1997, 2001-2021 Free
;; Software Foundation, Inc.
@@ -35,54 +35,45 @@
(defconst calendar-french-epoch (calendar-absolute-from-gregorian '(9 22 1792))
"Absolute date of start of French Revolutionary calendar = Sept 22, 1792.")
-(defconst calendar-french-month-name-array
- ["Vende'miaire" "Brumaire" "Frimaire" "Nivo^se" "Pluvio^se" "Vento^se"
- "Germinal" "Flore'al" "Prairial" "Messidor" "Thermidor" "Fructidor"]
- "Array of month names in the French calendar.")
+(define-obsolete-variable-alias 'calendar-french-multibyte-month-name-array
+ 'calendar-french-month-name-array "28.1")
-(defconst calendar-french-multibyte-month-name-array
+(defconst calendar-french-month-name-array
["Vendémiaire" "Brumaire" "Frimaire" "Nivôse" "Pluviôse" "Ventôse"
"Germinal" "Floréal" "Prairial" "Messidor" "Thermidor" "Fructidor"]
- "Array of multibyte month names in the French calendar.")
+ "Array of month names in the French calendar.")
(defconst calendar-french-day-name-array
["Primidi" "Duodi" "Tridi" "Quartidi" "Quintidi" "Sextidi" "Septidi"
"Octidi" "Nonidi" "Decadi"]
"Array of day names in the French calendar.")
-(defconst calendar-french-special-days-array
- ["de la Vertu" "du Ge'nie" "du Travail" "de la Raison" "des Re'compenses"
- "de la Re'volution"]
- "Array of special day names in the French calendar.")
+(define-obsolete-variable-alias 'calendar-french-multibyte-special-days-array
+ 'calendar-french-special-days-array "28.1")
-(defconst calendar-french-multibyte-special-days-array
+(defconst calendar-french-special-days-array
["de la Vertu" "du Génie" "du Travail" "de la Raison" "des Récompenses"
"de la Révolution"]
- "Array of multibyte special day names in the French calendar.")
+ "Array of special day names in the French calendar.")
(defun calendar-french-accents-p ()
- "Return non-nil if diacritical marks are available."
- (and (or window-system
- (terminal-coding-system))
- (or enable-multibyte-characters
- (and (char-table-p standard-display-table)
- (equal (aref standard-display-table 161) [161])))))
+ (declare (obsolete nil "28.1"))
+ t)
(defun calendar-french-month-name-array ()
"Return the array of month names, depending on whether accents are available."
- (if (calendar-french-accents-p)
- calendar-french-multibyte-month-name-array
- calendar-french-month-name-array))
+ (declare (obsolete "use the variable of the same name instead" "28.1"))
+ calendar-french-month-name-array)
(defun calendar-french-day-name-array ()
"Return the array of day names."
+ (declare (obsolete "use the variable of the same name instead" "28.1"))
calendar-french-day-name-array)
(defun calendar-french-special-days-array ()
"Return the special day names, depending on whether accents are available."
- (if (calendar-french-accents-p)
- calendar-french-multibyte-special-days-array
- calendar-french-special-days-array))
+ (declare (obsolete "use the variable of the same name instead" "28.1"))
+ calendar-french-special-days-array)
(defun calendar-french-leap-year-p (year)
"True if YEAR is a leap year on the French Revolutionary calendar.
@@ -171,17 +162,13 @@ Defaults to today's date if DATE is not given."
(d (calendar-extract-day french-date)))
(cond
((< y 1) "")
- ((= m 13) (format (if (calendar-french-accents-p)
- "Jour %s de l'Année %d de la Révolution"
- "Jour %s de l'Anne'e %d de la Re'volution")
- (aref (calendar-french-special-days-array) (1- d))
+ ((= m 13) (format "Jour %s de l'Année %d de la Révolution"
+ (aref calendar-french-special-days-array (1- d))
y))
(t (format
- (if (calendar-french-accents-p)
- "%d %s an %d de la Révolution"
- "%d %s an %d de la Re'volution")
+ "%d %s an %d de la Révolution"
d
- (aref (calendar-french-month-name-array) (1- m))
+ (aref calendar-french-month-name-array (1- m))
y)))))
;;;###cal-autoload
@@ -198,19 +185,16 @@ Defaults to today's date if DATE is not given."
"Move cursor to French Revolutionary date DATE.
Echo French Revolutionary date unless NOECHO is non-nil."
(interactive
- (let* ((months (calendar-french-month-name-array))
- (special-days (calendar-french-special-days-array))
+ (let* ((months calendar-french-month-name-array)
+ (special-days calendar-french-special-days-array)
(year (progn
- (calendar-read
- (if (calendar-french-accents-p)
- "Année de la Révolution (>0): "
- "Anne'e de la Re'volution (>0): ")
+ (calendar-read-sexp
+ "Année de la Révolution (>0)"
(lambda (x) (> x 0))
- (number-to-string
- (calendar-extract-year
- (calendar-french-from-absolute
- (calendar-absolute-from-gregorian
- (calendar-current-date))))))))
+ (calendar-extract-year
+ (calendar-french-from-absolute
+ (calendar-absolute-from-gregorian
+ (calendar-current-date)))))))
(month-list
(mapcar 'list
(append months
@@ -234,8 +218,8 @@ Echo French Revolutionary date unless NOECHO is non-nil."
(calendar-make-alist month-list 1 'car) t)))
(day (if (> month 12)
(- month 12)
- (calendar-read
- "Jour (1-30): "
+ (calendar-read-sexp
+ "Jour (1-30)"
(lambda (x) (and (<= 1 x) (<= x 30))))))
(month (if (> month 12) 13 month)))
(list (list month day year))))
diff --git a/lisp/calendar/cal-hebrew.el b/lisp/calendar/cal-hebrew.el
index bcc80f0877b..50b4fc363bb 100644
--- a/lisp/calendar/cal-hebrew.el
+++ b/lisp/calendar/cal-hebrew.el
@@ -1,4 +1,4 @@
-;;; cal-hebrew.el --- calendar functions for the Hebrew calendar
+;;; cal-hebrew.el --- calendar functions for the Hebrew calendar -*- lexical-binding: t; -*-
;; Copyright (C) 1995, 1997, 2001-2021 Free Software Foundation, Inc.
@@ -225,13 +225,12 @@ Driven by the variable `calendar-date-display-form'."
"Interactively read the arguments for a Hebrew date command.
Reads a year, month, and day."
(let* ((today (calendar-current-date))
- (year (calendar-read
- "Hebrew calendar year (>3760): "
+ (year (calendar-read-sexp
+ "Hebrew calendar year (>3760)"
(lambda (x) (> x 3760))
- (number-to-string
- (calendar-extract-year
- (calendar-hebrew-from-absolute
- (calendar-absolute-from-gregorian today))))))
+ (calendar-extract-year
+ (calendar-hebrew-from-absolute
+ (calendar-absolute-from-gregorian today)))))
(month-array (if (calendar-hebrew-leap-year-p year)
calendar-hebrew-month-name-array-leap-year
calendar-hebrew-month-name-array-common-year))
@@ -258,10 +257,11 @@ Reads a year, month, and day."
(last (calendar-hebrew-last-day-of-month month year))
(first (if (and (= year 3761) (= month 10))
18 1))
- (day (calendar-read
- (format "Hebrew calendar day (%d-%d): "
- first last)
- (lambda (x) (and (<= first x) (<= x last))))))
+ (day (calendar-read-sexp
+ "Hebrew calendar day (%d-%d)"
+ (lambda (x) (and (<= first x) (<= x last)))
+ nil
+ first last)))
(list (list month day year))))
;;;###cal-autoload
@@ -399,19 +399,20 @@ is non-nil."
(list m (calendar-last-day-of-month m y) y))))))
(abs-h (calendar-hebrew-to-absolute (list 9 25 h-y)))
(ord ["first" "second" "third" "fourth" "fifth" "sixth"
- "seventh" "eighth"])
- han)
+ "seventh" "eighth"]))
(holiday-filter-visible-calendar
(if (or all calendar-hebrew-all-holidays-flag)
(append
(list
(list (calendar-gregorian-from-absolute (1- abs-h))
"Erev Hanukkah"))
- (dotimes (i 8 (nreverse han))
- (push (list
- (calendar-gregorian-from-absolute (+ abs-h i))
- (format "Hanukkah (%s day)" (aref ord i)))
- han)))
+ (let (han)
+ (dotimes (i 8)
+ (push (list
+ (calendar-gregorian-from-absolute (+ abs-h i))
+ (format "Hanukkah (%s day)" (aref ord i)))
+ han))
+ (nreverse han)))
(list (list (calendar-gregorian-from-absolute abs-h) "Hanukkah")))))))
;;;###holiday-autoload
@@ -681,10 +682,10 @@ from the cursor position."
(if (equal (current-buffer) (get-buffer calendar-buffer))
(calendar-cursor-to-date t)
(let* ((today (calendar-current-date))
- (year (calendar-read
- "Year of death (>0): "
+ (year (calendar-read-sexp
+ "Year of death (>0)"
(lambda (x) (> x 0))
- (number-to-string (calendar-extract-year today))))
+ (calendar-extract-year today)))
(month-array calendar-month-name-array)
(completion-ignore-case t)
(month (cdr (assoc-string
@@ -694,20 +695,23 @@ from the cursor position."
nil t)
(calendar-make-alist month-array 1) t)))
(last (calendar-last-day-of-month month year))
- (day (calendar-read
- (format "Day of death (1-%d): " last)
- (lambda (x) (and (< 0 x) (<= x last))))))
+ (day (calendar-read-sexp
+ "Day of death (1-%d)"
+ (lambda (x) (and (< 0 x) (<= x last)))
+ nil
+ last)))
(list month day year))))
(death-year (calendar-extract-year death-date))
- (start-year (calendar-read
- (format "Starting year of Yahrzeit table (>%d): "
- death-year)
+ (start-year (calendar-read-sexp
+ "Starting year of Yahrzeit table (>%d)"
(lambda (x) (> x death-year))
- (number-to-string (1+ death-year))))
- (end-year (calendar-read
- (format "Ending year of Yahrzeit table (>=%d): "
- start-year)
- (lambda (x) (>= x start-year)))))
+ (1+ death-year)
+ death-year))
+ (end-year (calendar-read-sexp
+ "Ending year of Yahrzeit table (>=%d)"
+ (lambda (x) (>= x start-year))
+ nil
+ start-year)))
(list death-date start-year end-year)))
(message "Computing Yahrzeits...")
(let* ((h-date (calendar-hebrew-from-absolute
diff --git a/lisp/calendar/cal-html.el b/lisp/calendar/cal-html.el
index 3d7cc938437..e5810c3f027 100644
--- a/lisp/calendar/cal-html.el
+++ b/lisp/calendar/cal-html.el
@@ -1,4 +1,4 @@
-;;; cal-html.el --- functions for printing HTML calendars
+;;; cal-html.el --- functions for printing HTML calendars -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
@@ -250,7 +250,7 @@ Contains links to previous and next month and year, and current minical."
calendar-week-start-day))
7))
(monthpage-name (cal-html-monthpage-name month year))
- date)
+ ) ;; date
;; Start writing table.
(insert (cal-html-comment "MINICAL")
(cal-html-b-table "class=minical border=1 align=center"))
@@ -276,7 +276,7 @@ Contains links to previous and next month and year, and current minical."
(insert cal-html-e-tablerow-string
cal-html-b-tablerow-string)))
;; End empty slots (for some browsers like konqueror).
- (dotimes (i end-blank-days)
+ (dotimes (_ end-blank-days)
(insert
cal-html-b-tabledata-string
cal-html-e-tabledata-string)))
@@ -431,12 +431,11 @@ holidays in HOLIDAY-LIST."
;;; User commands.
;;;###cal-autoload
-(defun cal-html-cursor-month (month year dir &optional event)
+(defun cal-html-cursor-month (month year dir &optional _event)
"Write an HTML calendar file for numeric MONTH of four-digit YEAR.
The output directory DIR is created if necessary. Interactively,
-MONTH and YEAR are taken from the calendar cursor position, or from
-the position specified by EVENT. Note that any existing output files
-are overwritten."
+MONTH and YEAR are taken from the calendar cursor position.
+Note that any existing output files are overwritten."
(interactive (let* ((event last-nonmenu-event)
(date (calendar-cursor-to-date t event))
(month (calendar-extract-month date))
@@ -446,11 +445,11 @@ are overwritten."
(cal-html-one-month month year dir))
;;;###cal-autoload
-(defun cal-html-cursor-year (year dir &optional event)
+(defun cal-html-cursor-year (year dir &optional _event)
"Write HTML calendar files (index and monthly pages) for four-digit YEAR.
The output directory DIR is created if necessary. Interactively,
-YEAR is taken from the calendar cursor position, or from the position
-specified by EVENT. Note that any existing output files are overwritten."
+YEAR is taken from the calendar cursor position.
+Note that any existing output files are overwritten."
(interactive (let* ((event last-nonmenu-event)
(year (calendar-extract-year
(calendar-cursor-to-date t event))))
diff --git a/lisp/calendar/cal-islam.el b/lisp/calendar/cal-islam.el
index d256310ba6c..45c6ffa7bd7 100644
--- a/lisp/calendar/cal-islam.el
+++ b/lisp/calendar/cal-islam.el
@@ -1,4 +1,4 @@
-;;; cal-islam.el --- calendar functions for the Islamic calendar
+;;; cal-islam.el --- calendar functions for the Islamic calendar -*- lexical-binding: t; -*-
;; Copyright (C) 1995, 1997, 2001-2021 Free Software Foundation, Inc.
@@ -67,8 +67,8 @@
"Absolute date of Islamic DATE.
The absolute date is the number of days elapsed since the (imaginary)
Gregorian date Sunday, December 31, 1 BC."
- (let* ((month (calendar-extract-month date))
- (day (calendar-extract-day date))
+ (let* (;;(month (calendar-extract-month date))
+ ;;(day (calendar-extract-day date))
(year (calendar-extract-year date))
(y (% year 30))
(leap-years-in-cycle (cond ((< y 3) 0)
@@ -143,13 +143,12 @@ Driven by the variable `calendar-date-display-form'."
"Interactively read the arguments for an Islamic date command.
Reads a year, month, and day."
(let* ((today (calendar-current-date))
- (year (calendar-read
- "Islamic calendar year (>0): "
+ (year (calendar-read-sexp
+ "Islamic calendar year (>0)"
(lambda (x) (> x 0))
- (number-to-string
- (calendar-extract-year
- (calendar-islamic-from-absolute
- (calendar-absolute-from-gregorian today))))))
+ (calendar-extract-year
+ (calendar-islamic-from-absolute
+ (calendar-absolute-from-gregorian today)))))
(month-array calendar-islamic-month-name-array)
(completion-ignore-case t)
(month (cdr (assoc-string
@@ -159,9 +158,11 @@ Reads a year, month, and day."
nil t)
(calendar-make-alist month-array 1) t)))
(last (calendar-islamic-last-day-of-month month year))
- (day (calendar-read
- (format "Islamic calendar day (1-%d): " last)
- (lambda (x) (and (< 0 x) (<= x last))))))
+ (day (calendar-read-sexp
+ "Islamic calendar day (1-%d)"
+ (lambda (x) (and (< 0 x) (<= x last)))
+ nil
+ last)))
(list (list month day year))))
;;;###cal-autoload
diff --git a/lisp/calendar/cal-iso.el b/lisp/calendar/cal-iso.el
index 956433e4a20..90f57c25e9d 100644
--- a/lisp/calendar/cal-iso.el
+++ b/lisp/calendar/cal-iso.el
@@ -1,4 +1,4 @@
-;;; cal-iso.el --- calendar functions for the ISO calendar
+;;; cal-iso.el --- calendar functions for the ISO calendar -*- lexical-binding: t; -*-
;; Copyright (C) 1995, 1997, 2001-2021 Free Software Foundation, Inc.
@@ -92,22 +92,23 @@ date Sunday, December 31, 1 BC."
"Interactively read the arguments for an ISO date command.
Reads a year and week, and if DAYFLAG is non-nil a day (otherwise
taken to be 1)."
- (let* ((year (calendar-read
- "ISO calendar year (>0): "
+ (let* ((year (calendar-read-sexp
+ "ISO calendar year (>0)"
(lambda (x) (> x 0))
- (number-to-string (calendar-extract-year
- (calendar-current-date)))))
+ (calendar-extract-year (calendar-current-date))))
(no-weeks (calendar-extract-month
(calendar-iso-from-absolute
(1-
(calendar-dayname-on-or-before
1 (calendar-absolute-from-gregorian
(list 1 4 (1+ year))))))))
- (week (calendar-read
- (format "ISO calendar week (1-%d): " no-weeks)
- (lambda (x) (and (> x 0) (<= x no-weeks)))))
- (day (if dayflag (calendar-read
- "ISO day (1-7): "
+ (week (calendar-read-sexp
+ "ISO calendar week (1-%d)"
+ (lambda (x) (and (> x 0) (<= x no-weeks)))
+ nil
+ no-weeks))
+ (day (if dayflag (calendar-read-sexp
+ "ISO day (1-7)"
(lambda (x) (and (<= 1 x) (<= x 7))))
1)))
(list (list week day year))))
diff --git a/lisp/calendar/cal-julian.el b/lisp/calendar/cal-julian.el
index 235b4d00900..47880a4e974 100644
--- a/lisp/calendar/cal-julian.el
+++ b/lisp/calendar/cal-julian.el
@@ -95,14 +95,13 @@ Driven by the variable `calendar-date-display-form'."
"Move cursor to Julian DATE; echo Julian date unless NOECHO is non-nil."
(interactive
(let* ((today (calendar-current-date))
- (year (calendar-read
- "Julian calendar year (>0): "
+ (year (calendar-read-sexp
+ "Julian calendar year (>0)"
(lambda (x) (> x 0))
- (number-to-string
- (calendar-extract-year
- (calendar-julian-from-absolute
- (calendar-absolute-from-gregorian
- today))))))
+ (calendar-extract-year
+ (calendar-julian-from-absolute
+ (calendar-absolute-from-gregorian
+ today)))))
(month-array calendar-month-name-array)
(completion-ignore-case t)
(month (cdr (assoc-string
@@ -115,12 +114,13 @@ Driven by the variable `calendar-date-display-form'."
(if (and (zerop (% year 4)) (= month 2))
29
(aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- month))))
- (day (calendar-read
- (format "Julian calendar day (%d-%d): "
- (if (and (= year 1) (= month 1)) 3 1) last)
+ (day (calendar-read-sexp
+ "Julian calendar day (%d-%d)"
(lambda (x)
(and (< (if (and (= year 1) (= month 1)) 2 0) x)
- (<= x last))))))
+ (<= x last)))
+ nil
+ (if (and (= year 1) (= month 1)) 3 1) last)))
(list (list month day year))))
(calendar-goto-date (calendar-gregorian-from-absolute
(calendar-julian-to-absolute date)))
@@ -173,8 +173,8 @@ Defaults to today's date if DATE is not given."
(defun calendar-astro-goto-day-number (daynumber &optional noecho)
"Move cursor to astronomical (Julian) DAYNUMBER.
Echo astronomical (Julian) day number unless NOECHO is non-nil."
- (interactive (list (calendar-read
- "Astronomical (Julian) day number (>1721425): "
+ (interactive (list (calendar-read-sexp
+ "Astronomical (Julian) day number (>1721425)"
(lambda (x) (> x 1721425)))))
(calendar-goto-date
(calendar-gregorian-from-absolute
diff --git a/lisp/calendar/cal-mayan.el b/lisp/calendar/cal-mayan.el
index 8d894ebd986..9a221921130 100644
--- a/lisp/calendar/cal-mayan.el
+++ b/lisp/calendar/cal-mayan.el
@@ -1,4 +1,4 @@
-;;; cal-mayan.el --- calendar functions for the Mayan calendars
+;;; cal-mayan.el --- calendar functions for the Mayan calendars -*- lexical-binding: t; -*-
;; Copyright (C) 1992-1993, 1995, 1997, 2001-2021 Free Software
;; Foundation, Inc.
@@ -135,8 +135,8 @@ but some use 1137140. Using 1232041 gives you Spinden's correlation; using
(defun calendar-mayan-read-haab-date ()
"Prompt for a Mayan haab date."
(let* ((completion-ignore-case t)
- (haab-day (calendar-read
- "Haab kin (0-19): "
+ (haab-day (calendar-read-sexp
+ "Haab kin (0-19)"
(lambda (x) (and (>= x 0) (< x 20)))))
(haab-month-list (append calendar-mayan-haab-month-name-array
(and (< haab-day 5) '("Uayeb"))))
@@ -151,8 +151,8 @@ but some use 1137140. Using 1232041 gives you Spinden's correlation; using
(defun calendar-mayan-read-tzolkin-date ()
"Prompt for a Mayan tzolkin date."
(let* ((completion-ignore-case t)
- (tzolkin-count (calendar-read
- "Tzolkin kin (1-13): "
+ (tzolkin-count (calendar-read-sexp
+ "Tzolkin kin (1-13)"
(lambda (x) (and (> x 0) (< x 14)))))
(tzolkin-name-list (append calendar-mayan-tzolkin-names-array nil))
(tzolkin-name (cdr
diff --git a/lisp/calendar/cal-menu.el b/lisp/calendar/cal-menu.el
index a30c681a897..497f3329055 100644
--- a/lisp/calendar/cal-menu.el
+++ b/lisp/calendar/cal-menu.el
@@ -1,4 +1,4 @@
-;;; cal-menu.el --- calendar functions for menu bar and popup menu support
+;;; cal-menu.el --- calendar functions for menu bar and popup menu support -*- lexical-binding: t; -*-
;; Copyright (C) 1994-1995, 2001-2021 Free Software Foundation, Inc.
@@ -183,6 +183,8 @@ Signals an error if popups are unavailable."
;; Autoloaded in diary-lib.
(declare-function calendar-check-holidays "holidays" (date))
+(defvar diary-list-include-blanks)
+
(defun calendar-mouse-view-diary-entries (&optional date diary event)
"Pop up menu of diary entries for mouse-selected date.
Use optional DATE and alternative file DIARY. EVENT is the event
diff --git a/lisp/calendar/cal-move.el b/lisp/calendar/cal-move.el
index 710ce37ccbf..9294362cb43 100644
--- a/lisp/calendar/cal-move.el
+++ b/lisp/calendar/cal-move.el
@@ -1,4 +1,4 @@
-;;; cal-move.el --- calendar functions for movement in the calendar
+;;; cal-move.el --- calendar functions for movement in the calendar -*- lexical-binding: t; -*-
;; Copyright (C) 1995, 2001-2021 Free Software Foundation, Inc.
@@ -386,15 +386,16 @@ Moves forward if ARG is negative."
"Move cursor to YEAR, DAY number; echo DAY/YEAR unless NOECHO is non-nil.
Negative DAY counts backward from end of year."
(interactive
- (let* ((year (calendar-read
- "Year (>0): "
+ (let* ((year (calendar-read-sexp
+ "Year (>0)"
(lambda (x) (> x 0))
- (number-to-string (calendar-extract-year
- (calendar-current-date)))))
+ (calendar-extract-year (calendar-current-date))))
(last (if (calendar-leap-year-p year) 366 365))
- (day (calendar-read
- (format "Day number (+/- 1-%d): " last)
- (lambda (x) (and (<= 1 (abs x)) (<= (abs x) last))))))
+ (day (calendar-read-sexp
+ "Day number (+/- 1-%d)"
+ (lambda (x) (and (<= 1 (abs x)) (<= (abs x) last)))
+ nil
+ last)))
(list year day)))
(calendar-goto-date
(calendar-gregorian-from-absolute
diff --git a/lisp/calendar/cal-persia.el b/lisp/calendar/cal-persia.el
index a9c99fedbdb..ca37d803224 100644
--- a/lisp/calendar/cal-persia.el
+++ b/lisp/calendar/cal-persia.el
@@ -1,4 +1,4 @@
-;;; cal-persia.el --- calendar functions for the Persian calendar
+;;; cal-persia.el --- calendar functions for the Persian calendar -*- lexical-binding: t; -*-
;; Copyright (C) 1996-1997, 2001-2021 Free Software Foundation, Inc.
@@ -139,13 +139,14 @@ Gregorian date Sunday, December 31, 1 BC."
(calendar-absolute-from-gregorian
(or date (calendar-current-date)))))
(y (calendar-extract-year persian-date))
- (m (calendar-extract-month persian-date))
- (monthname (aref calendar-persian-month-name-array (1- m)))
+ (m (calendar-extract-month persian-date)))
+ (calendar-dlet*
+ ((monthname (aref calendar-persian-month-name-array (1- m)))
(day (number-to-string (calendar-extract-day persian-date)))
(year (number-to-string y))
(month (number-to-string m))
dayname)
- (mapconcat 'eval calendar-date-display-form "")))
+ (mapconcat #'eval calendar-date-display-form ""))))
;;;###cal-autoload
(defun calendar-persian-print-date ()
@@ -157,14 +158,13 @@ Gregorian date Sunday, December 31, 1 BC."
(defun calendar-persian-read-date ()
"Interactively read the arguments for a Persian date command.
Reads a year, month, and day."
- (let* ((year (calendar-read
- "Persian calendar year (not 0): "
+ (let* ((year (calendar-read-sexp
+ "Persian calendar year (not 0)"
(lambda (x) (not (zerop x)))
- (number-to-string
- (calendar-extract-year
- (calendar-persian-from-absolute
- (calendar-absolute-from-gregorian
- (calendar-current-date)))))))
+ (calendar-extract-year
+ (calendar-persian-from-absolute
+ (calendar-absolute-from-gregorian
+ (calendar-current-date))))))
(completion-ignore-case t)
(month (cdr (assoc
(completing-read
@@ -175,9 +175,11 @@ Reads a year, month, and day."
(calendar-make-alist calendar-persian-month-name-array
1))))
(last (calendar-persian-last-day-of-month month year))
- (day (calendar-read
- (format "Persian calendar day (1-%d): " last)
- (lambda (x) (and (< 0 x) (<= x last))))))
+ (day (calendar-read-sexp
+ "Persian calendar day (1-%d)"
+ (lambda (x) (and (< 0 x) (<= x last)))
+ nil
+ last)))
(list (list month day year))))
;;;###cal-autoload
diff --git a/lisp/calendar/cal-tex.el b/lisp/calendar/cal-tex.el
index 9df9f4cbedf..f5932014dd9 100644
--- a/lisp/calendar/cal-tex.el
+++ b/lisp/calendar/cal-tex.el
@@ -1,4 +1,4 @@
-;;; cal-tex.el --- calendar functions for printing calendars with LaTeX
+;;; cal-tex.el --- calendar functions for printing calendars with LaTeX -*- lexical-binding: t; -*-
;; Copyright (C) 1995, 2001-2021 Free Software Foundation, Inc.
@@ -248,6 +248,8 @@ This definition is the heart of the calendar!")
(autoload 'diary-list-entries "diary-lib")
+(defvar diary-list-include-blanks)
+
(defun cal-tex-list-diary-entries (d1 d2)
"Generate a list of all diary-entries from absolute date D1 to D2."
(let (diary-list-include-blanks)
@@ -591,6 +593,8 @@ indicates a buffer position to use instead of point."
LaTeX commands are inserted for the days of the MONTH in YEAR.
Diary entries on DIARY-LIST are included. Holidays on HOLIDAYS
are included. Each day is formatted using format DAY-FORMAT."
+ (with-suppressed-warnings ((lexical date))
+ (defvar date)) ;For `cal-tex-daily-string'.
(let ((blank-days ; at start of month
(mod
(- (calendar-day-of-week (list month 1 year))
@@ -605,7 +609,7 @@ are included. Each day is formatted using format DAY-FORMAT."
(insert (format day-format (cal-tex-month-name month) j))
(cal-tex-arg (cal-tex-latexify-list diary-list date))
(cal-tex-arg (cal-tex-latexify-list holidays date))
- (cal-tex-arg (eval cal-tex-daily-string))
+ (cal-tex-arg (eval cal-tex-daily-string t))
(cal-tex-arg)
(cal-tex-comment))
(when (and (zerop (mod (+ j blank-days) 7))
@@ -885,13 +889,15 @@ argument EVENT specifies a different buffer position."
(interactive (list (prefix-numeric-value current-prefix-arg)
last-nonmenu-event))
(or n (setq n 1))
+ (with-suppressed-warnings ((lexical date))
+ (defvar date)) ;For `cal-tex-daily-string'.
(let* ((date (calendar-gregorian-from-absolute
(calendar-dayname-on-or-before
1
(calendar-absolute-from-gregorian
(calendar-cursor-to-date t event)))))
(month (calendar-extract-month date))
- (year (calendar-extract-year date))
+ ;; (year (calendar-extract-year date))
(day (calendar-extract-day date))
(d1 (calendar-absolute-from-gregorian date))
(d2 (+ (* 7 n) d1))
@@ -932,7 +938,7 @@ argument EVENT specifies a different buffer position."
(insert ": ")
(cal-tex-large-bf s))
(cal-tex-hfill)
- (insert " " (eval cal-tex-daily-string))
+ (insert " " (eval cal-tex-daily-string t))
(cal-tex-e-parbox)
(cal-tex-nl)
(cal-tex-noindent)
@@ -951,7 +957,8 @@ argument EVENT specifies a different buffer position."
(cal-tex-e-parbox "2cm")
(cal-tex-nl)
(setq month (calendar-extract-month date)
- year (calendar-extract-year date)))
+ ;; year (calendar-extract-year date)
+ ))
(cal-tex-e-parbox)
(unless (= i (1- n))
(run-hooks 'cal-tex-week-hook)
@@ -961,13 +968,16 @@ argument EVENT specifies a different buffer position."
;; TODO respect cal-tex-daily-start,end?
;; Using different numbers of hours will probably break some layouts.
-(defun cal-tex-week-hours (date holidays height)
- "Insert hourly entries for DATE with HOLIDAYS, with line height HEIGHT.
+(defun cal-tex-week-hours (thedate holidays height)
+ "Insert hourly entries for THEDATE with HOLIDAYS, with line height HEIGHT.
Uses the 24-hour clock if `cal-tex-24' is non-nil. Note that the hours
shown are hard-coded to 8-12, 13-17."
- (let ((month (calendar-extract-month date))
+ (with-suppressed-warnings ((lexical date))
+ (defvar date)) ;For `cal-tex-daily-string'.
+ (let ((date thedate)
+ (month (calendar-extract-month date))
(day (calendar-extract-day date))
- (year (calendar-extract-year date))
+ ;; (year (calendar-extract-year date))
morning afternoon s)
(cal-tex-comment "begin cal-tex-week-hours")
(cal-tex-cmd "\\ \\\\[-.2cm]")
@@ -983,7 +993,7 @@ shown are hard-coded to 8-12, 13-17."
(insert ": ")
(cal-tex-large-bf s))
(cal-tex-hfill)
- (insert " " (eval cal-tex-daily-string))
+ (insert " " (eval cal-tex-daily-string t))
(cal-tex-e-parbox)
(cal-tex-nl "-.3cm")
(cal-tex-rule "0pt" "6.8in" ".2mm")
@@ -1088,14 +1098,16 @@ shown are hard-coded to 8-12, 13-17."
(defun cal-tex-weekly-common (n event &optional filofax)
"Common code for weekly calendars."
(or n (setq n 1))
+ (with-suppressed-warnings ((lexical date))
+ (defvar date)) ;For `cal-tex-daily-string'.
(let* ((date (calendar-gregorian-from-absolute
(calendar-dayname-on-or-before
1
(calendar-absolute-from-gregorian
(calendar-cursor-to-date t event)))))
- (month (calendar-extract-month date))
- (year (calendar-extract-year date))
- (day (calendar-extract-day date))
+ ;; (month (calendar-extract-month date))
+ ;; (year (calendar-extract-year date))
+ ;; (day (calendar-extract-day date))
(d1 (calendar-absolute-from-gregorian date))
(d2 (+ (* 7 n) d1))
(holidays (if cal-tex-holidays
@@ -1161,7 +1173,7 @@ shown are hard-coded to 8-12, 13-17."
(cal-tex-arg (number-to-string (calendar-extract-day date)))
(cal-tex-arg (cal-tex-latexify-list diary-list date))
(cal-tex-arg (cal-tex-latexify-list holidays date))
- (cal-tex-arg (eval cal-tex-daily-string))
+ (cal-tex-arg (eval cal-tex-daily-string t))
(insert "%\n")
(setq date (cal-tex-incr-date date)))
(insert "\\noindent\\rule{\\textwidth}{0.3pt}\\\\%\n")
@@ -1258,14 +1270,16 @@ Optional EVENT indicates a buffer position to use instead of point."
(interactive (list (prefix-numeric-value current-prefix-arg)
last-nonmenu-event))
(or n (setq n 1))
+ (with-suppressed-warnings ((lexical date))
+ (defvar date)) ;For `cal-tex-daily-string'.
(let* ((date (calendar-gregorian-from-absolute
(calendar-dayname-on-or-before
calendar-week-start-day
(calendar-absolute-from-gregorian
(calendar-cursor-to-date t event)))))
- (month (calendar-extract-month date))
- (year (calendar-extract-year date))
- (day (calendar-extract-day date))
+ ;; (month (calendar-extract-month date))
+ ;; (year (calendar-extract-year date))
+ ;; (day (calendar-extract-day date))
(d1 (calendar-absolute-from-gregorian date))
(d2 (+ (* 7 n) d1))
(holidays (if cal-tex-holidays
@@ -1311,7 +1325,7 @@ Optional EVENT indicates a buffer position to use instead of point."
(cal-tex-arg (number-to-string (calendar-extract-day date)))
(cal-tex-arg (cal-tex-latexify-list diary-list date))
(cal-tex-arg (cal-tex-latexify-list holidays date))
- (cal-tex-arg (eval cal-tex-daily-string))
+ (cal-tex-arg (eval cal-tex-daily-string t))
(insert "%\n")
(setq date (cal-tex-incr-date date)))
(unless (= i (1- n))
@@ -1342,14 +1356,16 @@ Optional EVENT indicates a buffer position to use instead of point."
(interactive (list (prefix-numeric-value current-prefix-arg)
last-nonmenu-event))
(or n (setq n 1))
+ (with-suppressed-warnings ((lexical date))
+ (defvar date)) ;For `cal-tex-daily-string'.
(let* ((date (calendar-gregorian-from-absolute
(calendar-dayname-on-or-before
1
(calendar-absolute-from-gregorian
(calendar-cursor-to-date t event)))))
- (month (calendar-extract-month date))
- (year (calendar-extract-year date))
- (day (calendar-extract-day date))
+ ;; (month (calendar-extract-month date))
+ ;; (year (calendar-extract-year date))
+ ;; (day (calendar-extract-day date))
(d1 (calendar-absolute-from-gregorian date))
(d2 (+ (* 7 n) d1))
(holidays (if cal-tex-holidays
@@ -1383,11 +1399,11 @@ Optional EVENT indicates a buffer position to use instead of point."
"\\leftday")))
(cal-tex-arg (cal-tex-latexify-list diary-list date))
(cal-tex-arg (cal-tex-latexify-list holidays date "\\\\" t))
- (cal-tex-arg (eval cal-tex-daily-string))
+ (cal-tex-arg (eval cal-tex-daily-string t))
(insert "%\n")
- (if cal-tex-rules
- (insert "\\linesfill\n")
- (insert "\\vfill\\noindent\\rule{\\textwidth}{0.3pt}\\\\%\n"))
+ (insert (if cal-tex-rules
+ "\\linesfill\n"
+ "\\vfill\\noindent\\rule{\\textwidth}{0.3pt}\\\\%\n"))
(cal-tex-newpage)
(setq date (cal-tex-incr-date date)))
(insert "%\n")
@@ -1397,11 +1413,11 @@ Optional EVENT indicates a buffer position to use instead of point."
(insert "\\weekend")
(cal-tex-arg (cal-tex-latexify-list diary-list date))
(cal-tex-arg (cal-tex-latexify-list holidays date "\\\\" t))
- (cal-tex-arg (eval cal-tex-daily-string))
+ (cal-tex-arg (eval cal-tex-daily-string t))
(insert "%\n")
- (if cal-tex-rules
- (insert "\\linesfill\n")
- (insert "\\vfill"))
+ (insert (if cal-tex-rules
+ "\\linesfill\n"
+ "\\vfill"))
(setq date (cal-tex-incr-date date)))
(or cal-tex-rules
(insert "\\noindent\\rule{\\textwidth}{0.3pt}\\\\%\n"))
@@ -1442,12 +1458,15 @@ a buffer position to use instead of point."
(cal-tex-end-document)
(run-hooks 'cal-tex-hook)))
-(defun cal-tex-daily-page (date)
- "Make a calendar page for Gregorian DATE on 8.5 by 11 paper.
+(defun cal-tex-daily-page (thedate)
+ "Make a calendar page for Gregorian THEDATE on 8.5 by 11 paper.
Uses the 24-hour clock if `cal-tex-24' is non-nil. Produces
hourly sections for the period specified by `cal-tex-daily-start'
and `cal-tex-daily-end'."
- (let ((month-name (cal-tex-month-name (calendar-extract-month date)))
+ (with-suppressed-warnings ((lexical date))
+ (defvar date)) ;For `cal-tex-daily-string'.
+ (let ((date thedate)
+ (month-name (cal-tex-month-name (calendar-extract-month date)))
(i (1- cal-tex-daily-start))
hour)
(cal-tex-banner "cal-tex-daily-page")
@@ -1459,7 +1478,7 @@ and `cal-tex-daily-end'."
(cal-tex-bf month-name )
(cal-tex-e-parbox)
(cal-tex-hspace "1cm")
- (cal-tex-scriptsize (eval cal-tex-daily-string))
+ (cal-tex-scriptsize (eval cal-tex-daily-string t))
(cal-tex-hspace "3.5cm")
(cal-tex-e-makebox)
(cal-tex-hfill)
diff --git a/lisp/calendar/cal-x.el b/lisp/calendar/cal-x.el
index 1c19a60db10..ca303ce39ae 100644
--- a/lisp/calendar/cal-x.el
+++ b/lisp/calendar/cal-x.el
@@ -1,4 +1,4 @@
-;;; cal-x.el --- calendar windows in dedicated frames
+;;; cal-x.el --- calendar windows in dedicated frames -*- lexical-binding: t; -*-
;; Copyright (C) 1994-1995, 2001-2021 Free Software Foundation, Inc.
diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el
index 21cea212e18..3f9fe1c9d8f 100644
--- a/lisp/calendar/calendar.el
+++ b/lisp/calendar/calendar.el
@@ -112,6 +112,8 @@
;;; Code:
+(eval-when-compile (require 'subr-x))
+
(load "cal-loaddefs" nil t)
;; Calendar has historically relied heavily on dynamic scoping.
@@ -1459,7 +1461,7 @@ Optional integers MON and YR are used instead of today's date."
Inserts STRING so that it ends at INDENT. STRING is either a
literal string, or a sexp to evaluate to return such. Truncates
STRING to length TRUNCATE, and ensures a trailing space."
- (if (not (ignore-errors (stringp (setq string (eval string)))))
+ (if (not (ignore-errors (stringp (setq string (eval string t)))))
(calendar-move-to-column indent)
(if (> (string-width string) truncate)
(setq string (truncate-string-to-width string truncate)))
@@ -1526,7 +1528,7 @@ first INDENT characters on the line."
(format (format "%%%dd" calendar-day-digit-width) day)
'mouse-face 'highlight
'help-echo (calendar-dlet* ((day day) (month month) (year year))
- (eval calendar-date-echo-text))
+ (eval calendar-date-echo-text t))
;; 'date property prevents intermonth text confusing re-searches.
;; (Tried intangible, it did not really work.)
'date t)
@@ -2054,23 +2056,40 @@ With argument ARG, jump to mark, pop it, and put point at end of ring."
(error "%s not available in the calendar"
(global-key-binding (this-command-keys))))
+(defun calendar-read-sexp (prompt predicate &optional default &rest args)
+ "Return an object read from the minibuffer.
+Passes PROMPT, DEFAULT, and ARGS to `format-prompt' to build
+the actual prompt. PREDICATE is called with a single value (the object
+the user entered) and it should return non-nil if that value is a valid choice.
+DEFAULT is the default value to use."
+ (unless (stringp default) (setq default (format "%S" default)))
+ (named-let query ()
+ ;; The call to `read-from-minibuffer' is copied from `read-minibuffer',
+ ;; except it's changed to use the DEFAULT arg instead of INITIAL-CONTENTS.
+ (let ((value (read-from-minibuffer
+ (apply #'format-prompt prompt default args)
+ nil minibuffer-local-map t 'minibuffer-history default)))
+ (if (funcall predicate value)
+ value
+ (query)))))
+
(defun calendar-read (prompt acceptable &optional initial-contents)
"Return an object read from the minibuffer.
Prompt with the string PROMPT and use the function ACCEPTABLE to decide
if entered item is acceptable. If non-nil, optional third arg
INITIAL-CONTENTS is a string to insert in the minibuffer before reading."
+ (declare (obsolete calendar-read-sexp "28.1"))
(let ((value (read-minibuffer prompt initial-contents)))
(while (not (funcall acceptable value))
(setq value (read-minibuffer prompt initial-contents)))
value))
-
(defun calendar-customized-p (symbol)
"Return non-nil if SYMBOL has been customized."
(and (default-boundp symbol)
(let ((standard (get symbol 'standard-value)))
(and standard
- (not (equal (eval (car standard)) (default-value symbol)))))))
+ (not (equal (eval (car standard) t) (default-value symbol)))))))
(defun calendar-abbrev-construct (full &optional maxlen)
"From sequence FULL, return a vector of abbreviations.
@@ -2284,32 +2303,38 @@ arguments SEQUENCES."
(append (list sequence) sequences))
(reverse alist)))
-(defun calendar-read-date (&optional noday)
+(defun calendar-read-date (&optional noday default-date)
"Prompt for Gregorian date. Return a list (month day year).
If optional NODAY is t, does not ask for day, but just returns
\(month 1 year); if NODAY is any other non-nil value the value
returned is (month year)."
- (let* ((year (calendar-read
- "Year (>0): "
- (lambda (x) (> x 0))
- (number-to-string (calendar-extract-year
- (calendar-current-date)))))
+ (unless default-date (setq default-date (calendar-current-date)))
+ (let* ((defyear (calendar-extract-year default-date))
+ (year (calendar-read-sexp "Year (>0)"
+ (lambda (x) (> x 0))
+ defyear))
(month-array calendar-month-name-array)
+ (defmon (aref month-array (1- (calendar-extract-month default-date))))
(completion-ignore-case t)
(month (cdr (assoc-string
- (completing-read
- "Month name: "
- (mapcar #'list (append month-array nil))
- nil t)
+ (completing-read
+ (format-prompt "Month name" defmon)
+ (append month-array nil)
+ nil t nil nil defmon)
(calendar-make-alist month-array 1) t)))
+ (defday (calendar-extract-day default-date))
(last (calendar-last-day-of-month month year)))
(if noday
(if (eq noday t)
(list month 1 year)
(list month year))
(list month
- (calendar-read (format "Day (1-%d): " last)
- (lambda (x) (and (< 0 x) (<= x last))))
+ (calendar-read-sexp "Day (1-%d)"
+ (lambda (x) (and (< 0 x) (<= x last)))
+ ;; Don't offer today's day as default
+ ;; if it's not valid for the chosen
+ ;; month/year.
+ (if (<= defday last) defday) last)
year))))
(defun calendar-interval (mon1 yr1 mon2 yr2)
diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el
index aad70161f9f..4efa3669967 100644
--- a/lisp/calendar/diary-lib.el
+++ b/lisp/calendar/diary-lib.el
@@ -2221,8 +2221,8 @@ Prefix argument ARG makes the entry nonmarking."
(diary-make-entry
(format "%s(diary-cyclic %d %s)"
diary-sexp-entry-symbol
- (calendar-read "Repeat every how many days: "
- (lambda (x) (> x 0)))
+ (calendar-read-sexp "Repeat every how many days"
+ (lambda (x) (> x 0)))
(calendar-date-string (calendar-cursor-to-date t) nil t))
arg)))
diff --git a/lisp/calendar/holidays.el b/lisp/calendar/holidays.el
index 932993beba0..4bc17de3067 100644
--- a/lisp/calendar/holidays.el
+++ b/lisp/calendar/holidays.el
@@ -423,16 +423,15 @@ of a holiday list.
The optional LABEL is used to label the buffer created."
(interactive
- (let* ((start-year (calendar-read
- "Starting year of holidays (>0): "
+ (let* ((start-year (calendar-read-sexp
+ "Starting year of holidays (>0)"
(lambda (x) (> x 0))
- (number-to-string (calendar-extract-year
- (calendar-current-date)))))
- (end-year (calendar-read
- (format "Ending year (inclusive) of holidays (>=%s): "
- start-year)
+ (calendar-extract-year (calendar-current-date))))
+ (end-year (calendar-read-sexp
+ "Ending year (inclusive) of holidays (>=%s)"
(lambda (x) (>= x start-year))
- (number-to-string start-year)))
+ start-year
+ start-year))
(completion-ignore-case t)
(lists
(list
diff --git a/lisp/cedet/ede.el b/lisp/cedet/ede.el
index 14289153e81..e3cc9062ed4 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/mode-local.el b/lisp/cedet/mode-local.el
index d1e528c4a02..63e0cef61a3 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/semantic.el b/lisp/cedet/semantic.el
index c64a9822c6b..44bd4b0cd82 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 034ecb5ea1c..3bc0e4dd618 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/complete.el b/lisp/cedet/semantic/complete.el
index 0a80b428e8e..c83505818f5 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 4d2defde35b..8d5b5dcdbdf 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 14726e503d5..db88463bfd1 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 b9b10917dc6..8f9eceea554 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 b3e8f076d07..ce4afbbf26d 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 0fba2a2f091..db8be5ecf47 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 f9c5365a29f..8927ccde843 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 f034ba01a4f..91944c44f5e 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 7721a834ea4..4551811c235 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 4898c85b216..73954f0266b 100644
--- a/lisp/cedet/semantic/idle.el
+++ b/lisp/cedet/semantic/idle.el
@@ -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.
diff --git a/lisp/cedet/semantic/imenu.el b/lisp/cedet/semantic/imenu.el
index 2898f3711a0..4c13959ba1d 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 8b83c09eb16..408011c6286 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 993c1dc14b6..4cafc7d4fe7 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."
@@ -472,11 +470,10 @@ PROPERTY set."
;;
;; FIXME change to non-obsolete default.
-(defvar semantic-lex-analyzer 'semantic-flex
+(defvar-local semantic-lex-analyzer 'semantic-flex
"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)
(defvar semantic-lex-tokens
'(
@@ -558,7 +555,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 +563,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 +622,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 +1760,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 +1769,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 +1779,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/senator.el b/lisp/cedet/semantic/senator.el
index 6768b432f69..f33356a170c 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 154a56a27aa..19f46ff7f15 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 d68ffa55d6e..85defe4f2c0 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 45eef10f005..f8d6bb759b0 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.
@@ -713,10 +712,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 +884,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 7d33d0e0886..8c487e14ed5 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 fb4d0b074ad..d5b73244a08 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/dired-aux.el b/lisp/dired-aux.el
index 5a96742fda9..ec864d54d69 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -1168,7 +1168,10 @@ ARGS are command switches passed to PROGRAM.")
("\\.tar\\.bz2\\'" . "tar -cf - %i | bzip2 -c9 > %o")
("\\.tar\\.xz\\'" . "tar -cf - %i | xz -c9 > %o")
("\\.tar\\.zst\\'" . "tar -cf - %i | zstd -19 -o %o")
- ("\\.zip\\'" . "zip %o -r --filesync %i"))
+ ("\\.tar\\.lz\\'" . "tar -cf - %i | lzip -c9 > %o")
+ ("\\.tar\\.lzo\\'" . "tar -cf - %i | lzop -c9 > %o")
+ ("\\.zip\\'" . "zip %o -r --filesync %i")
+ ("\\.pax\\'" . "pax -wf %o %i"))
"Control the compression shell command for `dired-do-compress-to'.
Each element is (REGEXP . CMD), where REGEXP is the name of the
@@ -1176,7 +1179,7 @@ archive to which you want to compress, and CMD is the
corresponding command.
Within CMD, %i denotes the input file(s), and %o denotes the
-output file. %i path(s) are relative, while %o is absolute.")
+output file. %i path(s) are relative, while %o is absolute.")
;;;###autoload
(defun dired-do-compress-to ()
diff --git a/lisp/dired.el b/lisp/dired.el
index 3f119363314..fe6ac1e2591 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -3532,18 +3532,21 @@ confirmation. To disable the confirmation, see
(when (and (featurep 'dired-x) dired-clean-up-buffers-too)
(let ((buf (get-file-buffer fn)))
(and buf
- (and dired-clean-confirm-killing-deleted-buffers
- (funcall #'y-or-n-p
- (format "Kill buffer of %s, too? "
- (file-name-nondirectory fn))))
+ (or (and dired-clean-confirm-killing-deleted-buffers
+ (funcall #'y-or-n-p
+ (format "Kill buffer of %s, too? "
+ (file-name-nondirectory fn))))
+ (not dired-clean-confirm-killing-deleted-buffers))
(kill-buffer buf)))
(let ((buf-list (dired-buffers-for-dir (expand-file-name fn))))
(and buf-list
- (and dired-clean-confirm-killing-deleted-buffers
- (y-or-n-p (format (ngettext "Kill Dired buffer of %s, too? "
- "Kill Dired buffers of %s, too? "
- (length buf-list))
- (file-name-nondirectory fn))))
+ (or (and dired-clean-confirm-killing-deleted-buffers
+ (y-or-n-p (format
+ (ngettext "Kill Dired buffer of %s, too? "
+ "Kill Dired buffers of %s, too? "
+ (length buf-list))
+ (file-name-nondirectory fn))))
+ (not dired-clean-confirm-killing-deleted-buffers))
(dolist (buf buf-list)
(kill-buffer buf))))))
diff --git a/lisp/double.el b/lisp/double.el
index 8bbbaa58189..d099fd06422 100644
--- a/lisp/double.el
+++ b/lisp/double.el
@@ -141,12 +141,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/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index 5f432b80bc2..0d9ba57d663 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -1,4 +1,4 @@
-;;; bindat.el --- binary data structure packing and unpacking.
+;;; bindat.el --- binary data structure packing and unpacking. -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
@@ -198,7 +198,7 @@
(defun bindat--unpack-u8 ()
(prog1
- (aref bindat-raw bindat-idx)
+ (aref bindat-raw bindat-idx)
(setq bindat-idx (1+ bindat-idx))))
(defun bindat--unpack-u16 ()
@@ -276,6 +276,8 @@
(t nil)))
(defun bindat--unpack-group (spec)
+ (with-suppressed-warnings ((lexical last))
+ (defvar last))
(let (struct last)
(while spec
(let* ((item (car spec))
@@ -287,11 +289,11 @@
data)
(setq spec (cdr spec))
(if (and (consp field) (eq (car field) 'eval))
- (setq field (eval (car (cdr field)))))
+ (setq field (eval (car (cdr field)) t)))
(if (and type (consp type) (eq (car type) 'eval))
- (setq type (eval (car (cdr type)))))
+ (setq type (eval (car (cdr type)) t)))
(if (and len (consp len) (eq (car len) 'eval))
- (setq len (eval (car (cdr len)))))
+ (setq len (eval (car (cdr len)) t)))
(if (memq field '(eval fill align struct union))
(setq tail 2
len type
@@ -304,48 +306,51 @@
(cond
((eq type 'eval)
(if field
- (setq data (eval len))
- (eval len)))
+ (setq data (eval len t))
+ (eval len t)))
((eq type 'fill)
(setq bindat-idx (+ bindat-idx len)))
((eq type 'align)
(while (/= (% bindat-idx len) 0)
(setq bindat-idx (1+ bindat-idx))))
((eq type 'struct)
- (setq data (bindat--unpack-group (eval len))))
+ (setq data (bindat--unpack-group (eval len t))))
((eq type 'repeat)
(let ((index 0) (count len))
(while (< index count)
- (setq data (cons (bindat--unpack-group (nthcdr tail item)) data))
+ (push (bindat--unpack-group (nthcdr tail item)) data)
(setq index (1+ index)))
(setq data (nreverse data))))
((eq type 'union)
+ (with-suppressed-warnings ((lexical tag))
+ (defvar tag))
(let ((tag len) (cases (nthcdr tail item)) case cc)
(while cases
(setq case (car cases)
cases (cdr cases)
cc (car case))
(if (or (equal cc tag) (equal cc t)
- (and (consp cc) (eval cc)))
+ (and (consp cc) (eval cc t)))
(setq data (bindat--unpack-group (cdr case))
cases nil)))))
(t
(setq data (bindat--unpack-item type len vectype)
last data)))
(if data
- (if field
- (setq struct (cons (cons field data) struct))
- (setq struct (append data struct))))))
+ (setq struct (if field
+ (cons (cons field data) struct)
+ (append data struct))))))
struct))
-(defun bindat-unpack (spec bindat-raw &optional bindat-idx)
- "Return structured data according to SPEC for binary data in BINDAT-RAW.
-BINDAT-RAW is a unibyte string or vector.
-Optional third arg BINDAT-IDX specifies the starting offset in BINDAT-RAW."
- (when (multibyte-string-p bindat-raw)
+(defun bindat-unpack (spec raw &optional idx)
+ "Return structured data according to SPEC for binary data in RAW.
+RAW is a unibyte string or vector.
+Optional third arg IDX specifies the starting offset in RAW."
+ (when (multibyte-string-p raw)
(error "String is multibyte"))
- (unless bindat-idx (setq bindat-idx 0))
- (bindat--unpack-group spec))
+ (let ((bindat-idx (or idx 0))
+ (bindat-raw raw))
+ (bindat--unpack-group spec)))
(defun bindat-get-field (struct &rest field)
"In structured data STRUCT, return value of field named FIELD.
@@ -373,6 +378,8 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(ip . 4)))
(defun bindat--length-group (struct spec)
+ (with-suppressed-warnings ((lexical last))
+ (defvar last))
(let (last)
(while spec
(let* ((item (car spec))
@@ -383,32 +390,31 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(tail 3))
(setq spec (cdr spec))
(if (and (consp field) (eq (car field) 'eval))
- (setq field (eval (car (cdr field)))))
+ (setq field (eval (car (cdr field)) t)))
(if (and type (consp type) (eq (car type) 'eval))
- (setq type (eval (car (cdr type)))))
+ (setq type (eval (car (cdr type)) t)))
(if (and len (consp len) (eq (car len) 'eval))
- (setq len (eval (car (cdr len)))))
+ (setq len (eval (car (cdr len)) t)))
(if (memq field '(eval fill align struct union))
(setq tail 2
len type
type field
field nil))
(if (and (consp len) (not (eq type 'eval)))
- (setq len (apply 'bindat-get-field struct len)))
+ (setq len (apply #'bindat-get-field struct len)))
(if (not len)
(setq len 1))
(while (eq type 'vec)
- (let ((vlen 1))
- (if (consp vectype)
- (setq len (* len (nth 1 vectype))
- type (nth 2 vectype))
- (setq type (or vectype 'u8)
- vectype nil))))
+ (if (consp vectype)
+ (setq len (* len (nth 1 vectype))
+ type (nth 2 vectype))
+ (setq type (or vectype 'u8)
+ vectype nil)))
(cond
((eq type 'eval)
(if field
- (setq struct (cons (cons field (eval len)) struct))
- (eval len)))
+ (setq struct (cons (cons field (eval len t)) struct))
+ (eval len t)))
((eq type 'fill)
(setq bindat-idx (+ bindat-idx len)))
((eq type 'align)
@@ -416,7 +422,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(setq bindat-idx (1+ bindat-idx))))
((eq type 'struct)
(bindat--length-group
- (if field (bindat-get-field struct field) struct) (eval len)))
+ (if field (bindat-get-field struct field) struct) (eval len t)))
((eq type 'repeat)
(let ((index 0) (count len))
(while (< index count)
@@ -425,13 +431,15 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(nthcdr tail item))
(setq index (1+ index)))))
((eq type 'union)
+ (with-suppressed-warnings ((lexical tag))
+ (defvar tag))
(let ((tag len) (cases (nthcdr tail item)) case cc)
(while cases
(setq case (car cases)
cases (cdr cases)
cc (car case))
(if (or (equal cc tag) (equal cc t)
- (and (consp cc) (eval cc)))
+ (and (consp cc) (eval cc t)))
(progn
(bindat--length-group struct (cdr case))
(setq cases nil))))))
@@ -536,6 +544,8 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(setq bindat-idx (+ bindat-idx len)))))
(defun bindat--pack-group (struct spec)
+ (with-suppressed-warnings ((lexical last))
+ (defvar last))
(let (last)
(while spec
(let* ((item (car spec))
@@ -546,11 +556,11 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(tail 3))
(setq spec (cdr spec))
(if (and (consp field) (eq (car field) 'eval))
- (setq field (eval (car (cdr field)))))
+ (setq field (eval (car (cdr field)) t)))
(if (and type (consp type) (eq (car type) 'eval))
- (setq type (eval (car (cdr type)))))
+ (setq type (eval (car (cdr type)) t)))
(if (and len (consp len) (eq (car len) 'eval))
- (setq len (eval (car (cdr len)))))
+ (setq len (eval (car (cdr len)) t)))
(if (memq field '(eval fill align struct union))
(setq tail 2
len type
@@ -563,8 +573,8 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(cond
((eq type 'eval)
(if field
- (setq struct (cons (cons field (eval len)) struct))
- (eval len)))
+ (setq struct (cons (cons field (eval len t)) struct))
+ (eval len t)))
((eq type 'fill)
(setq bindat-idx (+ bindat-idx len)))
((eq type 'align)
@@ -572,7 +582,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(setq bindat-idx (1+ bindat-idx))))
((eq type 'struct)
(bindat--pack-group
- (if field (bindat-get-field struct field) struct) (eval len)))
+ (if field (bindat-get-field struct field) struct) (eval len t)))
((eq type 'repeat)
(let ((index 0) (count len))
(while (< index count)
@@ -581,13 +591,15 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(nthcdr tail item))
(setq index (1+ index)))))
((eq type 'union)
+ (with-suppressed-warnings ((lexical tag))
+ (defvar tag))
(let ((tag len) (cases (nthcdr tail item)) case cc)
(while cases
(setq case (car cases)
cases (cdr cases)
cc (car case))
(if (or (equal cc tag) (equal cc t)
- (and (consp cc) (eval cc)))
+ (and (consp cc) (eval cc t)))
(progn
(bindat--pack-group struct (cdr case))
(setq cases nil))))))
@@ -596,19 +608,19 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(bindat--pack-item last type len vectype)
))))))
-(defun bindat-pack (spec struct &optional bindat-raw bindat-idx)
+(defun bindat-pack (spec struct &optional raw idx)
"Return binary data packed according to SPEC for structured data STRUCT.
-Optional third arg BINDAT-RAW is a pre-allocated unibyte string or vector to
+Optional third arg RAW is a pre-allocated unibyte string or vector to
pack into.
-Optional fourth arg BINDAT-IDX is the starting offset into BINDAT-RAW."
- (when (multibyte-string-p bindat-raw)
+Optional fourth arg IDX is the starting offset into RAW."
+ (when (multibyte-string-p raw)
(error "Pre-allocated string is multibyte"))
- (let ((no-return bindat-raw))
- (unless bindat-idx (setq bindat-idx 0))
- (unless bindat-raw
- (setq bindat-raw (make-string (+ bindat-idx (bindat-length spec struct)) 0)))
+ (let* ((bindat-idx (or idx 0))
+ (bindat-raw
+ (or raw
+ (make-string (+ bindat-idx (bindat-length spec struct)) 0))))
(bindat--pack-group struct spec)
- (if no-return nil bindat-raw)))
+ (if raw nil bindat-raw)))
;; Misc. format conversions
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index f29f85b9650..66a117fccc8 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -284,8 +284,10 @@
;; If `fn' is from the same file, it has already
;; been preprocessed!
`(function ,fn)
- (byte-compile-preprocess
- (byte-compile--reify-function fn)))))
+ ;; Try and process it "in its original environment".
+ (let ((byte-compile-bound-variables nil))
+ (byte-compile-preprocess
+ (byte-compile--reify-function fn))))))
(if (eq (car-safe newfn) 'function)
(byte-compile-unfold-lambda `(,(cadr newfn) ,@(cdr form)))
;; This can happen because of macroexp-warn-and-return &co.
@@ -1561,467 +1563,548 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
;; You may notice that sequences like "dup varset discard" are
;; optimized but sequences like "dup varset TAG1: discard" are not.
;; You may be tempted to change this; resist that temptation.
- (cond ;;
- ;; <side-effect-free> pop --> <deleted>
- ;; ...including:
- ;; const-X pop --> <deleted>
- ;; varref-X pop --> <deleted>
- ;; dup pop --> <deleted>
- ;;
- ((and (eq 'byte-discard (car lap1))
- (memq (car lap0) side-effect-free))
- (setq keep-going t)
- (setq tmp (aref byte-stack+-info (symbol-value (car lap0))))
- (setq rest (cdr rest))
- (cond ((= tmp 1)
- (byte-compile-log-lap
- " %s discard\t-->\t<deleted>" lap0)
- (setq lap (delq lap0 (delq lap1 lap))))
- ((= tmp 0)
- (byte-compile-log-lap
- " %s discard\t-->\t<deleted> discard" lap0)
- (setq lap (delq lap0 lap)))
- ((= tmp -1)
- (byte-compile-log-lap
- " %s discard\t-->\tdiscard discard" lap0)
- (setcar lap0 'byte-discard)
- (setcdr lap0 0))
- ((error "Optimizer error: too much on the stack"))))
- ;;
- ;; goto*-X X: --> X:
- ;;
- ((and (memq (car lap0) byte-goto-ops)
- (eq (cdr lap0) lap1))
- (cond ((eq (car lap0) 'byte-goto)
- (setq lap (delq lap0 lap))
- (setq tmp "<deleted>"))
- ((memq (car lap0) byte-goto-always-pop-ops)
- (setcar lap0 (setq tmp 'byte-discard))
- (setcdr lap0 0))
- ((error "Depth conflict at tag %d" (nth 2 lap0))))
- (and (memq byte-optimize-log '(t byte))
- (byte-compile-log " (goto %s) %s:\t-->\t%s %s:"
- (nth 1 lap1) (nth 1 lap1)
- tmp (nth 1 lap1)))
- (setq keep-going t))
- ;;
- ;; varset-X varref-X --> dup varset-X
- ;; varbind-X varref-X --> dup varbind-X
- ;; const/dup varset-X varref-X --> const/dup varset-X const/dup
- ;; const/dup varbind-X varref-X --> const/dup varbind-X const/dup
- ;; The latter two can enable other optimizations.
- ;;
- ;; For lexical variables, we could do the same
- ;; stack-set-X+1 stack-ref-X --> dup stack-set-X+2
- ;; but this is a very minor gain, since dup is stack-ref-0,
- ;; i.e. it's only better if X>5, and even then it comes
- ;; at the cost of an extra stack slot. Let's not bother.
- ((and (eq 'byte-varref (car lap2))
- (eq (cdr lap1) (cdr lap2))
- (memq (car lap1) '(byte-varset byte-varbind)))
- (if (and (setq tmp (memq (car (cdr lap2)) byte-boolean-vars))
- (not (eq (car lap0) 'byte-constant)))
- nil
- (setq keep-going t)
- (if (memq (car lap0) '(byte-constant byte-dup))
- (progn
- (setq tmp (if (or (not tmp)
- (macroexp--const-symbol-p
- (car (cdr lap0))))
- (cdr lap0)
- (byte-compile-get-constant t)))
- (byte-compile-log-lap " %s %s %s\t-->\t%s %s %s"
- lap0 lap1 lap2 lap0 lap1
- (cons (car lap0) tmp))
- (setcar lap2 (car lap0))
- (setcdr lap2 tmp))
- (byte-compile-log-lap " %s %s\t-->\tdup %s" lap1 lap2 lap1)
- (setcar lap2 (car lap1))
- (setcar lap1 'byte-dup)
- (setcdr lap1 0)
- ;; The stack depth gets locally increased, so we will
- ;; increase maxdepth in case depth = maxdepth here.
- ;; This can cause the third argument to byte-code to
- ;; be larger than necessary.
- (setq add-depth 1))))
- ;;
- ;; dup varset-X discard --> varset-X
- ;; dup varbind-X discard --> varbind-X
- ;; dup stack-set-X discard --> stack-set-X-1
- ;; (the varbind variant can emerge from other optimizations)
- ;;
- ((and (eq 'byte-dup (car lap0))
- (eq 'byte-discard (car lap2))
- (memq (car lap1) '(byte-varset byte-varbind
- byte-stack-set)))
- (byte-compile-log-lap " dup %s discard\t-->\t%s" lap1 lap1)
- (setq keep-going t
- rest (cdr rest))
- (if (eq 'byte-stack-set (car lap1)) (cl-decf (cdr lap1)))
- (setq lap (delq lap0 (delq lap2 lap))))
- ;;
- ;; not goto-X-if-nil --> goto-X-if-non-nil
- ;; not goto-X-if-non-nil --> goto-X-if-nil
- ;;
- ;; it is wrong to do the same thing for the -else-pop variants.
- ;;
- ((and (eq 'byte-not (car lap0))
- (memq (car lap1) '(byte-goto-if-nil byte-goto-if-not-nil)))
- (byte-compile-log-lap " not %s\t-->\t%s"
- lap1
- (cons
- (if (eq (car lap1) 'byte-goto-if-nil)
- 'byte-goto-if-not-nil
- 'byte-goto-if-nil)
- (cdr lap1)))
- (setcar lap1 (if (eq (car lap1) 'byte-goto-if-nil)
- 'byte-goto-if-not-nil
- 'byte-goto-if-nil))
- (setq lap (delq lap0 lap))
- (setq keep-going t))
- ;;
- ;; goto-X-if-nil goto-Y X: --> goto-Y-if-non-nil X:
- ;; goto-X-if-non-nil goto-Y X: --> goto-Y-if-nil X:
- ;;
- ;; it is wrong to do the same thing for the -else-pop variants.
- ;;
- ((and (memq (car lap0)
- '(byte-goto-if-nil byte-goto-if-not-nil)) ; gotoX
- (eq 'byte-goto (car lap1)) ; gotoY
- (eq (cdr lap0) lap2)) ; TAG X
- (let ((inverse (if (eq 'byte-goto-if-nil (car lap0))
- 'byte-goto-if-not-nil 'byte-goto-if-nil)))
- (byte-compile-log-lap " %s %s %s:\t-->\t%s %s:"
- lap0 lap1 lap2
- (cons inverse (cdr lap1)) lap2)
- (setq lap (delq lap0 lap))
- (setcar lap1 inverse)
- (setq keep-going t)))
- ;;
- ;; const goto-if-* --> whatever
- ;;
- ((and (eq 'byte-constant (car lap0))
- (memq (car lap1) byte-conditional-ops)
- ;; If the `byte-constant's cdr is not a cons cell, it has
- ;; to be an index into the constant pool); even though
- ;; it'll be a constant, that constant is not known yet
- ;; (it's typically a free variable of a closure, so will
- ;; only be known when the closure will be built at
- ;; run-time).
- (consp (cdr lap0)))
- (cond ((if (memq (car lap1) '(byte-goto-if-nil
- byte-goto-if-nil-else-pop))
- (car (cdr lap0))
- (not (car (cdr lap0))))
- (byte-compile-log-lap " %s %s\t-->\t<deleted>"
- lap0 lap1)
- (setq rest (cdr rest)
- lap (delq lap0 (delq lap1 lap))))
- (t
- (byte-compile-log-lap " %s %s\t-->\t%s"
- lap0 lap1
- (cons 'byte-goto (cdr lap1)))
- (when (memq (car lap1) byte-goto-always-pop-ops)
- (setq lap (delq lap0 lap)))
- (setcar lap1 'byte-goto)))
- (setq keep-going t))
- ;;
- ;; varref-X varref-X --> varref-X dup
- ;; varref-X [dup ...] varref-X --> varref-X [dup ...] dup
- ;; stackref-X [dup ...] stackref-X+N --> stackref-X [dup ...] dup
- ;; We don't optimize the const-X variations on this here,
- ;; because that would inhibit some goto optimizations; we
- ;; optimize the const-X case after all other optimizations.
- ;;
- ((and (memq (car lap0) '(byte-varref byte-stack-ref))
- (progn
- (setq tmp (cdr rest))
- (setq tmp2 0)
- (while (eq (car (car tmp)) 'byte-dup)
- (setq tmp2 (1+ tmp2))
- (setq tmp (cdr tmp)))
- t)
- (eq (if (eq 'byte-stack-ref (car lap0))
- (+ tmp2 1 (cdr lap0))
- (cdr lap0))
- (cdr (car tmp)))
- (eq (car lap0) (car (car tmp))))
- (if (memq byte-optimize-log '(t byte))
- (let ((str ""))
- (setq tmp2 (cdr rest))
- (while (not (eq tmp tmp2))
- (setq tmp2 (cdr tmp2)
- str (concat str " dup")))
- (byte-compile-log-lap " %s%s %s\t-->\t%s%s dup"
- lap0 str lap0 lap0 str)))
- (setq keep-going t)
- (setcar (car tmp) 'byte-dup)
- (setcdr (car tmp) 0)
- (setq rest tmp))
- ;;
- ;; TAG1: TAG2: --> TAG1: <deleted>
- ;; (and other references to TAG2 are replaced with TAG1)
- ;;
- ((and (eq (car lap0) 'TAG)
- (eq (car lap1) 'TAG))
- (and (memq byte-optimize-log '(t byte))
- (byte-compile-log " adjacent tags %d and %d merged"
- (nth 1 lap1) (nth 1 lap0)))
- (setq tmp3 lap)
- (while (setq tmp2 (rassq lap0 tmp3))
- (setcdr tmp2 lap1)
- (setq tmp3 (cdr (memq tmp2 tmp3))))
- (setq lap (delq lap0 lap)
- keep-going t)
- ;; replace references to tag in jump tables, if any
- (dolist (table byte-compile-jump-tables)
- (maphash #'(lambda (value tag)
- (when (equal tag lap0)
- (puthash value lap1 table)))
- table)))
- ;;
- ;; unused-TAG: --> <deleted>
- ;;
- ((and (eq 'TAG (car lap0))
- (not (rassq lap0 lap))
- ;; make sure this tag isn't used in a jump-table
- (cl-loop for table in byte-compile-jump-tables
- when (member lap0 (hash-table-values table))
- return nil finally return t))
- (and (memq byte-optimize-log '(t byte))
- (byte-compile-log " unused tag %d removed" (nth 1 lap0)))
- (setq lap (delq lap0 lap)
- keep-going t))
- ;;
- ;; goto ... --> goto <delete until TAG or end>
- ;; return ... --> return <delete until TAG or end>
- ;; (unless a jump-table is being used, where deleting may affect
- ;; other valid case bodies)
- ;;
- ((and (memq (car lap0) '(byte-goto byte-return))
- (not (memq (car lap1) '(TAG nil)))
- ;; FIXME: Instead of deferring simply when jump-tables are
- ;; being used, keep a list of tags used for switch tags and
- ;; use them instead (see `byte-compile-inline-lapcode').
- (not byte-compile-jump-tables))
- (setq tmp rest)
- (let ((i 0)
- (opt-p (memq byte-optimize-log '(t lap)))
- str deleted)
- (while (and (setq tmp (cdr tmp))
- (not (eq 'TAG (car (car tmp)))))
- (if opt-p (setq deleted (cons (car tmp) deleted)
- str (concat str " %s")
- i (1+ i))))
- (if opt-p
- (let ((tagstr
- (if (eq 'TAG (car (car tmp)))
- (format "%d:" (car (cdr (car tmp))))
- (or (car tmp) ""))))
- (if (< i 6)
- (apply 'byte-compile-log-lap-1
- (concat " %s" str
- " %s\t-->\t%s <deleted> %s")
- lap0
- (nconc (nreverse deleted)
- (list tagstr lap0 tagstr)))
- (byte-compile-log-lap
- " %s <%d unreachable op%s> %s\t-->\t%s <deleted> %s"
- lap0 i (if (= i 1) "" "s")
- tagstr lap0 tagstr))))
- (rplacd rest tmp))
- (setq keep-going t))
- ;;
- ;; <safe-op> unbind --> unbind <safe-op>
- ;; (this may enable other optimizations.)
- ;;
- ((and (eq 'byte-unbind (car lap1))
- (memq (car lap0) byte-after-unbind-ops))
- (byte-compile-log-lap " %s %s\t-->\t%s %s" lap0 lap1 lap1 lap0)
- (setcar rest lap1)
- (setcar (cdr rest) lap0)
- (setq keep-going t))
- ;;
- ;; varbind-X unbind-N --> discard unbind-(N-1)
- ;; save-excursion unbind-N --> unbind-(N-1)
- ;; save-restriction unbind-N --> unbind-(N-1)
- ;;
- ((and (eq 'byte-unbind (car lap1))
- (memq (car lap0) '(byte-varbind byte-save-excursion
- byte-save-restriction))
- (< 0 (cdr lap1)))
- (if (zerop (setcdr lap1 (1- (cdr lap1))))
- (delq lap1 rest))
- (if (eq (car lap0) 'byte-varbind)
- (setcar rest (cons 'byte-discard 0))
+ (cond
+ ;; <side-effect-free> pop --> <deleted>
+ ;; ...including:
+ ;; const-X pop --> <deleted>
+ ;; varref-X pop --> <deleted>
+ ;; dup pop --> <deleted>
+ ;;
+ ((and (eq 'byte-discard (car lap1))
+ (memq (car lap0) side-effect-free))
+ (setq keep-going t)
+ (setq tmp (aref byte-stack+-info (symbol-value (car lap0))))
+ (setq rest (cdr rest))
+ (cond ((= tmp 1)
+ (byte-compile-log-lap
+ " %s discard\t-->\t<deleted>" lap0)
+ (setq lap (delq lap0 (delq lap1 lap))))
+ ((= tmp 0)
+ (byte-compile-log-lap
+ " %s discard\t-->\t<deleted> discard" lap0)
(setq lap (delq lap0 lap)))
- (byte-compile-log-lap " %s %s\t-->\t%s %s"
- lap0 (cons (car lap1) (1+ (cdr lap1)))
- (if (eq (car lap0) 'byte-varbind)
- (car rest)
- (car (cdr rest)))
- (if (and (/= 0 (cdr lap1))
- (eq (car lap0) 'byte-varbind))
- (car (cdr rest))
- ""))
- (setq keep-going t))
- ;;
- ;; goto*-X ... X: goto-Y --> goto*-Y
- ;; goto-X ... X: return --> return
- ;;
- ((and (memq (car lap0) byte-goto-ops)
- (memq (car (setq tmp (nth 1 (memq (cdr lap0) lap))))
- '(byte-goto byte-return)))
- (cond ((and (not (eq tmp lap0))
- (or (eq (car lap0) 'byte-goto)
- (eq (car tmp) 'byte-goto)))
- (byte-compile-log-lap " %s [%s]\t-->\t%s"
- (car lap0) tmp tmp)
- (if (eq (car tmp) 'byte-return)
- (setcar lap0 'byte-return))
- (setcdr lap0 (cdr tmp))
- (setq keep-going t))))
- ;;
- ;; goto-*-else-pop X ... X: goto-if-* --> whatever
- ;; goto-*-else-pop X ... X: discard --> whatever
- ;;
- ((and (memq (car lap0) '(byte-goto-if-nil-else-pop
- byte-goto-if-not-nil-else-pop))
- (memq (car (car (setq tmp (cdr (memq (cdr lap0) lap)))))
- (eval-when-compile
- (cons 'byte-discard byte-conditional-ops)))
- (not (eq lap0 (car tmp))))
- (setq tmp2 (car tmp))
- (setq tmp3 (assq (car lap0) '((byte-goto-if-nil-else-pop
- byte-goto-if-nil)
- (byte-goto-if-not-nil-else-pop
- byte-goto-if-not-nil))))
- (if (memq (car tmp2) tmp3)
- (progn (setcar lap0 (car tmp2))
- (setcdr lap0 (cdr tmp2))
- (byte-compile-log-lap " %s-else-pop [%s]\t-->\t%s"
- (car lap0) tmp2 lap0))
- ;; Get rid of the -else-pop's and jump one step further.
+ ((= tmp -1)
+ (byte-compile-log-lap
+ " %s discard\t-->\tdiscard discard" lap0)
+ (setcar lap0 'byte-discard)
+ (setcdr lap0 0))
+ ((error "Optimizer error: too much on the stack"))))
+ ;;
+ ;; goto*-X X: --> X:
+ ;;
+ ((and (memq (car lap0) byte-goto-ops)
+ (eq (cdr lap0) lap1))
+ (cond ((eq (car lap0) 'byte-goto)
+ (setq lap (delq lap0 lap))
+ (setq tmp "<deleted>"))
+ ((memq (car lap0) byte-goto-always-pop-ops)
+ (setcar lap0 (setq tmp 'byte-discard))
+ (setcdr lap0 0))
+ ((error "Depth conflict at tag %d" (nth 2 lap0))))
+ (and (memq byte-optimize-log '(t byte))
+ (byte-compile-log " (goto %s) %s:\t-->\t%s %s:"
+ (nth 1 lap1) (nth 1 lap1)
+ tmp (nth 1 lap1)))
+ (setq keep-going t))
+ ;;
+ ;; varset-X varref-X --> dup varset-X
+ ;; varbind-X varref-X --> dup varbind-X
+ ;; const/dup varset-X varref-X --> const/dup varset-X const/dup
+ ;; const/dup varbind-X varref-X --> const/dup varbind-X const/dup
+ ;; The latter two can enable other optimizations.
+ ;;
+ ;; For lexical variables, we could do the same
+ ;; stack-set-X+1 stack-ref-X --> dup stack-set-X+2
+ ;; but this is a very minor gain, since dup is stack-ref-0,
+ ;; i.e. it's only better if X>5, and even then it comes
+ ;; at the cost of an extra stack slot. Let's not bother.
+ ((and (eq 'byte-varref (car lap2))
+ (eq (cdr lap1) (cdr lap2))
+ (memq (car lap1) '(byte-varset byte-varbind)))
+ (if (and (setq tmp (memq (car (cdr lap2)) byte-boolean-vars))
+ (not (eq (car lap0) 'byte-constant)))
+ nil
+ (setq keep-going t)
+ (if (memq (car lap0) '(byte-constant byte-dup))
+ (progn
+ (setq tmp (if (or (not tmp)
+ (macroexp--const-symbol-p
+ (car (cdr lap0))))
+ (cdr lap0)
+ (byte-compile-get-constant t)))
+ (byte-compile-log-lap " %s %s %s\t-->\t%s %s %s"
+ lap0 lap1 lap2 lap0 lap1
+ (cons (car lap0) tmp))
+ (setcar lap2 (car lap0))
+ (setcdr lap2 tmp))
+ (byte-compile-log-lap " %s %s\t-->\tdup %s" lap1 lap2 lap1)
+ (setcar lap2 (car lap1))
+ (setcar lap1 'byte-dup)
+ (setcdr lap1 0)
+ ;; The stack depth gets locally increased, so we will
+ ;; increase maxdepth in case depth = maxdepth here.
+ ;; This can cause the third argument to byte-code to
+ ;; be larger than necessary.
+ (setq add-depth 1))))
+ ;;
+ ;; dup varset-X discard --> varset-X
+ ;; dup varbind-X discard --> varbind-X
+ ;; dup stack-set-X discard --> stack-set-X-1
+ ;; (the varbind variant can emerge from other optimizations)
+ ;;
+ ((and (eq 'byte-dup (car lap0))
+ (eq 'byte-discard (car lap2))
+ (memq (car lap1) '(byte-varset byte-varbind
+ byte-stack-set)))
+ (byte-compile-log-lap " dup %s discard\t-->\t%s" lap1 lap1)
+ (setq keep-going t
+ rest (cdr rest))
+ (if (eq 'byte-stack-set (car lap1)) (cl-decf (cdr lap1)))
+ (setq lap (delq lap0 (delq lap2 lap))))
+ ;;
+ ;; not goto-X-if-nil --> goto-X-if-non-nil
+ ;; not goto-X-if-non-nil --> goto-X-if-nil
+ ;;
+ ;; it is wrong to do the same thing for the -else-pop variants.
+ ;;
+ ((and (eq 'byte-not (car lap0))
+ (memq (car lap1) '(byte-goto-if-nil byte-goto-if-not-nil)))
+ (byte-compile-log-lap " not %s\t-->\t%s"
+ lap1
+ (cons
+ (if (eq (car lap1) 'byte-goto-if-nil)
+ 'byte-goto-if-not-nil
+ 'byte-goto-if-nil)
+ (cdr lap1)))
+ (setcar lap1 (if (eq (car lap1) 'byte-goto-if-nil)
+ 'byte-goto-if-not-nil
+ 'byte-goto-if-nil))
+ (setq lap (delq lap0 lap))
+ (setq keep-going t))
+ ;;
+ ;; goto-X-if-nil goto-Y X: --> goto-Y-if-non-nil X:
+ ;; goto-X-if-non-nil goto-Y X: --> goto-Y-if-nil X:
+ ;;
+ ;; it is wrong to do the same thing for the -else-pop variants.
+ ;;
+ ((and (memq (car lap0)
+ '(byte-goto-if-nil byte-goto-if-not-nil)) ; gotoX
+ (eq 'byte-goto (car lap1)) ; gotoY
+ (eq (cdr lap0) lap2)) ; TAG X
+ (let ((inverse (if (eq 'byte-goto-if-nil (car lap0))
+ 'byte-goto-if-not-nil 'byte-goto-if-nil)))
+ (byte-compile-log-lap " %s %s %s:\t-->\t%s %s:"
+ lap0 lap1 lap2
+ (cons inverse (cdr lap1)) lap2)
+ (setq lap (delq lap0 lap))
+ (setcar lap1 inverse)
+ (setq keep-going t)))
+ ;;
+ ;; const goto-if-* --> whatever
+ ;;
+ ((and (eq 'byte-constant (car lap0))
+ (memq (car lap1) byte-conditional-ops)
+ ;; If the `byte-constant's cdr is not a cons cell, it has
+ ;; to be an index into the constant pool); even though
+ ;; it'll be a constant, that constant is not known yet
+ ;; (it's typically a free variable of a closure, so will
+ ;; only be known when the closure will be built at
+ ;; run-time).
+ (consp (cdr lap0)))
+ (cond ((if (memq (car lap1) '(byte-goto-if-nil
+ byte-goto-if-nil-else-pop))
+ (car (cdr lap0))
+ (not (car (cdr lap0))))
+ (byte-compile-log-lap " %s %s\t-->\t<deleted>"
+ lap0 lap1)
+ (setq rest (cdr rest)
+ lap (delq lap0 (delq lap1 lap))))
+ (t
+ (byte-compile-log-lap " %s %s\t-->\t%s"
+ lap0 lap1
+ (cons 'byte-goto (cdr lap1)))
+ (when (memq (car lap1) byte-goto-always-pop-ops)
+ (setq lap (delq lap0 lap)))
+ (setcar lap1 'byte-goto)))
+ (setq keep-going t))
+ ;;
+ ;; varref-X varref-X --> varref-X dup
+ ;; varref-X [dup ...] varref-X --> varref-X [dup ...] dup
+ ;; stackref-X [dup ...] stackref-X+N --> stackref-X [dup ...] dup
+ ;; We don't optimize the const-X variations on this here,
+ ;; because that would inhibit some goto optimizations; we
+ ;; optimize the const-X case after all other optimizations.
+ ;;
+ ((and (memq (car lap0) '(byte-varref byte-stack-ref))
+ (progn
+ (setq tmp (cdr rest))
+ (setq tmp2 0)
+ (while (eq (car (car tmp)) 'byte-dup)
+ (setq tmp2 (1+ tmp2))
+ (setq tmp (cdr tmp)))
+ t)
+ (eq (if (eq 'byte-stack-ref (car lap0))
+ (+ tmp2 1 (cdr lap0))
+ (cdr lap0))
+ (cdr (car tmp)))
+ (eq (car lap0) (car (car tmp))))
+ (if (memq byte-optimize-log '(t byte))
+ (let ((str ""))
+ (setq tmp2 (cdr rest))
+ (while (not (eq tmp tmp2))
+ (setq tmp2 (cdr tmp2)
+ str (concat str " dup")))
+ (byte-compile-log-lap " %s%s %s\t-->\t%s%s dup"
+ lap0 str lap0 lap0 str)))
+ (setq keep-going t)
+ (setcar (car tmp) 'byte-dup)
+ (setcdr (car tmp) 0)
+ (setq rest tmp))
+ ;;
+ ;; TAG1: TAG2: --> TAG1: <deleted>
+ ;; (and other references to TAG2 are replaced with TAG1)
+ ;;
+ ((and (eq (car lap0) 'TAG)
+ (eq (car lap1) 'TAG))
+ (and (memq byte-optimize-log '(t byte))
+ (byte-compile-log " adjacent tags %d and %d merged"
+ (nth 1 lap1) (nth 1 lap0)))
+ (setq tmp3 lap)
+ (while (setq tmp2 (rassq lap0 tmp3))
+ (setcdr tmp2 lap1)
+ (setq tmp3 (cdr (memq tmp2 tmp3))))
+ (setq lap (delq lap0 lap)
+ keep-going t)
+ ;; replace references to tag in jump tables, if any
+ (dolist (table byte-compile-jump-tables)
+ (maphash #'(lambda (value tag)
+ (when (equal tag lap0)
+ (puthash value lap1 table)))
+ table)))
+ ;;
+ ;; unused-TAG: --> <deleted>
+ ;;
+ ((and (eq 'TAG (car lap0))
+ (not (rassq lap0 lap))
+ ;; make sure this tag isn't used in a jump-table
+ (cl-loop for table in byte-compile-jump-tables
+ when (member lap0 (hash-table-values table))
+ return nil finally return t))
+ (and (memq byte-optimize-log '(t byte))
+ (byte-compile-log " unused tag %d removed" (nth 1 lap0)))
+ (setq lap (delq lap0 lap)
+ keep-going t))
+ ;;
+ ;; goto ... --> goto <delete until TAG or end>
+ ;; return ... --> return <delete until TAG or end>
+ ;; (unless a jump-table is being used, where deleting may affect
+ ;; other valid case bodies)
+ ;;
+ ((and (memq (car lap0) '(byte-goto byte-return))
+ (not (memq (car lap1) '(TAG nil)))
+ ;; FIXME: Instead of deferring simply when jump-tables are
+ ;; being used, keep a list of tags used for switch tags and
+ ;; use them instead (see `byte-compile-inline-lapcode').
+ (not byte-compile-jump-tables))
+ (setq tmp rest)
+ (let ((i 0)
+ (opt-p (memq byte-optimize-log '(t lap)))
+ str deleted)
+ (while (and (setq tmp (cdr tmp))
+ (not (eq 'TAG (car (car tmp)))))
+ (if opt-p (setq deleted (cons (car tmp) deleted)
+ str (concat str " %s")
+ i (1+ i))))
+ (if opt-p
+ (let ((tagstr
+ (if (eq 'TAG (car (car tmp)))
+ (format "%d:" (car (cdr (car tmp))))
+ (or (car tmp) ""))))
+ (if (< i 6)
+ (apply 'byte-compile-log-lap-1
+ (concat " %s" str
+ " %s\t-->\t%s <deleted> %s")
+ lap0
+ (nconc (nreverse deleted)
+ (list tagstr lap0 tagstr)))
+ (byte-compile-log-lap
+ " %s <%d unreachable op%s> %s\t-->\t%s <deleted> %s"
+ lap0 i (if (= i 1) "" "s")
+ tagstr lap0 tagstr))))
+ (rplacd rest tmp))
+ (setq keep-going t))
+ ;;
+ ;; <safe-op> unbind --> unbind <safe-op>
+ ;; (this may enable other optimizations.)
+ ;;
+ ((and (eq 'byte-unbind (car lap1))
+ (memq (car lap0) byte-after-unbind-ops))
+ (byte-compile-log-lap " %s %s\t-->\t%s %s" lap0 lap1 lap1 lap0)
+ (setcar rest lap1)
+ (setcar (cdr rest) lap0)
+ (setq keep-going t))
+ ;;
+ ;; varbind-X unbind-N --> discard unbind-(N-1)
+ ;; save-excursion unbind-N --> unbind-(N-1)
+ ;; save-restriction unbind-N --> unbind-(N-1)
+ ;;
+ ((and (eq 'byte-unbind (car lap1))
+ (memq (car lap0) '(byte-varbind byte-save-excursion
+ byte-save-restriction))
+ (< 0 (cdr lap1)))
+ (if (zerop (setcdr lap1 (1- (cdr lap1))))
+ (delq lap1 rest))
+ (if (eq (car lap0) 'byte-varbind)
+ (setcar rest (cons 'byte-discard 0))
+ (setq lap (delq lap0 lap)))
+ (byte-compile-log-lap " %s %s\t-->\t%s %s"
+ lap0 (cons (car lap1) (1+ (cdr lap1)))
+ (if (eq (car lap0) 'byte-varbind)
+ (car rest)
+ (car (cdr rest)))
+ (if (and (/= 0 (cdr lap1))
+ (eq (car lap0) 'byte-varbind))
+ (car (cdr rest))
+ ""))
+ (setq keep-going t))
+ ;;
+ ;; goto*-X ... X: goto-Y --> goto*-Y
+ ;; goto-X ... X: return --> return
+ ;;
+ ((and (memq (car lap0) byte-goto-ops)
+ (memq (car (setq tmp (nth 1 (memq (cdr lap0) lap))))
+ '(byte-goto byte-return)))
+ (cond ((and (not (eq tmp lap0))
+ (or (eq (car lap0) 'byte-goto)
+ (eq (car tmp) 'byte-goto)))
+ (byte-compile-log-lap " %s [%s]\t-->\t%s"
+ (car lap0) tmp tmp)
+ (if (eq (car tmp) 'byte-return)
+ (setcar lap0 'byte-return))
+ (setcdr lap0 (cdr tmp))
+ (setq keep-going t))))
+ ;;
+ ;; goto-*-else-pop X ... X: goto-if-* --> whatever
+ ;; goto-*-else-pop X ... X: discard --> whatever
+ ;;
+ ((and (memq (car lap0) '(byte-goto-if-nil-else-pop
+ byte-goto-if-not-nil-else-pop))
+ (memq (car (car (setq tmp (cdr (memq (cdr lap0) lap)))))
+ (eval-when-compile
+ (cons 'byte-discard byte-conditional-ops)))
+ (not (eq lap0 (car tmp))))
+ (setq tmp2 (car tmp))
+ (setq tmp3 (assq (car lap0) '((byte-goto-if-nil-else-pop
+ byte-goto-if-nil)
+ (byte-goto-if-not-nil-else-pop
+ byte-goto-if-not-nil))))
+ (if (memq (car tmp2) tmp3)
+ (progn (setcar lap0 (car tmp2))
+ (setcdr lap0 (cdr tmp2))
+ (byte-compile-log-lap " %s-else-pop [%s]\t-->\t%s"
+ (car lap0) tmp2 lap0))
+ ;; Get rid of the -else-pop's and jump one step further.
+ (or (eq 'TAG (car (nth 1 tmp)))
+ (setcdr tmp (cons (byte-compile-make-tag)
+ (cdr tmp))))
+ (byte-compile-log-lap " %s [%s]\t-->\t%s <skip>"
+ (car lap0) tmp2 (nth 1 tmp3))
+ (setcar lap0 (nth 1 tmp3))
+ (setcdr lap0 (nth 1 tmp)))
+ (setq keep-going t))
+ ;;
+ ;; const goto-X ... X: goto-if-* --> whatever
+ ;; const goto-X ... X: discard --> whatever
+ ;;
+ ((and (eq (car lap0) 'byte-constant)
+ (eq (car lap1) 'byte-goto)
+ (memq (car (car (setq tmp (cdr (memq (cdr lap1) lap)))))
+ (eval-when-compile
+ (cons 'byte-discard byte-conditional-ops)))
+ (not (eq lap1 (car tmp))))
+ (setq tmp2 (car tmp))
+ (cond ((when (consp (cdr lap0))
+ (memq (car tmp2)
+ (if (null (car (cdr lap0)))
+ '(byte-goto-if-nil byte-goto-if-nil-else-pop)
+ '(byte-goto-if-not-nil
+ byte-goto-if-not-nil-else-pop))))
+ (byte-compile-log-lap " %s goto [%s]\t-->\t%s %s"
+ lap0 tmp2 lap0 tmp2)
+ (setcar lap1 (car tmp2))
+ (setcdr lap1 (cdr tmp2))
+ ;; Let next step fix the (const,goto-if*) sequence.
+ (setq rest (cons nil rest))
+ (setq keep-going t))
+ ((or (consp (cdr lap0))
+ (eq (car tmp2) 'byte-discard))
+ ;; Jump one step further
+ (byte-compile-log-lap
+ " %s goto [%s]\t-->\t<deleted> goto <skip>"
+ lap0 tmp2)
(or (eq 'TAG (car (nth 1 tmp)))
(setcdr tmp (cons (byte-compile-make-tag)
(cdr tmp))))
- (byte-compile-log-lap " %s [%s]\t-->\t%s <skip>"
- (car lap0) tmp2 (nth 1 tmp3))
- (setcar lap0 (nth 1 tmp3))
- (setcdr lap0 (nth 1 tmp)))
- (setq keep-going t))
- ;;
- ;; const goto-X ... X: goto-if-* --> whatever
- ;; const goto-X ... X: discard --> whatever
- ;;
- ((and (eq (car lap0) 'byte-constant)
- (eq (car lap1) 'byte-goto)
- (memq (car (car (setq tmp (cdr (memq (cdr lap1) lap)))))
- (eval-when-compile
- (cons 'byte-discard byte-conditional-ops)))
- (not (eq lap1 (car tmp))))
- (setq tmp2 (car tmp))
- (cond ((when (consp (cdr lap0))
- (memq (car tmp2)
- (if (null (car (cdr lap0)))
- '(byte-goto-if-nil byte-goto-if-nil-else-pop)
- '(byte-goto-if-not-nil
- byte-goto-if-not-nil-else-pop))))
- (byte-compile-log-lap " %s goto [%s]\t-->\t%s %s"
- lap0 tmp2 lap0 tmp2)
- (setcar lap1 (car tmp2))
- (setcdr lap1 (cdr tmp2))
- ;; Let next step fix the (const,goto-if*) sequence.
- (setq rest (cons nil rest))
- (setq keep-going t))
- ((or (consp (cdr lap0))
- (eq (car tmp2) 'byte-discard))
- ;; Jump one step further
- (byte-compile-log-lap
- " %s goto [%s]\t-->\t<deleted> goto <skip>"
- lap0 tmp2)
- (or (eq 'TAG (car (nth 1 tmp)))
- (setcdr tmp (cons (byte-compile-make-tag)
- (cdr tmp))))
- (setcdr lap1 (car (cdr tmp)))
- (setq lap (delq lap0 lap))
- (setq keep-going t))))
- ;;
- ;; X: varref-Y ... varset-Y goto-X -->
- ;; X: varref-Y Z: ... dup varset-Y goto-Z
- ;; (varset-X goto-BACK, BACK: varref-X --> copy the varref down.)
- ;; (This is so usual for while loops that it is worth handling).
- ;;
- ;; Here again, we could do it for stack-ref/stack-set, but
- ;; that's replacing a stack-ref-Y with a stack-ref-0, which
- ;; is a very minor improvement (if any), at the cost of
- ;; more stack use and more byte-code. Let's not do it.
- ;;
- ((and (eq (car lap1) 'byte-varset)
- (eq (car lap2) 'byte-goto)
- (not (memq (cdr lap2) rest)) ;Backwards jump
- (eq (car (car (setq tmp (cdr (memq (cdr lap2) lap)))))
- 'byte-varref)
- (eq (cdr (car tmp)) (cdr lap1))
- (not (memq (car (cdr lap1)) byte-boolean-vars)))
- ;;(byte-compile-log-lap " Pulled %s to end of loop" (car tmp))
- (let ((newtag (byte-compile-make-tag)))
- (byte-compile-log-lap
- " %s: %s ... %s %s\t-->\t%s: %s %s: ... %s %s %s"
- (nth 1 (cdr lap2)) (car tmp)
- lap1 lap2
- (nth 1 (cdr lap2)) (car tmp)
- (nth 1 newtag) 'byte-dup lap1
- (cons 'byte-goto newtag)
- )
- (setcdr rest (cons (cons 'byte-dup 0) (cdr rest)))
- (setcdr tmp (cons (setcdr lap2 newtag) (cdr tmp))))
- (setq add-depth 1)
- (setq keep-going t))
- ;;
- ;; goto-X Y: ... X: goto-if*-Y --> goto-if-not-*-X+1 Y:
- ;; (This can pull the loop test to the end of the loop)
- ;;
- ((and (eq (car lap0) 'byte-goto)
- (eq (car lap1) 'TAG)
- (eq lap1
- (cdr (car (setq tmp (cdr (memq (cdr lap0) lap))))))
- (memq (car (car tmp))
- '(byte-goto byte-goto-if-nil byte-goto-if-not-nil
- byte-goto-if-nil-else-pop)))
-;; (byte-compile-log-lap " %s %s, %s %s --> moved conditional"
-;; lap0 lap1 (cdr lap0) (car tmp))
- (let ((newtag (byte-compile-make-tag)))
- (byte-compile-log-lap
- "%s %s: ... %s: %s\t-->\t%s ... %s:"
- lap0 (nth 1 lap1) (nth 1 (cdr lap0)) (car tmp)
- (cons (cdr (assq (car (car tmp))
- '((byte-goto-if-nil . byte-goto-if-not-nil)
- (byte-goto-if-not-nil . byte-goto-if-nil)
- (byte-goto-if-nil-else-pop .
- byte-goto-if-not-nil-else-pop)
- (byte-goto-if-not-nil-else-pop .
- byte-goto-if-nil-else-pop))))
- newtag)
-
- (nth 1 newtag)
- )
- (setcdr tmp (cons (setcdr lap0 newtag) (cdr tmp)))
- (if (eq (car (car tmp)) 'byte-goto-if-nil-else-pop)
- ;; We can handle this case but not the -if-not-nil case,
- ;; because we won't know which non-nil constant to push.
- (setcdr rest (cons (cons 'byte-constant
- (byte-compile-get-constant nil))
- (cdr rest))))
- (setcar lap0 (nth 1 (memq (car (car tmp))
- '(byte-goto-if-nil-else-pop
- byte-goto-if-not-nil
- byte-goto-if-nil
- byte-goto-if-not-nil
- byte-goto byte-goto))))
- )
- (setq keep-going t))
- )
+ (setcdr lap1 (car (cdr tmp)))
+ (setq lap (delq lap0 lap))
+ (setq keep-going t))))
+ ;;
+ ;; X: varref-Y ... varset-Y goto-X -->
+ ;; X: varref-Y Z: ... dup varset-Y goto-Z
+ ;; (varset-X goto-BACK, BACK: varref-X --> copy the varref down.)
+ ;; (This is so usual for while loops that it is worth handling).
+ ;;
+ ;; Here again, we could do it for stack-ref/stack-set, but
+ ;; that's replacing a stack-ref-Y with a stack-ref-0, which
+ ;; is a very minor improvement (if any), at the cost of
+ ;; more stack use and more byte-code. Let's not do it.
+ ;;
+ ((and (eq (car lap1) 'byte-varset)
+ (eq (car lap2) 'byte-goto)
+ (not (memq (cdr lap2) rest)) ;Backwards jump
+ (eq (car (car (setq tmp (cdr (memq (cdr lap2) lap)))))
+ 'byte-varref)
+ (eq (cdr (car tmp)) (cdr lap1))
+ (not (memq (car (cdr lap1)) byte-boolean-vars)))
+ ;;(byte-compile-log-lap " Pulled %s to end of loop" (car tmp))
+ (let ((newtag (byte-compile-make-tag)))
+ (byte-compile-log-lap
+ " %s: %s ... %s %s\t-->\t%s: %s %s: ... %s %s %s"
+ (nth 1 (cdr lap2)) (car tmp)
+ lap1 lap2
+ (nth 1 (cdr lap2)) (car tmp)
+ (nth 1 newtag) 'byte-dup lap1
+ (cons 'byte-goto newtag)
+ )
+ (setcdr rest (cons (cons 'byte-dup 0) (cdr rest)))
+ (setcdr tmp (cons (setcdr lap2 newtag) (cdr tmp))))
+ (setq add-depth 1)
+ (setq keep-going t))
+ ;;
+ ;; goto-X Y: ... X: goto-if*-Y --> goto-if-not-*-X+1 Y:
+ ;; (This can pull the loop test to the end of the loop)
+ ;;
+ ((and (eq (car lap0) 'byte-goto)
+ (eq (car lap1) 'TAG)
+ (eq lap1
+ (cdr (car (setq tmp (cdr (memq (cdr lap0) lap))))))
+ (memq (car (car tmp))
+ '(byte-goto byte-goto-if-nil byte-goto-if-not-nil
+ byte-goto-if-nil-else-pop)))
+ ;; (byte-compile-log-lap " %s %s, %s %s --> moved conditional"
+ ;; lap0 lap1 (cdr lap0) (car tmp))
+ (let ((newtag (byte-compile-make-tag)))
+ (byte-compile-log-lap
+ "%s %s: ... %s: %s\t-->\t%s ... %s:"
+ lap0 (nth 1 lap1) (nth 1 (cdr lap0)) (car tmp)
+ (cons (cdr (assq (car (car tmp))
+ '((byte-goto-if-nil . byte-goto-if-not-nil)
+ (byte-goto-if-not-nil . byte-goto-if-nil)
+ (byte-goto-if-nil-else-pop .
+ byte-goto-if-not-nil-else-pop)
+ (byte-goto-if-not-nil-else-pop .
+ byte-goto-if-nil-else-pop))))
+ newtag)
+
+ (nth 1 newtag)
+ )
+ (setcdr tmp (cons (setcdr lap0 newtag) (cdr tmp)))
+ (if (eq (car (car tmp)) 'byte-goto-if-nil-else-pop)
+ ;; We can handle this case but not the -if-not-nil case,
+ ;; because we won't know which non-nil constant to push.
+ (setcdr rest (cons (cons 'byte-constant
+ (byte-compile-get-constant nil))
+ (cdr rest))))
+ (setcar lap0 (nth 1 (memq (car (car tmp))
+ '(byte-goto-if-nil-else-pop
+ byte-goto-if-not-nil
+ byte-goto-if-nil
+ byte-goto-if-not-nil
+ byte-goto byte-goto))))
+ )
+ (setq keep-going t))
+
+ ;;
+ ;; stack-set-M [discard/discardN ...] --> discardN-preserve-tos
+ ;; stack-set-M [discard/discardN ...] --> discardN
+ ;;
+ ((and (eq (car lap0) 'byte-stack-set)
+ (memq (car lap1) '(byte-discard byte-discardN))
+ (progn
+ ;; See if enough discard operations follow to expose or
+ ;; destroy the value stored by the stack-set.
+ (setq tmp (cdr rest))
+ (setq tmp2 (1- (cdr lap0)))
+ (setq tmp3 0)
+ (while (memq (car (car tmp)) '(byte-discard byte-discardN))
+ (setq tmp3
+ (+ tmp3 (if (eq (car (car tmp)) 'byte-discard)
+ 1
+ (cdr (car tmp)))))
+ (setq tmp (cdr tmp)))
+ (>= tmp3 tmp2)))
+ ;; Do the optimization.
+ (setq lap (delq lap0 lap))
+ (setcar lap1
+ (if (= tmp2 tmp3)
+ ;; The value stored is the new TOS, so pop one more
+ ;; value (to get rid of the old value) using the
+ ;; TOS-preserving discard operator.
+ 'byte-discardN-preserve-tos
+ ;; Otherwise, the value stored is lost, so just use a
+ ;; normal discard.
+ 'byte-discardN))
+ (setcdr lap1 (1+ tmp3))
+ (setcdr (cdr rest) tmp)
+ (byte-compile-log-lap " %s [discard/discardN]...\t-->\t%s"
+ lap0 lap1))
+
+ ;;
+ ;; discardN-preserve-tos return --> return
+ ;; dup return --> return
+ ;; stack-set-N return --> return ; where N is TOS-1
+ ;;
+ ((and (eq (car lap1) 'byte-return)
+ (or (memq (car lap0) '(byte-discardN-preserve-tos byte-dup))
+ (and (eq (car lap0) 'byte-stack-set)
+ (= (cdr lap0) 1))))
+ (setq keep-going t)
+ ;; The byte-code interpreter will pop the stack for us, so
+ ;; we can just leave stuff on it.
+ (setq lap (delq lap0 lap))
+ (byte-compile-log-lap " %s %s\t-->\t%s" lap0 lap1 lap1))
+
+ ;;
+ ;; goto-X ... X: discard ==> discard goto-Y ... X: discard Y:
+ ;;
+ ((and (eq (car lap0) 'byte-goto)
+ (setq tmp (cdr (memq (cdr lap0) lap)))
+ (memq (caar tmp) '(byte-discard byte-discardN
+ byte-discardN-preserve-tos)))
+ (byte-compile-log-lap
+ " goto-X .. X: \t-->\t%s goto-X.. X: %s Y:"
+ (car tmp) (car tmp))
+ (setq keep-going t)
+ (let* ((newtag (byte-compile-make-tag))
+ ;; Make a copy, since we sometimes modify insts in-place!
+ (newdiscard (cons (caar tmp) (cdar tmp)))
+ (newjmp (cons (car lap0) newtag)))
+ (push newtag (cdr tmp)) ;Push new tag after the discard.
+ (setcar rest newdiscard)
+ (push newjmp (cdr rest))))
+
+ ;;
+ ;; const discardN-preserve-tos ==> discardN const
+ ;;
+ ((and (eq (car lap0) 'byte-constant)
+ (eq (car lap1) 'byte-discardN-preserve-tos))
+ (setq keep-going t)
+ (let ((newdiscard (cons 'byte-discardN (cdr lap1))))
+ (byte-compile-log-lap
+ " %s %s\t-->\t%s %s" lap0 lap1 newdiscard lap0)
+ (setf (car rest) newdiscard)
+ (setf (cadr rest) lap0)))
+ )
(setq rest (cdr rest)))
)
;; Cleanup stage:
@@ -2085,41 +2168,6 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
(setcdr lap1 (+ (cdr lap1) (cdr lap0))))
;;
- ;; stack-set-M [discard/discardN ...] --> discardN-preserve-tos
- ;; stack-set-M [discard/discardN ...] --> discardN
- ;;
- ((and (eq (car lap0) 'byte-stack-set)
- (memq (car lap1) '(byte-discard byte-discardN))
- (progn
- ;; See if enough discard operations follow to expose or
- ;; destroy the value stored by the stack-set.
- (setq tmp (cdr rest))
- (setq tmp2 (1- (cdr lap0)))
- (setq tmp3 0)
- (while (memq (car (car tmp)) '(byte-discard byte-discardN))
- (setq tmp3
- (+ tmp3 (if (eq (car (car tmp)) 'byte-discard)
- 1
- (cdr (car tmp)))))
- (setq tmp (cdr tmp)))
- (>= tmp3 tmp2)))
- ;; Do the optimization.
- (setq lap (delq lap0 lap))
- (setcar lap1
- (if (= tmp2 tmp3)
- ;; The value stored is the new TOS, so pop one more
- ;; value (to get rid of the old value) using the
- ;; TOS-preserving discard operator.
- 'byte-discardN-preserve-tos
- ;; Otherwise, the value stored is lost, so just use a
- ;; normal discard.
- 'byte-discardN))
- (setcdr lap1 (1+ tmp3))
- (setcdr (cdr rest) tmp)
- (byte-compile-log-lap " %s [discard/discardN]...\t-->\t%s"
- lap0 lap1))
-
- ;;
;; discard/discardN/discardN-preserve-tos-X discard/discardN-Y -->
;; discardN-(X+Y)
;;
@@ -2146,20 +2194,6 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
(setq lap (delq lap0 lap))
(setcdr lap1 (+ (cdr lap0) (cdr lap1)))
(byte-compile-log-lap " %s %s\t-->\t%s" lap0 lap1 (car rest)))
-
- ;;
- ;; discardN-preserve-tos return --> return
- ;; dup return --> return
- ;; stack-set-N return --> return ; where N is TOS-1
- ;;
- ((and (eq (car lap1) 'byte-return)
- (or (memq (car lap0) '(byte-discardN-preserve-tos byte-dup))
- (and (eq (car lap0) 'byte-stack-set)
- (= (cdr lap0) 1))))
- ;; The byte-code interpreter will pop the stack for us, so
- ;; we can just leave stuff on it.
- (setq lap (delq lap0 lap))
- (byte-compile-log-lap " %s %s\t-->\t%s" lap0 lap1 lap1))
)
(setq rest (cdr rest)))
(setq byte-compile-maxdepth (+ byte-compile-maxdepth add-depth)))
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index 0f8dd5a2842..88f362d24f0 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -232,8 +232,11 @@ The return value is undefined.
#'(lambda (x)
(let ((f (cdr (assq (car x) macro-declarations-alist))))
(if f (apply (car f) name arglist (cdr x))
- (message "Warning: Unknown macro property %S in %S"
- (car x) name))))
+ (macroexp--warn-and-return
+ (format-message
+ "Unknown macro property %S in %S"
+ (car x) name)
+ nil))))
decls)))
;; Refresh font-lock if this is a new macro, or it is an
;; existing macro whose 'no-font-lock-keyword declaration
@@ -301,9 +304,12 @@ The return value is undefined.
(cdr body)
body)))
nil)
- (t (message "Warning: Unknown defun property `%S' in %S"
- (car x) name)))))
- decls))
+ (t
+ (macroexp--warn-and-return
+ (format-message "Unknown defun property `%S' in %S"
+ (car x) name)
+ nil)))))
+ decls))
(def (list 'defalias
(list 'quote name)
(list 'function
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 360da6b6ba6..9429d6a0d5d 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -2505,7 +2505,8 @@ list that represents a doc string reference.
(when (memq sym byte-compile-lexical-variables)
(setq byte-compile-lexical-variables
(delq sym byte-compile-lexical-variables))
- (byte-compile-warn "Variable `%S' declared after its first use" sym))
+ (when (byte-compile-warning-enabled-p 'lexical sym)
+ (byte-compile-warn "Variable `%S' declared after its first use" sym)))
(push sym byte-compile-bound-variables)
(push sym byte-compile--seen-defvars))
diff --git a/lisp/emacs-lisp/chart.el b/lisp/emacs-lisp/chart.el
index 2cd73225ff3..7d760ffc57f 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 2e204ff7aea..9722792a5a5 100644
--- a/lisp/emacs-lisp/checkdoc.el
+++ b/lisp/emacs-lisp/checkdoc.el
@@ -241,7 +241,12 @@ system. Possible values are:
defun - Spell-check when style checking a single defun.
buffer - Spell-check when style checking the whole buffer.
interactive - Spell-check during any interactive check.
- t - Always spell-check."
+ t - Always spell-check.
+
+There is a list of Lisp-specific words which checkdoc will
+install into Ispell on the fly, but only if Ispell is not already
+running. Use `ispell-kill-ispell' to make checkdoc restart it
+with these words enabled."
:type '(choice (const nil)
(const defun)
(const buffer)
@@ -2357,7 +2362,9 @@ Code:, and others referenced in the style guide."
(checkdoc-create-error
(format "The footer should be: (provide '%s)\\n;;; %s%s ends here"
fn fn fe)
- (1- (point-max)) (point-max)))))
+ ;; The buffer may be empty.
+ (max (point-min) (1- (point-max)))
+ (point-max)))))
err))
;; The below checks will not return errors if the user says NO
diff --git a/lisp/emacs-lisp/crm.el b/lisp/emacs-lisp/crm.el
index eb3193c8213..e106815817e 100644
--- a/lisp/emacs-lisp/crm.el
+++ b/lisp/emacs-lisp/crm.el
@@ -1,4 +1,4 @@
-;;; crm.el --- read multiple strings with completion
+;;; crm.el --- read multiple strings with completion -*- lexical-binding: t; -*-
;; Copyright (C) 1985-1986, 1993-2021 Free Software Foundation, Inc.
diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el
index 42528429aaf..54528b2fb91 100644
--- a/lisp/emacs-lisp/derived.el
+++ b/lisp/emacs-lisp/derived.el
@@ -1,4 +1,4 @@
-;;; derived.el --- allow inheritance of major modes
+;;; derived.el --- allow inheritance of major modes -*- lexical-binding: t; -*-
;; (formerly mode-clone.el)
;; Copyright (C) 1993-1994, 1999, 2001-2021 Free Software Foundation,
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index f4dbcee4d69..54c0cf08b78 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.
@@ -453,8 +452,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)
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index 1ded0e7b097..84191af88cc 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -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
diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el
index edf4d34b649..e65f424cbab 100644
--- a/lisp/emacs-lisp/eieio-opt.el
+++ b/lisp/emacs-lisp/eieio-opt.el
@@ -1,4 +1,4 @@
-;;; eieio-opt.el -- eieio optional functions (debug, printing, speedbar)
+;;; eieio-opt.el -- eieio optional functions (debug, printing, speedbar) -*- lexical-binding: t; -*-
;; Copyright (C) 1996, 1998-2003, 2005, 2008-2021 Free Software
;; Foundation, Inc.
diff --git a/lisp/emacs-lisp/generic.el b/lisp/emacs-lisp/generic.el
index 93f780eac2f..294aba66c3a 100644
--- a/lisp/emacs-lisp/generic.el
+++ b/lisp/emacs-lisp/generic.el
@@ -1,4 +1,4 @@
-;;; generic.el --- defining simple major modes with comment and font-lock
+;;; generic.el --- defining simple major modes with comment and font-lock -*- lexical-binding: t; -*-
;;
;; Copyright (C) 1997, 1999, 2001-2021 Free Software Foundation, Inc.
;;
@@ -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
@@ -245,7 +244,6 @@ Some generic modes are defined in `generic-x.el'."
"Set up comment functionality for generic mode."
(let ((chars nil)
(comstyles)
- (comstyle "")
(comment-start nil))
;; Go through all the comments.
@@ -269,14 +267,16 @@ Some generic modes are defined in `generic-x.el'."
;; Store the relevant info but don't update yet.
(push (cons c0 (concat (cdr (assoc c0 chars)) "1")) chars)
(push (cons c1 (concat (cdr (assoc c1 chars))
- (concat "2" comstyle))) chars)))
+ (concat "2" comstyle)))
+ chars)))
(if (= (length end) 1)
(modify-syntax-entry (aref end 0)
(concat ">" comstyle) st)
(let ((c0 (aref end 0)) (c1 (aref end 1)))
;; Store the relevant info but don't update yet.
(push (cons c0 (concat (cdr (assoc c0 chars))
- (concat "3" comstyle))) chars)
+ (concat "3" comstyle)))
+ chars)
(push (cons c1 (concat (cdr (assoc c1 chars)) "4")) chars)))))
;; Process the chars that were part of a 2-char comment marker
diff --git a/lisp/emacs-lisp/helper.el b/lisp/emacs-lisp/helper.el
index 737f3ec2f33..a5f21a55924 100644
--- a/lisp/emacs-lisp/helper.el
+++ b/lisp/emacs-lisp/helper.el
@@ -1,4 +1,4 @@
-;;; helper.el --- utility help package supporting help in electric modes
+;;; helper.el --- utility help package supporting help in electric modes -*- lexical-binding: t; -*-
;; Copyright (C) 1985, 2001-2021 Free Software Foundation, Inc.
@@ -39,20 +39,19 @@
;; keymap either.
-(defvar Helper-help-map nil)
-(if Helper-help-map
- nil
- (setq Helper-help-map (make-keymap))
- ;(fillarray Helper-help-map 'undefined)
- (define-key Helper-help-map "m" 'Helper-describe-mode)
- (define-key Helper-help-map "b" 'Helper-describe-bindings)
- (define-key Helper-help-map "c" 'Helper-describe-key-briefly)
- (define-key Helper-help-map "k" 'Helper-describe-key)
- ;(define-key Helper-help-map "f" 'Helper-describe-function)
- ;(define-key Helper-help-map "v" 'Helper-describe-variable)
- (define-key Helper-help-map "?" 'Helper-help-options)
- (define-key Helper-help-map (char-to-string help-char) 'Helper-help-options)
- (fset 'Helper-help-map Helper-help-map))
+(defvar Helper-help-map
+ (let ((map (make-sparse-keymap)))
+ ;(fillarray map 'undefined)
+ (define-key map "m" 'Helper-describe-mode)
+ (define-key map "b" 'Helper-describe-bindings)
+ (define-key map "c" 'Helper-describe-key-briefly)
+ (define-key map "k" 'Helper-describe-key)
+ ;(define-key map "f" 'Helper-describe-function)
+ ;(define-key map "v" 'Helper-describe-variable)
+ (define-key map "?" 'Helper-help-options)
+ (define-key map (char-to-string help-char) 'Helper-help-options)
+ (fset 'Helper-help-map map)
+ map))
(defun Helper-help-scroller ()
(let ((blurb (or (and (boundp 'Helper-return-blurb)
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 8780c5dcd30..c96d849d442 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -201,41 +201,53 @@
(defun lisp--el-non-funcall-position-p (pos)
"Heuristically determine whether POS is an evaluated position."
+ (declare (obsolete lisp--el-funcall-position-p "28.1"))
+ (not (lisp--el-funcall-position-p pos)))
+
+(defun lisp--el-funcall-position-p (pos)
+ "Heuristically determine whether POS is an evaluated position."
(save-match-data
(save-excursion
(ignore-errors
(goto-char pos)
;; '(lambda ..) is not a funcall position, but #'(lambda ...) is.
- (or (and (eql (char-before) ?\')
- (not (eql (char-before (1- (point))) ?#)))
- (let* ((ppss (syntax-ppss))
- (paren-posns (nth 9 ppss))
- (parent
- (when paren-posns
- (goto-char (car (last paren-posns))) ;(up-list -1)
- (cond
- ((ignore-errors
- (and (eql (char-after) ?\()
- (when (cdr paren-posns)
- (goto-char (car (last paren-posns 2)))
- (looking-at "(\\_<let\\*?\\_>"))))
- (goto-char (match-end 0))
- 'let)
- ((looking-at
- (rx "("
- (group-n 1 (+ (or (syntax w) (syntax _))))
- symbol-end))
- (prog1 (intern-soft (match-string-no-properties 1))
- (goto-char (match-end 1))))))))
- (or (eq parent 'declare)
- (and (eq parent 'let)
- (progn
- (forward-sexp 1)
- (< pos (point))))
- (and (eq parent 'condition-case)
- (progn
- (forward-sexp 2)
- (< (point) pos))))))))))
+ (if (eql (char-before) ?\')
+ (eql (char-before (1- (point))) ?#)
+ (let* ((ppss (syntax-ppss))
+ (paren-posns (nth 9 ppss))
+ (parent
+ (when paren-posns
+ (goto-char (car (last paren-posns))) ;(up-list -1)
+ (cond
+ ((ignore-errors
+ (and (eql (char-after) ?\()
+ (when (cdr paren-posns)
+ (goto-char (car (last paren-posns 2)))
+ (looking-at "(\\_<let\\*?\\_>"))))
+ (goto-char (match-end 0))
+ 'let)
+ ((looking-at
+ (rx "("
+ (group-n 1 (+ (or (syntax w) (syntax _))))
+ symbol-end))
+ (prog1 (intern-soft (match-string-no-properties 1))
+ (goto-char (match-end 1))))))))
+ (pcase parent
+ ('declare nil)
+ ('let
+ (forward-sexp 1)
+ (>= pos (point)))
+ ('condition-case
+ ;; If (cdr paren-posns), then we're in the BODY
+ ;; of HANDLERS.
+ (or (cdr paren-posns)
+ (progn
+ (forward-sexp 1)
+ ;; If we're in the second form, then we're in
+ ;; a funcall position.
+ (< (point) pos (progn (forward-sexp 1)
+ (point))))))
+ (_ t))))))))
(defun lisp--el-match-keyword (limit)
;; FIXME: Move to elisp-mode.el.
@@ -245,11 +257,9 @@
(concat "(\\(" lisp-mode-symbol-regexp "\\)\\_>"))
limit t)
(let ((sym (intern-soft (match-string 1))))
- (when (or (special-form-p sym)
- (and (macrop sym)
- (not (get sym 'no-font-lock-keyword))
- (not (lisp--el-non-funcall-position-p
- (match-beginning 0)))))
+ (when (and (or (special-form-p sym) (macrop sym))
+ (not (get sym 'no-font-lock-keyword))
+ (lisp--el-funcall-position-p (match-beginning 0)))
(throw 'found t))))))
(defmacro let-when-compile (bindings &rest body)
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index 37844977f8f..e842222b7c3 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -127,7 +127,7 @@ and also to avoid outputting the warning during normal execution."
(cond
((null msg) form)
((macroexp--compiling-p)
- (if (gethash form macroexp--warned)
+ (if (and (consp form) (gethash form macroexp--warned))
;; Already wrapped this exp with a warning: avoid inf-looping
;; where we keep adding the same warning onto `form' because
;; macroexpand-all gets right back to macroexpanding `form'.
@@ -138,9 +138,10 @@ and also to avoid outputting the warning during normal execution."
,form)))
(t
(unless compile-only
- (message "%s%s" (if (stringp load-file-name)
- (concat (file-relative-name load-file-name) ": ")
- "")
+ (message "%sWarning: %s"
+ (if (stringp load-file-name)
+ (concat (file-relative-name load-file-name) ": ")
+ "")
msg))
form))))
@@ -180,8 +181,9 @@ and also to avoid outputting the warning during normal execution."
(defun macroexp-macroexpand (form env)
"Like `macroexpand' but checking obsolescence."
- (let ((new-form
- (macroexpand form env)))
+ (let* ((macroexpand-all-environment env)
+ (new-form
+ (macroexpand form env)))
(if (and (not (eq form new-form)) ;It was a macro call.
(car-safe form)
(symbolp (car form))
@@ -239,9 +241,22 @@ Assumes the caller has bound `macroexpand-all-environment'."
form))
(`(,(and fun `(lambda . ,_)) . ,args)
;; Embedded lambda in function position.
- (macroexp--cons (macroexp--all-forms fun 2)
- (macroexp--all-forms args)
- form))
+ ;; If the byte-optimizer is loaded, try to unfold this,
+ ;; 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))
+ ;; Unfolding failed for some reason, avoid infinite recursion.
+ (macroexp--cons (macroexp--all-forms fun 2)
+ (macroexp--all-forms args)
+ form)
+ (macroexp--expand-all newform))))
+
;; The following few cases are for normal function calls that
;; are known to funcall one of their arguments. The byte
;; compiler has traditionally handled these functions specially
@@ -255,17 +270,21 @@ Assumes the caller has bound `macroexpand-all-environment'."
(macroexp--warn-and-return
(format "%s quoted with ' rather than with #'"
(list 'lambda (nth 1 f) '...))
- (macroexp--expand-all `(,fun ,f . ,args))))
+ (macroexp--expand-all `(,fun #',f . ,args))))
;; Second arg is a function:
(`(,(and fun (or 'sort)) ,arg1 ',(and f `(lambda . ,_)) . ,args)
(macroexp--warn-and-return
(format "%s quoted with ' rather than with #'"
(list 'lambda (nth 1 f) '...))
- (macroexp--expand-all `(,fun ,arg1 ,f . ,args))))
- (`(funcall #',(and f (pred symbolp)) . ,args)
- ;; Rewrite (funcall #'foo bar) to (foo bar), in case `foo'
- ;; has a compiler-macro.
- (macroexp--expand-all `(,f . ,args)))
+ (macroexp--expand-all `(,fun ,arg1 #',f . ,args))))
+ (`(funcall ,exp . ,args)
+ (let ((eexp (macroexp--expand-all exp))
+ (eargs (macroexp--all-forms args)))
+ ;; Rewrite (funcall #'foo bar) to (foo bar), in case `foo'
+ ;; has a compiler-macro, or to unfold it.
+ (pcase eexp
+ (`#',f (macroexp--expand-all `(,f . ,eargs)))
+ (_ `(funcall ,eexp . ,eargs)))))
(`(,func . ,_)
;; Macro expand compiler macros. This cannot be delayed to
;; byte-optimize-form because the output of the compiler-macro can
@@ -358,12 +377,12 @@ Never returns an empty list."
(t
`(cond (,test ,@(macroexp-unprogn then))
(,(nth 1 else) ,@(macroexp-unprogn (nth 2 else)))
- (t ,@(nthcdr 3 else))))))
+ ,@(let ((def (nthcdr 3 else))) (if def `((t ,@def))))))))
((eq (car-safe else) 'cond)
`(cond (,test ,@(macroexp-unprogn then)) ,@(cdr else)))
;; Invert the test if that lets us reduce the depth of the tree.
((memq (car-safe then) '(if cond)) (macroexp-if `(not ,test) else then))
- (t `(if ,test ,then ,@(macroexp-unprogn else)))))
+ (t `(if ,test ,then ,@(if else (macroexp-unprogn else))))))
(defmacro macroexp-let2 (test sym exp &rest body)
"Evaluate BODY with SYM bound to an expression for EXP's value.
diff --git a/lisp/emacs-lisp/package-x.el b/lisp/emacs-lisp/package-x.el
index 8a0853ce445..b723643ffb9 100644
--- a/lisp/emacs-lisp/package-x.el
+++ b/lisp/emacs-lisp/package-x.el
@@ -1,4 +1,4 @@
-;;; package-x.el --- Package extras
+;;; package-x.el --- Package extras -*- lexical-binding: t; -*-
;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index ffde396e94a..ccd52aa7b33 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -3261,9 +3261,9 @@ To unhide a package, type
`\\[customize-variable] RET package-hidden-regexps'.
Type \\[package-menu-toggle-hiding] to toggle package hiding."
+ (declare (interactive-only "change `package-hidden-regexps' instead."))
(interactive)
(package--ensure-package-menu-mode)
- (declare (interactive-only "change `package-hidden-regexps' instead."))
(let* ((name (when (derived-mode-p 'package-menu-mode)
(concat "\\`" (regexp-quote (symbol-name (package-desc-name
(tabulated-list-get-id))))
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index bfd577c5d14..cf129c453ec 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -683,11 +683,6 @@ A and B can be one of:
;; and catch at least the easy cases such as (bug#14773).
(not (macroexp--fgrep (mapcar #'car vars) (cadr upat)))))
'(:pcase--succeed . :pcase--fail))
- ;; In case UPAT is of the form (pred (not PRED))
- ((and (eq 'pred (car upat)) (eq 'not (car-safe (cadr upat))))
- (let* ((test (cadr (cadr upat)))
- (res (pcase--split-pred vars `(pred ,test) pat)))
- (cons (cdr res) (car res))))
;; In case PAT is of the form (pred (not PRED))
((and (eq 'pred (car-safe pat)) (eq 'not (car-safe (cadr pat))))
(let* ((test (cadr (cadr pat)))
@@ -696,19 +691,34 @@ A and B can be one of:
((eq x :pcase--fail) :pcase--succeed)))))
(cons (funcall reverse (car res))
(funcall reverse (cdr res)))))
- ((and (eq 'pred (car upat))
- (let ((otherpred
- (cond ((eq 'pred (car-safe pat)) (cadr pat))
- ((not (eq 'quote (car-safe pat))) nil)
- ((consp (cadr pat)) #'consp)
- ((stringp (cadr pat)) #'stringp)
- ((vectorp (cadr pat)) #'vectorp)
- ((byte-code-function-p (cadr pat))
- #'byte-code-function-p))))
- (pcase--mutually-exclusive-p (cadr upat) otherpred)))
+ ;; All the rest below presumes UPAT is of the form (pred ...).
+ ((not (eq 'pred (car upat))) nil)
+ ;; In case UPAT is of the form (pred (not PRED))
+ ((eq 'not (car-safe (cadr upat)))
+ (let* ((test (cadr (cadr upat)))
+ (res (pcase--split-pred vars `(pred ,test) pat)))
+ (cons (cdr res) (car res))))
+ ((let ((otherpred
+ (cond ((eq 'pred (car-safe pat)) (cadr pat))
+ ((not (eq 'quote (car-safe pat))) nil)
+ ((consp (cadr pat)) #'consp)
+ ((stringp (cadr pat)) #'stringp)
+ ((vectorp (cadr pat)) #'vectorp)
+ ((byte-code-function-p (cadr pat))
+ #'byte-code-function-p))))
+ (pcase--mutually-exclusive-p (cadr upat) otherpred))
'(:pcase--fail . nil))
- ((and (eq 'pred (car upat))
- (eq 'quote (car-safe pat))
+ ;; Since we turn (or 'a 'b 'c) into (pred (pcase--flip (memq '(a b c))))
+ ;; try and preserve the info we get from that memq test.
+ ((and (eq 'pcase--flip (car-safe (cadr upat)))
+ (memq (cadr (cadr upat)) '(memq member memql))
+ (eq 'quote (car-safe (nth 2 (cadr upat))))
+ (eq 'quote (car-safe pat)))
+ (let ((set (cadr (nth 2 (cadr upat)))))
+ (if (member (cadr pat) set)
+ '(nil . :pcase--fail)
+ '(:pcase--fail . nil))))
+ ((and (eq 'quote (car-safe pat))
(symbolp (cadr upat))
(or (symbolp (cadr pat)) (stringp (cadr pat)) (numberp (cadr pat)))
(get (cadr upat) 'side-effect-free)
diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el
index 23221a2a00d..ce8d98df807 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/regi.el b/lisp/emacs-lisp/regi.el
index 38b202fa101..527af1ddf24 100644
--- a/lisp/emacs-lisp/regi.el
+++ b/lisp/emacs-lisp/regi.el
@@ -1,4 +1,4 @@
-;;; regi.el --- REGular expression Interpreting engine
+;;; regi.el --- REGular expression Interpreting engine -*- lexical-binding: t; -*-
;; Copyright (C) 1993, 2001-2021 Free Software Foundation, Inc.
@@ -153,7 +153,7 @@ useful information:
;; set up the narrowed region
(and start
end
- (let* ((tstart start)
+ (let* (;; (tstart start)
(start (min start end))
(end (max start end)))
(narrow-to-region
@@ -206,30 +206,33 @@ useful information:
;; if the line matched, package up the argument list and
;; funcall the FUNC
(if match-p
- (let* ((curline (buffer-substring
- (regi-pos 'bol)
- (regi-pos 'eol)))
- (curframe current-frame)
- (curentry entry)
- (result (eval func))
- (step (or (cdr (assq 'step result)) 1))
- )
- ;; changing frame on the fly?
- (if (assq 'frame result)
- (setq working-frame (cdr (assq 'frame result))))
-
- ;; continue processing current frame?
- (if (memq 'continue result)
- (setq current-frame (cdr current-frame))
- (forward-line step)
- (setq current-frame working-frame))
-
- ;; abort current frame?
- (if (memq 'abort result)
- (progn
- (setq donep t)
- (throw 'regi-throw-top t)))
- ) ; end-let
+ (with-suppressed-warnings
+ ((lexical curframe curentry curline))
+ (defvar curframe) (defvar curentry) (defvar curline)
+ (let* ((curline (buffer-substring
+ (regi-pos 'bol)
+ (regi-pos 'eol)))
+ (curframe current-frame)
+ (curentry entry)
+ (result (eval func))
+ (step (or (cdr (assq 'step result)) 1))
+ )
+ ;; changing frame on the fly?
+ (if (assq 'frame result)
+ (setq working-frame (cdr (assq 'frame result))))
+
+ ;; continue processing current frame?
+ (if (memq 'continue result)
+ (setq current-frame (cdr current-frame))
+ (forward-line step)
+ (setq current-frame working-frame))
+
+ ;; abort current frame?
+ (if (memq 'abort result)
+ (progn
+ (setq donep t)
+ (throw 'regi-throw-top t)))
+ )) ; end-let
;; else if no match occurred, then process the next
;; frame-entry on the current line
diff --git a/lisp/emacs-lisp/shadow.el b/lisp/emacs-lisp/shadow.el
index 168e5e46f37..c1d05941239 100644
--- a/lisp/emacs-lisp/shadow.el
+++ b/lisp/emacs-lisp/shadow.el
@@ -1,4 +1,4 @@
-;;; shadow.el --- locate Emacs Lisp file shadowings
+;;; shadow.el --- locate Emacs Lisp file shadowings -*- lexical-binding: t; -*-
;; Copyright (C) 1995, 2001-2021 Free Software Foundation, Inc.
@@ -58,8 +58,7 @@
(defcustom load-path-shadows-compare-text nil
"If non-nil, then shadowing files are reported only if their text differs.
This is slower, but filters out some innocuous shadowing."
- :type 'boolean
- :group 'lisp-shadow)
+ :type 'boolean)
(defun load-path-shadows-find (&optional path)
"Return a list of Emacs Lisp files that create shadows.
@@ -78,8 +77,7 @@ See the documentation for `list-load-path-shadows' for further information."
dir-case-insensitive ; `file-name-case-insensitive-p' of dir.
curr-files ; This dir's Emacs Lisp files.
orig-dir ; Where the file was first seen.
- files-seen-this-dir ; Files seen so far in this dir.
- file) ; The current file.
+ files-seen-this-dir) ; Files seen so far in this dir.
(dolist (pp (or path load-path))
(setq dir (directory-file-name (file-truename (or pp "."))))
(if (member dir true-names)
@@ -109,7 +107,7 @@ See the documentation for `list-load-path-shadows' for further information."
(dolist (file curr-files)
- (if (string-match "\\.gz$" file)
+ (if (string-match "\\.gz\\'" file)
(setq file (substring file 0 -3)))
(setq file (substring
file 0 (if (string= (substring file -1) "c") -4 -3)))
@@ -125,9 +123,13 @@ See the documentation for `list-load-path-shadows' for further information."
;; XXX.elc (or vice-versa) when they are in the same directory.
(setq files-seen-this-dir (cons file files-seen-this-dir))
- (if (setq orig-dir (assoc file files
- (when dir-case-insensitive
- (lambda (f1 f2) (eq (compare-strings f1 nil nil f2 nil nil t) t)))))
+ (if (setq orig-dir
+ (assoc file files
+ (when dir-case-insensitive
+ (lambda (f1 f2)
+ (eq (compare-strings f1 nil nil
+ f2 nil nil t)
+ t)))))
;; This file was seen before, we have a shadowing.
;; Report it unless the files are identical.
(let ((base1 (concat (cdr orig-dir) "/" (car orig-dir)))
@@ -142,7 +144,7 @@ See the documentation for `list-load-path-shadows' for further information."
(append shadows (list base1 base2)))))
;; Not seen before, add it to the list of seen files.
- (setq files (cons (cons file dir) files)))))))
+ (push (cons file dir) files))))))
;; Return the list of shadowings.
shadows))
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index b90227da42f..a4514454c0b 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -389,6 +389,28 @@ it makes no sense to convert it to a string using
(set-buffer source-buffer)
(replace-buffer-contents tmp-buffer max-secs max-costs)))))))))
+(defmacro named-let (name bindings &rest body)
+ "Looping construct taken from Scheme.
+Like `let', bind variables in BINDINGS and then evaluate BODY,
+but with the twist that BODY can evaluate itself recursively by
+calling NAME, where the arguments passed to NAME are used
+as the new values of the bound variables in the recursive invocation."
+ (declare (indent 2) (debug (symbolp (&rest (symbolp form)) body)))
+ (require 'cl-lib)
+ (let ((fargs (mapcar (lambda (b) (if (consp b) (car b) b)) bindings))
+ (aargs (mapcar (lambda (b) (if (consp b) (cadr b))) bindings)))
+ ;; According to the Scheme semantics of named let, `name' is not in scope
+ ;; while evaluating the expressions in `bindings', and for this reason, the
+ ;; "initial" function call below needs to be outside of the `cl-labels'.
+ ;; When the "self-tco" eliminates all recursive calls, the `cl-labels'
+ ;; expands to a lambda which the byte-compiler then combines with the
+ ;; funcall to make a `let' so we end up with a plain `while' loop and no
+ ;; remaining `lambda' at all.
+ `(funcall
+ (cl-labels ((,name ,fargs . ,body)) #',name)
+ . ,aargs)))
+
+
(provide 'subr-x)
;;; subr-x.el ends here
diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el
index 62f213c57f7..bee2f9639e7 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 7de9d547ce4..fb9cd8f47df 100644
--- a/lisp/emacs-lisp/tcover-ses.el
+++ b/lisp/emacs-lisp/tcover-ses.el
@@ -1,4 +1,4 @@
-;;;; testcover-ses.el -- Example use of `testcover' to test "SES"
+;;;; testcover-ses.el -- Example use of `testcover' to test "SES" -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
@@ -19,21 +19,14 @@
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-(require 'testcover)
+;;; Commentary:
-(defvar ses-initial-global-parameters)
-(defvar ses-mode-map)
+;; FIXME: Convert to ERT and move to `test/'?
-(declare-function ses-set-curcell "ses")
-(declare-function ses-update-cells "ses")
-(declare-function ses-load "ses")
-(declare-function ses-vector-delete "ses")
-(declare-function ses-create-header-string "ses")
-(declare-function ses-read-cell "ses")
-(declare-function ses-read-symbol "ses")
-(declare-function ses-command-hook "ses")
-(declare-function ses-jump "ses")
+;;; Code:
+(require 'testcover)
+(require 'ses)
;;;Here are some macros that exercise SES. Set `pause' to t if you want the
;;;macros to pause after each step.
@@ -652,6 +645,7 @@ spreadsheet files with invalid formatting."
(testcover-start "ses.el" t))
(require 'unsafep)) ;In case user has safe-functions = t!
+(defvar ses--curcell-overlay)
;;;#########################################################################
(defun ses-exercise ()
@@ -674,8 +668,8 @@ spreadsheet files with invalid formatting."
(ses-load))
;;ses-vector-delete is always called from buffer-undo-list with the same
;;symbol as argument. We'll give it a different one here.
- (let ((x [1 2 3]))
- (ses-vector-delete 'x 0 0))
+ (dlet ((tcover-ses--x [1 2 3]))
+ (ses-vector-delete 'tcover-ses--x 0 0))
;;ses-create-header-string behaves differently in a non-window environment
;;but we always test under windows.
(let ((window-system (not window-system)))
@@ -704,7 +698,7 @@ spreadsheet files with invalid formatting."
(ses-mode)))))
;;Test error-handling in command hook, outside a macro.
;;This will ring the bell.
- (let (curcell-overlay)
+ (let (ses--curcell-overlay)
(ses-command-hook))
;;Due to use of run-with-timer, ses-command-hook sometimes gets called
;;after we switch to another buffer.
@@ -720,4 +714,4 @@ spreadsheet files with invalid formatting."
;;Could do this here: (testcover-end "ses.el")
(message "Done"))
-;; testcover-ses.el ends here.
+;;; testcover-ses.el ends here.
diff --git a/lisp/emacs-lisp/unsafep.el b/lisp/emacs-lisp/unsafep.el
index f46d9c77eae..d52a6c796db 100644
--- a/lisp/emacs-lisp/unsafep.el
+++ b/lisp/emacs-lisp/unsafep.el
@@ -1,4 +1,4 @@
-;;;; unsafep.el -- Determine whether a Lisp form is safe to evaluate
+;;;; unsafep.el -- Determine whether a Lisp form is safe to evaluate -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
@@ -129,15 +129,16 @@ in the parse.")
(put x 'safe-function t))
;;;###autoload
-(defun unsafep (form &optional unsafep-vars)
+(defun unsafep (form &optional vars)
"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'."
(catch 'unsafep
(if (or (eq safe-functions t) ;User turned off safety-checking
(atom form)) ;Atoms are never unsafe
(throw 'unsafep nil))
- (let* ((fun (car form))
+ (let* ((unsafep-vars vars)
+ (fun (car form))
(reason (unsafep-function fun))
arg)
(cond
diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el
index 881eff7f801..a64274bc0c1 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-gmrk.el b/lisp/emulation/cua-gmrk.el
index 195bba1f317..6f6b9fce130 100644
--- a/lisp/emulation/cua-gmrk.el
+++ b/lisp/emulation/cua-gmrk.el
@@ -87,9 +87,11 @@
(defun cua-toggle-global-mark (stay)
"Set or cancel the global marker.
-When the global marker is set, CUA cut and copy commands will automatically
-insert the deleted or copied text before the global marker, even when the
-global marker is in another buffer.
+When the global marker is set, CUA cut and copy commands will
+automatically insert the inserted, deleted or copied text before
+the global marker, even when the global marker is in another
+buffer.
+
If the global marker isn't set, set the global marker at point in the current
buffer. Otherwise jump to the global marker position and cancel it.
With prefix argument, don't jump to global mark when canceling it."
diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el
index ea5dad2aa0b..be2d7c0fd8a 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 1e235831d6f..f38be908897 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 cede99bff73..c05cf6a48b4 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 7209dc664b5..1d80c9cd026 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 eec83dd05b5..71e40ee023e 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 07a234bab9b..1bdb155538a 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 6c9428060fc..df5a083a08a 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/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 487dc7692ef..4cabd42f532 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 06d4fbd9f6a..4e4d012545a 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 590785e91c2..9dedd3cda86 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 62238dd4344..8378ff53742 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-join.el b/lisp/erc/erc-join.el
index 947b2949690..e6e50707830 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 9fd3cfe1cc4..37fc4cf16c1 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 9c2bb9dfee3..9926255e3aa 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 098049edc68..e133e05a7d3 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-ring.el b/lisp/erc/erc-ring.el
index 3813eafe004..71a9f8ef3da 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 c7dfb0807bc..2c42a18081e 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 bb68173b6dc..37e4cc39d53 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 ()
@@ -6783,8 +6759,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 0200631da66..638c0ac230a 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)
+ :type (get 'pcomplete-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,7 +254,7 @@ 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
@@ -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/ezimage.el b/lisp/ezimage.el
index 9c1d8599101..13f5c039a7f 100644
--- a/lisp/ezimage.el
+++ b/lisp/ezimage.el
@@ -1,4 +1,4 @@
-;;; ezimage --- Generalized Image management
+;;; ezimage.el --- Generalized Image management -*- lexical-binding: t -*-
;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
diff --git a/lisp/faces.el b/lisp/faces.el
index 4e98338432f..90f11bbe3bb 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -2199,7 +2199,7 @@ the above example."
(not (funcall pred type)))
;; Strip off last hyphen and what follows, then try again
(setq type
- (if (setq hyphend (string-match-p "[-_][^-_]+$" type))
+ (if (setq hyphend (string-match-p "[-_.][^-_.]+$" type))
(substring type 0 hyphend)
nil))))
type)
@@ -2683,11 +2683,20 @@ the same as `window-divider' face."
(defface internal-border
'((t nil))
- "Basic face for the internal border."
+ "Basic face for the internal border.
+For the internal border of child frames see `child-frame-border'."
:version "26.1"
:group 'frames
:group 'basic-faces)
+(defface child-frame-border
+ '((t nil))
+ "Basic face for the internal border of child frames.
+For the internal border of non-child frames see `internal-border'."
+ :version "28.1"
+ :group 'frames
+ :group 'basic-faces)
+
(defface minibuffer-prompt
'((((background dark)) :foreground "cyan")
;; Don't use blue because many users of the MS-DOS port customize
diff --git a/lisp/files.el b/lisp/files.el
index d2e5413b3ad..dada69c1457 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.
@@ -3443,23 +3439,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.
@@ -4062,13 +4056,13 @@ Return the new variables list."
(subdirs (assq 'subdirs alist)))
(if (or (not subdirs)
(progn
- (setq alist (delq subdirs alist))
+ (setq alist (remq subdirs alist))
(cdr-safe subdirs))
;; TODO someone might want to extend this to allow
;; integer values for subdir, where N means
;; variables apply to this directory and N levels
;; below it (0 == nil).
- (equal root default-directory))
+ (equal root (expand-file-name default-directory)))
(setq variables (dir-locals-collect-mode-variables
alist variables))))))))
(error
@@ -5233,7 +5227,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.
@@ -5241,7 +5235,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)
@@ -5510,9 +5503,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/find-cmd.el b/lisp/find-cmd.el
index 5866b308551..bb2e97d8662 100644
--- a/lisp/find-cmd.el
+++ b/lisp/find-cmd.el
@@ -1,4 +1,4 @@
-;;; find-cmd.el --- Build a valid find(1) command with sexps
+;;; find-cmd.el --- Build a valid find(1) command with sexps -*- lexical-binding: t -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@@ -28,7 +28,7 @@
;; (find-cmd '(prune (name ".svn" ".git" ".CVS"))
;; '(and (or (name "*.pl" "*.pm" "*.t")
;; (mtime "+1"))
-;; (fstype "nfs" "ufs"))))
+;; (fstype "nfs" "ufs")))
;; will become (un-wrapped):
diff --git a/lisp/flow-ctrl.el b/lisp/flow-ctrl.el
index 656edf2eb09..adb52d7253a 100644
--- a/lisp/flow-ctrl.el
+++ b/lisp/flow-ctrl.el
@@ -1,4 +1,4 @@
-;;; flow-ctrl.el --- help for lusers on cu(1) or ttys with wired-in ^S/^Q flow control
+;;; flow-ctrl.el --- help for lusers on cu(1) or ttys with wired-in ^S/^Q flow control -*- lexical-binding: t -*-
;; Copyright (C) 1990-1991, 1994, 2001-2021 Free Software Foundation,
;; Inc.
@@ -64,12 +64,11 @@ With arg, enable flow control mode if arg is positive, otherwise disable."
(progn
;; Turn flow control off, and stop exchanging chars.
(set-input-mode t nil (nth 2 (current-input-mode)))
- (if keyboard-translate-table
- (progn
- (aset keyboard-translate-table flow-control-c-s-replacement nil)
- (aset keyboard-translate-table ?\^s nil)
- (aset keyboard-translate-table flow-control-c-q-replacement nil)
- (aset keyboard-translate-table ?\^q nil))))
+ (when keyboard-translate-table
+ (aset keyboard-translate-table flow-control-c-s-replacement nil)
+ (aset keyboard-translate-table ?\^s nil)
+ (aset keyboard-translate-table flow-control-c-q-replacement nil)
+ (aset keyboard-translate-table ?\^q nil)))
;; Turn flow control on.
;; Tell emacs to pass C-s and C-q to OS.
(set-input-mode nil t (nth 2 (current-input-mode)))
diff --git a/lisp/font-core.el b/lisp/font-core.el
index 0f1a3d1c364..4b695424977 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 a51434c38c9..c344a612581 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."
@@ -1104,8 +1101,8 @@ Called with two arguments BEG and END.")
"Reinitialize the font-lock machinery and (re-)fontify the buffer.
This functions is a convenience functions when developing font
locking for a mode, and is not meant to be called from lisp functions."
- (interactive)
(declare (interactive-only t))
+ (interactive)
;; Make font-lock recalculate all the mode-specific data.
(setq font-lock-major-mode nil)
;; Make the syntax machinery discard all information.
@@ -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/generic-x.el b/lisp/generic-x.el
index f3ea22a4a30..4c6e1189003 100644
--- a/lisp/generic-x.el
+++ b/lisp/generic-x.el
@@ -1,4 +1,4 @@
-;;; generic-x.el --- A collection of generic modes
+;;; generic-x.el --- A collection of generic modes -*- lexical-binding: t -*-
;; Copyright (C) 1997-1998, 2001-2021 Free Software Foundation, Inc.
@@ -121,14 +121,12 @@
"If non-nil, add a hook to enter `default-generic-mode' automatically.
This is done if the first few lines of a file in fundamental mode
start with a hash comment character."
- :group 'generic-x
:type 'boolean)
(defcustom generic-lines-to-scan 3
"Number of lines that `generic-mode-find-file-hook' looks at.
Relevant when deciding whether to enter Default-Generic mode automatically.
This variable should be set to a small positive number."
- :group 'generic-x
:type 'integer)
(defcustom generic-find-file-regexp "^#"
@@ -137,7 +135,6 @@ Files in fundamental mode whose first few lines contain a match
for this regexp, should be put into Default-Generic mode instead.
The number of lines tested for the matches is specified by the
value of the variable `generic-lines-to-scan', which see."
- :group 'generic-x
:type 'regexp)
(defcustom generic-ignore-files-regexp "[Tt][Aa][Gg][Ss]\\'"
@@ -146,7 +143,6 @@ Files whose names match this regular expression should not be put
into Default-Generic mode, even if they have lines which match
the regexp in `generic-find-file-regexp'. If the value is nil,
`generic-mode-find-file-hook' does not check the file names."
- :group 'generic-x
:type '(choice (const :tag "Don't check file names" nil) regexp))
;; This generic mode is always defined
@@ -249,7 +245,6 @@ This hook will be installed if the variable
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."
- :group 'generic-x
:type (let (list)
(dolist (mode
(sort (append generic-default-modes
@@ -365,7 +360,8 @@ your changes into effect."
(define-generic-mode hosts-generic-mode
'(?#)
'("localhost")
- '(("\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)" 1 font-lock-constant-face))
+ '(("\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)" 1 font-lock-constant-face)
+ ("\\<\\([0-9A-Fa-f:]+\\)\\>" 1 font-lock-constant-face))
'("[hH][oO][sS][tT][sS]\\'")
nil
"Generic mode for HOSTS files."))
@@ -415,7 +411,8 @@ like an INI file. You can add this hook to `find-file-hook'."
(goto-char (point-min))
(and (looking-at "^\\s-*\\[.*\\]")
(ini-generic-mode)))))
-(defalias 'generic-mode-ini-file-find-file-hook 'ini-generic-mode-find-file-hook))
+(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!
@@ -1296,19 +1293,16 @@ like an INI file. You can add this hook to `find-file-hook'."
;; here manually instead
(defun generic-rul-mode-setup-function ()
- (make-local-variable 'parse-sexp-ignore-comments)
- (make-local-variable 'comment-start)
(make-local-variable 'comment-start-skip)
- (make-local-variable 'comment-end)
(setq imenu-generic-expression
- '((nil "^function\\s-+\\([A-Za-z0-9_]+\\)" 1))
- parse-sexp-ignore-comments t
- comment-end "*/"
- comment-start "/*"
-;;; comment-end ""
-;;; comment-start "//"
-;;; comment-start-skip ""
- )
+ '((nil "^function\\s-+\\([A-Za-z0-9_]+\\)" 1)))
+ (setq-local parse-sexp-ignore-comments t
+ comment-end "*/"
+ comment-start "/*"
+;;; comment-end ""
+;;; comment-start "//"
+;;; comment-start-skip ""
+ )
;; (set-syntax-table rul-generic-mode-syntax-table)
(setq-local font-lock-syntax-table rul-generic-mode-syntax-table))
@@ -1458,7 +1452,7 @@ like an INI file. You can add this hook to `find-file-hook'."
":"
;; Password, UID and GID
(mapconcat
- 'identity
+ #'identity
(make-list 3 "\\([^:]+\\)")
":")
":"
@@ -1490,41 +1484,104 @@ like an INI file. You can add this hook to `find-file-hook'."
(define-generic-mode etc-fstab-generic-mode
'(?#)
'("adfs"
+ "ados"
"affs"
+ "anon_inodefs"
+ "atfs"
+ "audiofs"
"autofs"
+ "bdev"
+ "befs"
+ "bfs"
+ "binfmt_misc"
+ "btrfs"
+ "cd9660"
+ "cfs"
+ "cgroup"
+ "cifs"
"coda"
"coherent"
+ "configfs"
+ "cpuset"
"cramfs"
+ "devfs"
"devpts"
+ "devtmpfs"
+ "e2compr"
"efs"
"ext2"
+ "ext2fs"
"ext3"
"ext4"
+ "fdesc"
+ "ffs"
+ "filecore"
+ "fuse"
+ "fuseblk"
+ "fusectl"
"hfs"
"hpfs"
+ "hugetlbfs"
"iso9660"
+ "jffs"
+ "jffs2"
"jfs"
+ "kernfs"
+ "lfs"
+ "linprocfs"
+ "mfs"
"minix"
+ "mqueue"
"msdos"
"ncpfs"
"nfs"
+ "nfsd"
+ "nilfs2"
+ "none"
"ntfs"
+ "null"
+ "nwfs"
+ "overlay"
+ "ovlfs"
+ "pipefs"
+ "portal"
"proc"
+ "procfs"
+ "pstore"
+ "ptyfs"
"qnx4"
+ "ramfs"
"reiserfs"
"romfs"
+ "securityfs"
+ "shm"
"smbfs"
- "cifs"
- "usbdevfs"
- "sysv"
+ "sockfs"
+ "squashfs"
+ "sshfs"
+ "std"
+ "subfs"
"sysfs"
+ "sysv"
+ "tcfs"
"tmpfs"
"udf"
"ufs"
+ "umap"
"umsdos"
+ "union"
+ "usbdevfs"
+ "usbfs"
+ "userfs"
"vfat"
+ "vs3fs"
+ "vxfs"
+ "wrapfs"
+ "wvfs"
+ "xenfs"
"xenix"
"xfs"
+ "zisofs"
"swap"
"auto"
"ignore")
@@ -1575,8 +1632,7 @@ like an INI file. You can add this hook to `find-file-hook'."
(((class color) (min-colors 88)) (:background "red1"))
(((class color)) (:background "red"))
(t (:weight bold)))
- "Font Lock mode face used to highlight TABs."
- :group 'generic-x)
+ "Font Lock mode face used to highlight TABs.")
(defface show-tabs-space
'((((class grayscale) (background light)) (:background "DimGray" :weight bold))
@@ -1584,8 +1640,7 @@ like an INI file. You can add this hook to `find-file-hook'."
(((class color) (min-colors 88)) (:background "yellow1"))
(((class color)) (:background "yellow"))
(t (:weight bold)))
- "Font Lock mode face used to highlight spaces."
- :group 'generic-x)
+ "Font Lock mode face used to highlight spaces.")
(define-generic-mode show-tabs-generic-mode
nil ;; no comment char
diff --git a/lisp/gnus/canlock.el b/lisp/gnus/canlock.el
index 6c8c1a5927a..dbdbaa83d7e 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 b77dcdd4624..08beef7db9f 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 ab97c593d9c..bcf8dd014bc 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 686623029ed..cbe3505cd10 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)
@@ -1789,7 +1786,6 @@ variables. Returns the first non-nil value found."
. gnus-agent-enable-expiration)
(agent-predicate . gnus-agent-predicate)))))))
-;; FIXME: This looks an awful lot like `gnus-agent-retrieve-headers'.
(defun gnus-agent-fetch-headers (group)
"Fetch interesting headers into the agent. The group's overview
file will be updated to include the headers while a list of available
@@ -1811,9 +1807,10 @@ article numbers will be returned."
(cdr active))))
(gnus-uncompress-range (gnus-active group)))
(gnus-list-of-unread-articles group)))
+ (gnus-decode-encoded-word-function 'identity)
+ (gnus-decode-encoded-address-function 'identity)
(file (gnus-agent-article-name ".overview" group))
- (file-name-coding-system nnmail-pathname-coding-system)
- headers fetched-headers)
+ (file-name-coding-system nnmail-pathname-coding-system))
(unless fetch-all
;; Add articles with marks to the list of article headers we want to
@@ -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-range 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
@@ -1867,52 +1864,38 @@ article numbers will be returned."
10 "gnus-agent-fetch-headers: undownloaded articles are `%s'"
(gnus-compress-sequence articles t)))
- ;; Parse known headers from FILE.
- (if (file-exists-p file)
- (with-current-buffer gnus-agent-overview-buffer
- (erase-buffer)
- (let ((nnheader-file-coding-system
- gnus-agent-file-coding-system))
- (nnheader-insert-nov-file file (car articles))
- (with-current-buffer nntp-server-buffer
- (erase-buffer)
- (insert-buffer-substring gnus-agent-overview-buffer)
- (setq headers
- (gnus-get-newsgroup-headers-xover
- articles nil (buffer-local-value
- 'gnus-newsgroup-dependencies
- gnus-summary-buffer)
- gnus-newsgroup-name)))))
- (gnus-make-directory (nnheader-translate-file-chars
- (file-name-directory file) t)))
-
- ;; Fetch our new headers.
- (gnus-message 8 "Fetching headers for %s..." group)
- (if articles
- (setq fetched-headers (gnus-fetch-headers articles)))
-
- ;; Merge two sets of headers.
- (setq headers
- (if (and headers fetched-headers)
- (delete-dups
- (sort (append headers (copy-sequence fetched-headers))
- (lambda (l r)
- (< (mail-header-number l)
- (mail-header-number r)))))
- (or headers fetched-headers)))
-
- ;; Save the new set of headers to FILE.
- (let ((coding-system-for-write
- gnus-agent-file-coding-system))
- (with-current-buffer gnus-agent-overview-buffer
- (goto-char (point-max))
- (mapc #'nnheader-insert-nov fetched-headers)
- (sort-numeric-fields 1 (point-min) (point-max))
- (gnus-agent-check-overview-buffer)
- (write-region (point-min) (point-max) file nil 'silent))
- (gnus-agent-update-view-total-fetched-for group t)
- (gnus-agent-save-alist group articles nil)))
- headers))
+ (with-current-buffer nntp-server-buffer
+ (if articles
+ (progn
+ (gnus-message 8 "Fetching headers for %s..." group)
+
+ ;; Fetch them.
+ (gnus-make-directory (nnheader-translate-file-chars
+ (file-name-directory file) t))
+
+ (unless (eq 'nov (gnus-retrieve-headers articles group))
+ (nnvirtual-convert-headers))
+ (gnus-agent-check-overview-buffer)
+ ;; Move these headers to the overview buffer so that
+ ;; gnus-agent-braid-nov can merge them with the contents
+ ;; of FILE.
+ (copy-to-buffer
+ gnus-agent-overview-buffer (point-min) (point-max))
+ ;; NOTE: Call g-a-brand-nov even when the file does not
+ ;; exist. As a minimum, it will validate the article
+ ;; numbers already in the buffer.
+ (gnus-agent-braid-nov articles file)
+ (let ((coding-system-for-write
+ gnus-agent-file-coding-system))
+ (gnus-agent-check-overview-buffer)
+ (write-region (point-min) (point-max) file nil 'silent))
+ (gnus-agent-update-view-total-fetched-for group t)
+ (gnus-agent-save-alist group articles nil)
+ articles)
+ (ignore-errors
+ (erase-buffer)
+ (nnheader-insert-file-contents file)))))
+ articles))
(defsubst gnus-agent-read-article-number ()
"Read the article number at point.
@@ -1938,6 +1921,96 @@ Return nil when a valid article number can not be read."
(set-buffer nntp-server-buffer)
(insert-buffer-substring gnus-agent-overview-buffer b e))))
+(defun gnus-agent-braid-nov (articles file)
+ "Merge agent overview data with given file.
+Takes unvalidated headers for ARTICLES from
+`gnus-agent-overview-buffer' and validated headers from the given
+FILE and places the combined valid headers into
+`nntp-server-buffer'. This function can be used, when file
+doesn't exist, to valid the overview buffer."
+ (let (start last)
+ (set-buffer gnus-agent-overview-buffer)
+ (goto-char (point-min))
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (when (file-exists-p file)
+ (nnheader-insert-file-contents file))
+ (goto-char (point-max))
+ (forward-line -1)
+
+ (unless (or (= (point-min) (point-max))
+ (< (setq last (read (current-buffer))) (car articles)))
+ ;; Old and new overlap -- We do it the hard way.
+ (when (nnheader-find-nov-line (car articles))
+ ;; Replacing existing NOV entry
+ (delete-region (point) (progn (forward-line 1) (point))))
+ (gnus-agent-copy-nov-line (pop articles))
+
+ (ignore-errors
+ (while articles
+ (while (let ((art (read (current-buffer))))
+ (cond ((< art (car articles))
+ (forward-line 1)
+ t)
+ ((= art (car articles))
+ (beginning-of-line)
+ (delete-region
+ (point) (progn (forward-line 1) (point)))
+ nil)
+ (t
+ (beginning-of-line)
+ nil))))
+
+ (gnus-agent-copy-nov-line (pop articles)))))
+
+ (goto-char (point-max))
+
+ ;; Append the remaining lines
+ (when articles
+ (when last
+ (set-buffer gnus-agent-overview-buffer)
+ (setq start (point))
+ (set-buffer nntp-server-buffer))
+
+ (let ((p (point)))
+ (insert-buffer-substring gnus-agent-overview-buffer start)
+ (goto-char p))
+
+ (setq last (or last -134217728))
+ (while (catch 'problems
+ (let (sort art)
+ (while (not (eobp))
+ (setq art (gnus-agent-read-article-number))
+ (cond ((not art)
+ ;; Bad art num - delete this line
+ (beginning-of-line)
+ (delete-region (point) (progn (forward-line 1) (point))))
+ ((< art last)
+ ;; Art num out of order - enable sort
+ (setq sort t)
+ (forward-line 1))
+ ((= art last)
+ ;; Bad repeat of art number - delete this line
+ (beginning-of-line)
+ (delete-region (point) (progn (forward-line 1) (point))))
+ (t
+ ;; Good art num
+ (setq last art)
+ (forward-line 1))))
+ (when sort
+ ;; something is seriously wrong as we simply shouldn't see out-of-order data.
+ ;; First, we'll fix the sort.
+ (sort-numeric-fields 1 (point-min) (point-max))
+
+ ;; but now we have to consider that we may have duplicate rows...
+ ;; so reset to beginning of file
+ (goto-char (point-min))
+ (setq last -134217728)
+
+ ;; and throw a code that restarts this scan
+ (throw 'problems t))
+ nil))))))
+
;; Keeps the compiler from warning about the free variable in
;; gnus-agent-read-agentview.
(defvar gnus-agent-read-agentview)
@@ -1994,7 +2067,7 @@ Return nil when a valid article number can not be read."
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))
@@ -2310,9 +2383,10 @@ modified) original contents, they are first saved to their own file."
(gnus-orphan-score gnus-orphan-score)
;; Maybe some other gnus-summary local variables should also
;; be put here.
- fetched-headers
+
gnus-headers
gnus-score
+ articles
predicate info marks
)
(unless (gnus-check-group group)
@@ -2333,35 +2407,38 @@ modified) original contents, they are first saved to their own file."
(setq info (gnus-get-info group)))))))
(when arts
(setq marked-articles (nconc (gnus-uncompress-range arts)
- marked-articles))))))
- (setq marked-articles (sort marked-articles '<))
+ marked-articles))
+ ))))
+ (setq marked-articles (sort marked-articles #'<))
- (setq gnus-newsgroup-dependencies
- (or gnus-newsgroup-dependencies
- (gnus-make-hashtable)))
+ ;; Fetch any new articles from the server
+ (setq articles (gnus-agent-fetch-headers group))
- ;; Fetch headers for any new articles from the server.
- (setq fetched-headers (gnus-agent-fetch-headers group))
+ ;; Merge new articles with marked
+ (setq articles (sort (append marked-articles articles) #'<))
- (when fetched-headers
+ (when articles
+ ;; Parse them and see which articles we want to fetch.
+ (setq gnus-newsgroup-dependencies
+ (or gnus-newsgroup-dependencies
+ (gnus-make-hashtable (length articles))))
(setq gnus-newsgroup-headers
- (or gnus-newsgroup-headers
- fetched-headers)))
- (when marked-articles
- ;; `gnus-agent-overview-buffer' may be killed for timeout
- ;; reason. If so, recreate it.
+ (or gnus-newsgroup-headers
+ (gnus-get-newsgroup-headers-xover articles nil nil
+ group)))
+ ;; `gnus-agent-overview-buffer' may be killed for
+ ;; timeout reason. If so, recreate it.
(gnus-agent-create-buffer)
(setq predicate
- (gnus-get-predicate
- (gnus-agent-find-parameter group 'agent-predicate)))
-
- ;; If the selection predicate requires scoring, score each header.
+ (gnus-get-predicate
+ (gnus-agent-find-parameter group 'agent-predicate)))
+ ;; If the selection predicate requires scoring, score each header
(unless (memq predicate '(gnus-agent-true gnus-agent-false))
(let ((score-param
(gnus-agent-find-parameter group 'agent-score-file)))
- ;; Translate score-param into real one.
+ ;; Translate score-param into real one
(cond
((not score-param))
((eq score-param 'file)
@@ -2589,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 ()
@@ -2699,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."
@@ -2717,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."
@@ -2735,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."
@@ -3051,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
@@ -3581,9 +3655,11 @@ has been fetched."
(defun gnus-agent-retrieve-headers (articles group &optional fetch-old)
(save-excursion
(gnus-agent-create-buffer)
- (let ((file (gnus-agent-article-name ".overview" group))
- (file-name-coding-system nnmail-pathname-coding-system)
- uncached-articles headers fetched-headers)
+ (let ((gnus-decode-encoded-word-function 'identity)
+ (gnus-decode-encoded-address-function 'identity)
+ (file (gnus-agent-article-name ".overview" group))
+ uncached-articles
+ (file-name-coding-system nnmail-pathname-coding-system))
(gnus-make-directory (nnheader-translate-file-chars
(file-name-directory file) t))
@@ -3594,63 +3670,122 @@ has been fetched."
1)
(car (last articles))))))
- ;; See if we've got cached headers for ARTICLES and put them in
- ;; HEADERS. Articles with no cached headers go in
- ;; UNCACHED-ARTICLES to be fetched from the server.
+ ;; Populate temp buffer with known headers
(when (file-exists-p file)
(with-current-buffer gnus-agent-overview-buffer
(erase-buffer)
(let ((nnheader-file-coding-system
gnus-agent-file-coding-system))
- (nnheader-insert-nov-file file (car articles))
- (with-current-buffer nntp-server-buffer
- (erase-buffer)
- (insert-buffer-substring gnus-agent-overview-buffer)
- (setq headers
- (gnus-get-newsgroup-headers-xover
- articles nil (buffer-local-value
- 'gnus-newsgroup-dependencies
- gnus-summary-buffer)
- gnus-newsgroup-name))))))
-
- (setq uncached-articles
- (gnus-agent-uncached-articles articles group t))
-
- (when uncached-articles
- (let ((gnus-newsgroup-name group)
- gnus-agent) ; Prevent loop.
- ;; Fetch additional headers for the uncached articles.
- (setq fetched-headers (gnus-fetch-headers uncached-articles))
- ;; Merge headers we got from the overview file with our
- ;; newly-fetched headers.
- (when fetched-headers
- (setq headers
- (delete-dups
- (sort (append headers (copy-sequence fetched-headers))
- (lambda (l r)
- (< (mail-header-number l)
- (mail-header-number r))))))
-
- ;; Add the new set of known headers to the overview file.
+ (nnheader-insert-nov-file file (car articles)))))
+
+ (if (setq uncached-articles (gnus-agent-uncached-articles articles group
+ t))
+ (progn
+ ;; Populate nntp-server-buffer with uncached headers
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (cond ((not (eq 'nov (let (gnus-agent) ; Turn off agent
+ (gnus-retrieve-headers
+ uncached-articles group))))
+ (nnvirtual-convert-headers))
+ ((eq 'nntp (car gnus-current-select-method))
+ ;; The author of gnus-get-newsgroup-headers-xover
+ ;; reports that the XOVER command is commonly
+ ;; unreliable. The problem is that recently
+ ;; posted articles may not be entered into the
+ ;; NOV database in time to respond to my XOVER
+ ;; query.
+ ;;
+ ;; I'm going to use his assumption that the NOV
+ ;; database is updated in order of ascending
+ ;; article ID. Therefore, a response containing
+ ;; article ID N implies that all articles from 1
+ ;; to N-1 are up-to-date. Therefore, missing
+ ;; articles in that range have expired.
+
+ (set-buffer nntp-server-buffer)
+ (let* ((fetched-articles (list nil))
+ (tail-fetched-articles fetched-articles)
+ (min (car articles))
+ (max (car (last articles))))
+
+ ;; Get the list of articles that were fetched
+ (goto-char (point-min))
+ (let ((pm (point-max))
+ art)
+ (while (< (point) pm)
+ (when (setq art (gnus-agent-read-article-number))
+ (gnus-agent-append-to-list tail-fetched-articles art))
+ (forward-line 1)))
+
+ ;; Clip this list to the headers that will
+ ;; actually be returned
+ (setq fetched-articles (gnus-list-range-intersection
+ (cdr fetched-articles)
+ (cons min max)))
+
+ ;; Clip the uncached articles list to exclude
+ ;; IDs after the last FETCHED header. The
+ ;; excluded IDs may be fetchable using HEAD.
+ (if (car tail-fetched-articles)
+ (setq uncached-articles
+ (gnus-list-range-intersection
+ uncached-articles
+ (cons (car uncached-articles)
+ (car tail-fetched-articles)))))
+
+ ;; Create the list of articles that were
+ ;; "successfully" fetched. Success, in this
+ ;; case, means that the ID should not be
+ ;; fetched again. In the case of an expired
+ ;; article, the header will not be fetched.
+ (setq uncached-articles
+ (gnus-sorted-nunion fetched-articles
+ uncached-articles))
+ )))
+
+ ;; Erase the temp buffer
+ (set-buffer gnus-agent-overview-buffer)
+ (erase-buffer)
+
+ ;; Copy the nntp-server-buffer to the temp buffer
+ (set-buffer nntp-server-buffer)
+ (copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max))
+
+ ;; Merge the temp buffer with the known headers (found on
+ ;; disk in FILE) into the nntp-server-buffer
+ (when uncached-articles
+ (gnus-agent-braid-nov uncached-articles file))
+
+ ;; Save the new set of known headers to FILE
+ (set-buffer nntp-server-buffer)
(let ((coding-system-for-write
gnus-agent-file-coding-system))
- (with-current-buffer gnus-agent-overview-buffer
- ;; We stick the new headers in at the end, then
- ;; re-sort the whole buffer with
- ;; `sort-numeric-fields'. If this turns out to be
- ;; slow, we could consider a loop to add the headers
- ;; in sorted order to begin with.
- (goto-char (point-max))
- (mapc #'nnheader-insert-nov fetched-headers)
- (sort-numeric-fields 1 (point-min) (point-max))
- (gnus-agent-check-overview-buffer)
- (write-region (point-min) (point-max) file nil 'silent)
- (gnus-agent-update-view-total-fetched-for group t)
- ;; Update the group's article alist to include the
- ;; newly fetched articles.
- (gnus-agent-load-alist group)
- (gnus-agent-save-alist group uncached-articles nil))))))
- headers)))
+ (gnus-agent-check-overview-buffer)
+ (write-region (point-min) (point-max) file nil 'silent))
+
+ (gnus-agent-update-view-total-fetched-for group t)
+
+ ;; Update the group's article alist to include the newly
+ ;; fetched articles.
+ (gnus-agent-load-alist group)
+ (gnus-agent-save-alist group uncached-articles nil)
+ )
+
+ ;; Copy the temp buffer to the nntp-server-buffer
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (insert-buffer-substring gnus-agent-overview-buffer)))
+
+ (if (and fetch-old
+ (not (numberp fetch-old)))
+ t ; Don't remove anything.
+ (nnheader-nov-delete-outside-range
+ (car articles)
+ (car (last articles)))
+ t)
+
+ 'nov))
(defun gnus-agent-request-article (article group)
"Retrieve ARTICLE in GROUP from the agent cache."
@@ -3722,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
@@ -4026,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 4ade36f4b9c..39b182f2cda 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)))
@@ -3025,6 +3023,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
@@ -4326,74 +4326,69 @@ 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)))
+(defmacro gnus--\,@ (exp)
+ (declare (debug t))
+ `(progn ,@(eval exp t)))
+
+(gnus--\,@
+ (mapcar (lambda (func)
+ `(defun ,(intern (format "gnus-%s" func))
+ (&optional interactive &rest args)
+ ,(format "Run `%s' in the article buffer." func)
+ (interactive (list t))
+ (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 +4716,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 +5002,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 +5076,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 +5168,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 +5208,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 +5311,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 +5337,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 +5437,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 +5768,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 +6152,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 +6173,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 +6195,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 +7156,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 +7281,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 +7355,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 +7623,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 +7889,16 @@ 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
+ (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 +7992,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 +8089,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 +8105,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 +8318,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 +8522,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 +8531,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 +8592,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-async.el b/lisp/gnus/gnus-async.el
index ed948a26c0b..fefd02c7bfb 100644
--- a/lisp/gnus/gnus-async.el
+++ b/lisp/gnus/gnus-async.el
@@ -357,13 +357,8 @@ that was fetched."
(let ((nntp-server-buffer (current-buffer))
(nnheader-callback-function
(lambda (_arg)
- (setq gnus-async-header-prefetched
- (cons group unread)))))
- ;; FIXME: If header prefetch is ever put into use, we'll
- ;; have to handle the possibility that
- ;; `gnus-retrieve-headers' might return a list of header
- ;; vectors directly, rather than writing them into the
- ;; current buffer.
+ (setq gnus-async-header-prefetched
+ (cons group unread)))))
(gnus-retrieve-headers unread group gnus-fetch-old-headers))))))
(defun gnus-async-retrieve-fetched-headers (articles group)
diff --git a/lisp/gnus/gnus-bcklg.el b/lisp/gnus/gnus-bcklg.el
index d6f53e4b380..6c7ad0c4744 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 57859d806c9..bc41d5b149d 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 9423d9f2f6b..5ed731947bc 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)))
@@ -294,47 +294,49 @@ it's not cached."
(defun gnus-cache-retrieve-headers (articles group &optional fetch-old)
"Retrieve the headers for ARTICLES in GROUP."
(let ((cached
- (setq gnus-newsgroup-cached (gnus-cache-articles-in-group group)))
- (gnus-newsgroup-name group)
- (gnus-fetch-old-headers fetch-old))
+ (setq gnus-newsgroup-cached (gnus-cache-articles-in-group group))))
(if (not cached)
;; No cached articles here, so we just retrieve them
;; the normal way.
(let ((gnus-use-cache nil))
- (gnus-retrieve-headers articles group))
+ (gnus-retrieve-headers articles group fetch-old))
(let ((uncached-articles (gnus-sorted-difference articles cached))
(cache-file (gnus-cache-file-name group ".overview"))
- (file-name-coding-system nnmail-pathname-coding-system)
- headers)
+ type
+ (file-name-coding-system nnmail-pathname-coding-system))
;; We first retrieve all the headers that we don't have in
;; the cache.
(let ((gnus-use-cache nil))
(when uncached-articles
- (setq headers (and articles
- (gnus-fetch-headers uncached-articles)))))
+ (setq type (and articles
+ (gnus-retrieve-headers
+ uncached-articles group fetch-old)))))
(gnus-cache-save-buffers)
- ;; Then we include the cached headers.
- (when (file-exists-p cache-file)
- (setq headers
- (delete-dups
- (sort
- (append headers
- (let ((coding-system-for-read
- gnus-cache-overview-coding-system))
- (with-current-buffer nntp-server-buffer
- (erase-buffer)
- (insert-file-contents cache-file)
- (gnus-get-newsgroup-headers-xover
- (gnus-sorted-difference
- cached uncached-articles)
- nil (buffer-local-value
- 'gnus-newsgroup-dependencies
- gnus-summary-buffer)
- group))))
- (lambda (l r)
- (< (mail-header-number l)
- (mail-header-number r)))))))
- headers))))
+ ;; Then we insert the cached headers.
+ (save-excursion
+ (cond
+ ((not (file-exists-p cache-file))
+ ;; There are no cached headers.
+ type)
+ ((null type)
+ ;; There were no uncached headers (or retrieval was
+ ;; unsuccessful), so we use the cached headers exclusively.
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (let ((coding-system-for-read
+ gnus-cache-overview-coding-system))
+ (insert-file-contents cache-file))
+ 'nov)
+ ((eq type 'nov)
+ ;; We have both cached and uncached NOV headers, so we
+ ;; braid them.
+ (gnus-cache-braid-nov group cached)
+ type)
+ (t
+ ;; We braid HEADs.
+ (gnus-cache-braid-heads group (gnus-sorted-intersection
+ cached articles))
+ type)))))))
(defun gnus-cache-enter-article (&optional n)
"Enter the next N articles into the cache.
@@ -516,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
@@ -527,6 +529,70 @@ Returns the list of articles removed."
(setq gnus-cache-active-altered t)))
articles)))
+(defun gnus-cache-braid-nov (group cached &optional file)
+ (let ((cache-buf (gnus-get-buffer-create " *gnus-cache*"))
+ beg end)
+ (gnus-cache-save-buffers)
+ (with-current-buffer cache-buf
+ (erase-buffer)
+ (let ((coding-system-for-read gnus-cache-overview-coding-system)
+ (file-name-coding-system nnmail-pathname-coding-system))
+ (insert-file-contents
+ (or file (gnus-cache-file-name group ".overview"))))
+ (goto-char (point-min))
+ (insert "\n")
+ (goto-char (point-min)))
+ (set-buffer nntp-server-buffer)
+ (goto-char (point-min))
+ (while cached
+ (while (and (not (eobp))
+ (< (read (current-buffer)) (car cached)))
+ (forward-line 1))
+ (beginning-of-line)
+ (set-buffer cache-buf)
+ (if (search-forward (concat "\n" (int-to-string (car cached)) "\t")
+ nil t)
+ (setq beg (point-at-bol)
+ end (progn (end-of-line) (point)))
+ (setq beg nil))
+ (set-buffer nntp-server-buffer)
+ (when beg
+ (insert-buffer-substring cache-buf beg end)
+ (insert "\n"))
+ (setq cached (cdr cached)))
+ (kill-buffer cache-buf)))
+
+(defun gnus-cache-braid-heads (group cached)
+ (let ((cache-buf (gnus-get-buffer-create " *gnus-cache*")))
+ (with-current-buffer cache-buf
+ (erase-buffer))
+ (set-buffer nntp-server-buffer)
+ (goto-char (point-min))
+ (dolist (entry cached)
+ (while (and (not (eobp))
+ (looking-at "2.. +\\([0-9]+\\) ")
+ (< (progn (goto-char (match-beginning 1))
+ (read (current-buffer)))
+ entry))
+ (search-forward "\n.\n" nil 'move))
+ (beginning-of-line)
+ (set-buffer cache-buf)
+ (erase-buffer)
+ (let ((coding-system-for-read gnus-cache-coding-system)
+ (file-name-coding-system nnmail-pathname-coding-system))
+ (insert-file-contents (gnus-cache-file-name group entry)))
+ (goto-char (point-min))
+ (insert "220 ")
+ (princ (pop cached) (current-buffer))
+ (insert " Article retrieved.\n")
+ (search-forward "\n\n" nil 'move)
+ (delete-region (point) (point-max))
+ (forward-char -1)
+ (insert ".")
+ (set-buffer nntp-server-buffer)
+ (insert-buffer-substring cache-buf))
+ (kill-buffer cache-buf)))
+
;;;###autoload
(defun gnus-jog-cache ()
"Go through all groups and put the articles into the cache.
@@ -648,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))
@@ -664,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."
@@ -818,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 d02e898e230..96f1a7de5ec 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 00b85f546c2..3bc94f11e79 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.
@@ -30,8 +30,6 @@
(require 'parse-time)
(require 'nnimap)
-(declare-function gnus-fetch-headers "gnus-sum")
-(defvar gnus-alter-header-function)
(eval-when-compile (require 'epg)) ;; setf-method for `epg-context-armor'
(autoload 'epg-make-context "epg")
@@ -54,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)
@@ -70,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")
@@ -83,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")))
@@ -134,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
@@ -350,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."
@@ -393,6 +387,8 @@ When FULL is t, upload everything, not just a difference from the last full."
(gnus-group-refresh-group group))
(gnus-error 2 "Failed to upload Gnus Cloud data to %s" group)))))
+(defvar gnus-alter-header-function)
+
(defun gnus-cloud-add-timestamps (elems)
(dolist (elem elems)
(let* ((file-name (plist-get elem :file-name))
@@ -407,10 +403,14 @@ When FULL is t, upload everything, not just a difference from the last full."
(gnus-activate-group gnus-cloud-group-name nil nil gnus-cloud-method)
(let* ((group (gnus-group-full-name gnus-cloud-group-name gnus-cloud-method))
(active (gnus-active group))
- (gnus-newsgroup-name group)
- (headers (gnus-fetch-headers (gnus-uncompress-range active))))
- (when gnus-alter-header-function
- (mapc gnus-alter-header-function headers))
+ headers head)
+ (when (gnus-retrieve-headers (gnus-uncompress-range active) group)
+ (with-current-buffer nntp-server-buffer
+ (goto-char (point-min))
+ (while (setq head (nnheader-parse-head))
+ (when gnus-alter-header-function
+ (funcall gnus-alter-header-function head))
+ (push head headers))))
(sort (nreverse headers)
(lambda (h1 h2)
(> (gnus-cloud-chunk-sequence (mail-header-subject h1))
diff --git a/lisp/gnus/gnus-cus.el b/lisp/gnus/gnus-cus.el
index dc14943a060..d8f48b19f87 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 477ad88a9ca..0cee01b9428 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 219f15e2227..e99247c0ca9 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 78f1e53ff7a..52705640bf0 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 6f231c4fbb8..ca2d57de7dc 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 5f7ed386297..f68e9d6b749 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 f7d61bb35fc..e4f3da94573 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 feee7326cd2..265edf4d612 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 615f4a55bc5..f69c2ed12c2 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 a7ca733e755..9ea9e100316 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 ff792c57065..3661b6376df 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)
@@ -476,20 +477,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 +517,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 +529,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 +1375,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 +1386,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 +1511,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 +1559,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 +1583,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)
@@ -1608,7 +1627,7 @@ Some value are bound so the form can use them."
(cons 'unread (if (numberp (car entry)) (car entry) 0))
(cons 'total (if active (1+ (- (cdr active) (car active))) 0))
(cons 'mailp (apply
- 'append
+ #'append
(mapcar
(lambda (x)
(memq x (assoc
@@ -1735,7 +1754,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 +1902,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 +1950,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 +1961,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 +2004,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 +2070,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 +2533,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 +2819,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 +2938,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 +2997,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 +3007,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 +3130,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 +3138,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 +3386,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 +4280,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 +4339,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 +4506,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 +4628,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 +4698,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 +4760,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 +4822,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 bb1ee5a806a..be62bfd81f5 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-icalendar.el b/lisp/gnus/gnus-icalendar.el
index 1e0e2071018..9811e8b440f 100644
--- a/lisp/gnus/gnus-icalendar.el
+++ b/lisp/gnus/gnus-icalendar.el
@@ -835,6 +835,7 @@ These will be used to retrieve the RSVP information from ical events."
keymap ,gnus-mime-button-map
face ,gnus-article-button-face
follow-link t
+ category t
button t
gnus-data ,data))))
diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el
index 9c68773e19a..64928623e6a 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 7e592026cd0..b0e6cb59d52 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 105222d6797..cdfdc9b7319 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 b26b736d055..fc8d9be8d6d 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 a47c15525a3..3b2b5a07c1d 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 ed8d15a2feb..d42f0971259 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 419b5ead563..45e665be8c3 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 e772dd8e625..a4d198b46e4 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 92def9a72d0..7927b88c3de 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 1e5d2a066f6..6cc60cb49b3 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 068066e38c9..147550d8cf3 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 107e96350bb..5697c870888 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 abaa844f58a..e222d24b694 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 e74c4980879..ade0897a16a 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 5c6a5b9efd0..f3e08519c3e 100644
--- a/lisp/gnus/gnus-search.el
+++ b/lisp/gnus/gnus-search.el
@@ -123,8 +123,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 +132,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 +144,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 +159,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 +167,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 +197,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 +206,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 +226,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 +246,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 +261,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 +291,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 +300,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 +336,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 +345,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 +367,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 +375,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 +383,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))
@@ -909,6 +877,7 @@ quirks.")
(defclass gnus-search-namazu (gnus-search-indexed)
((index-directory
:initarg :index-directory
+ :initform (symbol-value 'gnus-search-namazu-index-directory)
:type string
:custom directory)
(program
@@ -938,7 +907,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)
@@ -1858,7 +1826,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)
@@ -1893,7 +1861,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)
@@ -1906,7 +1874,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 3b79d578644..5dcd079fb48 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 a5228551396..cb60108ea9c 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 34e5ceb3f67..a305e343f69 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 fbdbf41dc05..1554635a3f2 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 "^"))
@@ -637,7 +637,7 @@ the first newsgroup."
;; We subscribe the group by changing its level to `subscribed'.
(gnus-group-change-level
newsgroup gnus-level-default-subscribed
- gnus-level-killed (or next "dummy.group"))
+ gnus-level-killed next)
(gnus-request-update-group-status newsgroup 'subscribe)
(gnus-message 5 "Subscribe newsgroup: %s" newsgroup)
(run-hook-with-args 'gnus-subscribe-newsgroup-functions newsgroup)
@@ -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'.
@@ -1282,7 +1278,8 @@ string name) to insert this group before."
(gnus-dribble-enter
(format "(gnus-group-change-level %S %S %S %S %S)"
group level oldlevel
- (cadr (member previous gnus-group-list))
+ (when previous
+ (cadr (member previous gnus-group-list)))
fromkilled)))
;; Then we remove the newgroup from any old structures, if needed.
@@ -1341,9 +1338,10 @@ string name) to insert this group before."
;; at the head of `gnus-newsrc-alist'.
(push info (cdr gnus-newsrc-alist))
(puthash group (list num info) gnus-newsrc-hashtb)
- (when (stringp previous)
+ (when (and previous (stringp previous))
(setq previous (gnus-group-entry previous)))
- (let ((idx (or (seq-position gnus-group-list (caadr previous))
+ (let ((idx (or (and previous
+ (seq-position gnus-group-list (caadr previous)))
(length gnus-group-list))))
(push group (nthcdr idx gnus-group-list)))
(gnus-dribble-enter
@@ -2248,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))
@@ -2340,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."
@@ -2992,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")
@@ -3100,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))))
@@ -3160,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 5bd58b690af..456e7b0f8c4 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)
@@ -5658,21 +5658,10 @@ or a straight list of headers."
(setf (mail-header-subject header) subject))))))
(defun gnus-fetch-headers (articles &optional limit force-new dependencies)
- "Fetch headers of ARTICLES.
-This calls the `gnus-retrieve-headers' function of the current
-group's backend server. The server can do one of two things:
-
-1. Write the headers for ARTICLES into the
- `nntp-server-buffer' (the current buffer) in a parseable format, or
-2. Return the headers directly as a list of vectors.
-
-In the first case, `gnus-retrieve-headers' returns a symbol
-value, either `nov' or `headers'. This value determines which
-parsing function is used to read the headers. It is also stored
-into the variable `gnus-headers-retrieved-by', which is consulted
-later when possibly building full threads."
+ "Fetch headers of ARTICLES."
(gnus-message 7 "Fetching headers for %s..." gnus-newsgroup-name)
- (let ((res (setq gnus-headers-retrieved-by
+ (prog1
+ (pcase (setq gnus-headers-retrieved-by
(gnus-retrieve-headers
articles gnus-newsgroup-name
(or limit
@@ -5682,34 +5671,22 @@ later when possibly building full threads."
(not (eq gnus-fetch-old-headers 'some))
(not (numberp gnus-fetch-old-headers)))
(> (length articles) 1))
- gnus-fetch-old-headers))))))
- (prog1
- (pcase res
- ('nov
- (gnus-get-newsgroup-headers-xover
- articles force-new dependencies gnus-newsgroup-name t))
- ;; For now, assume that any backend returning its own
- ;; headers takes some effort to do so, so return `headers'.
- ((pred listp)
- (setq gnus-headers-retrieved-by 'headers)
- (let ((dependencies
- (or dependencies
- (buffer-local-value
- 'gnus-newsgroup-dependencies gnus-summary-buffer))))
- (when (functionp gnus-alter-header-function)
- (mapc gnus-alter-header-function res))
- (mapc (lambda (header)
- ;; The agent or the cache may have already
- ;; registered this header in the dependency
- ;; table.
- (unless (gethash (mail-header-id header) dependencies)
- (gnus-dependencies-add-header
- header dependencies force-new)))
- res)
- res))
- (_ (gnus-get-newsgroup-headers dependencies force-new)))
- (gnus-message 7 "Fetching headers for %s...done"
- gnus-newsgroup-name))))
+ gnus-fetch-old-headers))))
+ ('nov
+ (gnus-get-newsgroup-headers-xover
+ articles force-new dependencies gnus-newsgroup-name t))
+ ('headers
+ (gnus-get-newsgroup-headers dependencies force-new))
+ ((pred listp)
+ (let ((dependencies
+ (or dependencies
+ (with-current-buffer gnus-summary-buffer
+ gnus-newsgroup-dependencies))))
+ (delq nil (mapcar #'(lambda (header)
+ (gnus-dependencies-add-header
+ header dependencies force-new))
+ gnus-headers-retrieved-by)))))
+ (gnus-message 7 "Fetching headers for %s...done" gnus-newsgroup-name)))
(defun gnus-select-newsgroup (group &optional read-all select-articles)
"Select newsgroup GROUP.
@@ -6288,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
@@ -6466,10 +6443,6 @@ The resulting hash table is returned, or nil if no Xrefs were found."
(unless (gnus-ephemeral-group-p group)
(gnus-group-update-group group t))))))
-;; FIXME: Refactor this with `gnus-get-newsgroup-headers-xover' and
-;; extract the necessary bits for the direct-header-return case. Also
-;; look at this and see how similar it is to
-;; `nnheader-parse-naked-head'.
(defun gnus-get-newsgroup-headers (&optional dependencies force-new)
(let ((dependencies
(or dependencies
@@ -7890,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))
@@ -10644,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.
@@ -10701,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)
@@ -12393,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
@@ -12983,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 8a77c532d29..e7d1cf86161 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
@@ -644,7 +640,14 @@ 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
+ `((indentation . ,indentation)
+ (visible . ,visible)
+ (name . ,name)
+ (level . ,level)
+ (number-of-groups . ,number-of-groups)
+ (total-number-of-articles . ,total-number-of-articles)
+ (entries . ,entries))))
(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 b1c1fb832fe..64ed2bbad6b 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 de3c854ca56..3c7c948c2b5 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,16 +1055,16 @@ 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
@@ -1197,6 +1140,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 +1163,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 +1205,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 +1213,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 +1234,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 +1295,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 +1353,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 +1383,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 +1407,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 +1449,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 +1506,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 +1532,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 +1566,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 +1582,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 +1685,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 db0ffc6d0df..32a87851549 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 533b1e2a580..b7e6b2a8890 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 3fb8e469d04..8ac4e39fa52 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 2e9ee7189d2..84e53da297b 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -2388,14 +2388,7 @@ Typical marks are those that make no sense in a standalone back end,
such as a mark that says whether an article is stored in the cache
\(which doesn't make sense in a standalone back end).")
-(defvar gnus-headers-retrieved-by nil
- "Holds the return value of `gnus-retrieve-headers'.
-This is either the symbol `nov' or the symbol `headers'. This
-value is checked during the summary creation process, when
-building threads. A value of `nov' indicates that header
-retrieval is relatively cheap and threading is encouraged to
-include more old articles. A value of `headers' indicates that
-retrieval is expensive and should be minimized.")
+(defvar gnus-headers-retrieved-by nil)
(defvar gnus-article-reply nil)
(defvar gnus-override-method nil)
(defvar gnus-opened-servers nil)
@@ -3508,7 +3501,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."
@@ -3731,7 +3724,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 20562fb9ad2..6ff2a4e2851 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 b47e69ffa4b..091e3899c26 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 52470196f62..af0a1983766 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 b22b4543e71..d2a0092fde9 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -47,7 +47,7 @@
(require 'rfc2047)
(require 'puny)
(require 'rmc) ; read-multiple-choice
-(eval-when-compile (require 'subr-x))
+(require 'subr-x)
(autoload 'mailclient-send-it "mailclient")
@@ -620,8 +620,8 @@ Done before generating the new subject of a forward."
(defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus"
"All headers that match this regexp will be deleted when forwarding a message.
-This variable is not consulted when forwarding encrypted messages
-and `message-forward-show-mml' is `best'.
+Also see `message-forward-included-headers' -- both variables are applied.
+In addition, see `message-forward-included-mime-headers'.
This may also be a list of regexps."
:version "21.1"
@@ -637,7 +637,14 @@ This may also be a list of regexps."
'("^From:" "^Subject:" "^Date:" "^To:" "^Cc:")
"If non-nil, delete non-matching headers when forwarding a message.
Only headers that match this regexp will be included. This
-variable should be a regexp or a list of regexps."
+variable should be a regexp or a list of regexps.
+
+Also see `message-forward-ignored-headers' -- both variables are applied.
+In addition, see `message-forward-included-mime-headers'.
+
+When forwarding messages as MIME, but when
+`message-forward-show-mml' results in MML not being used,
+`message-forward-included-mime-headers' take precedence."
:version "27.1"
:group 'message-forwarding
:type '(repeat :value-to-internal (lambda (widget value)
@@ -647,6 +654,24 @@ variable should be a regexp or a list of regexps."
(widget-editable-list-match widget value)))
regexp))
+(defcustom message-forward-included-mime-headers
+ '("^Content-Type:" "^MIME-Version:")
+ "When forwarding as MIME, but not using MML, don't delete these headers.
+Also see `message-forward-ignored-headers' and
+`message-forward-ignored-headers'.
+
+When forwarding messages as MIME, but when
+`message-forward-show-mml' results in MML not being used,
+`message-forward-included-mime-headers' take precedence."
+ :version "28.1"
+ :group 'message-forwarding
+ :type '(repeat :value-to-internal (lambda (widget value)
+ (custom-split-regexp-maybe value))
+ :match (lambda (widget value)
+ (or (stringp value)
+ (widget-editable-list-match widget value)))
+ regexp))
+
(defcustom message-ignored-cited-headers "."
"Delete these headers from the messages you yank."
:group 'message-insertion
@@ -2170,10 +2195,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))
@@ -3148,7 +3174,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
@@ -3172,7 +3198,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))
@@ -3649,7 +3675,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
@@ -3966,11 +3992,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."
@@ -4039,7 +4066,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"))
@@ -4530,7 +4557,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)))
@@ -4601,7 +4628,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."
@@ -4917,7 +4944,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
@@ -4925,7 +4952,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")
@@ -4977,7 +5004,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.
@@ -5369,7 +5396,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)
@@ -6036,7 +6063,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
@@ -6053,11 +6080,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
@@ -6078,7 +6105,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)
@@ -6544,7 +6571,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) "")
"*")))
@@ -6558,7 +6585,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) "")
"*")))
@@ -6587,7 +6614,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)
@@ -6943,8 +6970,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")
@@ -7028,7 +7055,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
@@ -7062,7 +7089,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)
@@ -7617,14 +7644,28 @@ Optional DIGEST will use digest to forward."
"-------------------- End of forwarded message --------------------\n")
(message-remove-ignored-headers b e)))
-(defun message-remove-ignored-headers (b e)
+(defun message-remove-ignored-headers (b e &optional preserve-mime)
(when (or message-forward-ignored-headers
message-forward-included-headers)
+ (let ((saved-headers nil))
(save-restriction
(narrow-to-region b e)
(goto-char b)
(narrow-to-region (point)
(or (search-forward "\n\n" nil t) (point)))
+ ;; When forwarding as MIME, preserve some MIME headers.
+ (when preserve-mime
+ (let ((headers (buffer-string)))
+ (with-temp-buffer
+ (insert headers)
+ (message-remove-header
+ (if (listp message-forward-included-mime-headers)
+ (mapconcat
+ #'identity (cons "^$" message-forward-included-mime-headers)
+ "\\|")
+ message-forward-included-mime-headers)
+ t nil t)
+ (setq saved-headers (string-lines (buffer-string) t)))))
(when message-forward-ignored-headers
(let ((ignored (if (stringp message-forward-ignored-headers)
(list message-forward-ignored-headers)
@@ -7637,10 +7678,14 @@ Optional DIGEST will use digest to forward."
(mapconcat #'identity (cons "^$" message-forward-included-headers)
"\\|")
message-forward-included-headers)
- t nil t)))))
+ t nil t))
+ ;; Insert the MIME headers, if any.
+ (goto-char (point-max))
+ (forward-line -1)
+ (dolist (header saved-headers)
+ (insert header "\n"))))))
-(defun message-forward-make-body-mime (forward-buffer &optional beg end
- remove-headers)
+(defun message-forward-make-body-mime (forward-buffer &optional beg end)
(let ((b (point)))
(insert "\n\n<#part type=message/rfc822 disposition=inline raw=t>\n")
(save-restriction
@@ -7650,8 +7695,7 @@ Optional DIGEST will use digest to forward."
(goto-char (point-min))
(when (looking-at "From ")
(replace-match "X-From-Line: "))
- (when remove-headers
- (message-remove-ignored-headers (point-min) (point-max)))
+ (message-remove-ignored-headers (point-min) (point-max) t)
(goto-char (point-max)))
(insert "<#/part>\n")
;; Consider there is no illegible text.
@@ -7790,8 +7834,7 @@ is for the internal use."
(message-signed-or-encrypted-p)
(error t))))))
(message-forward-make-body-mml forward-buffer)
- (message-forward-make-body-mime
- forward-buffer nil nil (not (eq message-forward-show-mml 'best))))
+ (message-forward-make-body-mime forward-buffer))
(message-forward-make-body-plain forward-buffer)))
(message-position-point))
@@ -8325,7 +8368,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 635e7f4ee84..1ecceeedeb7 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 f35ba3a0b91..d6b71f15e54 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 61946aa5811..02cd6af0c98 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 8bd3e0b3d2d..84a3b0a8d1c 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 165c19139ce..0c25c8f8bcd 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 412a4744125..3d58738d637 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 db42bfa4b10..92e04f9d2ee 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 \"&#128;\" 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 0683703a4ea..3e36d6724ea 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 c117a3866ab..8d01d15ca01 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"))))))
@@ -346,8 +346,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 +558,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 +622,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 +795,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 +906,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 5baeaffa53a..5c133e680af 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 424215de941..f77e5c6434e 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 a87e642c07d..05f44a1cbd8 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 8eda59372fb..1af7d10d055 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 f2acea4fa64..76a7e21567a 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 130f56ad92f..3e6f9e88eea 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 b3e83e494d7..15003fabcd2 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 46351d0004f..bfc22836583 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 a3a66454853..172433ef3b8 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 1f87beda5f5..394b6fcc4fc 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 014ad3adfb1..d881d6ce055 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 9a0219c1436..1dd784d5a5b 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 15e4876642c..c10989aa1e9 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 a381720f24c..708887cb9c7 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 121513117b2..f4f4ef89a9e 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 d043ae1b426..9826bc6172c 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 2a4c74db5e8..46691e3494b 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 c061031b40a..c6aaf460ece 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 a4863c3e1fa..66c22670b23 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 82ed091982e..231583fae83 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 ebececa3ce2..18acc73aadd 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)
@@ -769,8 +769,24 @@ article number. This function is called narrowed to an article."
(let ((headers (nnheader-parse-head t)))
(setf (mail-header-chars headers) chars)
(setf (mail-header-number headers) number)
+ ;; If there's non-ASCII raw characters in the data,
+ ;; RFC2047-encode them to avoid having arbitrary data in the
+ ;; .overview file.
+ (nnml--encode-headers headers)
headers))))
+(defun nnml--encode-headers (headers)
+ (let ((subject (mail-header-subject headers))
+ (rfc2047-encoding-type 'mime))
+ (unless (string-match "\\`[[:ascii:]]*\\'" subject)
+ (setf (mail-header-subject headers)
+ (mail-encode-encoded-word-string subject t))))
+ (let ((from (mail-header-from headers))
+ (rfc2047-encoding-type 'address-mime))
+ (unless (string-match "\\`[[:ascii:]]*\\'" from)
+ (setf (mail-header-from headers)
+ (rfc2047-encode-string from t)))))
+
(defun nnml-get-nov-buffer (group &optional incrementalp)
(let ((buffer (gnus-get-buffer-create
(format " *nnml %soverview %s*"
@@ -840,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))
@@ -873,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)
@@ -994,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 7d400791fa2..36a8bc4581b 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 9bb86d65aba..7759951662a 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 e78f93d829a..15e41e9d425 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 f9e0a08a06e..aa7c8e584a5 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 ba0e60a2673..fffa2d27312 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 9de59d8631d..ce9ab3c53c1 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 c2bb960f945..1eb604d6754 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 ba2934351d6..b3b701e4126 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,17 +94,22 @@ 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)
(if (stringp (car articles))
'headers
- (let ((carticles (nnvirtual-partition-sequence articles))
+ (let ((vbuf (nnheader-set-temp-buffer
+ (gnus-get-buffer-create " *virtual headers*")))
+ (carticles (nnvirtual-partition-sequence articles))
(sysname (system-name))
- cgroup headers all-headers article prefix)
- (pcase-dolist (`(,cgroup . ,articles) carticles)
+ cgroup carticle article result prefix)
+ (while carticles
+ (setq cgroup (caar carticles))
+ (setq articles (cdar carticles))
+ (pop carticles)
(when (and articles
(gnus-check-server
(gnus-find-method-for-group cgroup) t)
@@ -114,42 +119,74 @@ It is computed from the marks of individual component groups.")
;; This is probably evil if people have set
;; gnus-use-cache to nil themselves, but I
;; have no way of finding the true value of it.
- (let ((gnus-use-cache t)
- (gnus-newsgroup-name cgroup)
- (gnus-fetch-old-headers nil))
- (setq headers (gnus-fetch-headers articles))))
- (erase-buffer)
- ;; Remove all header article numbers from `articles'.
- ;; If there's anything left, those are expired or
- ;; canceled articles, so we update the component group
- ;; below.
- (dolist (h headers)
- (setq articles (delq (mail-header-number h) articles)
- article (nnvirtual-reverse-map-article
- cgroup (mail-header-number h)))
- ;; Update all the header numbers according to their
- ;; reverse mapping, and drop any with no such mapping.
- (when article
- ;; Do this first, before we re-set the header's
- ;; article number.
- (nnvirtual-update-xref-header
- h cgroup prefix sysname)
- (setf (mail-header-number h) article)
- (push h all-headers)))
- ;; Anything left in articles is expired or canceled.
- ;; Could be smart and not tell it about articles already
- ;; known?
- (when articles
- (gnus-group-make-articles-read cgroup articles))))
-
- (sort all-headers (lambda (h1 h2)
- (< (mail-header-number h1)
- (mail-header-number h2)))))))))
+ (let ((gnus-use-cache t))
+ (setq result (gnus-retrieve-headers
+ articles cgroup nil))))
+ (set-buffer nntp-server-buffer)
+ ;; If we got HEAD headers, we convert them into NOV
+ ;; headers. This is slow, inefficient and, come to think
+ ;; of it, downright evil. So sue me. I couldn't be
+ ;; bothered to write a header parse routine that could
+ ;; parse a mixed HEAD/NOV buffer.
+ (when (eq result 'headers)
+ (nnvirtual-convert-headers))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (delete-region (point)
+ (progn
+ (setq carticle (read nntp-server-buffer))
+ (point)))
+
+ ;; We remove this article from the articles list, if
+ ;; anything is left in the articles list after going through
+ ;; the entire buffer, then those articles have been
+ ;; expired or canceled, so we appropriately update the
+ ;; component group below. They should be coming up
+ ;; generally in order, so this shouldn't be slow.
+ (setq articles (delq carticle articles))
+
+ (setq article (nnvirtual-reverse-map-article cgroup carticle))
+ (if (null article)
+ ;; This line has no reverse mapping, that means it
+ ;; was an extra article reference returned by nntp.
+ (progn
+ (beginning-of-line)
+ (delete-region (point) (progn (forward-line 1) (point))))
+ ;; Otherwise insert the virtual article number,
+ ;; and clean up the xrefs.
+ (princ article nntp-server-buffer)
+ (nnvirtual-update-xref-header cgroup carticle
+ prefix sysname)
+ (forward-line 1))
+ )
+
+ (set-buffer vbuf)
+ (goto-char (point-max))
+ (insert-buffer-substring nntp-server-buffer))
+ ;; Anything left in articles is expired or canceled.
+ ;; Could be smart and not tell it about articles already known?
+ (when articles
+ (gnus-group-make-articles-read cgroup articles))
+ )
+
+ ;; The headers are ready for reading, so they are inserted into
+ ;; the nntp-server-buffer, which is where Gnus expects to find
+ ;; them.
+ (prog1
+ (with-current-buffer nntp-server-buffer
+ (erase-buffer)
+ (insert-buffer-substring vbuf)
+ ;; FIX FIX FIX, we should be able to sort faster than
+ ;; this if needed, since each cgroup is sorted, we just
+ ;; need to merge
+ (sort-numeric-fields 1 (point-min) (point-max))
+ 'nov)
+ (kill-buffer vbuf)))))))
(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.
@@ -213,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))
@@ -232,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)
@@ -242,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
@@ -254,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
@@ -284,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
@@ -302,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
@@ -316,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))
@@ -330,23 +367,66 @@ 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.
-(defun nnvirtual-update-xref-header (header group prefix sysname)
- "Add xref to component GROUP to HEADER.
-Also add a server PREFIX any existing xref lines."
- (let ((bits (split-string (mail-header-xref header)
- nil t "[[:blank:]]"))
- (art-no (mail-header-number header)))
- (setf (mail-header-xref header)
- (concat
- (format "%s %s:%d " sysname group art-no)
- (mapconcat (lambda (bit)
- (concat prefix bit))
- bits " ")))))
+(defun nnvirtual-convert-headers ()
+ "Convert HEAD headers into NOV headers."
+ (with-current-buffer nntp-server-buffer
+ (let* ((dependencies (make-hash-table :test #'equal))
+ (headers (gnus-get-newsgroup-headers dependencies)))
+ (erase-buffer)
+ (mapc #'nnheader-insert-nov headers))))
+
+
+(defun nnvirtual-update-xref-header (group article prefix sysname)
+ "Edit current NOV header in current buffer to have an xref to the component group, and also server prefix any existing xref lines."
+ ;; Move to beginning of Xref field, creating a slot if needed.
+ (beginning-of-line)
+ (looking-at
+ "[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t")
+ (goto-char (match-end 0))
+ (unless (search-forward "\t" (point-at-eol) 'move)
+ (insert "\t"))
+
+ ;; Remove any spaces at the beginning of the Xref field.
+ (while (eq (char-after (1- (point))) ? )
+ (forward-char -1)
+ (delete-char 1))
+
+ (insert "Xref: " sysname " " group ":")
+ (princ article (current-buffer))
+ (insert " ")
+
+ ;; If there were existing xref lines, clean them up to have the correct
+ ;; component server prefix.
+ (save-restriction
+ (narrow-to-region (point)
+ (or (search-forward "\t" (point-at-eol) t)
+ (point-at-eol)))
+ (goto-char (point-min))
+ (when (re-search-forward "Xref: *[^\n:0-9 ]+ *" nil t)
+ (replace-match "" t t))
+ (goto-char (point-min))
+ (when (re-search-forward
+ (concat (regexp-quote (gnus-group-real-name group)) ":[0-9]+")
+ nil t)
+ (replace-match "" t t))
+ (unless (eobp)
+ (insert " ")
+ (when (not (string= "" prefix))
+ (while (re-search-forward "[^ ]+:[0-9]+" nil t)
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (insert prefix))))))
+
+ ;; Ensure a trailing \t.
+ (end-of-line)
+ (or (eq (char-after (1- (point))) ?\t)
+ (insert ?\t)))
+
(defun nnvirtual-possibly-change-server (server)
(or (not server)
@@ -422,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
@@ -568,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)
@@ -670,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)))
@@ -680,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 b8fb4a8373a..f08dc47e313 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 b8726c03c3e..d3ed3600ad9 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 d9e04f3b40c..3ee59479cf5 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 ae5d171d871..8900be5e4f1 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 8c148ce9d91..d87a6c2af0d 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 3662ade2663..70753cad9ca 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 1d00a39060d..bb2a1b97ada 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 22810332b65..f7288c98f6f 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/hl-line.el b/lisp/hl-line.el
index 73870f9579e..82952e934b6 100644
--- a/lisp/hl-line.el
+++ b/lisp/hl-line.el
@@ -45,11 +45,7 @@
;; An overlay is used. In the non-sticky cases, this overlay is
;; active only on the selected window. A hook is added to
;; `post-command-hook' to activate the overlay and move it to the line
-;; about point. To get the non-sticky behavior, `hl-line-unhighlight'
-;; is added to `pre-command-hook' as well. This function deactivates
-;; the overlay unconditionally in case the command changes the
-;; selected window. (It does so rather than keeping track of changes
-;; in the selected window).
+;; about point.
;; You could make variable `global-hl-line-mode' buffer-local and set
;; it to nil to avoid highlighting specific buffers, when the global
@@ -91,9 +87,9 @@ when `global-hl-line-sticky-flag' is non-nil.")
(set symbol value)
(dolist (buffer (buffer-list))
(with-current-buffer buffer
- (when hl-line-overlay
+ (when (overlayp hl-line-overlay)
(overlay-put hl-line-overlay 'face hl-line-face))))
- (when global-hl-line-overlay
+ (when (overlayp global-hl-line-overlay)
(overlay-put global-hl-line-overlay 'face hl-line-face))))
(defcustom hl-line-sticky-flag t
@@ -141,9 +137,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."
:group 'hl-line
(if hl-line-mode
(progn
@@ -151,12 +145,10 @@ addition to `hl-line-highlight' on `post-command-hook'."
(add-hook 'change-major-mode-hook #'hl-line-unhighlight nil t)
(hl-line-highlight)
(setq hl-line-overlay-buffer (current-buffer))
- (add-hook 'post-command-hook #'hl-line-highlight nil t)
- (add-hook 'post-command-hook #'hl-line-maybe-unhighlight nil t))
+ (add-hook 'post-command-hook #'hl-line-highlight nil t))
(remove-hook 'post-command-hook #'hl-line-highlight t)
(hl-line-unhighlight)
- (remove-hook 'change-major-mode-hook #'hl-line-unhighlight t)
- (remove-hook 'post-command-hook #'hl-line-maybe-unhighlight t)))
+ (remove-hook 'change-major-mode-hook #'hl-line-unhighlight t)))
(defun hl-line-make-overlay ()
(let ((ol (make-overlay (point) (point))))
@@ -168,17 +160,19 @@ addition to `hl-line-highlight' on `post-command-hook'."
"Activate the Hl-Line overlay on the current line."
(if hl-line-mode ; Might be changed outside the mode function.
(progn
- (unless hl-line-overlay
+ (unless (overlayp hl-line-overlay)
(setq hl-line-overlay (hl-line-make-overlay))) ; To be moved.
(overlay-put hl-line-overlay
'window (unless hl-line-sticky-flag (selected-window)))
- (hl-line-move hl-line-overlay))
+ (hl-line-move hl-line-overlay)
+ (hl-line-maybe-unhighlight))
(hl-line-unhighlight)))
(defun hl-line-unhighlight ()
"Deactivate the Hl-Line overlay on the current line."
- (when hl-line-overlay
- (delete-overlay hl-line-overlay)))
+ (when (overlayp hl-line-overlay)
+ (delete-overlay hl-line-overlay)
+ (setq hl-line-overlay nil)))
(defun hl-line-maybe-unhighlight ()
"Maybe deactivate the Hl-Line overlay on the current line.
@@ -191,8 +185,7 @@ such overlays in all buffers except the current one."
(not (eq curbuf hlob))
(not (minibufferp)))
(with-current-buffer hlob
- (when (overlayp hl-line-overlay)
- (delete-overlay hl-line-overlay))))
+ (hl-line-unhighlight)))
(when (and (overlayp hl-line-overlay)
(eq (overlay-buffer hl-line-overlay) curbuf))
(setq hl-line-overlay-buffer curbuf))))
@@ -205,8 +198,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'."
:global t
:group 'hl-line
(if global-hl-line-mode
@@ -214,25 +207,24 @@ and `global-hl-line-maybe-unhighlight' on `post-command-hook'."
;; In case `kill-all-local-variables' is called.
(add-hook 'change-major-mode-hook #'global-hl-line-unhighlight)
(global-hl-line-highlight-all)
- (add-hook 'post-command-hook #'global-hl-line-highlight)
- (add-hook 'post-command-hook #'global-hl-line-maybe-unhighlight))
+ (add-hook 'post-command-hook #'global-hl-line-highlight))
(global-hl-line-unhighlight-all)
(remove-hook 'post-command-hook #'global-hl-line-highlight)
- (remove-hook 'change-major-mode-hook #'global-hl-line-unhighlight)
- (remove-hook 'post-command-hook #'global-hl-line-maybe-unhighlight)))
+ (remove-hook 'change-major-mode-hook #'global-hl-line-unhighlight)))
(defun global-hl-line-highlight ()
"Highlight the current line in the current window."
(when global-hl-line-mode ; Might be changed outside the mode function.
(unless (window-minibuffer-p)
- (unless global-hl-line-overlay
+ (unless (overlayp global-hl-line-overlay)
(setq global-hl-line-overlay (hl-line-make-overlay))) ; To be moved.
(unless (member global-hl-line-overlay global-hl-line-overlays)
(push global-hl-line-overlay global-hl-line-overlays))
(overlay-put global-hl-line-overlay 'window
(unless global-hl-line-sticky-flag
(selected-window)))
- (hl-line-move global-hl-line-overlay))))
+ (hl-line-move global-hl-line-overlay)
+ (global-hl-line-maybe-unhighlight))))
(defun global-hl-line-highlight-all ()
"Highlight the current line in all live windows."
@@ -243,8 +235,9 @@ and `global-hl-line-maybe-unhighlight' on `post-command-hook'."
(defun global-hl-line-unhighlight ()
"Deactivate the Global-Hl-Line overlay on the current line."
- (when global-hl-line-overlay
- (delete-overlay global-hl-line-overlay)))
+ (when (overlayp global-hl-line-overlay)
+ (delete-overlay global-hl-line-overlay)
+ (setq global-hl-line-overlay nil)))
(defun global-hl-line-maybe-unhighlight ()
"Maybe deactivate the Global-Hl-Line overlay on the current line.
@@ -256,9 +249,8 @@ all such overlays in all buffers except the current one."
(bufferp ovb)
(not (eq ovb (current-buffer)))
(not (minibufferp)))
- (with-current-buffer ovb
- (when (overlayp global-hl-line-overlay)
- (delete-overlay global-hl-line-overlay))))))
+ (with-current-buffer ovb
+ (global-hl-line-unhighlight)))))
global-hl-line-overlays))
(defun global-hl-line-unhighlight-all ()
diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el
index ed5c9c02115..44574abd46a 100644
--- a/lisp/ibuf-ext.el
+++ b/lisp/ibuf-ext.el
@@ -1497,10 +1497,10 @@ Ordering is lexicographic."
(string-lessp
;; FIXME: For now just compare the file name and the process name
;; (if it exists). Is there a better way to do this?
- (or (buffer-file-name (car a))
+ (or (with-current-buffer (car a) (ibuffer-buffer-file-name))
(let ((pr-a (get-buffer-process (car a))))
(and (processp pr-a) (process-name pr-a))))
- (or (buffer-file-name (car b))
+ (or (with-current-buffer (car b) (ibuffer-buffer-file-name))
(let ((pr-b (get-buffer-process (car b))))
(and (processp pr-b) (process-name pr-b))))))
diff --git a/lisp/image.el b/lisp/image.el
index 814035594b6..6955a90de77 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -264,9 +264,9 @@ compatibility with versions of Emacs that lack the variable
;; Used to be in image-type-header-regexps, but now not used anywhere
;; (since 2009-08-28).
(defun image-jpeg-p (data)
- (declare (obsolete "It is unused inside Emacs and will be removed." "27.1"))
"Value is non-nil if DATA, a string, consists of JFIF image data.
We accept the tag Exif because that is the same format."
+ (declare (obsolete "It is unused inside Emacs and will be removed." "27.1"))
(setq data (ignore-errors (string-to-unibyte data)))
(when (and data (string-match-p "\\`\xff\xd8" data))
(catch 'jfif
diff --git a/lisp/image/gravatar.el b/lisp/image/gravatar.el
index 4f37834a27f..f6f056a2baf 100644
--- a/lisp/image/gravatar.el
+++ b/lisp/image/gravatar.el
@@ -160,16 +160,19 @@ to track whether you're reading a specific mail."
(cond
((and
result ;there is a result
- (let* ((data (mapcar (lambda (record)
+ (let* ((answers (dns-get 'answers result))
+ (data (mapcar (lambda (record)
(dns-get 'data (cdr record)))
- (dns-get 'answers result)))
+ ;; We may get junk data back (or CNAME;
+ ;; ignore).
+ (and (eq (dns-get 'type answers) 'SRV)
+ answers)))
(priorities (mapcar (lambda (r)
(dns-get 'priority r))
data))
- (max-priority (if priorities
- (apply #'max priorities)
- 0))
- (sum 0) top)
+ (max-priority (apply #'max 0 priorities))
+ (sum 0)
+ top)
;; Attempt to find all records with the same maximal
;; priority, and calculate the sum of their weights.
(dolist (ent data)
diff --git a/lisp/international/isearch-x.el b/lisp/international/isearch-x.el
index 400421ddb23..b890bde48d1 100644
--- a/lisp/international/isearch-x.el
+++ b/lisp/international/isearch-x.el
@@ -1,4 +1,4 @@
-;;; isearch-x.el --- extended isearch handling commands
+;;; isearch-x.el --- extended isearch handling commands -*- lexical-binding: t; -*-
;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
@@ -67,7 +67,7 @@
;; Exit from recursive edit safely. Set in `after-change-functions'
;; by isearch-with-keyboard-coding.
-(defun isearch-exit-recursive-edit (start end length)
+(defun isearch-exit-recursive-edit (_start _end _length)
(interactive)
(throw 'exit nil))
@@ -102,6 +102,7 @@
;;;###autoload
(defun isearch-process-search-multibyte-characters (last-char &optional count)
+ (defvar junk-hist)
(if (eq this-command 'isearch-printing-char)
(let ((overriding-terminal-local-map nil)
(prompt (isearch-message-prefix))
diff --git a/lisp/international/iso-cvt.el b/lisp/international/iso-cvt.el
index 3f3843e23dd..ead7c8aa619 100644
--- a/lisp/international/iso-cvt.el
+++ b/lisp/international/iso-cvt.el
@@ -1,4 +1,4 @@
-;;; iso-cvt.el --- translate ISO 8859-1 from/to various encodings -*- coding: utf-8 -*-
+;;; iso-cvt.el --- translate ISO 8859-1 from/to various encodings -*- lexical-binding: t; -*-
;; This file was formerly called gm-lingo.el.
;; Copyright (C) 1993-1998, 2000-2021 Free Software Foundation, Inc.
@@ -79,7 +79,7 @@
(point-max))))
;;;###autoload
-(defun iso-spanish (from to &optional buffer)
+(defun iso-spanish (from to &optional _buffer)
"Translate net conventions for Spanish to ISO 8859-1.
Translate the region between FROM and TO using the table
`iso-spanish-trans-tab'.
@@ -121,7 +121,7 @@ and may translate too little.")
"Currently active translation table for German.")
;;;###autoload
-(defun iso-german (from to &optional buffer)
+(defun iso-german (from to &optional _buffer)
"Translate net conventions for German to ISO 8859-1.
Translate the region FROM and TO using the table
`iso-german-trans-tab'.
@@ -194,7 +194,7 @@ Optional arg BUFFER is ignored (for use in `format-alist')."
"Translation table for translating ISO 8859-1 characters to TeX sequences.")
;;;###autoload
-(defun iso-iso2tex (from to &optional buffer)
+(defun iso-iso2tex (from to &optional _buffer)
"Translate ISO 8859-1 characters to TeX sequences.
Translate the region between FROM and TO using the table
`iso-iso2tex-trans-tab'.
@@ -387,7 +387,7 @@ This table is not exhaustive (and due to TeX's power can never be).
It only contains commonly used sequences.")
;;;###autoload
-(defun iso-tex2iso (from to &optional buffer)
+(defun iso-tex2iso (from to &optional _buffer)
"Translate TeX sequences to ISO 8859-1 characters.
Translate the region between FROM and TO using the table
`iso-tex2iso-trans-tab'.
@@ -646,7 +646,7 @@ It only contains commonly used sequences.")
"Translation table for translating ISO 8859-1 characters to German TeX.")
;;;###autoload
-(defun iso-gtex2iso (from to &optional buffer)
+(defun iso-gtex2iso (from to &optional _buffer)
"Translate German TeX sequences to ISO 8859-1 characters.
Translate the region between FROM and TO using the table
`iso-gtex2iso-trans-tab'.
@@ -655,7 +655,7 @@ Optional arg BUFFER is ignored (for use in `format-alist')."
(iso-translate-conventions from to iso-gtex2iso-trans-tab))
;;;###autoload
-(defun iso-iso2gtex (from to &optional buffer)
+(defun iso-iso2gtex (from to &optional _buffer)
"Translate ISO 8859-1 characters to German TeX sequences.
Translate the region between FROM and TO using the table
`iso-iso2gtex-trans-tab'.
@@ -674,7 +674,7 @@ Optional arg BUFFER is ignored (for use in `format-alist')."
"Translation table for translating ISO 8859-1 characters to Duden sequences.")
;;;###autoload
-(defun iso-iso2duden (from to &optional buffer)
+(defun iso-iso2duden (from to &optional _buffer)
"Translate ISO 8859-1 characters to Duden sequences.
Translate the region between FROM and TO using the table
`iso-iso2duden-trans-tab'.
@@ -812,7 +812,7 @@ Optional arg BUFFER is ignored (for use in `format-alist')."
("&yuml;" "ÿ")))
;;;###autoload
-(defun iso-iso2sgml (from to &optional buffer)
+(defun iso-iso2sgml (from to &optional _buffer)
"Translate ISO 8859-1 characters in the region to SGML entities.
Use entities from \"ISO 8879:1986//ENTITIES Added Latin 1//EN\".
Optional arg BUFFER is ignored (for use in `format-alist')."
@@ -820,7 +820,7 @@ Optional arg BUFFER is ignored (for use in `format-alist')."
(iso-translate-conventions from to iso-iso2sgml-trans-tab))
;;;###autoload
-(defun iso-sgml2iso (from to &optional buffer)
+(defun iso-sgml2iso (from to &optional _buffer)
"Translate SGML entities in the region to ISO 8859-1 characters.
Use entities from \"ISO 8879:1986//ENTITIES Added Latin 1//EN\".
Optional arg BUFFER is ignored (for use in `format-alist')."
@@ -828,13 +828,13 @@ Optional arg BUFFER is ignored (for use in `format-alist')."
(iso-translate-conventions from to iso-sgml2iso-trans-tab))
;;;###autoload
-(defun iso-cvt-read-only (&rest ignore)
+(defun iso-cvt-read-only (&rest _ignore)
"Warn that format is read-only."
(interactive)
(error "This format is read-only; specify another format for writing"))
;;;###autoload
-(defun iso-cvt-write-only (&rest ignore)
+(defun iso-cvt-write-only (&rest _ignore)
"Warn that format is write-only."
(interactive)
(error "This format is write-only"))
diff --git a/lisp/international/ja-dic-cnv.el b/lisp/international/ja-dic-cnv.el
index b80590491c1..3be7849df19 100644
--- a/lisp/international/ja-dic-cnv.el
+++ b/lisp/international/ja-dic-cnv.el
@@ -1,4 +1,4 @@
-;;; ja-dic-cnv.el --- convert a Japanese dictionary (SKK-JISYO.L) to Emacs Lisp
+;;; ja-dic-cnv.el --- convert a Japanese dictionary (SKK-JISYO.L) to Emacs Lisp -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
@@ -96,7 +96,7 @@
("ã‚‚ã" "ç›®")
("ゆã" "è¡Œ")))
-(defun skkdic-convert-postfix (skkbuf buf)
+(defun skkdic-convert-postfix (_skkbuf buf)
(byte-compile-info "Processing POSTFIX entries" t)
(goto-char (point-min))
(with-current-buffer buf
@@ -150,7 +150,7 @@
(defconst skkdic-prefix-list '(skkdic-prefix-list))
-(defun skkdic-convert-prefix (skkbuf buf)
+(defun skkdic-convert-prefix (_skkbuf buf)
(byte-compile-info "Processing PREFIX entries" t)
(goto-char (point-min))
(with-current-buffer buf
@@ -209,7 +209,7 @@
(substring str from idx)
skkdic-word-list)))
(if (or (and (consp kana2-list)
- (let ((kana-len (length kana))
+ (let (;; (kana-len (length kana))
kana2)
(catch 'skkdic-tag
(while kana2-list
@@ -342,7 +342,8 @@ The name of generated file is specified by the variable `ja-dic-filename'."
(with-current-buffer buf
(erase-buffer)
(buffer-disable-undo)
- (insert ";;; ja-dic.el --- dictionary for Japanese input method\n"
+ (insert ";;; ja-dic.el --- dictionary for Japanese input method"
+ " -*- lexical-binding:t -*-\n"
";;\tGenerated by the command `skkdic-convert'\n"
";;\tOriginal SKK dictionary file: "
(file-relative-name (expand-file-name filename) dirname)
diff --git a/lisp/international/ja-dic-utl.el b/lisp/international/ja-dic-utl.el
index 498fb23f707..cc636986f99 100644
--- a/lisp/international/ja-dic-utl.el
+++ b/lisp/international/ja-dic-utl.el
@@ -1,4 +1,4 @@
-;;; ja-dic-utl.el --- utilities for handling Japanese dictionary (SKK-JISYO.L)
+;;; ja-dic-utl.el --- utilities for handling Japanese dictionary (SKK-JISYO.L) -*- lexical-binding: t; -*-
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
diff --git a/lisp/international/kinsoku.el b/lisp/international/kinsoku.el
index cd740acc6ac..05179a98ac2 100644
--- a/lisp/international/kinsoku.el
+++ b/lisp/international/kinsoku.el
@@ -1,4 +1,4 @@
-;;; kinsoku.el --- `Kinsoku' processing funcs
+;;; kinsoku.el --- `Kinsoku' processing funcs -*- lexical-binding: t; -*-
;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
diff --git a/lisp/international/kkc.el b/lisp/international/kkc.el
index 290f4fa0cf1..87f73897bf6 100644
--- a/lisp/international/kkc.el
+++ b/lisp/international/kkc.el
@@ -1,4 +1,4 @@
-;;; kkc.el --- Kana Kanji converter
+;;; kkc.el --- Kana Kanji converter -*- lexical-binding: t; -*-
;; Copyright (C) 1997-1998, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
diff --git a/lisp/international/latexenc.el b/lisp/international/latexenc.el
index e2ee3fb37e3..ff7cddcb26e 100644
--- a/lisp/international/latexenc.el
+++ b/lisp/international/latexenc.el
@@ -1,4 +1,4 @@
-;;; latexenc.el --- guess correct coding system in LaTeX files -*-coding: utf-8 -*-
+;;; latexenc.el --- guess correct coding system in LaTeX files -*- lexical-binding: t; -*-
;; Copyright (C) 2005-2021 Free Software Foundation, Inc.
@@ -109,6 +109,8 @@ Return nil if no matching input encoding can be found."
(defvar latexenc-dont-use-tex-guess-main-file-flag nil
"Non-nil means don't use tex-guessmain-file to find the coding system.")
+(defvar tex-start-of-header)
+
;;;###autoload
(defun latexenc-find-file-coding-system (arg-list)
"Determine the coding system of a LaTeX file if it uses \"inputenc.sty\".
diff --git a/lisp/international/latin1-disp.el b/lisp/international/latin1-disp.el
index bda2c51ab9d..4b6ef9833e5 100644
--- a/lisp/international/latin1-disp.el
+++ b/lisp/international/latin1-disp.el
@@ -1,4 +1,4 @@
-;;; latin1-disp.el --- display tables for other ISO 8859 on Latin-1 terminals -*-coding: utf-8;-*-
+;;; latin1-disp.el --- display tables for other ISO 8859 on Latin-1 terminals -*- lexical-binding: t; -*-
;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
@@ -86,8 +86,8 @@ use either \\[customize] or the function `latin1-display'."
:group 'latin1-display
:type 'boolean
:require 'latin1-disp
- :initialize 'custom-initialize-default
- :set (lambda (symbol value)
+ :initialize #'custom-initialize-default
+ :set (lambda (_symbol value)
(if value
(apply #'latin1-display latin1-display-sets)
(latin1-display))))
@@ -186,7 +186,7 @@ character set."
'arabic-iso8859-6
(car (remq 'ascii (get-language-info language
'charset))))))
- (map-charset-chars #'(lambda (range arg)
+ (map-charset-chars #'(lambda (range _arg)
(standard-display-default (car range) (cdr range)))
charset))
(sit-for 0))
@@ -201,11 +201,10 @@ character set: `latin-2', `hebrew' etc."
(char (and info (decode-char (car (remq 'ascii info)) ?\ ))))
(and char (char-displayable-p char))))
-(defun latin1-display-setup (set &optional force)
+(defun latin1-display-setup (set &optional _force)
"Set up Latin-1 display for characters in the given SET.
SET must be a member of `latin1-display-sets'. Normally, check
-whether a font for SET is available and don't set the display if it
-is. If FORCE is non-nil, set up the display regardless."
+whether a font for SET is available and don't set the display if it is."
(cond
((eq set 'latin-2)
(latin1-display-identities set)
@@ -735,7 +734,7 @@ is. If FORCE is non-nil, set up the display regardless."
(sit-for 0))
;;;###autoload
-(defcustom latin1-display-ucs-per-lynx nil
+(defcustom latin1-display-ucs-per-lynx nil ;FIXME: Isn't this a minor mode?
"Set up Latin-1/ASCII display for Unicode characters.
This uses the transliterations of the Lynx browser. The display isn't
changed if the display can render Unicode characters.
@@ -745,8 +744,8 @@ use either \\[customize] or the function `latin1-display'."
:group 'latin1-display
:type 'boolean
:require 'latin1-disp
- :initialize 'custom-initialize-default
- :set (lambda (symbol value)
+ :initialize #'custom-initialize-default
+ :set (lambda (_symbol value)
(if value
(latin1-display-ucs-per-lynx 1)
(latin1-display-ucs-per-lynx -1))))
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index 347e6782590..5dc3de4422b 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -1279,7 +1279,7 @@ in the format of Lisp expression for registering each input method.
Emacs loads this file at startup time.")
(defconst leim-list-header (format-message
-";;; %s -- list of LEIM (Library of Emacs Input Method) -*-coding: utf-8;-*-
+";;; %s --- list of LEIM (Library of Emacs Input Method) -*- lexical-binding:t -*-
;;
;; This file is automatically generated.
;;
@@ -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
diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el
index d6222685251..d97d090cd08 100644
--- a/lisp/international/mule-diag.el
+++ b/lisp/international/mule-diag.el
@@ -1,4 +1,4 @@
-;;; mule-diag.el --- show diagnosis of multilingual environment (Mule)
+;;; mule-diag.el --- show diagnosis of multilingual environment (Mule) -*- lexical-binding: t; -*-
;; Copyright (C) 1997-1998, 2000-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
@@ -86,8 +86,7 @@ but still shows the full information."
(indent-to 48)
(insert "| +--CHARS\n")
(let ((columns '(("CHARSET-NAME" . name) "\t\t\t\t\t"
- ("D CH FINAL-BYTE" . iso-spec)))
- pos)
+ ("D CH FINAL-BYTE" . iso-spec))))
(while columns
(if (stringp (car columns))
(insert (car columns))
@@ -117,8 +116,8 @@ but still shows the full information."
SORT-KEY should be `name' or `iso-spec' (default `name')."
(or sort-key
(setq sort-key 'name))
- (let ((tail charset-list)
- charset-info-list supplementary-list charset sort-func)
+ (let (;; (tail charset-list)
+ charset-info-list supplementary-list sort-func)
(dolist (charset charset-list)
;; Generate a list that contains all information to display.
(let ((elt (list charset
@@ -273,9 +272,9 @@ meanings of these arguments."
(setq tab-width 4)
(set-buffer-multibyte t)
(let ((dim (charset-dimension charset))
- (chars (charset-chars charset))
- ;; (plane (charset-iso-graphic-plane charset))
- (plane 1)
+ ;; (chars (charset-chars charset))
+ ;; (plane (charset-iso-graphic-plane charset))
+ ;; (plane 1)
(range (plist-get (charset-plist charset) :code-space))
min max min2 max2)
(if (> dim 2)
@@ -415,7 +414,8 @@ or provided just for backward compatibility." nil)))
(print-coding-system-briefly coding-system 'doc-string)
(let ((type (coding-system-type coding-system))
;; Fixme: use this
- (extra-spec (coding-system-plist coding-system)))
+ ;; (extra-spec (coding-system-plist coding-system))
+ )
(princ "Type: ")
(princ type)
(cond ((eq type 'undecided)
@@ -858,6 +858,8 @@ The IGNORED argument is ignored."
(with-output-to-temp-buffer "*Help*"
(describe-font-internal font-info)))))
+(defvar mule--print-opened)
+
(defun print-fontset-element (val)
;; VAL has this format:
;; ((REQUESTED-FONT-NAME OPENED-FONT-NAME ...) ...)
@@ -915,7 +917,7 @@ The IGNORED argument is ignored."
(or adstyle "*") registry)))))
;; Insert opened font names (if any).
- (if (and (boundp 'print-opened) (symbol-value 'print-opened))
+ (if (bound-and-true-p mule--print-opened)
(dolist (opened (cdr elt))
(insert "\n\t[" opened "]")))))))
@@ -943,8 +945,9 @@ the current buffer."
" and [" (propertize "OPENED" 'face 'underline) "])")
(let* ((info (fontset-info fontset))
(default-info (char-table-extra-slot info 0))
+ (mule--print-opened print-opened)
start1 end1 start2 end2)
- (describe-vector info 'print-fontset-element)
+ (describe-vector info #'print-fontset-element)
(when (char-table-range info nil)
;; The default of FONTSET is described.
(setq start1 (re-search-backward "^default"))
@@ -956,7 +959,7 @@ the current buffer."
(when default-info
(insert "\n ---<fallback to the default fontset>---")
(put-text-property (line-beginning-position) (point) 'face 'highlight)
- (describe-vector default-info 'print-fontset-element)
+ (describe-vector default-info #'print-fontset-element)
(when (char-table-range default-info nil)
;; The default of the default fontset is described.
(setq end2 (re-search-backward "^default"))
diff --git a/lisp/international/mule.el b/lisp/international/mule.el
index 6a32cffe9a6..52e743e6f3d 100644
--- a/lisp/international/mule.el
+++ b/lisp/international/mule.el
@@ -1191,12 +1191,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/ogonek.el b/lisp/international/ogonek.el
index 79e446875da..e049832d58b 100644
--- a/lisp/international/ogonek.el
+++ b/lisp/international/ogonek.el
@@ -1,4 +1,4 @@
-;;; ogonek.el --- change the encoding of Polish diacritics
+;;; ogonek.el --- change the encoding of Polish diacritics -*- lexical-binding: t; -*-
;; Copyright (C) 1997-1998, 2001-2021 Free Software Foundation, Inc.
diff --git a/lisp/international/quail.el b/lisp/international/quail.el
index f2ac44a8a60..67ea00665fc 100644
--- a/lisp/international/quail.el
+++ b/lisp/international/quail.el
@@ -1,4 +1,4 @@
-;;; quail.el --- provides simple input method for multilingual text
+;;; quail.el --- provides simple input method for multilingual text -*- lexical-binding: t; -*-
;; Copyright (C) 1997-1998, 2000-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
@@ -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.
@@ -1046,7 +1038,7 @@ the following annotation types are supported.
(quail-install-decode-map ',decode-map))))))
;;;###autoload
-(defun quail-install-map (map &optional name)
+(defun quail-install-map (map &optional _name)
"Install the Quail map MAP in the current Quail package.
Optional 2nd arg NAME, if non-nil, is a name of Quail package for
@@ -1060,7 +1052,7 @@ The installed map can be referred by the function `quail-map'."
(setcar (cdr (cdr quail-current-package)) map))
;;;###autoload
-(defun quail-install-decode-map (decode-map &optional name)
+(defun quail-install-decode-map (decode-map &optional _name)
"Install the Quail decode map DECODE-MAP in the current Quail package.
Optional 2nd arg NAME, if non-nil, is a name of Quail package for
@@ -1390,7 +1382,7 @@ Return the input string."
(let* ((echo-keystrokes 0)
(help-char nil)
(overriding-terminal-local-map (quail-translation-keymap))
- (generated-events nil) ;FIXME: What is this?
+ ;; (generated-events nil) ;FIXME: What is this?
(input-method-function nil)
(modified-p (buffer-modified-p))
last-command-event last-command this-command inhibit-record)
@@ -1455,7 +1447,7 @@ Return the input string."
(let* ((echo-keystrokes 0)
(help-char nil)
(overriding-terminal-local-map (quail-conversion-keymap))
- (generated-events nil) ;FIXME: What is this?
+ ;; (generated-events nil) ;FIXME: What is this?
(input-method-function nil)
(modified-p (buffer-modified-p))
last-command-event last-command this-command inhibit-record)
@@ -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
@@ -2452,7 +2449,7 @@ should be made by `quail-build-decode-map' (which see)."
(insert-char ?- single-trans-width)
(forward-line 1)
;; Insert the key-tran pairs.
- (dotimes (row rows)
+ (dotimes (_ rows)
(let ((elt (pop single-list)))
(when elt
(move-to-column col)
@@ -2625,12 +2622,14 @@ KEY BINDINGS FOR CONVERSION
(run-hooks 'temp-buffer-show-hook)))))
(defun quail-help-insert-keymap-description (keymap &optional header)
+ (defvar the-keymap)
(let ((pos1 (point))
+ (the-keymap keymap)
pos2)
(if header
(insert header))
(save-excursion
- (insert (substitute-command-keys "\\{keymap}")))
+ (insert (substitute-command-keys "\\{the-keymap}")))
;; Skip headers "key bindings", etc.
(forward-line 3)
(setq pos2 (point))
@@ -3011,7 +3010,7 @@ of each directory."
;; At first, clean up the file.
(with-current-buffer list-buf
- (goto-char 1)
+ (goto-char (point-min))
;; Insert the correct header.
(if (looking-at (regexp-quote leim-list-header))
diff --git a/lisp/international/robin.el b/lisp/international/robin.el
index 16cac07c773..e4a11801c38 100644
--- a/lisp/international/robin.el
+++ b/lisp/international/robin.el
@@ -1,4 +1,4 @@
-;;; robin.el --- yet another input method (smaller than quail)
+;;; robin.el --- yet another input method (smaller than quail) -*- lexical-binding: t; -*-
;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -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/international/titdic-cnv.el b/lisp/international/titdic-cnv.el
index 58c81bfd1f3..64d66443760 100644
--- a/lisp/international/titdic-cnv.el
+++ b/lisp/international/titdic-cnv.el
@@ -1,4 +1,4 @@
-;;; titdic-cnv.el --- convert cxterm dictionary (TIT format) to Quail package -*- coding:iso-2022-7bit; lexical-binding:t -*-
+;;; titdic-cnv.el --- convert cxterm dictionary (TIT format) to Quail package -*- coding: utf-8-emacs; lexical-binding:t -*-
;; Copyright (C) 1997-1998, 2000-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
@@ -83,9 +83,9 @@
;; how to select a translation from a list of candidates.
(defvar quail-cxterm-package-ext-info
- '(("chinese-4corner" "$(0(?-F(B")
- ("chinese-array30" "$(0#R#O(B")
- ("chinese-ccdospy" "$AKuF4(B"
+ '(("chinese-4corner" "四角")
+ ("chinese-array30" "3ï¼")
+ ("chinese-ccdospy" "缩拼"
"Pinyin base input method for Chinese charset GB2312 (`chinese-gb2312').
Pinyin is the standard Roman transliteration method for Chinese.
@@ -94,10 +94,10 @@ method `chinese-py'.
This input method works almost the same way as `chinese-py'. The
difference is that you type a single key for these Pinyin spelling.
- Pinyin: zh en eng ang ch an ao ai ong sh ing yu($A(9(B)
+ Pinyin: zh en eng ang ch an ao ai ong sh ing yu(ü)
keyseq: a f g h i j k l s u y v
For example:
- Chinese: $A0!(B $A9{(B $AVP(B $AND(B $A9b(B $ASq(B $AH+(B
+ Chinese: 啊 果 中 文 光 玉 全
Pinyin: a guo zhong wen guang yu quan
Keyseq: a1 guo4 as1 wf4 guh1 yu..6 qvj6
@@ -106,14 +106,14 @@ For example:
For double-width GB2312 characters corresponding to ASCII, use the
input method `chinese-qj'.")
- ("chinese-ecdict" "$(05CKH(B"
+ ("chinese-ecdict" "英漢"
"In this input method, you enter a Chinese (Big5) character or word
by typing the corresponding English word. For example, if you type
-\"computer\", \"$(0IZH+(B\" is input.
+\"computer\", \"電腦\" is input.
\\<quail-translation-docstring>")
- ("chinese-etzy" "$(06/0D(B"
+ ("chinese-etzy" "倚注"
"Zhuyin base input method for Chinese Big5 characters (`chinese-big5-1',
`chinese-big5-2').
@@ -122,20 +122,20 @@ compose one Chinese character.
In this input method, you enter a Chinese character by first typing
keys corresponding to Zhuyin symbols (see the above table) followed by
-SPC, 1, 2, 3, or 4 specifying a tone (SPC:$(0?v(N(B, 1:$(0M=Vy(B, 2:$(0Dm(N(B, 3: $(0&9Vy(B,
-4:$(0(+Vy(B).
+SPC, 1, 2, 3, or 4 specifying a tone (SPC:é™°å¹³, 1:輕è², 2:陽平, 3: 上è²,
+4:去è²).
\\<quail-translation-docstring>")
- ("chinese-punct-b5" "$(0O:(BB"
+ ("chinese-punct-b5" "標B"
"Input method for Chinese punctuation and symbols of Big5
\(`chinese-big5-1' and `chinese-big5-2').")
- ("chinese-punct" "$A1j(BG"
+ ("chinese-punct" "æ ‡G"
"Input method for Chinese punctuation and symbols of GB2312
\(`chinese-gb2312').")
- ("chinese-py-b5" "$(03<(BB"
+ ("chinese-py-b5" "拼B"
"Pinyin base input method for Chinese Big5 characters
\(`chinese-big5-1', `chinese-big5-2').
@@ -153,28 +153,28 @@ method `chinese-qj-b5'.
The input method `chinese-py' and `chinese-tonepy' are also Pinyin
based, but for the character set GB2312 (`chinese-gb2312').")
- ("chinese-qj-b5" "$(0)A(BB")
+ ("chinese-qj-b5" "å…¨B")
- ("chinese-qj" "$AH+(BG")
+ ("chinese-qj" "å…¨G")
- ("chinese-sw" "$AJWN2(B"
+ ("chinese-sw" "首尾"
"Radical base input method for Chinese charset GB2312 (`chinese-gb2312').
In this input method, you enter a Chinese character by typing two
-keys. The first key corresponds to the first ($AJW(B) radical, the second
-key corresponds to the last ($AN2(B) radical. The correspondence of keys
+keys. The first key corresponds to the first (首) radical, the second
+key corresponds to the last (å°¾) radical. The correspondence of keys
and radicals is as below:
first radical:
a b c d e f g h i j k l m n o p q r s t u v w x y z
- $APD(B $AZ"(B $AJ,(B $AX<(B $A;p(B $A?Z(B $A^P(B $Ac_(B $AZ%(B $A\3(B $AXi(B $AD>(B $Alj(B $Ab;(B $ATB(B $Afy(B $AJ/(B $AMu(B $A0K(B $AX/(B $AHU(B $AeA(B $Aak(B $AVq(B $AR;(B $AHK(B
+ 心 冖 å°¸ 丶 ç« å£ æ‰Œ æ°µ è®  艹 亻 木 礻 饣 月 纟 石 王 å…« 丿 æ—¥ 辶 犭 竹 一 人
last radical:
a b c d e f g h i j k l m n o p q r s t u v w x y z
- $ASV(B $AI=(B $AMA(B $A56(B $AZb(B $A?Z(B $ARB(B $Aqb(B $A4s(B $A6!(B $A[L(B $Ala(B $AJ.(B $A4u(B $AXg(B $ACE(B $A=q(B $AX-(B $AE.(B $ARR(B $A`m(B $AP!(B $A3'(B $A3f(B $A_.(B $A27(B
+ åˆ å±± 土 刀 é˜ å£ è¡£ ç–‹ 大 ä¸ åŽ¶ ç¬ å æ­¹ 冂 é—¨ 今 丨 女 ä¹™ å›— å° åŽ‚ 虫 弋 åœ
\\<quail-translation-docstring>")
- ("chinese-tonepy" "$A5wF4(B"
+ ("chinese-tonepy" "调拼"
"Pinyin base input method for Chinese charset GB2312 (`chinese-gb2312').
Pinyin is the standard roman transliteration method for Chinese.
@@ -183,18 +183,18 @@ method `chinese-py'.
This input method works almost the same way as `chinese-py'. The
difference is that you must type 1..5 after each Pinyin spelling to
-specify a tone (1:$ARuF=(B, 2:$AQtF=(B, 3:$AIOIy(B, 4$AOBIy(B, 5:$AGaIy(B).
+specify a tone (1:阴平, 2:阳平, 3:上声, 4下声, 5:轻声).
\\<quail-translation-docstring>
-For instance, to input $ADc(B, you type \"n i 3 3\", the first \"n i\" is
+For instance, to input ä½ , you type \"n i 3 3\", the first \"n i\" is
a Pinyin, the next \"3\" specifies tone, and the last \"3\" selects
the third character from the candidate list.
For double-width GB2312 characters corresponding to ASCII, use the
input method `chinese-qj'.")
- ("chinese-zozy" "$(0I\0D(B"
+ ("chinese-zozy" "零注"
"Zhuyin base input method for Chinese Big5 characters (`chinese-big5-1',
`chinese-big5-2').
@@ -203,8 +203,8 @@ compose a Chinese character.
In this input method, you enter a Chinese character by first typing
keys corresponding to Zhuyin symbols (see the above table) followed by
-SPC, 6, 3, 4, or 7 specifying a tone (SPC:$(0?v(N(B, 6:$(0Dm(N(B, 3:$(0&9Vy(B, 4:$(0(+Vy(B,
-7:$(0M=Vy(B).
+SPC, 6, 3, 4, or 7 specifying a tone (SPC:é™°å¹³, 6:陽平, 3:上è², 4:去è²,
+7:輕è²).
\\<quail-translation-docstring>")))
@@ -269,6 +269,8 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:$(0?v(N(B, 6:$(0Dm(N(B, 3:$(0&9Vy
(tit-moveleft ",<")
(tit-keyprompt nil))
+ (princ (format ";;; %s -*- lexical-binding:t -*-\n"
+ (file-name-nondirectory filename)))
(princ ";; Quail package `")
(princ package)
(princ "\n")
@@ -354,7 +356,7 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:$(0?v(N(B, 6:$(0Dm(N(B, 3:$(0&9Vy
(princ (nth 2 (assoc tit-encode tit-encode-list)))
(princ "\" \"")
(princ (or title
- (if (string-match "[:$A!K$(0!(!J(B]+\\([^:$A!K$(0!(!K(B]+\\)" tit-prompt)
+ (if (string-match "[:∷:ã€]+\\([^:∷:】]+\\)" tit-prompt)
(substring tit-prompt (match-beginning 1) (match-end 1))
tit-prompt)))
(princ "\"\n"))
@@ -375,7 +377,7 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:$(0?v(N(B, 6:$(0Dm(N(B, 3:$(0&9Vy
;; Arg DOCSTRING
(let ((doc (concat tit-prompt "\n"))
(comments (if tit-comments
- (mapconcat 'identity (nreverse tit-comments) "\n")))
+ (mapconcat #'identity (nreverse tit-comments) "\n")))
(doc-ext (nth 2 (assoc package quail-cxterm-package-ext-info))))
(if comments
(setq doc (concat doc "\n" comments "\n")))
@@ -580,7 +582,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
;; )
(defvar quail-misc-package-ext-info
- '(("chinese-b5-tsangchi" "$(06A(BB"
+ '(("chinese-b5-tsangchi" "倉B"
"cangjie-table.b5" big5 "tsang-b5.el"
tsang-b5-converter
"\
@@ -590,7 +592,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
;; # unmodified versions is granted without royalty provided
;; # this notice is preserved.")
- ("chinese-b5-quick" "$(0X|(BB"
+ ("chinese-b5-quick" "ç°¡B"
"cangjie-table.b5" big5 "quick-b5.el"
quick-b5-converter
"\
@@ -600,7 +602,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
;; # unmodified versions is granted without royalty provided
;; # this notice is preserved.")
- ("chinese-cns-tsangchi" "$(GT?(BC"
+ ("chinese-cns-tsangchi" "倉C"
"cangjie-table.cns" iso-2022-cn-ext "tsang-cns.el"
tsang-cns-converter
"\
@@ -610,7 +612,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
;; # unmodified versions is granted without royalty provided
;; # this notice is preserved.")
- ("chinese-cns-quick" "$(Gv|(BC"
+ ("chinese-cns-quick" "ç°¡C"
"cangjie-table.cns" iso-2022-cn-ext "quick-cns.el"
quick-cns-converter
"\
@@ -620,7 +622,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
;; # unmodified versions is granted without royalty provided
;; # this notice is preserved.")
- ("chinese-py" "$AF4(BG"
+ ("chinese-py" "拼G"
"pinyin.map" cn-gb-2312 "PY.el"
py-converter
"\
@@ -648,7 +650,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
;; You should have received a copy of the GNU General Public License along with
;; CCE. If not, see <https://www.gnu.org/licenses/>.")
- ("chinese-ziranma" "$AWTH;(B"
+ ("chinese-ziranma" "自然"
"ziranma.cin" cn-gb-2312 "ZIRANMA.el"
ziranma-converter
"\
@@ -676,7 +678,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
;; You should have received a copy of the GNU General Public License along with
;; CCE. If not, see <https://www.gnu.org/licenses/>.")
- ("chinese-ctlau" "$AAuTA(B"
+ ("chinese-ctlau" "刘粤"
"CTLau.html" cn-gb-2312 "CTLau.el"
ctlau-gb-converter
"\
@@ -701,7 +703,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
;; # You should have received a copy of the GNU General Public License
;; # along with this program. If not, see <https://www.gnu.org/licenses/>.")
- ("chinese-ctlaub" "$(0N,Gn(B"
+ ("chinese-ctlaub" "劉粵"
"CTLau-b5.html" big5 "CTLau-b5.el"
ctlau-b5-converter
"\
@@ -731,41 +733,27 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
;; dictionary in the buffer DICBUF. The input method name of the
;; Quail package is NAME, and the title string is TITLE.
-;; TSANG-P is non-nil, generate $(06AQo(B input method. Otherwise
-;; generate $(0X|/y(B (simple version of $(06AQo(B). If BIG5-P is non-nil, the
+;; TSANG-P is non-nil, generate 倉頡 input method. Otherwise
+;; generate 簡易 (simple version of 倉頡). If BIG5-P is non-nil, the
;; input method is for inputting Big5 characters. Otherwise the input
;; method is for inputting CNS characters.
(defun tsang-quick-converter (dicbuf tsang-p big5-p)
- (let ((fulltitle (if tsang-p (if big5-p "$(06AQo(B" "$(GT?on(B")
- (if big5-p "$(0X|/y(B" "$(Gv|Mx(B")))
+ (let ((fulltitle (if tsang-p "倉頡" "簡易"))
dic)
(goto-char (point-max))
- (if big5-p
- (insert (format "\"$(0&d'GTT&,!J(B%s$(0!K(BBIG5
+ (insert (format "\"中文輸入ã€%s】%s
- $(0KHM$(B%s$(0TT&,WoOu(B
+ 漢語%s輸入éµç›¤
- [Q $(0'D(B] [W $(0(q(B] [E $(0'V(B] [R $(0&H(B] [T $(0'>(B] [Y $(0&4(B] [U $(0&U(B] [I $(0'B(B] [O $(0&*(B] [P $(0'A(B]
+ [Q 手] [W ç”°] [E æ°´] [R å£] [T 廿] [Y åœ] [U å±±] [I 戈] [O 人] [P 心]
- [A $(0'K(B] [S $(0&T(B] [D $(0'N(B] [F $(0'W(B] [G $(0&I(B] [H $(0*M(B] [J $(0&3(B] [L $(0&d(B]
+ [A æ—¥] [S å°¸] [D 木] [F ç«] [G 土] [H 竹] [J å] [L 中]
- [Z ] [X $(0[E(B] [C $(01[(B] [V $(0&M(B] [B $(0'M(B] [N $(0&_(B] [M $(0&"(B]
+ [Z ] [X 難] [C 金] [V 女] [B 月] [N 弓] [M 一]
\\\\<quail-translation-docstring>\"\n"
- fulltitle fulltitle))
- (insert (format "\"$(GDcEFrSD+!J(B%s$(G!K(BCNS
-
- $(GiGk#(B%s$(GrSD+uomu(B
-
- [Q $(GEC(B] [W $(GFp(B] [E $(GEU(B] [R $(GDG(B] [T $(GE=(B] [Y $(GD3(B] [U $(GDT(B] [I $(GEA(B] [O $(GD)(B] [P $(GE@(B]
-
- [A $(GEJ(B] [S $(GDS(B] [D $(GEM(B] [F $(GEV(B] [G $(GDH(B] [H $(GHL(B] [J $(GD2(B] [L $(GDc(B]
-
- [Z ] [X $(GyE(B] [C $(GOZ(B] [V $(GDL(B] [B $(GEL(B] [N $(GD^(B] [M $(GD!(B]
-
-\\\\<quail-translation-docstring>\"\n"
- fulltitle fulltitle)))
+ fulltitle (if big5-p "BIG5" "CNS") fulltitle))
(insert " '((\".\" . quail-next-translation-block)
(\",\" . quail-prev-translation-block))
nil nil)\n\n")
@@ -798,35 +786,35 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
(setq dic (sort dic (lambda (x y) (string< (car x ) (car y)))))
(dolist (elt dic)
(insert (format "(%S\t%S)\n" (car elt) (cdr elt))))
- (let ((punctuation '((";" "$(0!'!2!"!#!.!/(B" "$(G!'!2!"!#!.!/(B")
- (":" "$(0!(!+!3!%!$!&!0!1(B" "$(G!(!+!3!%!$!&!0!1(B")
- ("'" "$(0!e!d(B" "$(G!e!d(B")
- ("\"" "$(0!g!f!h!i!q(B" "$(G!g!f!h!i!q(B")
- ("\\" "$(0"`"b#M(B" "$(G"`"b#M(B")
- ("|" "$(0!6!8!:"^(B" "$(G!6!8!:"^(B")
- ("/" "$(0"_"a#L(B" "$(G"_"a#L(B")
- ("?" "$(0!)!4(B" "$(G!)!4(B")
- ("<" "$(0!R"6"A!T"H(B" "$(G!R"6"A!T"H(B")
- (">" "$(0!S"7"B!U(B" "$(G!S"7"B!U(B")
- ("[" "$(0!F!J!b!H!L!V!Z!X!\(B" "$(G!F!J!b!H!L!V!Z!X!\(B")
- ("]" "$(0!G!K!c!I!M!W![!Y!](B" "$(G!G!K!c!I!M!W![!Y!](B")
- ("{" "$(0!B!`!D(B " "$(G!B!`!D(B ")
- ("}" "$(0!C!a!E(B" "$(G!C!a!E(B")
- ("`" "$(0!j!k(B" "$(G!j!k(B")
- ("~" "$(0"D"+",!<!=(B" "$(G"D"+",!<!=(B")
- ("!" "$(0!*!5(B" "$(G!*!5(B")
- ("@" "$(0"i"n(B" "$(G"i"n(B")
- ("#" "$(0!l"-(B" "$(G!l"-(B")
- ("$" "$(0"c"l(B" "$(G"c"l(B")
- ("%" "$(0"h"m(B" "$(G"h"m(B")
- ("&" "$(0!m".(B" "$(G!m".(B")
- ("*" "$(0!n"/!o!w!x(B" "$(G!n"/!o!w!x(B")
- ("(" "$(0!>!^!@(B" "$(G!>!^!@(B")
- (")" "$(0!?!_!A(B" "$(G!?!_!A(B")
- ("-" "$(0!7!9"#"$"1"@(B" "$(G!7!9"#"$"1"@(B")
- ("_" "$(0"%"&(B" "$(G"%"&(B")
- ("=" "$(0"8"C(B" "$(G"8"C(B")
- ("+" "$(0"0"?(B" "$(G"0"?(B"))))
+ (let ((punctuation '((";" ";﹔,ã€ï¹ï¹‘" ";﹔,ã€ï¹ï¹‘")
+ (":" ":︰﹕.。‧﹒·" ":︰﹕.。・﹒·")
+ ("'" "’‘" "’‘")
+ ("\"" "â€â€œã€ã€žã€ƒ" "â€â€œã€ã€žã€ƒ")
+ ("\\" "\﹨╲" "\﹨╲")
+ ("|" "|︱︳∣" "︱︲ô”€™ï½œ")
+ ("/" "ï¼âˆ•â•±" "ï¼âˆ•â•±")
+ ("?" "?﹖" "?﹖")
+ ("<" "〈<﹤︿∠" "〈<﹤︿∠")
+ (">" "〉>﹥﹀" "〉>﹦﹀")
+ ("[" "〔ã€ï¹ï¸¹ï¸»ã€Œã€Žï¹ï¹ƒ" "〔ã€ï¹ï¸¹ï¸»ã€Œã€Žï¹ï¹ƒ")
+ ("]" "〕】﹞︺︼ã€ã€ï¹‚﹄" "〕】﹞︺︼ã€ã€ï¹‚﹄")
+ ("{" "{﹛︷ " "{﹛︷ ")
+ ("}" "ï½ï¹œï¸¸" "ï½ï¹œï¸¸")
+ ("`" "‵′" "′‵")
+ ("~" "~﹋﹌︴ï¹" "∼﹋﹌ô”€›ô”€œ")
+ ("!" "ï¼ï¹—" "ï¼ï¹—")
+ ("@" "@﹫" "@﹫")
+ ("#" "#﹟" "#﹟")
+ ("$" "$﹩" "$﹩")
+ ("%" "%﹪" "%﹪")
+ ("&" "&﹠" "&﹠")
+ ("*" "*﹡※☆★" "*﹡※☆★")
+ ("(" "(﹙︵" "(﹙︵")
+ (")" ")﹚︶" ")﹚︶")
+ ("-" "–—¯ ̄ï¼ï¹£" "—–‾ô”¡ï¼ï¹£")
+ ("_" "_Ë" "_ô”£")
+ ("=" "ï¼ï¹¦" "ï¼ï¹¥")
+ ("+" "+﹢" "+﹢"))))
(dolist (elt punctuation)
(insert (format "(%S %S)\n" (concat "z" (car elt))
(if big5-p (nth 1 elt) (nth 2 elt))))))
@@ -850,11 +838,11 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
(defun py-converter (dicbuf)
(goto-char (point-max))
- (insert (format "%S\n" "$A::WVJdHk!KF4Rt!K(B
+ (insert (format "%S\n" "汉字输入∷拼音∷
- $AF4Rt7=08(B
+ 拼音方案
- $AP!P4S"NDWVD84z1m!8F4Rt!97{:E#,(B \"u(yu) $ATrSC(B u: $A1mJ>!C(B
+ å°å†™è‹±æ–‡å­—æ¯ä»£è¡¨ã€Œæ‹¼éŸ³ã€ç¬¦å·ï¼Œ \"u(yu) 则用 u: 表示∶
Pinyin base input method for Chinese charset GB2312 (`chinese-gb2312').
@@ -868,14 +856,14 @@ character. The sequence is made by the combination of the initials
iang ing iong u ua uo uai ui uan un uan ueng yu yue yuan yun
(Note: In the correct Pinyin writing, the sequence \"yu\" in the last
- four finals should be written by the character u-umlaut `$A(9(B'.)
+ four finals should be written by the character u-umlaut `ü'.)
With this input method, you enter a Chinese character by first
entering its pinyin spelling.
\\<quail-translation-docstring>
-For instance, to input $ADc(B, you type \"n i C-n 3\". The first \"n i\"
+For instance, to input ä½ , you type \"n i C-n 3\". The first \"n i\"
is a Pinyin, \"C-n\" selects the next group of candidates (each group
contains at most 10 characters), \"3\" select the third character in
that group.
@@ -953,27 +941,27 @@ method `chinese-tonepy' with which you must specify tones by digits
(= (length (aref trans i)) 1))
(setq i (1+ i)))
(if (= i len)
- (setq trans (mapconcat 'identity trans "")))))
+ (setq trans (mapconcat #'identity trans "")))))
(setq dic (cons (cons key trans) dic)))
table)))
(setq dic (sort dic (lambda (x y) (string< (car x) (car y)))))
(goto-char (point-max))
- (insert (format "%S\n" "$A::WVJdHk!K!>WTH;!?!K(B
-
- $A<|EL6TUU1m(B:
- $A)3)%)%)W)%)%)W)%)%)W)%)%)W)%)%)W)%)%)W)%)%)W)%)%)W)%)%)W)%)%)7(B
- $A)'#Q(B $A)'#W(B $A)'#E(B $A)'#R(B $A)'#T(B $A)'#Y(B $A)'#U(Bsh$A)'#I(Bch$A)'#O(B $A)'#P(B $A)'(B
- $A)'(B iu$A)'(B ua$A)'(B e$A)'(B uan$A)'(B ue$A)'(B uai$A)'(B u$A)'(B i$A)'(B o$A)'(B un$A)'(B
- $A)'(B $A)'(B ia$A)'(B $A)'(B van$A)'(B ve$A)'(B ing$A)'(B $A)'(B $A)'(B uo$A)'(B vn$A)'(B
- $A);)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)?(B
- $A)'#A(B $A)'#S(B $A)'#D(B $A)'#F(B $A)'#G(B $A)'#H(B $A)'#J(B $A)'#K(B $A)'#L(B $A)'(B
- $A)'(B a$A)'(Biong$A)'(Buang$A)'(B en$A)'(B eng$A)'(B ang$A)'(B an$A)'(B ao$A)'(B ai$A)'(B
- $A)'(B $A)'(B ong$A)'(Biang$A)'(B $A)'(B ng$A)'(B $A)'(B $A)'(B $A)'(B $A)'(B
- $A);)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)%)7(B
- $A)'#Z(B $A)'#X(B $A)'#C(B $A)'#V(Bzh$A)'#B(B $A)'#N(B $A)'#M(B $A)'#,(B $A)'#.(B $A)'(B $A#/(B $A)'(B
- $A)'(B ei$A)'(B ie$A)'(B iao$A)'(B ui$A)'(B ou$A)'(B in$A)'(B ian$A)'G0R3)':sR3)'7{:E)'(B
- $A)'(B $A)'(B $A)'(B $A)'(B v$A)'(B $A)'(B $A)'(B $A)'(B $A)'(B $A)'(B $A)'(B
- $A);)%)%)_)%)%)_)%)%)_)%)%)_)%)%)_)%)%)_)%)%)_)%)%)_)%)%)_)%)%)?(B
+ (insert (format "%S\n" "汉字输入∷ã€è‡ªç„¶ã€‘∷
+
+ 键盘对照表:
+ â”â”â”┳â”â”┳â”â”┳â”â”┳â”â”┳â”â”┳â”â”┳â”â”┳â”â”┳â”â”┓
+ ┃Q ┃W ┃E ┃R ┃T ┃Y ┃Ush┃Ich┃O ┃P ┃
+ ┃ iu┃ ua┃ e┃ uan┃ ue┃ uai┃ u┃ i┃ o┃ un┃
+ ┃ ┃ ia┃ ┃ van┃ ve┃ ing┃ ┃ ┃ uo┃ vn┃
+ ┗┳â”┻┳â”┻┳â”┻┳â”┻┳â”┻┳â”┻┳â”┻┳â”┻┳â”┻┳â”â”›
+ ┃A ┃S ┃D ┃F ┃G ┃H ┃J ┃K ┃L ┃
+ ┃ a┃iong┃uang┃ en┃ eng┃ ang┃ an┃ ao┃ ai┃
+ ┃ ┃ ong┃iang┃ ┃ ng┃ ┃ ┃ ┃ ┃
+ ┗┳â”┻┳â”┻┳â”┻┳â”┻┳â”┻┳â”┻┳â”┻┳â”┻┳â”┻┳â”â”┓
+ ┃Z ┃X ┃C ┃Vzh┃B ┃N ┃M ┃, ┃. ┃ ï¼ â”ƒ
+ ┃ ei┃ ie┃ iao┃ ui┃ ou┃ in┃ ian┃å‰é¡µâ”ƒåŽé¡µâ”ƒç¬¦å·â”ƒ
+ ┃ ┃ ┃ ┃ v┃ ┃ ┃ ┃ ┃ ┃ ┃
+ â”—â”â”â”»â”â”â”»â”â”â”»â”â”â”»â”â”â”»â”â”â”»â”â”â”»â”â”â”»â”â”â”»â”â”â”›
Pinyin base input method for Chinese GB2312 characters (`chinese-gb2312').
@@ -985,34 +973,34 @@ method `chinese-py'.
Unlike the standard spelling of Pinyin, in this input method all
initials and finals are assigned to single keys (see the above table).
For instance, the initial \"ch\" is assigned to the key `i', the final
-\"iu\" is assigned to the key `q', and tones 1, 2, 3, 4, and $AGaIy(B are
+\"iu\" is assigned to the key `q', and tones 1, 2, 3, 4, and 轻声 are
assigned to the keys `q', `w', `e', `r', `t' respectively.
\\<quail-translation-docstring>
To input one-letter words, you type 4 keys, the first two for the
Pinyin of the letter, next one for tone, and the last one is always a
-quote ('). For instance, \"vsq'\" input $AVP(B. Exceptions are these
+quote ('). For instance, \"vsq'\" input 中. Exceptions are these
letters. You can input them just by typing a single key.
- Character: $A04(B $A2;(B $A4N(B $A5D(B $A6~(B $A7"(B $A8v(B $A:M(B $A3v(B $A<0(B $A?I(B $AAK(B $AC;(B
+ Character: 按 ä¸ æ¬¡ çš„ 二 å‘ ä¸ª å’Œ 出 åŠ å¯ äº† 没
Key: a b c d e f g h i j k l m
- Character: $ADc(B $AE7(B $AF,(B $AF_(B $AHK(B $AH}(B $AK{(B $AJG(B $AWE(B $ANR(B $AP!(B $AR;(B $ATZ(B
+ Character: ä½  欧 片 七 人 三 ä»– 是 ç€ æˆ‘ å° ä¸€ 在
Key: n o p q r s t u v w x y z
To input two-letter words, you have two ways. One way is to type 4
keys, two for the first Pinyin, two for the second Pinyin. For
-instance, \"vsgo\" inputs $AVP9z(B. Another way is to type 3 keys: 2
+instance, \"vsgo\" inputs 中国. Another way is to type 3 keys: 2
initials of two letters, and quote ('). For instance, \"vg'\" also
-inputs $AVP9z(B.
+inputs 中国.
To input three-letter words, you type 4 keys: initials of three
-letters, and the last is quote ('). For instance, \"bjy'2\" inputs $A11(B
-$A>)Q<(B (the last `2' is to select one of the candidates).
+letters, and the last is quote ('). For instance, \"bjy'2\" inputs 北
+京鸭 (the last `2' is to select one of the candidates).
To input words of more than three letters, you type 4 keys, initials
of the first three letters and the last letter. For instance,
-\"bjdt\" inputs $A11>)5gJSL((B.
+\"bjdt\" inputs 北京电视å°.
To input symbols and punctuation, type `/' followed by one of `a' to
`z', then select one of the candidates."))
@@ -1059,7 +1047,7 @@ To input symbols and punctuation, type `/' followed by one of `a' to
;; which the file is converted have no Big5 equivalent. Go
;; through and delete them.
(goto-char pos)
- (while (search-forward "$(0!{(B" nil t)
+ (while (search-forward "â–¡" nil t)
(delete-char -1))
;; Uppercase keys in dictionary need to be downcased. Backslashes
;; at the beginning of keys need to be turned into double
@@ -1083,31 +1071,31 @@ To input symbols and punctuation, type `/' followed by one of `a' to
(defun ctlau-gb-converter (dicbuf)
(ctlau-converter dicbuf
-"$A::WVJdHk!KAuN}OiJ=TARt!K(B
+"汉字输入∷刘锡祥å¼ç²¤éŸ³âˆ·
- $AAuN}OiJ=TASoW"Rt7=08(B
+ 刘锡祥å¼ç²¤è¯­æ³¨éŸ³æ–¹æ¡ˆ
Sidney Lau's Cantonese transcription scheme as described in his book
\"Elementary Cantonese\", The Government Printer, Hong Kong, 1972.
- This file was prepared by Fung Fung Lee ($A@n7c7e(B).
+ This file was prepared by Fung Fung Lee (æŽæž«å³°).
Originally converted from CTCPS3.tit
Last modified: June 2, 1993.
Some infrequent GB characters are accessed by typing \\, followed by
- the Cantonese romanization of the respective radical ($A2?JW(B)."))
+ the Cantonese romanization of the respective radical (部首)."))
(defun ctlau-b5-converter (dicbuf)
(ctlau-converter dicbuf
-"$(0KH)tTT&,!(N,Tg>A*#Gn5x!((B
+"漢字輸入:劉錫祥å¼ç²µéŸ³ï¼š
- $(0N,Tg>A*#GnM$0D5x'J7{(B
+ 劉錫祥å¼ç²µèªžæ³¨éŸ³æ–¹æ¡ˆ
Sidney Lau's Cantonese transcription scheme as described in his book
\"Elementary Cantonese\", The Government Printer, Hong Kong, 1972.
- This file was prepared by Fung Fung Lee ($(0,XFS76(B).
+ This file was prepared by Fung Fung Lee (æŽæ¥“å³°).
Originally converted from CTCPS3.tit
Last modified: June 2, 1993.
Some infrequent characters are accessed by typing \\, followed by
- the Cantonese romanization of the respective radical ($(0?f5}(B)."))
+ the Cantonese romanization of the respective radical (部首)."))
(declare-function dos-8+3-filename "dos-fns.el" (filename))
@@ -1147,6 +1135,8 @@ the generated Quail package is saved."
;; Explicitly set eol format to `unix'.
(setq coding-system-for-write 'utf-8-unix)
(with-temp-file (expand-file-name quailfile dirname)
+ (insert (format ";;; %s -*- lexical-binding:t -*-\n"
+ (file-name-nondirectory quailfile)))
(insert (format-message ";; Quail package `%s'\n" name))
(insert (format-message
";; Generated by the command `miscdic-convert'\n"))
@@ -1212,8 +1202,10 @@ The library is named pinyin.el, and contains the constant
(dst-file (cadr command-line-args-left))
(coding-system-for-write 'utf-8-unix))
(with-temp-file dst-file
- (insert ";; This file is automatically generated from pinyin.map,\
- by the\n;; function pinyin-convert.\n\n")
+ (insert ";;; " (file-name-nondirectory dst-file)
+ " -*- lexical-binding:t -*-
+;; This file is automatically generated from pinyin.map, by the
+;; function pinyin-convert.\n\n")
(insert "(defconst pinyin-character-map\n'(")
(let ((pos (point)))
(insert-file-contents src-file)
diff --git a/lisp/international/utf-7.el b/lisp/international/utf-7.el
index e941abb463e..dece184ffef 100644
--- a/lisp/international/utf-7.el
+++ b/lisp/international/utf-7.el
@@ -1,4 +1,4 @@
-;;; utf-7.el --- utf-7 coding system
+;;; utf-7.el --- utf-7 coding system -*- lexical-binding: t; -*-
;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
diff --git a/lisp/isearch.el b/lisp/isearch.el
index a86678572c4..82d64c5766b 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -352,10 +352,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
@@ -513,7 +523,7 @@ This is like `describe-bindings', but displays only Isearch keys."
(call-interactively command)))
(defvar isearch-menu-bar-commands
- '(isearch-tmm-menubar menu-bar-open mouse-minor-mode-menu)
+ '(isearch-tmm-menubar tmm-menubar menu-bar-open mouse-minor-mode-menu)
"List of commands that can open a menu during Isearch.")
(defvar isearch-menu-bar-yank-map
@@ -787,7 +797,6 @@ This is like `describe-bindings', but displays only Isearch keys."
(define-key map [menu-bar search-menu]
(list 'menu-item "Isearch" isearch-menu-bar-map))
- (define-key map [remap tmm-menubar] 'isearch-tmm-menubar)
map)
"Keymap for `isearch-mode'.")
@@ -3357,7 +3366,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
@@ -3917,7 +3926,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)
@@ -3962,7 +3972,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/kmacro.el b/lisp/kmacro.el
index bb8dacf4f48..303f38a59b6 100644
--- a/lisp/kmacro.el
+++ b/lisp/kmacro.el
@@ -172,6 +172,7 @@ macro to be executed before appending to it."
(define-key map "\C-k" 'kmacro-end-or-call-macro-repeat)
(define-key map "r" 'apply-macro-to-region-lines)
(define-key map "q" 'kbd-macro-query) ;; Like C-x q
+ (define-key map "Q" 'kdb-macro-redisplay)
;; macro ring
(define-key map "\C-n" 'kmacro-cycle-ring-next)
@@ -1298,6 +1299,16 @@ To customize possible responses, change the \"bindings\" in
(kmacro-push-ring)
(setq last-kbd-macro kmacro-step-edit-new-macro))))
+(defun kdb-macro-redisplay ()
+ "Force redisplay during kbd macro execution."
+ (interactive)
+ (or executing-kbd-macro
+ defining-kbd-macro
+ (user-error "Not defining or executing kbd macro"))
+ (when executing-kbd-macro
+ (let ((executing-kbd-macro nil))
+ (redisplay))))
+
(provide 'kmacro)
;;; kmacro.el ends here
diff --git a/lisp/language/burmese.el b/lisp/language/burmese.el
index d689e87d785..373f25ac5ca 100644
--- a/lisp/language/burmese.el
+++ b/lisp/language/burmese.el
@@ -51,7 +51,7 @@
regexp t t))))
regexp))
-(let ((elt (list (vector burmese-composable-pattern 0 'font-shape-gstring)
- (vector "." 0 'font-shape-gstring))))
+(let ((elt (list (vector burmese-composable-pattern 0 #'font-shape-gstring)
+ (vector "." 0 #'font-shape-gstring))))
(set-char-table-range composition-function-table '(#x1000 . #x107F) elt)
(set-char-table-range composition-function-table '(#xAA60 . #xAA7B) elt))
diff --git a/lisp/language/cham.el b/lisp/language/cham.el
index 089988da918..3aac986b437 100644
--- a/lisp/language/cham.el
+++ b/lisp/language/cham.el
@@ -23,13 +23,13 @@
;;; Commentary:
-;; Tai Viet is being included in the Unicode at the range U+AA80..U+AADF.
+;; Cham script is included in the Unicode at the range U+AA00..U+AA5F.
;;; Code:
(set-char-table-range composition-function-table
'(#xAA00 . #xAA5F)
- (list (vector "[\xAA00-\xAA5F]+" 0 'font-shape-gstring)))
+ (list (vector "[\xAA00-\xAA5F]+" 0 #'font-shape-gstring)))
(set-language-info-alist
"Cham" '((charset unicode)
diff --git a/lisp/language/china-util.el b/lisp/language/china-util.el
index 4bc2eaa2cdd..105e7a735fd 100644
--- a/lisp/language/china-util.el
+++ b/lisp/language/china-util.el
@@ -1,4 +1,4 @@
-;;; china-util.el --- utilities for Chinese -*- coding: utf-8 -*-
+;;; china-util.el --- utilities for Chinese -*- lexical-binding: t; -*-
;; Copyright (C) 1995, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
diff --git a/lisp/language/cyril-util.el b/lisp/language/cyril-util.el
index 72ceffdf0d6..04e681d743d 100644
--- a/lisp/language/cyril-util.el
+++ b/lisp/language/cyril-util.el
@@ -1,4 +1,4 @@
-;;; cyril-util.el --- utilities for Cyrillic scripts
+;;; cyril-util.el --- utilities for Cyrillic scripts -*- lexical-binding: t; -*-
;; Copyright (C) 1997-1998, 2001-2021 Free Software Foundation, Inc.
diff --git a/lisp/language/ethio-util.el b/lisp/language/ethio-util.el
index 174b9ecfda2..9b5fdf24d2b 100644
--- a/lisp/language/ethio-util.el
+++ b/lisp/language/ethio-util.el
@@ -1,4 +1,4 @@
-;;; ethio-util.el --- utilities for Ethiopic -*- coding: utf-8-emacs; -*-
+;;; ethio-util.el --- utilities for Ethiopic -*- coding: utf-8-emacs; lexical-binding: t; -*-
;; Copyright (C) 1997-1998, 2002-2021 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -832,11 +832,12 @@ The 2nd and 3rd arguments BEGIN and END specify the region."
(set-buffer-modified-p nil)))
;;;###autoload
-(defun ethio-tex-to-fidel-buffer nil
+(defun ethio-tex-to-fidel-buffer ()
"Convert fidel-tex commands in the current buffer into fidel chars."
(interactive)
- (let ((buffer-read-only nil)
- (p) (ch))
+ (let ((inhibit-read-only t)
+ ;; (p) (ch)
+ )
;; TeX macros to Ethiopic characters
(robin-convert-region (point-min) (point-max) "ethiopic-tex")
@@ -1018,7 +1019,7 @@ With ARG, insert that many delimiters."
;;
;;;###autoload
-(defun ethio-composition-function (pos to font-object string _direction)
+(defun ethio-composition-function (pos _to _font-object string _direction)
(setq pos (1- pos))
(let ((pattern "\\ce\\(áŸ\\|ö ‡Š\\)"))
(if string
diff --git a/lisp/language/ethiopic.el b/lisp/language/ethiopic.el
index 8573f6177df..209dcd51c90 100644
--- a/lisp/language/ethiopic.el
+++ b/lisp/language/ethiopic.el
@@ -79,8 +79,8 @@
)))
;; For automatic composition
-(aset composition-function-table ?ö ‡Š 'ethio-composition-function)
-(aset composition-function-table ?០'ethio-composition-function)
+(aset composition-function-table ?ö ‡Š #'ethio-composition-function)
+(aset composition-function-table ?០#'ethio-composition-function)
(provide 'ethiopic)
diff --git a/lisp/language/hanja-util.el b/lisp/language/hanja-util.el
index 313fc63bebd..9e9213536cb 100644
--- a/lisp/language/hanja-util.el
+++ b/lisp/language/hanja-util.el
@@ -1,4 +1,4 @@
-;;; hanja-util.el --- Korean Hanja util module -*- coding: utf-8 -*-
+;;; hanja-util.el --- Korean Hanja util module -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
diff --git a/lisp/language/hebrew.el b/lisp/language/hebrew.el
index 389565669a9..c55d23f72d6 100644
--- a/lisp/language/hebrew.el
+++ b/lisp/language/hebrew.el
@@ -245,9 +245,9 @@ Bidirectional editing is supported.")))
(pattern2 (concat base "\u200D" combining)))
(set-char-table-range
composition-function-table '(#x591 . #x5C7)
- (list (vector pattern2 3 'hebrew-shape-gstring)
- (vector pattern2 2 'hebrew-shape-gstring)
- (vector pattern1 1 'hebrew-shape-gstring)
+ (list (vector pattern2 3 #'hebrew-shape-gstring)
+ (vector pattern2 2 #'hebrew-shape-gstring)
+ (vector pattern1 1 #'hebrew-shape-gstring)
[nil 0 hebrew-shape-gstring]))
;; Exclude non-combining characters.
(set-char-table-range
diff --git a/lisp/language/ind-util.el b/lisp/language/ind-util.el
index 4bd1cd76a6d..8d4b2a826e6 100644
--- a/lisp/language/ind-util.el
+++ b/lisp/language/ind-util.el
@@ -1,4 +1,4 @@
-;;; ind-util.el --- Transliteration and Misc. Tools for Indian Languages -*- coding: utf-8-emacs; -*-
+;;; ind-util.el --- Transliteration and Misc. Tools for Indian Languages -*- coding: utf-8-emacs; lexical-binding: t; -*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
@@ -40,7 +40,7 @@
(defun indian-regexp-of-hashtbl-keys (hashtbl)
"Return the regular expression of hash table keys."
(let (keys)
- (maphash (lambda (key val) (push key keys)) hashtbl)
+ (maphash (lambda (key _val) (push key keys)) hashtbl)
(regexp-opt keys)))
(defvar indian-dev-base-table
@@ -565,7 +565,7 @@
(let ((regexp ,(indian-regexp-of-hashtbl-keys
(if encode-p (car (eval hashtable))
(cdr (eval hashtable))))))
- (narrow-to-region from to)
+ (narrow-to-region ,from ,to)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(let ((matchstr (gethash (match-string 0)
@@ -613,7 +613,7 @@
;; The followings provide conversion between IS 13194 (ISCII) and UCS.
-(let
+(dlet
;;Unicode vs IS13194 ;; only Devanagari is supported now.
((ucs-devanagari-to-is13194-alist
'((?\x0900 . "[U+0900]")
@@ -820,11 +820,11 @@ Returns new end position."
(save-restriction
(narrow-to-region from to)
(goto-char (point-min))
- (let* ((current-repertory is13194-default-repertory))
+ ;; (let* ((current-repertory is13194-default-repertory))
(while (re-search-forward indian-ucs-to-is13194-regexp nil t)
(replace-match
(get-char-code-property (string-to-char (match-string 0))
- 'iscii))))
+ 'iscii)));; )
(point-max))))
(defun indian-iscii-to-ucs-region (from to)
@@ -1246,7 +1246,7 @@ Returns new end position."
(interactive "r")
(save-excursion
(save-restriction
- (let ((pos from)
+ (let (;; (pos from)
(alist (char-table-extra-slot indian-2-column-to-ucs-chartable 0)))
(narrow-to-region from to)
(decompose-region from to)
diff --git a/lisp/language/indian.el b/lisp/language/indian.el
index 5ff57966c12..6f9d2703849 100644
--- a/lisp/language/indian.el
+++ b/lisp/language/indian.el
@@ -381,7 +381,7 @@ South Indian language Malayalam is supported in this language environment."))
(if slot
(set-char-table-range
composition-function-table key
- (list (vector (cdr slot) 0 'font-shape-gstring))))))
+ (list (vector (cdr slot) 0 #'font-shape-gstring))))))
char-script-table))
(provide 'indian)
diff --git a/lisp/language/japan-util.el b/lisp/language/japan-util.el
index 9dce17c4967..948bfef9f22 100644
--- a/lisp/language/japan-util.el
+++ b/lisp/language/japan-util.el
@@ -1,4 +1,4 @@
-;;; japan-util.el --- utilities for Japanese
+;;; japan-util.el --- utilities for Japanese -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
@@ -236,7 +236,7 @@ of which charset is `japanese-jisx0201-kana'."
(composition
(and (not hankaku)
(get-char-code-property kana 'kana-composition)))
- next slot)
+ slot) ;; next
(if (and composition (setq slot (assq (following-char) composition)))
(japanese-replace-region (match-beginning 0) (1+ (point))
(cdr slot))
@@ -258,7 +258,7 @@ of which charset is `japanese-jisx0201-kana'."
(while (re-search-forward "\\cK\\|\\ck" nil t)
(let* ((kata (preceding-char))
(composition (get-char-code-property kata 'kana-composition))
- next slot)
+ slot) ;; next
(if (and composition (setq slot (assq (following-char) composition)))
(japanese-replace-region (match-beginning 0) (1+ (point))
(get-char-code-property
@@ -305,7 +305,7 @@ Optional argument KATAKANA-ONLY non-nil means to convert only KATAKANA char."
(re-search-forward "\\ca\\|\\ck" nil t)))
(let* ((hankaku (preceding-char))
(composition (get-char-code-property hankaku 'kana-composition))
- next slot)
+ slot) ;; next
(if (and composition (setq slot (assq (following-char) composition)))
(japanese-replace-region (match-beginning 0) (1+ (point))
(cdr slot))
diff --git a/lisp/language/khmer.el b/lisp/language/khmer.el
index 37173c9fb95..6f08e60d601 100644
--- a/lisp/language/khmer.el
+++ b/lisp/language/khmer.el
@@ -31,7 +31,7 @@
(documentation . t)))
(let ((val (list (vector "[\x1780-\x17FF\x19E0-\x19FF\x200C\x200D]+"
- 0 'font-shape-gstring))))
+ 0 #'font-shape-gstring))))
(set-char-table-range composition-function-table '(#x1780 . #x17FF) val)
(set-char-table-range composition-function-table '(#x19E0 . #x19FF) val))
diff --git a/lisp/language/korea-util.el b/lisp/language/korea-util.el
index eb7b85bce81..b999eff662f 100644
--- a/lisp/language/korea-util.el
+++ b/lisp/language/korea-util.el
@@ -1,4 +1,4 @@
-;;; korea-util.el --- utilities for Korean
+;;; korea-util.el --- utilities for Korean -*- lexical-binding: t; -*-
;; Copyright (C) 1997, 1999, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
@@ -32,21 +32,25 @@
(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)
(activate-input-method
(concat "korean-hangul" default-korean-keyboard))))
-(defun quail-hangul-switch-symbol-ksc (&rest ignore)
- "Switch to/from Korean symbol package."
+(defun quail-hangul-switch-symbol-ksc (&rest _ignore)
+ "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")
@@ -54,8 +58,10 @@
default-korean-keyboard))
(activate-input-method "korean-symbol"))))
-(defun quail-hangul-switch-hanja (&rest ignore)
- "Switch to/from Korean hanja package."
+(defun quail-hangul-switch-hanja (&rest _ignore)
+ "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/language/korean.el b/lisp/language/korean.el
index 22b33a440ef..bdf8240de96 100644
--- a/lisp/language/korean.el
+++ b/lisp/language/korean.el
@@ -92,10 +92,10 @@ and the following key bindings are available within Korean input methods:
(pattern (concat choseong jungseong jongseong)))
(set-char-table-range composition-function-table
'(#x1100 . #x115F)
- (list (vector pattern 0 'font-shape-gstring)))
+ (list (vector pattern 0 #'font-shape-gstring)))
(set-char-table-range composition-function-table
'(#xA960 . #xA97C)
- (list (vector pattern 0 'font-shape-gstring))))
+ (list (vector pattern 0 #'font-shape-gstring))))
(provide 'korean)
diff --git a/lisp/language/lao-util.el b/lisp/language/lao-util.el
index 59c9850b1a1..c8c3fe4f7e6 100644
--- a/lisp/language/lao-util.el
+++ b/lisp/language/lao-util.el
@@ -1,4 +1,4 @@
-;;; lao-util.el --- utilities for Lao -*- coding: utf-8; -*-
+;;; lao-util.el --- utilities for Lao -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
@@ -498,10 +498,10 @@ syllable. In that case, FROM and TO are indexes to STR."
(compose-gstring-for-graphic gstring direction)
(or (font-shape-gstring gstring direction)
(let ((glyph-len (lgstring-glyph-len gstring))
- (i 0)
- glyph)
+ (i 0)) ;; glyph
(while (and (< i glyph-len)
- (setq glyph (lgstring-glyph gstring i)))
+ ;; (setq glyph
+ (lgstring-glyph gstring i)) ;;)
(setq i (1+ i)))
(compose-glyph-string-relative gstring 0 i 0.1)))))
diff --git a/lisp/language/lao.el b/lisp/language/lao.el
index 5252f1e60ea..c699d57c15a 100644
--- a/lisp/language/lao.el
+++ b/lisp/language/lao.el
@@ -66,7 +66,7 @@
(t (string c))))
(cdr l) ""))
;; Element of composition-function-table.
- (elt (list (vector regexp 1 'lao-composition-function)
+ (elt (list (vector regexp 1 #'lao-composition-function)
fallback-rule))
ch)
(dotimes (i len)
diff --git a/lisp/language/misc-lang.el b/lisp/language/misc-lang.el
index 0a274f144c2..a2ca678b2be 100644
--- a/lisp/language/misc-lang.el
+++ b/lisp/language/misc-lang.el
@@ -137,9 +137,9 @@ thin (i.e. 1-dot width) space."
composition-function-table
'(#x600 . #x74F)
(list (vector "[\u200C\u200D][\u0600-\u074F\u200C\u200D]+"
- 1 'arabic-shape-gstring)
+ 1 #'arabic-shape-gstring)
(vector "[\u0600-\u074F\u200C\u200D]+"
- 0 'arabic-shape-gstring)))
+ 0 #'arabic-shape-gstring)))
;; The Egyptian Hieroglyph Format Controls were introduced in Unicode
;; Standard v12.0. Apparently, they are not yet well supported in
@@ -186,13 +186,13 @@ thin (i.e. 1-dot width) space."
;; doesn't support these controls, the glyphs are
;; displayed individually, and not as a single
;; grapheme cluster.
- 1 'font-shape-gstring)))
+ 1 #'font-shape-gstring)))
;; Grouping controls
(set-char-table-range
composition-function-table
#x13437
(list (vector "\U00013437[\U00013000-\U0001343F]+"
- 0 'egyptian-shape-grouping))))
+ 0 #'egyptian-shape-grouping))))
(provide 'misc-lang)
diff --git a/lisp/language/sinhala.el b/lisp/language/sinhala.el
index 90fc41c1c41..99a104ec339 100644
--- a/lisp/language/sinhala.el
+++ b/lisp/language/sinhala.el
@@ -43,6 +43,6 @@
"[\u0D85-\u0D96][\u0D82-\u0D83]?\\|"
;; any other singleton characters
"[\u0D80-\u0DFF]")
- 0 'font-shape-gstring)))
+ 0 #'font-shape-gstring)))
;; sinhala.el ends here
diff --git a/lisp/language/tai-viet.el b/lisp/language/tai-viet.el
index 17abf136f7f..4549b111a3d 100644
--- a/lisp/language/tai-viet.el
+++ b/lisp/language/tai-viet.el
@@ -30,7 +30,7 @@
(set-char-table-range composition-function-table
'(#xAA80 . #xAADF)
- 'tai-viet-composition-function)
+ #'tai-viet-composition-function)
(set-language-info-alist
"TaiViet" '((charset unicode)
diff --git a/lisp/language/thai-util.el b/lisp/language/thai-util.el
index f9c57e8ca83..e11a05445c7 100644
--- a/lisp/language/thai-util.el
+++ b/lisp/language/thai-util.el
@@ -1,4 +1,4 @@
-;;; thai-util.el --- utilities for Thai -*- coding: utf-8; -*-
+;;; thai-util.el --- utilities for Thai -*- lexical-binding: t; -*-
;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
@@ -232,10 +232,10 @@ positions (integers or markers) specifying the region."
(let ((glyph-len (lgstring-glyph-len gstring))
(last-char (lgstring-char gstring
(1- (lgstring-char-len gstring))))
- (i 0)
- glyph)
+ (i 0)) ;; glyph
(while (and (< i glyph-len)
- (setq glyph (lgstring-glyph gstring i)))
+ ;; (setq glyph
+ (lgstring-glyph gstring i)) ;; )
(setq i (1+ i)))
(if (= last-char ?ำ)
(setq i (1- i)))
diff --git a/lisp/language/thai-word.el b/lisp/language/thai-word.el
index 94c6ab98979..ff1e80298ba 100644
--- a/lisp/language/thai-word.el
+++ b/lisp/language/thai-word.el
@@ -1,4 +1,4 @@
-;;; thai-word.el -- find Thai word boundaries
+;;; thai-word.el -- find Thai word boundaries -*- lexical-binding: t; -*-
;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -10973,8 +10973,7 @@ If COUNT is negative, move point backward (- COUNT) words."
;; special instead of using forward-word.
(let ((start (point))
(limit (match-end 0))
- boundaries
- tail)
+ boundaries) ;; tail
;; If thai-forward-word has been called within a Thai
;; region, we must go back until the Thai region starts
;; to do the contextual analysis for finding word
diff --git a/lisp/language/tibet-util.el b/lisp/language/tibet-util.el
index e741af18740..ddf4a0c0fb1 100644
--- a/lisp/language/tibet-util.el
+++ b/lisp/language/tibet-util.el
@@ -1,4 +1,4 @@
-;;; tibet-util.el --- utilities for Tibetan -*- coding: utf-8-emacs; -*-
+;;; tibet-util.el --- utilities for Tibetan -*- coding: utf-8-emacs; lexical-binding: t; -*-
;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
@@ -126,42 +126,42 @@ The returned string has no composition information."
(setq t-str-list (cons (substring str idx) t-str-list)))
(apply 'concat (nreverse t-str-list))))
-;;;
+;;
;;; Functions for composing/decomposing Tibetan sequence.
-;;;
-;;; A Tibetan syllable is typically structured as follows:
-;;;
-;;; [Prefix] C [C+] V [M] [Suffix [Post suffix]]
-;;;
-;;; where C's are all vertically stacked, V appears below or above
-;;; consonant cluster and M is always put above the C[C+]V combination.
-;;; (Sanskrit visarga, though it is a vowel modifier, is considered
-;;; to be a punctuation.)
-;;;
-;;; Here are examples of the words "bsgrubs" and "hfauM"
-;;;
-;;; བསྒྲུབས ཧཱུཾ
-;;;
-;;; M
-;;; b s b s h
-;;; g fa
-;;; r u
-;;; u
-;;;
-;;; Consonants `'' (འ), `w' (à½), `y' (ཡ), `r' (ར) take special
-;;; forms when they are used as subjoined consonant. Consonant `r'
-;;; takes another special form when used as superjoined in such a case
-;;; as "rka", while it does not change its form when conjoined with
-;;; subjoined `'', `w' or `y' as in "rwa", "rya".
-
-;; Append a proper composition rule and glyph to COMPONENTS to compose
-;; CHAR with a composition that has COMPONENTS.
+;;
+;; A Tibetan syllable is typically structured as follows:
+;;
+;; [Prefix] C [C+] V [M] [Suffix [Post suffix]]
+;;
+;; where C's are all vertically stacked, V appears below or above
+;; consonant cluster and M is always put above the C[C+]V combination.
+;; (Sanskrit visarga, though it is a vowel modifier, is considered
+;; to be a punctuation.)
+;;
+;; Here are examples of the words "bsgrubs" and "hfauM"
+;;
+;; བསྒྲུབས ཧཱུཾ
+;;
+;; M
+;; b s b s h
+;; g fa
+;; r u
+;; u
+;;
+;; Consonants `'' (འ), `w' (à½), `y' (ཡ), `r' (ར) take special
+;; forms when they are used as subjoined consonant. Consonant `r'
+;; takes another special form when used as superjoined in such a case
+;; as "rka", while it does not change its form when conjoined with
+;; subjoined `'', `w' or `y' as in "rwa", "rya".
+
+; Append a proper composition rule and glyph to COMPONENTS to compose
+; CHAR with a composition that has COMPONENTS.
(defun tibetan-add-components (components char)
(let ((last (last components))
(stack-upper '(tc . bc))
(stack-under '(bc . tc))
- rule comp-vowel tmp)
+ rule comp-vowel)
;; Special treatment for 'a chung.
;; If 'a follows a consonant, turn it into the subjoined form.
;; * Disabled by Tomabechi 2000/06/09 *
@@ -246,7 +246,7 @@ The returned string has no composition information."
(defun tibetan-compose-region (beg end)
"Compose Tibetan text the region BEG and END."
(interactive "r")
- (let (str result chars)
+ ;; (let (str result chars)
(save-excursion
(save-restriction
(narrow-to-region beg end)
@@ -272,7 +272,7 @@ The returned string has no composition information."
(while (< (point) to)
(tibetan-add-components components (following-char))
(forward-char 1))
- (compose-region from to components)))))))
+ (compose-region from to components)))))) ;; )
(defvar tibetan-decompose-precomposition-alist
(mapcar (lambda (x) (cons (string-to-char (cdr x)) (car x)))
diff --git a/lisp/language/tibetan.el b/lisp/language/tibetan.el
index edd9d765b1e..48c7638948c 100644
--- a/lisp/language/tibetan.el
+++ b/lisp/language/tibetan.el
@@ -605,7 +605,7 @@ This also matches some punctuation characters which need conversion.")
;; For automatic composition.
(set-char-table-range
composition-function-table '(#xF00 . #xFD1)
- (list (vector tibetan-composable-pattern 0 'font-shape-gstring)))
+ (list (vector tibetan-composable-pattern 0 #'font-shape-gstring)))
(provide 'tibetan)
diff --git a/lisp/language/tv-util.el b/lisp/language/tv-util.el
index 7ce8ee1e500..1a530d350f2 100644
--- a/lisp/language/tv-util.el
+++ b/lisp/language/tv-util.el
@@ -1,4 +1,4 @@
-;;; tv-util.el --- support for Tai Viet -*- coding: utf-8 -*-
+;;; tv-util.el --- support for Tai Viet -*- lexical-binding: t; -*-
;; Copyright (C) 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -128,7 +128,7 @@
;;;###autoload
-(defun tai-viet-composition-function (from to font-object string _direction)
+(defun tai-viet-composition-function (from _to _font-object string _direction)
(if string
(if (string-match tai-viet-re string from)
(tai-viet-compose-string from (match-end 0) string))
diff --git a/lisp/language/viet-util.el b/lisp/language/viet-util.el
index 177b04bc473..bfaf0f3b94a 100644
--- a/lisp/language/viet-util.el
+++ b/lisp/language/viet-util.el
@@ -1,4 +1,4 @@
-;;; viet-util.el --- utilities for Vietnamese -*- coding: utf-8; -*-
+;;; viet-util.el --- utilities for Vietnamese -*- lexical-binding: t; -*-
;; Copyright (C) 1998, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
diff --git a/lisp/leim/quail/compose.el b/lisp/leim/quail/compose.el
index f7ac83aec5b..264a9b479b3 100644
--- a/lisp/leim/quail/compose.el
+++ b/lisp/leim/quail/compose.el
@@ -1,4 +1,4 @@
-;;; compose.el --- Quail package for Multi_key character composition -*-coding: utf-8;-*-
+;;; compose.el --- Quail package for Multi_key character composition -*-coding: utf-8; lexical-binding: t -*-
;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
diff --git a/lisp/leim/quail/viqr.el b/lisp/leim/quail/viqr.el
index b7591b15e05..d127ff247cf 100644
--- a/lisp/leim/quail/viqr.el
+++ b/lisp/leim/quail/viqr.el
@@ -1,4 +1,4 @@
-;;; viqr.el --- Quail packages for inputting Vietnamese with VIQR system -*-coding: utf-8;-*-
+;;; viqr.el --- Quail packages for inputting Vietnamese with VIQR system -*-coding: utf-8; lexical-binding: t -*-
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010, 2011
diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el
index 4e8009db864..815ff4339eb 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/flow-fill.el b/lisp/mail/flow-fill.el
index e93ba547a89..0fab1b21b47 100644
--- a/lisp/mail/flow-fill.el
+++ b/lisp/mail/flow-fill.el
@@ -174,8 +174,8 @@ lines."
(defvar fill-flowed-encode-tests)
(defun fill-flowed-test ()
- (interactive "")
(declare (obsolete nil "27.1"))
+ (interactive "")
(user-error (concat "This function is obsolete. Please see "
"test/lisp/mail/flow-fill-tests.el "
"in the Emacs source tree")))
diff --git a/lisp/mail/footnote.el b/lisp/mail/footnote.el
index ea109eec12a..995ae5f9160 100644
--- a/lisp/mail/footnote.el
+++ b/lisp/mail/footnote.el
@@ -910,7 +910,31 @@ play around with the following keys:
(unless (assoc bullet-regexp filladapt-token-table)
(setq filladapt-token-table
(append filladapt-token-table
- (list (list bullet-regexp 'bullet)))))))))
+ (list (list bullet-regexp 'bullet)))))))
+ (footnote--regenerate-alist)))
+
+(defun footnote--regenerate-alist ()
+ (save-excursion
+ (goto-char (point-min))
+ (when (re-search-forward footnote-section-tag-regexp nil t)
+ (setq footnote--markers-alist
+ (cl-loop
+ with start-of-footnotes = (match-beginning 0)
+ with regexp = (footnote--current-regexp)
+ for (note text) in
+ (cl-loop for pos = (re-search-forward regexp nil t)
+ while pos
+ collect (list (match-string 1)
+ (copy-marker (match-beginning 0) t)))
+ do (goto-char (point-min))
+ collect (cl-list*
+ (string-to-number note)
+ text
+ (cl-loop
+ for pos = (re-search-forward regexp start-of-footnotes t)
+ while pos
+ when (equal note (match-string 1))
+ collect (copy-marker (match-beginning 0) t))))))))
(provide 'footnote)
diff --git a/lisp/mail/reporter.el b/lisp/mail/reporter.el
index 2e583a470d6..4b70582a261 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 29460cc20f5..8ccf1bffdd6 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.
@@ -2723,6 +2721,12 @@ See also `unrmail-mbox-format'."
:version "24.4"
:group 'rmail-files)
+(defcustom rmail-show-message-set-modified nil
+ "If non-nil, displaying an unseen message marks the Rmail buffer as modified."
+ :type 'boolean
+ :group 'rmail
+ :version "28.1")
+
(defun rmail-show-message-1 (&optional msg)
"Show message MSG (default: current message) using `rmail-view-buffer'.
Return text to display in the minibuffer if MSG is out of
@@ -2750,6 +2754,8 @@ The current mail message becomes the message displayed."
;; Mark the message as seen, but preserve buffer modified flag.
(let ((modiff (buffer-modified-p)))
(rmail-set-attribute rmail-unseen-attr-index nil)
+ (and rmail-show-message-set-modified
+ (setq modiff t))
(unless modiff
(restore-buffer-modified-p modiff)))
;; bracket the message in the mail
diff --git a/lisp/mail/rmailedit.el b/lisp/mail/rmailedit.el
index 2680ed7f3a3..c3b351d7bc8 100644
--- a/lisp/mail/rmailedit.el
+++ b/lisp/mail/rmailedit.el
@@ -145,8 +145,9 @@ This function runs the hooks `text-mode-hook' and `rmail-edit-mode-hook'.
(declare-function rmail-summary-enable "rmailsum" ())
(declare-function rmail-summary-update-line "rmailsum" (n))
-(defun rmail-cease-edit ()
- "Finish editing message; switch back to Rmail proper."
+(defun rmail-cease-edit (&optional abort)
+ "Finish editing message; switch back to Rmail proper.
+If ABORT, this is the result of aborting an edit."
(interactive)
(if (rmail-summary-exists)
(with-current-buffer rmail-summary-buffer
@@ -271,6 +272,8 @@ This function runs the hooks `text-mode-hook' and `rmail-edit-mode-hook'.
;; No match for rmail-mime-charset-pattern, but there was some
;; other Content-Type. We should not insert another. (Bug#4624)
(content-type)
+ ;; Don't insert anything if aborting.
+ (abort)
((null old-coding)
;; If there was no charset= spec, insert one.
(backward-char 1)
@@ -352,7 +355,7 @@ This function runs the hooks `text-mode-hook' and `rmail-edit-mode-hook'.
(widen)
(delete-region (point-min) (point-max))
(insert rmail-old-text)
- (rmail-cease-edit)
+ (rmail-cease-edit t)
(rmail-highlight-headers))
(defun rmail-edit-headers-alist (&optional widen markers)
diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el
index d29115a9570..7f99ecdcf2c 100644
--- a/lisp/mail/rmailsum.el
+++ b/lisp/mail/rmailsum.el
@@ -974,8 +974,9 @@ a negative argument means to delete and move forward."
(delete-char 1)
(insert "D"))
;; Discard cached new summary line.
- (with-current-buffer rmail-buffer
- (aset rmail-summary-vector (1- n) nil))))
+ (when n
+ (with-current-buffer rmail-buffer
+ (aset rmail-summary-vector (1- n) nil)))))
(beginning-of-line))
(defun rmail-summary-update-line (n)
diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el
index 9f6fd6de224..cd071667562 100644
--- a/lisp/mail/sendmail.el
+++ b/lisp/mail/sendmail.el
@@ -104,7 +104,9 @@ being sent is used), or nil (in which case the value of
(defcustom 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."
:type 'boolean)
;;;###autoload
@@ -172,14 +174,18 @@ This is used by the default mail-sending commands. See also
(defcustom 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."
:type '(choice file (const nil)))
;;;###autoload
(defcustom 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."
:type '(choice (const nil) string))
(defcustom mail-alias-file nil
@@ -388,7 +394,9 @@ in `message-auto-save-directory'."
(defcustom 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."
:type '(choice (const nil) string))
(defcustom mail-bury-selects-summary t
@@ -1792,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 5766c791878..99ac41dd9ba 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/menu-bar.el b/lisp/menu-bar.el
index 526491f0272..2fdfcc8b582 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -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-mime.el b/lisp/mh-e/mh-mime.el
index 7bdf743fc42..70df9e6b0f2 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/mh-e/mh-speed.el b/lisp/mh-e/mh-speed.el
index 35d5884b16c..7cbd42c8ea2 100644
--- a/lisp/mh-e/mh-speed.el
+++ b/lisp/mh-e/mh-speed.el
@@ -125,11 +125,10 @@ With non-nil FORCE, the update is always carried out."
;; Otherwise on to your regular programming
(t t)))
-(defun mh-speed-toggle (&rest ignored)
+(defun mh-speed-toggle (&rest _ignored)
"Toggle the display of child folders in the speedbar.
The optional arguments from speedbar are IGNORED."
(interactive)
- (declare (ignore args))
(beginning-of-line)
(let ((parent (get-text-property (point) 'mh-folder))
(kids-p (get-text-property (point) 'mh-children-p))
@@ -164,11 +163,10 @@ The optional arguments from speedbar are IGNORED."
(mh-line-beginning-position) (1+ (line-beginning-position))
'(mh-expanded t)))))))
-(defun mh-speed-view (&rest ignored)
+(defun mh-speed-view (&rest _ignored)
"Visits the selected folder just as if you had used \\<mh-folder-mode-map>\\[mh-visit-folder].
The optional arguments from speedbar are IGNORED."
(interactive)
- (declare (ignore args))
(let* ((folder (get-text-property (mh-line-beginning-position) 'mh-folder))
(range (and (stringp folder)
(mh-read-range "Scan" folder t nil nil
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 315f2d369af..03cc70c0d4d 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.
diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index 9559b125135..fa13dd57d1d 100644
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -2547,7 +2547,7 @@ can parse the output from a DIR listing for a host of type TYPE.")
FILE is the full name of the remote file, LSARGS is any args to pass to the
`ls' command, and PARSE specifies that the output should be parsed and stored
away in the internal cache."
- (when (string-match "^--dired\\s-+" lsargs)
+ (while (string-match "^--dired\\s-+" lsargs)
(setq lsargs (replace-match "" nil t lsargs)))
;; If parse is t, we assume that file is a directory. i.e. we only parse
;; full directory listings.
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index 7b72a713623..58f01d5bf98 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 7a7bbef5364..195ddc6bbac 100644
--- a/lisp/net/dbus.el
+++ b/lisp/net/dbus.el
@@ -2079,6 +2079,7 @@ daemon, it is rather the timestamp the corresponding D-Bus event
has been handled by this function."
(with-current-buffer (get-buffer-create "*D-Bus Monitor*")
(special-mode)
+ (buffer-disable-undo)
;; Move forward and backward between messages.
(local-set-key [?n] #'forward-paragraph)
(local-set-key [?p] #'backward-paragraph)
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index d131b2bf8c9..e39a4c33b20 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -1050,9 +1050,16 @@ the like."
;; multi-page isearch support
(setq-local multi-isearch-next-buffer-function #'eww-isearch-next-buffer)
(setq truncate-lines t)
+ (setq-local thing-at-point-provider-alist
+ (append thing-at-point-provider-alist
+ '((url . eww--url-at-point))))
(buffer-disable-undo)
(setq buffer-read-only t))
+(defun eww--url-at-point ()
+ "`thing-at-point' provider function."
+ (get-text-property (point) 'shr-url))
+
;;;###autoload
(defun eww-browse-url (url &optional new-window)
"Ask the EWW browser to load URL.
diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el
index 3b120be61f5..ea96012af20 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 44d2fd666ad..21d47b838f5 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 22348a1725c..58cc8b1be55 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/sasl-cram.el b/lisp/net/sasl-cram.el
index bc2612d9452..4022a35b391 100644
--- a/lisp/net/sasl-cram.el
+++ b/lisp/net/sasl-cram.el
@@ -1,4 +1,4 @@
-;;; sasl-cram.el --- CRAM-MD5 module for the SASL client framework
+;;; sasl-cram.el --- CRAM-MD5 module for the SASL client framework -*- lexical-binding: t -*-
;; Copyright (C) 2000, 2007-2021 Free Software Foundation, Inc.
diff --git a/lisp/net/sasl-digest.el b/lisp/net/sasl-digest.el
index efc8f82890c..5afc195d4b4 100644
--- a/lisp/net/sasl-digest.el
+++ b/lisp/net/sasl-digest.el
@@ -1,4 +1,4 @@
-;;; sasl-digest.el --- DIGEST-MD5 module for the SASL client framework
+;;; sasl-digest.el --- DIGEST-MD5 module for the SASL client framework -*- lexical-binding: t -*-
;; Copyright (C) 2000, 2007-2021 Free Software Foundation, Inc.
diff --git a/lisp/net/sasl-ntlm.el b/lisp/net/sasl-ntlm.el
index 66582265615..dfb7e713302 100644
--- a/lisp/net/sasl-ntlm.el
+++ b/lisp/net/sasl-ntlm.el
@@ -1,4 +1,4 @@
-;;; sasl-ntlm.el --- NTLM (NT Lan Manager) module for the SASL client framework
+;;; sasl-ntlm.el --- NTLM (NT Lan Manager) module for the SASL client framework -*- lexical-binding: t -*-
;; Copyright (C) 2000, 2007-2021 Free Software Foundation, Inc.
@@ -40,7 +40,7 @@
"A list of functions to be called in sequence for the NTLM
authentication steps. They are called by `sasl-next-step'.")
-(defun sasl-ntlm-request (client step)
+(defun sasl-ntlm-request (client _step)
"SASL step function to generate a NTLM authentication request to the server.
Called from `sasl-next-step'.
CLIENT is a vector [mechanism user service server sasl-client-properties]
diff --git a/lisp/net/sasl.el b/lisp/net/sasl.el
index 7f0431afb60..b7f814f7237 100644
--- a/lisp/net/sasl.el
+++ b/lisp/net/sasl.el
@@ -1,4 +1,4 @@
-;;; sasl.el --- SASL client framework
+;;; sasl.el --- SASL client framework -*- lexical-binding: t -*-
;; Copyright (C) 2000, 2007-2021 Free Software Foundation, Inc.
@@ -161,15 +161,8 @@ the current challenge. At the first time STEP should be set to nil."
(if function
(vector function (funcall function client step)))))
-(defvar sasl-read-passphrase nil)
+(defvar sasl-read-passphrase 'read-passwd)
(defun sasl-read-passphrase (prompt)
- (if (not sasl-read-passphrase)
- (if (functionp 'read-passwd)
- (setq sasl-read-passphrase 'read-passwd)
- (if (load "passwd" t)
- (setq sasl-read-passphrase 'read-passwd)
- (autoload 'ange-ftp-read-passwd "ange-ftp")
- (setq sasl-read-passphrase 'ange-ftp-read-passwd))))
(funcall sasl-read-passphrase prompt))
(defun sasl-unique-id ()
@@ -210,7 +203,7 @@ It contain at least 64 bits of entropy."
(defconst sasl-plain-steps
'(sasl-plain-response))
-(defun sasl-plain-response (client step)
+(defun sasl-plain-response (client _step)
(let ((passphrase
(sasl-read-passphrase
(format "PLAIN passphrase for %s: " (sasl-client-name client))))
@@ -236,12 +229,12 @@ It contain at least 64 bits of entropy."
sasl-login-response-1
sasl-login-response-2))
-(defun sasl-login-response-1 (client step)
+(defun sasl-login-response-1 (client _step)
;;; (unless (string-match "^Username:" (sasl-step-data step))
;;; (sasl-error (format "Unexpected response: %s" (sasl-step-data step))))
(sasl-client-name client))
-(defun sasl-login-response-2 (client step)
+(defun sasl-login-response-2 (client _step)
;;; (unless (string-match "^Password:" (sasl-step-data step))
;;; (sasl-error (format "Unexpected response: %s" (sasl-step-data step))))
(sasl-read-passphrase
@@ -257,7 +250,7 @@ It contain at least 64 bits of entropy."
'(ignore ;no initial response
sasl-anonymous-response))
-(defun sasl-anonymous-response (client step)
+(defun sasl-anonymous-response (client _step)
(or (sasl-client-property client 'trace)
(sasl-client-name client)))
diff --git a/lisp/net/sieve-mode.el b/lisp/net/sieve-mode.el
index fbc4e75fae5..7bc1d16122d 100644
--- a/lisp/net/sieve-mode.el
+++ b/lisp/net/sieve-mode.el
@@ -128,6 +128,9 @@
(modify-syntax-entry ?| "." st)
(modify-syntax-entry ?_ "_" st)
(modify-syntax-entry ?\' "\"" st)
+ (modify-syntax-entry ?\{ "(}" st)
+ (modify-syntax-entry ?\} "){" st)
+ (modify-syntax-entry ?\" "\"" st)
st)
"Syntax table in use in sieve-mode buffers.")
@@ -178,12 +181,8 @@
'syntax-table (string-to-syntax "|")))))
;;;###autoload
-(define-derived-mode sieve-mode c-mode "Sieve"
+(define-derived-mode sieve-mode prog-mode "Sieve"
"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'."
(setq-local paragraph-start (concat "$\\|" page-delimiter))
(setq-local paragraph-separate paragraph-start)
@@ -194,8 +193,17 @@ Turning on Sieve mode runs `sieve-mode-hook'."
(setq-local syntax-propertize-function #'sieve-syntax-propertize)
(setq-local font-lock-defaults
'(sieve-font-lock-keywords nil nil ((?_ . "w"))))
+ (setq-local indent-line-function #'sieve-mode-indent-function)
(easy-menu-add-item nil nil sieve-mode-menu))
+(defun sieve-mode-indent-function ()
+ (save-excursion
+ (beginning-of-line)
+ (let ((depth (car (syntax-ppss))))
+ (when (looking-at "[ \t]*}")
+ (setq depth (1- depth)))
+ (indent-line-to (* 2 depth)))))
+
(provide 'sieve-mode)
;; sieve-mode.el ends here
diff --git a/lisp/net/soap-inspect.el b/lisp/net/soap-inspect.el
index 604e35c07cf..9d4e440719d 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 67f844428a7..44f535f01c9 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 2c4ef2acaef..73dffe1d64f 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -636,7 +636,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(copy-directory filename newname keep-date t)
(let ((t1 (tramp-tramp-file-p filename))
- (t2 (tramp-tramp-file-p newname)))
+ (t2 (tramp-tramp-file-p newname))
+ ;; We don't want the target file to be compressed, so we
+ ;; let-bind `jka-compr-inhibit' to t.
+ (jka-compr-inhibit t))
(with-parsed-tramp-file-name (if t1 filename newname) nil
(unless (file-exists-p filename)
(tramp-error
@@ -717,7 +720,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(delete-directory filename 'recursive))
(let ((t1 (tramp-tramp-file-p filename))
- (t2 (tramp-tramp-file-p newname)))
+ (t2 (tramp-tramp-file-p newname))
+ ;; We don't want the target file to be compressed, so we
+ ;; let-bind `jka-compr-inhibit' to t.
+ (jka-compr-inhibit t))
(with-parsed-tramp-file-name (if t1 filename newname) nil
(unless (file-exists-p filename)
(tramp-error
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 618a9fb9d02..2274efdf8b5 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -181,10 +181,9 @@ The string is used in `tramp-methods'.")
`("scpx"
(tramp-login-program "ssh")
(tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
- ("-e" "none") ("-t" "-t") ("%h")
- ("%l")))
+ ("-e" "none") ("-t" "-t")
+ ("-o" "RemoteCommand='%l'") ("%h")))
(tramp-async-args (("-q")))
- (tramp-direct-async t)
(tramp-remote-shell ,tramp-default-remote-shell)
(tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))
@@ -238,10 +237,9 @@ The string is used in `tramp-methods'.")
`("sshx"
(tramp-login-program "ssh")
(tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
- ("-e" "none") ("-t" "-t") ("%h")
- ("%l")))
+ ("-e" "none") ("-t" "-t")
+ ("-o" "RemoteCommand='%l'") ("%h")))
(tramp-async-args (("-q")))
- (tramp-direct-async t)
(tramp-remote-shell ,tramp-default-remote-shell)
(tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))))
@@ -1710,6 +1708,12 @@ ID-FORMAT valid values are `string' and `integer'."
(= (tramp-compat-file-attribute-user-id attributes)
(tramp-get-remote-uid v 'integer))
(or (not group)
+ ;; On BSD-derived systems files always inherit the
+ ;; parent directory's group, so skip the group-gid
+ ;; test.
+ (string-match-p
+ "BSD\\|DragonFly\\|Darwin"
+ (tramp-get-connection-property v "uname" ""))
(= (tramp-compat-file-attribute-group-id attributes)
(tramp-get-remote-gid v 'integer)))))))))
@@ -2619,11 +2623,8 @@ The method used must be an out-of-band method."
filename switches wildcard full-directory-p)
(when (stringp switches)
(setq switches (split-string switches)))
- (when (tramp-get-ls-command-with ;FIXME: tramp-sh--quoting-style-options?
- v "--quoting-style=literal --show-control-chars")
- (setq switches
- (append
- switches '("--quoting-style=literal" "--show-control-chars"))))
+ (setq switches
+ (append switches (split-string (tramp-sh--quoting-style-options v))))
(unless (tramp-get-ls-command-with v "--dired")
(setq switches (delete "--dired" switches)))
(when wildcard
@@ -5124,7 +5125,7 @@ connection if a previous connection has died for some reason."
options (format-spec options spec)
spec (format-spec-make
?h l-host ?u l-user ?p l-port ?c options
- ?l (concat remote-shell " " extra-args))
+ ?l (concat remote-shell " " extra-args " -i"))
command
(concat
;; We do not want to see the trailing local
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 1604e8962c0..c5a74a5c653 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -156,6 +156,7 @@ this variable (\"client min protocol=NT1\") ."
"NT_STATUS_NO_SUCH_FILE"
"NT_STATUS_NO_SUCH_USER"
"NT_STATUS_NOT_A_DIRECTORY"
+ "NT_STATUS_NOT_SUPPORTED"
"NT_STATUS_OBJECT_NAME_COLLISION"
"NT_STATUS_OBJECT_NAME_INVALID"
"NT_STATUS_OBJECT_NAME_NOT_FOUND"
@@ -371,17 +372,17 @@ pass to the OPERATION."
(tramp-error
v2 'file-error
"add-name-to-file: %s must not be a directory" filename))
- ;; Do the 'confirm if exists' thing.
- (when (file-exists-p newname)
- ;; What to do?
- (if (or (null ok-if-already-exists) ; not allowed to exist
- (and (numberp ok-if-already-exists)
- (not (yes-or-no-p
- (format
- "File %s already exists; make it a link anyway? "
- v2-localname)))))
- (tramp-error v2 'file-already-exists newname)
- (delete-file newname)))
+ ;; Do the 'confirm if exists' thing.
+ (when (file-exists-p newname)
+ ;; What to do?
+ (if (or (null ok-if-already-exists) ; not allowed to exist
+ (and (numberp ok-if-already-exists)
+ (not (yes-or-no-p
+ (format
+ "File %s already exists; make it a link anyway? "
+ v2-localname)))))
+ (tramp-error v2 'file-already-exists newname)
+ (delete-file newname)))
;; We must also flush the cache of the directory, because
;; `file-attributes' reads the values from there.
(tramp-flush-file-properties v2 v2-localname)
@@ -1166,7 +1167,6 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(insert " -> " (tramp-compat-file-attribute-type attr))))
(insert "\n")
- (forward-line)
(beginning-of-line)))
entries))))))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 2816c58fe7f..7b34a748822 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -1990,6 +1990,8 @@ the resulting error message."
(tramp-dissect-file-name default-directory) 0 fmt-string arguments)
(apply #'message fmt-string arguments)))
+(put #'tramp-test-message 'tramp-suppress-trace t)
+
;; This function provides traces in case of errors not triggered by
;; Tramp functions.
(defun tramp-signal-hook-function (error-symbol data)
@@ -3801,15 +3803,20 @@ It does not support `:stderr'."
(get-buffer-create buffer)
;; BUFFER can be nil. We use a temporary buffer.
(generate-new-buffer tramp-temp-buffer-name)))
- ;; We use as environment the difference to toplevel
- ;; `process-environment'.
(env (mapcar
(lambda (elt)
- (unless
- (member
- elt (default-toplevel-value 'process-environment))
- (when (string-match-p "=" elt) elt)))
- process-environment))
+ (when (string-match-p "=" elt) elt))
+ tramp-remote-process-environment))
+ ;; We use as environment the difference to toplevel
+ ;; `process-environment'.
+ (env (dolist (elt process-environment env)
+ (when
+ (and
+ (string-match-p "=" elt)
+ (not
+ (member
+ elt (default-toplevel-value 'process-environment))))
+ (setq env (cons elt env)))))
(env (setenv-internal
env "INSIDE_EMACS"
(concat (or (getenv "INSIDE_EMACS") emacs-version)
diff --git a/lisp/net/webjump.el b/lisp/net/webjump.el
index 9bcf1d37345..1fa625c3245 100644
--- a/lisp/net/webjump.el
+++ b/lisp/net/webjump.el
@@ -2,9 +2,10 @@
;; Copyright (C) 1996-1997, 2001-2021 Free Software Foundation, Inc.
-;; Author: Neil W. Van Dyke <nwv@acm.org>
-;; Created: 09-Aug-1996
-;; Keywords: comm www
+;; Author: Neil W. Van Dyke <nwv@acm.org>
+;; Maintainer: emacs-devel@gnu.org
+;; Created: 09-Aug-1996
+;; Keywords: comm www
;; This file is part of GNU Emacs.
@@ -95,9 +96,6 @@
("DuckDuckGo" .
[simple-query "duckduckgo.com"
"duckduckgo.com/?q=" ""])
- ("Google" .
- [simple-query "www.google.com"
- "www.google.com/search?q=" ""])
("Google Groups" .
[simple-query "groups.google.com"
"groups.google.com/groups?q=" ""])
diff --git a/lisp/newcomment.el b/lisp/newcomment.el
index 5d0d1053f4b..ea47eec4fda 100644
--- a/lisp/newcomment.el
+++ b/lisp/newcomment.el
@@ -832,12 +832,17 @@ Ensure that `comment-normalize-vars' has been called before you use this."
(when (and (stringp str) (string-match "\\S-" str))
;; Separate the actual string from any leading/trailing padding
(string-match "\\`\\s-*\\(.*?\\)\\s-*\\'" str)
- (let ((s (match-string 1 str)) ;actual string
+ (let ((s (match-string 1 str)) ;actual string
(lpad (substring str 0 (match-beginning 1))) ;left padding
- (rpad (concat (substring str (match-end 1)) ;original right padding
- (substring comment-padding ;additional right padding
- (min (- (match-end 0) (match-end 1))
- (length comment-padding)))))
+ (rpad (concat
+ (substring str (match-end 1)) ;original right padding
+ (if (numberp comment-padding)
+ (make-string (min comment-padding
+ (- (match-end 0) (match-end 1)))
+ ?\s)
+ (substring comment-padding ;additional right padding
+ (min (- (match-end 0) (match-end 1))
+ (length comment-padding))))))
;; We can only duplicate C if the comment-end has multiple chars
;; or if comments can be nested, else the comment-end `}' would
;; be turned into `}}}' where only the first ends the comment
@@ -852,7 +857,7 @@ Ensure that `comment-normalize-vars' has been called before you use this."
(concat (mapconcat (lambda (c) (concat (regexp-quote (string c)) "?"))
lpad "") ;padding is not required
(regexp-quote s)
- (when multi "+") ;the last char of S might be repeated
+ (when multi "+") ;the last char of S might be repeated
(mapconcat (lambda (c) (concat (regexp-quote (string c)) "?"))
rpad "")))))) ;padding is not required
@@ -1221,21 +1226,33 @@ changed with `comment-style'."
;; FIXME: maybe we should call uncomment depending on ARG.
(funcall comment-region-function beg end arg)))
-(defun comment-region-default-1 (beg end &optional arg)
+(defun comment-region-default-1 (beg end &optional arg noadjust)
+ "Comment region between BEG and END.
+See `comment-region' for ARG. If NOADJUST, do not skip past
+leading/trailing space when determining the region to comment
+out."
(let* ((numarg (prefix-numeric-value arg))
(style (cdr (assoc comment-style comment-styles)))
(lines (nth 2 style))
(block (nth 1 style))
(multi (nth 0 style)))
- ;; We use `chars' instead of `syntax' because `\n' might be
- ;; of end-comment syntax rather than of whitespace syntax.
- ;; sanitize BEG and END
- (goto-char beg) (skip-chars-forward " \t\n\r") (beginning-of-line)
- (setq beg (max beg (point)))
- (goto-char end) (skip-chars-backward " \t\n\r") (end-of-line)
- (setq end (min end (point)))
- (if (>= beg end) (error "Nothing to comment"))
+ (if noadjust
+ (when (bolp)
+ (setq end (1- end)))
+ ;; We use `chars' instead of `syntax' because `\n' might be
+ ;; of end-comment syntax rather than of whitespace syntax.
+ ;; sanitize BEG and END
+ (goto-char beg)
+ (skip-chars-forward " \t\n\r")
+ (beginning-of-line)
+ (setq beg (max beg (point)))
+ (goto-char end)
+ (skip-chars-backward " \t\n\r")
+ (end-of-line)
+ (setq end (min end (point)))
+ (when (>= beg end)
+ (error "Nothing to comment")))
;; sanitize LINES
(setq lines
diff --git a/lisp/nxml/rng-cmpct.el b/lisp/nxml/rng-cmpct.el
index dcbd7ed1dd7..45a69a73f35 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 12ffa578200..034671feeb0 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-util.el b/lisp/nxml/rng-util.el
index 59465c371eb..a20e95086cb 100644
--- a/lisp/nxml/rng-util.el
+++ b/lisp/nxml/rng-util.el
@@ -1,4 +1,4 @@
-;;; rng-util.el --- utility functions for RELAX NG library
+;;; rng-util.el --- utility functions for RELAX NG library -*- lexical-binding: t; -*-
;; Copyright (C) 2003, 2007-2021 Free Software Foundation, Inc.
diff --git a/lisp/nxml/rng-valid.el b/lisp/nxml/rng-valid.el
index 6ea893404cb..a5eb893c554 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/obsolete/nnir.el b/lisp/obsolete/nnir.el
index 0b7d1e454c3..147efed0057 100644
--- a/lisp/obsolete/nnir.el
+++ b/lisp/obsolete/nnir.el
@@ -504,6 +504,7 @@ Add an entry here when adding a new search engine.")
,@(mapcar (lambda (elem) (list 'const (car elem)))
nnir-engines)))))
+
(defmacro nnir-add-result (dirnam artno score prefix server artlist)
"Construct a result vector and add it to ARTLIST.
DIRNAM, ARTNO, SCORE, PREFIX and SERVER are passed to
diff --git a/lisp/org/ol.el b/lisp/org/ol.el
index d1db1683bbe..994e30f4f43 100644
--- a/lisp/org/ol.el
+++ b/lisp/org/ol.el
@@ -376,9 +376,9 @@ changes to the current buffer."
Shell links can be dangerous: just think about a link
- [[shell:rm -rf ~/*][Google Search]]
+ [[shell:rm -rf ~/*][Web Search]]
-This link would show up in your Org document as \"Google Search\",
+This link would show up in your Org document as \"Web Search\",
but really it would remove your entire home directory.
Therefore we advise against setting this variable to nil.
Just change it to `y-or-n-p' if you want to confirm with a
@@ -401,9 +401,9 @@ single keystroke rather than having to type \"yes\"."
"Non-nil means ask for confirmation before executing Emacs Lisp links.
Elisp links can be dangerous: just think about a link
- [[elisp:(shell-command \"rm -rf ~/*\")][Google Search]]
+ [[elisp:(shell-command \"rm -rf ~/*\")][Web Search]]
-This link would show up in your Org document as \"Google Search\",
+This link would show up in your Org document as \"Web Search\",
but really it would remove your entire home directory.
Therefore we advise against setting this variable to nil.
Just change it to `y-or-n-p' if you want to confirm with a
diff --git a/lisp/org/org.el b/lisp/org/org.el
index 43aa0a178a9..2d21a44fb48 100644
--- a/lisp/org/org.el
+++ b/lisp/org/org.el
@@ -1846,7 +1846,7 @@ link types. The types are:
bracket The recommended [[link][description]] or [[link]] links with hiding.
angle Links in angular brackets that may contain whitespace like
<bbdb:Carsten Dominik>.
-plain Plain links in normal text, no whitespace, like http://google.com.
+plain Plain links in normal text, no whitespace, like https://gnu.org.
radio Text that is matched by a radio target, see manual for details.
tag Tag settings in a headline (link to tag search).
date Time stamps (link to calendar).
diff --git a/lisp/play/5x5.el b/lisp/play/5x5.el
index 07ef30c07d1..05e61dfe401 100644
--- a/lisp/play/5x5.el
+++ b/lisp/play/5x5.el
@@ -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
diff --git a/lisp/play/decipher.el b/lisp/play/decipher.el
index a7a4b89c372..b870bfb4a19 100644
--- a/lisp/play/decipher.el
+++ b/lisp/play/decipher.el
@@ -184,28 +184,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/gamegrid.el b/lisp/play/gamegrid.el
index e540ca723d0..8b64dfdf9b5 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 1a1d2d76520..be39e1ebfb0 100644
--- a/lisp/play/gametree.el
+++ b/lisp/play/gametree.el
@@ -79,7 +79,6 @@
;;; Code:
-(require 'derived)
(require 'outline)
;;;; Configuration variables
diff --git a/lisp/play/handwrite.el b/lisp/play/handwrite.el
index 7ad3de6fb64..98da26c2e6c 100644
--- a/lisp/play/handwrite.el
+++ b/lisp/play/handwrite.el
@@ -1,8 +1,9 @@
-;;; handwrite.el --- turns your emacs buffer into a handwritten document
+;;; handwrite.el --- turns your emacs buffer into a handwritten document -*- lexical-binding: t -*-
;; Copyright (C) 1996, 2001-2021 Free Software Foundation, Inc.
;; Author: Danny Roozendaal (was: <danny@tvs.kun.nl>)
+;; Maintainer: emacs-devel@gnu.org
;; Created: October 21 1996
;; Keywords: wp, print, postscript, cursive writing
@@ -22,11 +23,11 @@
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
+
+;; The function `handwrite' creates PostScript output containing a
+;; handwritten version of the current buffer.
;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; The function handwrite creates PostScript output containing a
-;; handwritten version of the current buffer..
-;; Other functions that may be useful are
+;; Other functions that may be useful are:
;;
;; handwrite-10pt: sets the font size to 10 and finds corresponding
;; values for the line spacing and the number of lines
@@ -54,8 +55,6 @@
;; unknown characters.
;;
;; Thanks to anyone who emailed me suggestions!
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
;;; Code:
@@ -64,7 +63,6 @@
(defvar ps-lpr-command)
(defvar ps-lpr-switches)
-
;; Variables
(defgroup handwrite nil
@@ -98,44 +96,43 @@
(defcustom handwrite-numlines 60
"The number of lines on a page of the PostScript output from `handwrite'."
- :type 'integer
- :group 'handwrite)
+ :type 'integer)
+
(defcustom handwrite-fontsize 11
"The size of the font for the PostScript output from `handwrite'."
- :type 'integer
- :group 'handwrite)
+ :type 'integer)
+
(defcustom handwrite-linespace 12
"The spacing for the PostScript output from `handwrite'."
- :type 'integer
- :group 'handwrite)
+ :type 'integer)
+
(defcustom handwrite-xstart 30
"X-axis translation in the PostScript output from `handwrite'."
- :type 'integer
- :group 'handwrite)
+ :type 'integer)
+
(defcustom handwrite-ystart 810
"Y-axis translation in the PostScript output from `handwrite'."
- :type 'integer
- :group 'handwrite)
+ :type 'integer)
+
(defcustom handwrite-pagenumbering nil
"If non-nil, number each page of the PostScript output from `handwrite'."
- :type 'boolean
- :group 'handwrite)
+ :type 'boolean)
+
(defcustom handwrite-10pt-numlines 65
"The number of lines on a page for the function `handwrite-10pt'."
- :type 'integer
- :group 'handwrite)
+ :type 'integer)
+
(defcustom handwrite-11pt-numlines 60
"The number of lines on a page for the function `handwrite-11pt'."
- :type 'integer
- :group 'handwrite)
+ :type 'integer)
+
(defcustom handwrite-12pt-numlines 55
"The number of lines on a page for the function `handwrite-12pt'."
- :type 'integer
- :group 'handwrite)
+ :type 'integer)
+
(defcustom handwrite-13pt-numlines 50
"The number of lines on a page for the function `handwrite-13pt'."
- :type 'integer
- :group 'handwrite)
+ :type 'integer)
;; Interactive functions
@@ -150,17 +147,17 @@ Variables: `handwrite-linespace' (default 12)
`handwrite-numlines' (default 60)
`handwrite-pagenumbering' (default nil)"
(interactive)
+ (setq handwrite-psindex (1+ handwrite-psindex))
(let
- (;(pmin) ; thanks, Havard
- (cur-buf (current-buffer))
+ ((cur-buf (current-buffer))
(tpoint (point))
(ps-ypos 63)
(lcount 0)
(ipage 1)
- (nlan next-line-add-newlines) ;remember the old value
+ (next-line-add-newlines t)
(buf-name (buffer-name) )
(textp)
- (ps-buf-name) ;name of the PostScript buffer
+ (ps-buf-name (format "*handwritten%d.ps*" handwrite-psindex))
(trans-table
'(("ÿ" . "264") ("á" . "207") ("à" . "210") ("â" . "211")
("ä" . "212") ("ã" . "213") ("å" . "214") ("é" . "216")
@@ -175,10 +172,6 @@ Variables: `handwrite-linespace' (default 12)
; on inserted backslashes
line)
(goto-char (point-min)) ;start at beginning
- (setq handwrite-psindex (1+ handwrite-psindex))
- (setq ps-buf-name
- (format "*handwritten%d.ps*" handwrite-psindex))
- (setq next-line-add-newlines t)
(switch-to-buffer ps-buf-name)
(handwrite-insert-header buf-name)
(insert "%%Creator: GNU Emacs's handwrite version " emacs-version "\n")
@@ -258,9 +251,7 @@ Variables: `handwrite-linespace' (default 12)
(message "")
(bury-buffer ())
(switch-to-buffer cur-buf)
- (goto-char tpoint)
- (setq next-line-add-newlines nlan)
- ))
+ (goto-char tpoint)))
(defun handwrite-set-pagenumber ()
@@ -280,7 +271,6 @@ values for `handwrite-linespace' and `handwrite-numlines'."
(setq handwrite-numlines handwrite-10pt-numlines)
(message "Handwrite output size set to 10 points"))
-
(defun handwrite-11pt ()
"Specify 11-point output for `handwrite'.
This sets `handwrite-fontsize' to 11 and finds correct
@@ -1238,28 +1228,16 @@ end
/Joepie Hwfdict definefont
%%EndFont Joepie\n\n"))
-;;Sets page numbering off
(defun handwrite-set-pagenumber-off ()
+ "Set page numbering off."
(setq handwrite-pagenumbering nil)
(message "page numbering off"))
-;;Sets page numbering on
(defun handwrite-set-pagenumber-on ()
+ "Set page numbering on."
(setq handwrite-pagenumbering t)
(message "page numbering on" ))
-
-;; Key bindings
-
-;; I'd rather not fill up the menu bar menus with
-;; lots of random miscellaneous features. -- rms.
-;;;(define-key-after
-;;; (lookup-key global-map [menu-bar edit])
-;;; [handwrite]
-;;; '("Write by hand" . menu-bar-handwrite-map)
-;;; 'spell)
-
(provide 'handwrite)
-
;;; handwrite.el ends here
diff --git a/lisp/play/mpuz.el b/lisp/play/mpuz.el
index 7fff604aead..838bddfb665 100644
--- a/lisp/play/mpuz.el
+++ b/lisp/play/mpuz.el
@@ -1,4 +1,4 @@
-;;; mpuz.el --- multiplication puzzle for GNU Emacs
+;;; mpuz.el --- multiplication puzzle for GNU Emacs -*- lexical-binding: t -*-
;; Copyright (C) 1990, 2001-2021 Free Software Foundation, Inc.
@@ -40,49 +40,41 @@
The value t means never ding, and `error' means only ding on wrong input."
:type '(choice (const :tag "No" nil)
(const :tag "Yes" t)
- (const :tag "If correct" error))
- :group 'mpuz)
+ (const :tag "If correct" error)))
(defcustom mpuz-solve-when-trivial t
"Solve any row that can be trivially calculated from what you've found."
- :type 'boolean
- :group 'mpuz)
+ :type 'boolean)
(defcustom mpuz-allow-double-multiplicator nil
"Allow 2nd factors like 33 or 77."
- :type 'boolean
- :group 'mpuz)
+ :type 'boolean)
(defface mpuz-unsolved
'((default :weight bold)
(((class color)) :foreground "red1"))
- "Face for letters to be solved."
- :group 'mpuz)
+ "Face for letters to be solved.")
(defface mpuz-solved
'((default :weight bold)
(((class color)) :foreground "green1"))
- "Face for solved digits."
- :group 'mpuz)
+ "Face for solved digits.")
(defface mpuz-trivial
'((default :weight bold)
(((class color)) :foreground "blue"))
- "Face for trivial digits solved for you."
- :group 'mpuz)
+ "Face for trivial digits solved for you.")
(defface mpuz-text
'((t :inherit variable-pitch))
- "Face for text on right."
- :group 'mpuz)
+ "Face for text on right.")
;; Mpuz mode and keymaps
;;----------------------
(defcustom mpuz-mode-hook nil
"Hook to run upon entry to mpuz."
- :type 'hook
- :group 'mpuz)
+ :type 'hook)
(defvar mpuz-mode-map
(let ((map (make-sparse-keymap)))
@@ -341,8 +333,8 @@ You may abort a game by typing \\<mpuz-mode-map>\\[mpuz-offer-abort]."
(defun mpuz-switch-to-window ()
"Find or create the Mult-Puzzle buffer, and display it."
- (let ((buf (mpuz-get-buffer)))
- (or buf (setq buf (mpuz-create-buffer)))
+ (let ((buf (or (mpuz-get-buffer)
+ (mpuz-create-buffer))))
(switch-to-buffer buf)
(setq buffer-read-only t)
(mpuz-mode)))
diff --git a/lisp/play/snake.el b/lisp/play/snake.el
index 5584bf88103..bed7cea6ee5 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 8205d3f79c5..05e4ffe0111 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/progmodes/asm-mode.el b/lisp/progmodes/asm-mode.el
index 62ff783fbac..99b2ec6d87e 100644
--- a/lisp/progmodes/asm-mode.el
+++ b/lisp/progmodes/asm-mode.el
@@ -141,8 +141,7 @@ Special commands:
(setq-local comment-add 1)
(setq-local comment-start-skip "\\(?:\\s<+\\|/[/*]+\\)[ \t]*")
(setq-local comment-end-skip "[ \t]*\\(\\s>\\|\\*+/\\)")
- (setq-local comment-end "")
- (setq fill-prefix "\t"))
+ (setq-local comment-end ""))
(defun asm-indent-line ()
"Auto-indent the current line."
diff --git a/lisp/progmodes/bat-mode.el b/lisp/progmodes/bat-mode.el
index 44295c3f679..7ba8a69775e 100644
--- a/lisp/progmodes/bat-mode.el
+++ b/lisp/progmodes/bat-mode.el
@@ -1,4 +1,4 @@
-;;; bat-mode.el --- Major mode for editing DOS/Windows scripts
+;;; bat-mode.el --- Major mode for editing DOS/Windows scripts -*- lexical-binding: t -*-
;; Copyright (C) 2003, 2008-2021 Free Software Foundation, Inc.
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 94e4f3c6fa7..614ed7d835d 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."
@@ -2673,9 +2669,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.
@@ -3041,7 +3036,12 @@ TRUE-DIRNAME is the `file-truename' of DIRNAME, if given."
;; Get the specified directory from FILE.
(spec-directory
(if (cdr file)
- (file-truename (concat comint-file-name-prefix (cdr file))))))
+ ;; This function is active in `compilation-filter'.
+ ;; There could be problems to call `file-truename'
+ ;; for remote compilation processes.
+ (if (file-remote-p default-directory)
+ (concat comint-file-name-prefix (cdr file))
+ (file-truename (concat comint-file-name-prefix (cdr file)))))))
;; Check for a comint-file-name-prefix and prepend it if appropriate.
;; (This is very useful for compilation-minor-mode in an rlogin-mode
diff --git a/lisp/progmodes/cpp.el b/lisp/progmodes/cpp.el
index 4ea1674db02..b2c2e8dab57 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/ebnf2ps.el b/lisp/progmodes/ebnf2ps.el
index 6f9509d152b..b376423c185 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/f90.el b/lisp/progmodes/f90.el
index 2641387986d..92b165bc641 100644
--- a/lisp/progmodes/f90.el
+++ b/lisp/progmodes/f90.el
@@ -926,9 +926,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.
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index 460af718aad..5d96c62b418 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -352,12 +352,20 @@ diagnostics at BEG."
(flymake--diag-accessor flymake-diagnostic-data flymake--diag-data backend)
(defun flymake-diagnostic-beg (diag)
- "Get Flymake diagnostic DIAG's start position."
- (overlay-start (flymake--diag-overlay diag)))
+ "Get Flymake diagnostic DIAG's start position.
+This position only be queried after DIAG has been reported to Flymake."
+ (let ((overlay (flymake--diag-overlay diag)))
+ (unless overlay
+ (error "DIAG %s not reported to Flymake yet" diag))
+ (overlay-start overlay)))
(defun flymake-diagnostic-end (diag)
- "Get Flymake diagnostic DIAG's end position."
- (overlay-end (flymake--diag-overlay diag)))
+ "Get Flymake diagnostic DIAG's end position.
+This position only be queried after DIAG has been reported to Flymake."
+ (let ((overlay (flymake--diag-overlay diag)))
+ (unless overlay
+ (error "DIAG %s not reported to Flymake yet" diag))
+ (overlay-end overlay)))
(cl-defun flymake--overlays (&key beg end filter compare key)
"Get flymake-related overlays.
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index 259da2fd019..eb114acdabc 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/js.el b/lisp/progmodes/js.el
index 33bea59e3ba..cdf6536fc7e 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/octave.el b/lisp/progmodes/octave.el
index a14a8d75a78..c37bb1c7112 100644
--- a/lisp/progmodes/octave.el
+++ b/lisp/progmodes/octave.el
@@ -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.
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index d047dd543c2..0120e4a7cd1 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -143,7 +143,7 @@
'(;; Functions
(nil "^[ \t]*sub\\s-+\\([-[:alnum:]+_:]+\\)" 1)
;;Variables
- ("Variables" "^[ \t]*\\(?:anon\\|argument\\|has\\|local\\|my\\|our\\|state\\|supersede\\)\\s-+\\([$@%][-[:alnum:]+_:]+\\)\\s-*=" 1)
+ ("Variables" "^[ \t]*\\(?:has\\|local\\|my\\|our\\|state\\)\\s-+\\([$@%][-[:alnum:]+_:]+\\)\\s-*=" 1)
("Packages" "^[ \t]*package\\s-+\\([-[:alnum:]+_:]+\\);" 1)
("Doc sections" "^=head[0-9][ \t]+\\(.*\\)" 1))
"Imenu generic expression for Perl mode. See `imenu-generic-expression'.")
@@ -188,9 +188,8 @@
"\\>")
;;
;; Fontify declarators and prefixes as types.
- ("\\<\\(anon\\|argument\\|has\\|local\\|my\\|our\\|state\\|supersede\\)\\>" . font-lock-type-face) ; declarators
- ("\\<\\(let\\|temp\\)\\>" . font-lock-type-face) ; prefixes
- ;;
+ ("\\<\\(has\\|local\\|my\\|our\\|state\\)\\>" . font-lock-type-face) ; declarators
+ ;;
;; Fontify function, variable and file name references.
("&\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-function-name-face)
;; Additionally fontify non-scalar variables. `perl-non-scalar-variable'
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 18124227d1b..fc5e30111e5 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -1,8 +1,8 @@
;;; project.el --- Operations on the current project -*- lexical-binding: t; -*-
;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
-;; Version: 0.5.3
-;; Package-Requires: ((emacs "26.3") (xref "1.0.2"))
+;; Version: 0.5.4
+;; Package-Requires: ((emacs "26.1") (xref "1.0.2"))
;; This is a GNU ELPA :core package. Avoid using functionality that
;; not compatible with the version of Emacs recorded above.
@@ -928,16 +928,16 @@ if one already exists."
;;;###autoload
(defun project-async-shell-command ()
"Run `async-shell-command' in the current project's root directory."
- (interactive)
(declare (interactive-only async-shell-command))
+ (interactive)
(let ((default-directory (project-root (project-current t))))
(call-interactively #'async-shell-command)))
;;;###autoload
(defun project-shell-command ()
"Run `shell-command' in the current project's root directory."
- (interactive)
(declare (interactive-only shell-command))
+ (interactive)
(let ((default-directory (project-root (project-current t))))
(call-interactively #'shell-command)))
@@ -974,8 +974,8 @@ loop using the command \\[fileloop-continue]."
;;;###autoload
(defun project-compile ()
"Run `compile' in the project root."
- (interactive)
(declare (interactive-only compile))
+ (interactive)
(let ((default-directory (project-root (project-current t))))
(call-interactively #'compile)))
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index a417de32640..f588ad99c9d 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:]:]\\)"
@@ -1556,7 +1555,7 @@ with your script for an edit-interpret-debug cycle."
(sh-set-shell
(cond ((save-excursion
(goto-char (point-min))
- (looking-at "#![ \t]?\\([^ \t\n]*/bin/env[ \t]\\)?\\([^ \t\n]+\\)"))
+ (looking-at auto-mode-interpreter-regexp))
(match-string 2))
((not buffer-file-name) sh-shell-file)
;; Checks that use `buffer-file-name' follow.
@@ -1957,12 +1956,18 @@ May return nil if the line should not be treated as continued."
('(:after . "case-)") (- (sh-var-value 'sh-indent-for-case-alt)
(sh-var-value 'sh-indent-for-case-label)))
(`(:before . ,(or "(" "{" "[" "while" "if" "for" "case"))
- (if (not (smie-rule-prev-p "&&" "||" "|"))
- (when (smie-rule-hanging-p)
- (smie-rule-parent))
+ (cond
+ ((and (equal token "{") (smie-rule-parent-p "for"))
+ (let ((data (smie-backward-sexp "in")))
+ (when (equal (nth 2 data) "for")
+ `(column . ,(smie-indent-virtual)))))
+ ((not (smie-rule-prev-p "&&" "||" "|"))
+ (when (smie-rule-hanging-p)
+ (smie-rule-parent)))
+ (t
(unless (smie-rule-bolp)
(while (equal "|" (nth 2 (smie-backward-sexp 'halfexp))))
- `(column . ,(smie-indent-virtual)))))
+ `(column . ,(smie-indent-virtual))))))
;; FIXME: Maybe this handling of ;; should be made into
;; a smie-rule-terminator function that takes the substitute ";" as arg.
(`(:before . ,(or ";;" ";&" ";;&"))
@@ -2927,8 +2932,8 @@ option followed by a colon `:' if the option accepts an argument."
(put 'sh-assignment 'delete-selection t)
(defun sh-assignment (arg)
"Remember preceding identifier for future completion and do self-insert."
- (interactive "p")
(declare (obsolete nil "27.1"))
+ (interactive "p")
(self-insert-command arg)
(sh--assignment-collect))
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index aecb30a0ad4..18fdd963fb1 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -2,7 +2,7 @@
;; Copyright (C) 2014-2021 Free Software Foundation, Inc.
;; Version: 1.0.4
-;; Package-Requires: ((emacs "26.3"))
+;; Package-Requires: ((emacs "26.1"))
;; This is a GNU ELPA :core package. Avoid functionality that is not
;; compatible with the version of Emacs recorded above.
@@ -967,16 +967,16 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)."
(let ((inhibit-read-only t)
(buffer-undo-list t))
(save-excursion
- (erase-buffer)
(condition-case err
- (xref--insert-xrefs
- (xref--analyze (funcall xref--fetcher)))
+ (let ((alist (xref--analyze (funcall xref--fetcher))))
+ (erase-buffer)
+ (xref--insert-xrefs alist))
(user-error
+ (erase-buffer)
(insert
(propertize
(error-message-string err)
- 'face 'error))))
- (goto-char (point-min)))))
+ 'face 'error)))))))
(defun xref-show-definitions-buffer (fetcher alist)
"Show the definitions list in a regular window.
diff --git a/lisp/recentf.el b/lisp/recentf.el
index a28a3977a76..d39a523289f 100644
--- a/lisp/recentf.el
+++ b/lisp/recentf.el
@@ -1352,7 +1352,14 @@ That is, remove duplicates, non-kept, and excluded files."
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."
+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)"
:global t
:group 'recentf
:keymap recentf-mode-map
diff --git a/lisp/replace.el b/lisp/replace.el
index db5b340631a..f13d27aff89 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -186,6 +186,21 @@ See `replace-regexp' and `query-replace-regexp-eval'.")
length)
length)))))
+(defun query-replace-read-from-suggestions ()
+ "Return a list of standard suggestions for `query-replace-read-from'.
+By default, the list includes the active region, the identifier
+(a.k.a. \"tag\") at point (see Info node `(emacs) Identifier Search'),
+the last isearch string, and the last replacement regexp.
+`query-replace-read-from' appends the list returned
+by this function to the end of values available via
+\\<minibuffer-local-map>\\[next-history-element]."
+ (delq nil (list (when (use-region-p)
+ (buffer-substring-no-properties
+ (region-beginning) (region-end)))
+ (find-tag-default)
+ (car search-ring)
+ (car (symbol-value query-replace-from-history-variable)))))
+
(defun query-replace-read-from (prompt regexp-flag)
"Query and return the `from' argument of a query-replace operation.
Prompt with PROMPT. REGEXP-FLAG non-nil means the response should be a regexp.
@@ -242,7 +257,8 @@ wants to replace FROM with TO."
(if regexp-flag
(read-regexp prompt nil 'minibuffer-history)
(read-from-minibuffer
- prompt nil nil nil nil (car search-ring) t)))))
+ prompt nil nil nil nil
+ (query-replace-read-from-suggestions) t)))))
(to))
(if (and (zerop (length from)) query-replace-defaults)
(cons (caar query-replace-defaults)
@@ -327,14 +343,15 @@ Prompt with PROMPT. REGEXP-FLAG non-nil means the response should a regexp."
(defun query-replace-read-args (prompt regexp-flag &optional noerror)
(unless noerror
(barf-if-buffer-read-only))
- (let* ((from (query-replace-read-from prompt regexp-flag))
- (to (if (consp from) (prog1 (cdr from) (setq from (car from)))
- (query-replace-read-to from prompt regexp-flag))))
- (list from to
- (or (and current-prefix-arg (not (eq current-prefix-arg '-)))
- (and (plist-member (text-properties-at 0 from) 'isearch-regexp-function)
- (get-text-property 0 'isearch-regexp-function from)))
- (and current-prefix-arg (eq current-prefix-arg '-)))))
+ (save-mark-and-excursion
+ (let* ((from (query-replace-read-from prompt regexp-flag))
+ (to (if (consp from) (prog1 (cdr from) (setq from (car from)))
+ (query-replace-read-to from prompt regexp-flag))))
+ (list from to
+ (or (and current-prefix-arg (not (eq current-prefix-arg '-)))
+ (and (plist-member (text-properties-at 0 from) 'isearch-regexp-function)
+ (get-text-property 0 'isearch-regexp-function from)))
+ (and current-prefix-arg (eq current-prefix-arg '-))))))
(defun query-replace (from-string to-string &optional delimited start end backward region-noncontiguous-p)
"Replace some occurrences of FROM-STRING with TO-STRING.
@@ -808,11 +825,16 @@ the function that you set this to can check `this-command'."
(defun read-regexp-suggestions ()
"Return a list of standard suggestions for `read-regexp'.
-By default, the list includes the tag at point, the last isearch regexp,
-the last isearch string, and the last replacement regexp. `read-regexp'
-appends the list returned by this function to the end of values available
-via \\<minibuffer-local-map>\\[next-history-element]."
+By default, the list includes the active region, the identifier
+(a.k.a. \"tag\") at point (see Info node `(emacs) Identifier Search'),
+the last isearch regexp, the last isearch string, and the last
+replacement regexp. `read-regexp' appends the list returned
+by this function to the end of values available via
+\\<minibuffer-local-map>\\[next-history-element]."
(list
+ (when (use-region-p)
+ (buffer-substring-no-properties
+ (region-beginning) (region-end)))
(find-tag-default-as-regexp)
(find-tag-default-as-symbol-regexp)
(car regexp-search-ring)
@@ -825,31 +847,35 @@ Prompt with the string PROMPT. If PROMPT ends in \":\" (followed by
optional whitespace), use it as-is. Otherwise, add \": \" to the end,
possibly preceded by the default result (see below).
-The optional argument DEFAULTS can be either: nil, a string, a list
-of strings, or a symbol. We use DEFAULTS to construct the default
-return value in case of empty input.
+The optional argument DEFAULTS is used to construct the default
+return value in case of empty input. DEFAULTS can be nil, a string,
+a list of strings, or a symbol.
-If DEFAULTS is a string, we use it as-is.
+If DEFAULTS is a string, the function uses it as-is.
If DEFAULTS is a list of strings, the first element is the
default return value, but all the elements are accessible
using the history command \\<minibuffer-local-map>\\[next-history-element].
-If DEFAULTS is a non-nil symbol, then if `read-regexp-defaults-function'
-is non-nil, we use that in place of DEFAULTS in the following:
- If DEFAULTS is the symbol `regexp-history-last', we use the first
- element of HISTORY (if specified) or `regexp-history'.
- If DEFAULTS is a function, we call it with no arguments and use
- what it returns, which should be either nil, a string, or a list of strings.
+If DEFAULTS is the symbol `regexp-history-last', the default return
+value will be the first element of HISTORY. If HISTORY is omitted or
+nil, `regexp-history' is used instead.
+If DEFAULTS is a symbol with a function definition, it is called with
+no arguments and should return either nil, a string, or a list of
+strings, which will be used as above.
+Other symbol values for DEFAULTS are ignored.
+
+If `read-regexp-defaults-function' is non-nil, its value is used
+instead of DEFAULTS in the two cases described in the last paragraph.
-We append the standard values from `read-regexp-suggestions' to DEFAULTS
-before using it.
+Before using whatever value DEFAULTS yields, the function appends the
+standard values from `read-regexp-suggestions' to that value.
If the first element of DEFAULTS is non-nil (and if PROMPT does not end
-in \":\", followed by optional whitespace), we add it to the prompt.
+in \":\", followed by optional whitespace), DEFAULT is added to the prompt.
The optional argument HISTORY is a symbol to use for the history list.
-If nil, uses `regexp-history'."
+If nil, use `regexp-history'."
(let* ((defaults
(if (and defaults (symbolp defaults))
(cond
diff --git a/lisp/simple.el b/lisp/simple.el
index 37c0885dcc5..e4a363a9a59 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
@@ -820,9 +816,10 @@ With ARG, perform this action that many times."
(delete-horizontal-space t)
(unless arg
(setq arg 1))
- (dotimes (_ arg)
- (newline nil t)
- (indent-according-to-mode)))
+ (let ((electric-indent-mode nil))
+ (dotimes (_ arg)
+ (newline nil t)
+ (indent-according-to-mode))))
(defun reindent-then-newline-and-indent ()
"Reindent current line, insert newline, then indent the new line.
@@ -832,7 +829,8 @@ In programming language modes, this is the same as TAB.
In some text modes, where TAB inserts a tab, this indents to the
column specified by the function `current-left-margin'."
(interactive "*")
- (let ((pos (point)))
+ (let ((pos (point))
+ (electric-indent-mode nil))
;; Be careful to insert the newline before indenting the line.
;; Otherwise, the indentation might be wrong.
(newline)
@@ -1266,9 +1264,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."
@@ -2307,14 +2304,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
@@ -2470,11 +2465,24 @@ previous element of the minibuffer history in the minibuffer."
(save-excursion
(goto-char (1- prompt-end))
(current-column)))
- 0)
+ 1)
(current-column)))))
(condition-case nil
(with-no-warnings
- (previous-line arg))
+ (previous-line arg)
+ ;; Avoid moving point to the prompt
+ (when (< (point) (minibuffer-prompt-end))
+ ;; If there is minibuffer contents on the same line
+ (if (<= (minibuffer-prompt-end)
+ (save-excursion
+ (if (or truncate-lines (not line-move-visual))
+ (end-of-line)
+ (end-of-visual-line))
+ (point)))
+ ;; Move to the beginning of minibuffer contents
+ (goto-char (minibuffer-prompt-end))
+ ;; Otherwise, go to the previous history element
+ (signal 'beginning-of-buffer nil))))
(beginning-of-buffer
;; Restore old position since `line-move-visual' moves point to
;; the beginning of the line when it fails to go to the previous line.
@@ -3465,13 +3473,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
@@ -3976,6 +3983,9 @@ impose the use of a shell (with its need to quote arguments)."
(start-process-shell-command "Shell" buffer command)))
(setq mode-line-process '(":%s"))
(shell-mode)
+ (setq-local revert-buffer-function
+ (lambda (&rest _)
+ (async-shell-command command buffer)))
(set-process-sentinel proc #'shell-command-sentinel)
;; Use the comint filter for proper handling of
;; carriage motion (see comint-inhibit-carriage-motion).
@@ -4242,6 +4252,9 @@ characters."
buffer))))
;; Report the output.
(with-current-buffer buffer
+ (setq-local revert-buffer-function
+ (lambda (&rest _)
+ (shell-command command)))
(setq mode-line-process
(cond ((null exit-status)
" - Error")
@@ -7338,10 +7351,7 @@ even beep.)"
;; of the kill before killing.
(let ((opoint (point))
(kill-whole-line (and kill-whole-line (bolp)))
- (orig-y (cdr (nth 2 (posn-at-point))))
- ;; FIXME: This tolerance should be zero! It isn't due to a
- ;; bug in posn-at-point, see bug#45837.
- (tol (/ (line-pixel-height) 2)))
+ (orig-vlnum (cdr (nth 6 (posn-at-point)))))
(if arg
(vertical-motion (prefix-numeric-value arg))
(end-of-visual-line 1)
@@ -7352,8 +7362,8 @@ even beep.)"
;; end-of-visual-line didn't overshoot due to complications
;; like display or overlay strings, intangible text, etc.:
;; otherwise, we don't want to kill a character that's
- ;; unrelated to the place where the visual line wrapped.
- (and (< (abs (- (cdr (nth 2 (posn-at-point))) orig-y)) tol)
+ ;; unrelated to the place where the visual line wraps.
+ (and (= (cdr (nth 6 (posn-at-point))) orig-vlnum)
;; Make sure we delete the character where the line wraps
;; under visual-line-mode, be it whitespace or a
;; character whose category set allows to wrap at it.
diff --git a/lisp/startup.el b/lisp/startup.el
index c508af7bb26..402d8a87b00 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -320,6 +320,8 @@ early init file.")
This variable is used to define the proper function and keypad
keys for use under X. It is used in a fashion analogous to the
environment variable TERM.")
+(make-obsolete-variable 'keyboard-type nil "28.1")
+(internal-make-var-non-special 'keyboard-type)
(defvar window-setup-hook nil
"Normal hook run after loading init files and handling the command line.
diff --git a/lisp/subr.el b/lisp/subr.el
index f249ec3578c..a85f41d7d77 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1701,6 +1701,7 @@ be a list of the form returned by `event-start' and `event-end'."
(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")
@@ -2965,8 +2966,6 @@ Also discard all previous input in the minibuffer."
(minibuffer-message "Wrong answer")
(sit-for 2)))
-(defvar empty-history)
-
(defun read-char-from-minibuffer (prompt &optional chars history)
"Read a character from the minibuffer, prompting for it with PROMPT.
Like `read-char', but uses the minibuffer to read and return a character.
@@ -2981,6 +2980,7 @@ while calling this function, then pressing `help-char'
causes it to evaluate `help-form' and display the result.
There is no need to explicitly add `help-char' to CHARS;
`help-char' is bound automatically to `help-form-show'."
+ (defvar empty-history)
(let* ((empty-history '())
(map (if (consp chars)
(or (gethash (list help-form (cons help-char chars))
@@ -3093,8 +3093,6 @@ Also discard all previous input in the minibuffer."
"Prefer `read-key' when answering a \"y or n\" question by `y-or-n-p'.
Otherwise, use the minibuffer.")
-(defvar empty-history)
-
(defun y-or-n-p (prompt)
"Ask user a \"y or n\" question.
Return t if answer is \"y\" and nil if it is \"n\".
@@ -3190,6 +3188,7 @@ is nil and `use-dialog-box' is non-nil."
(discard-input)))
(t
(setq prompt (funcall padded prompt))
+ (defvar empty-history)
(let* ((empty-history '())
(enable-recursive-minibuffers t)
(msg help-form)
@@ -4923,7 +4922,9 @@ file, FORM is evaluated immediately after the provide statement.
Usually FILE is just a library name like \"font-lock\" or a feature name
like `font-lock'.
-This function makes or adds to an entry on `after-load-alist'."
+This function makes or adds to an entry on `after-load-alist'.
+
+See also `with-eval-after-load'."
(declare (compiler-macro
(lambda (whole)
(if (eq 'quote (car-safe form))
diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el
index 7e556550daa..6720d82b471 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 2726947a4c2..9209f2d46ec 100644
--- a/lisp/tab-line.el
+++ b/lisp/tab-line.el
@@ -651,7 +651,9 @@ corresponding to the switched buffer."
(if (functionp tab-line-new-tab-choice)
(funcall tab-line-new-tab-choice)
(let ((tab-line-tabs-buffer-groups mouse-buffer-menu-mode-groups))
- (if (and (listp mouse-event) window-system) ; (display-popup-menus-p)
+ (if (and (listp mouse-event)
+ (display-popup-menus-p)
+ (not tty-menu-open-use-tmm))
(mouse-buffer-menu mouse-event) ; like (buffer-menu-open)
;; tty menu doesn't support mouse clicks, so use tmm
(tmm-prompt (mouse-buffer-menu-keymap))))))
diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el
index 5f4dd9ef587..af1e388c2a3 100644
--- a/lisp/term/ns-win.el
+++ b/lisp/term/ns-win.el
@@ -120,6 +120,15 @@ The properties returned may include `top', `left', `height', and `width'."
(define-key global-map [?\s-d] 'isearch-repeat-backward)
(define-key global-map [?\s-e] 'isearch-yank-kill)
(define-key global-map [?\s-f] 'isearch-forward)
+(define-key esc-map [?\s-f] 'isearch-forward-regexp)
+(define-key minibuffer-local-isearch-map [?\s-f]
+ 'isearch-forward-exit-minibuffer)
+(define-key isearch-mode-map [?\s-f] 'isearch-repeat-forward)
+(define-key global-map [?\s-F] 'isearch-backward)
+(define-key esc-map [?\s-F] 'isearch-backward-regexp)
+(define-key minibuffer-local-isearch-map [?\s-F]
+ 'isearch-reverse-exit-minibuffer)
+(define-key isearch-mode-map [?\s-F] 'isearch-repeat-backward)
(define-key global-map [?\s-g] 'isearch-repeat-forward)
(define-key global-map [?\s-h] 'ns-do-hide-emacs)
(define-key global-map [?\s-H] 'ns-do-hide-others)
@@ -365,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/term/w32console.el b/lisp/term/w32console.el
index 8859f13bd20..4a925cd84c3 100644
--- a/lisp/term/w32console.el
+++ b/lisp/term/w32console.el
@@ -1,4 +1,4 @@
-;;; w32console.el -- Setup w32 console keys and colors.
+;;; w32console.el -- Setup w32 console keys and colors. -*- lexical-binding: t; -*-
;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el
index 50c00c95320..e66adb43e75 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/css-mode.el b/lisp/textmodes/css-mode.el
index 9186e520086..622853da456 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/enriched.el b/lisp/textmodes/enriched.el
index 1aac96413e4..bac209cdef6 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
diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el
index d8503168846..83dba7177ab 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 8d49a7c54c8..ea46270508e 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 9cacc175ba9..24ccb3ce980 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 896578513cf..fe70e925b05 100644
--- a/lisp/textmodes/nroff-mode.el
+++ b/lisp/textmodes/nroff-mode.el
@@ -1,4 +1,4 @@
-;;; nroff-mode.el --- GNU Emacs major mode for editing nroff source
+;;; nroff-mode.el --- GNU Emacs major mode for editing nroff source -*- lexical-binding: t -*-
;; Copyright (C) 1985-1986, 1994-1995, 1997, 2001-2021 Free Software
;; Foundation, Inc.
@@ -43,7 +43,6 @@
(defcustom nroff-electric-mode nil
"Non-nil means automatically closing requests when you insert an open."
- :group 'nroff
:type 'boolean)
(defvar nroff-mode-map
@@ -111,7 +110,7 @@
;; arguments in common cases, like \f.
(concat "\\\\" ; backslash
"\\(" ; followed by various possibilities
- (mapconcat 'identity
+ (mapconcat #'identity
'("[f*n]*\\[.+?]" ; some groff extensions
"(.." ; two chars after (
"[^(\"#]" ; single char escape
@@ -119,13 +118,11 @@
"\\)")
)
"Font-lock highlighting control in `nroff-mode'."
- :group 'nroff
:type '(repeat regexp))
(defcustom nroff-mode-hook nil
"Hook run by function `nroff-mode'."
- :type 'hook
- :group 'nroff)
+ :type 'hook)
;;;###autoload
(define-derived-mode nroff-mode text-mode "Nroff"
diff --git a/lisp/textmodes/refill.el b/lisp/textmodes/refill.el
index 6edd9aeb7ef..8f4f3c5a231 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/remember.el b/lisp/textmodes/remember.el
index 98d3a3856ea..820ee38d101 100644
--- a/lisp/textmodes/remember.el
+++ b/lisp/textmodes/remember.el
@@ -159,7 +159,8 @@
;; ;; This should be before other entries that may return t
;; (add-to-list 'remember-handler-functions 'remember-diary-extract-entries)
;;
-;; This module recognizes entries of the form
+;; This module recognizes entries of the form (defined by
+;; `remember-diary-regexp')
;;
;; DIARY: ....
;;
@@ -410,13 +411,24 @@ The default emulates `current-time-string' for backward compatibility."
:group 'remember
:version "27.1")
+(defcustom remember-text-format-function nil
+ "The function to format the remembered text.
+The function receives the remembered text as argument and should
+return the text to be remembered."
+ :type '(choice (const nil) function)
+ :group 'remember
+ :version "28.1")
+
(defun remember-append-to-file ()
"Remember, with description DESC, the given TEXT."
(let* ((text (buffer-string))
(desc (remember-buffer-desc))
- (remember-text (concat "\n" remember-leader-text
- (format-time-string remember-time-format)
- " (" desc ")\n\n" text
+ (remember-text (concat "\n"
+ (if remember-text-format-function
+ (funcall remember-text-format-function text)
+ (concat remember-leader-text
+ (format-time-string remember-time-format)
+ " (" desc ")\n\n" text))
(save-excursion (goto-char (point-max))
(if (bolp) nil "\n"))))
(buf (find-buffer-visiting remember-data-file)))
@@ -532,17 +544,28 @@ If this is nil, then `diary-file' will be used instead."
(autoload 'diary-make-entry "diary-lib")
+(defcustom remember-diary-regexp "^DIARY:\\s-*\\(.+\\)"
+ "Regexp to extract diary entries."
+ :type 'regexp
+ :version "28.1")
+
+(defvar diary-file)
+
;;;###autoload
(defun remember-diary-extract-entries ()
- "Extract diary entries from the region."
+ "Extract diary entries from the region based on `remember-diary-regexp'."
(save-excursion
(goto-char (point-min))
(let (list)
- (while (re-search-forward "^DIARY:\\s-*\\(.+\\)" nil t)
+ (while (re-search-forward remember-diary-regexp nil t)
(push (remember-diary-convert-entry (match-string 1)) list))
(when list
(diary-make-entry (mapconcat 'identity list "\n")
- nil remember-diary-file))
+ nil remember-diary-file)
+ (when remember-save-after-remembering
+ (with-current-buffer (find-buffer-visiting (or remember-diary-file
+ diary-file))
+ (save-buffer))))
nil))) ;; Continue processing
;;; Internal Functions:
diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el
index 8465e82b02a..3e29f055ece 100644
--- a/lisp/textmodes/sgml-mode.el
+++ b/lisp/textmodes/sgml-mode.el
@@ -2290,19 +2290,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))
@@ -2402,9 +2400,9 @@ To work around that, do:
(setq-local sgml-empty-tags
;; From HTML-4.01's loose.dtd, parsed with
- ;; `sgml-parse-dtd', plus manual addition of "wbr".
+ ;; `sgml-parse-dtd', plus manual additions of "source" and "wbr".
'("area" "base" "basefont" "br" "col" "frame" "hr" "img" "input"
- "isindex" "link" "meta" "param" "wbr"))
+ "isindex" "link" "meta" "source" "param" "wbr"))
(setq-local sgml-unclosed-tags
;; From HTML-4.01's loose.dtd, parsed with `sgml-parse-dtd'.
'("body" "colgroup" "dd" "dt" "head" "html" "li" "option"
diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el
index 071684d3c4d..06785e458b2 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 c4e4864da17..d5a79ad0ac5 100644
--- a/lisp/textmodes/tex-mode.el
+++ b/lisp/textmodes/tex-mode.el
@@ -1169,7 +1169,12 @@ subshell is initiated, `tex-shell-hook' is run."
(setq-local outline-regexp latex-outline-regexp)
(setq-local outline-level #'latex-outline-level)
(setq-local forward-sexp-function #'latex-forward-sexp)
- (setq-local skeleton-end-hook nil))
+ (setq-local skeleton-end-hook nil)
+ (setq-local comment-region-function #'latex--comment-region)
+ (setq-local comment-style 'plain))
+
+(defun latex--comment-region (beg end &optional arg)
+ (comment-region-default-1 beg end arg t))
;;;###autoload
(define-derived-mode slitex-mode latex-mode "SliTeX"
@@ -2039,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/two-column.el b/lisp/textmodes/two-column.el
index 36aad84c0e6..d072ab16c3c 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/thingatpt.el b/lisp/thingatpt.el
index d3ba941fcc2..c52fcfcc051 100644
--- a/lisp/thingatpt.el
+++ b/lisp/thingatpt.el
@@ -52,8 +52,30 @@
;;; Code:
+(require 'cl-lib)
(provide 'thingatpt)
+(defvar thing-at-point-provider-alist nil
+ "Alist of providers for returning a \"thing\" at point.
+This variable can be set globally, or appended to buffer-locally
+by modes, to provide functions that will return a \"thing\" at
+point. The first provider for the \"thing\" that returns a
+non-nil value wins.
+
+For instance, a major mode could say:
+
+\(setq-local thing-at-point-provider-alist
+ (append thing-at-point-provider-alist
+ \\='((url . my-mode--url-at-point))))
+
+to provide a way to get an `url' at point in that mode. The
+provider functions are called with no parameters at the point in
+question.
+
+\"things\" include `symbol', `list', `sexp', `defun', `filename',
+`url', `email', `uuid', `word', `sentence', `whitespace', `line',
+and `page'.")
+
;; Basic movement
;;;###autoload
@@ -143,11 +165,18 @@ strip text properties from the return value.
See the file `thingatpt.el' for documentation on how to define
a symbol as a valid THING."
(let ((text
- (if (get thing 'thing-at-point)
- (funcall (get thing 'thing-at-point))
+ (cond
+ ((cl-loop for (pthing . function) in thing-at-point-provider-alist
+ when (eq pthing thing)
+ for result = (funcall function)
+ when result
+ return result))
+ ((get thing 'thing-at-point)
+ (funcall (get thing 'thing-at-point)))
+ (t
(let ((bounds (bounds-of-thing-at-point thing)))
(when bounds
- (buffer-substring (car bounds) (cdr bounds)))))))
+ (buffer-substring (car bounds) (cdr bounds))))))))
(when (and text no-properties (sequencep text))
(set-text-properties 0 (length text) nil text))
text))
@@ -218,6 +247,15 @@ The bounds of THING are determined by `bounds-of-thing-at-point'."
(put 'sexp 'beginning-op 'thing-at-point--beginning-of-sexp)
+;; Symbols
+
+(put 'symbol 'beginning-op 'thing-at-point--beginning-of-symbol)
+
+(defun thing-at-point--beginning-of-symbol ()
+ "Move point to the beginning of the current symbol."
+ (and (re-search-backward "\\(\\sw\\|\\s_\\)+")
+ (skip-syntax-backward "w_")))
+
;; Lists
(put 'list 'bounds-of-thing-at-point 'thing-at-point-bounds-of-list-at-point)
diff --git a/lisp/tmm.el b/lisp/tmm.el
index e49246a5c4f..2040f522700 100644
--- a/lisp/tmm.el
+++ b/lisp/tmm.el
@@ -56,12 +56,14 @@ to invoke `tmm-menubar' instead, customize the variable
`tty-menu-open-use-tmm' to a non-nil value."
(interactive)
(run-hooks 'menu-bar-update-hook)
- (let ((menu-bar (menu-bar-keymap))
- (menu-bar-item-cons (and x-position
- (menu-bar-item-at-x x-position))))
- (tmm-prompt menu-bar
- nil
- (and menu-bar-item-cons (car menu-bar-item-cons)))))
+ (if isearch-mode
+ (isearch-tmm-menubar)
+ (let ((menu-bar (menu-bar-keymap))
+ (menu-bar-item-cons (and x-position
+ (menu-bar-item-at-x x-position))))
+ (tmm-prompt menu-bar
+ nil
+ (and menu-bar-item-cons (car menu-bar-item-cons))))))
;;;###autoload
(defun tmm-menubar-mouse (event)
diff --git a/lisp/type-break.el b/lisp/type-break.el
index 84c240c9f8c..a6d5cd01702 100644
--- a/lisp/type-break.el
+++ b/lisp/type-break.el
@@ -487,7 +487,7 @@ Return nil if the file is missing or if the time is not a Lisp time value."
(goto-char (point-min))
(read (current-buffer)))
(end-of-file
- (error "End of file in `%s'" file))))))))
+ (warn "End of file in `%s'" file))))))))
(defun type-break-get-previous-count ()
"Get previous keystroke count from `type-break-file-name'.
@@ -505,7 +505,7 @@ integer."
(forward-line 1)
(read (current-buffer)))
(end-of-file
- (error "End of file in `%s'" file)))))))
+ (warn "End of file in `%s'" file)))))))
file
0)))
diff --git a/lisp/url/url-about.el b/lisp/url/url-about.el
index bff5570f6df..6ae90ccefad 100644
--- a/lisp/url/url-about.el
+++ b/lisp/url/url-about.el
@@ -1,4 +1,4 @@
-;;; url-about.el --- Show internal URLs
+;;; url-about.el --- Show internal URLs -*- lexical-binding: t; -*-
;; Copyright (C) 2001, 2004-2021 Free Software Foundation, Inc.
@@ -44,7 +44,7 @@
(defvar url-scheme-registry)
-(defun url-about-protocols (url)
+(defun url-about-protocols (_url)
(url-probe-protocols)
(insert "<html>\n"
" <head>\n"
@@ -73,13 +73,15 @@
"ynchronous<br>\n"
(if (url-scheme-get-property k 'default-port)
(format "Default Port: %d<br>\n"
- (url-scheme-get-property k 'default-port)) "")
+ (url-scheme-get-property k 'default-port))
+ "")
(if (assoc k url-proxy-services)
(format "Proxy: %s<br>\n" (assoc k url-proxy-services)) ""))
;; Now the description...
(insert " <td valign=top>"
(or (url-scheme-get-property k 'description) "N/A"))))
- (sort (let (x) (maphash (lambda (k v) (push k x)) url-scheme-registry) x) 'string-lessp))
+ (sort (let (x) (maphash (lambda (k _v) (push k x)) url-scheme-registry) x)
+ #'string-lessp))
(insert " </table>\n"
" </body>\n"
"</html>\n"))
diff --git a/lisp/url/url-cache.el b/lisp/url/url-cache.el
index acf88eb0212..830e6ba9dcc 100644
--- a/lisp/url/url-cache.el
+++ b/lisp/url/url-cache.el
@@ -1,4 +1,4 @@
-;;; url-cache.el --- Uniform Resource Locator retrieval tool
+;;; url-cache.el --- Uniform Resource Locator retrieval tool -*- lexical-binding: t; -*-
;; Copyright (C) 1996-1999, 2004-2021 Free Software Foundation, Inc.
diff --git a/lisp/url/url-cid.el b/lisp/url/url-cid.el
index d465cabc90c..0ca2d8a0737 100644
--- a/lisp/url/url-cid.el
+++ b/lisp/url/url-cid.el
@@ -1,4 +1,4 @@
-;;; url-cid.el --- Content-ID URL loader
+;;; url-cid.el --- Content-ID URL loader -*- lexical-binding: t; -*-
;; Copyright (C) 1998-1999, 2004-2021 Free Software Foundation, Inc.
diff --git a/lisp/url/url-dav.el b/lisp/url/url-dav.el
index 12d5a683e97..edb1c1de9fc 100644
--- a/lisp/url/url-dav.el
+++ b/lisp/url/url-dav.el
@@ -1,4 +1,4 @@
-;;; url-dav.el --- WebDAV support
+;;; url-dav.el --- WebDAV support -*- lexical-binding: t; -*-
;; Copyright (C) 2001, 2004-2021 Free Software Foundation, Inc.
@@ -133,7 +133,8 @@ Returns nil if WebDAV is not supported."
(node-type nil)
(props nil)
(value nil)
- (handler-func nil))
+ ;; (handler-func nil)
+ )
(when (not children)
(error "No child nodes in DAV:prop"))
@@ -453,7 +454,7 @@ FAILURE-RESULTS is a list of (URL STATUS)."
" </DAV:owner>\n"))
(response nil) ; Responses to the LOCK request
(result nil) ; For walking thru the response list
- (child-url nil)
+ ;; (child-url nil)
(child-status nil)
(failures nil) ; List of failure cases (URL . STATUS)
(successes nil)) ; List of success cases (URL . STATUS)
@@ -468,7 +469,7 @@ FAILURE-RESULTS is a list of (URL STATUS)."
;; status code.
(while response
(setq result (pop response)
- child-url (url-expand-file-name (pop result) url)
+ ;; child-url (url-expand-file-name (pop result) url)
child-status (or (plist-get result 'DAV:status) 500))
(if (url-dav-http-success-p child-status)
(push (list url child-status "huh") successes)
@@ -478,7 +479,7 @@ FAILURE-RESULTS is a list of (URL STATUS)."
(defun url-dav-active-locks (url &optional depth)
"Return an assoc list of all active locks on URL."
(let ((response (url-dav-get-properties url '(DAV:lockdiscovery) depth))
- (properties nil)
+ ;; (properties nil)
(child nil)
(child-url nil)
(child-results nil)
@@ -676,7 +677,6 @@ Use with care, and even then think three times."
If optional second argument RECURSIVE is non-nil, then delete all
files in the collection as well."
(let ((status nil)
- (props nil)
(props nil))
(setq props (url-dav-delete-something
url lock-token
@@ -769,7 +769,7 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
(when (member 'DAV:collection (plist-get properties 'DAV:resourcetype))
t)))
-(defun url-dav-make-directory (url &optional parents)
+(defun url-dav-make-directory (url &optional _parents)
"Create the directory DIR and any nonexistent parent dirs."
(let* ((url-request-extra-headers nil)
(url-request-method "MKCOL")
@@ -849,7 +849,9 @@ that start with FILE.
If there is only one and FILE matches it exactly, returns t.
Returns nil if URL contains no name starting with FILE."
(let ((matches (url-dav-file-name-all-completions file url))
- (result nil))
+ ;; (result nil)
+ )
+ ;; FIXME: Use `try-completion'!
(cond
((null matches)
;; No matches
diff --git a/lisp/url/url-expand.el b/lisp/url/url-expand.el
index a42b4c7ad23..05088e3cac8 100644
--- a/lisp/url/url-expand.el
+++ b/lisp/url/url-expand.el
@@ -66,7 +66,7 @@ path components followed by `..' are removed, along with the `..' itself."
;; Need to nuke newlines and spaces in the URL, or we open
;; ourselves up to potential security holes.
(setq url (mapconcat (lambda (x)
- (if (memq x '(? ?\n ?\r))
+ (if (memq x '(?\s ?\n ?\r))
""
(char-to-string x)))
url "")))
diff --git a/lisp/url/url-file.el b/lisp/url/url-file.el
index 52a9588030e..0e2ab5544b9 100644
--- a/lisp/url/url-file.el
+++ b/lisp/url/url-file.el
@@ -154,7 +154,7 @@ to them."
;; not the compressed one.
;; FIXME should this regexp not include more extensions; basically
;; everything that url-file-find-possibly-compressed-file does?
- (setq uncompressed-filename (if (string-match "\\.\\(gz\\|Z\\|z\\)$" filename)
+ (setq uncompressed-filename (if (string-match "\\.\\(gz\\|Z\\|z\\)\\'" filename)
(substring filename 0 (match-beginning 0))
filename))
(setq content-type (mailcap-extension-to-mime
diff --git a/lisp/url/url-gw.el b/lisp/url/url-gw.el
index 68df67f6486..d2bf843fc36 100644
--- a/lisp/url/url-gw.el
+++ b/lisp/url/url-gw.el
@@ -1,4 +1,4 @@
-;;; url-gw.el --- Gateway munging for URL loading
+;;; url-gw.el --- Gateway munging for URL loading -*- lexical-binding: t; -*-
;; Copyright (C) 1997-1998, 2004-2021 Free Software Foundation, Inc.
@@ -222,18 +222,17 @@ overriding the value of `url-gateway-method'."
host))
'native
gwm))
- ;; An attempt to deal with denied connections, and attempt
- ;; to reconnect
- (cur-retries 0)
- (retry t)
- (errobj nil)
- (conn nil))
+ ;; An attempt to deal with denied connections, and attempt
+ ;; to reconnect
+ ;; (cur-retries 0)
+ ;; (retry t)
+ (conn nil))
;; If the user told us to do DNS for them, do it.
(if url-gateway-broken-resolution
(setq host (url-gateway-nslookup-host host)))
- (condition-case errobj
+ (condition-case nil
;; This is a clean way to ensure the new process inherits the
;; right coding systems in both Emacs and XEmacs.
(let ((coding-system-for-read 'binary)
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index 324cf99554d..61e07a0d9ca 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -66,7 +66,7 @@
(defconst url-http-default-port 80 "Default HTTP port.")
(defconst url-http-asynchronous-p t "HTTP retrievals are asynchronous.")
-(defalias 'url-http-expand-file-name 'url-default-expander)
+(defalias 'url-http-expand-file-name #'url-default-expander)
(defvar url-http-real-basic-auth-storage nil)
(defvar url-http-proxy-basic-auth-storage nil)
@@ -150,7 +150,7 @@ request.")
;; These routines will allow us to implement persistent HTTP
;; connections.
(defsubst url-http-debug (&rest args)
- (apply 'url-debug 'http args))
+ (apply #'url-debug 'http args))
(defun url-http-mark-connection-as-busy (host port proc)
(url-http-debug "Marking connection as busy: %s:%d %S" host port proc)
@@ -1203,8 +1203,7 @@ the end of the document."
;; We got back a headerless malformed response from the
;; server.
(url-http-activate-callback))
- ((or (= url-http-response-status 204)
- (= url-http-response-status 205))
+ ((memq url-http-response-status '(204 205))
(url-http-debug "%d response must have headers only (%s)."
url-http-response-status (buffer-name))
(when (url-http-parse-headers)
@@ -1239,11 +1238,11 @@ the end of the document."
(url-http-debug
"Saw HTTP/0.9 response, connection closed means end of document.")
(setq url-http-after-change-function
- 'url-http-simple-after-change-function))
+ #'url-http-simple-after-change-function))
((equal url-http-transfer-encoding "chunked")
(url-http-debug "Saw chunked encoding.")
(setq url-http-after-change-function
- 'url-http-chunked-encoding-after-change-function)
+ #'url-http-chunked-encoding-after-change-function)
(when (> nd url-http-end-of-headers)
(url-http-debug
"Calling initial chunked-encoding for extra data at end of headers")
@@ -1254,7 +1253,7 @@ the end of the document."
(url-http-debug
"Got a content-length, being smart about document end.")
(setq url-http-after-change-function
- 'url-http-content-length-after-change-function)
+ #'url-http-content-length-after-change-function)
(cond
((= 0 url-http-content-length)
;; We got a NULL body! Activate the callback
@@ -1275,7 +1274,7 @@ the end of the document."
(t
(url-http-debug "No content-length, being dumb.")
(setq url-http-after-change-function
- 'url-http-simple-after-change-function)))))
+ #'url-http-simple-after-change-function)))))
;; We are still at the beginning of the buffer... must just be
;; waiting for a response.
(url-http-debug "Spinning waiting for headers...")
@@ -1374,7 +1373,7 @@ The return value of this function is the retrieval buffer."
url-http-referer referer)
(set-process-buffer connection buffer)
- (set-process-filter connection 'url-http-generic-filter)
+ (set-process-filter connection #'url-http-generic-filter)
(pcase (process-status connection)
('connect
;; Asynchronous connection
@@ -1388,12 +1387,12 @@ The return value of this function is the retrieval buffer."
(url-type url-current-object)))
(url-https-proxy-connect connection)
(set-process-sentinel connection
- 'url-http-end-of-document-sentinel)
+ #'url-http-end-of-document-sentinel)
(process-send-string connection (url-http-create-request)))))))
buffer))
(defun url-https-proxy-connect (connection)
- (setq url-http-after-change-function 'url-https-proxy-after-change-function)
+ (setq url-http-after-change-function #'url-https-proxy-after-change-function)
(process-send-string
connection
(format
@@ -1441,7 +1440,7 @@ The return value of this function is the retrieval buffer."
(with-current-buffer process-buffer (erase-buffer))
(set-process-buffer tls-connection process-buffer)
(setq url-http-after-change-function
- 'url-http-wait-for-headers-change-function)
+ #'url-http-wait-for-headers-change-function)
(set-process-filter tls-connection 'url-http-generic-filter)
(process-send-string tls-connection
(url-http-create-request)))
@@ -1510,7 +1509,7 @@ The return value of this function is the retrieval buffer."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defalias 'url-http-symbol-value-in-buffer
(if (fboundp 'symbol-value-in-buffer)
- 'symbol-value-in-buffer
+ #'symbol-value-in-buffer
(lambda (symbol buffer &optional unbound-value)
"Return the value of SYMBOL in BUFFER, or UNBOUND-VALUE if it is unbound."
(with-current-buffer buffer
diff --git a/lisp/url/url-imap.el b/lisp/url/url-imap.el
index 05c3e73fb0e..492907f33ff 100644
--- a/lisp/url/url-imap.el
+++ b/lisp/url/url-imap.el
@@ -1,4 +1,4 @@
-;;; url-imap.el --- IMAP retrieval routines
+;;; url-imap.el --- IMAP retrieval routines -*- lexical-binding: t; -*-
;; Copyright (C) 1999, 2004-2021 Free Software Foundation, Inc.
@@ -37,6 +37,9 @@
(defconst url-imap-default-port 143 "Default IMAP port.")
+(defvar imap-username)
+(defvar imap-password)
+
(defun url-imap-open-host (host port user pass)
;; xxx use user and password
(if (fboundp 'nnheader-init-server-buffer)
diff --git a/lisp/url/url-ldap.el b/lisp/url/url-ldap.el
index 0fa9970fa47..d26562b7f10 100644
--- a/lisp/url/url-ldap.el
+++ b/lisp/url/url-ldap.el
@@ -1,4 +1,4 @@
-;;; url-ldap.el --- LDAP Uniform Resource Locator retrieval code
+;;; url-ldap.el --- LDAP Uniform Resource Locator retrieval code -*- lexical-binding: t; -*-
;; Copyright (C) 1998-1999, 2004-2021 Free Software Foundation, Inc.
diff --git a/lisp/url/url-mailto.el b/lisp/url/url-mailto.el
index 688f102cabd..72884c07cc9 100644
--- a/lisp/url/url-mailto.el
+++ b/lisp/url/url-mailto.el
@@ -1,4 +1,4 @@
-;;; url-mail.el --- Mail Uniform Resource Locator retrieval code
+;;; url-mail.el --- Mail Uniform Resource Locator retrieval code -*- lexical-binding: t; -*-
;; Copyright (C) 1996-1999, 2004-2021 Free Software Foundation, Inc.
@@ -67,7 +67,7 @@
;; mailto:wmperry@gnu.org
(setf (url-filename url) (concat (url-user url) "@" (url-filename url))))
(setq url (url-filename url))
- (let (to args source-url subject func headers-start)
+ (let (to args source-url subject headers-start) ;; func
(if (string-match (regexp-quote "?") url)
(setq headers-start (match-end 0)
to (url-unhex-string (substring url 0 (match-beginning 0)))
@@ -76,10 +76,11 @@
(setq to (url-unhex-string url)))
(setq source-url (url-view-url t))
(if (and url-request-data (not (assoc "subject" args)))
- (setq args (cons (list "subject"
+ (push (list "subject"
(concat "Automatic submission from "
url-package-name "/"
- url-package-version)) args)))
+ url-package-version))
+ args))
(if (and source-url (not (assoc "x-url-from" args)))
(setq args (cons (list "x-url-from" source-url) args)))
@@ -107,7 +108,7 @@
(replace-regexp-in-string "\r\n" "\n" string))
(cdar args) "\n")))
(url-mail-goto-field (caar args))
- (setq func (intern-soft (concat "mail-" (caar args))))
+ ;; (setq func (intern-soft (concat "mail-" (caar args))))
(insert (mapconcat 'identity (cdar args) ", ")))
(setq args (cdr args)))
;; (url-mail-goto-field "User-Agent")
diff --git a/lisp/url/url-methods.el b/lisp/url/url-methods.el
index 7aad741210d..cfe7d5bc6a3 100644
--- a/lisp/url/url-methods.el
+++ b/lisp/url/url-methods.el
@@ -1,4 +1,4 @@
-;;; url-methods.el --- Load URL schemes as needed
+;;; url-methods.el --- Load URL schemes as needed -*- lexical-binding: t; -*-
;; Copyright (C) 1996-1999, 2004-2021 Free Software Foundation, Inc.
@@ -57,7 +57,7 @@
'file-exists-p 'ignore
'file-attributes 'ignore))
-(defun url-scheme-default-loader (url &optional callback cbargs)
+(defun url-scheme-default-loader (url &optional _callback _cbargs)
"Signal an error for an unknown URL scheme."
(error "Unknown URL scheme: %s" (url-type url)))
diff --git a/lisp/url/url-misc.el b/lisp/url/url-misc.el
index d3db31d612a..fe2393beb64 100644
--- a/lisp/url/url-misc.el
+++ b/lisp/url/url-misc.el
@@ -1,4 +1,4 @@
-;;; url-misc.el --- Misc Uniform Resource Locator retrieval code
+;;; url-misc.el --- Misc Uniform Resource Locator retrieval code -*- lexical-binding: t; -*-
;; Copyright (C) 1996-1999, 2002, 2004-2021 Free Software Foundation,
;; Inc.
diff --git a/lisp/url/url-news.el b/lisp/url/url-news.el
index d5f8483ab7a..585a28291ae 100644
--- a/lisp/url/url-news.el
+++ b/lisp/url/url-news.el
@@ -1,4 +1,4 @@
-;;; url-news.el --- News Uniform Resource Locator retrieval code
+;;; url-news.el --- News Uniform Resource Locator retrieval code -*- lexical-binding: t; -*-
;; Copyright (C) 1996-1999, 2004-2021 Free Software Foundation, Inc.
@@ -106,7 +106,7 @@
;; Find a news reference
(let* ((host (or (url-host url) url-news-server))
(port (url-port url))
- (article-brackets nil)
+ ;; (article-brackets nil)
(buf nil)
(article (url-unhex-string (url-filename url))))
(url-news-open-host host port (url-user url) (url-password url))
diff --git a/lisp/url/url-nfs.el b/lisp/url/url-nfs.el
index 3c80c8059b5..0449930408d 100644
--- a/lisp/url/url-nfs.el
+++ b/lisp/url/url-nfs.el
@@ -1,4 +1,4 @@
-;;; url-nfs.el --- NFS URL interface
+;;; url-nfs.el --- NFS URL interface -*- lexical-binding: t; -*-
;; Copyright (C) 1996-1999, 2004-2021 Free Software Foundation, Inc.
diff --git a/lisp/url/url-privacy.el b/lisp/url/url-privacy.el
index e3ca0f66d98..d926775c48d 100644
--- a/lisp/url/url-privacy.el
+++ b/lisp/url/url-privacy.el
@@ -1,4 +1,4 @@
-;;; url-privacy.el --- Global history tracking for URL package
+;;; url-privacy.el --- Global history tracking for URL package -*- lexical-binding: t; -*-
;; Copyright (C) 1996-1999, 2004-2021 Free Software Foundation, Inc.
@@ -23,7 +23,7 @@
(require 'url-vars)
-(defun url-device-type (&optional device)
+(defun url-device-type (&optional _device)
(declare (obsolete nil "27.1"))
(or window-system 'tty))
diff --git a/lisp/url/url-proxy.el b/lisp/url/url-proxy.el
index 6bf65845098..8436c7a4be2 100644
--- a/lisp/url/url-proxy.el
+++ b/lisp/url/url-proxy.el
@@ -1,4 +1,4 @@
-;;; url-proxy.el --- Proxy server support
+;;; url-proxy.el --- Proxy server support -*- lexical-binding: t; -*-
;; Copyright (C) 1999, 2004-2021 Free Software Foundation, Inc.
diff --git a/lisp/url/url-tramp.el b/lisp/url/url-tramp.el
index 325d25cb8e2..5b9dd8a2682 100644
--- a/lisp/url/url-tramp.el
+++ b/lisp/url/url-tramp.el
@@ -1,4 +1,4 @@
-;;; url-tramp.el --- file-name-handler magic invoking Tramp for some protocols
+;;; url-tramp.el --- file-name-handler magic invoking Tramp for some protocols -*- lexical-binding: t; -*-
;; Copyright (C) 2014-2021 Free Software Foundation, Inc.
diff --git a/lisp/url/url.el b/lisp/url/url.el
index 172a3af2b3b..8daf9f0a8e8 100644
--- a/lisp/url/url.el
+++ b/lisp/url/url.el
@@ -156,16 +156,16 @@ If INHIBIT-COOKIES, cookies will neither be stored nor sent to
the server.
If URL is a multibyte string, it will be encoded as utf-8 and
URL-encoded before it's used."
-;;; XXX: There is code in Emacs that does dynamic binding
-;;; of the following variables around url-retrieve:
-;;; url-standalone-mode, url-gateway-unplugged, w3-honor-stylesheets,
-;;; url-confirmation-func, url-cookie-multiple-line,
-;;; url-cookie-{{,secure-}storage,confirmation}
-;;; url-standalone-mode and url-gateway-unplugged should work as
-;;; usual. url-confirmation-func is only used in nnwarchive.el and
-;;; webmail.el; the latter should be updated. Is
-;;; url-cookie-multiple-line needed anymore? The other url-cookie-*
-;;; are (for now) only used in synchronous retrievals.
+ ;; XXX: There is code in Emacs that does dynamic binding
+ ;; of the following variables around url-retrieve:
+ ;; url-standalone-mode, url-gateway-unplugged, w3-honor-stylesheets,
+ ;; url-confirmation-func, url-cookie-multiple-line,
+ ;; url-cookie-{{,secure-}storage,confirmation}
+ ;; url-standalone-mode and url-gateway-unplugged should work as
+ ;; usual. url-confirmation-func is only used in nnwarchive.el and
+ ;; webmail.el; the latter should be updated. Is
+ ;; url-cookie-multiple-line needed anymore? The other url-cookie-*
+ ;; are (for now) only used in synchronous retrievals.
(url-retrieve-internal url callback (cons nil cbargs) silent
inhibit-cookies))
@@ -210,7 +210,7 @@ URL-encoded before it's used."
(asynch (url-scheme-get-property (url-type url) 'asynchronous-p)))
(if url-using-proxy
(setq asynch t
- loader 'url-proxy))
+ loader #'url-proxy))
(if asynch
(let ((url-current-object url))
(setq buffer (funcall loader url callback cbargs)))
diff --git a/lisp/vc/ediff-diff.el b/lisp/vc/ediff-diff.el
index e90eaa11565..fde9d4338f3 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 0865ac5ce41..c20d03c83d6 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)))
diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el
index 3b09dfe5d2e..f50b2540c55 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))))
diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index e4eff486f5e..c495afb6ec5 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.
diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el
index bbb73240be2..9d0808c0435 100644
--- a/lisp/vc/vc-dir.el
+++ b/lisp/vc/vc-dir.el
@@ -300,7 +300,6 @@ See `run-hooks'."
(define-key map "\C-o" 'vc-dir-display-file)
(define-key map "\C-c\C-c" 'vc-dir-kill-dir-status-process)
(define-key map [down-mouse-3] 'vc-dir-menu)
- (define-key map [mouse-2] 'vc-dir-toggle-mark)
(define-key map [follow-link] 'mouse-face)
(define-key map "x" 'vc-dir-hide-up-to-date)
(define-key map [?\C-k] 'vc-dir-kill-line)
@@ -1085,7 +1084,6 @@ U - if the cursor is on a file: unmark all the files with the same state
as the current file
- if the cursor is on a directory: unmark all child files
- with a prefix argument: unmark all files
-mouse-2 - toggles the mark state
VC commands
VC commands in the `C-x v' prefix can be used.
@@ -1392,6 +1390,12 @@ These are the commands available for use in the file status buffer:
(propertize "Please add backend specific headers here. It's easy!"
'face 'font-lock-warning-face)))
+(defvar vc-dir-status-mouse-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [mouse-2] 'vc-dir-toggle-mark)
+ map)
+ "Local keymap for toggling mark.")
+
(defvar vc-dir-filename-mouse-map
(let ((map (make-sparse-keymap)))
(define-key map [mouse-2] 'vc-dir-find-file-other-window)
@@ -1418,7 +1422,8 @@ These are the commands available for use in the file status buffer:
((memq state '(missing conflict)) 'font-lock-warning-face)
((eq state 'edited) 'font-lock-constant-face)
(t 'font-lock-variable-name-face))
- 'mouse-face 'highlight)
+ 'mouse-face 'highlight
+ 'keymap vc-dir-status-mouse-map)
" "
(propertize
(format "%s" filename)
diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el
index 6b17f2afe74..2573964c42c 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 a9ee28e3aad..d00c2c2133c 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -479,9 +479,10 @@ or an empty string if none."
(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))
- 'mouse-face 'highlight)
+ ((eq state '(missing conflict)) 'font-lock-warning-face)
+ (t 'font-lock-variable-name-face))
+ '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))
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index c4b82ab11eb..1d163a64ab2 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -1166,7 +1166,8 @@ hg binary."
;; Modeled after the similar function in vc-bzr.el
(defun vc-hg-rename-file (old new)
"Rename file from OLD to NEW using `hg mv'."
- (vc-hg-command nil 0 new "mv" old))
+ (vc-hg-command nil 0 (expand-file-name new) "mv"
+ (expand-file-name old)))
(defun vc-hg-register (files &optional _comment)
"Register FILES under hg. COMMENT is ignored."
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index bc9f11202b1..00976a07d42 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/wdired.el b/lisp/wdired.el
index f4a0b6d9a93..a096abd106f 100644
--- a/lisp/wdired.el
+++ b/lisp/wdired.el
@@ -27,26 +27,26 @@
;; wdired.el (the "w" is for writable) provides an alternative way of
;; renaming files.
;;
-;; Have you ever wished to use C-x r t (string-rectangle), M-%
+;; Have you ever wanted to use C-x r t (string-rectangle), M-%
;; (query-replace), M-c (capitalize-word), etc... to change the name of
-;; the files in a "dired" buffer? Now you can do this. All the power
-;; of Emacs commands are available to renaming files!
+;; the files in a "dired" buffer? Now you can do this. All the power
+;; of Emacs commands are available when renaming files!
;;
;; This package provides a function that makes the filenames of a
;; dired buffer editable, by changing the buffer mode (which inhibits
-;; all of the commands of dired mode). Here you can edit the names of
+;; all of the commands of dired mode). Here you can edit the names of
;; one or more files and directories, and when you press C-c C-c, the
;; renaming takes effect and you are back to dired mode.
;;
-;; Another things you can do with WDired:
+;; Other things you can do with WDired:
;;
-;; - To move files to another directory (by typing their path,
+;; - Move files to another directory (by typing their path,
;; absolute or relative, as a part of the new filename).
;;
-;; - To change the target of symbolic links.
+;; - Change the target of symbolic links.
;;
-;; - To change the permission bits of the filenames (in systems with a
-;; working unix-alike `dired-chmod-program'). See and customize the
+;; - Change the permission bits of the filenames (in systems with a
+;; working unix-alike `dired-chmod-program'). See and customize the
;; variable `wdired-allow-to-change-permissions'. To change a single
;; char (toggling between its two more usual values) you can press
;; the space bar over it or left-click the mouse. To set any char to
@@ -56,7 +56,7 @@
;; the change would affect to their targets, and this would not be
;; WYSIWYG :-).
;;
-;; - To mark files for deletion, by deleting their whole filename.
+;; - Mark files for deletion, by deleting their whole filename.
;;; Usage:
@@ -68,8 +68,8 @@
;;; Change Log:
-;; Google is your friend (previous versions with complete changelogs
-;; were posted to gnu.emacs.sources)
+;; Previous versions with complete changelogs were posted to
+;; gnu.emacs.sources.
;;; Code:
diff --git a/lisp/whitespace.el b/lisp/whitespace.el
index 7b8e5b7cc11..22bfae06975 100644
--- a/lisp/whitespace.el
+++ b/lisp/whitespace.el
@@ -1000,8 +1000,8 @@ See also `whitespace-style', `whitespace-newline' and
((eq whitespace-global-modes t))
((listp whitespace-global-modes)
(if (eq (car-safe whitespace-global-modes) 'not)
- (not (memq major-mode (cdr whitespace-global-modes)))
- (memq major-mode whitespace-global-modes)))
+ (not (apply #'derived-mode-p (cdr whitespace-global-modes)))
+ (apply #'derived-mode-p whitespace-global-modes)))
(t nil))
;; ...we have a display (not running a batch job)
(not noninteractive)
diff --git a/lisp/window.el b/lisp/window.el
index 0a37d16273f..8905d4a826e 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.
@@ -8196,8 +8194,8 @@ such alists.
If ALIST has a non-nil `inhibit-same-window' entry, the selected
window is not usable. A dedicated window is usable only if it
already shows BUFFER. If ALIST contains a `previous-window'
-entry, the window specified by that entry is usable even if it
-never showed BUFFER before.
+entry, the window specified by that entry (either a variable
+or a value) is usable even if it never showed BUFFER before.
If ALIST contains a `reusable-frames' entry, its value determines
which frames to search for a usable window:
@@ -8239,6 +8237,7 @@ indirectly called by the latter."
0)
(display-buffer-reuse-frames 0)
(t (last-nonminibuffer-frame))))
+ (previous-window (cdr (assq 'previous-window alist)))
best-window second-best-window window)
;; Scan windows whether they have shown the buffer recently.
(catch 'best
@@ -8252,7 +8251,9 @@ indirectly called by the latter."
(throw 'best t)))))
;; When ALIST has a `previous-window' entry, that entry may override
;; anything we found so far.
- (when (and (setq window (cdr (assq 'previous-window alist)))
+ (when (and previous-window (boundp previous-window))
+ (setq previous-window (symbol-value previous-window)))
+ (when (and (setq window previous-window)
(window-live-p window)
(or (eq buffer (window-buffer window))
(not (window-dedicated-p window))))
@@ -9577,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
@@ -9591,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
@@ -9611,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
@@ -9626,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
@@ -9653,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
@@ -9684,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.
@@ -9695,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.
diff --git a/m4/canonicalize.m4 b/m4/canonicalize.m4
index 475fa15d6bd..0dfb2da9a6a 100644
--- a/m4/canonicalize.m4
+++ b/m4/canonicalize.m4
@@ -1,4 +1,4 @@
-# canonicalize.m4 serial 35
+# canonicalize.m4 serial 37
dnl Copyright (C) 2003-2007, 2009-2021 Free Software Foundation, Inc.
@@ -78,68 +78,106 @@ AC_DEFUN([gl_CANONICALIZE_LGPL_SEPARATE],
# so is the latter.
AC_DEFUN([gl_FUNC_REALPATH_WORKS],
[
- AC_CHECK_FUNCS_ONCE([realpath])
+ AC_CHECK_FUNCS_ONCE([realpath lstat])
AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
AC_CACHE_CHECK([whether realpath works], [gl_cv_func_realpath_works], [
rm -rf conftest.a conftest.d
touch conftest.a
+ # Assume that if we have lstat, we can also check symlinks.
+ if test $ac_cv_func_lstat = yes; then
+ ln -s conftest.a conftest.l
+ fi
mkdir conftest.d
AC_RUN_IFELSE([
AC_LANG_PROGRAM([[
]GL_NOCRASH[
+ #include <errno.h>
#include <stdlib.h>
#include <string.h>
]], [[
int result = 0;
+ /* This test fails on Solaris 10. */
{
char *name = realpath ("conftest.a", NULL);
if (!(name && *name == '/'))
result |= 1;
free (name);
}
+ /* This test fails on older versions of Cygwin. */
{
char *name = realpath ("conftest.b/../conftest.a", NULL);
if (name != NULL)
result |= 2;
free (name);
}
+ /* This test fails on Cygwin 2.9. */
+ #if HAVE_LSTAT
+ {
+ char *name = realpath ("conftest.l/../conftest.a", NULL);
+ if (name != NULL || errno != ENOTDIR)
+ result |= 4;
+ free (name);
+ }
+ #endif
+ /* This test fails on Mac OS X 10.13, OpenBSD 6.0. */
{
char *name = realpath ("conftest.a/", NULL);
if (name != NULL)
- result |= 4;
+ result |= 8;
free (name);
}
+ /* This test fails on AIX 7, Solaris 10. */
{
char *name1 = realpath (".", NULL);
char *name2 = realpath ("conftest.d//./..", NULL);
if (! name1 || ! name2 || strcmp (name1, name2))
- result |= 8;
+ result |= 16;
free (name1);
free (name2);
}
+ #ifdef __linux__
+ /* On Linux, // is the same as /. See also double-slash-root.m4.
+ realpath() should respect this.
+ This test fails on musl libc 1.2.2. */
+ {
+ char *name = realpath ("//", NULL);
+ if (! name || strcmp (name, "/"))
+ result |= 32;
+ free (name);
+ }
+ #endif
return result;
]])
],
[gl_cv_func_realpath_works=yes],
- [gl_cv_func_realpath_works=no],
+ [case $? in
+ 32) gl_cv_func_realpath_works=nearly ;;
+ *) gl_cv_func_realpath_works=no ;;
+ esac
+ ],
[case "$host_os" in
# Guess yes on glibc systems.
*-gnu* | gnu*) gl_cv_func_realpath_works="guessing yes" ;;
- # Guess yes on musl systems.
- *-musl*) gl_cv_func_realpath_works="guessing yes" ;;
+ # Guess 'nearly' on musl systems.
+ *-musl*) gl_cv_func_realpath_works="guessing nearly" ;;
+ # Guess no on Cygwin.
+ cygwin*) gl_cv_func_realpath_works="guessing no" ;;
# Guess no on native Windows.
mingw*) gl_cv_func_realpath_works="guessing no" ;;
# If we don't know, obey --enable-cross-guesses.
*) gl_cv_func_realpath_works="$gl_cross_guess_normal" ;;
esac
])
- rm -rf conftest.a conftest.d
+ rm -rf conftest.a conftest.l conftest.d
])
case "$gl_cv_func_realpath_works" in
*yes)
- AC_DEFINE([FUNC_REALPATH_WORKS], [1], [Define to 1 if realpath()
- can malloc memory, always gives an absolute path, and handles
- trailing slash correctly.])
+ AC_DEFINE([FUNC_REALPATH_WORKS], [1],
+ [Define to 1 if realpath() can malloc memory, always gives an absolute path, and handles leading slashes and a trailing slash correctly.])
+ ;;
+ *nearly)
+ AC_DEFINE([FUNC_REALPATH_NEARLY_WORKS], [1],
+ [Define to 1 if realpath() can malloc memory, always gives an absolute path, and handles a trailing slash correctly.])
;;
esac
])
diff --git a/m4/extensions.m4 b/m4/extensions.m4
index f7333acbd4f..5792a9557a8 100644
--- a/m4/extensions.m4
+++ b/m4/extensions.m4
@@ -1,4 +1,4 @@
-# serial 21 -*- Autoconf -*-
+# serial 22 -*- Autoconf -*-
# Enable extensions on systems that normally disable them.
# Copyright (C) 2003, 2006-2021 Free Software Foundation, Inc.
@@ -212,4 +212,16 @@ dnl it should only be defined when necessary.
AC_DEFUN_ONCE([gl_USE_SYSTEM_EXTENSIONS],
[
AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS])
+
+ dnl On OpenBSD 6.8 with GCC, the include files contain a couple of
+ dnl definitions that are only activated with an explicit -D_ISOC11_SOURCE.
+ dnl That's because this version of GCC (4.2.1) supports the option
+ dnl '-std=gnu99' but not the option '-std=gnu11'.
+ AC_REQUIRE([AC_CANONICAL_HOST])
+ case "$host_os" in
+ openbsd*)
+ AC_DEFINE([_ISOC11_SOURCE], [1],
+ [Define to enable the declarations of ISO C 11 types and functions.])
+ ;;
+ esac
])
diff --git a/m4/fchmodat.m4 b/m4/fchmodat.m4
index 09380327799..66c0e308fcc 100644
--- a/m4/fchmodat.m4
+++ b/m4/fchmodat.m4
@@ -1,4 +1,4 @@
-# fchmodat.m4 serial 5
+# fchmodat.m4 serial 6
dnl Copyright (C) 2004-2021 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -16,11 +16,9 @@ AC_DEFUN([gl_FUNC_FCHMODAT],
HAVE_FCHMODAT=0
else
AC_CACHE_CHECK(
- [whether fchmodat+AT_SYMLINK_NOFOLLOW works on non-symlinks],
+ [whether fchmodat works],
[gl_cv_func_fchmodat_works],
- [dnl This test fails on GNU/Linux with glibc 2.31 (but not on
- dnl GNU/kFreeBSD nor GNU/Hurd) and Cygwin 2.9.
- AC_RUN_IFELSE(
+ [AC_RUN_IFELSE(
[AC_LANG_PROGRAM(
[
AC_INCLUDES_DEFAULT[
@@ -44,27 +42,49 @@ AC_DEFUN([gl_FUNC_FCHMODAT],
[[
int permissive = S_IRWXU | S_IRWXG | S_IRWXO;
int desired = S_IRUSR | S_IWUSR;
- static char const f[] = "conftest.fchmodat";
+ int result = 0;
+ #define file "conftest.fchmodat"
struct stat st;
- if (creat (f, permissive) < 0)
+ if (creat (file, permissive) < 0)
return 1;
- if (fchmodat (AT_FDCWD, f, desired, AT_SYMLINK_NOFOLLOW) != 0)
+ /* Test whether fchmodat rejects a trailing slash on a non-directory.
+ This test fails on AIX 7.2. */
+ if (fchmodat (AT_FDCWD, file "/", desired, 0) == 0)
+ result |= 2;
+ /* Test whether fchmodat+AT_SYMLINK_NOFOLLOW works on non-symlinks.
+ This test fails on GNU/Linux with glibc 2.31 (but not on
+ GNU/kFreeBSD nor GNU/Hurd) and Cygwin 2.9. */
+ if (fchmodat (AT_FDCWD, file, desired, AT_SYMLINK_NOFOLLOW) != 0)
+ result |= 4;
+ if (stat (file, &st) != 0)
return 1;
- if (stat (f, &st) != 0)
- return 1;
- return ! ((st.st_mode & permissive) == desired);
+ if ((st.st_mode & permissive) != desired)
+ result |= 4;
+ return result;
]])],
[gl_cv_func_fchmodat_works=yes],
- [gl_cv_func_fchmodat_works=no],
+ [case $? in
+ 2) gl_cv_func_fchmodat_works='nearly' ;;
+ *) gl_cv_func_fchmodat_works=no ;;
+ esac
+ ],
[case "$host_os" in
- dnl Guess no on Linux with glibc and Cygwin, yes otherwise.
+ # Guess no on Linux with glibc and Cygwin.
linux-gnu* | cygwin*) gl_cv_func_fchmodat_works="guessing no" ;;
+ # Guess 'nearly' on AIX.
+ aix*) gl_cv_func_fchmodat_works="guessing nearly" ;;
+ # If we don't know, obey --enable-cross-guesses.
*) gl_cv_func_fchmodat_works="$gl_cross_guess_normal" ;;
esac
])
rm -f conftest.fchmodat])
- case $gl_cv_func_fchmodat_works in
+ case "$gl_cv_func_fchmodat_works" in
*yes) ;;
+ *nearly)
+ AC_DEFINE([HAVE_NEARLY_WORKING_FCHMODAT], [1],
+ [Define to 1 if fchmodat works, except for the trailing slash handling.])
+ REPLACE_FCHMODAT=1
+ ;;
*)
AC_DEFINE([NEED_FCHMODAT_NONSYMLINK_FIX], [1],
[Define to 1 if fchmodat+AT_SYMLINK_NOFOLLOW does not work right on non-symlinks.])
diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4
index 535359b2cf6..f2eff10de6d 100644
--- a/m4/gnulib-common.m4
+++ b/m4/gnulib-common.m4
@@ -39,11 +39,12 @@ AC_DEFUN([gl_COMMON_BODY], [
this syntax with 'extern'. */
# define _Noreturn [[noreturn]]
# elif ((!defined __cplusplus || defined __clang__) \
- && (201112 <= (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) \
- || _GL_GNUC_PREREQ (4, 7) \
- || (defined __apple_build_version__ \
- ? 6000000 <= __apple_build_version__ \
- : 3 < __clang_major__ + (5 <= __clang_minor__))))
+ && (201112 <= (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) \
+ || (!defined __STRICT_ANSI__ \
+ && (_GL_GNUC_PREREQ (4, 7) \
+ || (defined __apple_build_version__ \
+ ? 6000000 <= __apple_build_version__ \
+ : 3 < __clang_major__ + (5 <= __clang_minor__))))))
/* _Noreturn works as-is. */
# elif _GL_GNUC_PREREQ (2, 8) || defined __clang__ || 0x5110 <= __SUNPRO_C
# define _Noreturn __attribute__ ((__noreturn__))
@@ -66,7 +67,9 @@ AC_DEFUN([gl_COMMON_BODY], [
#endif])
AH_VERBATIM([attribute],
[/* Attributes. */
-#ifdef __has_attribute
+#if (defined __has_attribute \
+ && (!defined __clang_minor__ \
+ || 3 < __clang_major__ + (5 <= __clang_minor__)))
# define _GL_HAS_ATTRIBUTE(attr) __has_attribute (__##attr##__)
#else
# define _GL_HAS_ATTRIBUTE(attr) _GL_ATTR_##attr
diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4
index ad109520dd1..cd6f7b4bbdf 100644
--- a/m4/gnulib-comp.m4
+++ b/m4/gnulib-comp.m4
@@ -75,6 +75,7 @@ AC_DEFUN([gl_EARLY],
# Code from module dtoastr:
# Code from module dtotimespec:
# Code from module dup2:
+ # Code from module dynarray:
# Code from module eloop-threshold:
# Code from module environ:
# Code from module errno:
@@ -517,6 +518,7 @@ AC_DEFUN([gl_INIT],
gl_gnulib_enabled_260941c0e5dc67ec9e87d1fb321c300b=false
gl_gnulib_enabled_cloexec=false
gl_gnulib_enabled_dirfd=false
+ gl_gnulib_enabled_dynarray=false
gl_gnulib_enabled_925677f0343de64b89a9f0c790b4104c=false
gl_gnulib_enabled_euidaccess=false
gl_gnulib_enabled_getdtablesize=false
@@ -564,6 +566,12 @@ AC_DEFUN([gl_INIT],
gl_gnulib_enabled_dirfd=true
fi
}
+ func_gl_gnulib_m4code_dynarray ()
+ {
+ if ! $gl_gnulib_enabled_dynarray; then
+ gl_gnulib_enabled_dynarray=true
+ fi
+ }
func_gl_gnulib_m4code_925677f0343de64b89a9f0c790b4104c ()
{
if ! $gl_gnulib_enabled_925677f0343de64b89a9f0c790b4104c; then
@@ -797,6 +805,9 @@ AC_DEFUN([gl_INIT],
if test $HAVE_READLINKAT = 0 || test $REPLACE_READLINKAT = 1; then
func_gl_gnulib_m4code_03e0aaad4cb89ca757653bd367a6ccb7
fi
+ if test $ac_use_included_regex = yes; then
+ func_gl_gnulib_m4code_dynarray
+ fi
if { test $HAVE_DECL_STRTOIMAX = 0 || test $REPLACE_STRTOIMAX = 1; } && test $ac_cv_type_long_long_int = yes; then
func_gl_gnulib_m4code_strtoll
fi
@@ -819,6 +830,7 @@ AC_DEFUN([gl_INIT],
AM_CONDITIONAL([gl_GNULIB_ENABLED_260941c0e5dc67ec9e87d1fb321c300b], [$gl_gnulib_enabled_260941c0e5dc67ec9e87d1fb321c300b])
AM_CONDITIONAL([gl_GNULIB_ENABLED_cloexec], [$gl_gnulib_enabled_cloexec])
AM_CONDITIONAL([gl_GNULIB_ENABLED_dirfd], [$gl_gnulib_enabled_dirfd])
+ AM_CONDITIONAL([gl_GNULIB_ENABLED_dynarray], [$gl_gnulib_enabled_dynarray])
AM_CONDITIONAL([gl_GNULIB_ENABLED_925677f0343de64b89a9f0c790b4104c], [$gl_gnulib_enabled_925677f0343de64b89a9f0c790b4104c])
AM_CONDITIONAL([gl_GNULIB_ENABLED_euidaccess], [$gl_gnulib_enabled_euidaccess])
AM_CONDITIONAL([gl_GNULIB_ENABLED_getdtablesize], [$gl_gnulib_enabled_getdtablesize])
@@ -1021,6 +1033,7 @@ AC_DEFUN([gl_FILE_LIST], [
lib/dtoastr.c
lib/dtotimespec.c
lib/dup2.c
+ lib/dynarray.h
lib/eloop-threshold.h
lib/errno.in.h
lib/euidaccess.c
@@ -1076,6 +1089,13 @@ AC_DEFUN([gl_FILE_LIST], [
lib/libc-config.h
lib/limits.in.h
lib/lstat.c
+ lib/malloc/dynarray-skeleton.c
+ lib/malloc/dynarray.h
+ lib/malloc/dynarray_at_failure.c
+ lib/malloc/dynarray_emplace_enlarge.c
+ lib/malloc/dynarray_finalize.c
+ lib/malloc/dynarray_resize.c
+ lib/malloc/dynarray_resize_clear.c
lib/malloc/scratch_buffer.h
lib/malloc/scratch_buffer_dupfree.c
lib/malloc/scratch_buffer_grow.c
diff --git a/m4/nstrftime.m4 b/m4/nstrftime.m4
index 4674442810b..b510554b947 100644
--- a/m4/nstrftime.m4
+++ b/m4/nstrftime.m4
@@ -1,4 +1,4 @@
-# serial 36
+# serial 37
# Copyright (C) 1996-1997, 1999-2007, 2009-2021 Free Software Foundation, Inc.
#
@@ -12,7 +12,7 @@ AC_DEFUN([gl_FUNC_GNU_STRFTIME],
[
AC_REQUIRE([AC_C_RESTRICT])
- # This defines (or not) HAVE_TZNAME and HAVE_TM_ZONE.
+ # This defines (or not) HAVE_TZNAME and HAVE_STRUCT_TM_TM_ZONE.
AC_REQUIRE([AC_STRUCT_TIMEZONE])
AC_REQUIRE([gl_TM_GMTOFF])
diff --git a/m4/stddef_h.m4 b/m4/stddef_h.m4
index 18e872f483e..cd666c4a58c 100644
--- a/m4/stddef_h.m4
+++ b/m4/stddef_h.m4
@@ -1,14 +1,19 @@
-dnl A placeholder for <stddef.h>, for platforms that have issues.
-# stddef_h.m4 serial 7
+# stddef_h.m4 serial 9
dnl Copyright (C) 2009-2021 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
+dnl A placeholder for <stddef.h>, for platforms that have issues.
+
AC_DEFUN([gl_STDDEF_H],
[
AC_REQUIRE([gl_STDDEF_H_DEFAULTS])
AC_REQUIRE([gt_TYPE_WCHAR_T])
+
+ dnl Persuade OpenBSD <stddef.h> to declare max_align_t.
+ AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS])
+
STDDEF_H=
dnl Test whether the type max_align_t exists and whether its alignment
@@ -23,6 +28,13 @@ AC_DEFUN([gl_STDDEF_H],
int check1[2 * (__alignof__ (double) <= __alignof__ (max_align_t)) - 1];
int check2[2 * (__alignof__ (long double) <= __alignof__ (max_align_t)) - 1];
#endif
+ typedef struct { char a; max_align_t b; } max_helper;
+ typedef struct { char a; long b; } long_helper;
+ typedef struct { char a; double b; } double_helper;
+ typedef struct { char a; long double b; } long_double_helper;
+ int check3[2 * (offsetof (long_helper, b) <= offsetof (max_helper, b)) - 1];
+ int check4[2 * (offsetof (double_helper, b) <= offsetof (max_helper, b)) - 1];
+ int check5[2 * (offsetof (long_double_helper, b) <= offsetof (max_helper, b)) - 1];
]])],
[gl_cv_type_max_align_t=yes],
[gl_cv_type_max_align_t=no])
diff --git a/m4/string_h.m4 b/m4/string_h.m4
index 3e65355735c..a4cc5b43783 100644
--- a/m4/string_h.m4
+++ b/m4/string_h.m4
@@ -5,7 +5,7 @@
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
-# serial 28
+# serial 29
# Written by Paul Eggert.
@@ -113,6 +113,7 @@ AC_DEFUN([gl_HEADER_STRING_H_DEFAULTS],
HAVE_SIGDESCR_NP=1; AC_SUBST([HAVE_SIGDESCR_NP])
HAVE_DECL_STRSIGNAL=1; AC_SUBST([HAVE_DECL_STRSIGNAL])
HAVE_STRVERSCMP=1; AC_SUBST([HAVE_STRVERSCMP])
+ REPLACE_FFSLL=0; AC_SUBST([REPLACE_FFSLL])
REPLACE_MEMCHR=0; AC_SUBST([REPLACE_MEMCHR])
REPLACE_MEMMEM=0; AC_SUBST([REPLACE_MEMMEM])
REPLACE_STPNCPY=0; AC_SUBST([REPLACE_STPNCPY])
diff --git a/m4/sys_stat_h.m4 b/m4/sys_stat_h.m4
index e8eac71b466..23cbdd28eb2 100644
--- a/m4/sys_stat_h.m4
+++ b/m4/sys_stat_h.m4
@@ -1,4 +1,4 @@
-# sys_stat_h.m4 serial 36 -*- Autoconf -*-
+# sys_stat_h.m4 serial 38 -*- Autoconf -*-
dnl Copyright (C) 2006-2021 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -104,7 +104,9 @@ AC_DEFUN([gl_SYS_STAT_H_DEFAULTS],
REPLACE_LSTAT=0; AC_SUBST([REPLACE_LSTAT])
REPLACE_MKDIR=0; AC_SUBST([REPLACE_MKDIR])
REPLACE_MKFIFO=0; AC_SUBST([REPLACE_MKFIFO])
+ REPLACE_MKFIFOAT=0; AC_SUBST([REPLACE_MKFIFOAT])
REPLACE_MKNOD=0; AC_SUBST([REPLACE_MKNOD])
+ REPLACE_MKNODAT=0; AC_SUBST([REPLACE_MKNODAT])
REPLACE_STAT=0; AC_SUBST([REPLACE_STAT])
REPLACE_UTIMENSAT=0; AC_SUBST([REPLACE_UTIMENSAT])
])
diff --git a/m4/time_h.m4 b/m4/time_h.m4
index 07e6967e45b..b6a1aa3bc0f 100644
--- a/m4/time_h.m4
+++ b/m4/time_h.m4
@@ -2,7 +2,7 @@
# Copyright (C) 2000-2001, 2003-2007, 2009-2021 Free Software Foundation, Inc.
-# serial 13
+# serial 15
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
@@ -25,6 +25,22 @@ AC_DEFUN([gl_HEADER_TIME_H_BODY],
AC_REQUIRE([gl_CHECK_TYPE_STRUCT_TIMESPEC])
AC_REQUIRE([AC_C_RESTRICT])
+
+ AC_CACHE_CHECK([for TIME_UTC in <time.h>],
+ [gl_cv_time_h_has_TIME_UTC],
+ [AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#include <time.h>
+ ]],
+ [[static int x = TIME_UTC; x++;]])],
+ [gl_cv_time_h_has_TIME_UTC=yes],
+ [gl_cv_time_h_has_TIME_UTC=no])])
+ if test $gl_cv_time_h_has_TIME_UTC = yes; then
+ TIME_H_DEFINES_TIME_UTC=1
+ else
+ TIME_H_DEFINES_TIME_UTC=0
+ fi
+ AC_SUBST([TIME_H_DEFINES_TIME_UTC])
])
dnl Check whether 'struct timespec' is declared
@@ -113,6 +129,7 @@ AC_DEFUN([gl_HEADER_TIME_H_DEFAULTS],
GNULIB_STRFTIME=0; AC_SUBST([GNULIB_STRFTIME])
GNULIB_STRPTIME=0; AC_SUBST([GNULIB_STRPTIME])
GNULIB_TIMEGM=0; AC_SUBST([GNULIB_TIMEGM])
+ GNULIB_TIMESPEC_GET=0; AC_SUBST([GNULIB_TIMESPEC_GET])
GNULIB_TIME_R=0; AC_SUBST([GNULIB_TIME_R])
GNULIB_TIME_RZ=0; AC_SUBST([GNULIB_TIME_RZ])
GNULIB_TZSET=0; AC_SUBST([GNULIB_TZSET])
@@ -123,6 +140,7 @@ AC_DEFUN([gl_HEADER_TIME_H_DEFAULTS],
HAVE_NANOSLEEP=1; AC_SUBST([HAVE_NANOSLEEP])
HAVE_STRPTIME=1; AC_SUBST([HAVE_STRPTIME])
HAVE_TIMEGM=1; AC_SUBST([HAVE_TIMEGM])
+ HAVE_TIMESPEC_GET=1; AC_SUBST([HAVE_TIMESPEC_GET])
dnl Even GNU libc does not have timezone_t yet.
HAVE_TIMEZONE_T=0; AC_SUBST([HAVE_TIMEZONE_T])
dnl If another module says to replace or to not replace, do that.
diff --git a/m4/utimensat.m4 b/m4/utimensat.m4
index bdabe24c568..b5bff1651f3 100644
--- a/m4/utimensat.m4
+++ b/m4/utimensat.m4
@@ -1,4 +1,4 @@
-# serial 7
+# serial 9
# See if we need to provide utimensat replacement.
dnl Copyright (C) 2009-2021 Free Software Foundation, Inc.
@@ -12,6 +12,7 @@ AC_DEFUN([gl_FUNC_UTIMENSAT],
[
AC_REQUIRE([gl_SYS_STAT_H_DEFAULTS])
AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS])
+ AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
AC_CHECK_FUNCS_ONCE([utimensat])
if test $ac_cv_func_utimensat = no; then
HAVE_UTIMENSAT=0
@@ -28,10 +29,19 @@ AC_DEFUN([gl_FUNC_UTIMENSAT],
const char *f = "conftest.file";
if (close (creat (f, 0600)))
return 1;
+ /* Test whether a trailing slash is handled correctly.
+ This fails on AIX 7.2. */
+ {
+ struct timespec ts[2];
+ ts[0].tv_sec = 345183300; ts[0].tv_nsec = 0;
+ ts[1] = ts[0];
+ if (utimensat (AT_FDCWD, "conftest.file/", ts, 0) == 0)
+ result |= 2;
+ }
/* Test whether the AT_SYMLINK_NOFOLLOW flag is supported. */
{
if (utimensat (AT_FDCWD, f, NULL, AT_SYMLINK_NOFOLLOW))
- result |= 2;
+ result |= 4;
}
/* Test whether UTIME_NOW and UTIME_OMIT work. */
{
@@ -41,7 +51,7 @@ AC_DEFUN([gl_FUNC_UTIMENSAT],
ts[1].tv_sec = 1;
ts[1].tv_nsec = UTIME_NOW;
if (utimensat (AT_FDCWD, f, ts, 0))
- result |= 4;
+ result |= 8;
}
sleep (1);
{
@@ -52,19 +62,44 @@ AC_DEFUN([gl_FUNC_UTIMENSAT],
ts[1].tv_sec = 1;
ts[1].tv_nsec = UTIME_OMIT;
if (utimensat (AT_FDCWD, f, ts, 0))
- result |= 8;
- if (stat (f, &st))
result |= 16;
- else if (st.st_ctime < st.st_atime)
+ if (stat (f, &st))
result |= 32;
+ else if (st.st_ctime < st.st_atime)
+ result |= 64;
}
return result;
]])],
[gl_cv_func_utimensat_works=yes],
- [gl_cv_func_utimensat_works=no],
- [gl_cv_func_utimensat_works="guessing yes"])])
- if test "$gl_cv_func_utimensat_works" = no; then
- REPLACE_UTIMENSAT=1
- fi
+ [case $? in
+ 2) gl_cv_func_utimensat_works='nearly' ;;
+ *) gl_cv_func_utimensat_works=no ;;
+ esac
+ ],
+ [case "$host_os" in
+ # Guess yes on Linux or glibc systems.
+ linux-* | linux | *-gnu* | gnu*)
+ gl_cv_func_utimensat_works="guessing yes" ;;
+ # Guess 'nearly' on AIX.
+ aix*)
+ gl_cv_func_utimensat_works="guessing nearly" ;;
+ # If we don't know, obey --enable-cross-guesses.
+ *)
+ gl_cv_func_utimensat_works="$gl_cross_guess_normal" ;;
+ esac
+ ])
+ ])
+ case "$gl_cv_func_utimensat_works" in
+ *yes)
+ ;;
+ *nearly)
+ AC_DEFINE([HAVE_NEARLY_WORKING_UTIMENSAT], [1],
+ [Define to 1 if utimensat works, except for the trailing slash handling.])
+ REPLACE_UTIMENSAT=1
+ ;;
+ *)
+ REPLACE_UTIMENSAT=1
+ ;;
+ esac
fi
])
diff --git a/src/alloc.c b/src/alloc.c
index c0a55e61b97..b86ed4ed262 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -6101,11 +6101,13 @@ garbage_collect (void)
gc_in_progress = 0;
- unblock_input ();
-
consing_until_gc = gc_threshold
= consing_threshold (gc_cons_threshold, Vgc_cons_percentage, 0);
+ /* Unblock *after* re-setting `consing_until_gc` in case `unblock_input`
+ signals an error (see bug#43389). */
+ unblock_input ();
+
if (garbage_collection_messages && NILP (Vmemory_full))
{
if (message_p || minibuf_level > 0)
diff --git a/src/cmds.c b/src/cmds.c
index 1547db80e88..c8a96d918cd 100644
--- a/src/cmds.c
+++ b/src/cmds.c
@@ -99,6 +99,7 @@ DEFUN ("forward-line", Fforward_line, Sforward_line, 0, 1, "^p",
Precisely, if point is on line I, move to the start of line I + N
\("start of line" in the logical order).
If there isn't room, go as far as possible (no error).
+Interactively, N is the numeric prefix argument and defaults to 1.
Returns the count of lines left to move. If moving forward,
that is N minus number of lines moved; if backward, N plus number
diff --git a/src/conf_post.h b/src/conf_post.h
index bd56f29e287..176ab28b21a 100644
--- a/src/conf_post.h
+++ b/src/conf_post.h
@@ -71,7 +71,9 @@ typedef bool bool_bf;
It is used only on arguments like cleanup that are handled here.
This macro should be used only in #if expressions, as Oracle
Studio 12.5's __has_attribute does not work in plain code. */
-#ifdef __has_attribute
+#if (defined __has_attribute \
+ && (!defined __clang_minor__ \
+ || 3 < __clang_major__ + (5 <= __clang_minor__)))
# define HAS_ATTRIBUTE(a) __has_attribute (__##a##__)
#else
# define HAS_ATTRIBUTE(a) HAS_ATTR_##a
diff --git a/src/dispextern.h b/src/dispextern.h
index 3ad98b8344e..f4e872644db 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -1826,6 +1826,7 @@ enum face_id
WINDOW_DIVIDER_FIRST_PIXEL_FACE_ID,
WINDOW_DIVIDER_LAST_PIXEL_FACE_ID,
INTERNAL_BORDER_FACE_ID,
+ CHILD_FRAME_BORDER_FACE_ID,
TAB_BAR_FACE_ID,
TAB_LINE_FACE_ID,
BASIC_FACE_ID_SENTINEL
diff --git a/src/editfns.c b/src/editfns.c
index 6f04c998915..e3285494c14 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -52,6 +52,9 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "window.h"
#include "blockinput.h"
+#ifdef WINDOWSNT
+# include "w32common.h"
+#endif
static void update_buffer_properties (ptrdiff_t, ptrdiff_t);
static Lisp_Object styled_format (ptrdiff_t, Lisp_Object *, bool);
@@ -121,12 +124,14 @@ init_editfns (void)
else if (NILP (Vuser_full_name))
Vuser_full_name = build_string ("unknown");
-#ifdef HAVE_SYS_UTSNAME_H
+#if defined HAVE_SYS_UTSNAME_H
{
struct utsname uts;
uname (&uts);
Voperating_system_release = build_string (uts.release);
}
+#elif defined WINDOWSNT
+ Voperating_system_release = build_string (w32_version_string ());
#else
Voperating_system_release = Qnil;
#endif
@@ -4479,7 +4484,9 @@ functions if all the text being accessed has this property. */);
doc: /* The user's name, based upon the real uid only. */);
DEFVAR_LISP ("operating-system-release", Voperating_system_release,
- doc: /* The release of the operating system Emacs is running on. */);
+ doc: /* The kernel version of the operating system on which Emacs is running.
+The value is a string. It can also be nil if Emacs doesn't
+know how to get the kernel version on the underlying OS. */);
DEFVAR_BOOL ("binary-as-unsigned",
binary_as_unsigned,
diff --git a/src/emacs-module.h.in b/src/emacs-module.h.in
index 2989b439109..fe52587c1a5 100644
--- a/src/emacs-module.h.in
+++ b/src/emacs-module.h.in
@@ -51,7 +51,9 @@ information how to write modules and use this header file.
#if 3 < __GNUC__ + (3 <= __GNUC_MINOR__)
# define EMACS_ATTRIBUTE_NONNULL(...) \
__attribute__ ((__nonnull__ (__VA_ARGS__)))
-#elif defined __has_attribute
+#elif (defined __has_attribute \
+ && (!defined __clang_minor__ \
+ || 3 < __clang_major__ + (5 <= __clang_minor__)))
# if __has_attribute (__nonnull__)
# define EMACS_ATTRIBUTE_NONNULL(...) \
__attribute__ ((__nonnull__ (__VA_ARGS__)))
diff --git a/src/emacs.c b/src/emacs.c
index 77114271b27..fd08667f3fd 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -186,7 +186,8 @@ bool build_details;
/* Name for the server started by the daemon.*/
static char *daemon_name;
-/* 0 not a daemon, 1 new-style (foreground), 2 old-style (background). */
+/* 0 not a daemon, 1 new-style (foreground), 2 old-style (background).
+ A negative value means the daemon initialization was already done. */
int daemon_type;
#ifndef WINDOWSNT
@@ -2354,7 +2355,10 @@ all of which are called before Emacs is actually killed. */
int exit_code;
#ifdef HAVE_LIBSYSTEMD
- sd_notify(0, "STOPPING=1");
+ /* Notify systemd we are shutting down, but only if we have notified
+ it about startup. */
+ if (daemon_type == -1)
+ sd_notify(0, "STOPPING=1");
#endif /* HAVE_LIBSYSTEMD */
/* Fsignal calls emacs_abort () if it sees that waiting_for_input is
@@ -2866,7 +2870,7 @@ from the parent process and its tty file descriptors. */)
}
/* Set it to an invalid value so we know we've already run this function. */
- daemon_type = -1;
+ daemon_type = -daemon_type;
#else /* WINDOWSNT */
/* Signal the waiting emacsclient process. */
diff --git a/src/fns.c b/src/fns.c
index 7ab2e8f1a03..bd4afa0c4e9 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -4599,33 +4599,29 @@ sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p)
EMACS_UINT
hash_string (char const *ptr, ptrdiff_t len)
{
- EMACS_UINT const *p = (EMACS_UINT const *) ptr;
- EMACS_UINT const *end = (EMACS_UINT const *) (ptr + len);
+ char const *p = ptr;
+ char const *end = ptr + len;
EMACS_UINT hash = len;
/* At most 8 steps. We could reuse SXHASH_MAX_LEN, of course,
* but dividing by 8 is cheaper. */
- ptrdiff_t step = 1 + ((end - p) >> 3);
+ ptrdiff_t step = sizeof hash + ((end - p) >> 3);
- /* Beware: `end` might be unaligned, so `p < end` is not always the same
- * as `p <= end - 1`. */
- while (p <= end - 1)
+ while (p + sizeof hash <= end)
{
- EMACS_UINT c = *p;
+ EMACS_UINT c;
+ /* We presume that the compiler will replace this `memcpy` with
+ a single load/move instruction when applicable. */
+ memcpy (&c, p, sizeof hash);
p += step;
hash = sxhash_combine (hash, c);
}
- if (p < end)
- { /* A few last bytes remain (smaller than an EMACS_UINT). */
- /* FIXME: We could do this without a loop, but it'd require
- endian-dependent code :-( */
- char const *p1 = (char const *)p;
- char const *end1 = (char const *)end;
- do
- {
- unsigned char c = *p1++;
- hash = sxhash_combine (hash, c);
- }
- while (p1 < end1);
+ /* A few last bytes may remain (smaller than an EMACS_UINT). */
+ /* FIXME: We could do this without a loop, but it'd require
+ endian-dependent code :-( */
+ while (p < end)
+ {
+ unsigned char c = *p++;
+ hash = sxhash_combine (hash, c);
}
return hash;
diff --git a/src/frame.c b/src/frame.c
index 599c4075f88..a2167ce1e49 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -3543,6 +3543,13 @@ DEFUN ("frame-fringe-width", Ffringe_width, Sfringe_width, 0, 1, 0,
return make_fixnum (FRAME_TOTAL_FRINGE_WIDTH (decode_any_frame (frame)));
}
+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. */)
+ (Lisp_Object frame)
+{
+ 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,
doc: /* Return width of FRAME's internal border in pixels. */)
(Lisp_Object frame)
@@ -3759,6 +3766,7 @@ static const struct frame_parm_table frame_parms[] =
{"foreground-color", -1},
{"icon-name", SYMBOL_INDEX (Qicon_name)},
{"icon-type", SYMBOL_INDEX (Qicon_type)},
+ {"child-frame-border-width", SYMBOL_INDEX (Qchild_frame_border_width)},
{"internal-border-width", SYMBOL_INDEX (Qinternal_border_width)},
{"right-divider-width", SYMBOL_INDEX (Qright_divider_width)},
{"bottom-divider-width", SYMBOL_INDEX (Qbottom_divider_width)},
@@ -4302,6 +4310,8 @@ 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)));
store_in_alist (alistptr, Qinternal_border_width,
make_fixnum (FRAME_INTERNAL_BORDER_WIDTH (f)));
store_in_alist (alistptr, Qright_divider_width,
@@ -5999,6 +6009,7 @@ syms_of_frame (void)
DEFSYM (Qhorizontal_scroll_bars, "horizontal-scroll-bars");
DEFSYM (Qicon_name, "icon-name");
DEFSYM (Qicon_type, "icon-type");
+ DEFSYM (Qchild_frame_border_width, "child-frame-border-width");
DEFSYM (Qinternal_border_width, "internal-border-width");
DEFSYM (Qleft_fringe, "left-fringe");
DEFSYM (Qline_spacing, "line-spacing");
@@ -6423,6 +6434,7 @@ iconify the top level frame instead. */);
defsubr (&Sscroll_bar_width);
defsubr (&Sscroll_bar_height);
defsubr (&Sfringe_width);
+ defsubr (&Sframe_child_frame_border_width);
defsubr (&Sframe_internal_border_width);
defsubr (&Sright_divider_width);
defsubr (&Sbottom_divider_width);
diff --git a/src/frame.h b/src/frame.h
index 8cf41dc0046..21148fe94c9 100644
--- a/src/frame.h
+++ b/src/frame.h
@@ -534,6 +534,10 @@ struct frame
/* Border width of the frame window as known by the (X) window system. */
int border_width;
+ /* Width of child frames' internal border. Acts as
+ internal_border_width for child frames. */
+ int child_frame_border_width;
+
/* Width of the internal border. This is a line of background color
just inside the window's border. When the frame is selected,
a highlighting is displayed inside the internal border. */
@@ -1432,11 +1436,27 @@ FRAME_TOTAL_FRINGE_WIDTH (struct frame *f)
return FRAME_LEFT_FRINGE_WIDTH (f) + FRAME_RIGHT_FRINGE_WIDTH (f);
}
-/* Pixel-width of internal border lines. */
+INLINE int
+FRAME_CHILD_FRAME_BORDER_WIDTH (struct frame *f)
+{
+ return frame_dimension (f->child_frame_border_width);
+}
+
+/* Pixel-width of internal border. Uses child_frame_border_width for
+ child frames if possible, and falls back on internal_border_width
+ otherwise. */
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);
+#else
return frame_dimension (f->internal_border_width);
+#endif
}
/* Pixel-size of window divider lines. */
@@ -1687,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/macros.c b/src/macros.c
index c8ce94e63b1..60d0766a754 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 5df10453739..949c3d989d5 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 ae114f83e4d..c383e2f7ecf 100644
--- a/src/nsfns.m
+++ b/src/nsfns.m
@@ -687,6 +687,21 @@ 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);
+
+ if (new_width == old_width)
+ return;
+ f->child_frame_border_width = new_width;
+
+ if (FRAME_NATIVE_WINDOW (f) != 0)
+ adjust_frame_size (f, -1, -1, 3, 0, Qchild_frame_border_width);
+
+ SET_FRAME_GARBAGED (f);
+}
static void
ns_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
@@ -912,6 +927,7 @@ frame_parm_handler ns_frame_parm_handlers[] =
ns_set_foreground_color,
ns_set_icon_name,
ns_set_icon_type,
+ ns_set_child_frame_border_width,
ns_set_internal_border_width,
gui_set_right_divider_width, /* generic OK */
gui_set_bottom_divider_width, /* generic OK */
@@ -1197,6 +1213,9 @@ 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),
+ "childFrameBorderWidth", "childFrameBorderWidth",
+ 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),
@@ -1487,7 +1506,6 @@ Some window managers may refuse to restack windows. */)
{
EmacsWindow *window = (EmacsWindow *)[FRAME_NS_VIEW (f1) window];
NSWindow *window2 = [FRAME_NS_VIEW (f2) window];
- BOOL flag = !NILP (above);
if ([window restackWindow:window2 above:!NILP (above)])
return Qt;
diff --git a/src/nsmenu.m b/src/nsmenu.m
index 8086f56854e..24aa5a0ac11 100644
--- a/src/nsmenu.m
+++ b/src/nsmenu.m
@@ -101,7 +101,6 @@ popup_activated (void)
static void
ns_update_menubar (struct frame *f, bool deep_p)
{
- NSAutoreleasePool *pool;
BOOL needsSet = NO;
id menu = [NSApp mainMenu];
bool owfi;
@@ -406,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);
}
@@ -1796,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/nsterm.m b/src/nsterm.m
index c5815ce8d10..1b2328628ee 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -272,7 +272,9 @@ long context_menu_value = 0;
/* display update */
static struct frame *ns_updating_frame;
+#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400
static NSView *focus_view = NULL;
+#endif
static int ns_window_num = 0;
static BOOL gsaved = NO;
static BOOL ns_fake_keydown = NO;
@@ -1139,7 +1141,9 @@ ns_update_end (struct frame *f)
external (RIF) call; for whole frame, called after gui_update_window_end
-------------------------------------------------------------------------- */
{
+#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400
EmacsView *view = FRAME_NS_VIEW (f);
+#endif
NSTRACE_WHEN (NSTRACE_GROUP_UPDATES, "ns_update_end");
@@ -1449,7 +1453,7 @@ ns_ring_bell (struct frame *f)
}
}
-
+#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400
static void
hide_bell (void)
/* --------------------------------------------------------------------------
@@ -1463,6 +1467,7 @@ hide_bell (void)
[bell_view remove];
}
}
+#endif
/* ==========================================================================
@@ -2876,6 +2881,8 @@ ns_get_shifted_character (NSEvent *event)
========================================================================== */
+#if 0
+/* FIXME: Remove this function. */
static void
ns_redraw_scroll_bars (struct frame *f)
{
@@ -2890,6 +2897,7 @@ ns_redraw_scroll_bars (struct frame *f)
[view display];
}
}
+#endif
void
@@ -3029,9 +3037,13 @@ ns_clear_under_internal_border (struct frame *f)
NSRectEdge edge[] = {NSMinXEdge, NSMinYEdge, NSMaxXEdge, NSMaxYEdge};
int face_id =
- !NILP (Vface_remapping_alist)
- ? lookup_basic_face (NULL, f, INTERNAL_BORDER_FACE_ID)
- : INTERNAL_BORDER_FACE_ID;
+ (FRAME_PARENT_FRAME (f)
+ ? (!NILP (Vface_remapping_alist)
+ ? lookup_basic_face (NULL, f, CHILD_FRAME_BORDER_FACE_ID)
+ : CHILD_FRAME_BORDER_FACE_ID)
+ : (!NILP (Vface_remapping_alist)
+ ? lookup_basic_face (NULL, f, INTERNAL_BORDER_FACE_ID)
+ : INTERNAL_BORDER_FACE_ID));
struct face *face = FACE_FROM_ID_OR_NULL (f, face_id);
if (!face)
@@ -8399,21 +8411,23 @@ not_in_argv (NSString *arg)
void *pixels = CGBitmapContextGetData (context);
int rowSize = CGBitmapContextGetBytesPerRow (context);
int srcRowSize = NSWidth (srcRect) * scale * bpp;
- void *srcPixels = pixels + (int)(NSMinY (srcRect) * scale * rowSize
- + NSMinX (srcRect) * scale * bpp);
- void *dstPixels = pixels + (int)(NSMinY (dstRect) * scale * rowSize
- + NSMinX (dstRect) * scale * bpp);
+ void *srcPixels = (char *) pixels
+ + (int) (NSMinY (srcRect) * scale * rowSize
+ + NSMinX (srcRect) * scale * bpp);
+ void *dstPixels = (char *) pixels
+ + (int) (NSMinY (dstRect) * scale * rowSize
+ + NSMinX (dstRect) * scale * bpp);
if (NSIntersectsRect (srcRect, dstRect)
&& NSMinY (srcRect) < NSMinY (dstRect))
for (int y = NSHeight (srcRect) * scale - 1 ; y >= 0 ; y--)
- memmove (dstPixels + y * rowSize,
- srcPixels + y * rowSize,
+ memmove ((char *) dstPixels + y * rowSize,
+ (char *) srcPixels + y * rowSize,
srcRowSize);
else
for (int y = 0 ; y < NSHeight (srcRect) * scale ; y++)
- memmove (dstPixels + y * rowSize,
- srcPixels + y * rowSize,
+ memmove ((char *) dstPixels + y * rowSize,
+ (char *) srcPixels + y * rowSize,
srcRowSize);
#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
@@ -8742,7 +8756,8 @@ not_in_argv (NSString *arg)
/* The array returned by [NSWindow parentWindow] may already be
sorted, but the documentation doesn't tell us whether or not it is,
so to be safe we'll sort it. */
-NSInteger nswindow_orderedIndex_sort (id w1, id w2, void *c)
+static NSInteger
+nswindow_orderedIndex_sort (id w1, id w2, void *c)
{
NSInteger i1 = [w1 orderedIndex];
NSInteger i2 = [w2 orderedIndex];
diff --git a/src/process.c b/src/process.c
index 57105982c15..3beb9cf7146 100644
--- a/src/process.c
+++ b/src/process.c
@@ -290,7 +290,9 @@ static int child_signal_read_fd = -1;
status changes. */
static int child_signal_write_fd = -1;
static void child_signal_init (void);
+#ifndef WINDOWSNT
static void child_signal_read (int, void *);
+#endif
static void child_signal_notify (void);
/* Indexed by descriptor, gives the process (if any) for that descriptor. */
@@ -7148,8 +7150,23 @@ process has been transmitted to the serial port. */)
have the same process ID.
To avoid a deadlock when receiving SIGCHLD while
- `wait_reading_process_output' is in `pselect', the SIGCHLD handler
- will notify the `pselect' using a pipe. */
+ 'wait_reading_process_output' is in 'pselect', the SIGCHLD handler
+ will notify the `pselect' using a self-pipe. The deadlock could
+ occur if SIGCHLD is delivered outside of the 'pselect' call, in
+ which case 'pselect' will not be interrupted by the signal, and
+ will therefore wait on the process's output descriptor for the
+ output that will never come.
+
+ WINDOWSNT doesn't need this facility because its 'pselect'
+ emulation (see 'sys_select' in w32proc.c) waits on a subprocess
+ handle, which becomes signaled when the process exits, and also
+ because that emulation delays the delivery of the simulated SIGCHLD
+ until all the output from the subprocess has been consumed. */
+
+/* FIXME: On Unix-like systems that have a proper 'pselect'
+ (HAVE_PSELECT), we should block SIGCHLD in
+ 'wait_reading_process_output' and pass a non-NULL signal mask to
+ 'pselect' to avoid the need for the self-pipe. */
/* Set up `child_signal_read_fd' and `child_signal_write_fd'. */
@@ -7159,6 +7176,7 @@ child_signal_init (void)
/* Either both are initialized, or both are uninitialized. */
eassert ((child_signal_read_fd < 0) == (child_signal_write_fd < 0));
+#ifndef WINDOWSNT
if (0 <= child_signal_read_fd)
return; /* already done */
@@ -7181,12 +7199,16 @@ child_signal_init (void)
eassert (0 <= fds[1]);
if (fcntl (fds[0], F_SETFL, O_NONBLOCK) != 0)
emacs_perror ("fcntl");
+ if (fcntl (fds[1], F_SETFL, O_NONBLOCK) != 0)
+ emacs_perror ("fcntl");
add_read_fd (fds[0], child_signal_read, NULL);
fd_callback_info[fds[0]].flags &= ~KEYBOARD_FD;
child_signal_read_fd = fds[0];
child_signal_write_fd = fds[1];
+#endif /* !WINDOWSNT */
}
+#ifndef WINDOWSNT
/* Consume a process status change. */
static void
@@ -7195,9 +7217,10 @@ child_signal_read (int fd, void *data)
eassert (0 <= fd);
eassert (fd == child_signal_read_fd);
char dummy;
- if (emacs_read (fd, &dummy, 1) < 0)
+ if (emacs_read (fd, &dummy, 1) < 0 && errno != EAGAIN)
emacs_perror ("reading from child signal FD");
}
+#endif /* !WINDOWSNT */
/* Notify `wait_reading_process_output' of a process status
change. */
@@ -7205,11 +7228,13 @@ child_signal_read (int fd, void *data)
static void
child_signal_notify (void)
{
+#ifndef WINDOWSNT
int fd = child_signal_write_fd;
eassert (0 <= fd);
char dummy = 0;
if (emacs_write (fd, &dummy, 1) != 1)
emacs_perror ("writing to child signal FD");
+#endif
}
/* LIB_CHILD_HANDLER is a SIGCHLD handler that Emacs calls while doing
diff --git a/src/term.c b/src/term.c
index 2e2ab2bf438..1059b0669a7 100644
--- a/src/term.c
+++ b/src/term.c
@@ -790,7 +790,7 @@ tty_write_glyphs (struct frame *f, struct glyph *string, int len)
cmcheckmagic (tty);
}
-#ifdef HAVE_GPM /* Only used by GPM code. */
+#ifndef DOS_NT
static void
tty_write_glyphs_with_face (register struct frame *f, register struct glyph *string,
@@ -847,6 +847,7 @@ tty_write_glyphs_with_face (register struct frame *f, register struct glyph *str
cmcheckmagic (tty);
}
+
#endif
/* An implementation of insert_glyphs for termcap frames. */
@@ -2380,23 +2381,9 @@ frame's terminal). */)
Mouse
***********************************************************************/
-#ifdef HAVE_GPM
-
-void
-term_mouse_moveto (int x, int y)
-{
- /* TODO: how to set mouse position?
- const char *name;
- int fd;
- name = (const char *) ttyname (0);
- fd = emacs_open (name, O_WRONLY, 0);
- SOME_FUNCTION (x, y, fd);
- emacs_close (fd);
- last_mouse_x = x;
- last_mouse_y = y; */
-}
+#ifndef DOS_NT
-/* Implementation of draw_row_with_mouse_face for TTY/GPM. */
+/* Implementation of draw_row_with_mouse_face for TTY/GPM and macOS. */
void
tty_draw_row_with_mouse_face (struct window *w, struct glyph_row *row,
int start_hpos, int end_hpos,
@@ -2428,6 +2415,24 @@ tty_draw_row_with_mouse_face (struct window *w, struct glyph_row *row,
cursor_to (f, save_y, save_x);
}
+#endif
+
+#ifdef HAVE_GPM
+
+void
+term_mouse_moveto (int x, int y)
+{
+ /* TODO: how to set mouse position?
+ const char *name;
+ int fd;
+ name = (const char *) ttyname (0);
+ fd = emacs_open (name, O_WRONLY, 0);
+ SOME_FUNCTION (x, y, fd);
+ emacs_close (fd);
+ last_mouse_x = x;
+ last_mouse_y = y; */
+}
+
/* Return the current time, as a Time value. Wrap around on overflow. */
static Time
current_Time (void)
diff --git a/src/w32common.h b/src/w32common.h
index 94bb457e59d..714a2386a68 100644
--- a/src/w32common.h
+++ b/src/w32common.h
@@ -50,6 +50,11 @@ extern int os_subtype;
/* Cache system info, e.g., the NT page size. */
extern void cache_system_info (void);
+#ifdef WINDOWSNT
+/* Return a static buffer with the MS-Windows version string. */
+extern char * w32_version_string (void);
+#endif
+
typedef void (* VOIDFNPTR) (void);
/* Load a function address from a DLL. Cast the result via VOIDFNPTR
diff --git a/src/w32fns.c b/src/w32fns.c
index c1e18ff7fad..5704f1d3c33 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -1519,9 +1519,13 @@ w32_clear_under_internal_border (struct frame *f)
int width = FRAME_PIXEL_WIDTH (f);
int height = FRAME_PIXEL_HEIGHT (f);
int face_id =
- !NILP (Vface_remapping_alist)
- ? lookup_basic_face (NULL, f, INTERNAL_BORDER_FACE_ID)
- : INTERNAL_BORDER_FACE_ID;
+ (FRAME_PARENT_FRAME (f)
+ ? (!NILP (Vface_remapping_alist)
+ ? lookup_basic_face (NULL, f, CHILD_FRAME_BORDER_FACE_ID)
+ : CHILD_FRAME_BORDER_FACE_ID)
+ : (!NILP (Vface_remapping_alist)
+ ? lookup_basic_face (NULL, f, INTERNAL_BORDER_FACE_ID)
+ : INTERNAL_BORDER_FACE_ID));
struct face *face = FACE_FROM_ID_OR_NULL (f, face_id);
block_input ();
@@ -1548,6 +1552,32 @@ w32_clear_under_internal_border (struct frame *f)
}
}
+/**
+ * w32_set_child_frame_border_width:
+ *
+ * Set width of child frame F's internal border to ARG pixels.
+ * ARG < 0 is treated like ARG = 0.
+ */
+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);
+
+ if (border != FRAME_CHILD_FRAME_BORDER_WIDTH (f))
+ {
+ f->child_frame_border_width = border;
+
+ if (FRAME_NATIVE_WINDOW (f) != 0)
+ {
+ adjust_frame_size (f, -1, -1, 3, false, Qchild_frame_border_width);
+
+ if (FRAME_VISIBLE_P (f))
+ w32_clear_under_internal_border (f);
+ }
+ }
+}
+
/**
* w32_set_internal_border_width:
@@ -1607,7 +1637,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. */
@@ -5873,6 +5903,28 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
parameters);
}
+ /* 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",
+ RES_TYPE_NUMBER);
+ 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
+ "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),
@@ -9428,6 +9480,18 @@ cache_system_info (void)
w32_num_mouse_buttons = GetSystemMetrics (SM_CMOUSEBUTTONS);
}
+#ifdef WINDOWSNT
+char *
+w32_version_string (void)
+{
+ /* NNN.NNN.NNNNNNNNNN */
+ static char version_string[3 + 1 + 3 + 1 + 10 + 1];
+ _snprintf (version_string, sizeof version_string, "%d.%d.%d",
+ w32_major_version, w32_minor_version, w32_build_number);
+ return version_string;
+}
+#endif
+
#ifdef EMACSDEBUG
void
_DebPrint (const char *fmt, ...)
@@ -10232,6 +10296,7 @@ frame_parm_handler w32_frame_parm_handlers[] =
w32_set_foreground_color,
w32_set_icon_name,
w32_set_icon_type,
+ w32_set_child_frame_border_width,
w32_set_internal_border_width,
gui_set_right_divider_width,
gui_set_bottom_divider_width,
diff --git a/src/w32menu.c b/src/w32menu.c
index 8bf0c462030..3bf76663947 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/w32term.c b/src/w32term.c
index 109aa58d732..0ee805a8526 100644
--- a/src/w32term.c
+++ b/src/w32term.c
@@ -2404,14 +2404,29 @@ w32_draw_stretch_glyph_string (struct glyph_string *s)
else if (!s->background_filled_p)
{
int background_width = s->background_width;
- int x = s->x, left_x = window_box_left_offset (s->w, TEXT_AREA);
+ int x = s->x, text_left_x = window_box_left_offset (s->w, TEXT_AREA);
- /* Don't draw into left margin, fringe or scrollbar area
- except for header line and mode line. */
- if (x < left_x && !s->row->mode_line_p)
+ /* Don't draw into left fringe or scrollbar area except for
+ header line and mode line. */
+ if (x < text_left_x && !s->row->mode_line_p)
{
- background_width -= left_x - x;
- x = left_x;
+ int left_x = WINDOW_LEFT_SCROLL_BAR_AREA_WIDTH (s->w);
+ int right_x = text_left_x;
+
+ if (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (s->w))
+ left_x += WINDOW_LEFT_FRINGE_WIDTH (s->w);
+ else
+ right_x -= WINDOW_LEFT_FRINGE_WIDTH (s->w);
+
+ /* Adjust X and BACKGROUND_WIDTH to fit inside the space
+ between LEFT_X and RIGHT_X. */
+ if (x < left_x)
+ {
+ background_width -= left_x - x;
+ x = left_x;
+ }
+ if (x + background_width > right_x)
+ background_width = right_x - x;
}
if (background_width > 0)
w32_draw_glyph_string_bg_rect (s, x, s->y, background_width, s->height);
diff --git a/src/window.c b/src/window.c
index e025e0b0821..eb16e2a4338 100644
--- a/src/window.c
+++ b/src/window.c
@@ -2260,7 +2260,7 @@ return value is a list of elements of the form (PARAMETER . VALUE). */)
Lisp_Object
window_parameter (struct window *w, Lisp_Object parameter)
{
- Lisp_Object result = Fassq (parameter, w->window_parameters);
+ Lisp_Object result = assq_no_quit (parameter, w->window_parameters);
return CDR_SAFE (result);
}
diff --git a/src/xdisp.c b/src/xdisp.c
index 32e9773b54e..32b359098aa 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -12876,7 +12876,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
@@ -29813,7 +29813,8 @@ produce_stretch_glyph (struct it *it)
#endif /* HAVE_WINDOW_SYSTEM */
height = 1;
- if (width > 0 && it->line_wrap != TRUNCATE
+ if (width > 0
+ && it->area == TEXT_AREA && it->line_wrap != TRUNCATE
&& it->current_x + width > it->last_visible_x)
{
width = it->last_visible_x - it->current_x;
@@ -31927,9 +31928,8 @@ draw_row_with_mouse_face (struct window *w, int start_x, struct glyph_row *row,
return;
}
#endif
-#if defined (HAVE_GPM) || defined (MSDOS) || defined (WINDOWSNT)
+
tty_draw_row_with_mouse_face (w, row, start_hpos, end_hpos, draw);
-#endif
}
/* Display the active region described by mouse_face_* according to DRAW. */
diff --git a/src/xfaces.c b/src/xfaces.c
index 258b365eda3..12087138e51 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -4914,6 +4914,7 @@ lookup_basic_face (struct window *w, struct frame *f, int face_id)
case WINDOW_DIVIDER_FIRST_PIXEL_FACE_ID: name = Qwindow_divider_first_pixel; break;
case WINDOW_DIVIDER_LAST_PIXEL_FACE_ID: name = Qwindow_divider_last_pixel; break;
case INTERNAL_BORDER_FACE_ID: name = Qinternal_border; break;
+ case CHILD_FRAME_BORDER_FACE_ID: name = Qchild_frame_border; break;
default:
emacs_abort (); /* the caller is supposed to pass us a basic face id */
@@ -5620,6 +5621,7 @@ realize_basic_faces (struct frame *f)
realize_named_face (f, Qwindow_divider_last_pixel,
WINDOW_DIVIDER_LAST_PIXEL_FACE_ID);
realize_named_face (f, Qinternal_border, INTERNAL_BORDER_FACE_ID);
+ realize_named_face (f, Qchild_frame_border, CHILD_FRAME_BORDER_FACE_ID);
realize_named_face (f, Qtab_bar, TAB_BAR_FACE_ID);
realize_named_face (f, Qtab_line, TAB_LINE_FACE_ID);
@@ -6973,6 +6975,7 @@ syms_of_xfaces (void)
DEFSYM (Qwindow_divider_first_pixel, "window-divider-first-pixel");
DEFSYM (Qwindow_divider_last_pixel, "window-divider-last-pixel");
DEFSYM (Qinternal_border, "internal-border");
+ DEFSYM (Qchild_frame_border, "child-frame-border");
/* TTY color-related functions (defined in tty-colors.el). */
DEFSYM (Qtty_color_desc, "tty-color-desc");
diff --git a/src/xfns.c b/src/xfns.c
index 9ab537ca8d9..cac41ee4856 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -1800,6 +1800,28 @@ x_change_tool_bar_height (struct frame *f, int height)
#endif /* USE_GTK */
}
+static void
+x_set_child_frame_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
+{
+ int border = check_int_nonnegative (arg);
+
+ if (border != FRAME_CHILD_FRAME_BORDER_WIDTH (f))
+ {
+ f->child_frame_border_width = border;
+
+#ifdef USE_X_TOOLKIT
+ if (FRAME_X_OUTPUT (f)->edit_widget)
+ widget_store_internal_border (FRAME_X_OUTPUT (f)->edit_widget);
+#endif
+
+ if (FRAME_X_WINDOW (f))
+ {
+ adjust_frame_size (f, -1, -1, 3, false, Qchild_frame_border_width);
+ x_clear_under_internal_border (f);
+ }
+ }
+
+}
static void
x_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
@@ -3897,6 +3919,29 @@ This function is an internal primitive--use `make-frame' instead. */)
parms = Fcons (Fcons (Qinternal_border_width, value),
parms);
}
+
+ /* 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",
+ 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
+ "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),
@@ -7762,6 +7807,7 @@ frame_parm_handler x_frame_parm_handlers[] =
x_set_foreground_color,
x_set_icon_name,
x_set_icon_type,
+ x_set_child_frame_border_width,
x_set_internal_border_width,
gui_set_right_divider_width,
gui_set_bottom_divider_width,
diff --git a/src/xmenu.c b/src/xmenu.c
index ea3813a64e2..a83fffbf1ce 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/src/xterm.c b/src/xterm.c
index b8374fed8b1..744b80c68a0 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -1293,9 +1293,13 @@ x_clear_under_internal_border (struct frame *f)
int height = FRAME_PIXEL_HEIGHT (f);
int margin = FRAME_TOP_MARGIN_HEIGHT (f);
int face_id =
- !NILP (Vface_remapping_alist)
- ? lookup_basic_face (NULL, f, INTERNAL_BORDER_FACE_ID)
- : INTERNAL_BORDER_FACE_ID;
+ (FRAME_PARENT_FRAME (f)
+ ? (!NILP (Vface_remapping_alist)
+ ? lookup_basic_face (NULL, f, CHILD_FRAME_BORDER_FACE_ID)
+ : CHILD_FRAME_BORDER_FACE_ID)
+ : (!NILP (Vface_remapping_alist)
+ ? lookup_basic_face (NULL, f, INTERNAL_BORDER_FACE_ID)
+ : INTERNAL_BORDER_FACE_ID));
struct face *face = FACE_FROM_ID_OR_NULL (f, face_id);
block_input ();
@@ -1360,9 +1364,13 @@ x_after_update_window_line (struct window *w, struct glyph_row *desired_row)
{
int y = WINDOW_TO_FRAME_PIXEL_Y (w, max (0, desired_row->y));
int face_id =
- !NILP (Vface_remapping_alist)
- ? lookup_basic_face (NULL, f, INTERNAL_BORDER_FACE_ID)
- : INTERNAL_BORDER_FACE_ID;
+ (FRAME_PARENT_FRAME (f)
+ ? (!NILP (Vface_remapping_alist)
+ ? lookup_basic_face (NULL, f, CHILD_FRAME_BORDER_FACE_ID)
+ : CHILD_FRAME_BORDER_FACE_ID)
+ : (!NILP (Vface_remapping_alist)
+ ? lookup_basic_face (NULL, f, INTERNAL_BORDER_FACE_ID)
+ : INTERNAL_BORDER_FACE_ID));
struct face *face = FACE_FROM_ID_OR_NULL (f, face_id);
block_input ();
@@ -3577,14 +3585,29 @@ x_draw_stretch_glyph_string (struct glyph_string *s)
else if (!s->background_filled_p)
{
int background_width = s->background_width;
- int x = s->x, left_x = window_box_left_offset (s->w, TEXT_AREA);
+ int x = s->x, text_left_x = window_box_left_offset (s->w, TEXT_AREA);
- /* Don't draw into left margin, fringe or scrollbar area
- except for header line and mode line. */
- if (x < left_x && !s->row->mode_line_p)
+ /* Don't draw into left fringe or scrollbar area except for
+ header line and mode line. */
+ if (x < text_left_x && !s->row->mode_line_p)
{
- background_width -= left_x - x;
- x = left_x;
+ int left_x = WINDOW_LEFT_SCROLL_BAR_AREA_WIDTH (s->w);
+ int right_x = text_left_x;
+
+ if (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (s->w))
+ left_x += WINDOW_LEFT_FRINGE_WIDTH (s->w);
+ else
+ right_x -= WINDOW_LEFT_FRINGE_WIDTH (s->w);
+
+ /* Adjust X and BACKGROUND_WIDTH to fit inside the space
+ between LEFT_X and RIGHT_X. */
+ if (x < left_x)
+ {
+ background_width -= left_x - x;
+ x = left_x;
+ }
+ if (x + background_width > right_x)
+ background_width = right_x - x;
}
if (background_width > 0)
x_draw_glyph_string_bg_rect (s, x, s->y, background_width, s->height);
diff --git a/test/Makefile.in b/test/Makefile.in
index c5e86df3761..f907602a622 100644
--- a/test/Makefile.in
+++ b/test/Makefile.in
@@ -122,8 +122,9 @@ MODULES_EMACSOPT :=
endif
# The actual Emacs command run in the targets below.
-# Prevent any setting of EMACSLOADPATH in user environment causing problems.
-emacs = EMACSLOADPATH= \
+# Prevent any setting of EMACSLOADPATH in user environment causing problems,
+# and prevent locals to influence the text of the errors we expect to receive.
+emacs = LANG=C EMACSLOADPATH= \
EMACS_TEST_DIRECTORY=$(abspath $(srcdir)) \
$(GDB) "$(EMACS)" $(MODULES_EMACSOPT) $(EMACSOPT)
diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml
index ddabacfe010..5a0ab54e4b9 100644
--- a/test/infra/gitlab-ci.yml
+++ b/test/infra/gitlab-ci.yml
@@ -72,6 +72,7 @@ default:
- lisp/**/*.el
- src/*.{h,c}
- test/infra/*
+ - test/lib-src/*.el
- test/lisp/**/*.el
- test/src/*.el
- changes:
@@ -100,7 +101,8 @@ default:
script:
- docker pull ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG}
# TODO: with make -j4 several of the tests were failing, for example shadowfile-tests, but passed without it
- - docker run -i --rm -e EMACS_EMBA_CI=${EMACS_EMBA_CI} ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} make ${make_params}
+ - 'export PWD=$(pwd)'
+ - 'docker run -i --rm -e EMACS_EMBA_CI=${EMACS_EMBA_CI} --volumes-from $(docker ps -q -f "label=com.gitlab.gitlab-runner.job.id=${CI_JOB_ID}"):ro ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} /bin/bash -c "git fetch ${PWD} HEAD && echo checking out these updated files && git diff --name-only FETCH_HEAD && ( git diff --name-only FETCH_HEAD | xargs git checkout -f FETCH_HEAD ) && make -j4 && make ${make_params}"'
.build-template:
rules:
diff --git a/test/lisp/autorevert-tests.el b/test/lisp/autorevert-tests.el
index 6da515bb2c8..45cf6353960 100644
--- a/test/lisp/autorevert-tests.el
+++ b/test/lisp/autorevert-tests.el
@@ -524,8 +524,10 @@ This expects `auto-revert--messages' to be bound by
(auto-revert-test--write-file "1-b" file-1)
(auto-revert-test--wait-for-buffer-text
buf-1 "1-b" (auto-revert--timeout))
- (should (buffer-local-value
- 'auto-revert-notify-watch-descriptor buf-1))
+ ;; On emba, `buf-1' is a killed buffer.
+ (when (buffer-live-p buf-1)
+ (should (buffer-local-value
+ 'auto-revert-notify-watch-descriptor buf-1)))
;; Write a buffer to a new file, then modify the new file on disk.
(with-current-buffer buf-2
@@ -607,11 +609,12 @@ This expects `auto-revert--messages' to be bound by
(should auto-revert-mode))
(dotimes (i num-buffers)
- (add-to-list
- 'buffers
- (make-indirect-buffer
- (car buffers) (format "%s-%d" (buffer-file-name (car buffers)) i) 'clone)
- 'append))
+ (push (make-indirect-buffer
+ (car buffers)
+ (format "%s-%d" (buffer-file-name (car buffers)) i)
+ 'clone)
+ buffers))
+ (setq buffers (nreverse buffers))
(dolist (buf buffers)
(with-current-buffer buf
(should (string-equal (buffer-string) "any text"))
@@ -638,10 +641,10 @@ This expects `auto-revert--messages' to be bound by
(auto-revert-tests--write-file "any text" tmpfile (pop times))
(dotimes (i num-buffers)
- (add-to-list
- 'buffers
- (generate-new-buffer (format "%s-%d" (file-name-nondirectory tmpfile) i))
- 'append))
+ (push (generate-new-buffer
+ (format "%s-%d" (file-name-nondirectory tmpfile) i))
+ buffers))
+ (setq buffers (nreverse buffers))
(dolist (buf buffers)
(with-current-buffer buf
(insert-file-contents tmpfile 'visit)
diff --git a/test/lisp/electric-tests.el b/test/lisp/electric-tests.el
index 1b7beeaa366..62a42b7fe44 100644
--- a/test/lisp/electric-tests.el
+++ b/test/lisp/electric-tests.el
@@ -1,4 +1,4 @@
-;;; electric-tests.el --- tests for electric.el
+;;; electric-tests.el --- tests for electric.el -*- lexical-binding: t; -*-
;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
@@ -135,9 +135,11 @@ The buffer's contents should %s:
(length fixture)
fixture
(if fixture-fn (format "\nNow call this:\n\n%s"
- (pp-to-string fixture-fn)) "")
+ (pp-to-string fixture-fn))
+ "")
(if bindings (format "\nEnsure the following bindings:\n\n%s"
- (pp-to-string bindings)) "")
+ (pp-to-string bindings))
+ "")
char
(if (string= fixture expected-string) "stay" "become")
(replace-regexp-in-string "\n" "\\\\n" expected-string)
@@ -163,8 +165,11 @@ The buffer's contents should %s:
(test-in-comments t)
(test-in-strings t)
(test-in-code t)
- (fixture-fn #'(lambda ()
- (electric-pair-mode 1))))
+ ;; The semantics of CL's defmacro "default values" is subtle:
+ ;; contrary to the actual arguments, these are evaluated (and
+ ;; are expected to return the "default form").
+ ;; `fixture-fn' contains a form whose evaluation returns a function.
+ (fixture-fn '#'electric-pair-mode))
`(progn
,@(cl-loop
for mode in (eval modes) ;FIXME: avoid `eval'
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/foo-inlinable.el b/test/lisp/emacs-lisp/bytecomp-resources/foo-inlinable.el
new file mode 100644
index 00000000000..47481574ea8
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/foo-inlinable.el
@@ -0,0 +1,6 @@
+;; -*- lexical-binding: t; -*-
+
+(defsubst foo-inlineable (foo-var)
+ (+ foo-var 2))
+
+(provide 'foo-inlinable)
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/nowarn-inline-after-defvar.el b/test/lisp/emacs-lisp/bytecomp-resources/nowarn-inline-after-defvar.el
new file mode 100644
index 00000000000..5582b2ab0ea
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/nowarn-inline-after-defvar.el
@@ -0,0 +1,17 @@
+;; -*- lexical-binding: t; -*-
+
+;; In this test, we try and make sure that inlined functions's code isn't
+;; mistakenly re-interpreted in the caller's context: we import an
+;; inlinable function from another file where `foo-var' is a normal
+;; lexical variable, and then call(inline) it in a function where
+;; `foo-var' is a dynamically-scoped variable.
+
+(require 'foo-inlinable
+ (expand-file-name "foo-inlinable.el"
+ (file-name-directory
+ (or byte-compile-current-file load-file-name))))
+
+(defvar foo-var)
+
+(defun foo-fun ()
+ (+ (foo-inlineable 5) 1))
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el
index 263736af4ed..980b402ca2d 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -713,6 +713,10 @@ Subtests signal errors if something goes wrong."
"warn-wide-docstring-multiline.el"
"defvar.*foo.*wider than.*characters")
+(bytecomp--define-warning-file-test
+ "nowarn-inline-after-defvar.el"
+ "Lexical argument shadows" 'reverse)
+
;;;; Macro expansion.
diff --git a/test/lisp/emacs-lisp/cl-lib-tests.el b/test/lisp/emacs-lisp/cl-lib-tests.el
index 97a44c43ef7..065ca4fa651 100644
--- a/test/lisp/emacs-lisp/cl-lib-tests.el
+++ b/test/lisp/emacs-lisp/cl-lib-tests.el
@@ -543,15 +543,7 @@
(apply (lambda (x) (+ x 1)) (list 8)))))
'(5 (6 5) (6 6) 9))))
-(defun cl-lib-tests--dummy-function ()
- ;; Dummy function to see if the file is compiled.
- t)
-
(ert-deftest cl-lib-defstruct-record ()
- ;; This test fails when compiled, see Bug#24402/27718.
- :expected-result (if (byte-code-function-p
- (symbol-function 'cl-lib-tests--dummy-function))
- :failed :passed)
(cl-defstruct foo x)
(let ((x (make-foo :x 42)))
(should (recordp x))
@@ -566,6 +558,7 @@
(should (eq (type-of x) 'vector))
(cl-old-struct-compat-mode 1)
+ (defvar cl-struct-foo)
(let ((cl-struct-foo (cl--struct-get-class 'foo)))
(setf (symbol-function 'cl-struct-foo) :quick-object-witness-check)
(should (eq (type-of x) 'foo))
diff --git a/test/lisp/emacs-lisp/seq-tests.el b/test/lisp/emacs-lisp/seq-tests.el
index 670398354a6..05c7fbe781e 100644
--- a/test/lisp/emacs-lisp/seq-tests.el
+++ b/test/lisp/emacs-lisp/seq-tests.el
@@ -29,6 +29,9 @@
(require 'ert)
(require 'seq)
+(eval-when-compile
+ (require 'cl-lib))
+
(defmacro with-test-sequences (spec &rest body)
"Successively bind VAR to a list, vector, and string built from SEQ.
Evaluate BODY for each created sequence.
@@ -108,16 +111,12 @@ Evaluate BODY for each created sequence.
'((a 0) (b 1) (c 2) (d 3)))))
(ert-deftest test-seq-do-indexed ()
- (let ((result nil))
- (seq-do-indexed (lambda (elt i)
- (add-to-list 'result (list elt i)))
- nil)
- (should (equal result nil)))
+ (let (result)
+ (seq-do-indexed (lambda (elt i) (push (list elt i) result)) ())
+ (should-not result))
(with-test-sequences (seq '(4 5 6))
- (let ((result nil))
- (seq-do-indexed (lambda (elt i)
- (add-to-list 'result (list elt i)))
- seq)
+ (let (result)
+ (seq-do-indexed (lambda (elt i) (push (list elt i) result)) seq)
(should (equal (seq-elt result 0) '(6 2)))
(should (equal (seq-elt result 1) '(5 1)))
(should (equal (seq-elt result 2) '(4 0))))))
@@ -410,12 +409,10 @@ Evaluate BODY for each created sequence.
(ert-deftest test-seq-random-elt-take-all ()
(let ((seq '(a b c d e))
- (elts '()))
- (should (= 0 (length elts)))
+ elts)
(dotimes (_ 1000)
(let ((random-elt (seq-random-elt seq)))
- (add-to-list 'elts
- random-elt)))
+ (cl-pushnew random-elt elts)))
(should (= 5 (length elts)))))
(ert-deftest test-seq-random-elt-signal-on-empty ()
diff --git a/test/lisp/faces-tests.el b/test/lisp/faces-tests.el
index 6e77259fe1b..c0db9c9de17 100644
--- a/test/lisp/faces-tests.el
+++ b/test/lisp/faces-tests.el
@@ -217,5 +217,13 @@
))
)
+(ert-deftest test-tty-find-type ()
+ (let ((pred (lambda (string)
+ (locate-library (concat "term/" string ".el")))))
+ (should (tty-find-type pred "cygwin"))
+ (should (tty-find-type pred "cygwin-foo"))
+ (should (equal (tty-find-type pred "xterm") "xterm"))
+ (should (equal (tty-find-type pred "screen.xterm") "screen"))))
+
(provide 'faces-tests)
;;; faces-tests.el ends here
diff --git a/test/lisp/find-cmd-tests.el b/test/lisp/find-cmd-tests.el
new file mode 100644
index 00000000000..b8e0f273988
--- /dev/null
+++ b/test/lisp/find-cmd-tests.el
@@ -0,0 +1,45 @@
+;;; find-cmd-tests.el --- tests for find-cmd.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/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'find-cmd)
+
+(ert-deftest find-cmd-test-find-cmd ()
+ (should
+ (string-match
+ (rx "find " (+ any)
+ " \\( \\( -name .svn -or -name .git -or -name .CVS \\)"
+ " -prune -or -true \\)"
+ " \\( \\( \\(" " -name \\*.pl -or -name \\*.pm -or -name \\*.t \\)"
+ " -or -mtime \\+1 \\) -and \\( -fstype nfs -or -fstype ufs \\) \\) ")
+ (find-cmd '(prune (name ".svn" ".git" ".CVS"))
+ '(and (or (name "*.pl" "*.pm" "*.t")
+ (mtime "+1"))
+ (fstype "nfs" "ufs"))))))
+
+(ert-deftest find-cmd-test-find-cmd/error-unknown-atom ()
+ (should-error (find-cmd '(unknown 123))))
+
+(ert-deftest find-cmd-test-find-cmd/error-wrong-argnum ()
+ (should-error (find-cmd '(name))))
+
+(provide 'find-cmd-tests)
+;;; find-cmd-tests.el ends here
diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el
index 3ebca14a284..7349b191caf 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/sasl-cram-tests.el b/test/lisp/net/sasl-cram-tests.el
new file mode 100644
index 00000000000..e0230ddee60
--- /dev/null
+++ b/test/lisp/net/sasl-cram-tests.el
@@ -0,0 +1,46 @@
+;;; sasl-cram-tests.el --- tests for sasl-cram.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:
+
+;; Test case from RFC 2195.
+
+;;; Code:
+
+(require 'ert)
+(require 'sasl)
+(require 'sasl-cram)
+
+(ert-deftest sasl-cram-md5-response-test ()
+ ;; The following strings are taken from section 2 of RFC 2195.
+ (let ((client
+ (sasl-make-client (sasl-find-mechanism '("CRAM-MD5"))
+ "user"
+ "imap"
+ "localhost"))
+ (data (base64-decode-string "PDE4OTYuNjk3MTcwOTUyQHBvc3RvZmZpY2UucmVzdG9uLm1jaS5uZXQ+"))
+ (sasl-read-passphrase
+ (lambda (_prompt) (copy-sequence "tanstaaftanstaaf"))))
+ (should (equal (sasl-cram-md5-response client (vector nil data))
+ "user b913a602c7eda7a495b4e6e7334d3890"))))
+
+(provide 'sasl-cram-tests)
+;;; sasl-cram-tests.el ends here
diff --git a/test/lisp/net/sasl-tests.el b/test/lisp/net/sasl-tests.el
new file mode 100644
index 00000000000..dab40754c00
--- /dev/null
+++ b/test/lisp/net/sasl-tests.el
@@ -0,0 +1,59 @@
+;;; sasl-tests.el --- tests for sasl.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)
+
+(ert-deftest sasl-test-make-client ()
+ (let ((client (sasl-make-client 'foo 'bar 'baz 'zut)))
+ (should (eq (sasl-client-mechanism client) 'foo))
+ (should (eq (sasl-client-name client) 'bar))
+ (should (eq (sasl-client-service client) 'baz))
+ (should (eq (sasl-client-server client) 'zut))))
+
+(ert-deftest sasl-test-client-set-properties ()
+ (let ((client (sasl-make-client 'foo 'bar 'baz 'zut)))
+ (sasl-client-set-property client 'foo 'bar)
+ (should (eq (sasl-client-property client 'foo) 'bar))))
+
+(ert-deftest sasl-test-step-data ()
+ (let ((step [nil nil]))
+ (sasl-step-set-data step "foo")
+ (should (equal (sasl-step-data step) "foo"))))
+
+(ert-deftest sasl-test-unique-id ()
+ (should (stringp (sasl-unique-id)))
+ (should-not (equal (sasl-unique-id) (sasl-unique-id))))
+
+(ert-deftest sasl-test-find-mechanism ()
+ (should (sasl-find-mechanism '("ANONYMOUS")))
+ (should-not (sasl-find-mechanism '("nonexistent mechanism"))))
+
+(ert-deftest sasl-test-mechanism-name ()
+ (let ((mechanism (sasl-find-mechanism '("ANONYMOUS"))))
+ (should (equal (sasl-mechanism-name mechanism) "ANONYMOUS"))))
+
+(provide 'sasl-tests)
+;;; sasl-tests.el ends here
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 5deee658296..19a40fdf06c 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -3192,6 +3192,8 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
(ert-deftest tramp-test17-insert-directory-one-file ()
"Check `insert-directory' inside directory listing."
(skip-unless (tramp--test-enabled))
+ ;; Relative file names in dired are not supported in tramp-crypt.el.
+ (skip-unless (not (tramp--test-crypt-p)))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(let* ((tmp-name1
@@ -5247,7 +5249,7 @@ Use direct async.")
;; order to avoid a question. `explicit-sh-args' echoes the
;; test data.
(with-current-buffer (get-buffer-create "*shell*")
- (ignore-errors (kill-process (current-buffer)))
+ (ignore-errors (kill-process (get-buffer-process (current-buffer))))
(should-not explicit-shell-file-name)
(call-interactively #'shell)
(with-timeout (10)
@@ -5720,16 +5722,16 @@ This requires restrictions of file name syntax."
(tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
'tramp-ftp-file-name-handler))
+(defun tramp--test-crypt-p ()
+ "Check, whether the remote directory is crypted"
+ (tramp-crypt-file-name-p tramp-test-temporary-file-directory))
+
(defun tramp--test-docker-p ()
"Check, whether the docker method is used.
This does not support some special file names."
(string-equal
"docker" (file-remote-p tramp-test-temporary-file-directory 'method)))
-(defun tramp--test-crypt-p ()
- "Check, whether the remote directory is crypted"
- (tramp-crypt-file-name-p tramp-test-temporary-file-directory))
-
(defun tramp--test-ftp-p ()
"Check, whether an FTP-like method is used.
This does not support globbing characters in file names (yet)."
@@ -5748,7 +5750,7 @@ If optional METHOD is given, it is checked first."
"Check, whether the remote host runs HP-UX.
Several special characters do not work properly there."
;; We must refill the cache. `file-truename' does it.
- (file-truename tramp-test-temporary-file-directory) nil
+ (file-truename tramp-test-temporary-file-directory)
(string-match-p
"^HP-UX" (tramp-get-connection-property tramp-test-vec "uname" "")))
@@ -5757,7 +5759,7 @@ Several special characters do not work properly there."
ksh93 makes some strange conversions of non-latin characters into
a $'' syntax."
;; We must refill the cache. `file-truename' does it.
- (file-truename tramp-test-temporary-file-directory) nil
+ (file-truename tramp-test-temporary-file-directory)
(string-match-p
"ksh$" (tramp-get-connection-property tramp-test-vec "remote-shell" "")))
@@ -5787,6 +5789,17 @@ This does not support special file names."
"Check, whether the remote host runs a based method from tramp-sh.el."
(tramp-sh-file-name-handler-p tramp-test-vec))
+(defun tramp--test-sh-no-ls--dired-p ()
+ "Check, whether the remote host runs a based method from tramp-sh.el.
+Additionally, ls does not support \"--dired\"."
+ (and (tramp--test-sh-p)
+ (with-temp-buffer
+ ;; We must refill the cache. `insert-directory' does it.
+ ;; This fails for tramp-crypt.el, so we ignore that.
+ (ignore-errors
+ (insert-directory tramp-test-temporary-file-directory "-al"))
+ (not (tramp-get-connection-property tramp-test-vec "ls--dired" nil)))))
+
(defun tramp--test-share-p ()
"Check, whether the method needs a share."
(and (tramp--test-gvfs-p)
@@ -6023,17 +6036,20 @@ This requires restrictions of file name syntax."
;; expanded to <TAB>.
(let ((files
(list
- (if (or (tramp--test-ange-ftp-p)
- (tramp--test-gvfs-p)
- (tramp--test-rclone-p)
- (tramp--test-sudoedit-p)
- (tramp--test-windows-nt-or-smb-p))
- "foo bar baz"
- (if (or (tramp--test-adb-p)
- (tramp--test-docker-p)
- (eq system-type 'cygwin))
- " foo bar baz "
- " foo\tbar baz\t"))
+ (cond ((or (tramp--test-ange-ftp-p)
+ (tramp--test-docker-p)
+ (tramp--test-gvfs-p)
+ (tramp--test-rclone-p)
+ (tramp--test-sudoedit-p)
+ (tramp--test-windows-nt-or-smb-p))
+ "foo bar baz")
+ ((or (tramp--test-adb-p)
+ (eq system-type 'cygwin))
+ " foo bar baz ")
+ ((tramp--test-sh-no-ls--dired-p)
+ "\tfoo bar baz\t")
+ (t " foo\tbar baz\t"))
+ "@foo@bar@baz@"
"$foo$bar$$baz$"
"-foo-bar-baz-"
"%foo%bar%baz%"
diff --git a/test/lisp/progmodes/asm-mode-tests.el b/test/lisp/progmodes/asm-mode-tests.el
index 6ae4fdf5850..87872179d93 100644
--- a/test/lisp/progmodes/asm-mode-tests.el
+++ b/test/lisp/progmodes/asm-mode-tests.el
@@ -69,4 +69,14 @@
(should (string-match-p ";;; \nlabel:" (buffer-string)))
(should (= (current-column) 4))))
+(ert-deftest asm-mode-tests-fill-comment ()
+ (asm-mode-tests--with-temp-buffer
+ (call-interactively #'comment-dwim)
+ (insert "Pellentesque condimentum, magna ut suscipit hendrerit, \
+ipsum augue ornare nulla, non luctus diam neque sit amet urna.")
+ (call-interactively #'fill-paragraph)
+ (should (equal (buffer-string) "\t;; Pellentesque condimentum, \
+magna ut suscipit hendrerit,\n\t;; ipsum augue ornare nulla, non \
+luctus diam neque sit amet\n\t;; urna."))))
+
;;; asm-mode-tests.el ends here
diff --git a/test/lisp/progmodes/elisp-mode-tests.el b/test/lisp/progmodes/elisp-mode-tests.el
index fd43707f277..badcad670c2 100644
--- a/test/lisp/progmodes/elisp-mode-tests.el
+++ b/test/lisp/progmodes/elisp-mode-tests.el
@@ -834,5 +834,61 @@ to (xref-elisp-test-descr-to-target xref)."
(indent-region (point-min) (point-max))
(should (equal (buffer-string) orig)))))
+(defun test--font (form search)
+ (with-temp-buffer
+ (emacs-lisp-mode)
+ (if (stringp form)
+ (insert form)
+ (pp form (current-buffer)))
+ (font-lock-debug-fontify)
+ (goto-char (point-min))
+ (and (re-search-forward search nil t)
+ (get-text-property (match-beginning 1) 'face))))
+
+(ert-deftest test-elisp-font-keywords-1 ()
+ ;; Special form.
+ (should (eq (test--font '(if foo bar) "(\\(if\\)")
+ 'font-lock-keyword-face))
+ ;; Macro.
+ (should (eq (test--font '(when foo bar) "(\\(when\\)")
+ 'font-lock-keyword-face))
+ (should (eq (test--font '(condition-case nil
+ (foo)
+ (error (if a b)))
+ "(\\(if\\)")
+ 'font-lock-keyword-face))
+ (should (eq (test--font '(condition-case nil
+ (foo)
+ (when (if a b)))
+ "(\\(when\\)")
+ 'nil)))
+
+(ert-deftest test-elisp-font-keywords-2 ()
+ (should (eq (test--font '(condition-case nil
+ (foo)
+ (error (when a b)))
+ "(\\(when\\)")
+ 'font-lock-keyword-face)))
+
+(ert-deftest test-elisp-font-keywords-3 ()
+ (should (eq (test--font '(setq a '(if when zot))
+ "(\\(if\\)")
+ nil)))
+
+(ert-deftest test-elisp-font-keywords-4 ()
+ :expected-result :failed ; FIXME bug#43265
+ (should (eq (test--font '(condition-case nil
+ (foo)
+ ((if foo) (when a b)))
+ "(\\(if\\)")
+ nil)))
+
+(ert-deftest test-elisp-font-keywords-5 ()
+ (should (eq (test--font '(condition-case (when a)
+ (foo)
+ (error t))
+ "(\\(when\\)")
+ nil)))
+
(provide 'elisp-mode-tests)
;;; elisp-mode-tests.el ends here
diff --git a/test/lisp/replace-tests.el b/test/lisp/replace-tests.el
index 8c2682a1f13..2db570c97dd 100644
--- a/test/lisp/replace-tests.el
+++ b/test/lisp/replace-tests.el
@@ -587,5 +587,18 @@ bound to HIGHLIGHT-LOCUS."
(get-text-property (point) 'occur-target))
(should (funcall check-overlays has-overlay)))))))
+(ert-deftest replace-regexp-bug45973 ()
+ "Test for https://debbugs.gnu.org/45973 ."
+ (let ((before "1RB 1LC 1RC 1RB 1RD 0LE 1LA 1LD 1RH 0LA")
+ (after "1LB 1RC 1LC 1LB 1LD 0RE 1RA 1RD 1LH 0RA"))
+ (with-temp-buffer
+ (insert before)
+ (goto-char (point-min))
+ (replace-regexp
+ "\\(\\(L\\)\\|\\(R\\)\\)"
+ '(replace-eval-replacement
+ replace-quote
+ (if (match-string 2) "R" "L")))
+ (should (equal (buffer-string) after)))))
;;; replace-tests.el ends here
diff --git a/test/lisp/thingatpt-tests.el b/test/lisp/thingatpt-tests.el
index c43c81af9fd..62a27f09cbd 100644
--- a/test/lisp/thingatpt-tests.el
+++ b/test/lisp/thingatpt-tests.el
@@ -146,4 +146,48 @@ position to retrieve THING.")
(should (thing-at-point-looking-at "2abcd"))
(should (equal (match-data) m2)))))
+(ert-deftest test-symbol-thing-1 ()
+ (with-temp-buffer
+ (insert "foo bar zot")
+ (goto-char 4)
+ (should (eq (symbol-at-point) 'foo))
+ (forward-char 1)
+ (should (eq (symbol-at-point) 'bar))
+ (forward-char 1)
+ (should (eq (symbol-at-point) 'bar))
+ (forward-char 1)
+ (should (eq (symbol-at-point) 'bar))
+ (forward-char 1)
+ (should (eq (symbol-at-point) 'bar))
+ (forward-char 1)
+ (should (eq (symbol-at-point) 'zot))))
+
+(ert-deftest test-symbol-thing-2 ()
+ (with-temp-buffer
+ (insert " bar ")
+ (goto-char (point-max))
+ (should (eq (symbol-at-point) nil))
+ (forward-char -1)
+ (should (eq (symbol-at-point) 'bar))))
+
+(ert-deftest test-symbol-thing-2 ()
+ (with-temp-buffer
+ (insert " bar ")
+ (goto-char (point-max))
+ (should (eq (symbol-at-point) nil))
+ (forward-char -1)
+ (should (eq (symbol-at-point) 'bar))))
+
+(ert-deftest test-symbol-thing-3 ()
+ (with-temp-buffer
+ (insert "bar")
+ (goto-char 2)
+ (should (eq (symbol-at-point) 'bar))))
+
+(ert-deftest test-symbol-thing-3 ()
+ (with-temp-buffer
+ (insert "`[[`(")
+ (goto-char 2)
+ (should (eq (symbol-at-point) nil))))
+
;;; thingatpt.el ends here
diff --git a/test/manual/indent/shell.sh b/test/manual/indent/shell.sh
index dc184ea0d77..bd4a74f7054 100755
--- a/test/manual/indent/shell.sh
+++ b/test/manual/indent/shell.sh
@@ -6,6 +6,13 @@ setlock -n /tmp/getmail.lock && echo getmail isn\'t running
toto=$(grep hello foo |
wc)
+myfun () {
+ for ((it=0; it<${limit}; ++it))
+ {
+ echo "whatever $it"
+ }
+}
+
# adsgsdg
if foo; then
diff --git a/test/src/process-tests.el b/test/src/process-tests.el
index 949f73595b4..a3fba8d328b 100644
--- a/test/src/process-tests.el
+++ b/test/src/process-tests.el
@@ -789,6 +789,36 @@ have written output."
(should (equal calls
(list (list process "finished\n"))))))))))
+(ert-deftest process-tests/multiple-threads-waiting ()
+ (skip-unless (fboundp 'make-thread))
+ (with-timeout (60 (ert-fail "Test timed out"))
+ (process-tests--with-processes processes
+ (let ((threads ())
+ (cat (executable-find "cat")))
+ (skip-unless cat)
+ (dotimes (i 10)
+ (let* ((name (format "test %d" i))
+ (process (make-process :name name
+ :command (list cat)
+ :coding 'no-conversion
+ :noquery t
+ :connection-type 'pipe)))
+ (push process processes)
+ (set-process-thread process nil)
+ (push (make-thread
+ (lambda ()
+ (while (accept-process-output process)))
+ name)
+ threads)))
+ (mapc #'process-send-eof processes)
+ (cl-loop for process in processes
+ and thread in threads
+ do
+ (should-not (thread-join thread))
+ (should-not (thread-last-error))
+ (should (eq (process-status process) 'exit))
+ (should (eql (process-exit-status process) 0)))))))
+
(defun process-tests--eval (command form)
"Return a command that evaluates FORM in an Emacs subprocess.
COMMAND must be a list returned by