summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSean Whitton <spwhitton@spwhitton.name>2021-01-19 14:19:49 -0700
committerSean Whitton <spwhitton@spwhitton.name>2021-01-19 14:19:49 -0700
commitba6d9241e8081cc0b82dc683b63f4e1f44b1329f (patch)
tree7cb3ea26fd89eb6b73173d387a8309280219080c
parent600e22e4f7c2de9ef9a23e7325b5ac962ec623f8 (diff)
parent8ed97a8d543b9596166c670212265dabc44aa3d5 (diff)
downloademacs-ba6d9241e8081cc0b82dc683b63f4e1f44b1329f.tar.gz
Merge remote-tracking branch 'origin/master' into athena/unstable
-rw-r--r--.clang-format2
-rw-r--r--.dir-locals.el1
-rw-r--r--.gitattributes2
-rw-r--r--.gitignore4
-rw-r--r--.gitlab-ci.yml90
-rw-r--r--ChangeLog.12
-rw-r--r--ChangeLog.22
-rw-r--r--ChangeLog.32
-rw-r--r--GNUmakefile2
-rw-r--r--INSTALL33
-rw-r--r--INSTALL.REPO2
-rw-r--r--Makefile.in6
-rw-r--r--README2
-rw-r--r--admin/ChangeLog.12
-rw-r--r--admin/README2
-rw-r--r--admin/admin.el2
-rw-r--r--admin/alloc-colors.c2
-rw-r--r--admin/authors.el20
-rwxr-xr-xadmin/automerge2
-rwxr-xr-xadmin/build-configs2
-rw-r--r--admin/charsets/Makefile.in2
-rw-r--r--admin/charsets/cp51932.awk2
-rw-r--r--admin/charsets/eucjp-ms.awk2
-rwxr-xr-xadmin/charsets/mapconv2
-rw-r--r--admin/charsets/mapfiles/README2
-rw-r--r--admin/charsets/mule-charsets.el6
-rw-r--r--admin/cus-test.el2
-rwxr-xr-xadmin/diff-tar-files6
-rwxr-xr-xadmin/emake85
-rw-r--r--admin/find-gc.el2
-rw-r--r--admin/gitmerge.el2
-rw-r--r--admin/grammars/Makefile.in2
-rw-r--r--admin/grammars/c.by2
-rw-r--r--admin/grammars/grammar.wy2
-rw-r--r--admin/grammars/java-tags.wy2
-rw-r--r--admin/grammars/js.wy2
-rw-r--r--admin/grammars/make.by2
-rw-r--r--admin/grammars/python.wy2
-rw-r--r--admin/grammars/scheme.by2
-rw-r--r--admin/grammars/srecode-template.wy2
-rw-r--r--admin/last-chance.el22
-rwxr-xr-xadmin/make-emacs2
-rwxr-xr-xadmin/make-manuals2
-rw-r--r--admin/make-tarball.txt37
-rwxr-xr-xadmin/merge-gnulib5
-rwxr-xr-xadmin/merge-pkg-config4
-rw-r--r--admin/notes/copyright2
-rw-r--r--admin/notes/elpa32
-rw-r--r--admin/notes/emba2
-rw-r--r--admin/notes/hydra2
-rw-r--r--admin/notes/multi-tty2
-rw-r--r--admin/notes/unicode2
-rw-r--r--admin/notes/www2
-rw-r--r--admin/nt/README-UNDUMP.W322
-rw-r--r--admin/nt/dist-build/README-scripts38
-rw-r--r--admin/nt/dist-build/README-windows-binaries51
-rwxr-xr-xadmin/nt/dist-build/build-dep-zips.py191
-rwxr-xr-xadmin/nt/dist-build/build-zips.sh102
-rw-r--r--admin/nt/dist-build/emacs.nsi31
-rwxr-xr-xadmin/quick-install-emacs2
-rw-r--r--admin/release-process5
-rw-r--r--admin/unidata/Makefile.in2
-rwxr-xr-xadmin/unidata/blocks.awk4
-rw-r--r--admin/unidata/unidata-gen.el2
-rw-r--r--admin/unidata/uvs.el2
-rwxr-xr-xadmin/update-copyright2
-rwxr-xr-xadmin/update_autogen2
-rwxr-xr-xadmin/upload-manuals2
-rwxr-xr-xautogen.sh2
-rwxr-xr-xbuild-aux/config.guess224
-rwxr-xr-xbuild-aux/config.sub60
-rwxr-xr-xbuild-aux/git-hooks/commit-msg2
-rwxr-xr-xbuild-aux/git-hooks/pre-commit2
-rwxr-xr-xbuild-aux/git-hooks/prepare-commit-msg6
-rwxr-xr-xbuild-aux/gitlog-to-changelog2
-rwxr-xr-xbuild-aux/gitlog-to-emacslog2
-rwxr-xr-xbuild-aux/install-sh35
-rwxr-xr-xbuild-aux/make-info-dir2
-rwxr-xr-xbuild-aux/move-if-change2
-rwxr-xr-xbuild-aux/msys-to-w322
-rwxr-xr-xbuild-aux/update-copyright2
-rwxr-xr-xbuild-aux/update-subdirs4
-rw-r--r--config.bat2
-rw-r--r--configure.ac77
-rw-r--r--doc/emacs/ChangeLog.12
-rw-r--r--doc/emacs/Makefile.in2
-rw-r--r--doc/emacs/abbrevs.texi2
-rw-r--r--doc/emacs/ack.texi2
-rw-r--r--doc/emacs/anti.texi2
-rw-r--r--doc/emacs/arevert-xtra.texi2
-rw-r--r--doc/emacs/basic.texi13
-rw-r--r--doc/emacs/buffers.texi2
-rw-r--r--doc/emacs/building.texi15
-rw-r--r--doc/emacs/cal-xtra.texi2
-rw-r--r--doc/emacs/calendar.texi2
-rw-r--r--doc/emacs/cmdargs.texi5
-rw-r--r--doc/emacs/commands.texi2
-rw-r--r--doc/emacs/custom.texi2
-rw-r--r--doc/emacs/dired-xtra.texi2
-rw-r--r--doc/emacs/dired.texi2
-rw-r--r--doc/emacs/display.texi2
-rw-r--r--doc/emacs/emacs-xtra.texi2
-rw-r--r--doc/emacs/emacs.texi2
-rw-r--r--doc/emacs/emerge-xtra.texi2
-rw-r--r--doc/emacs/entering.texi2
-rw-r--r--doc/emacs/files.texi2
-rw-r--r--doc/emacs/fixit.texi2
-rw-r--r--doc/emacs/fortran-xtra.texi2
-rw-r--r--doc/emacs/frames.texi8
-rw-r--r--doc/emacs/glossary.texi2
-rw-r--r--doc/emacs/gnu.texi2
-rw-r--r--doc/emacs/help.texi2
-rw-r--r--doc/emacs/indent.texi4
-rw-r--r--doc/emacs/killing.texi13
-rw-r--r--doc/emacs/kmacro.texi2
-rw-r--r--doc/emacs/m-x.texi2
-rw-r--r--doc/emacs/macos.texi2
-rw-r--r--doc/emacs/maintaining.texi12
-rw-r--r--doc/emacs/mark.texi2
-rw-r--r--doc/emacs/mini.texi17
-rw-r--r--doc/emacs/misc.texi30
-rw-r--r--doc/emacs/modes.texi2
-rw-r--r--doc/emacs/msdos-xtra.texi2
-rw-r--r--doc/emacs/msdos.texi2
-rw-r--r--doc/emacs/mule.texi28
-rw-r--r--doc/emacs/package.texi18
-rw-r--r--doc/emacs/picture-xtra.texi2
-rw-r--r--doc/emacs/programs.texi2
-rw-r--r--doc/emacs/regs.texi2
-rw-r--r--doc/emacs/rmail.texi16
-rw-r--r--doc/emacs/screen.texi2
-rw-r--r--doc/emacs/search.texi19
-rw-r--r--doc/emacs/sending.texi2
-rw-r--r--doc/emacs/text.texi2
-rw-r--r--doc/emacs/trouble.texi9
-rw-r--r--doc/emacs/vc-xtra.texi2
-rw-r--r--doc/emacs/vc1-xtra.texi2
-rw-r--r--doc/emacs/windows.texi6
-rw-r--r--doc/emacs/xresources.texi2
-rw-r--r--doc/lispintro/ChangeLog.12
-rw-r--r--doc/lispintro/Makefile.in2
-rw-r--r--doc/lispintro/README2
-rw-r--r--doc/lispintro/cons-1.eps2
-rw-r--r--doc/lispintro/cons-2.eps2
-rw-r--r--doc/lispintro/cons-2a.eps2
-rw-r--r--doc/lispintro/cons-3.eps2
-rw-r--r--doc/lispintro/cons-4.eps2
-rw-r--r--doc/lispintro/cons-5.eps2
-rw-r--r--doc/lispintro/drawers.eps2
-rw-r--r--doc/lispintro/emacs-lisp-intro.texi2
-rw-r--r--doc/lispintro/lambda-1.eps2
-rw-r--r--doc/lispintro/lambda-2.eps2
-rw-r--r--doc/lispintro/lambda-3.eps2
-rw-r--r--doc/lispref/ChangeLog.12
-rw-r--r--doc/lispref/Makefile.in2
-rw-r--r--doc/lispref/README2
-rw-r--r--doc/lispref/abbrevs.texi2
-rw-r--r--doc/lispref/anti.texi2
-rw-r--r--doc/lispref/back.texi2
-rw-r--r--doc/lispref/backups.texi8
-rw-r--r--doc/lispref/buffers.texi61
-rw-r--r--doc/lispref/commands.texi23
-rw-r--r--doc/lispref/compile.texi8
-rw-r--r--doc/lispref/control.texi7
-rw-r--r--doc/lispref/customize.texi2
-rw-r--r--doc/lispref/debugging.texi17
-rw-r--r--doc/lispref/display.texi83
-rw-r--r--doc/lispref/edebug.texi14
-rw-r--r--doc/lispref/elisp.texi3
-rw-r--r--doc/lispref/errors.texi18
-rw-r--r--doc/lispref/eval.texi2
-rw-r--r--doc/lispref/files.texi27
-rw-r--r--doc/lispref/frames.texi2
-rw-r--r--doc/lispref/functions.texi4
-rw-r--r--doc/lispref/hash.texi2
-rw-r--r--doc/lispref/help.texi9
-rw-r--r--doc/lispref/hooks.texi2
-rw-r--r--doc/lispref/internals.texi31
-rw-r--r--doc/lispref/intro.texi2
-rw-r--r--doc/lispref/keymaps.texi14
-rw-r--r--doc/lispref/lay-flat.texi2
-rw-r--r--doc/lispref/lists.texi2
-rw-r--r--doc/lispref/loading.texi2
-rw-r--r--doc/lispref/macros.texi2
-rw-r--r--doc/lispref/maps.texi2
-rw-r--r--doc/lispref/markers.texi2
-rw-r--r--doc/lispref/minibuf.texi97
-rw-r--r--doc/lispref/modes.texi29
-rw-r--r--doc/lispref/nonascii.texi2
-rw-r--r--doc/lispref/numbers.texi2
-rw-r--r--doc/lispref/objects.texi2
-rw-r--r--doc/lispref/os.texi53
-rw-r--r--doc/lispref/package.texi2
-rw-r--r--doc/lispref/positions.texi2
-rw-r--r--doc/lispref/processes.texi32
-rw-r--r--doc/lispref/records.texi2
-rw-r--r--doc/lispref/searching.texi6
-rw-r--r--doc/lispref/sequences.texi17
-rw-r--r--doc/lispref/streams.texi38
-rw-r--r--doc/lispref/strings.texi65
-rw-r--r--doc/lispref/symbols.texi2
-rw-r--r--doc/lispref/syntax.texi4
-rw-r--r--doc/lispref/text.texi20
-rw-r--r--doc/lispref/threads.texi2
-rw-r--r--doc/lispref/tips.texi17
-rw-r--r--doc/lispref/two-volume-cross-refs.txt2
-rw-r--r--doc/lispref/two-volume.make2
-rw-r--r--doc/lispref/variables.texi14
-rw-r--r--doc/lispref/windows.texi29
-rw-r--r--doc/man/ChangeLog.12
-rw-r--r--doc/man/ebrowse.12
-rw-r--r--doc/man/emacs.1.in2
-rw-r--r--doc/man/etags.12
-rw-r--r--doc/misc/ChangeLog.12
-rw-r--r--doc/misc/Makefile.in2
-rw-r--r--doc/misc/auth.texi14
-rw-r--r--doc/misc/autotype.texi2
-rw-r--r--doc/misc/bovine.texi2
-rw-r--r--doc/misc/calc.texi10
-rw-r--r--doc/misc/cc-mode.texi6
-rw-r--r--doc/misc/cl.texi30
-rw-r--r--doc/misc/dbus.texi2
-rw-r--r--doc/misc/dired-x.texi2
-rw-r--r--doc/misc/ebrowse.texi4
-rw-r--r--doc/misc/ede.texi2
-rw-r--r--doc/misc/ediff.texi2
-rw-r--r--doc/misc/edt.texi2
-rw-r--r--doc/misc/efaq-w32.texi2
-rw-r--r--doc/misc/efaq.texi183
-rw-r--r--doc/misc/eieio.texi2
-rw-r--r--doc/misc/emacs-gnutls.texi2
-rw-r--r--doc/misc/emacs-mime.texi2
-rw-r--r--doc/misc/epa.texi2
-rw-r--r--doc/misc/erc.texi6
-rw-r--r--doc/misc/ert.texi2
-rw-r--r--doc/misc/eshell.texi4
-rw-r--r--doc/misc/eudc.texi2
-rw-r--r--doc/misc/eww.texi8
-rw-r--r--doc/misc/flymake.texi12
-rw-r--r--doc/misc/forms.texi2
-rw-r--r--doc/misc/gnus-coding.texi2
-rw-r--r--doc/misc/gnus-faq.texi10
-rw-r--r--doc/misc/gnus.texi684
-rw-r--r--doc/misc/htmlfontify.texi2
-rw-r--r--doc/misc/idlwave.texi2
-rw-r--r--doc/misc/ido.texi2
-rw-r--r--doc/misc/info.texi2
-rw-r--r--doc/misc/mairix-el.texi2
-rw-r--r--doc/misc/message.texi2
-rw-r--r--doc/misc/mh-e.texi2
-rw-r--r--doc/misc/modus-themes.texi2
-rw-r--r--doc/misc/newsticker.texi2
-rw-r--r--doc/misc/nxml-mode.texi2
-rw-r--r--doc/misc/octave-mode.texi2
-rw-r--r--doc/misc/org.texi1215
-rw-r--r--doc/misc/pcl-cvs.texi2
-rw-r--r--doc/misc/pgg.texi2
-rw-r--r--doc/misc/rcirc.texi2
-rw-r--r--doc/misc/reftex.texi2
-rw-r--r--doc/misc/remember.texi2
-rw-r--r--doc/misc/sasl.texi2
-rw-r--r--doc/misc/sc.texi2
-rw-r--r--doc/misc/sem-user.texi2
-rw-r--r--doc/misc/semantic.texi2
-rw-r--r--doc/misc/ses.texi2
-rw-r--r--doc/misc/sieve.texi2
-rw-r--r--doc/misc/smtpmail.texi2
-rw-r--r--doc/misc/speedbar.texi2
-rw-r--r--doc/misc/srecode.texi2
-rw-r--r--doc/misc/texinfo.tex65
-rw-r--r--doc/misc/todo-mode.texi2
-rw-r--r--doc/misc/tramp.texi154
-rw-r--r--doc/misc/trampver.texi4
-rw-r--r--doc/misc/url.texi2
-rw-r--r--doc/misc/vhdl-mode.texi2
-rw-r--r--doc/misc/vip.texi2
-rw-r--r--doc/misc/viper.texi2
-rw-r--r--doc/misc/widget.texi29
-rw-r--r--doc/misc/wisent.texi2
-rw-r--r--doc/misc/woman.texi2
-rw-r--r--etc/CALC-NEWS2
-rw-r--r--etc/ChangeLog.12
-rw-r--r--etc/DEBUG2
-rw-r--r--etc/DISTRIB2
-rw-r--r--etc/ERC-NEWS2
-rw-r--r--etc/ETAGS.EBNF4
-rw-r--r--etc/ETAGS.README2
-rw-r--r--etc/HELLO12
-rw-r--r--etc/MACHINES2
-rw-r--r--etc/MH-E-NEWS2
-rw-r--r--etc/NEWS646
-rw-r--r--etc/NEWS.1-172
-rw-r--r--etc/NEWS.182
-rw-r--r--etc/NEWS.194
-rw-r--r--etc/NEWS.202
-rw-r--r--etc/NEWS.212
-rw-r--r--etc/NEWS.222
-rw-r--r--etc/NEWS.232
-rw-r--r--etc/NEWS.242
-rw-r--r--etc/NEWS.252
-rw-r--r--etc/NEWS.262
-rw-r--r--etc/NEWS.2719
-rw-r--r--etc/NEXTSTEP2
-rw-r--r--etc/NXML-NEWS2
-rw-r--r--etc/ORG-NEWS595
-rw-r--r--etc/PROBLEMS13
-rw-r--r--etc/README2
-rw-r--r--etc/TERMS2
-rw-r--r--etc/TODO70
-rw-r--r--etc/charsets/README2
-rw-r--r--etc/compilation.txt2
-rw-r--r--etc/edt-user.el2
-rw-r--r--etc/emacs-buffer.gdb2
-rw-r--r--etc/emacs.appdata.xml2
-rw-r--r--etc/emacs.service6
-rw-r--r--etc/enriched.txt2
-rw-r--r--etc/forms/forms-d2.el2
-rw-r--r--etc/gnus-tut.txt2
-rw-r--r--etc/grep.txt8
-rw-r--r--etc/images/README8
-rw-r--r--etc/images/checked.xpm2
-rw-r--r--etc/images/custom/README2
-rw-r--r--etc/images/ezimage/README2
-rw-r--r--etc/images/gnus/README6
-rw-r--r--etc/images/gnus/gnus.svg2
-rw-r--r--etc/images/gud/README6
-rw-r--r--etc/images/icons/README8
-rw-r--r--etc/images/icons/hicolor/scalable/apps/emacs.svg2
-rw-r--r--etc/images/icons/hicolor/scalable/apps/emacs23.svg2
-rw-r--r--etc/images/icons/hicolor/scalable/mimetypes/emacs-document23.svg2
-rw-r--r--etc/images/mh-logo.xpm2
-rw-r--r--etc/images/mpc/README2
-rw-r--r--etc/images/newsticker/README2
-rw-r--r--etc/images/smilies/README2
-rw-r--r--etc/images/smilies/grayscale/README2
-rw-r--r--etc/images/smilies/medium/README2
-rw-r--r--etc/images/splash.svg2
-rw-r--r--etc/images/tabs/README2
-rw-r--r--etc/images/tree-widget/default/README2
-rw-r--r--etc/images/tree-widget/folder/README2
-rw-r--r--etc/images/unchecked.xpm2
-rw-r--r--etc/org/README2
-rw-r--r--etc/ps-prin0.ps2
-rw-r--r--etc/ps-prin1.ps2
-rw-r--r--etc/publicsuffix.txt108
-rw-r--r--etc/refcards/Makefile2
-rw-r--r--etc/refcards/README4
-rw-r--r--etc/refcards/calccard.tex2
-rw-r--r--etc/refcards/cs-dired-ref.tex2
-rw-r--r--etc/refcards/cs-refcard.tex2
-rw-r--r--etc/refcards/cs-survival.tex2
-rw-r--r--etc/refcards/de-refcard.tex2
-rw-r--r--etc/refcards/dired-ref.tex2
-rw-r--r--etc/refcards/emacsver.tex.in2
-rw-r--r--etc/refcards/fr-dired-ref.tex2
-rw-r--r--etc/refcards/fr-refcard.tex2
-rw-r--r--etc/refcards/fr-survival.tex2
-rw-r--r--etc/refcards/gnus-logo.eps2
-rw-r--r--etc/refcards/gnus-refcard.tex2
-rw-r--r--etc/refcards/orgcard.tex11
-rw-r--r--etc/refcards/pdflayout.sty2
-rw-r--r--etc/refcards/pl-refcard.tex2
-rw-r--r--etc/refcards/pt-br-refcard.tex2
-rw-r--r--etc/refcards/refcard.tex2
-rw-r--r--etc/refcards/ru-refcard.tex4
-rw-r--r--etc/refcards/sk-dired-ref.tex2
-rw-r--r--etc/refcards/sk-refcard.tex2
-rw-r--r--etc/refcards/sk-survival.tex2
-rw-r--r--etc/refcards/survival.tex2
-rw-r--r--etc/refcards/vipcard.tex2
-rw-r--r--etc/refcards/viperCard.tex2
-rw-r--r--etc/schema/locate.rnc2
-rw-r--r--etc/schema/relaxng.rnc2
-rw-r--r--etc/schema/schemas.xml2
-rw-r--r--etc/ses-example.ses2
-rw-r--r--etc/srecode/c.srt2
-rw-r--r--etc/srecode/cpp.srt2
-rw-r--r--etc/srecode/default.srt2
-rw-r--r--etc/srecode/doc-cpp.srt2
-rw-r--r--etc/srecode/doc-default.srt2
-rw-r--r--etc/srecode/doc-java.srt2
-rw-r--r--etc/srecode/ede-autoconf.srt2
-rw-r--r--etc/srecode/ede-make.srt2
-rw-r--r--etc/srecode/el.srt2
-rw-r--r--etc/srecode/getset-cpp.srt2
-rw-r--r--etc/srecode/java.srt2
-rw-r--r--etc/srecode/make.srt2
-rw-r--r--etc/srecode/proj-test.srt2
-rw-r--r--etc/srecode/template.srt2
-rw-r--r--etc/srecode/test.srt2
-rw-r--r--etc/srecode/texi.srt2
-rw-r--r--etc/srecode/wisent.srt2
-rw-r--r--etc/themes/adwaita-theme.el2
-rw-r--r--etc/themes/deeper-blue-theme.el2
-rw-r--r--etc/themes/dichromacy-theme.el2
-rw-r--r--etc/themes/leuven-theme.el2
-rw-r--r--etc/themes/light-blue-theme.el2
-rw-r--r--etc/themes/manoj-dark-theme.el2
-rw-r--r--etc/themes/misterioso-theme.el2
-rw-r--r--etc/themes/modus-operandi-theme.el2
-rw-r--r--etc/themes/modus-vivendi-theme.el2
-rw-r--r--etc/themes/tango-dark-theme.el2
-rw-r--r--etc/themes/tango-theme.el2
-rw-r--r--etc/themes/tsdh-dark-theme.el2
-rw-r--r--etc/themes/tsdh-light-theme.el2
-rw-r--r--etc/themes/wheatgrass-theme.el2
-rw-r--r--etc/themes/whiteboard-theme.el2
-rw-r--r--etc/themes/wombat-theme.el2
-rw-r--r--etc/tutorials/TUTORIAL20
-rw-r--r--etc/tutorials/TUTORIAL.bg2
-rw-r--r--etc/tutorials/TUTORIAL.cn4
-rw-r--r--etc/tutorials/TUTORIAL.cs2
-rw-r--r--etc/tutorials/TUTORIAL.de8
-rw-r--r--etc/tutorials/TUTORIAL.eo2
-rw-r--r--etc/tutorials/TUTORIAL.es30
-rw-r--r--etc/tutorials/TUTORIAL.fr14
-rw-r--r--etc/tutorials/TUTORIAL.he19
-rw-r--r--etc/tutorials/TUTORIAL.it75
-rw-r--r--etc/tutorials/TUTORIAL.ja2
-rw-r--r--etc/tutorials/TUTORIAL.ko2
-rw-r--r--etc/tutorials/TUTORIAL.nl4
-rw-r--r--etc/tutorials/TUTORIAL.pl2
-rw-r--r--etc/tutorials/TUTORIAL.pt_BR2
-rw-r--r--etc/tutorials/TUTORIAL.ro4
-rw-r--r--etc/tutorials/TUTORIAL.ru2
-rw-r--r--etc/tutorials/TUTORIAL.sk2
-rw-r--r--etc/tutorials/TUTORIAL.sl2
-rw-r--r--etc/tutorials/TUTORIAL.sv207
-rw-r--r--etc/tutorials/TUTORIAL.th2
-rw-r--r--etc/tutorials/TUTORIAL.zh2
-rw-r--r--etc/w32-feature.el37
-rw-r--r--leim/ChangeLog.12
-rw-r--r--leim/Makefile.in2
-rw-r--r--leim/README2
-rw-r--r--leim/leim-ext.el2
-rw-r--r--lib-src/ChangeLog.12
-rw-r--r--lib-src/Makefile.in11
-rw-r--r--lib-src/ebrowse.c2
-rw-r--r--lib-src/emacsclient.c41
-rw-r--r--lib-src/etags.c56
-rw-r--r--lib-src/hexl.c2
-rw-r--r--lib-src/make-docfile.c2
-rw-r--r--lib-src/make-fingerprint.c11
-rw-r--r--lib-src/movemail.c2
-rw-r--r--lib-src/ntlib.c2
-rw-r--r--lib-src/ntlib.h2
-rw-r--r--lib-src/pop.c2
-rw-r--r--lib-src/pop.h2
-rwxr-xr-xlib-src/rcs2log4
-rw-r--r--lib-src/update-game-score.c6
-rw-r--r--lib/Makefile.in8
-rw-r--r--lib/_Noreturn.h2
-rw-r--r--lib/acl-errno-valid.c2
-rw-r--r--lib/acl-internal.c2
-rw-r--r--lib/acl-internal.h2
-rw-r--r--lib/acl.h2
-rw-r--r--lib/acl_entries.c2
-rw-r--r--lib/alloca.in.h2
-rw-r--r--lib/allocator.h2
-rw-r--r--lib/arg-nonnull.h2
-rw-r--r--lib/at-func.c2
-rw-r--r--lib/attribute.h25
-rw-r--r--lib/binary-io.c2
-rw-r--r--lib/binary-io.h2
-rw-r--r--lib/byteswap.in.h2
-rw-r--r--lib/c++defs.h10
-rw-r--r--lib/c-ctype.h2
-rw-r--r--lib/c-strcase.h2
-rw-r--r--lib/c-strcasecmp.c2
-rw-r--r--lib/c-strncasecmp.c2
-rw-r--r--lib/canonicalize-lgpl.c495
-rw-r--r--lib/careadlinkat.c32
-rw-r--r--lib/careadlinkat.h2
-rw-r--r--lib/cdefs.h6
-rw-r--r--lib/cloexec.c2
-rw-r--r--lib/cloexec.h2
-rw-r--r--lib/close-stream.c2
-rw-r--r--lib/copy-file-range.c2
-rw-r--r--lib/count-leading-zeros.h2
-rw-r--r--lib/count-one-bits.h2
-rw-r--r--lib/count-trailing-zeros.h2
-rw-r--r--lib/diffseq.h2
-rw-r--r--lib/dirent.in.h2
-rw-r--r--lib/dirfd.c2
-rw-r--r--lib/dtotimespec.c2
-rw-r--r--lib/dup2.c2
-rw-r--r--lib/eloop-threshold.h83
-rw-r--r--lib/errno.in.h2
-rw-r--r--lib/euidaccess.c11
-rw-r--r--lib/execinfo.in.h2
-rw-r--r--lib/explicit_bzero.c2
-rw-r--r--lib/faccessat.c2
-rw-r--r--lib/fchmodat.c2
-rw-r--r--lib/fcntl.c6
-rw-r--r--lib/fcntl.in.h39
-rw-r--r--lib/fdopendir.c2
-rw-r--r--lib/filemode.c16
-rw-r--r--lib/filemode.h2
-rw-r--r--lib/filename.h22
-rw-r--r--lib/filevercmp.c2
-rw-r--r--lib/filevercmp.h2
-rw-r--r--lib/fingerprint.c2
-rw-r--r--lib/fingerprint.h2
-rw-r--r--lib/flexmember.h2
-rw-r--r--lib/fpending.c9
-rw-r--r--lib/fpending.h2
-rw-r--r--lib/free.c33
-rw-r--r--lib/fstatat.c2
-rw-r--r--lib/fsusage.c2
-rw-r--r--lib/fsusage.h2
-rw-r--r--lib/fsync.c2
-rw-r--r--lib/ftoastr.c2
-rw-r--r--lib/ftoastr.h2
-rw-r--r--lib/futimens.c2
-rw-r--r--lib/get-permissions.c2
-rw-r--r--lib/getdtablesize.c2
-rw-r--r--lib/getgroups.c2
-rw-r--r--lib/getloadavg.c2
-rw-r--r--lib/getopt-cdefs.in.h2
-rw-r--r--lib/getopt-core.h2
-rw-r--r--lib/getopt-ext.h2
-rw-r--r--lib/getopt-pfx-core.h2
-rw-r--r--lib/getopt-pfx-ext.h2
-rw-r--r--lib/getopt.c2
-rw-r--r--lib/getopt.in.h2
-rw-r--r--lib/getopt1.c2
-rw-r--r--lib/getopt_int.h2
-rw-r--r--lib/getrandom.c2
-rw-r--r--lib/gettext.h2
-rw-r--r--lib/gettime.c2
-rw-r--r--lib/gettimeofday.c2
-rw-r--r--lib/gnulib.mk.in218
-rw-r--r--lib/group-member.c2
-rw-r--r--lib/idx.h114
-rw-r--r--lib/ieee754.in.h2
-rw-r--r--lib/ignore-value.h2
-rw-r--r--lib/intprops.h52
-rw-r--r--lib/inttypes.in.h2
-rw-r--r--lib/lchmod.c2
-rw-r--r--lib/libc-config.h2
-rw-r--r--lib/limits.in.h2
-rw-r--r--lib/lstat.c2
-rw-r--r--lib/malloc/scratch_buffer.h151
-rw-r--r--lib/malloc/scratch_buffer_dupfree.c41
-rw-r--r--lib/malloc/scratch_buffer_grow.c56
-rw-r--r--lib/malloc/scratch_buffer_grow_preserve.c67
-rw-r--r--lib/malloc/scratch_buffer_set_array_size.c64
-rw-r--r--lib/malloca.c3
-rw-r--r--lib/malloca.h2
-rw-r--r--lib/md5.c2
-rw-r--r--lib/md5.h2
-rw-r--r--lib/memmem.c2
-rw-r--r--lib/mempcpy.c2
-rw-r--r--lib/memrchr.c2
-rw-r--r--lib/mini-gmp-gnulib.c2
-rw-r--r--lib/mini-gmp.c58
-rw-r--r--lib/mini-gmp.h5
-rw-r--r--lib/minmax.h2
-rw-r--r--lib/mkostemp.c2
-rw-r--r--lib/mktime.c2
-rw-r--r--lib/nstrftime.c2
-rw-r--r--lib/open.c2
-rw-r--r--lib/openat-priv.h2
-rw-r--r--lib/openat-proc.c2
-rw-r--r--lib/openat.h2
-rw-r--r--lib/pathmax.h2
-rw-r--r--lib/pipe2.c2
-rw-r--r--lib/pselect.c2
-rw-r--r--lib/pthread_sigmask.c2
-rw-r--r--lib/qcopy-acl.c2
-rw-r--r--lib/rawmemchr.c136
-rw-r--r--lib/rawmemchr.valgrind28
-rw-r--r--lib/readlink.c50
-rw-r--r--lib/readlinkat.c49
-rw-r--r--lib/regcomp.c2
-rw-r--r--lib/regex.h2
-rw-r--r--lib/regex_internal.c21
-rw-r--r--lib/regex_internal.h10
-rw-r--r--lib/root-uid.h2
-rw-r--r--lib/save-cwd.c2
-rw-r--r--lib/save-cwd.h2
-rw-r--r--lib/scratch_buffer.h29
-rw-r--r--lib/set-permissions.c2
-rw-r--r--lib/sha1.c2
-rw-r--r--lib/sha1.h2
-rw-r--r--lib/sha256.c2
-rw-r--r--lib/sha256.h2
-rw-r--r--lib/sha512.c2
-rw-r--r--lib/sha512.h2
-rw-r--r--lib/sig2str.c2
-rw-r--r--lib/sig2str.h2
-rw-r--r--lib/sigdescr_np.c2
-rw-r--r--lib/signal.in.h8
-rw-r--r--lib/stat-time.h2
-rw-r--r--lib/stdalign.in.h2
-rw-r--r--lib/stddef.in.h2
-rw-r--r--lib/stdint.in.h7
-rw-r--r--lib/stdio-impl.h4
-rw-r--r--lib/stdio.in.h205
-rw-r--r--lib/stdlib.in.h187
-rw-r--r--lib/stpcpy.c2
-rw-r--r--lib/str-two-way.h2
-rw-r--r--lib/strftime.h2
-rw-r--r--lib/string.in.h42
-rw-r--r--lib/strnlen.c2
-rw-r--r--lib/strtoimax.c2
-rw-r--r--lib/strtol.c2
-rw-r--r--lib/strtoll.c2
-rw-r--r--lib/symlink.c4
-rw-r--r--lib/sys_random.in.h2
-rw-r--r--lib/sys_select.in.h11
-rw-r--r--lib/sys_stat.in.h91
-rw-r--r--lib/sys_time.in.h2
-rw-r--r--lib/sys_types.in.h2
-rw-r--r--lib/tempname.c51
-rw-r--r--lib/tempname.h2
-rw-r--r--lib/time-internal.h2
-rw-r--r--lib/time.in.h25
-rw-r--r--lib/time_r.c2
-rw-r--r--lib/time_rz.c18
-rw-r--r--lib/timespec-add.c2
-rw-r--r--lib/timespec-sub.c2
-rw-r--r--lib/timespec.h2
-rw-r--r--lib/u64.h2
-rw-r--r--lib/unistd.in.h563
-rw-r--r--lib/unlocked-io.h2
-rw-r--r--lib/utimens.c2
-rw-r--r--lib/utimens.h2
-rw-r--r--lib/utimensat.c2
-rw-r--r--lib/verify.h2
-rw-r--r--lib/vla.h2
-rw-r--r--lib/warn-on-use.h2
-rw-r--r--lib/xalloc-oversized.h4
-rw-r--r--lisp/ChangeLog.12
-rw-r--r--lisp/ChangeLog.102
-rw-r--r--lisp/ChangeLog.112
-rw-r--r--lisp/ChangeLog.122
-rw-r--r--lisp/ChangeLog.132
-rw-r--r--lisp/ChangeLog.142
-rw-r--r--lisp/ChangeLog.152
-rw-r--r--lisp/ChangeLog.162
-rw-r--r--lisp/ChangeLog.172
-rw-r--r--lisp/ChangeLog.22
-rw-r--r--lisp/ChangeLog.32
-rw-r--r--lisp/ChangeLog.42
-rw-r--r--lisp/ChangeLog.52
-rw-r--r--lisp/ChangeLog.62
-rw-r--r--lisp/ChangeLog.72
-rw-r--r--lisp/ChangeLog.82
-rw-r--r--lisp/ChangeLog.92
-rw-r--r--lisp/Makefile.in2
-rw-r--r--lisp/abbrev.el2
-rw-r--r--lisp/align.el167
-rw-r--r--lisp/allout-widgets.el32
-rw-r--r--lisp/allout.el16
-rw-r--r--lisp/ansi-color.el52
-rw-r--r--lisp/apropos.el11
-rw-r--r--lisp/arc-mode.el62
-rw-r--r--lisp/array.el60
-rw-r--r--lisp/auth-source-pass.el2
-rw-r--r--lisp/auth-source.el47
-rw-r--r--lisp/autoarg.el2
-rw-r--r--lisp/autoinsert.el4
-rw-r--r--lisp/autorevert.el31
-rw-r--r--lisp/avoid.el2
-rw-r--r--lisp/battery.el12
-rw-r--r--lisp/bindings.el8
-rw-r--r--lisp/bookmark.el35
-rw-r--r--lisp/bs.el2
-rw-r--r--lisp/buff-menu.el6
-rw-r--r--lisp/button.el16
-rw-r--r--lisp/calc/calc-aent.el37
-rw-r--r--lisp/calc/calc-alg.el9
-rw-r--r--lisp/calc/calc-arith.el12
-rw-r--r--lisp/calc/calc-bin.el54
-rw-r--r--lisp/calc/calc-comb.el12
-rw-r--r--lisp/calc/calc-cplx.el2
-rw-r--r--lisp/calc/calc-embed.el6
-rw-r--r--lisp/calc/calc-ext.el72
-rw-r--r--lisp/calc/calc-fin.el2
-rw-r--r--lisp/calc/calc-forms.el4
-rw-r--r--lisp/calc/calc-frac.el7
-rw-r--r--lisp/calc/calc-funcs.el17
-rw-r--r--lisp/calc/calc-graph.el4
-rw-r--r--lisp/calc/calc-help.el52
-rw-r--r--lisp/calc/calc-incom.el2
-rw-r--r--lisp/calc/calc-keypd.el2
-rw-r--r--lisp/calc/calc-lang.el368
-rw-r--r--lisp/calc/calc-macs.el16
-rw-r--r--lisp/calc/calc-map.el45
-rw-r--r--lisp/calc/calc-math.el18
-rw-r--r--lisp/calc/calc-menu.el2
-rw-r--r--lisp/calc/calc-misc.el13
-rw-r--r--lisp/calc/calc-mode.el4
-rw-r--r--lisp/calc/calc-mtx.el8
-rw-r--r--lisp/calc/calc-nlfit.el2
-rw-r--r--lisp/calc/calc-poly.el23
-rw-r--r--lisp/calc/calc-prog.el41
-rw-r--r--lisp/calc/calc-rewr.el79
-rw-r--r--lisp/calc/calc-rules.el2
-rw-r--r--lisp/calc/calc-sel.el14
-rw-r--r--lisp/calc/calc-stat.el2
-rw-r--r--lisp/calc/calc-store.el81
-rw-r--r--lisp/calc/calc-stuff.el8
-rw-r--r--lisp/calc/calc-trail.el2
-rw-r--r--lisp/calc/calc-undo.el2
-rw-r--r--lisp/calc/calc-units.el44
-rw-r--r--lisp/calc/calc-vec.el20
-rw-r--r--lisp/calc/calc-yank.el101
-rw-r--r--lisp/calc/calc.el46
-rw-r--r--lisp/calc/calcalg2.el585
-rw-r--r--lisp/calc/calcalg3.el18
-rw-r--r--lisp/calc/calccomp.el369
-rw-r--r--lisp/calc/calcsel2.el2
-rw-r--r--lisp/calculator.el2
-rw-r--r--lisp/calendar/appt.el6
-rw-r--r--lisp/calendar/cal-bahai.el2
-rw-r--r--lisp/calendar/cal-china.el2
-rw-r--r--lisp/calendar/cal-coptic.el2
-rw-r--r--lisp/calendar/cal-dst.el2
-rw-r--r--lisp/calendar/cal-french.el2
-rw-r--r--lisp/calendar/cal-hebrew.el2
-rw-r--r--lisp/calendar/cal-html.el2
-rw-r--r--lisp/calendar/cal-islam.el2
-rw-r--r--lisp/calendar/cal-iso.el2
-rw-r--r--lisp/calendar/cal-julian.el2
-rw-r--r--lisp/calendar/cal-mayan.el2
-rw-r--r--lisp/calendar/cal-menu.el2
-rw-r--r--lisp/calendar/cal-move.el2
-rw-r--r--lisp/calendar/cal-persia.el2
-rw-r--r--lisp/calendar/cal-tex.el2
-rw-r--r--lisp/calendar/cal-x.el2
-rw-r--r--lisp/calendar/calendar.el4
-rw-r--r--lisp/calendar/diary-lib.el49
-rw-r--r--lisp/calendar/holidays.el2
-rw-r--r--lisp/calendar/icalendar.el2
-rw-r--r--lisp/calendar/iso8601.el2
-rw-r--r--lisp/calendar/lunar.el2
-rw-r--r--lisp/calendar/parse-time.el2
-rw-r--r--lisp/calendar/solar.el2
-rw-r--r--lisp/calendar/time-date.el2
-rw-r--r--lisp/calendar/timeclock.el4
-rw-r--r--lisp/calendar/todo-mode.el29
-rw-r--r--lisp/case-table.el42
-rw-r--r--lisp/cdl.el2
-rw-r--r--lisp/cedet/ChangeLog.12
-rw-r--r--lisp/cedet/cedet-cscope.el2
-rw-r--r--lisp/cedet/cedet-files.el2
-rw-r--r--lisp/cedet/cedet-global.el2
-rw-r--r--lisp/cedet/cedet-idutils.el2
-rw-r--r--lisp/cedet/cedet.el2
-rw-r--r--lisp/cedet/data-debug.el8
-rw-r--r--lisp/cedet/ede.el2
-rw-r--r--lisp/cedet/ede/auto.el26
-rw-r--r--lisp/cedet/ede/autoconf-edit.el2
-rw-r--r--lisp/cedet/ede/base.el7
-rw-r--r--lisp/cedet/ede/config.el2
-rw-r--r--lisp/cedet/ede/cpp-root.el2
-rw-r--r--lisp/cedet/ede/custom.el5
-rw-r--r--lisp/cedet/ede/detect.el2
-rw-r--r--lisp/cedet/ede/dired.el2
-rw-r--r--lisp/cedet/ede/emacs.el2
-rw-r--r--lisp/cedet/ede/files.el2
-rw-r--r--lisp/cedet/ede/generic.el6
-rw-r--r--lisp/cedet/ede/linux.el2
-rw-r--r--lisp/cedet/ede/locate.el2
-rw-r--r--lisp/cedet/ede/make.el2
-rw-r--r--lisp/cedet/ede/makefile-edit.el2
-rw-r--r--lisp/cedet/ede/pconf.el2
-rw-r--r--lisp/cedet/ede/pmake.el4
-rw-r--r--lisp/cedet/ede/proj-archive.el2
-rw-r--r--lisp/cedet/ede/proj-aux.el2
-rw-r--r--lisp/cedet/ede/proj-comp.el2
-rw-r--r--lisp/cedet/ede/proj-elisp.el5
-rw-r--r--lisp/cedet/ede/proj-info.el2
-rw-r--r--lisp/cedet/ede/proj-misc.el2
-rw-r--r--lisp/cedet/ede/proj-obj.el2
-rw-r--r--lisp/cedet/ede/proj-prog.el2
-rw-r--r--lisp/cedet/ede/proj-scheme.el2
-rw-r--r--lisp/cedet/ede/proj-shared.el2
-rw-r--r--lisp/cedet/ede/proj.el4
-rw-r--r--lisp/cedet/ede/project-am.el5
-rw-r--r--lisp/cedet/ede/shell.el2
-rw-r--r--lisp/cedet/ede/simple.el2
-rw-r--r--lisp/cedet/ede/source.el2
-rw-r--r--lisp/cedet/ede/speedbar.el2
-rw-r--r--lisp/cedet/ede/srecode.el2
-rw-r--r--lisp/cedet/ede/system.el2
-rw-r--r--lisp/cedet/ede/util.el2
-rw-r--r--lisp/cedet/inversion.el8
-rw-r--r--lisp/cedet/mode-local.el4
-rw-r--r--lisp/cedet/pulse.el2
-rw-r--r--lisp/cedet/semantic.el7
-rw-r--r--lisp/cedet/semantic/analyze.el8
-rw-r--r--lisp/cedet/semantic/analyze/complete.el2
-rw-r--r--lisp/cedet/semantic/analyze/debug.el4
-rw-r--r--lisp/cedet/semantic/analyze/fcn.el2
-rw-r--r--lisp/cedet/semantic/analyze/refs.el8
-rw-r--r--lisp/cedet/semantic/bovine.el2
-rw-r--r--lisp/cedet/semantic/bovine/c.el5
-rw-r--r--lisp/cedet/semantic/bovine/debug.el2
-rw-r--r--lisp/cedet/semantic/bovine/el.el28
-rw-r--r--lisp/cedet/semantic/bovine/gcc.el2
-rw-r--r--lisp/cedet/semantic/bovine/grammar.el2
-rw-r--r--lisp/cedet/semantic/bovine/make.el5
-rw-r--r--lisp/cedet/semantic/bovine/scm.el2
-rw-r--r--lisp/cedet/semantic/chart.el2
-rw-r--r--lisp/cedet/semantic/complete.el2
-rw-r--r--lisp/cedet/semantic/ctxt.el2
-rw-r--r--lisp/cedet/semantic/db-debug.el2
-rw-r--r--lisp/cedet/semantic/db-ebrowse.el2
-rw-r--r--lisp/cedet/semantic/db-el.el2
-rw-r--r--lisp/cedet/semantic/db-file.el2
-rw-r--r--lisp/cedet/semantic/db-find.el2
-rw-r--r--lisp/cedet/semantic/db-global.el2
-rw-r--r--lisp/cedet/semantic/db-javascript.el2
-rw-r--r--lisp/cedet/semantic/db-mode.el2
-rw-r--r--lisp/cedet/semantic/db-ref.el2
-rw-r--r--lisp/cedet/semantic/db-typecache.el4
-rw-r--r--lisp/cedet/semantic/db.el2
-rw-r--r--lisp/cedet/semantic/debug.el2
-rw-r--r--lisp/cedet/semantic/decorate.el2
-rw-r--r--lisp/cedet/semantic/decorate/include.el2
-rw-r--r--lisp/cedet/semantic/decorate/mode.el2
-rw-r--r--lisp/cedet/semantic/dep.el2
-rw-r--r--lisp/cedet/semantic/doc.el4
-rw-r--r--lisp/cedet/semantic/ede-grammar.el2
-rw-r--r--lisp/cedet/semantic/edit.el2
-rw-r--r--lisp/cedet/semantic/find.el2
-rw-r--r--lisp/cedet/semantic/format.el13
-rw-r--r--lisp/cedet/semantic/fw.el2
-rw-r--r--lisp/cedet/semantic/grammar-wy.el2
-rw-r--r--lisp/cedet/semantic/grammar.el60
-rw-r--r--lisp/cedet/semantic/html.el2
-rw-r--r--lisp/cedet/semantic/ia-sb.el2
-rw-r--r--lisp/cedet/semantic/ia.el13
-rw-r--r--lisp/cedet/semantic/idle.el2
-rw-r--r--lisp/cedet/semantic/imenu.el5
-rw-r--r--lisp/cedet/semantic/java.el2
-rw-r--r--lisp/cedet/semantic/lex-spp.el2
-rw-r--r--lisp/cedet/semantic/lex.el2
-rw-r--r--lisp/cedet/semantic/mru-bookmark.el2
-rw-r--r--lisp/cedet/semantic/sb.el2
-rw-r--r--lisp/cedet/semantic/scope.el2
-rw-r--r--lisp/cedet/semantic/senator.el22
-rw-r--r--lisp/cedet/semantic/sort.el8
-rw-r--r--lisp/cedet/semantic/symref.el9
-rw-r--r--lisp/cedet/semantic/symref/cscope.el2
-rw-r--r--lisp/cedet/semantic/symref/filter.el2
-rw-r--r--lisp/cedet/semantic/symref/global.el2
-rw-r--r--lisp/cedet/semantic/symref/grep.el25
-rw-r--r--lisp/cedet/semantic/symref/idutils.el2
-rw-r--r--lisp/cedet/semantic/symref/list.el6
-rw-r--r--lisp/cedet/semantic/tag-file.el2
-rw-r--r--lisp/cedet/semantic/tag-ls.el7
-rw-r--r--lisp/cedet/semantic/tag-write.el2
-rw-r--r--lisp/cedet/semantic/tag.el13
-rw-r--r--lisp/cedet/semantic/texi.el2
-rw-r--r--lisp/cedet/semantic/util-modes.el9
-rw-r--r--lisp/cedet/semantic/util.el2
-rw-r--r--lisp/cedet/semantic/wisent.el2
-rw-r--r--lisp/cedet/semantic/wisent/comp.el2
-rw-r--r--lisp/cedet/semantic/wisent/grammar.el2
-rw-r--r--lisp/cedet/semantic/wisent/java-tags.el2
-rw-r--r--lisp/cedet/semantic/wisent/javascript.el2
-rw-r--r--lisp/cedet/semantic/wisent/python.el6
-rw-r--r--lisp/cedet/semantic/wisent/wisent.el2
-rw-r--r--lisp/cedet/srecode.el4
-rw-r--r--lisp/cedet/srecode/args.el2
-rw-r--r--lisp/cedet/srecode/compile.el2
-rw-r--r--lisp/cedet/srecode/cpp.el2
-rw-r--r--lisp/cedet/srecode/ctxt.el2
-rw-r--r--lisp/cedet/srecode/dictionary.el2
-rw-r--r--lisp/cedet/srecode/document.el2
-rw-r--r--lisp/cedet/srecode/el.el2
-rw-r--r--lisp/cedet/srecode/expandproto.el2
-rw-r--r--lisp/cedet/srecode/extract.el2
-rw-r--r--lisp/cedet/srecode/fields.el2
-rw-r--r--lisp/cedet/srecode/filters.el2
-rw-r--r--lisp/cedet/srecode/find.el2
-rw-r--r--lisp/cedet/srecode/getset.el2
-rw-r--r--lisp/cedet/srecode/insert.el2
-rw-r--r--lisp/cedet/srecode/java.el2
-rw-r--r--lisp/cedet/srecode/map.el2
-rw-r--r--lisp/cedet/srecode/mode.el2
-rw-r--r--lisp/cedet/srecode/semantic.el10
-rw-r--r--lisp/cedet/srecode/srt-mode.el26
-rw-r--r--lisp/cedet/srecode/srt.el2
-rw-r--r--lisp/cedet/srecode/table.el2
-rw-r--r--lisp/cedet/srecode/template.el2
-rw-r--r--lisp/cedet/srecode/texi.el2
-rw-r--r--lisp/char-fold.el2
-rw-r--r--lisp/chistory.el4
-rw-r--r--lisp/cmuscheme.el2
-rw-r--r--lisp/color.el2
-rw-r--r--lisp/comint.el66
-rw-r--r--lisp/completion.el2
-rw-r--r--lisp/composite.el10
-rw-r--r--lisp/cus-dep.el4
-rw-r--r--lisp/cus-edit.el217
-rw-r--r--lisp/cus-face.el9
-rw-r--r--lisp/cus-start.el9
-rw-r--r--lisp/cus-theme.el2
-rw-r--r--lisp/custom.el69
-rw-r--r--lisp/dabbrev.el12
-rw-r--r--lisp/delim-col.el2
-rw-r--r--lisp/delsel.el4
-rw-r--r--lisp/descr-text.el15
-rw-r--r--lisp/desktop.el10
-rw-r--r--lisp/dframe.el13
-rw-r--r--lisp/dired-aux.el22
-rw-r--r--lisp/dired-x.el6
-rw-r--r--lisp/dired.el19
-rw-r--r--lisp/dirtrack.el2
-rw-r--r--lisp/disp-table.el6
-rw-r--r--lisp/display-fill-column-indicator.el2
-rw-r--r--lisp/display-line-numbers.el2
-rw-r--r--lisp/dnd.el2
-rw-r--r--lisp/doc-view.el26
-rw-r--r--lisp/dom.el2
-rw-r--r--lisp/dos-fns.el4
-rw-r--r--lisp/dos-vars.el2
-rw-r--r--lisp/dos-w32.el12
-rw-r--r--lisp/double.el2
-rw-r--r--lisp/dynamic-setting.el2
-rw-r--r--lisp/ebuff-menu.el9
-rw-r--r--lisp/echistory.el2
-rw-r--r--lisp/ecomplete.el2
-rw-r--r--lisp/edmacro.el59
-rw-r--r--lisp/ehelp.el3
-rw-r--r--lisp/elec-pair.el2
-rw-r--r--lisp/electric.el6
-rw-r--r--lisp/elide-head.el2
-rw-r--r--lisp/emacs-lisp/advice.el82
-rw-r--r--lisp/emacs-lisp/autoload.el30
-rw-r--r--lisp/emacs-lisp/avl-tree.el2
-rw-r--r--lisp/emacs-lisp/backquote.el2
-rw-r--r--lisp/emacs-lisp/backtrace.el2
-rw-r--r--lisp/emacs-lisp/benchmark.el4
-rw-r--r--lisp/emacs-lisp/bindat.el2
-rw-r--r--lisp/emacs-lisp/byte-opt.el365
-rw-r--r--lisp/emacs-lisp/byte-run.el31
-rw-r--r--lisp/emacs-lisp/bytecomp.el392
-rw-r--r--lisp/emacs-lisp/cconv.el2
-rw-r--r--lisp/emacs-lisp/chart.el7
-rw-r--r--lisp/emacs-lisp/check-declare.el2
-rw-r--r--lisp/emacs-lisp/checkdoc.el3
-rw-r--r--lisp/emacs-lisp/cl-extra.el31
-rw-r--r--lisp/emacs-lisp/cl-generic.el46
-rw-r--r--lisp/emacs-lisp/cl-indent.el2
-rw-r--r--lisp/emacs-lisp/cl-lib.el2
-rw-r--r--lisp/emacs-lisp/cl-macs.el156
-rw-r--r--lisp/emacs-lisp/cl-preloaded.el2
-rw-r--r--lisp/emacs-lisp/cl-print.el4
-rw-r--r--lisp/emacs-lisp/cl-seq.el15
-rw-r--r--lisp/emacs-lisp/copyright.el4
-rw-r--r--lisp/emacs-lisp/crm.el2
-rw-r--r--lisp/emacs-lisp/cursor-sensor.el2
-rw-r--r--lisp/emacs-lisp/debug.el3
-rw-r--r--lisp/emacs-lisp/derived.el44
-rw-r--r--lisp/emacs-lisp/disass.el2
-rw-r--r--lisp/emacs-lisp/easy-mmode.el51
-rw-r--r--lisp/emacs-lisp/easymenu.el10
-rw-r--r--lisp/emacs-lisp/edebug.el25
-rw-r--r--lisp/emacs-lisp/eieio-base.el137
-rw-r--r--lisp/emacs-lisp/eieio-compat.el2
-rw-r--r--lisp/emacs-lisp/eieio-core.el9
-rw-r--r--lisp/emacs-lisp/eieio-custom.el12
-rw-r--r--lisp/emacs-lisp/eieio-datadebug.el2
-rw-r--r--lisp/emacs-lisp/eieio-opt.el6
-rw-r--r--lisp/emacs-lisp/eieio-speedbar.el2
-rw-r--r--lisp/emacs-lisp/eieio.el2
-rw-r--r--lisp/emacs-lisp/eldoc.el12
-rw-r--r--lisp/emacs-lisp/elint.el27
-rw-r--r--lisp/emacs-lisp/elp.el2
-rw-r--r--lisp/emacs-lisp/ert-x.el21
-rw-r--r--lisp/emacs-lisp/ert.el30
-rw-r--r--lisp/emacs-lisp/ewoc.el2
-rw-r--r--lisp/emacs-lisp/faceup.el2
-rw-r--r--lisp/emacs-lisp/find-func.el69
-rw-r--r--lisp/emacs-lisp/float-sup.el2
-rw-r--r--lisp/emacs-lisp/generator.el2
-rw-r--r--lisp/emacs-lisp/generic.el2
-rw-r--r--lisp/emacs-lisp/gv.el7
-rw-r--r--lisp/emacs-lisp/helper.el2
-rw-r--r--lisp/emacs-lisp/hierarchy.el2
-rw-r--r--lisp/emacs-lisp/inline.el2
-rw-r--r--lisp/emacs-lisp/let-alist.el2
-rw-r--r--lisp/emacs-lisp/lisp-mnt.el4
-rw-r--r--lisp/emacs-lisp/lisp-mode.el31
-rw-r--r--lisp/emacs-lisp/lisp.el18
-rw-r--r--lisp/emacs-lisp/macroexp.el31
-rw-r--r--lisp/emacs-lisp/map-ynp.el2
-rw-r--r--lisp/emacs-lisp/map.el2
-rw-r--r--lisp/emacs-lisp/memory-report.el317
-rw-r--r--lisp/emacs-lisp/nadvice.el2
-rw-r--r--lisp/emacs-lisp/package-x.el2
-rw-r--r--lisp/emacs-lisp/package.el234
-rw-r--r--lisp/emacs-lisp/pcase.el78
-rw-r--r--lisp/emacs-lisp/pp.el44
-rw-r--r--lisp/emacs-lisp/radix-tree.el9
-rw-r--r--lisp/emacs-lisp/re-builder.el8
-rw-r--r--lisp/emacs-lisp/regexp-opt.el2
-rw-r--r--lisp/emacs-lisp/regi.el23
-rw-r--r--lisp/emacs-lisp/ring.el2
-rw-r--r--lisp/emacs-lisp/rmc.el2
-rw-r--r--lisp/emacs-lisp/rx.el5
-rw-r--r--lisp/emacs-lisp/seq.el9
-rw-r--r--lisp/emacs-lisp/shadow.el7
-rw-r--r--lisp/emacs-lisp/shortdoc.el49
-rw-r--r--lisp/emacs-lisp/smie.el6
-rw-r--r--lisp/emacs-lisp/subr-x.el98
-rw-r--r--lisp/emacs-lisp/syntax.el4
-rw-r--r--lisp/emacs-lisp/tabulated-list.el35
-rw-r--r--lisp/emacs-lisp/tcover-ses.el2
-rw-r--r--lisp/emacs-lisp/testcover.el2
-rw-r--r--lisp/emacs-lisp/text-property-search.el2
-rw-r--r--lisp/emacs-lisp/thunk.el4
-rw-r--r--lisp/emacs-lisp/timer-list.el8
-rw-r--r--lisp/emacs-lisp/timer.el2
-rw-r--r--lisp/emacs-lisp/tq.el2
-rw-r--r--lisp/emacs-lisp/trace.el4
-rw-r--r--lisp/emacs-lisp/unsafep.el2
-rw-r--r--lisp/emacs-lisp/warnings.el9
-rw-r--r--lisp/emacs-lock.el2
-rw-r--r--lisp/emulation/cua-base.el12
-rw-r--r--lisp/emulation/cua-gmrk.el2
-rw-r--r--lisp/emulation/cua-rect.el2
-rw-r--r--lisp/emulation/edt-lk201.el4
-rw-r--r--lisp/emulation/edt-mapper.el2
-rw-r--r--lisp/emulation/edt-pc.el4
-rw-r--r--lisp/emulation/edt-vt100.el4
-rw-r--r--lisp/emulation/edt.el19
-rw-r--r--lisp/emulation/keypad.el2
-rw-r--r--lisp/emulation/viper-cmd.el16
-rw-r--r--lisp/emulation/viper-ex.el2
-rw-r--r--lisp/emulation/viper-init.el7
-rw-r--r--lisp/emulation/viper-keym.el4
-rw-r--r--lisp/emulation/viper-macs.el2
-rw-r--r--lisp/emulation/viper-mous.el2
-rw-r--r--lisp/emulation/viper-util.el12
-rw-r--r--lisp/emulation/viper.el4
-rw-r--r--lisp/env.el2
-rw-r--r--lisp/epa-dired.el2
-rw-r--r--lisp/epa-file.el5
-rw-r--r--lisp/epa-hook.el2
-rw-r--r--lisp/epa-mail.el4
-rw-r--r--lisp/epa.el15
-rw-r--r--lisp/epg-config.el2
-rw-r--r--lisp/epg.el9
-rw-r--r--lisp/erc/ChangeLog.12
-rw-r--r--lisp/erc/ChangeLog.22
-rw-r--r--lisp/erc/erc-autoaway.el2
-rw-r--r--lisp/erc/erc-backend.el2
-rw-r--r--lisp/erc/erc-button.el3
-rw-r--r--lisp/erc/erc-capab.el2
-rw-r--r--lisp/erc/erc-dcc.el5
-rw-r--r--lisp/erc/erc-desktop-notifications.el2
-rw-r--r--lisp/erc/erc-ezbounce.el2
-rw-r--r--lisp/erc/erc-fill.el2
-rw-r--r--lisp/erc/erc-goodies.el5
-rw-r--r--lisp/erc/erc-ibuffer.el2
-rw-r--r--lisp/erc/erc-identd.el2
-rw-r--r--lisp/erc/erc-imenu.el2
-rw-r--r--lisp/erc/erc-join.el2
-rw-r--r--lisp/erc/erc-lang.el2
-rw-r--r--lisp/erc/erc-list.el14
-rw-r--r--lisp/erc/erc-log.el7
-rw-r--r--lisp/erc/erc-match.el2
-rw-r--r--lisp/erc/erc-menu.el17
-rw-r--r--lisp/erc/erc-netsplit.el2
-rw-r--r--lisp/erc/erc-networks.el2
-rw-r--r--lisp/erc/erc-notify.el2
-rw-r--r--lisp/erc/erc-page.el2
-rw-r--r--lisp/erc/erc-pcomplete.el24
-rw-r--r--lisp/erc/erc-replace.el2
-rw-r--r--lisp/erc/erc-ring.el2
-rw-r--r--lisp/erc/erc-services.el58
-rw-r--r--lisp/erc/erc-sound.el2
-rw-r--r--lisp/erc/erc-speedbar.el2
-rw-r--r--lisp/erc/erc-spelling.el2
-rw-r--r--lisp/erc/erc-stamp.el2
-rw-r--r--lisp/erc/erc-status-sidebar.el2
-rw-r--r--lisp/erc/erc-track.el2
-rw-r--r--lisp/erc/erc-truncate.el2
-rw-r--r--lisp/erc/erc-xdcc.el2
-rw-r--r--lisp/erc/erc.el102
-rw-r--r--lisp/eshell/em-alias.el2
-rw-r--r--lisp/eshell/em-banner.el2
-rw-r--r--lisp/eshell/em-basic.el11
-rw-r--r--lisp/eshell/em-cmpl.el123
-rw-r--r--lisp/eshell/em-dirs.el13
-rw-r--r--lisp/eshell/em-glob.el6
-rw-r--r--lisp/eshell/em-hist.el72
-rw-r--r--lisp/eshell/em-ls.el84
-rw-r--r--lisp/eshell/em-pred.el48
-rw-r--r--lisp/eshell/em-prompt.el14
-rw-r--r--lisp/eshell/em-rebind.el7
-rw-r--r--lisp/eshell/em-script.el8
-rw-r--r--lisp/eshell/em-smart.el33
-rw-r--r--lisp/eshell/em-term.el10
-rw-r--r--lisp/eshell/em-tramp.el9
-rw-r--r--lisp/eshell/em-unix.el39
-rw-r--r--lisp/eshell/em-xtra.el2
-rw-r--r--lisp/eshell/esh-arg.el85
-rw-r--r--lisp/eshell/esh-cmd.el46
-rw-r--r--lisp/eshell/esh-ext.el2
-rw-r--r--lisp/eshell/esh-io.el9
-rw-r--r--lisp/eshell/esh-mode.el97
-rw-r--r--lisp/eshell/esh-module.el21
-rw-r--r--lisp/eshell/esh-opt.el2
-rw-r--r--lisp/eshell/esh-proc.el12
-rw-r--r--lisp/eshell/esh-util.el2
-rw-r--r--lisp/eshell/esh-var.el30
-rw-r--r--lisp/eshell/eshell.el2
-rw-r--r--lisp/expand.el4
-rw-r--r--lisp/ezimage.el2
-rw-r--r--lisp/face-remap.el69
-rw-r--r--lisp/facemenu.el19
-rw-r--r--lisp/faces.el8
-rw-r--r--lisp/ffap.el47
-rw-r--r--lisp/filecache.el2
-rw-r--r--lisp/fileloop.el2
-rw-r--r--lisp/filenotify.el2
-rw-r--r--lisp/files-x.el12
-rw-r--r--lisp/files.el110
-rw-r--r--lisp/filesets.el601
-rw-r--r--lisp/find-cmd.el2
-rw-r--r--lisp/find-dired.el17
-rw-r--r--lisp/find-file.el2
-rw-r--r--lisp/find-lisp.el44
-rw-r--r--lisp/finder.el20
-rw-r--r--lisp/flow-ctrl.el2
-rw-r--r--lisp/foldout.el29
-rw-r--r--lisp/follow.el2
-rw-r--r--lisp/font-core.el12
-rw-r--r--lisp/font-lock.el33
-rw-r--r--lisp/format-spec.el105
-rw-r--r--lisp/format.el12
-rw-r--r--lisp/forms.el65
-rw-r--r--lisp/frame.el26
-rw-r--r--lisp/frameset.el2
-rw-r--r--lisp/fringe.el2
-rw-r--r--lisp/generic-x.el123
-rw-r--r--lisp/gnus/ChangeLog.12
-rw-r--r--lisp/gnus/ChangeLog.22
-rw-r--r--lisp/gnus/ChangeLog.32
-rw-r--r--lisp/gnus/canlock.el2
-rw-r--r--lisp/gnus/deuglify.el14
-rw-r--r--lisp/gnus/gmm-utils.el2
-rw-r--r--lisp/gnus/gnus-agent.el437
-rw-r--r--lisp/gnus/gnus-art.el46
-rw-r--r--lisp/gnus/gnus-async.el11
-rw-r--r--lisp/gnus/gnus-bcklg.el2
-rw-r--r--lisp/gnus/gnus-bookmark.el5
-rw-r--r--lisp/gnus/gnus-cache.el128
-rw-r--r--lisp/gnus/gnus-cite.el2
-rw-r--r--lisp/gnus/gnus-cloud.el18
-rw-r--r--lisp/gnus/gnus-cus.el36
-rw-r--r--lisp/gnus/gnus-dbus.el2
-rw-r--r--lisp/gnus/gnus-delay.el2
-rw-r--r--lisp/gnus/gnus-demon.el2
-rw-r--r--lisp/gnus/gnus-diary.el2
-rw-r--r--lisp/gnus/gnus-dired.el2
-rw-r--r--lisp/gnus/gnus-draft.el2
-rw-r--r--lisp/gnus/gnus-dup.el2
-rw-r--r--lisp/gnus/gnus-eform.el2
-rw-r--r--lisp/gnus/gnus-fun.el6
-rw-r--r--lisp/gnus/gnus-gravatar.el2
-rw-r--r--lisp/gnus/gnus-group.el99
-rw-r--r--lisp/gnus/gnus-html.el2
-rw-r--r--lisp/gnus/gnus-icalendar.el2
-rw-r--r--lisp/gnus/gnus-int.el2
-rw-r--r--lisp/gnus/gnus-kill.el2
-rw-r--r--lisp/gnus/gnus-logic.el2
-rw-r--r--lisp/gnus/gnus-mh.el2
-rw-r--r--lisp/gnus/gnus-ml.el2
-rw-r--r--lisp/gnus/gnus-mlspl.el2
-rw-r--r--lisp/gnus/gnus-msg.el23
-rw-r--r--lisp/gnus/gnus-notifications.el2
-rw-r--r--lisp/gnus/gnus-picon.el2
-rw-r--r--lisp/gnus/gnus-range.el2
-rw-r--r--lisp/gnus/gnus-registry.el74
-rw-r--r--lisp/gnus/gnus-rfc1843.el2
-rw-r--r--lisp/gnus/gnus-salt.el12
-rw-r--r--lisp/gnus/gnus-score.el10
-rw-r--r--lisp/gnus/gnus-search.el2186
-rw-r--r--lisp/gnus/gnus-sieve.el2
-rw-r--r--lisp/gnus/gnus-spec.el2
-rw-r--r--lisp/gnus/gnus-srvr.el5
-rw-r--r--lisp/gnus/gnus-start.el15
-rw-r--r--lisp/gnus/gnus-sum.el164
-rw-r--r--lisp/gnus/gnus-topic.el25
-rw-r--r--lisp/gnus/gnus-undo.el6
-rw-r--r--lisp/gnus/gnus-util.el6
-rw-r--r--lisp/gnus/gnus-uu.el17
-rw-r--r--lisp/gnus/gnus-vm.el2
-rw-r--r--lisp/gnus/gnus-win.el7
-rw-r--r--lisp/gnus/gnus.el72
-rw-r--r--lisp/gnus/gssapi.el2
-rw-r--r--lisp/gnus/legacy-gnus-agent.el2
-rw-r--r--lisp/gnus/mail-source.el2
-rw-r--r--lisp/gnus/message.el165
-rw-r--r--lisp/gnus/mm-archive.el2
-rw-r--r--lisp/gnus/mm-bodies.el2
-rw-r--r--lisp/gnus/mm-decode.el2
-rw-r--r--lisp/gnus/mm-encode.el2
-rw-r--r--lisp/gnus/mm-extern.el2
-rw-r--r--lisp/gnus/mm-partial.el2
-rw-r--r--lisp/gnus/mm-url.el2
-rw-r--r--lisp/gnus/mm-util.el2
-rw-r--r--lisp/gnus/mm-uu.el2
-rw-r--r--lisp/gnus/mm-view.el4
-rw-r--r--lisp/gnus/mml-sec.el2
-rw-r--r--lisp/gnus/mml-smime.el2
-rw-r--r--lisp/gnus/mml.el6
-rw-r--r--lisp/gnus/mml1991.el2
-rw-r--r--lisp/gnus/mml2015.el7
-rw-r--r--lisp/gnus/nnagent.el2
-rw-r--r--lisp/gnus/nnbabyl.el2
-rw-r--r--lisp/gnus/nndiary.el10
-rw-r--r--lisp/gnus/nndir.el2
-rw-r--r--lisp/gnus/nndoc.el2
-rw-r--r--lisp/gnus/nndraft.el2
-rw-r--r--lisp/gnus/nneething.el2
-rw-r--r--lisp/gnus/nnfolder.el8
-rw-r--r--lisp/gnus/nngateway.el2
-rw-r--r--lisp/gnus/nnheader.el4
-rw-r--r--lisp/gnus/nnimap.el30
-rw-r--r--lisp/gnus/nnmail.el7
-rw-r--r--lisp/gnus/nnmaildir.el5
-rw-r--r--lisp/gnus/nnmairix.el86
-rw-r--r--lisp/gnus/nnmbox.el2
-rw-r--r--lisp/gnus/nnmh.el4
-rw-r--r--lisp/gnus/nnml.el6
-rw-r--r--lisp/gnus/nnoo.el2
-rw-r--r--lisp/gnus/nnregistry.el2
-rw-r--r--lisp/gnus/nnrss.el2
-rw-r--r--lisp/gnus/nnselect.el103
-rw-r--r--lisp/gnus/nnspool.el2
-rw-r--r--lisp/gnus/nntp.el11
-rw-r--r--lisp/gnus/nnvirtual.el191
-rw-r--r--lisp/gnus/nnweb.el2
-rw-r--r--lisp/gnus/score-mode.el2
-rw-r--r--lisp/gnus/smiley.el2
-rw-r--r--lisp/gnus/smime.el4
-rw-r--r--lisp/gnus/spam-report.el2
-rw-r--r--lisp/gnus/spam-stat.el2
-rw-r--r--lisp/gnus/spam-wash.el2
-rw-r--r--lisp/gnus/spam.el28
-rw-r--r--lisp/help-at-pt.el2
-rw-r--r--lisp/help-fns.el65
-rw-r--r--lisp/help-macro.el2
-rw-r--r--lisp/help-mode.el14
-rw-r--r--lisp/help.el11
-rw-r--r--lisp/hex-util.el2
-rw-r--r--lisp/hexl.el12
-rw-r--r--lisp/hfy-cmap.el2
-rw-r--r--lisp/hi-lock.el4
-rw-r--r--lisp/hilit-chg.el2
-rw-r--r--lisp/hippie-exp.el30
-rw-r--r--lisp/hl-line.el2
-rw-r--r--lisp/htmlfontify.el12
-rw-r--r--lisp/ibuf-ext.el37
-rw-r--r--lisp/ibuf-macs.el2
-rw-r--r--lisp/ibuffer.el59
-rw-r--r--lisp/icomplete.el24
-rw-r--r--lisp/ido.el20
-rw-r--r--lisp/ielm.el37
-rw-r--r--lisp/iimage.el2
-rw-r--r--lisp/image-dired.el2
-rw-r--r--lisp/image-file.el2
-rw-r--r--lisp/image-mode.el34
-rw-r--r--lisp/image.el47
-rw-r--r--lisp/image/compface.el2
-rw-r--r--lisp/image/exif.el4
-rw-r--r--lisp/image/gravatar.el2
-rw-r--r--lisp/image/image-converter.el2
-rw-r--r--lisp/imenu.el2
-rw-r--r--lisp/indent.el2
-rw-r--r--lisp/info-look.el2
-rw-r--r--lisp/info-xref.el2
-rw-r--r--lisp/info.el49
-rw-r--r--lisp/informat.el2
-rw-r--r--lisp/international/ccl.el2
-rw-r--r--lisp/international/characters.el100
-rw-r--r--lisp/international/fontset.el5
-rw-r--r--lisp/international/isearch-x.el22
-rw-r--r--lisp/international/iso-ascii.el2
-rw-r--r--lisp/international/iso-cvt.el2
-rw-r--r--lisp/international/iso-transl.el14
-rw-r--r--lisp/international/ja-dic-cnv.el2
-rw-r--r--lisp/international/kinsoku.el2
-rw-r--r--lisp/international/kkc.el2
-rw-r--r--lisp/international/latexenc.el2
-rw-r--r--lisp/international/latin1-disp.el2
-rw-r--r--lisp/international/mule-cmds.el203
-rw-r--r--lisp/international/mule-conf.el92
-rw-r--r--lisp/international/mule-diag.el15
-rw-r--r--lisp/international/mule-util.el2
-rw-r--r--lisp/international/mule.el24
-rw-r--r--lisp/international/ogonek.el2
-rw-r--r--lisp/international/quail.el48
-rw-r--r--lisp/international/rfc1843.el2
-rw-r--r--lisp/international/robin.el3
-rw-r--r--lisp/international/titdic-cnv.el2
-rw-r--r--lisp/international/ucs-normalize.el8
-rw-r--r--lisp/international/utf-7.el2
-rw-r--r--lisp/international/utf7.el2
-rw-r--r--lisp/isearch.el120
-rw-r--r--lisp/isearchb.el2
-rw-r--r--lisp/jit-lock.el2
-rw-r--r--lisp/jka-cmpr-hook.el5
-rw-r--r--lisp/jka-compr.el12
-rw-r--r--lisp/json.el9
-rw-r--r--lisp/jsonrpc.el45
-rw-r--r--lisp/kermit.el2
-rw-r--r--lisp/kmacro.el8
-rw-r--r--lisp/language/cham.el8
-rw-r--r--lisp/language/china-util.el2
-rw-r--r--lisp/language/chinese.el4
-rw-r--r--lisp/language/cyril-util.el2
-rw-r--r--lisp/language/cyrillic.el4
-rw-r--r--lisp/language/czech.el2
-rw-r--r--lisp/language/english.el4
-rw-r--r--lisp/language/ethio-util.el12
-rw-r--r--lisp/language/ethiopic.el4
-rw-r--r--lisp/language/european.el85
-rw-r--r--lisp/language/georgian.el2
-rw-r--r--lisp/language/greek.el2
-rw-r--r--lisp/language/hanja-util.el2
-rw-r--r--lisp/language/hebrew.el4
-rw-r--r--lisp/language/ind-util.el2
-rw-r--r--lisp/language/indian.el4
-rw-r--r--lisp/language/japan-util.el2
-rw-r--r--lisp/language/japanese.el20
-rw-r--r--lisp/language/korea-util.el17
-rw-r--r--lisp/language/korean.el5
-rw-r--r--lisp/language/lao-util.el2
-rw-r--r--lisp/language/lao.el4
-rw-r--r--lisp/language/misc-lang.el2
-rw-r--r--lisp/language/romanian.el2
-rw-r--r--lisp/language/slovak.el2
-rw-r--r--lisp/language/tai-viet.el2
-rw-r--r--lisp/language/thai-util.el2
-rw-r--r--lisp/language/thai.el4
-rw-r--r--lisp/language/tibet-util.el2
-rw-r--r--lisp/language/tibetan.el4
-rw-r--r--lisp/language/utf-8-lang.el2
-rw-r--r--lisp/language/viet-util.el2
-rw-r--r--lisp/language/vietnamese.el2
-rw-r--r--lisp/ldefs-boot.el1595
-rw-r--r--lisp/leim/quail/arabic.el4
-rw-r--r--lisp/leim/quail/cham.el116
-rw-r--r--lisp/leim/quail/compose.el2952
-rw-r--r--lisp/leim/quail/croatian.el4
-rw-r--r--lisp/leim/quail/cyril-jis.el4
-rw-r--r--lisp/leim/quail/cyrillic.el4
-rw-r--r--lisp/leim/quail/czech.el4
-rw-r--r--lisp/leim/quail/ethiopic.el2
-rw-r--r--lisp/leim/quail/georgian.el4
-rw-r--r--lisp/leim/quail/greek.el4
-rw-r--r--lisp/leim/quail/hangul.el4
-rw-r--r--lisp/leim/quail/hanja-jis.el2
-rw-r--r--lisp/leim/quail/hanja.el4
-rw-r--r--lisp/leim/quail/hanja3.el4
-rw-r--r--lisp/leim/quail/hebrew.el2
-rw-r--r--lisp/leim/quail/indian.el2
-rw-r--r--lisp/leim/quail/ipa-praat.el4
-rw-r--r--lisp/leim/quail/ipa.el2
-rw-r--r--lisp/leim/quail/japanese.el2
-rw-r--r--lisp/leim/quail/latin-alt.el4
-rw-r--r--lisp/leim/quail/latin-ltx.el4
-rw-r--r--lisp/leim/quail/latin-post.el4
-rw-r--r--lisp/leim/quail/latin-pre.el4
-rw-r--r--lisp/leim/quail/lrt.el2
-rw-r--r--lisp/leim/quail/persian.el4
-rw-r--r--lisp/leim/quail/programmer-dvorak.el4
-rw-r--r--lisp/leim/quail/py-punct.el4
-rw-r--r--lisp/leim/quail/pypunct-b5.el2
-rw-r--r--lisp/leim/quail/rfc1345.el4
-rw-r--r--lisp/leim/quail/sami.el4
-rw-r--r--lisp/leim/quail/sgml-input.el4
-rw-r--r--lisp/leim/quail/sisheng.el2
-rw-r--r--lisp/leim/quail/slovak.el4
-rw-r--r--lisp/leim/quail/symbol-ksc.el4
-rw-r--r--lisp/leim/quail/tamil-dvorak.el4
-rw-r--r--lisp/leim/quail/tibetan.el2
-rw-r--r--lisp/leim/quail/uni-input.el5
-rw-r--r--lisp/leim/quail/vntelex.el4
-rw-r--r--lisp/leim/quail/vnvni.el4
-rw-r--r--lisp/leim/quail/welsh.el4
-rw-r--r--lisp/linum.el2
-rw-r--r--lisp/loadhist.el2
-rw-r--r--lisp/loadup.el5
-rw-r--r--lisp/locate.el22
-rw-r--r--lisp/lpr.el2
-rw-r--r--lisp/ls-lisp.el2
-rw-r--r--lisp/macros.el2
-rw-r--r--lisp/mail/binhex.el2
-rw-r--r--lisp/mail/blessmail.el2
-rw-r--r--lisp/mail/emacsbug.el11
-rw-r--r--lisp/mail/feedmail.el77
-rw-r--r--lisp/mail/flow-fill.el2
-rw-r--r--lisp/mail/footnote.el2
-rw-r--r--lisp/mail/hashcash.el2
-rw-r--r--lisp/mail/ietf-drums.el2
-rw-r--r--lisp/mail/mail-extr.el2
-rw-r--r--lisp/mail/mail-hist.el2
-rw-r--r--lisp/mail/mail-parse.el2
-rw-r--r--lisp/mail/mail-prsvr.el2
-rw-r--r--lisp/mail/mail-utils.el2
-rw-r--r--lisp/mail/mailabbrev.el22
-rw-r--r--lisp/mail/mailalias.el2
-rw-r--r--lisp/mail/mailclient.el2
-rw-r--r--lisp/mail/mailheader.el2
-rw-r--r--lisp/mail/mspools.el2
-rw-r--r--lisp/mail/qp.el2
-rw-r--r--lisp/mail/reporter.el87
-rw-r--r--lisp/mail/rfc2045.el2
-rw-r--r--lisp/mail/rfc2047.el2
-rw-r--r--lisp/mail/rfc2231.el2
-rw-r--r--lisp/mail/rfc2368.el2
-rw-r--r--lisp/mail/rfc822.el15
-rw-r--r--lisp/mail/rmail-spam-filter.el19
-rw-r--r--lisp/mail/rmail.el80
-rw-r--r--lisp/mail/rmailedit.el24
-rw-r--r--lisp/mail/rmailkwd.el2
-rw-r--r--lisp/mail/rmailmm.el2
-rw-r--r--lisp/mail/rmailmsc.el2
-rw-r--r--lisp/mail/rmailout.el4
-rw-r--r--lisp/mail/rmailsort.el2
-rw-r--r--lisp/mail/rmailsum.el35
-rw-r--r--lisp/mail/sendmail.el28
-rw-r--r--lisp/mail/smtpmail.el2
-rw-r--r--lisp/mail/supercite.el32
-rw-r--r--lisp/mail/uce.el2
-rw-r--r--lisp/mail/undigest.el2
-rw-r--r--lisp/mail/unrmail.el2
-rw-r--r--lisp/mail/uudecode.el38
-rw-r--r--lisp/mail/yenc.el2
-rw-r--r--lisp/makesum.el2
-rw-r--r--lisp/man.el12
-rw-r--r--lisp/master.el5
-rw-r--r--lisp/mb-depth.el12
-rw-r--r--lisp/md4.el2
-rw-r--r--lisp/menu-bar.el7
-rw-r--r--lisp/mh-e/ChangeLog.12
-rw-r--r--lisp/mh-e/ChangeLog.22
-rw-r--r--lisp/mh-e/mh-acros.el2
-rw-r--r--lisp/mh-e/mh-alias.el33
-rw-r--r--lisp/mh-e/mh-buffers.el2
-rw-r--r--lisp/mh-e/mh-comp.el112
-rw-r--r--lisp/mh-e/mh-compat.el2
-rw-r--r--lisp/mh-e/mh-e.el4
-rw-r--r--lisp/mh-e/mh-folder.el9
-rw-r--r--lisp/mh-e/mh-funcs.el2
-rw-r--r--lisp/mh-e/mh-gnus.el2
-rw-r--r--lisp/mh-e/mh-identity.el11
-rw-r--r--lisp/mh-e/mh-inc.el2
-rw-r--r--lisp/mh-e/mh-junk.el2
-rw-r--r--lisp/mh-e/mh-letter.el4
-rw-r--r--lisp/mh-e/mh-limit.el2
-rw-r--r--lisp/mh-e/mh-mime.el2
-rw-r--r--lisp/mh-e/mh-print.el2
-rw-r--r--lisp/mh-e/mh-scan.el2
-rw-r--r--lisp/mh-e/mh-search.el4
-rw-r--r--lisp/mh-e/mh-seq.el8
-rw-r--r--lisp/mh-e/mh-show.el9
-rw-r--r--lisp/mh-e/mh-speed.el2
-rw-r--r--lisp/mh-e/mh-thread.el2
-rw-r--r--lisp/mh-e/mh-tool-bar.el2
-rw-r--r--lisp/mh-e/mh-utils.el7
-rw-r--r--lisp/mh-e/mh-xface.el5
-rw-r--r--lisp/midnight.el2
-rw-r--r--lisp/minibuf-eldef.el2
-rw-r--r--lisp/minibuffer.el205
-rw-r--r--lisp/misc.el2
-rw-r--r--lisp/misearch.el2
-rw-r--r--lisp/mouse-copy.el2
-rw-r--r--lisp/mouse-drag.el6
-rw-r--r--lisp/mouse.el4
-rw-r--r--lisp/mpc.el2
-rw-r--r--lisp/msb.el2
-rw-r--r--lisp/mwheel.el35
-rw-r--r--lisp/net/ange-ftp.el157
-rw-r--r--lisp/net/browse-url.el2
-rw-r--r--lisp/net/dbus.el2
-rw-r--r--lisp/net/dictionary-connection.el155
-rw-r--r--lisp/net/dictionary.el1355
-rw-r--r--lisp/net/dig.el8
-rw-r--r--lisp/net/dns.el2
-rw-r--r--lisp/net/eudc-bob.el14
-rw-r--r--lisp/net/eudc-export.el13
-rw-r--r--lisp/net/eudc-hotlist.el2
-rw-r--r--lisp/net/eudc-vars.el4
-rw-r--r--lisp/net/eudc.el239
-rw-r--r--lisp/net/eudcb-bbdb.el45
-rw-r--r--lisp/net/eudcb-ldap.el21
-rw-r--r--lisp/net/eudcb-mab.el2
-rw-r--r--lisp/net/eudcb-macos-contacts.el2
-rw-r--r--lisp/net/eww.el36
-rw-r--r--lisp/net/gnutls.el2
-rw-r--r--lisp/net/goto-addr.el2
-rw-r--r--lisp/net/hmac-def.el2
-rw-r--r--lisp/net/hmac-md5.el2
-rw-r--r--lisp/net/imap.el10
-rw-r--r--lisp/net/ldap.el3
-rw-r--r--lisp/net/mailcap.el44
-rw-r--r--lisp/net/mairix.el85
-rw-r--r--lisp/net/net-utils.el22
-rw-r--r--lisp/net/netrc.el2
-rw-r--r--lisp/net/network-stream.el2
-rw-r--r--lisp/net/newst-backend.el2
-rw-r--r--lisp/net/newst-plainview.el16
-rw-r--r--lisp/net/newst-reader.el2
-rw-r--r--lisp/net/newst-ticker.el2
-rw-r--r--lisp/net/newst-treeview.el11
-rw-r--r--lisp/net/newsticker.el10
-rw-r--r--lisp/net/nsm.el4
-rw-r--r--lisp/net/ntlm.el2
-rw-r--r--lisp/net/pop3.el4
-rw-r--r--lisp/net/puny.el2
-rw-r--r--lisp/net/quickurl.el2
-rw-r--r--lisp/net/rcirc.el40
-rw-r--r--lisp/net/rfc2104.el4
-rw-r--r--lisp/net/rlogin.el8
-rw-r--r--lisp/net/sasl-cram.el2
-rw-r--r--lisp/net/sasl-digest.el2
-rw-r--r--lisp/net/sasl-ntlm.el2
-rw-r--r--lisp/net/sasl-scram-rfc.el2
-rw-r--r--lisp/net/sasl-scram-sha256.el2
-rw-r--r--lisp/net/sasl.el2
-rw-r--r--lisp/net/secrets.el10
-rw-r--r--lisp/net/shr-color.el2
-rw-r--r--lisp/net/shr.el7
-rw-r--r--lisp/net/sieve-manage.el2
-rw-r--r--lisp/net/sieve-mode.el28
-rw-r--r--lisp/net/sieve.el16
-rw-r--r--lisp/net/snmp-mode.el68
-rw-r--r--lisp/net/soap-client.el2
-rw-r--r--lisp/net/soap-inspect.el2
-rw-r--r--lisp/net/socks.el18
-rw-r--r--lisp/net/telnet.el8
-rw-r--r--lisp/net/tramp-adb.el101
-rw-r--r--lisp/net/tramp-archive.el2
-rw-r--r--lisp/net/tramp-cache.el2
-rw-r--r--lisp/net/tramp-cmds.el8
-rw-r--r--lisp/net/tramp-compat.el44
-rw-r--r--lisp/net/tramp-crypt.el11
-rw-r--r--lisp/net/tramp-ftp.el3
-rw-r--r--lisp/net/tramp-gvfs.el99
-rw-r--r--lisp/net/tramp-integration.el36
-rw-r--r--lisp/net/tramp-rclone.el16
-rw-r--r--lisp/net/tramp-sh.el563
-rw-r--r--lisp/net/tramp-smb.el48
-rw-r--r--lisp/net/tramp-sudoedit.el2
-rw-r--r--lisp/net/tramp-uu.el2
-rw-r--r--lisp/net/tramp.el349
-rw-r--r--lisp/net/trampver.el20
-rw-r--r--lisp/net/webjump.el3
-rw-r--r--lisp/net/zeroconf.el2
-rw-r--r--lisp/newcomment.el80
-rw-r--r--lisp/notifications.el2
-rw-r--r--lisp/novice.el2
-rw-r--r--lisp/nxml/nxml-enc.el2
-rw-r--r--lisp/nxml/nxml-maint.el2
-rw-r--r--lisp/nxml/nxml-mode.el38
-rw-r--r--lisp/nxml/nxml-ns.el2
-rw-r--r--lisp/nxml/nxml-outln.el2
-rw-r--r--lisp/nxml/nxml-parse.el2
-rw-r--r--lisp/nxml/nxml-rap.el2
-rw-r--r--lisp/nxml/nxml-util.el2
-rw-r--r--lisp/nxml/rng-cmpct.el2
-rw-r--r--lisp/nxml/rng-dt.el2
-rw-r--r--lisp/nxml/rng-loc.el2
-rw-r--r--lisp/nxml/rng-maint.el2
-rw-r--r--lisp/nxml/rng-match.el2
-rw-r--r--lisp/nxml/rng-nxml.el2
-rw-r--r--lisp/nxml/rng-parse.el2
-rw-r--r--lisp/nxml/rng-pttrn.el2
-rw-r--r--lisp/nxml/rng-uri.el2
-rw-r--r--lisp/nxml/rng-util.el2
-rw-r--r--lisp/nxml/rng-valid.el2
-rw-r--r--lisp/nxml/rng-xsd.el2
-rw-r--r--lisp/nxml/xmltok.el2
-rw-r--r--lisp/nxml/xsd-regexp.el10
-rw-r--r--lisp/obarray.el2
-rw-r--r--lisp/obsolete/abbrevlist.el2
-rw-r--r--lisp/obsolete/assoc.el2
-rw-r--r--lisp/obsolete/bruce.el2
-rw-r--r--lisp/obsolete/cc-compat.el2
-rw-r--r--lisp/obsolete/cl-compat.el19
-rw-r--r--lisp/obsolete/cl.el6
-rw-r--r--lisp/obsolete/complete.el2
-rw-r--r--lisp/obsolete/crisp.el2
-rw-r--r--lisp/obsolete/cust-print.el2
-rw-r--r--lisp/obsolete/erc-compat.el2
-rw-r--r--lisp/obsolete/erc-hecomplete.el2
-rw-r--r--lisp/obsolete/eudcb-ph.el2
-rw-r--r--lisp/obsolete/fast-lock.el2
-rw-r--r--lisp/obsolete/gs.el2
-rw-r--r--lisp/obsolete/gulp.el2
-rw-r--r--lisp/obsolete/html2text.el2
-rw-r--r--lisp/obsolete/info-edit.el2
-rw-r--r--lisp/obsolete/iswitchb.el2
-rw-r--r--lisp/obsolete/landmark.el5
-rw-r--r--lisp/obsolete/lazy-lock.el2
-rw-r--r--lisp/obsolete/longlines.el5
-rw-r--r--lisp/obsolete/mantemp.el2
-rw-r--r--lisp/obsolete/messcompat.el2
-rw-r--r--lisp/obsolete/metamail.el2
-rw-r--r--lisp/obsolete/mouse-sel.el2
-rw-r--r--lisp/obsolete/nnir.el (renamed from lisp/gnus/nnir.el)34
-rw-r--r--lisp/obsolete/old-emacs-lock.el2
-rw-r--r--lisp/obsolete/otodo-mode.el5
-rw-r--r--lisp/obsolete/pc-mode.el2
-rw-r--r--lisp/obsolete/pc-select.el2
-rw-r--r--lisp/obsolete/pgg-def.el2
-rw-r--r--lisp/obsolete/pgg-gpg.el2
-rw-r--r--lisp/obsolete/pgg-parse.el2
-rw-r--r--lisp/obsolete/pgg-pgp.el2
-rw-r--r--lisp/obsolete/pgg-pgp5.el2
-rw-r--r--lisp/obsolete/pgg.el2
-rw-r--r--lisp/obsolete/rcompile.el2
-rw-r--r--lisp/obsolete/s-region.el2
-rw-r--r--lisp/obsolete/sb-image.el3
-rw-r--r--lisp/obsolete/sregex.el2
-rw-r--r--lisp/obsolete/starttls.el2
-rw-r--r--lisp/obsolete/sup-mouse.el2
-rw-r--r--lisp/obsolete/terminal.el9
-rw-r--r--lisp/obsolete/tls.el8
-rw-r--r--lisp/obsolete/tpu-edt.el2
-rw-r--r--lisp/obsolete/tpu-extras.el2
-rw-r--r--lisp/obsolete/tpu-mapper.el2
-rw-r--r--lisp/obsolete/url-ns.el2
-rw-r--r--lisp/obsolete/vc-arch.el2
-rw-r--r--lisp/obsolete/vip.el2
-rw-r--r--lisp/obsolete/ws-mode.el2
-rw-r--r--lisp/obsolete/yow.el2
-rw-r--r--lisp/org/ChangeLog.12
-rw-r--r--lisp/org/ob-C.el12
-rw-r--r--lisp/org/ob-J.el11
-rw-r--r--lisp/org/ob-R.el13
-rw-r--r--lisp/org/ob-abc.el6
-rw-r--r--lisp/org/ob-asymptote.el4
-rw-r--r--lisp/org/ob-awk.el4
-rw-r--r--lisp/org/ob-calc.el4
-rw-r--r--lisp/org/ob-clojure.el342
-rw-r--r--lisp/org/ob-comint.el4
-rw-r--r--lisp/org/ob-coq.el4
-rw-r--r--lisp/org/ob-core.el532
-rw-r--r--lisp/org/ob-css.el4
-rw-r--r--lisp/org/ob-ditaa.el4
-rw-r--r--lisp/org/ob-dot.el4
-rw-r--r--lisp/org/ob-ebnf.el28
-rw-r--r--lisp/org/ob-emacs-lisp.el53
-rw-r--r--lisp/org/ob-eshell.el2
-rw-r--r--lisp/org/ob-eval.el4
-rw-r--r--lisp/org/ob-exp.el10
-rw-r--r--lisp/org/ob-forth.el5
-rw-r--r--lisp/org/ob-fortran.el5
-rw-r--r--lisp/org/ob-gnuplot.el6
-rw-r--r--lisp/org/ob-groovy.el6
-rw-r--r--lisp/org/ob-haskell.el88
-rw-r--r--lisp/org/ob-hledger.el7
-rw-r--r--lisp/org/ob-io.el5
-rw-r--r--lisp/org/ob-java.el9
-rw-r--r--lisp/org/ob-js.el6
-rw-r--r--lisp/org/ob-latex.el14
-rw-r--r--lisp/org/ob-ledger.el4
-rw-r--r--lisp/org/ob-lilypond.el15
-rw-r--r--lisp/org/ob-lisp.el4
-rw-r--r--lisp/org/ob-lob.el2
-rw-r--r--lisp/org/ob-lua.el7
-rw-r--r--lisp/org/ob-makefile.el4
-rw-r--r--lisp/org/ob-matlab.el4
-rw-r--r--lisp/org/ob-maxima.el7
-rw-r--r--lisp/org/ob-mscgen.el7
-rw-r--r--lisp/org/ob-ocaml.el4
-rw-r--r--lisp/org/ob-octave.el10
-rw-r--r--lisp/org/ob-org.el4
-rw-r--r--lisp/org/ob-perl.el4
-rw-r--r--lisp/org/ob-picolisp.el10
-rw-r--r--lisp/org/ob-plantuml.el107
-rw-r--r--lisp/org/ob-processing.el2
-rw-r--r--lisp/org/ob-python.el221
-rw-r--r--lisp/org/ob-ref.el6
-rw-r--r--lisp/org/ob-ruby.el33
-rw-r--r--lisp/org/ob-sass.el4
-rw-r--r--lisp/org/ob-scheme.el13
-rw-r--r--lisp/org/ob-screen.el17
-rw-r--r--lisp/org/ob-sed.el7
-rw-r--r--lisp/org/ob-shell.el61
-rw-r--r--lisp/org/ob-shen.el3
-rw-r--r--lisp/org/ob-sql.el123
-rw-r--r--lisp/org/ob-sqlite.el9
-rw-r--r--lisp/org/ob-stan.el3
-rw-r--r--lisp/org/ob-table.el7
-rw-r--r--lisp/org/ob-tangle.el62
-rw-r--r--lisp/org/ob-vala.el2
-rw-r--r--lisp/org/ob.el2
-rw-r--r--lisp/org/ol-bbdb.el41
-rw-r--r--lisp/org/ol-bibtex.el27
-rw-r--r--lisp/org/ol-docview.el5
-rw-r--r--lisp/org/ol-eshell.el4
-rw-r--r--lisp/org/ol-eww.el17
-rw-r--r--lisp/org/ol-gnus.el34
-rw-r--r--lisp/org/ol-info.el4
-rw-r--r--lisp/org/ol-irc.el4
-rw-r--r--lisp/org/ol-mhe.el4
-rw-r--r--lisp/org/ol-rmail.el8
-rw-r--r--lisp/org/ol-w3m.el2
-rw-r--r--lisp/org/ol.el499
-rw-r--r--lisp/org/org-agenda.el1243
-rw-r--r--lisp/org/org-archive.el56
-rw-r--r--lisp/org/org-attach-git.el2
-rw-r--r--lisp/org/org-attach.el158
-rw-r--r--lisp/org/org-capture.el138
-rw-r--r--lisp/org/org-clock.el143
-rw-r--r--lisp/org/org-colview.el55
-rw-r--r--lisp/org/org-compat.el139
-rw-r--r--lisp/org/org-crypt.el233
-rw-r--r--lisp/org/org-ctags.el4
-rw-r--r--lisp/org/org-datetree.el31
-rw-r--r--lisp/org/org-duration.el54
-rw-r--r--lisp/org/org-element.el268
-rw-r--r--lisp/org/org-entities.el7
-rw-r--r--lisp/org/org-faces.el31
-rw-r--r--lisp/org/org-feed.el2
-rw-r--r--lisp/org/org-footnote.el2
-rw-r--r--lisp/org/org-goto.el40
-rw-r--r--lisp/org/org-habit.el13
-rw-r--r--lisp/org/org-id.el133
-rw-r--r--lisp/org/org-indent.el37
-rw-r--r--lisp/org/org-inlinetask.el2
-rw-r--r--lisp/org/org-keys.el22
-rw-r--r--lisp/org/org-lint.el79
-rw-r--r--lisp/org/org-list.el649
-rw-r--r--lisp/org/org-macro.el60
-rw-r--r--lisp/org/org-macs.el129
-rw-r--r--lisp/org/org-mobile.el13
-rw-r--r--lisp/org/org-mouse.el12
-rw-r--r--lisp/org/org-num.el9
-rw-r--r--lisp/org/org-pcomplete.el38
-rw-r--r--lisp/org/org-plot.el48
-rw-r--r--lisp/org/org-protocol.el36
-rw-r--r--lisp/org/org-refile.el742
-rw-r--r--lisp/org/org-src.el91
-rw-r--r--lisp/org/org-table.el541
-rw-r--r--lisp/org/org-tempo.el4
-rw-r--r--lisp/org/org-timer.el21
-rw-r--r--lisp/org/org-version.el4
-rw-r--r--lisp/org/org.el4571
-rw-r--r--lisp/org/ox-ascii.el19
-rw-r--r--lisp/org/ox-beamer.el4
-rw-r--r--lisp/org/ox-html.el355
-rw-r--r--lisp/org/ox-icalendar.el13
-rw-r--r--lisp/org/ox-latex.el88
-rw-r--r--lisp/org/ox-man.el24
-rw-r--r--lisp/org/ox-md.el347
-rw-r--r--lisp/org/ox-odt.el38
-rw-r--r--lisp/org/ox-org.el6
-rw-r--r--lisp/org/ox-publish.el13
-rw-r--r--lisp/org/ox-texinfo.el25
-rw-r--r--lisp/org/ox.el320
-rw-r--r--lisp/outline.el63
-rw-r--r--lisp/paren.el2
-rw-r--r--lisp/password-cache.el6
-rw-r--r--lisp/pcmpl-cvs.el10
-rw-r--r--lisp/pcmpl-gnu.el32
-rw-r--r--lisp/pcmpl-linux.el2
-rw-r--r--lisp/pcmpl-rpm.el12
-rw-r--r--lisp/pcmpl-unix.el2
-rw-r--r--lisp/pcmpl-x.el2
-rw-r--r--lisp/pcomplete.el23
-rw-r--r--lisp/pixel-scroll.el17
-rw-r--r--lisp/play/5x5.el24
-rw-r--r--lisp/play/animate.el2
-rw-r--r--lisp/play/blackbox.el2
-rw-r--r--lisp/play/bubbles.el9
-rw-r--r--lisp/play/cookie1.el2
-rw-r--r--lisp/play/decipher.el6
-rw-r--r--lisp/play/dissociate.el2
-rw-r--r--lisp/play/doctor.el788
-rw-r--r--lisp/play/dunnet.el243
-rw-r--r--lisp/play/fortune.el72
-rw-r--r--lisp/play/gamegrid.el2
-rw-r--r--lisp/play/gametree.el2
-rw-r--r--lisp/play/gomoku.el7
-rw-r--r--lisp/play/handwrite.el16
-rw-r--r--lisp/play/life.el2
-rw-r--r--lisp/play/morse.el2
-rw-r--r--lisp/play/mpuz.el2
-rw-r--r--lisp/play/pong.el2
-rw-r--r--lisp/play/snake.el2
-rw-r--r--lisp/play/solitaire.el10
-rw-r--r--lisp/play/spook.el2
-rw-r--r--lisp/play/tetris.el48
-rw-r--r--lisp/play/zone.el2
-rw-r--r--lisp/plstore.el2
-rw-r--r--lisp/printing.el2
-rw-r--r--lisp/proced.el8
-rw-r--r--lisp/profiler.el36
-rw-r--r--lisp/progmodes/antlr-mode.el9
-rw-r--r--lisp/progmodes/asm-mode.el2
-rw-r--r--lisp/progmodes/autoconf.el2
-rw-r--r--lisp/progmodes/bat-mode.el2
-rw-r--r--lisp/progmodes/bug-reference.el2
-rw-r--r--lisp/progmodes/cc-align.el8
-rw-r--r--lisp/progmodes/cc-awk.el103
-rw-r--r--lisp/progmodes/cc-bytecomp.el2
-rw-r--r--lisp/progmodes/cc-cmds.el7
-rw-r--r--lisp/progmodes/cc-defs.el9
-rw-r--r--lisp/progmodes/cc-engine.el790
-rw-r--r--lisp/progmodes/cc-fonts.el144
-rw-r--r--lisp/progmodes/cc-guess.el2
-rw-r--r--lisp/progmodes/cc-langs.el23
-rw-r--r--lisp/progmodes/cc-menus.el2
-rw-r--r--lisp/progmodes/cc-mode.el102
-rw-r--r--lisp/progmodes/cc-styles.el2
-rw-r--r--lisp/progmodes/cc-vars.el5
-rw-r--r--lisp/progmodes/cfengine.el48
-rw-r--r--lisp/progmodes/cl-font-lock.el2
-rw-r--r--lisp/progmodes/cmacexp.el2
-rw-r--r--lisp/progmodes/compile.el185
-rw-r--r--lisp/progmodes/cperl-mode.el469
-rw-r--r--lisp/progmodes/cpp.el2
-rw-r--r--lisp/progmodes/cwarn.el4
-rw-r--r--lisp/progmodes/dcl-mode.el14
-rw-r--r--lisp/progmodes/ebnf-abn.el2
-rw-r--r--lisp/progmodes/ebnf-bnf.el2
-rw-r--r--lisp/progmodes/ebnf-dtd.el2
-rw-r--r--lisp/progmodes/ebnf-ebx.el2
-rw-r--r--lisp/progmodes/ebnf-iso.el2
-rw-r--r--lisp/progmodes/ebnf-otz.el2
-rw-r--r--lisp/progmodes/ebnf-yac.el2
-rw-r--r--lisp/progmodes/ebnf2ps.el2
-rw-r--r--lisp/progmodes/ebrowse.el2
-rw-r--r--lisp/progmodes/elisp-mode.el33
-rw-r--r--lisp/progmodes/etags.el84
-rw-r--r--lisp/progmodes/executable.el4
-rw-r--r--lisp/progmodes/f90.el43
-rw-r--r--lisp/progmodes/flymake-cc.el4
-rw-r--r--lisp/progmodes/flymake-proc.el21
-rw-r--r--lisp/progmodes/flymake.el323
-rw-r--r--lisp/progmodes/fortran.el106
-rw-r--r--lisp/progmodes/gdb-mi.el126
-rw-r--r--lisp/progmodes/glasses.el2
-rw-r--r--lisp/progmodes/grep.el191
-rw-r--r--lisp/progmodes/gud.el74
-rw-r--r--lisp/progmodes/hideif.el24
-rw-r--r--lisp/progmodes/hideshow.el5
-rw-r--r--lisp/progmodes/icon.el35
-rw-r--r--lisp/progmodes/idlw-complete-structtag.el2
-rw-r--r--lisp/progmodes/idlw-help.el37
-rw-r--r--lisp/progmodes/idlw-shell.el58
-rw-r--r--lisp/progmodes/idlw-toolbar.el2
-rw-r--r--lisp/progmodes/idlwave.el101
-rw-r--r--lisp/progmodes/inf-lisp.el11
-rw-r--r--lisp/progmodes/js.el2
-rw-r--r--lisp/progmodes/ld-script.el9
-rw-r--r--lisp/progmodes/m4-mode.el2
-rw-r--r--lisp/progmodes/make-mode.el71
-rw-r--r--lisp/progmodes/meta-mode.el55
-rw-r--r--lisp/progmodes/mixal-mode.el24
-rw-r--r--lisp/progmodes/modula2.el16
-rw-r--r--lisp/progmodes/octave.el33
-rw-r--r--lisp/progmodes/opascal.el2
-rw-r--r--lisp/progmodes/pascal.el2
-rw-r--r--lisp/progmodes/perl-mode.el83
-rw-r--r--lisp/progmodes/prog-mode.el2
-rw-r--r--lisp/progmodes/project.el208
-rw-r--r--lisp/progmodes/prolog.el25
-rw-r--r--lisp/progmodes/ps-mode.el28
-rw-r--r--lisp/progmodes/python.el291
-rw-r--r--lisp/progmodes/ruby-mode.el114
-rw-r--r--lisp/progmodes/scheme.el2
-rw-r--r--lisp/progmodes/sh-script.el10
-rw-r--r--lisp/progmodes/simula.el34
-rw-r--r--lisp/progmodes/sql.el76
-rw-r--r--lisp/progmodes/subword.el4
-rw-r--r--lisp/progmodes/tcl.el135
-rw-r--r--lisp/progmodes/vera-mode.el2
-rw-r--r--lisp/progmodes/verilog-mode.el12
-rw-r--r--lisp/progmodes/vhdl-mode.el120
-rw-r--r--lisp/progmodes/which-func.el11
-rw-r--r--lisp/progmodes/xref.el299
-rw-r--r--lisp/progmodes/xscheme.el20
-rw-r--r--lisp/ps-bdf.el2
-rw-r--r--lisp/ps-def.el2
-rw-r--r--lisp/ps-mule.el2
-rw-r--r--lisp/ps-print.el3
-rw-r--r--lisp/ps-samp.el2
-rw-r--r--lisp/recentf.el8
-rw-r--r--lisp/rect.el2
-rw-r--r--lisp/register.el2
-rw-r--r--lisp/registry.el2
-rw-r--r--lisp/repeat.el2
-rw-r--r--lisp/replace.el45
-rw-r--r--lisp/reposition.el2
-rw-r--r--lisp/reveal.el4
-rw-r--r--lisp/rfn-eshadow.el4
-rw-r--r--lisp/rot13.el2
-rw-r--r--lisp/rtree.el2
-rw-r--r--lisp/ruler-mode.el10
-rw-r--r--lisp/savehist.el4
-rw-r--r--lisp/saveplace.el2
-rw-r--r--lisp/scroll-all.el2
-rw-r--r--lisp/scroll-bar.el4
-rw-r--r--lisp/scroll-lock.el4
-rw-r--r--lisp/select.el2
-rw-r--r--lisp/server.el138
-rw-r--r--lisp/ses.el5
-rw-r--r--lisp/shadowfile.el33
-rw-r--r--lisp/shell.el75
-rw-r--r--lisp/simple.el345
-rw-r--r--lisp/skeleton.el15
-rw-r--r--lisp/so-long.el21
-rw-r--r--lisp/sort.el62
-rw-r--r--lisp/soundex.el2
-rw-r--r--lisp/speedbar.el33
-rw-r--r--lisp/startup.el69
-rw-r--r--lisp/strokes.el48
-rw-r--r--lisp/subr.el650
-rw-r--r--lisp/svg.el15
-rw-r--r--lisp/t-mouse.el2
-rw-r--r--lisp/tab-bar.el196
-rw-r--r--lisp/tab-line.el67
-rw-r--r--lisp/tabify.el2
-rw-r--r--lisp/talk.el2
-rw-r--r--lisp/tar-mode.el41
-rw-r--r--lisp/tempo.el23
-rw-r--r--lisp/term.el90
-rw-r--r--lisp/term/AT386.el2
-rw-r--r--lisp/term/README2
-rw-r--r--lisp/term/common-win.el4
-rw-r--r--lisp/term/internal.el2
-rw-r--r--lisp/term/iris-ansi.el2
-rw-r--r--lisp/term/konsole.el2
-rw-r--r--lisp/term/news.el2
-rw-r--r--lisp/term/ns-win.el8
-rw-r--r--lisp/term/pc-win.el2
-rw-r--r--lisp/term/rxvt.el2
-rw-r--r--lisp/term/screen.el2
-rw-r--r--lisp/term/st.el2
-rw-r--r--lisp/term/sun.el2
-rw-r--r--lisp/term/tmux.el2
-rw-r--r--lisp/term/tty-colors.el4
-rw-r--r--lisp/term/tvi970.el2
-rw-r--r--lisp/term/vt100.el2
-rw-r--r--lisp/term/w32-win.el82
-rw-r--r--lisp/term/w32console.el2
-rw-r--r--lisp/term/wyse50.el8
-rw-r--r--lisp/term/x-win.el3
-rw-r--r--lisp/term/xterm.el12
-rw-r--r--lisp/textmodes/artist.el55
-rw-r--r--lisp/textmodes/bib-mode.el2
-rw-r--r--lisp/textmodes/bibtex-style.el14
-rw-r--r--lisp/textmodes/bibtex.el887
-rw-r--r--lisp/textmodes/conf-mode.el2
-rw-r--r--lisp/textmodes/css-mode.el2
-rw-r--r--lisp/textmodes/dns-mode.el15
-rw-r--r--lisp/textmodes/enriched.el7
-rw-r--r--lisp/textmodes/fill.el44
-rw-r--r--lisp/textmodes/flyspell.el2
-rw-r--r--lisp/textmodes/ispell.el77
-rw-r--r--lisp/textmodes/less-css-mode.el2
-rw-r--r--lisp/textmodes/makeinfo.el2
-rw-r--r--lisp/textmodes/mhtml-mode.el2
-rw-r--r--lisp/textmodes/nroff-mode.el41
-rw-r--r--lisp/textmodes/page-ext.el23
-rw-r--r--lisp/textmodes/page.el2
-rw-r--r--lisp/textmodes/paragraphs.el65
-rw-r--r--lisp/textmodes/picture.el17
-rw-r--r--lisp/textmodes/po.el2
-rw-r--r--lisp/textmodes/refbib.el2
-rw-r--r--lisp/textmodes/refer.el8
-rw-r--r--lisp/textmodes/refill.el14
-rw-r--r--lisp/textmodes/reftex-auc.el2
-rw-r--r--lisp/textmodes/reftex-cite.el2
-rw-r--r--lisp/textmodes/reftex-dcr.el2
-rw-r--r--lisp/textmodes/reftex-global.el2
-rw-r--r--lisp/textmodes/reftex-index.el8
-rw-r--r--lisp/textmodes/reftex-parse.el4
-rw-r--r--lisp/textmodes/reftex-ref.el2
-rw-r--r--lisp/textmodes/reftex-sel.el2
-rw-r--r--lisp/textmodes/reftex-toc.el8
-rw-r--r--lisp/textmodes/reftex-vars.el30
-rw-r--r--lisp/textmodes/reftex.el12
-rw-r--r--lisp/textmodes/remember.el13
-rw-r--r--lisp/textmodes/rst.el17
-rw-r--r--lisp/textmodes/sgml-mode.el6
-rw-r--r--lisp/textmodes/table.el187
-rw-r--r--lisp/textmodes/tex-mode.el11
-rw-r--r--lisp/textmodes/texinfmt.el2
-rw-r--r--lisp/textmodes/texinfo.el2
-rw-r--r--lisp/textmodes/texnfo-upd.el2
-rw-r--r--lisp/textmodes/text-mode.el2
-rw-r--r--lisp/textmodes/tildify.el2
-rw-r--r--lisp/textmodes/two-column.el7
-rw-r--r--lisp/textmodes/underline.el2
-rw-r--r--lisp/thingatpt.el2
-rw-r--r--lisp/thread.el2
-rw-r--r--lisp/thumbs.el7
-rw-r--r--lisp/time-stamp.el10
-rw-r--r--lisp/time.el2
-rw-r--r--lisp/timezone.el4
-rw-r--r--lisp/tmm.el2
-rw-r--r--lisp/tool-bar.el5
-rw-r--r--lisp/tooltip.el2
-rw-r--r--lisp/tree-widget.el9
-rw-r--r--lisp/tutorial.el16
-rw-r--r--lisp/type-break.el2
-rw-r--r--lisp/uniquify.el2
-rw-r--r--lisp/url/ChangeLog.12
-rw-r--r--lisp/url/url-about.el2
-rw-r--r--lisp/url/url-auth.el31
-rw-r--r--lisp/url/url-cache.el25
-rw-r--r--lisp/url/url-cid.el2
-rw-r--r--lisp/url/url-cookie.el4
-rw-r--r--lisp/url/url-dav.el2
-rw-r--r--lisp/url/url-dired.el4
-rw-r--r--lisp/url/url-domsuf.el2
-rw-r--r--lisp/url/url-expand.el10
-rw-r--r--lisp/url/url-file.el2
-rw-r--r--lisp/url/url-ftp.el4
-rw-r--r--lisp/url/url-future.el2
-rw-r--r--lisp/url/url-gw.el2
-rw-r--r--lisp/url/url-handlers.el6
-rw-r--r--lisp/url/url-history.el2
-rw-r--r--lisp/url/url-http.el18
-rw-r--r--lisp/url/url-imap.el2
-rw-r--r--lisp/url/url-irc.el8
-rw-r--r--lisp/url/url-ldap.el2
-rw-r--r--lisp/url/url-mailto.el2
-rw-r--r--lisp/url/url-methods.el2
-rw-r--r--lisp/url/url-misc.el2
-rw-r--r--lisp/url/url-news.el5
-rw-r--r--lisp/url/url-nfs.el2
-rw-r--r--lisp/url/url-parse.el2
-rw-r--r--lisp/url/url-privacy.el2
-rw-r--r--lisp/url/url-proxy.el5
-rw-r--r--lisp/url/url-queue.el2
-rw-r--r--lisp/url/url-tramp.el2
-rw-r--r--lisp/url/url-util.el6
-rw-r--r--lisp/url/url-vars.el2
-rw-r--r--lisp/url/url.el16
-rw-r--r--lisp/userlock.el4
-rw-r--r--lisp/vc/add-log.el48
-rw-r--r--lisp/vc/compare-w.el2
-rw-r--r--lisp/vc/cvs-status.el6
-rw-r--r--lisp/vc/diff-mode.el68
-rw-r--r--lisp/vc/diff.el8
-rw-r--r--lisp/vc/ediff-diff.el4
-rw-r--r--lisp/vc/ediff-help.el2
-rw-r--r--lisp/vc/ediff-hook.el2
-rw-r--r--lisp/vc/ediff-init.el14
-rw-r--r--lisp/vc/ediff-merg.el4
-rw-r--r--lisp/vc/ediff-mult.el6
-rw-r--r--lisp/vc/ediff-ptch.el19
-rw-r--r--lisp/vc/ediff-util.el9
-rw-r--r--lisp/vc/ediff-vers.el2
-rw-r--r--lisp/vc/ediff-wind.el22
-rw-r--r--lisp/vc/ediff.el4
-rw-r--r--lisp/vc/log-edit.el38
-rw-r--r--lisp/vc/log-view.el18
-rw-r--r--lisp/vc/pcvs-defs.el2
-rw-r--r--lisp/vc/pcvs-info.el2
-rw-r--r--lisp/vc/pcvs-parse.el2
-rw-r--r--lisp/vc/pcvs-util.el2
-rw-r--r--lisp/vc/pcvs.el39
-rw-r--r--lisp/vc/smerge-mode.el58
-rw-r--r--lisp/vc/vc-annotate.el20
-rw-r--r--lisp/vc/vc-bzr.el14
-rw-r--r--lisp/vc/vc-cvs.el2
-rw-r--r--lisp/vc/vc-dav.el2
-rw-r--r--lisp/vc/vc-dir.el16
-rw-r--r--lisp/vc/vc-dispatcher.el24
-rw-r--r--lisp/vc/vc-filewise.el2
-rw-r--r--lisp/vc/vc-git.el22
-rw-r--r--lisp/vc/vc-hg.el40
-rw-r--r--lisp/vc/vc-hooks.el4
-rw-r--r--lisp/vc/vc-mtn.el12
-rw-r--r--lisp/vc/vc-rcs.el2
-rw-r--r--lisp/vc/vc-sccs.el2
-rw-r--r--lisp/vc/vc-src.el2
-rw-r--r--lisp/vc/vc-svn.el4
-rw-r--r--lisp/vc/vc.el114
-rw-r--r--lisp/vcursor.el19
-rw-r--r--lisp/version.el8
-rw-r--r--lisp/view.el14
-rw-r--r--lisp/vt-control.el2
-rw-r--r--lisp/vt100-led.el2
-rw-r--r--lisp/w32-fns.el16
-rw-r--r--lisp/w32-vars.el2
-rw-r--r--lisp/wdired.el25
-rw-r--r--lisp/whitespace.el44
-rw-r--r--lisp/wid-browse.el5
-rw-r--r--lisp/wid-edit.el110
-rw-r--r--lisp/widget.el4
-rw-r--r--lisp/windmove.el8
-rw-r--r--lisp/window.el113
-rw-r--r--lisp/winner.el2
-rw-r--r--lisp/woman.el3
-rw-r--r--lisp/x-dnd.el8
-rw-r--r--lisp/xdg.el2
-rw-r--r--lisp/xml.el2
-rw-r--r--lisp/xt-mouse.el9
-rw-r--r--lisp/xwidget.el4
-rw-r--r--lwlib/ChangeLog.12
-rw-r--r--lwlib/Makefile.in2
-rw-r--r--lwlib/deps.mk2
-rw-r--r--lwlib/lwlib-Xaw.c2
-rw-r--r--lwlib/lwlib-Xlw.c2
-rw-r--r--lwlib/lwlib-Xm.c2
-rw-r--r--lwlib/lwlib-int.h2
-rw-r--r--lwlib/lwlib-utils.c17
-rw-r--r--lwlib/lwlib-widget.h2
-rw-r--r--lwlib/lwlib.c2
-rw-r--r--lwlib/lwlib.h2
-rw-r--r--lwlib/xlwmenu.c2
-rw-r--r--lwlib/xlwmenu.h2
-rw-r--r--lwlib/xlwmenuP.h2
-rw-r--r--m4/00gnulib.m42
-rw-r--r--m4/__inline.m42
-rw-r--r--m4/absolute-header.m42
-rw-r--r--m4/acl.m42
-rw-r--r--m4/alloca.m46
-rw-r--r--m4/builtin-expect.m42
-rw-r--r--m4/byteswap.m42
-rw-r--r--m4/canonicalize.m410
-rw-r--r--m4/clock_time.m42
-rw-r--r--m4/close-stream.m42
-rw-r--r--m4/copy-file-range.m42
-rw-r--r--m4/d-type.m42
-rw-r--r--m4/dirent_h.m42
-rw-r--r--m4/dirfd.m42
-rw-r--r--m4/double-slash-root.m42
-rw-r--r--m4/dup2.m42
-rw-r--r--m4/eealloc.m42
-rw-r--r--m4/environ.m42
-rw-r--r--m4/errno_h.m42
-rw-r--r--m4/euidaccess.m42
-rw-r--r--m4/execinfo.m42
-rw-r--r--m4/explicit_bzero.m42
-rw-r--r--m4/extensions.m4162
-rw-r--r--m4/extern-inline.m42
-rw-r--r--m4/faccessat.m46
-rw-r--r--m4/fchmodat.m42
-rw-r--r--m4/fcntl.m454
-rw-r--r--m4/fcntl_h.m47
-rw-r--r--m4/fdopendir.m42
-rw-r--r--m4/filemode.m45
-rw-r--r--m4/flexmember.m42
-rw-r--r--m4/fpending.m42
-rw-r--r--m4/fpieee.m42
-rw-r--r--m4/free.m449
-rw-r--r--m4/fstatat.m42
-rw-r--r--m4/fsusage.m45
-rw-r--r--m4/fsync.m42
-rw-r--r--m4/futimens.m42
-rw-r--r--m4/getdtablesize.m42
-rw-r--r--m4/getgroups.m42
-rw-r--r--m4/getloadavg.m42
-rw-r--r--m4/getopt.m42
-rw-r--r--m4/getrandom.m42
-rw-r--r--m4/gettime.m42
-rw-r--r--m4/gettimeofday.m42
-rw-r--r--m4/glibc21.m44
-rw-r--r--m4/gnulib-common.m465
-rw-r--r--m4/gnulib-comp.m498
-rw-r--r--m4/group-member.m42
-rw-r--r--m4/ieee754-h.m42
-rw-r--r--m4/include_next.m42
-rw-r--r--m4/inttypes.m42
-rw-r--r--m4/largefile.m44
-rw-r--r--m4/lchmod.m42
-rw-r--r--m4/libgmp.m42
-rw-r--r--m4/limits-h.m42
-rw-r--r--m4/lstat.m42
-rw-r--r--m4/malloca.m44
-rw-r--r--m4/manywarnings.m42
-rw-r--r--m4/mbstate_t.m413
-rw-r--r--m4/md5.m42
-rw-r--r--m4/memmem.m42
-rw-r--r--m4/mempcpy.m42
-rw-r--r--m4/memrchr.m42
-rw-r--r--m4/minmax.m42
-rw-r--r--m4/mkostemp.m42
-rw-r--r--m4/mktime.m42
-rw-r--r--m4/mode_t.m42
-rw-r--r--m4/multiarch.m42
-rw-r--r--m4/nocrash.m42
-rw-r--r--m4/nstrftime.m42
-rw-r--r--m4/off_t.m42
-rw-r--r--m4/open-cloexec.m42
-rw-r--r--m4/open-slash.m42
-rw-r--r--m4/open.m42
-rw-r--r--m4/pathmax.m42
-rw-r--r--m4/pid_t.m438
-rw-r--r--m4/pipe2.m42
-rw-r--r--m4/pselect.m42
-rw-r--r--m4/pthread_sigmask.m42
-rw-r--r--m4/rawmemchr.m420
-rw-r--r--m4/readlink.m463
-rw-r--r--m4/readlinkat.m415
-rw-r--r--m4/regex.m45
-rw-r--r--m4/sha1.m42
-rw-r--r--m4/sha256.m42
-rw-r--r--m4/sha512.m42
-rw-r--r--m4/sig2str.m42
-rw-r--r--m4/sigdescr_np.m42
-rw-r--r--m4/signal_h.m42
-rw-r--r--m4/socklen.m42
-rw-r--r--m4/ssize_t.m42
-rw-r--r--m4/st_dm_mode.m43
-rw-r--r--m4/stat-time.m42
-rw-r--r--m4/std-gnu11.m47
-rw-r--r--m4/stdalign.m42
-rw-r--r--m4/stddef_h.m42
-rw-r--r--m4/stdint.m412
-rw-r--r--m4/stdio_h.m417
-rw-r--r--m4/stdlib_h.m444
-rw-r--r--m4/stpcpy.m42
-rw-r--r--m4/string_h.m47
-rw-r--r--m4/strnlen.m42
-rw-r--r--m4/strtoimax.m42
-rw-r--r--m4/strtoll.m42
-rw-r--r--m4/symlink.m42
-rw-r--r--m4/sys_random_h.m42
-rw-r--r--m4/sys_select_h.m42
-rw-r--r--m4/sys_socket_h.m42
-rw-r--r--m4/sys_stat_h.m49
-rw-r--r--m4/sys_time_h.m42
-rw-r--r--m4/sys_types_h.m424
-rw-r--r--m4/tempname.m42
-rw-r--r--m4/time_h.m46
-rw-r--r--m4/time_r.m42
-rw-r--r--m4/time_rz.m42
-rw-r--r--m4/timegm.m42
-rw-r--r--m4/timer_time.m42
-rw-r--r--m4/timespec.m42
-rw-r--r--m4/tm_gmtoff.m42
-rw-r--r--m4/unistd_h.m451
-rw-r--r--m4/unlocked-io.m42
-rw-r--r--m4/utimens.m42
-rw-r--r--m4/utimensat.m42
-rw-r--r--m4/utimes.m42
-rw-r--r--m4/vararrays.m416
-rw-r--r--m4/warnings.m42
-rw-r--r--m4/wchar_t.m42
-rw-r--r--m4/zzgnulib.m42
-rwxr-xr-xmake-dist26
-rwxr-xr-xmodules/modhelp.py2
-rw-r--r--msdos/ChangeLog.12
-rw-r--r--msdos/INSTALL2
-rw-r--r--msdos/README4
-rw-r--r--msdos/autogen/Makefile.in6
-rw-r--r--msdos/autogen/config.in2
-rw-r--r--msdos/depfiles.bat2
-rw-r--r--msdos/inttypes.h2
-rw-r--r--msdos/mainmake.v22
-rw-r--r--msdos/sed1v2.inp2
-rw-r--r--msdos/sed1x.inp2
-rw-r--r--msdos/sed2v2.inp4
-rw-r--r--msdos/sed2x.inp2
-rw-r--r--msdos/sed3v2.inp2
-rw-r--r--msdos/sed4.inp2
-rw-r--r--msdos/sed5x.inp2
-rw-r--r--msdos/sed6.inp2
-rw-r--r--msdos/sedadmin.inp2
-rw-r--r--msdos/sedalloc.inp2
-rw-r--r--msdos/sedleim.inp2
-rw-r--r--msdos/sedlibcf.inp2
-rw-r--r--msdos/sedlibmk.inp2
-rw-r--r--msdos/sedlisp.inp2
-rw-r--r--nextstep/ChangeLog.12
-rw-r--r--nextstep/INSTALL2
-rw-r--r--nextstep/Makefile.in2
-rw-r--r--nextstep/README2
-rw-r--r--nextstep/templates/Info.plist.in2
-rw-r--r--nt/ChangeLog.12
-rw-r--r--nt/INSTALL20
-rw-r--r--nt/INSTALL.W6414
-rw-r--r--nt/Makefile.in2
-rw-r--r--nt/README2
-rw-r--r--nt/README.W322
-rw-r--r--nt/addpm.c2
-rw-r--r--nt/cmdproxy.c2
-rwxr-xr-xnt/configure.bat2
-rw-r--r--nt/ddeclient.c2
-rw-r--r--nt/emacs.rc.in2
-rw-r--r--nt/emacsclient.rc.in2
-rw-r--r--nt/epaths.nt2
-rw-r--r--nt/gnulib-cfg.mk2
-rw-r--r--nt/icons/README6
-rw-r--r--nt/inc/grp.h2
-rw-r--r--nt/inc/inttypes.h2
-rw-r--r--nt/inc/langinfo.h2
-rw-r--r--nt/inc/ms-w32.h2
-rw-r--r--nt/inc/nl_types.h2
-rw-r--r--nt/inc/stdint.h2
-rw-r--r--nt/inc/sys/resource.h2
-rw-r--r--nt/inc/sys/socket.h2
-rw-r--r--nt/inc/sys/stat.h2
-rw-r--r--nt/inc/sys/wait.h2
-rw-r--r--nt/mingw-cfg.site6
-rw-r--r--nt/preprep.c2
-rw-r--r--nt/runemacs.c2
-rw-r--r--oldXMenu/Activate.c2
-rw-r--r--oldXMenu/ChangeLog.12
-rw-r--r--oldXMenu/Create.c2
-rw-r--r--oldXMenu/FindSel.c2
-rw-r--r--oldXMenu/Internal.c2
-rw-r--r--oldXMenu/Makefile.in2
-rw-r--r--oldXMenu/deps.mk2
-rw-r--r--oldXMenu/insque.c2
-rw-r--r--src/.gdbinit2
-rw-r--r--src/ChangeLog.12
-rw-r--r--src/ChangeLog.102
-rw-r--r--src/ChangeLog.112
-rw-r--r--src/ChangeLog.122
-rw-r--r--src/ChangeLog.132
-rw-r--r--src/ChangeLog.22
-rw-r--r--src/ChangeLog.32
-rw-r--r--src/ChangeLog.42
-rw-r--r--src/ChangeLog.52
-rw-r--r--src/ChangeLog.62
-rw-r--r--src/ChangeLog.72
-rw-r--r--src/ChangeLog.82
-rw-r--r--src/ChangeLog.92
-rw-r--r--src/Makefile.in9
-rw-r--r--src/README2
-rw-r--r--src/alloc.c65
-rw-r--r--src/atimer.c2
-rw-r--r--src/atimer.h2
-rw-r--r--src/bidi.c14
-rw-r--r--src/bignum.c2
-rw-r--r--src/bignum.h2
-rw-r--r--src/blockinput.h2
-rw-r--r--src/buffer.c121
-rw-r--r--src/buffer.h15
-rw-r--r--src/bytecode.c2
-rw-r--r--src/callint.c7
-rw-r--r--src/callproc.c520
-rw-r--r--src/casefiddle.c15
-rw-r--r--src/casetab.c2
-rw-r--r--src/category.c2
-rw-r--r--src/ccl.c4
-rw-r--r--src/character.c23
-rw-r--r--src/character.h1
-rw-r--r--src/charset.c6
-rw-r--r--src/charset.h2
-rw-r--r--src/chartab.c6
-rw-r--r--src/cm.c2
-rw-r--r--src/cm.h2
-rw-r--r--src/cmds.c23
-rw-r--r--src/coding.c32
-rw-r--r--src/coding.h5
-rw-r--r--src/commands.h10
-rw-r--r--src/composite.c2
-rw-r--r--src/composite.h2
-rw-r--r--src/conf_post.h2
-rw-r--r--src/cygw32.c2
-rw-r--r--src/cygw32.h2
-rw-r--r--src/data.c22
-rw-r--r--src/dbusbind.c45
-rw-r--r--src/decompress.c2
-rw-r--r--src/deps.mk2
-rw-r--r--src/dired.c47
-rw-r--r--src/dispextern.h7
-rw-r--r--src/dispnew.c89
-rw-r--r--src/disptab.h2
-rw-r--r--src/dmpstruct.awk2
-rw-r--r--src/doc.c80
-rw-r--r--src/doprnt.c36
-rw-r--r--src/dosfns.c2
-rw-r--r--src/dosfns.h2
-rw-r--r--src/dynlib.c2
-rw-r--r--src/dynlib.h2
-rw-r--r--src/editfns.c24
-rw-r--r--src/emacs-icon.h2
-rw-r--r--src/emacs-module.c118
-rw-r--r--src/emacs-module.h.in2
-rw-r--r--src/emacs.c35
-rw-r--r--src/emacsgtkfixed.c2
-rw-r--r--src/emacsgtkfixed.h2
-rw-r--r--src/epaths.in2
-rw-r--r--src/eval.c145
-rw-r--r--src/fileio.c22
-rw-r--r--src/filelock.c2
-rw-r--r--src/firstfile.c2
-rw-r--r--src/floatfns.c2
-rw-r--r--src/fns.c257
-rw-r--r--src/font.c19
-rw-r--r--src/font.h2
-rw-r--r--src/fontset.c2
-rw-r--r--src/fontset.h2
-rw-r--r--src/frame.c90
-rw-r--r--src/frame.h2
-rw-r--r--src/fringe.c2
-rw-r--r--src/ftcrfont.c9
-rw-r--r--src/ftfont.c2
-rw-r--r--src/getpagesize.h2
-rw-r--r--src/gfilenotify.c2
-rw-r--r--src/gmalloc.c2
-rw-r--r--src/gnutls.c4
-rw-r--r--src/gnutls.h2
-rw-r--r--src/gtkutil.c9
-rw-r--r--src/gtkutil.h2
-rw-r--r--src/hbfont.c2
-rw-r--r--src/image.c280
-rw-r--r--src/indent.c2
-rw-r--r--src/indent.h2
-rw-r--r--src/inotify.c2
-rw-r--r--src/insdel.c2
-rw-r--r--src/intervals.c2
-rw-r--r--src/intervals.h2
-rw-r--r--src/json.c2
-rw-r--r--src/keyboard.c103
-rw-r--r--src/keyboard.h5
-rw-r--r--src/keymap.c403
-rw-r--r--src/keymap.h4
-rw-r--r--src/kqueue.c7
-rw-r--r--src/lastfile.c2
-rw-r--r--src/lcms.c2
-rw-r--r--src/lisp.h81
-rw-r--r--src/lread.c33
-rw-r--r--src/macfont.h2
-rw-r--r--src/macfont.m2
-rw-r--r--src/macros.c2
-rw-r--r--src/macros.h2
-rw-r--r--src/marker.c2
-rw-r--r--src/menu.c2
-rw-r--r--src/menu.h2
-rw-r--r--src/minibuf.c339
-rw-r--r--src/msdos.c2
-rw-r--r--src/msdos.h2
-rw-r--r--src/nsfns.m24
-rw-r--r--src/nsfont.m9
-rw-r--r--src/nsgui.h2
-rw-r--r--src/nsimage.m40
-rw-r--r--src/nsmenu.m644
-rw-r--r--src/nsselect.m27
-rw-r--r--src/nsterm.h58
-rw-r--r--src/nsterm.m651
-rw-r--r--src/nsxwidget.h2
-rw-r--r--src/nsxwidget.m21
-rw-r--r--src/pdumper.c10
-rw-r--r--src/pdumper.h2
-rw-r--r--src/print.c71
-rw-r--r--src/process.c422
-rw-r--r--src/process.h2
-rw-r--r--src/profiler.c2
-rw-r--r--src/puresize.h2
-rw-r--r--src/ralloc.c2
-rw-r--r--src/regex-emacs.c19
-rw-r--r--src/regex-emacs.h2
-rw-r--r--src/region-cache.c2
-rw-r--r--src/region-cache.h2
-rw-r--r--src/scroll.c2
-rw-r--r--src/search.c20
-rw-r--r--src/sheap.c2
-rw-r--r--src/sheap.h2
-rw-r--r--src/sound.c2
-rw-r--r--src/syntax.c2
-rw-r--r--src/syntax.h2
-rw-r--r--src/sysdep.c250
-rw-r--r--src/sysselect.h2
-rw-r--r--src/syssignal.h2
-rw-r--r--src/sysstdio.h2
-rw-r--r--src/systhread.c2
-rw-r--r--src/systhread.h2
-rw-r--r--src/systime.h2
-rw-r--r--src/systty.h2
-rw-r--r--src/syswait.h2
-rw-r--r--src/term.c110
-rw-r--r--src/termcap.c2
-rw-r--r--src/termchar.h2
-rw-r--r--src/termhooks.h11
-rw-r--r--src/terminal.c2
-rw-r--r--src/terminfo.c8
-rw-r--r--src/termopts.h2
-rw-r--r--src/textprop.c2
-rw-r--r--src/thread.c2
-rw-r--r--src/thread.h3
-rw-r--r--src/timefns.c2
-rw-r--r--src/tparam.c2
-rw-r--r--src/tparam.h2
-rw-r--r--src/undo.c2
-rw-r--r--src/unexaix.c2
-rw-r--r--src/unexcoff.c2
-rw-r--r--src/unexcw.c2
-rw-r--r--src/unexelf.c2
-rw-r--r--src/unexmacosx.c2
-rw-r--r--src/unexw32.c2
-rw-r--r--src/vm-limit.c2
-rw-r--r--src/w16select.c2
-rw-r--r--src/w32.c7
-rw-r--r--src/w32.h4
-rw-r--r--src/w32common.h2
-rw-r--r--src/w32console.c2
-rw-r--r--src/w32cygwinx.c2
-rw-r--r--src/w32fns.c45
-rw-r--r--src/w32font.c2
-rw-r--r--src/w32font.h2
-rw-r--r--src/w32gui.h3
-rw-r--r--src/w32heap.c2
-rw-r--r--src/w32heap.h2
-rw-r--r--src/w32image.c2
-rw-r--r--src/w32inevt.c2
-rw-r--r--src/w32inevt.h2
-rw-r--r--src/w32menu.c2
-rw-r--r--src/w32notify.c2
-rw-r--r--src/w32proc.c6
-rw-r--r--src/w32reg.c2
-rw-r--r--src/w32select.c2
-rw-r--r--src/w32select.h2
-rw-r--r--src/w32term.c51
-rw-r--r--src/w32term.h2
-rw-r--r--src/w32uniscribe.c2
-rw-r--r--src/w32xfns.c2
-rw-r--r--src/widget.c2
-rw-r--r--src/widget.h2
-rw-r--r--src/widgetprv.h2
-rw-r--r--src/window.c119
-rw-r--r--src/window.h7
-rw-r--r--src/xdisp.c293
-rw-r--r--src/xfaces.c10
-rw-r--r--src/xfns.c33
-rw-r--r--src/xfont.c2
-rw-r--r--src/xftfont.c2
-rw-r--r--src/xgselect.c2
-rw-r--r--src/xgselect.h2
-rw-r--r--src/xmenu.c2
-rw-r--r--src/xml.c2
-rw-r--r--src/xrdb.c2
-rw-r--r--src/xselect.c2
-rw-r--r--src/xsettings.c2
-rw-r--r--src/xsettings.h2
-rw-r--r--src/xsmfns.c2
-rw-r--r--src/xterm.c56
-rw-r--r--src/xterm.h2
-rw-r--r--src/xwidget.c15
-rw-r--r--src/xwidget.h2
-rw-r--r--test/ChangeLog.12
-rw-r--r--test/Makefile.in25
-rw-r--r--test/README14
-rw-r--r--test/file-organization.org21
-rw-r--r--test/infra/Dockerfile.emba71
-rw-r--r--test/infra/gitlab-ci.yml243
-rw-r--r--test/lib-src/emacsclient-tests.el2
-rw-r--r--test/lisp/abbrev-tests.el7
-rw-r--r--test/lisp/align-resources/align-post.c3
-rw-r--r--test/lisp/align-resources/align-post.java9
-rw-r--r--test/lisp/align-resources/align-pre.c3
-rw-r--r--test/lisp/align-resources/align-pre.java9
-rw-r--r--test/lisp/align-tests.el47
-rw-r--r--test/lisp/allout-tests.el8
-rw-r--r--test/lisp/allout-widgets-tests.el2
-rw-r--r--test/lisp/ansi-color-tests.el49
-rw-r--r--test/lisp/apropos-tests.el2
-rw-r--r--test/lisp/arc-mode-tests.el2
-rw-r--r--test/lisp/auth-source-pass-tests.el2
-rw-r--r--test/lisp/auth-source-tests.el2
-rw-r--r--test/lisp/autoinsert-tests.el2
-rw-r--r--test/lisp/autorevert-tests.el87
-rw-r--r--test/lisp/battery-tests.el2
-rw-r--r--test/lisp/bookmark-tests.el2
-rw-r--r--test/lisp/buff-menu-tests.el2
-rw-r--r--test/lisp/button-tests.el2
-rw-r--r--test/lisp/calc/calc-tests.el2
-rw-r--r--test/lisp/calendar/cal-julian-tests.el2
-rw-r--r--test/lisp/calendar/icalendar-tests.el2
-rw-r--r--test/lisp/calendar/iso8601-tests.el2
-rw-r--r--test/lisp/calendar/lunar-tests.el40
-rw-r--r--test/lisp/calendar/parse-time-tests.el2
-rw-r--r--test/lisp/calendar/solar-tests.el6
-rw-r--r--test/lisp/calendar/time-date-tests.el2
-rw-r--r--test/lisp/calendar/todo-mode-tests.el2
-rw-r--r--test/lisp/cedet/semantic-utest-c.el2
-rw-r--r--test/lisp/cedet/semantic-utest-fmt.el2
-rw-r--r--test/lisp/cedet/semantic-utest-ia.el4
-rw-r--r--test/lisp/cedet/semantic-utest.el15
-rw-r--r--test/lisp/cedet/srecode-utest-getset.el3
-rw-r--r--test/lisp/cedet/srecode-utest-template.el8
-rw-r--r--test/lisp/char-fold-tests.el2
-rw-r--r--test/lisp/color-tests.el2
-rw-r--r--test/lisp/comint-tests.el2
-rw-r--r--test/lisp/completion-tests.el2
-rw-r--r--test/lisp/cus-edit-tests.el80
-rw-r--r--test/lisp/custom-tests.el49
-rw-r--r--test/lisp/dabbrev-tests.el2
-rw-r--r--test/lisp/delim-col-tests.el2
-rw-r--r--test/lisp/descr-text-tests.el2
-rw-r--r--test/lisp/dired-aux-tests.el2
-rw-r--r--test/lisp/dired-tests.el78
-rw-r--r--test/lisp/dired-x-tests.el2
-rw-r--r--test/lisp/dom-tests.el2
-rw-r--r--test/lisp/electric-tests.el2
-rw-r--r--test/lisp/elide-head-tests.el2
-rw-r--r--test/lisp/emacs-lisp/backquote-tests.el2
-rw-r--r--test/lisp/emacs-lisp/backtrace-tests.el2
-rw-r--r--test/lisp/emacs-lisp/benchmark-tests.el2
-rw-r--r--test/lisp/emacs-lisp/bindat-tests.el2
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/error-lexical-var-with-add-hook.el4
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/error-lexical-var-with-remove-hook.el4
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/error-lexical-var-with-run-hook-with-args-until-failure.el3
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/error-lexical-var-with-run-hook-with-args-until-success.el3
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/error-lexical-var-with-run-hook-with-args.el3
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/error-lexical-var-with-symbol-value.el4
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/warn-autoload-not-on-top-level.el3
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/warn-callargs.el5
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/warn-defcustom-nogroup.el3
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/warn-defcustom-notype.el3
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/warn-defvar-lacks-prefix.el2
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/warn-format.el2
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/warn-free-setq.el2
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/warn-free-variable-reference.el4
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/warn-interactive-only.el3
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/warn-lambda-malformed-interactive-spec.el4
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/warn-make-variable-buffer-local.el4
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-defun.el8
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-hook.el3
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-variable-bound.el7
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-variable-same-file.el13
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-variable.el4
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/warn-redefine-defun-as-macro.el3
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/warn-redefine-defun.el3
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/warn-redefine-macro-as-defun.el3
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/warn-save-excursion.el5
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/warn-variable-let-bind-constant.el3
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/warn-variable-let-bind-nonvariable.el3
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/warn-variable-set-constant.el3
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/warn-variable-set-nonvariable.el3
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-autoload.el3
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-custom-declare-variable.el4
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defalias.el3
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defconst.el3
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-define-abbrev-table.el3
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-define-obsolete-function-alias.el3
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-define-obsolete-variable-alias.el3
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defun.el3
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defvar.el6
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defvaralias.el3
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-ignore-fill-column.el7
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-ignore-override.el8
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-ignore.el7
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-multiline-first.el5
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-multiline.el6
-rw-r--r--test/lisp/emacs-lisp/bytecomp-tests.el298
-rw-r--r--test/lisp/emacs-lisp/cconv-tests.el2
-rw-r--r--test/lisp/emacs-lisp/check-declare-tests.el2
-rw-r--r--test/lisp/emacs-lisp/checkdoc-tests.el2
-rw-r--r--test/lisp/emacs-lisp/cl-extra-tests.el2
-rw-r--r--test/lisp/emacs-lisp/cl-generic-tests.el2
-rw-r--r--test/lisp/emacs-lisp/cl-lib-tests.el2
-rw-r--r--test/lisp/emacs-lisp/cl-macs-tests.el25
-rw-r--r--test/lisp/emacs-lisp/cl-preloaded-tests.el2
-rw-r--r--test/lisp/emacs-lisp/cl-print-tests.el2
-rw-r--r--test/lisp/emacs-lisp/cl-seq-tests.el2
-rw-r--r--test/lisp/emacs-lisp/copyright-tests.el2
-rw-r--r--test/lisp/emacs-lisp/derived-tests.el2
-rw-r--r--test/lisp/emacs-lisp/easy-mmode-tests.el33
-rw-r--r--test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el2
-rw-r--r--test/lisp/emacs-lisp/edebug-tests.el7
-rw-r--r--test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el2
-rw-r--r--test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el2
-rw-r--r--test/lisp/emacs-lisp/eieio-tests/eieio-tests.el2
-rw-r--r--test/lisp/emacs-lisp/ert-tests.el17
-rw-r--r--test/lisp/emacs-lisp/ert-x-tests.el2
-rw-r--r--test/lisp/emacs-lisp/faceup-resources/faceup-test-mode.el6
-rw-r--r--test/lisp/emacs-lisp/faceup-resources/faceup-test-this-file-directory.el2
-rw-r--r--test/lisp/emacs-lisp/faceup-tests/faceup-test-basics.el2
-rw-r--r--test/lisp/emacs-lisp/faceup-tests/faceup-test-files.el2
-rw-r--r--test/lisp/emacs-lisp/find-func-tests.el75
-rw-r--r--test/lisp/emacs-lisp/float-sup-tests.el2
-rw-r--r--test/lisp/emacs-lisp/generator-tests.el2
-rw-r--r--test/lisp/emacs-lisp/gv-tests.el13
-rw-r--r--test/lisp/emacs-lisp/let-alist-tests.el2
-rw-r--r--test/lisp/emacs-lisp/lisp-mode-tests.el2
-rw-r--r--test/lisp/emacs-lisp/lisp-tests.el2
-rw-r--r--test/lisp/emacs-lisp/map-tests.el2
-rw-r--r--test/lisp/emacs-lisp/memory-report-tests.el57
-rw-r--r--test/lisp/emacs-lisp/nadvice-tests.el2
-rwxr-xr-xtest/lisp/emacs-lisp/package-resources/signed/update-signatures.sh2
-rw-r--r--test/lisp/emacs-lisp/package-tests.el8
-rw-r--r--test/lisp/emacs-lisp/pcase-tests.el6
-rw-r--r--test/lisp/emacs-lisp/pp-tests.el2
-rw-r--r--test/lisp/emacs-lisp/regexp-opt-tests.el2
-rw-r--r--test/lisp/emacs-lisp/ring-tests.el2
-rw-r--r--test/lisp/emacs-lisp/rmc-tests.el2
-rw-r--r--test/lisp/emacs-lisp/rx-tests.el10
-rw-r--r--test/lisp/emacs-lisp/seq-tests.el2
-rw-r--r--test/lisp/emacs-lisp/shadow-tests.el2
-rw-r--r--test/lisp/emacs-lisp/subr-x-tests.el55
-rw-r--r--test/lisp/emacs-lisp/syntax-tests.el2
-rw-r--r--test/lisp/emacs-lisp/tabulated-list-test.el2
-rw-r--r--test/lisp/emacs-lisp/testcover-resources/testcases.el2
-rw-r--r--test/lisp/emacs-lisp/testcover-tests.el2
-rw-r--r--test/lisp/emacs-lisp/text-property-search-tests.el2
-rw-r--r--test/lisp/emacs-lisp/thunk-tests.el2
-rw-r--r--test/lisp/emacs-lisp/timer-tests.el6
-rw-r--r--test/lisp/emacs-lisp/unsafep-tests.el2
-rw-r--r--test/lisp/emacs-lisp/warnings-tests.el2
-rw-r--r--test/lisp/emulation/viper-tests.el2
-rw-r--r--test/lisp/epg-tests.el5
-rw-r--r--test/lisp/erc/erc-tests.el2
-rw-r--r--test/lisp/erc/erc-track-tests.el3
-rw-r--r--test/lisp/eshell/em-hist-tests.el2
-rw-r--r--test/lisp/eshell/em-ls-tests.el2
-rw-r--r--test/lisp/eshell/esh-opt-tests.el2
-rw-r--r--test/lisp/eshell/eshell-tests.el2
-rw-r--r--test/lisp/faces-resources/faces-test-dark-theme.el2
-rw-r--r--test/lisp/faces-resources/faces-test-light-theme.el2
-rw-r--r--test/lisp/faces-tests.el3
-rw-r--r--test/lisp/ffap-tests.el2
-rw-r--r--test/lisp/filenotify-tests.el84
-rw-r--r--test/lisp/files-tests.el2
-rw-r--r--test/lisp/files-x-tests.el10
-rw-r--r--test/lisp/font-lock-tests.el2
-rw-r--r--test/lisp/format-spec-tests.el12
-rw-r--r--test/lisp/gnus/gnus-icalendar-tests.el2
-rw-r--r--test/lisp/gnus/gnus-search-tests.el96
-rw-r--r--test/lisp/gnus/gnus-test-headers.el2
-rw-r--r--test/lisp/gnus/gnus-tests.el2
-rw-r--r--test/lisp/gnus/gnus-util-tests.el2
-rw-r--r--test/lisp/gnus/message-tests.el2
-rw-r--r--test/lisp/gnus/mm-decode-resources/8bit-multipart.bin20
-rw-r--r--test/lisp/gnus/mm-decode-resources/win1252-multipart.bin44
-rw-r--r--test/lisp/gnus/mm-decode-tests.el102
-rw-r--r--test/lisp/gnus/mml-sec-tests.el12
-rw-r--r--test/lisp/gnus/nnrss-tests.el2
-rw-r--r--test/lisp/help-fns-tests.el5
-rw-r--r--test/lisp/help-mode-tests.el23
-rw-r--r--test/lisp/help-tests.el29
-rw-r--r--test/lisp/hfy-cmap-resources/rgb.txt1
-rw-r--r--test/lisp/hfy-cmap-tests.el2
-rw-r--r--test/lisp/hi-lock-tests.el2
-rw-r--r--test/lisp/htmlfontify-tests.el2
-rw-r--r--test/lisp/ibuffer-tests.el2
-rw-r--r--test/lisp/ido-tests.el2
-rw-r--r--test/lisp/image-file-tests.el2
-rw-r--r--test/lisp/image-tests.el2
-rw-r--r--test/lisp/image/exif-tests.el2
-rw-r--r--test/lisp/image/gravatar-tests.el2
-rw-r--r--test/lisp/imenu-tests.el2
-rw-r--r--test/lisp/info-xref-tests.el2
-rw-r--r--test/lisp/international/ccl-tests.el2
-rw-r--r--test/lisp/international/mule-tests.el2
-rw-r--r--test/lisp/international/mule-util-tests.el2
-rw-r--r--test/lisp/international/ucs-normalize-tests.el2
-rw-r--r--test/lisp/isearch-tests.el2
-rw-r--r--test/lisp/jit-lock-tests.el2
-rw-r--r--test/lisp/json-tests.el2
-rw-r--r--test/lisp/jsonrpc-tests.el2
-rw-r--r--test/lisp/kmacro-tests.el2
-rw-r--r--test/lisp/ls-lisp-tests.el2
-rw-r--r--test/lisp/mail/flow-fill-tests.el2
-rw-r--r--test/lisp/mail/footnote-tests.el2
-rw-r--r--test/lisp/mail/qp-tests.el2
-rw-r--r--test/lisp/mail/rfc2045-tests.el2
-rw-r--r--test/lisp/mail/rfc2047-tests.el2
-rw-r--r--test/lisp/mail/rfc2368-tests.el2
-rw-r--r--test/lisp/mail/rfc822-tests.el2
-rw-r--r--test/lisp/mail/rmail-tests.el2
-rw-r--r--test/lisp/mail/rmailmm-tests.el2
-rw-r--r--test/lisp/mail/uudecode-tests.el2
-rw-r--r--test/lisp/makesum-tests.el2
-rw-r--r--test/lisp/man-tests.el2
-rw-r--r--test/lisp/md4-tests.el2
-rw-r--r--test/lisp/minibuffer-tests.el2
-rw-r--r--test/lisp/misc-tests.el2
-rw-r--r--test/lisp/mouse-tests.el2
-rw-r--r--test/lisp/mwheel-tests.el2
-rw-r--r--test/lisp/net/browse-url-tests.el2
-rw-r--r--test/lisp/net/dbus-tests.el2
-rw-r--r--test/lisp/net/dig-tests.el2
-rw-r--r--test/lisp/net/gnutls-tests.el2
-rw-r--r--test/lisp/net/hmac-md5-tests.el2
-rw-r--r--test/lisp/net/mailcap-tests.el2
-rw-r--r--test/lisp/net/netrc-tests.el2
-rw-r--r--test/lisp/net/network-stream-tests.el2
-rw-r--r--test/lisp/net/newsticker-tests.el2
-rw-r--r--test/lisp/net/nsm-tests.el10
-rw-r--r--test/lisp/net/ntlm-tests.el2
-rw-r--r--test/lisp/net/puny-tests.el2
-rw-r--r--test/lisp/net/rcirc-tests.el14
-rw-r--r--test/lisp/net/rfc2104-tests.el2
-rw-r--r--test/lisp/net/sasl-scram-rfc-tests.el2
-rw-r--r--test/lisp/net/secrets-tests.el2
-rw-r--r--test/lisp/net/shr-tests.el2
-rw-r--r--test/lisp/net/socks-tests.el103
-rw-r--r--test/lisp/net/tramp-archive-tests.el2
-rw-r--r--test/lisp/net/tramp-tests.el480
-rw-r--r--test/lisp/net/webjump-tests.el2
-rw-r--r--test/lisp/nxml/nxml-mode-tests.el2
-rw-r--r--test/lisp/nxml/xsd-regexp-tests.el30
-rw-r--r--test/lisp/obarray-tests.el2
-rw-r--r--test/lisp/obsolete/cl-tests.el2
-rw-r--r--test/lisp/org/org-tests.el2
-rw-r--r--test/lisp/paren-tests.el2
-rw-r--r--test/lisp/password-cache-tests.el2
-rw-r--r--test/lisp/pcmpl-linux-tests.el2
-rw-r--r--test/lisp/play/animate-tests.el2
-rw-r--r--test/lisp/play/dissociate-tests.el2
-rw-r--r--test/lisp/play/fortune-resources/fortunes11
-rw-r--r--test/lisp/play/fortune-tests.el41
-rw-r--r--test/lisp/play/life-tests.el2
-rw-r--r--test/lisp/play/morse-tests.el2
-rw-r--r--test/lisp/play/studly-tests.el2
-rw-r--r--test/lisp/progmodes/asm-mode-tests.el2
-rw-r--r--test/lisp/progmodes/autoconf-tests.el2
-rw-r--r--test/lisp/progmodes/bat-mode-tests.el2
-rw-r--r--test/lisp/progmodes/cc-mode-tests.el2
-rw-r--r--test/lisp/progmodes/compile-tests.el8
-rw-r--r--test/lisp/progmodes/cperl-mode-resources/cperl-bug-19709.pl25
-rw-r--r--test/lisp/progmodes/cperl-mode-resources/cperl-bug-26850.pl16
-rw-r--r--test/lisp/progmodes/cperl-mode-resources/cperl-bug-30393.pl19
-rw-r--r--test/lisp/progmodes/cperl-mode-resources/cperl-indent-styles.pl10
-rw-r--r--test/lisp/progmodes/cperl-mode-resources/here-docs.pl143
-rw-r--r--test/lisp/progmodes/cperl-mode-tests.el334
-rw-r--r--test/lisp/progmodes/elisp-mode-tests.el16
-rw-r--r--test/lisp/progmodes/etags-tests.el2
-rw-r--r--test/lisp/progmodes/f90-tests.el2
-rw-r--r--test/lisp/progmodes/flymake-tests.el2
-rw-r--r--test/lisp/progmodes/gdb-mi-tests.el8
-rw-r--r--test/lisp/progmodes/glasses-tests.el2
-rw-r--r--test/lisp/progmodes/js-tests.el2
-rw-r--r--test/lisp/progmodes/opascal-tests.el2
-rw-r--r--test/lisp/progmodes/pascal-tests.el2
-rw-r--r--test/lisp/progmodes/perl-mode-tests.el2
-rw-r--r--test/lisp/progmodes/ps-mode-tests.el2
-rw-r--r--test/lisp/progmodes/python-tests.el2
-rw-r--r--test/lisp/progmodes/ruby-mode-resources/ruby.rb8
-rw-r--r--test/lisp/progmodes/ruby-mode-tests.el5
-rw-r--r--test/lisp/progmodes/scheme-tests.el2
-rw-r--r--test/lisp/progmodes/sql-tests.el2
-rw-r--r--test/lisp/progmodes/subword-tests.el2
-rw-r--r--test/lisp/progmodes/tcl-tests.el16
-rw-r--r--test/lisp/progmodes/xref-tests.el87
-rw-r--r--test/lisp/ps-print-tests.el2
-rw-r--r--test/lisp/register-tests.el2
-rw-r--r--test/lisp/replace-tests.el2
-rw-r--r--test/lisp/rot13-tests.el2
-rw-r--r--test/lisp/saveplace-tests.el2
-rw-r--r--test/lisp/scroll-lock-tests.el2
-rw-r--r--test/lisp/ses-tests.el2
-rw-r--r--test/lisp/shadowfile-tests.el2
-rw-r--r--test/lisp/shell-tests.el2
-rw-r--r--test/lisp/simple-tests.el2
-rw-r--r--test/lisp/so-long-tests/autoload-longlines-mode-tests.el2
-rw-r--r--test/lisp/so-long-tests/autoload-major-mode-tests.el2
-rw-r--r--test/lisp/so-long-tests/autoload-minor-mode-tests.el2
-rw-r--r--test/lisp/so-long-tests/so-long-tests-helpers.el2
-rw-r--r--test/lisp/so-long-tests/so-long-tests.el2
-rw-r--r--test/lisp/so-long-tests/spelling-tests.el2
-rw-r--r--test/lisp/sort-tests.el2
-rw-r--r--test/lisp/soundex-tests.el2
-rw-r--r--test/lisp/startup-tests.el2
-rw-r--r--test/lisp/subr-tests.el197
-rw-r--r--test/lisp/tabify-tests.el2
-rw-r--r--test/lisp/tar-mode-tests.el2
-rw-r--r--test/lisp/tempo-tests.el2
-rw-r--r--test/lisp/term-tests.el2
-rw-r--r--test/lisp/term/tty-colors-tests.el2
-rw-r--r--test/lisp/textmodes/bibtex-tests.el2
-rw-r--r--test/lisp/textmodes/conf-mode-tests.el2
-rw-r--r--test/lisp/textmodes/css-mode-tests.el2
-rw-r--r--test/lisp/textmodes/dns-mode-tests.el2
-rw-r--r--test/lisp/textmodes/fill-tests.el33
-rw-r--r--test/lisp/textmodes/mhtml-mode-tests.el2
-rw-r--r--test/lisp/textmodes/page-tests.el2
-rw-r--r--test/lisp/textmodes/paragraphs-resources/mark-paragraph.bin9
-rw-r--r--test/lisp/textmodes/paragraphs-tests.el25
-rw-r--r--test/lisp/textmodes/po-tests.el2
-rw-r--r--test/lisp/textmodes/reftex-tests.el37
-rw-r--r--test/lisp/textmodes/sgml-mode-tests.el2
-rw-r--r--test/lisp/textmodes/tildify-tests.el2
-rw-r--r--test/lisp/textmodes/underline-tests.el2
-rw-r--r--test/lisp/thingatpt-tests.el2
-rw-r--r--test/lisp/thread-tests.el2
-rw-r--r--test/lisp/time-stamp-tests.el129
-rw-r--r--test/lisp/time-tests.el2
-rw-r--r--test/lisp/timezone-tests.el2
-rw-r--r--test/lisp/url/url-auth-tests.el2
-rw-r--r--test/lisp/url/url-domsuf-tests.el2
-rw-r--r--test/lisp/url/url-expand-tests.el2
-rw-r--r--test/lisp/url/url-file-tests.el2
-rw-r--r--test/lisp/url/url-future-tests.el10
-rw-r--r--test/lisp/url/url-handlers-test.el2
-rw-r--r--test/lisp/url/url-misc-tests.el2
-rw-r--r--test/lisp/url/url-parse-tests.el2
-rw-r--r--test/lisp/url/url-tramp-tests.el2
-rw-r--r--test/lisp/url/url-util-tests.el2
-rw-r--r--test/lisp/vc/add-log-tests.el2
-rw-r--r--test/lisp/vc/diff-mode-tests.el2
-rw-r--r--test/lisp/vc/ediff-diff-tests.el2
-rw-r--r--test/lisp/vc/ediff-ptch-tests.el2
-rw-r--r--test/lisp/vc/log-edit-tests.el2
-rw-r--r--test/lisp/vc/smerge-mode-tests.el2
-rw-r--r--test/lisp/vc/vc-bzr-tests.el2
-rw-r--r--test/lisp/vc/vc-hg-tests.el2
-rw-r--r--test/lisp/vc/vc-tests.el5
-rw-r--r--test/lisp/version-tests.el2
-rw-r--r--test/lisp/wdired-tests.el2
-rw-r--r--test/lisp/whitespace-tests.el2
-rw-r--r--test/lisp/wid-edit-tests.el187
-rw-r--r--test/lisp/xdg-tests.el2
-rw-r--r--test/lisp/xml-tests.el2
-rw-r--r--test/lisp/xt-mouse-tests.el2
-rw-r--r--test/manual/biditest.el2
-rw-r--r--test/manual/cedet/cedet-utests.el2
-rw-r--r--test/manual/cedet/ede-tests.el2
-rw-r--r--test/manual/cedet/semantic-tests.el2
-rw-r--r--test/manual/cedet/srecode-tests.el2
-rw-r--r--test/manual/cedet/tests/test-fmt.cpp2
-rw-r--r--test/manual/cedet/tests/test-fmt.el2
-rw-r--r--test/manual/cedet/tests/test.c2
-rw-r--r--test/manual/cedet/tests/test.el2
-rw-r--r--test/manual/cedet/tests/test.make2
-rw-r--r--test/manual/cedet/tests/test.srt2
-rw-r--r--test/manual/cedet/tests/testdoublens.cpp2
-rw-r--r--test/manual/cedet/tests/testdoublens.hpp2
-rw-r--r--test/manual/cedet/tests/testjavacomp.java2
-rw-r--r--test/manual/cedet/tests/testlocalvars.cpp2
-rw-r--r--test/manual/cedet/tests/testnsp.cpp2
-rw-r--r--test/manual/cedet/tests/testpolymorph.cpp2
-rw-r--r--test/manual/cedet/tests/testspp.c2
-rw-r--r--test/manual/cedet/tests/testsppcomplete.c2
-rw-r--r--test/manual/cedet/tests/testsppreplace.c2
-rw-r--r--test/manual/cedet/tests/testsppreplaced.c2
-rw-r--r--test/manual/cedet/tests/teststruct.cpp2
-rw-r--r--test/manual/cedet/tests/testsubclass.cpp2
-rw-r--r--test/manual/cedet/tests/testsubclass.hh2
-rw-r--r--test/manual/cedet/tests/testtemplates.cpp2
-rw-r--r--test/manual/cedet/tests/testtypedefs.cpp2
-rw-r--r--test/manual/cedet/tests/testusing.cpp2
-rw-r--r--test/manual/cedet/tests/testusing.hh2
-rw-r--r--test/manual/cedet/tests/testvarnames.c2
-rw-r--r--test/manual/cedet/tests/testvarnames.java2
-rw-r--r--test/manual/cedet/tests/testwisent.wy2
-rw-r--r--test/manual/etags/ETAGS.good_114
-rw-r--r--test/manual/etags/ETAGS.good_214
-rw-r--r--test/manual/etags/ETAGS.good_314
-rw-r--r--test/manual/etags/ETAGS.good_414
-rw-r--r--test/manual/etags/ETAGS.good_514
-rw-r--r--test/manual/etags/ETAGS.good_614
-rw-r--r--test/manual/etags/c-src/abbrev.c2
-rw-r--r--test/manual/etags/c-src/emacs/src/gmalloc.c2
-rw-r--r--test/manual/etags/c-src/emacs/src/keyboard.c2
-rw-r--r--test/manual/etags/c-src/emacs/src/lisp.h2
-rw-r--r--test/manual/etags/c-src/emacs/src/regex.h2
-rw-r--r--test/manual/etags/c-src/etags.c2
-rw-r--r--test/manual/etags/c-src/exit.c2
-rw-r--r--test/manual/etags/c-src/exit.strange_suffix2
-rw-r--r--test/manual/etags/c-src/getopt.h2
-rw-r--r--test/manual/etags/c-src/sysdep.h2
-rw-r--r--test/manual/etags/el-src/emacs/lisp/progmodes/etags.el2
-rw-r--r--test/manual/etags/tex-src/texinfo.tex2
-rw-r--r--test/manual/etags/y-src/cccp.c2
-rw-r--r--test/manual/etags/y-src/parse.c2
-rw-r--r--test/manual/etags/y-src/parse.y2
-rw-r--r--test/manual/image-circular-tests.el87
-rw-r--r--test/manual/image-size-tests.el2
-rw-r--r--test/manual/image-transforms-tests.el2
-rw-r--r--test/manual/indent/pascal.pas2
-rwxr-xr-xtest/manual/indent/perl.perl14
-rw-r--r--test/manual/indent/tcl.tcl4
-rw-r--r--test/manual/redisplay-testsuite.el2
-rw-r--r--test/manual/scroll-tests.el2
-rw-r--r--test/src/alloc-tests.el2
-rw-r--r--test/src/buffer-tests.el35
-rw-r--r--test/src/callint-tests.el2
-rw-r--r--test/src/callproc-tests.el2
-rw-r--r--test/src/casefiddle-tests.el5
-rw-r--r--test/src/charset-tests.el2
-rw-r--r--test/src/chartab-tests.el22
-rw-r--r--test/src/cmds-tests.el2
-rw-r--r--test/src/coding-tests.el2
-rw-r--r--test/src/data-tests.el54
-rw-r--r--test/src/decompress-tests.el22
-rw-r--r--test/src/editfns-tests.el2
-rw-r--r--test/src/emacs-module-resources/mod-test.c48
-rw-r--r--test/src/emacs-module-tests.el72
-rw-r--r--test/src/eval-tests.el52
-rw-r--r--test/src/fileio-tests.el8
-rw-r--r--test/src/floatfns-tests.el2
-rw-r--r--test/src/fns-tests.el124
-rw-r--r--test/src/font-tests.el2
-rw-r--r--test/src/indent-tests.el2
-rw-r--r--test/src/inotify-tests.el2
-rw-r--r--test/src/json-tests.el2
-rw-r--r--test/src/keyboard-tests.el2
-rw-r--r--test/src/keymap-tests.el206
-rw-r--r--test/src/lcms-tests.el2
-rw-r--r--test/src/lread-tests.el8
-rw-r--r--test/src/marker-tests.el2
-rw-r--r--test/src/minibuf-tests.el17
-rw-r--r--test/src/print-tests.el41
-rw-r--r--test/src/process-tests.el545
-rw-r--r--test/src/regex-emacs-tests.el66
-rw-r--r--test/src/syntax-resources/syntax-comments.txt26
-rw-r--r--test/src/syntax-tests.el68
-rw-r--r--test/src/textprop-tests.el2
-rw-r--r--test/src/thread-tests.el2
-rw-r--r--test/src/timefns-tests.el2
-rw-r--r--test/src/undo-tests.el2
-rw-r--r--test/src/xdisp-tests.el33
-rw-r--r--test/src/xfaces-tests.el2
-rw-r--r--test/src/xml-tests.el16
3012 files changed, 48738 insertions, 26920 deletions
diff --git a/.clang-format b/.clang-format
index 7895ada36da..9ab09a86ff2 100644
--- a/.clang-format
+++ b/.clang-format
@@ -4,7 +4,7 @@ AlignEscapedNewlinesLeft: true
AlwaysBreakAfterReturnType: TopLevelDefinitions
BreakBeforeBinaryOperators: All
BreakBeforeBraces: GNU
-ColumnLimit: 80
+ColumnLimit: 70
ContinuationIndentWidth: 2
ForEachMacros: [FOR_EACH_TAIL, FOR_EACH_TAIL_SAFE]
IncludeCategories:
diff --git a/.dir-locals.el b/.dir-locals.el
index 27d50c60699..b313945936c 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -9,6 +9,7 @@
(c-noise-macro-names . ("INLINE" "ATTRIBUTE_NO_SANITIZE_UNDEFINED" "UNINIT" "CALLBACK" "ALIGN_STACK"))
(electric-quote-comment . nil)
(electric-quote-string . nil)
+ (indent-tabs-mode . t)
(mode . bug-reference-prog)))
(objc-mode . ((c-file-style . "GNU")
(electric-quote-comment . nil)
diff --git a/.gitattributes b/.gitattributes
index 00f434da7ce..a99cf12af5e 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -1,6 +1,6 @@
# Attributes of Emacs files in the Git repository.
-# Copyright 2015-2020 Free Software Foundation, Inc.
+# Copyright 2015-2021 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
diff --git a/.gitignore b/.gitignore
index f7a877e6476..0ae6b16f46b 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,6 +1,6 @@
# Files that Git should ignore in the Emacs source directory.
-# Copyright 2009-2020 Free Software Foundation, Inc.
+# Copyright 2009-2021 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
@@ -158,6 +158,7 @@ test/manual/etags/ETAGS
test/manual/etags/CTAGS
test/manual/indent/*.new
test/lisp/gnus/mml-sec-resources/random_seed
+test/lisp/play/fortune-resources/fortunes.dat
# ctags, etags.
TAGS
@@ -202,7 +203,6 @@ src/bootstrap-emacs
src/emacs
src/emacs-[0-9]*
src/temacs
-src/fingerprint.c
src/dmpstruct.h
src/*.pdmp
diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index f4e08d59dd0..3138f4184e6 100644
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@@ -1,4 +1,4 @@
-# Copyright (C) 2017-2020 Free Software Foundation, Inc.
+# Copyright (C) 2021 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
#
@@ -24,89 +24,5 @@
# Maintainer: Ted Zlatanov <tzz@lifelogs.com>
# URL: https://emba.gnu.org/emacs/emacs
-image: debian:stretch
-
-variables:
- GIT_STRATEGY: fetch
- EMACS_EMBA_CI: 1
-
-before_script:
- - apt update -qq
- - DEBIAN_FRONTEND=noninteractive apt install --no-install-recommends -y -qq -o=Dpkg::Use-Pty=0 libc-dev gcc g++ make autoconf automake libncurses-dev gnutls-dev git
-
-stages:
- - test
-
-test-all:
- # This tests also file monitor libraries inotify and inotifywatch.
- stage: test
- only:
- changes:
- - "Makefile.in"
- - .gitlab-ci.yml
- - aclocal.m4
- - autogen.sh
- - configure.ac
- - lib/*.{h,c}
- - lisp/*.el
- - lisp/**/*.el
- - src/*.{h,c}
- - test/lisp/*.el
- - test/lisp/**/*.el
- - test/src/*.el
- except:
- changes:
- # gfilemonitor, kqueue
- - src/gfilenotify.c
- - src/kqueue.c
- # MS Windows
- - lisp/w32*.el
- - lisp/term/w32*.el
- - src/w32*.{h,c}
- # GNUstep
- - lisp/term/ns-win.el
- - src/ns*.{h,m}
- - src/macfont.{h,m}
- script:
- - DEBIAN_FRONTEND=noninteractive apt install --no-install-recommends -y -qq -o=Dpkg::Use-Pty=0 inotify-tools
- - ./autogen.sh autoconf
- - ./configure --without-makeinfo
- - make bootstrap
- - make check-expensive
-
-test-filenotify-gio:
- stage: test
- # This tests file monitor libraries gfilemonitor and gio.
- only:
- changes:
- - .gitlab-ci.yml
- - lisp/autorevert.el
- - lisp/filenotify.el
- - lisp/net/tramp-sh.el
- - src/gfilenotify.c
- - test/lisp/autorevert-tests.el
- - test/lisp/filenotify-tests.el
- script:
- - DEBIAN_FRONTEND=noninteractive apt install --no-install-recommends -y -qq -o=Dpkg::Use-Pty=0 libglib2.0-dev libglib2.0-bin libglib2.0-0
- - ./autogen.sh autoconf
- - ./configure --without-makeinfo --with-file-notification=gfile
- - make bootstrap
- - make -C test autorevert-tests filenotify-tests
-
-test-gnustep:
- stage: test
- # This tests the GNUstep build process
- only:
- changes:
- - .gitlab-ci.yml
- - configure.ac
- - src/ns*.{h,m}
- - src/macfont.{h,m}
- - lisp/term/ns-win.el
- - nextstep/**/*
- script:
- - DEBIAN_FRONTEND=noninteractive apt install --no-install-recommends -y -qq -o=Dpkg::Use-Pty=0 gnustep-devel
- - ./autogen.sh autoconf
- - ./configure --without-makeinfo --with-ns
- - make bootstrap
- - make install
+# Just load from test/infra, to keep build automation files there.
+include: '/test/infra/gitlab-ci.yml'
diff --git a/ChangeLog.1 b/ChangeLog.1
index b01a316f741..82e0ad5c2b8 100644
--- a/ChangeLog.1
+++ b/ChangeLog.1
@@ -14700,7 +14700,7 @@
;; coding: utf-8
;; End:
- Copyright (C) 1993-1999, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1993-1999, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/ChangeLog.2 b/ChangeLog.2
index 5e9b8b901e0..7b40c54dc64 100644
--- a/ChangeLog.2
+++ b/ChangeLog.2
@@ -35787,7 +35787,7 @@ See ChangeLog.1 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 2015-2020 Free Software Foundation, Inc.
+ Copyright (C) 2015-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/ChangeLog.3 b/ChangeLog.3
index 0f363100794..22b45cb5a30 100644
--- a/ChangeLog.3
+++ b/ChangeLog.3
@@ -142485,7 +142485,7 @@ See ChangeLog.2 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 2015-2020 Free Software Foundation, Inc.
+ Copyright (C) 2015-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/GNUmakefile b/GNUmakefile
index c6407d04918..f27163840b7 100644
--- a/GNUmakefile
+++ b/GNUmakefile
@@ -1,6 +1,6 @@
# Build Emacs from a fresh tarball or version-control checkout.
-# Copyright (C) 2011-2020 Free Software Foundation, Inc.
+# Copyright (C) 2011-2021 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
#
diff --git a/INSTALL b/INSTALL
index e880b4e3547..b6f681a153a 100644
--- a/INSTALL
+++ b/INSTALL
@@ -1,5 +1,5 @@
GNU Emacs Installation Guide
-Copyright (C) 1992, 1994, 1996-1997, 2000-2020 Free Software Foundation,
+Copyright (C) 1992, 1994, 1996-1997, 2000-2021 Free Software Foundation,
Inc.
See the end of the file for license conditions.
@@ -113,23 +113,30 @@ sections if you need to.
make help
+
ADDITIONAL DISTRIBUTION FILES
* Complex Text Layout support libraries
-On GNU and Unix systems, Emacs needs the optional libraries "m17n-db",
-"libm17n-flt", "libotf" to correctly display such complex scripts as
-Indic and Khmer, and also for scripts that require Arabic shaping
-support (Arabic and Farsi). On some systems, particularly GNU/Linux,
-these libraries may be already present or available as additional
-packages. Note that if there is a separate 'dev' or 'devel' package,
-for use at compilation time rather than run time, you will need that
-as well as the corresponding run time package; typically the dev
-package will contain header files and a library archive. Otherwise,
-you can download the libraries from <https://www.nongnu.org/m17n/>.
+On GNU and Unix systems, Emacs needs optional libraries to correctly
+display such complex scripts as Indic and Khmer, and also for scripts
+that require Arabic shaping support (Arabic and Farsi). If the
+HarfBuzz library is installed, Emacs will build with it and use it for
+this purpose. HarfBuzz is the preferred shaping engine, both on Posix
+hosts and on MS-Windows, so we recommend installing it before building
+Emacs. The alternative for GNU/Linux and Posix systems is to use the
+"m17n-db", "libm17n-flt", and "libotf" libraries. (On some systems,
+particularly GNU/Linux, these libraries may be already present or
+available as additional packages.) Note that if there is a separate
+'dev' or 'devel' package, for use at compilation time rather than run
+time, you will need that as well as the corresponding run time
+package; typically the dev package will contain header files and a
+library archive. On MS-Windows, if HarfBuzz is not available, Emacs
+will use the Uniscribe shaping engine that is part of the OS.
Note that Emacs cannot support complex scripts on a TTY, unless the
-terminal includes such a support.
+terminal includes such a support. However, most modern terminal
+emulators, such as xterm, do support such scripts.
* intlfonts-VERSION.tar.gz
@@ -216,6 +223,8 @@ like 'apt-get build-dep emacs' (on older systems, replace 'emacs' with
eg 'emacs25'). On Red Hat-based systems, the corresponding command is
'dnf builddep emacs' (on older systems, use 'yum-builddep' instead).
+On FreeBSD, the command is 'pkg install -y `pkg rquery %dn emacs-devel`'.
+
DETAILED BUILDING AND INSTALLATION:
diff --git a/INSTALL.REPO b/INSTALL.REPO
index da0c220c2bd..da56d7611b2 100644
--- a/INSTALL.REPO
+++ b/INSTALL.REPO
@@ -83,7 +83,7 @@ never platform-specific.
-Copyright (C) 2002-2020 Free Software Foundation, Inc.
+Copyright (C) 2002-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/Makefile.in b/Makefile.in
index fbb1891ba72..20683622991 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -1,6 +1,6 @@
### @configure_input@
-# Copyright (C) 1992-2020 Free Software Foundation, Inc.
+# Copyright (C) 1992-2021 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
@@ -969,6 +969,10 @@ else
@echo "Maybe you used a release tarfile that lacks tests."
endif
+test/%:
+ $(MAKE) -C test $*
+
+
dist:
cd ${srcdir}; ./make-dist
diff --git a/README b/README
index 3d499a3596d..a1d5e2dcef3 100644
--- a/README
+++ b/README
@@ -1,4 +1,4 @@
-Copyright (C) 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 2001-2021 Free Software Foundation, Inc.
See the end of the file for license conditions.
diff --git a/admin/ChangeLog.1 b/admin/ChangeLog.1
index 64c65bdd12c..f3de691325b 100644
--- a/admin/ChangeLog.1
+++ b/admin/ChangeLog.1
@@ -2577,7 +2577,7 @@
;; coding: utf-8
;; End:
- Copyright (C) 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/admin/README b/admin/README
index 67f51a34133..312f09839ea 100644
--- a/admin/README
+++ b/admin/README
@@ -1,4 +1,4 @@
-Copyright (C) 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 2001-2021 Free Software Foundation, Inc.
See the end of the file for license conditions.
diff --git a/admin/admin.el b/admin/admin.el
index 22d29673fb5..fa96b7e5cac 100644
--- a/admin/admin.el
+++ b/admin/admin.el
@@ -1,6 +1,6 @@
;;; admin.el --- utilities for Emacs administration
-;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/admin/alloc-colors.c b/admin/alloc-colors.c
index 203605cc58d..ea5b7502363 100644
--- a/admin/alloc-colors.c
+++ b/admin/alloc-colors.c
@@ -1,6 +1,6 @@
/* Allocate X colors. Used for testing with dense colormaps.
-Copyright (C) 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/admin/authors.el b/admin/authors.el
index cf9cf9871e5..0180ffea250 100644
--- a/admin/authors.el
+++ b/admin/authors.el
@@ -1,6 +1,6 @@
;;; authors.el --- utility for maintaining Emacs's AUTHORS file
-;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;; Author: Gerd Moellmann <gerd@gnu.org>
;; Maintainer: emacs-devel@gnu.org
@@ -467,7 +467,12 @@ Changes to files matching one of the regexps in this list are not listed.")
"notes/font-backend"
;; ada-mode has been deleted, now in GNU ELPA
"ada-mode.texi"
+ "doc/misc/ada-mode.texi"
+ "lisp/progmodes/ada-mode.el"
+ "lisp/progmodes/ada-prj.el"
+ "lisp/progmodes/ada-xref.el"
"GNUS-NEWS"
+ "etc/GNUS-NEWS"
"doc/misc/gnus-news.el"
"src/fingerprint-dummy.c"
"src/fingerprint.h"
@@ -878,6 +883,7 @@ Changes to files in this list are not listed.")
"lisp/obsolete/spell.el"
"lisp/obsolete/swedish.el"
"lisp/obsolete/sym-comp.el"
+ "obsolete/sym-comp.el"
"library-of-babel.org"
"flymake-elisp.el"
"flymake-ui.el"
@@ -999,7 +1005,8 @@ in the repository.")
("nxml/test.invalid.xml" . "test-invalid.xml")
("nxml/test.valid.xml" . "test-valid.xml")
("automated/Makefile.in" . "test/Makefile.in")
- ("test/rmailmm.el" . "rmailmm.el")
+ ("test/rmailmm.el" . "test/manual/rmailmm.el")
+ ("rmailmm.el" . "test/manual/rmailmm.el")
;; The one in lisp is eshell/eshell.el.
("eshell.el" . "eshell-tests.el")
("automated/eshell.el" . "eshell-tests.el")
@@ -1123,10 +1130,13 @@ in the repository.")
("lisp/net/starttls.el" . "lisp/obsolete/starttls.el")
("url-ns.el" . "lisp/obsolete/url-ns.el")
("gnus-news.texi" . "doc/misc/gnus.texi")
- ("lisp/multifile.el". "lisp/fileloop.el")
- ("lisp/emacs-lisp/thread.el". "lisp/thread.el")
+ ("lisp/multifile.el" . "lisp/fileloop.el")
+ ("lisp/emacs-lisp/thread.el" . "lisp/thread.el")
+ ("lisp/emacs-lisp/cl.el" . "lisp/emacs-lisp/cl-lib.el")
+ ("lisp/progmodes/mantemp.el" . "lisp/obsolete/mantemp.el")
("src/mini-gmp.c" . "lib/mini-gmp.c")
("src/mini-gmp.h" . "lib/mini-gmp.h")
+ ("sysdep.c" . "src/sysdep.c")
)
"Alist of files which have been renamed during their lifetime.
Elements are (OLDNAME . NEWNAME).")
@@ -1600,7 +1610,7 @@ and a buffer *Authors Errors* containing references to unknown files."
;; the versioned ChangeLog.N rather than the unversioned ChangeLog.
(zerop (call-process "make" nil nil nil
"-C" root "change-history-nocommit"))
- (error "Problem updating ChangeLog"))
+ (error "Problem updating ChangeLog, try \"C-u M-x authors RET\""))
(let ((logs (process-lines find-program root "-name" "ChangeLog*"))
(table (make-hash-table :test 'equal))
(buffer-name "*Authors*")
diff --git a/admin/automerge b/admin/automerge
index cd0f22c3f25..61570587d6b 100755
--- a/admin/automerge
+++ b/admin/automerge
@@ -1,7 +1,7 @@
#!/bin/bash
### automerge - automatically merge the Emacs release branch to master
-## Copyright (C) 2018-2020 Free Software Foundation, Inc.
+## Copyright (C) 2018-2021 Free Software Foundation, Inc.
## Author: Glenn Morris <rgm@gnu.org>
## Maintainer: emacs-devel@gnu.org
diff --git a/admin/build-configs b/admin/build-configs
index dfd037cacec..2e04e0008e7 100755
--- a/admin/build-configs
+++ b/admin/build-configs
@@ -1,7 +1,7 @@
#! /usr/bin/perl
# Build Emacs in several different configurations.
-# Copyright (C) 2001-2020 Free Software Foundation, Inc.
+# Copyright (C) 2001-2021 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
diff --git a/admin/charsets/Makefile.in b/admin/charsets/Makefile.in
index 3af0f028164..0fd130d346e 100644
--- a/admin/charsets/Makefile.in
+++ b/admin/charsets/Makefile.in
@@ -1,6 +1,6 @@
### @configure_input@
-# Copyright (C) 2015-2020 Free Software Foundation, Inc.
+# Copyright (C) 2015-2021 Free Software Foundation, Inc.
# Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
# National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/admin/charsets/cp51932.awk b/admin/charsets/cp51932.awk
index c3555095249..22b24af1ef5 100644
--- a/admin/charsets/cp51932.awk
+++ b/admin/charsets/cp51932.awk
@@ -31,7 +31,7 @@
# already been mapped to 1 or 3.
BEGIN {
- print ";;; cp51932.el -- translation table for CP51932";
+ print ";;; cp51932.el -- translation table for CP51932 -*- lexical-binding:t -*-";
print ";;; Automatically generated from CP932-2BYTE.map";
print "(let ((map";
printf " '(;JISEXT<->UNICODE";
diff --git a/admin/charsets/eucjp-ms.awk b/admin/charsets/eucjp-ms.awk
index f6a6748ce51..ca9a317611b 100644
--- a/admin/charsets/eucjp-ms.awk
+++ b/admin/charsets/eucjp-ms.awk
@@ -38,7 +38,7 @@ BEGIN {
JISX0208_FROM2 = "/xf5/xa1";
JISX0212_FROM = "/x8f/xf3/xf3";
- print ";;; eucjp-ms.el -- translation table for eucJP-ms";
+ print ";;; eucjp-ms.el -- translation table for eucJP-ms -*- lexical-binding:t -*-";
print ";;; Automatically generated from /usr/share/i18n/charmaps/EUC-JP-MS.gz";
print "(let ((map";
print " '(;JISEXT<->UNICODE";
diff --git a/admin/charsets/mapconv b/admin/charsets/mapconv
index ad62f3cb64d..f933c34ffc6 100755
--- a/admin/charsets/mapconv
+++ b/admin/charsets/mapconv
@@ -1,6 +1,6 @@
#!/bin/sh
-# Copyright (C) 2015-2020 Free Software Foundation, Inc.
+# Copyright (C) 2015-2021 Free Software Foundation, Inc.
# Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
# National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/admin/charsets/mapfiles/README b/admin/charsets/mapfiles/README
index c3205672d19..60f09125a91 100644
--- a/admin/charsets/mapfiles/README
+++ b/admin/charsets/mapfiles/README
@@ -1,4 +1,4 @@
-Copyright (C) 2009-2020 Free Software Foundation, Inc.
+Copyright (C) 2009-2021 Free Software Foundation, Inc.
Copyright (C) 2009, 2010, 2011
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H13PRO009
diff --git a/admin/charsets/mule-charsets.el b/admin/charsets/mule-charsets.el
index 8355af4488d..99a8c60d880 100644
--- a/admin/charsets/mule-charsets.el
+++ b/admin/charsets/mule-charsets.el
@@ -1,4 +1,4 @@
-;; mule-charsets.el -- Generate Mule-original charset maps.
+;; mule-charsets.el -- Generate Mule-original charset maps. -*- lexical-binding: t -*-
;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H13PRO009
@@ -55,14 +55,14 @@
("MULE-lviscii.map" . vietnamese-viscii-lower)
("MULE-uviscii.map" . vietnamese-viscii-upper)))
-(defconst header
+(defconst mule-charsets-header
(format
"# Generated by running admin/charsets/mule-charsets.el in Emacs %d.%d.\n"
emacs-major-version emacs-minor-version))
(dolist (elt charset-alist)
(with-temp-buffer
- (insert header)
+ (insert mule-charsets-header)
(map-charset-chars 'func (cdr elt) (cdr elt))
(sort-lines nil (point-min) (point-max))
(let ((coding-system-for-write 'unix))
diff --git a/admin/cus-test.el b/admin/cus-test.el
index b4e4b426515..aca7b68aa7a 100644
--- a/admin/cus-test.el
+++ b/admin/cus-test.el
@@ -1,6 +1,6 @@
;;; cus-test.el --- tests for custom types and load problems
-;; Copyright (C) 1998, 2000, 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2000, 2002-2021 Free Software Foundation, Inc.
;; Author: Markus Rost <rost@math.uni-bielefeld.de>
;; Created: 13 Sep 1998
diff --git a/admin/diff-tar-files b/admin/diff-tar-files
index cbcec862329..cdcc512ae6b 100755
--- a/admin/diff-tar-files
+++ b/admin/diff-tar-files
@@ -1,6 +1,6 @@
#! /bin/sh
-# Copyright (C) 2001-2020 Free Software Foundation, Inc.
+# Copyright (C) 2001-2021 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
@@ -35,7 +35,7 @@ old_tmp=/tmp/old.$$
new_tmp=/tmp/new.$$
trap "rm -f $old_tmp $new_tmp; exit 1" 1 2 15
-tar tzf $old_tar | sed -e 's,^[^/]*,,' | sort > $old_tmp
-tar tzf $new_tar | sed -e 's,^[^/]*,,' | sort > $new_tmp
+tar tzf "$old_tar" | sed -e 's,^[^/]*,,' | sort > $old_tmp
+tar tzf "$new_tar" | sed -e 's,^[^/]*,,' | sort > $new_tmp
diff -u $old_tmp $new_tmp
rm -f $new_tmp $old_tmp
diff --git a/admin/emake b/admin/emake
new file mode 100755
index 00000000000..d9aa4ea74bd
--- /dev/null
+++ b/admin/emake
@@ -0,0 +1,85 @@
+#!/bin/bash
+
+# This script is meant to be used as ./admin/emake, and will compile
+# the Emacs tree with virtually all of the informational messages
+# removed, and with errors/warnings highlighted in red. It'll give a
+# quick overview to confirm that nothing has broken, for instance
+# after doing a "git pull". It's not meant to be used during actual
+# development, because it removes so much information that commands
+# like `next-error' won't be able to jump to the source code where
+# errors are.
+
+cores=1
+
+# Determine the number of cores.
+if [ -f /proc/cpuinfo ]; then
+ cores=$(($(egrep "^physical id|^cpu cores" /proc/cpuinfo |\
+ awk '{ print $4; }' |\
+ sed '$!N;s/\n/ /' |\
+ uniq |\
+ sed 's/^[0-9]*/+/')))
+fi
+
+make -j$cores "$@" 2>&1 | \
+sed -u 's# \.\./\.\./# #
+s# \.\./# #
+s#^Configuring local git # Configuring local git #
+s#^Installing git hooks...# Installing git hooks...#
+s#^Running # Running #
+s#^Configured for # Configured for #
+s#^./temacs # ./temacs #
+s#^Dumping under the name# Dumping under the name#
+' | \
+egrep --line-buffered -v "^make|\
+^Loading|\
+SCRAPE|\
+INFO.*Scraping.*[.]\$|\
+^Waiting for git|\
+^Finding pointers|\
+^Using load-path|\
+^Adding name|\
+^Dump mode|\
+^Dumping finger|\
+^Byte counts|\
+^Reloc counts|\
+^Pure-hashed|\
+^cp -f temacs|\
+^rm -f bootstrap|\
+^Dump complete|\
+^rm -f emacs|\
+mkdir -p etc|\
+mkdir -p info|\
+mkdir -p lisp|\
+^LC_ALL.*pdump|\
+^cp -f emacs.p|\
+GEN.*loaddefs|\
+^Reloading stale|\
+^Source file.*newer than|\
+^Directories for loaddefs|\
+^./autogen.sh|\
+^[Cc]hecking |\
+^.Read INSTALL.REPO for more|\
+^Your system has the required tools.|\
+^Building aclocal.m4|\
+^ Running 'autoreconf|\
+^You can now run './configure'|\
+^./configure|\
+^configure: creating|\
+^\"configure\" file built.|\
+^There seems to be no|\
+^config.status:|\
+^ *$|\
+^Makefile built|\
+The GNU allocators don't work|\
+^git config |\
+^'\.git/|\
+^\^\(\(|\
+^'build-aux/git-hooks\
+" | \
+while read
+do
+ C=""
+ [[ "X${REPLY:0:1}" != "X " ]] && C="\033[1;31m"
+ [[ "X${REPLY:0:3}" == "X " ]] && C="\033[1;31m"
+ [[ "X$C" == "X" ]] && printf "%s\n" "$REPLY" || printf "$C%s\033[0m\n" "$REPLY"
+done
diff --git a/admin/find-gc.el b/admin/find-gc.el
index 7de2474b828..c70a051bfb5 100644
--- a/admin/find-gc.el
+++ b/admin/find-gc.el
@@ -1,6 +1,6 @@
;;; find-gc.el --- detect functions that call the garbage collector
-;; Copyright (C) 1992, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 2001-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
diff --git a/admin/gitmerge.el b/admin/gitmerge.el
index 18da466aaa1..1364bdc67ac 100644
--- a/admin/gitmerge.el
+++ b/admin/gitmerge.el
@@ -1,6 +1,6 @@
;;; gitmerge.el --- help merge one Emacs branch into another
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Authors: David Engster <deng@randomsample.de>
;; Stefan Monnier <monnier@iro.umontreal.ca>
diff --git a/admin/grammars/Makefile.in b/admin/grammars/Makefile.in
index a170e089246..98c9c623abc 100644
--- a/admin/grammars/Makefile.in
+++ b/admin/grammars/Makefile.in
@@ -1,6 +1,6 @@
### @configure_input@
-## Copyright (C) 2013-2020 Free Software Foundation, Inc.
+## Copyright (C) 2013-2021 Free Software Foundation, Inc.
## This file is part of GNU Emacs.
diff --git a/admin/grammars/c.by b/admin/grammars/c.by
index d12e6f95cb4..2d04c999aca 100644
--- a/admin/grammars/c.by
+++ b/admin/grammars/c.by
@@ -1,5 +1,5 @@
;;; c.by -- LL grammar for C/C++ language specification
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;;
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; David Ponce <david@dponce.com>
diff --git a/admin/grammars/grammar.wy b/admin/grammars/grammar.wy
index 1ae2a903bdf..054e85bf70d 100644
--- a/admin/grammars/grammar.wy
+++ b/admin/grammars/grammar.wy
@@ -1,6 +1,6 @@
;;; semantic-grammar.wy -- LALR grammar of Semantic input grammars
;;
-;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;;
;; Author: David Ponce <david@dponce.com>
;; Created: 26 Aug 2002
diff --git a/admin/grammars/java-tags.wy b/admin/grammars/java-tags.wy
index 678b36cd0ae..486924b7990 100644
--- a/admin/grammars/java-tags.wy
+++ b/admin/grammars/java-tags.wy
@@ -1,6 +1,6 @@
;;; java-tags.wy -- Semantic LALR grammar for Java
-;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;;
;; Author: David Ponce <david@dponce.com>
;; Created: 26 Aug 2002
diff --git a/admin/grammars/js.wy b/admin/grammars/js.wy
index 94837baf7c2..e85db1572c6 100644
--- a/admin/grammars/js.wy
+++ b/admin/grammars/js.wy
@@ -1,6 +1,6 @@
;;; javascript-jv.wy -- LALR grammar for Javascript
-;; Copyright (C) 2005-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2005-2021 Free Software Foundation, Inc.
;; Copyright (C) 1998-2011 Ecma International.
;; Author: Joakim Verona
diff --git a/admin/grammars/make.by b/admin/grammars/make.by
index 7573d0cf9ec..f66585e70e9 100644
--- a/admin/grammars/make.by
+++ b/admin/grammars/make.by
@@ -1,6 +1,6 @@
;;; make.by -- BY notation for Makefiles.
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;;
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; David Ponce <david@dponce.com>
diff --git a/admin/grammars/python.wy b/admin/grammars/python.wy
index 5790461c73c..aaa25ced202 100644
--- a/admin/grammars/python.wy
+++ b/admin/grammars/python.wy
@@ -1,6 +1,6 @@
;;; python.wy -- LALR grammar for Python
-;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Copyright (c) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
;; 2009, 2010 Python Software Foundation; All Rights Reserved
diff --git a/admin/grammars/scheme.by b/admin/grammars/scheme.by
index 572cf564d75..c3abb5a28e2 100644
--- a/admin/grammars/scheme.by
+++ b/admin/grammars/scheme.by
@@ -1,6 +1,6 @@
;;; scheme.by -- Scheme BNF language specification
-;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/admin/grammars/srecode-template.wy b/admin/grammars/srecode-template.wy
index c8d1492af23..868a81cf18a 100644
--- a/admin/grammars/srecode-template.wy
+++ b/admin/grammars/srecode-template.wy
@@ -1,6 +1,6 @@
;;; srecode-template.wy --- Semantic Recoder Template parser
-;; Copyright (C) 2005-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2005-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
diff --git a/admin/last-chance.el b/admin/last-chance.el
index 8ee6af5a66d..e8021129e30 100644
--- a/admin/last-chance.el
+++ b/admin/last-chance.el
@@ -1,6 +1,6 @@
;;; last-chance.el --- dangling deterrence -*- lexical-binding: t; -*-
-;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2016-2021 Free Software Foundation, Inc.
;; Author: Thien-Thi Nguyen <ttn@gnu.org>
;; Maintainer: emacs-devel@gnu.org
@@ -105,18 +105,14 @@ defaulting to the one at point."
"Symbol: " obarray
nil nil
one nil one)))))
- (let ((default-directory (or (vc-root-dir)
- default-directory)))
- (grep (format "%s %s"
- last-chance-grep-command
- symbol)))
- (setf (buffer-local-value 'last-chance-symbol
- (process-buffer
- (car compilation-in-progress)))
- symbol))
-
-(add-to-list 'compilation-finish-functions
- 'last-chance-cleanup)
+ (with-current-buffer
+ (let ((default-directory (or (vc-root-dir)
+ default-directory)))
+ (grep (format "%s %s"
+ last-chance-grep-command
+ symbol)))
+ (add-hook 'compilation-finish-functions #'last-chance-cleanup nil t)
+ (setq-local last-chance-symbol symbol)))
(provide 'last-chance)
diff --git a/admin/make-emacs b/admin/make-emacs
index 634c226ac84..fa7880b5664 100755
--- a/admin/make-emacs
+++ b/admin/make-emacs
@@ -2,7 +2,7 @@
# Build Emacs with various options for profiling, debugging,
# with and without warnings enabled etc.
-# Copyright (C) 2001-2020 Free Software Foundation, Inc.
+# Copyright (C) 2001-2021 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
diff --git a/admin/make-manuals b/admin/make-manuals
index 13a8148bb3c..f1339495208 100755
--- a/admin/make-manuals
+++ b/admin/make-manuals
@@ -1,7 +1,7 @@
#!/bin/bash
### make-manuals - create the Emacs manuals to upload to the gnu.org website
-## Copyright 2018-2020 Free Software Foundation, Inc.
+## Copyright 2018-2021 Free Software Foundation, Inc.
## Author: Glenn Morris <rgm@gnu.org>
## Maintainer: emacs-devel@gnu.org
diff --git a/admin/make-tarball.txt b/admin/make-tarball.txt
index 64c61705f4c..5125086e881 100644
--- a/admin/make-tarball.txt
+++ b/admin/make-tarball.txt
@@ -33,17 +33,32 @@ General steps (for each step, check for possible errors):
or some form of "git clean -x". It's probably simpler and safer to
make a new working directory exclusively for the release branch.
+ Make sure the tree is built, or at least configured. That's
+ because some of the commands below run Make, so they need
+ Makefiles to be present.
+
2. Regenerate the etc/AUTHORS file:
M-: (require 'authors) RET
M-x authors RET
(This first updates the current versioned ChangeLog.N)
- If there is an "*Authors Errors*" buffer, address the issues.
- If there was a ChangeLog typo, fix the relevant entry.
- If a file was deleted or renamed, consider adding an appropriate
- entry to authors-ignored-files, authors-valid-file-names, or
- authors-renamed-files-alist.
+ If this says "Problem updating ChangeLog", find the reason for the
+ failure of the command it runs, viz.:
+
+ make -C ROOT change-history-nocommit
+
+ (where ROOT is the top-level directory where you run this). It
+ could be because there are uncommitted changes in ChangeLog.N, for
+ example. One possible way forward is to invoke "C-u M-x authors",
+ which will skip updating the versioned ChangeLog.N file.
+
+ After "M-x authors" finishes, if there is an "*Authors Errors*"
+ buffer, address the issues. If there was a ChangeLog typo, fix
+ the relevant entry. If a file was deleted or renamed, consider
+ adding an appropriate entry to variables authors-ignored-files,
+ authors-valid-file-names, or authors-renamed-files-alist in
+ authors.el.
If necessary, repeat 'C-u M-x authors' after making those changes.
Save the "*Authors*" buffer as etc/AUTHORS.
@@ -87,10 +102,14 @@ General steps (for each step, check for possible errors):
make -C etc/refcards
make -C etc/refcards clean
- If some of the non-English etc/refcards fail to build, you
- probably need to install some TeX foreign language packages.
- For more information, search for the string "refcard" in the file
- admin/release-process.
+ If some of the etc/refcards, especially the non-English ones, fail
+ to build, you probably need to install some TeX/LaTeX packages, in
+ particular for foreign language support. For more information,
+ search for the string "refcard" in the file admin/release-process.
+
+ (ru-refcard causes numerous "Underfull hbox" and "Overfull hbox"
+ messages from TeX, but those seem to be harmless, as the result
+ looks just fine.)
5. Copy lisp/loaddefs.el to lisp/ldefs-boot.el.
diff --git a/admin/merge-gnulib b/admin/merge-gnulib
index 164300e1db6..1c8b4427000 100755
--- a/admin/merge-gnulib
+++ b/admin/merge-gnulib
@@ -4,7 +4,7 @@
#
# admin/merge-gnulib
-# Copyright 2012-2020 Free Software Foundation, Inc.
+# Copyright 2012-2021 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
@@ -34,7 +34,8 @@ GNULIB_MODULES='
d-type diffseq double-slash-root dtoastr dtotimespec dup2
environ execinfo explicit_bzero faccessat
fchmodat fcntl fcntl-h fdopendir
- filemode filename filevercmp flexmember fpieee fstatat fsusage fsync futimens
+ filemode filename filevercmp flexmember fpieee
+ free-posix fstatat fsusage fsync futimens
getloadavg getopt-gnu getrandom gettime gettimeofday gitlog-to-changelog
ieee754-h ignore-value intprops largefile libgmp lstat
manywarnings memmem-simple mempcpy memrchr minmax mkostemp mktime nstrftime
diff --git a/admin/merge-pkg-config b/admin/merge-pkg-config
index 6ec54ce9edf..1136a304dd7 100755
--- a/admin/merge-pkg-config
+++ b/admin/merge-pkg-config
@@ -4,7 +4,7 @@
#
# admin/merge-pkg-config
-# Copyright 2014-2020 Free Software Foundation, Inc.
+# Copyright 2014-2021 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
@@ -60,4 +60,4 @@ test -d m4 || {
printf >&2 '%s\n' "$0: copying $dir/pkg.m4 to m4/pkg.m4"
-cp $dir/pkg.m4 m4
+cp "$dir"/pkg.m4 m4
diff --git a/admin/notes/copyright b/admin/notes/copyright
index 156eec04cd6..5b00c82ce93 100644
--- a/admin/notes/copyright
+++ b/admin/notes/copyright
@@ -1,4 +1,4 @@
-Copyright (C) 2007-2020 Free Software Foundation, Inc.
+Copyright (C) 2007-2021 Free Software Foundation, Inc.
See the end of the file for license conditions.
diff --git a/admin/notes/elpa b/admin/notes/elpa
index ea6c132fe19..1e9e7a9f52b 100644
--- a/admin/notes/elpa
+++ b/admin/notes/elpa
@@ -5,17 +5,31 @@ repository named "elpa", hosted on Savannah. To check it out:
git clone git://git.sv.gnu.org/emacs/elpa
cd elpa
- git remote set-url --push origin git+ssh://git.sv.gnu.org/srv/git/emacs/elpa
- [create task branch for edits, etc.]
+ make setup
-Changes to this branch propagate to elpa.gnu.org via a "deployment" script run
-daily. This script (which is kept in elpa/admin/update-archive.sh) generates
-the content visible at https://elpa.gnu.org/packages.
+That leaves the elpa/packages directory empty; you must check out the
+ones you want.
-A new package is released as soon as the "version number" of that package is
-changed. So you can use 'elpa' to work on a package without fear of releasing
-those changes prematurely. And once the code is ready, just bump the
-version number to make a new release of the package.
+If you wish to check out all the packages into the packages directory,
+you can run the command:
+
+ make worktrees
+
+You can check out a specific package <pkgname> into the packages
+directory with:
+
+ make packages/<pkgname>
+
+
+Changes to this repository propagate to elpa.gnu.org via a
+"deployment" script run daily. This script generates the content
+visible at https://elpa.gnu.org/packages.
+
+A new package is released as soon as the "version number" of that
+package is changed. So you can use 'elpa' to work on a package
+without fear of releasing those changes prematurely. And once the
+code is ready, just bump the version number to make a new release of
+the package.
It is easy to use the elpa branch to deploy a "local" copy of the
package archive. For details, see the README file in the elpa branch.
diff --git a/admin/notes/emba b/admin/notes/emba
index 76b0d3c5993..adebcefcf3e 100644
--- a/admin/notes/emba
+++ b/admin/notes/emba
@@ -1,6 +1,6 @@
-*- mode: outline; coding: utf-8 -*-
-Copyright (C) 2019-2020 Free Software Foundation, Inc.
+Copyright (C) 2019-2021 Free Software Foundation, Inc.
See the end of the file for license conditions.
NOTES FOR EMACS CONTINUOUS BUILD ON EMBA
diff --git a/admin/notes/hydra b/admin/notes/hydra
index 1b7d915c7a3..62ad7ebf9c5 100644
--- a/admin/notes/hydra
+++ b/admin/notes/hydra
@@ -1,6 +1,6 @@
-*- mode: outline; coding: utf-8 -*-
-Copyright (C) 2013-2020 Free Software Foundation, Inc.
+Copyright (C) 2013-2021 Free Software Foundation, Inc.
See the end of the file for license conditions.
NOTES FOR EMACS CONTINUOUS BUILD ON HYDRA
diff --git a/admin/notes/multi-tty b/admin/notes/multi-tty
index dee816ddb35..1a337b9d799 100644
--- a/admin/notes/multi-tty
+++ b/admin/notes/multi-tty
@@ -1,6 +1,6 @@
-*- coding: utf-8; mode: text; -*-
-Copyright (C) 2007-2020 Free Software Foundation, Inc.
+Copyright (C) 2007-2021 Free Software Foundation, Inc.
See the end of the file for license conditions.
From README.multi-tty in the multi-tty branch.
diff --git a/admin/notes/unicode b/admin/notes/unicode
index 1e418590a68..45455d897f3 100644
--- a/admin/notes/unicode
+++ b/admin/notes/unicode
@@ -1,6 +1,6 @@
-*-mode: text; coding: utf-8;-*-
-Copyright (C) 2002-2020 Free Software Foundation, Inc.
+Copyright (C) 2002-2021 Free Software Foundation, Inc.
See the end of the file for license conditions.
Importing a new Unicode Standard version into Emacs
diff --git a/admin/notes/www b/admin/notes/www
index cfc23ace017..524b908d0e7 100644
--- a/admin/notes/www
+++ b/admin/notes/www
@@ -1,6 +1,6 @@
-*- outline -*-
-Copyright (C) 2013-2020 Free Software Foundation, Inc.
+Copyright (C) 2013-2021 Free Software Foundation, Inc.
See the end of the file for license conditions.
NOTES FOR EMACS WWW PAGES
diff --git a/admin/nt/README-UNDUMP.W32 b/admin/nt/README-UNDUMP.W32
index 7937d65a51a..aaaea3b91f7 100644
--- a/admin/nt/README-UNDUMP.W32
+++ b/admin/nt/README-UNDUMP.W32
@@ -1,4 +1,4 @@
-Copyright (C) 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 2001-2021 Free Software Foundation, Inc.
See the end of the file for license conditions.
Emacs for Windows
diff --git a/admin/nt/dist-build/README-scripts b/admin/nt/dist-build/README-scripts
index 4c3554e8df5..f27bcd3bd66 100644
--- a/admin/nt/dist-build/README-scripts
+++ b/admin/nt/dist-build/README-scripts
@@ -33,26 +33,21 @@ build-zips.sh file will create this for you.
A location for the dependencies. This needs to contain two zip files
with the dependencies. build-dep-zips.py will create these files for you.
-~/emacs-build/deps/libXpm/i686
-~/emacs-build/deps/libXpm/x86_64
+~/emacs-build/deps/libXpm
Contain libXpm-noX4.dll. This file is used to load images for the
splash screen, menu items and so on. Emacs runs without it, but looks
-horrible. The x86_64 comes from msys2, while the i686 comes from
-ezwinports because it itself has no dependencies. These have to be
-placed manually (but probably never need updating).
+horrible. The files came original from msys2, and contains no
+dependencies. It has to be placed manually (but probably never
+need updating).
-
-~/emacs-build/build/$version/i686
-~/emacs-build/build/$version/x86_64
+~/emacs-build/build/$version
We build Emacs out-of-source here. This directory is created by
build-zips.sh. This directory can be freely deleted after zips have
been created
-
-~/emacs-build/install/$version/i686
-~/emacs-build/install/$version/x86_64
+~/emacs-build/install/$version
We install Emacs here. This directory is created by build-zips.sh.
This directory can and *should* be deleted after zips have been
@@ -79,9 +74,9 @@ To do this:
Update msys to the latest version with `pacman -Syu`.
-Then run build-dep-zips.py, in the ~/emacs-build/deps directory. Three
-zips will be created, containing the 64bit and 32bit dependencies, as
-well as the source for these.
+Then run build-dep-zips.py, in the ~/emacs-build/deps directory. Two
+zips will be created, containing the dependencies, as well as the
+source for these.
For emacs release or pre-test version:
@@ -105,12 +100,12 @@ To do this:
Update msys to the latest version with `pacman -Syu`.
-Then run build-dep-zips.py, in ~/emacs-build/deps directory. Three
-zips will be created, containing the 64bit and 32bit dependencies, as
-well as the source for these. These deps files contain the date of
-creation in their name. The deps file can be reused as desired, or a
-new version created. Where multiple deps files exist, the most
-recent will be used.
+Then run build-dep-zips.py, in ~/emacs-build/deps directory. Two zips
+will be created, containing the dependencies, as well as the source
+for these. These deps files contain the date of creation in their
+name. The deps file can be reused as desired, or a new version
+created. Where multiple deps files exist, the most recent will be
+used.
Now, run `build-zips.sh -s` to build a snapshot release.
@@ -134,4 +129,5 @@ For snapshots from another branch
Snapshots can be build from any other branch. There is rarely a need
to do this, except where some significant, wide-ranging feature is
being added on a feature branch. In this case, the branch can be
-given using `build-zips.sh -b pdumper -s` for example.
+given using `build-zips.sh -b pdumper -s` for example. Any "/"
+characters in the branch title are replaced.
diff --git a/admin/nt/dist-build/README-windows-binaries b/admin/nt/dist-build/README-windows-binaries
index 01f7ed9da13..b6f6e55d8c6 100644
--- a/admin/nt/dist-build/README-windows-binaries
+++ b/admin/nt/dist-build/README-windows-binaries
@@ -1,10 +1,10 @@
-Copyright (C) 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 2001-2021 Free Software Foundation, Inc.
See the end of the file for license conditions.
Precompiled Distributions of
Emacs for Windows
- Jan 1, 2020
+ Jan 14, 2021
This directory contains precompiled distributions for GNU Emacs on
Windows
@@ -25,51 +25,33 @@ old binaries.
Windows Binaries
================
-Currently, we provide six different binary packages for Emacs, which
+Currently, we provide three different binary packages for Emacs, which
are:
-emacs-$VERSION-x86_64-installer.exe
+emacs-$VERSION-installer.exe
-Contains a 64-bit build of Emacs with dependencies as an installer
+Contains Emacs with dependencies as an installer
package. Mostly, this is the best one to install.
-emacs-$VERSION-x86_64.zip
+emacs-$VERSION.zip
-Contains a 64-bit build of Emacs with dependencies. This contains the
-same files as the installer but as a zip file which some users may
-prefer.
+Contains Emacs with dependencies. This contains the same files as the
+installer but as a zip file which some users may prefer.
-emacs-$VERSION-x86_64-no-deps.zip
+emacs-$VERSION-no-deps.zip
-Contains a 64-bit build of Emacs without any dependencies. This may be
-useful if you wish to install where the dependencies are already
-available, or if you want the small possible Emacs.
-
-emacs-$VERSION-i686-installer.exe
-
-Contains a 32-bit build of Emacs with dependencies as an installer
-package. This is useful for running on a 32-bit machine.
-
-emacs-$VERSION-i686.zip
-
-Contains a 32-bit build of Emacs with dependencies.
-
-emacs-$VERSION-i686-no-deps.zip
-
-Contains a 32-bit build of Emacs without dependencies
+Contains Emacs without any dependencies. This may be useful if you
+wish to install where the dependencies are already available, or if
+you want the small possible Emacs.
In addition, we provide the following files which will not be useful
for most end-users.
-emacs-$VERSION-x86_64-deps.zip
+emacs-$VERSION-deps.zip
The dependencies. Unzipping this file on top of
-emacs-$VERSION-x86_64-no-deps.zip should result in the same install as
-emacs-$VERSION-x86_64.zip.
-
-emacs-$VERSION-i686-deps.zip
-
-The 32-bit version of the dependencies.
+emacs-$VERSION-no-deps.zip should result in the same install as
+emacs-$VERSION.zip.
emacs-$VERSION-deps-mingw-w64-src.zip
@@ -85,7 +67,8 @@ Snapshots
We also distribute "snapshots" of Emacs built at points throughout the
development cycle, for those interested in following this cycle. They
-are not recommended for normal users.
+are not recommended for normal users; however, they are useful for
+people who want to report bugs against the current master.
The files follow the same naming convention, but also include a date
(and sometimes information about their branch). The Emacs source at
diff --git a/admin/nt/dist-build/build-dep-zips.py b/admin/nt/dist-build/build-dep-zips.py
index 7047d28346d..19168e7ff25 100755
--- a/admin/nt/dist-build/build-dep-zips.py
+++ b/admin/nt/dist-build/build-dep-zips.py
@@ -1,6 +1,6 @@
#!/usr/bin/python3
-## Copyright (C) 2017-2020 Free Software Foundation, Inc.
+## Copyright (C) 2017-2021 Free Software Foundation, Inc.
## This file is part of GNU Emacs.
@@ -17,8 +17,6 @@
## You should have received a copy of the GNU General Public License
## along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
import argparse
-import multiprocessing as mp
-import glob
import os
import shutil
import re
@@ -41,21 +39,84 @@ mingw-w64-x86_64-libtiff
mingw-w64-x86_64-libxml2
mingw-w64-x86_64-xpm-nox'''.split()
+DLL_REQ='''libgif
+libgnutls
+libharfbuzz
+libjansson
+liblcms2
+libturbojpeg
+libpng
+librsvg
+libtiff
+libxml
+libXpm'''.split()
+
## Options
DRY_RUN=False
+
+def check_output_maybe(*args,**kwargs):
+ if(DRY_RUN):
+ print("Calling: {}{}".format(args,kwargs))
+ else:
+ return check_output(*args,**kwargs)
+
+## DLL Capture
+def gather_deps():
+
+ os.mkdir("x86_64")
+ os.chdir("x86_64")
+
+ for dep in full_dll_dependency():
+ check_output_maybe(["cp /mingw64/bin/{}*.dll .".format(dep)],
+ shell=True)
+
+ print("Zipping")
+ check_output_maybe("zip -9r ../emacs-{}-{}deps.zip *"
+ .format(EMACS_MAJOR_VERSION, DATE),
+ shell=True)
+ os.chdir("../")
+
+## Return all Emacs dependencies
+def full_dll_dependency():
+ deps = [dll_dependency(dep) for dep in DLL_REQ]
+ return set(sum(deps, []) + DLL_REQ)
+
+## Dependencies for a given DLL
+def dll_dependency(dll):
+ output = check_output(["/mingw64/bin/ntldd", "--recursive",
+ "/mingw64/bin/{}*.dll".format(dll)]).decode("utf-8")
+ ## munge output
+ return ntldd_munge(output)
+
+def ntldd_munge(out):
+ deps = out.splitlines()
+ rtn = []
+ for dep in deps:
+ ## Output looks something like this
+
+ ## KERNEL32.dll => C:\Windows\SYSTEM32\KERNEL32.dll (0x0000000002a30000)
+ ## libwinpthread-1.dll => C:\msys64\mingw64\bin\libwinpthread-1.dll (0x0000000000090000)
+
+ ## if it's the former, we want it, if its the later we don't
+ splt = dep.split()
+ if len(splt) > 2 and "msys64" in splt[2]:
+ print("Adding dep", splt[0])
+ rtn.append(splt[0].split(".")[0])
+
+ return rtn
+
+#### Source Capture
+
## Packages to fiddle with
## Source for gcc-libs is part of gcc
SKIP_SRC_PKGS=["mingw-w64-gcc-libs"]
-SKIP_DEP_PKGS=["mingw-w64-x86_64-glib2"]
+SKIP_DEP_PKGS=["mingw-w64-glib2"]
MUNGE_SRC_PKGS={"mingw-w64-libwinpthread-git":"mingw-w64-winpthreads-git"}
MUNGE_DEP_PKGS={
- "mingw-w64-i686-libwinpthread":"mingw-w64-i686-libwinpthread-git",
"mingw-w64-x86_64-libwinpthread":"mingw-w64-x86_64-libwinpthread-git",
-
"mingw-w64-x86_64-libtre": "mingw-w64-x86_64-libtre-git",
- "mingw-w64-i686-libtre": "mingw-w64-i686-libtre-git"
}
## Currently no packages seem to require this!
@@ -63,12 +124,6 @@ ARCH_PKGS=[]
SRC_REPO="https://sourceforge.net/projects/msys2/files/REPOS/MINGW/Sources"
-def check_output_maybe(*args,**kwargs):
- if(DRY_RUN):
- print("Calling: {}{}".format(args,kwargs))
- else:
- return check_output(*args,**kwargs)
-
def immediate_deps(pkg):
package_info = check_output(["pacman", "-Si", pkg]).decode("utf-8").split("\n")
@@ -88,92 +143,50 @@ def immediate_deps(pkg):
return dependencies
+## Extract all the msys2 packages that are dependencies of our direct dependencies
def extract_deps():
print( "Extracting deps" )
# Get a list of all dependencies needed for packages mentioned above.
pkgs = PKG_REQ[:]
- print("Initial pkgs", pkgs)
n = 0
while n < len(pkgs):
subdeps = immediate_deps(pkgs[n])
for p in subdeps:
if not (p in pkgs or p in SKIP_DEP_PKGS):
- print("adding", p)
pkgs.append(p)
n = n + 1
return sorted(pkgs)
-def gather_deps(deps, arch, directory):
-
- os.mkdir(arch)
- os.chdir(arch)
-
- ## Replace the architecture with the correct one
- deps = [re.sub(r"x86_64",arch,x) for x in deps]
-
- ## find all files the transitive dependencies
- deps_files = check_output(
- ["pacman", "-Ql"] + deps
- ).decode("utf-8").split("\n")
-
- ## Produces output like
- ## mingw-w64-x86_64-zlib /mingw64/lib/libminizip.a
-
- ## drop the package name
- tmp = deps_files.copy()
- deps_files=[]
- for d in tmp:
- slt = d.split()
- if(not slt==[]):
- deps_files.append(slt[1])
-
- ## sort uniq
- deps_files = sorted(list(set(deps_files)))
- ## copy all files into local
- print("Copying dependencies: {}".format(arch))
- check_output_maybe(["rsync", "-R"] + deps_files + ["."])
-
- ## And package them up
- os.chdir(directory)
- print("Zipping: {}".format(arch))
- check_output_maybe("zip -9r ../../emacs-{}-{}{}-deps.zip *"
- .format(EMACS_MAJOR_VERSION, DATE, arch),
- shell=True)
- os.chdir("../../")
-
def download_source(tarball):
print("Acquiring {}...".format(tarball))
- if os.path.exists("../emacs-src-cache/{}".format(tarball)):
- print("Copying {} from local".format(tarball))
- shutil.copyfile("../emacs-src-cache/{}".format(tarball),
- "{}".format(tarball))
- else:
+ if not os.path.exists("../emacs-src-cache/{}".format(tarball)):
print("Downloading {}...".format(tarball))
check_output_maybe(
- "wget -a ../download.log -O {} {}/{}/download"
+ "wget -a ../download.log -O ../emacs-src-cache/{} {}/{}/download"
.format(tarball, SRC_REPO, tarball),
shell=True
)
print("Downloading {}... done".format(tarball))
-def gather_source(deps):
+ print("Copying {} from local".format(tarball))
+ shutil.copyfile("../emacs-src-cache/{}".format(tarball),
+ "{}".format(tarball))
- ## Source for gcc-libs is part of gcc
- ## Source for libwinpthread is in libwinpthreads
- ## mpc, termcap, xpm -- has x86_64, and i686 versions
+## Fetch all the source code
+def gather_source(deps):
+
+ if not os.path.exists("emacs-src-cache"):
+ os.mkdir("emacs-src-cache")
- ## This needs to have been run first at the same time as the
- ## system was updated.
os.mkdir("emacs-src")
os.chdir("emacs-src")
- to_download = []
for pkg in deps:
pkg_name_and_version= \
check_output(["pacman","-Q", pkg]).decode("utf-8").strip()
@@ -184,31 +197,18 @@ def gather_source(deps):
pkg_name=pkg_name_components[0]
pkg_version=pkg_name_components[1]
- ## make a simple name to make lookup easier
- simple_pkg_name = re.sub(r"x86_64-","",pkg_name)
+ ## source pkgs don't have an architecture in them
+ pkg_name = re.sub(r"x86_64-","",pkg_name)
- if(simple_pkg_name in SKIP_SRC_PKGS):
+ if(pkg_name in SKIP_SRC_PKGS):
continue
- ## Some packages have different source files for different
- ## architectures. For these we need two downloads.
- if(simple_pkg_name in ARCH_PKGS):
- downloads = [pkg_name,
- re.sub(r"x86_64","i686",pkg_name)]
- else:
- downloads = [simple_pkg_name]
-
- for d in downloads:
- ## Switch names if necessary
- d = MUNGE_SRC_PKGS.get(d,d)
+ ## Switch names if necessary
+ pkg_name = MUNGE_SRC_PKGS.get(pkg_name,pkg_name)
- tarball = "{}-{}.src.tar.gz".format(d,pkg_version)
+ tarball = "{}-{}.src.tar.gz".format(pkg_name,pkg_version)
- to_download.append(tarball)
-
- ## Download in parallel or it is just too slow
- p = mp.Pool(16)
- p.map(download_source,to_download)
+ download_source(tarball)
print("Zipping")
check_output_maybe("zip -9 ../emacs-{}-{}deps-mingw-w64-src.zip *"
@@ -221,7 +221,6 @@ def gather_source(deps):
def clean():
print("Cleaning")
os.path.isdir("emacs-src") and shutil.rmtree("emacs-src")
- os.path.isdir("i686") and shutil.rmtree("i686")
os.path.isdir("x86_64") and shutil.rmtree("x86_64")
os.path.isfile("download.log") and os.remove("download.log")
@@ -235,12 +234,6 @@ parser = argparse.ArgumentParser()
parser.add_argument("-s", help="snapshot build",
action="store_true")
-parser.add_argument("-t", help="32 bit deps only",
- action="store_true")
-
-parser.add_argument("-f", help="64 bit deps only",
- action="store_true")
-
parser.add_argument("-r", help="source code only",
action="store_true")
@@ -254,9 +247,9 @@ parser.add_argument("-l", help="list dependencies only",
action="store_true")
args = parser.parse_args()
-do_all=not (args.c or args.r or args.f or args.t)
+do_all=not (args.c or args.r)
+
-deps=extract_deps()
DRY_RUN=args.d
@@ -270,13 +263,11 @@ if args.s:
else:
DATE=""
-if( do_all or args.t ):
- gather_deps(deps,"i686","mingw32")
-
-if( do_all or args.f ):
- gather_deps(deps,"x86_64","mingw64")
+if( do_all):
+ gather_deps()
if( do_all or args.r ):
+ deps=extract_deps()
gather_source(deps)
if( args.c ):
diff --git a/admin/nt/dist-build/build-zips.sh b/admin/nt/dist-build/build-zips.sh
index 8eaa3a909bd..7bc6ea6a9e5 100755
--- a/admin/nt/dist-build/build-zips.sh
+++ b/admin/nt/dist-build/build-zips.sh
@@ -1,6 +1,6 @@
#!/bin/bash
-## Copyright (C) 2017-2020 Free Software Foundation, Inc.
+## Copyright (C) 2017-2021 Free Software Foundation, Inc.
## This file is part of GNU Emacs.
@@ -20,7 +20,7 @@
function git_up {
echo [build] Making git worktree for Emacs $VERSION
- cd $HOME/emacs-build/git/emacs-$MAJOR_VERSION
+ cd $REPO_DIR/emacs-$MAJOR_VERSION
git pull
git worktree add ../$BRANCH $BRANCH
@@ -29,72 +29,62 @@ function git_up {
}
function build_zip {
-
- ARCH=$1
- PKG=$2
- HOST=$3
-
- echo [build] Building Emacs-$VERSION for $ARCH
- if [ $ARCH == "i686" ]
- then
- PATH=/mingw32/bin:$PATH
- MSYSTEM=MINGW32
- fi
+ echo [build] Building Emacs-$VERSION
## Clean the install location because we use it twice
- rm -rf $HOME/emacs-build/install/emacs-$VERSION/$ARCH
- mkdir --parents $HOME/emacs-build/build/emacs-$VERSION/$ARCH
- cd $HOME/emacs-build/build/emacs-$VERSION/$ARCH
+ rm -rf $HOME/emacs-build/install/emacs-$VERSION
+ mkdir --parents $HOME/emacs-build/build/emacs-$VERSION
+ cd $HOME/emacs-build/build/emacs-$VERSION
+
+ ## Do we need this or is it the default?
+ export PKG_CONFIG_PATH=/mingw64/lib/pkgconfig
- export PKG_CONFIG_PATH=$PKG
## Running configure forces a rebuild of the C core which takes
## time that is not always needed, so do not do it unless we have
## to.
if [ ! -f Makefile ] || (($CONFIG))
then
- echo [build] Configuring Emacs $ARCH
- ../../../git/$BRANCH/configure \
+ echo [build] Configuring Emacs
+ $REPO_DIR/$BRANCH/configure \
--without-dbus \
- --host=$HOST --without-compress-install \
+ --without-compress-install \
$CACHE \
CFLAGS="$CFLAGS"
fi
make -j 4 $INSTALL_TARGET \
- prefix=$HOME/emacs-build/install/emacs-$VERSION/$ARCH
- cd $HOME/emacs-build/install/emacs-$VERSION/$ARCH
- cp $HOME/emacs-build/deps/libXpm/$ARCH/libXpm-noX4.dll bin
- zip -r -9 emacs-$OF_VERSION-$ARCH-no-deps.zip *
- mv emacs-$OF_VERSION-$ARCH-no-deps.zip $HOME/emacs-upload
- rm bin/libXpm-noX4.dll
+ prefix=$HOME/emacs-build/install/emacs-$VERSION
+ cd $HOME/emacs-build/install/emacs-$VERSION
+ zip -r -9 emacs-$OF_VERSION-no-deps.zip *
+ mv emacs-$OF_VERSION-no-deps.zip $HOME/emacs-upload
if [ -z $SNAPSHOT ];
then
- DEPS_FILE=$HOME/emacs-build/deps/emacs-$MAJOR_VERSION-$ARCH-deps.zip
+ DEPS_FILE=$HOME/emacs-build/deps/emacs-$MAJOR_VERSION-deps.zip
else
## Pick the most recent snapshot whatever that is
- DEPS_FILE=`ls $HOME/emacs-build/deps/emacs-$MAJOR_VERSION-*-$ARCH-deps.zip | tail -n 1`
+ DEPS_FILE=`ls $HOME/emacs-build/deps/emacs-$MAJOR_VERSION-*-deps.zip | tail -n 1`
fi
echo [build] Using $DEPS_FILE
- unzip $DEPS_FILE
+ unzip -d bin $DEPS_FILE
- zip -r -9 emacs-$OF_VERSION-$ARCH.zip *
- mv emacs-$OF_VERSION-$ARCH.zip ~/emacs-upload
+ zip -r -9 emacs-$OF_VERSION.zip *
+ mv emacs-$OF_VERSION.zip ~/emacs-upload
}
function build_installer {
- ARCH=$1
- cd $HOME/emacs-build/install/emacs-$VERSION
+ cd $HOME/emacs-build/install/
echo [build] Calling makensis in `pwd`
- cp ../../git/$BRANCH/admin/nt/dist-build/emacs.nsi .
+ cp $REPO_DIR/$BRANCH/admin/nt/dist-build/emacs.nsi .
makensis -v4 \
- -DARCH=$ARCH -DEMACS_VERSION=$ACTUAL_VERSION \
+ -DEMACS_VERSION=$ACTUAL_VERSION \
+ -DVERSION_BRANCH=$VERSION \
-DOUT_VERSION=$OF_VERSION emacs.nsi
rm emacs.nsi
- mv emacs-$OF_VERSION-$ARCH-installer.exe ~/emacs-upload
+ mv emacs-$OF_VERSION-installer.exe ~/emacs-upload
}
set -o errexit
@@ -103,26 +93,18 @@ SNAPSHOT=
CACHE=
BUILD=1
-BUILD_32=1
BUILD_64=1
GIT_UP=0
CONFIG=1
CFLAGS="-O2 -static"
INSTALL_TARGET="install-strip"
-while getopts "36gb:hnsiV:" opt; do
- case $opt in
- 3)
- BUILD_32=1
- BUILD_64=0
- GIT_UP=0
- ;;
- 6)
- BUILD_32=0
- BUILD_64=1
- GIT_UP=0
- ;;
+## The location of the git repo
+REPO_DIR=$HOME/emacs-build/git/
+
+while getopts "gb:hnsiV:" opt; do
+ case $opt in
g)
BUILD_32=0
BUILD_64=0
@@ -148,10 +130,11 @@ while getopts "36gb:hnsiV:" opt; do
;;
h)
echo "build-zips.sh"
- echo " -3 32 bit build only"
- echo " -6 64 bit build only"
+ echo " -b args -- build args branch"
echo " -g git update and worktree only"
echo " -i build installer only"
+ echo " -n do not configure"
+ echo " -s snaphot build"
exit 0
;;
\?)
@@ -204,7 +187,7 @@ then
else
BRANCH=$REQUIRED_BRANCH
echo [build] Building from Branch $BRANCH
- VERSION=$VERSION-$BRANCH
+ VERSION=$VERSION-${BRANCH/\//_}
OF_VERSION="$VERSION-`date +%Y-%m-%d`"
## Use snapshot dependencies
SNAPSHOT=1
@@ -221,18 +204,7 @@ if (($BUILD_64))
then
if (($BUILD))
then
- build_zip x86_64 /mingw64/lib/pkgconfig x86_64-w64-mingw32
- fi
- build_installer x86_64
-fi
-
-## Do the 64 bit build first, because we reset some environment
-## variables during the 32 bit which will break the build.
-if (($BUILD_32))
-then
- if (($BUILD))
- then
- build_zip i686 /mingw32/lib/pkgconfig i686-w64-mingw32
+ build_zip
fi
- build_installer i686
+ build_installer
fi
diff --git a/admin/nt/dist-build/emacs.nsi b/admin/nt/dist-build/emacs.nsi
index dce8f3db4a3..557bb106dde 100644
--- a/admin/nt/dist-build/emacs.nsi
+++ b/admin/nt/dist-build/emacs.nsi
@@ -2,7 +2,7 @@
!include LogicLib.nsh
!include x64.nsh
-Outfile "emacs-${OUT_VERSION}-${ARCH}-installer.exe"
+Outfile "emacs-${OUT_VERSION}-installer.exe"
SetCompressor /solid lzma
@@ -14,15 +14,15 @@ Var StartMenuFolder
!define MUI_WELCOMEPAGE_TITLE_3LINES
!define MUI_WELCOMEPAGE_TEXT "Welcome to Emacs -- the editor of a lifetime."
-!define MUI_WELCOMEFINISHPAGE_BITMAP "${ARCH}\share\emacs\${EMACS_VERSION}\etc\images\splash.bmp"
-!define MUI_ICON "${ARCH}\share\emacs\${EMACS_VERSION}\etc\images\icons\hicolor\scalable\apps\emacs.ico"
-!define MUI_UNICON "${ARCH}\share\emacs\${EMACS_VERSION}\etc\images\icons\hicolor\scalable\apps\emacs.ico"
+!define MUI_WELCOMEFINISHPAGE_BITMAP "emacs-${VERSION_BRANCH}\share\emacs\${EMACS_VERSION}\etc\images\splash.bmp"
+!define MUI_ICON "emacs-${VERSION_BRANCH}\share\emacs\${EMACS_VERSION}\etc\images\icons\hicolor\scalable\apps\emacs.ico"
+!define MUI_UNICON "emacs-${VERSION_BRANCH}\share\emacs\${EMACS_VERSION}\etc\images\icons\hicolor\scalable\apps\emacs.ico"
!insertmacro MUI_PAGE_WELCOME
!define MUI_LICENSEPAGE_TEXT_TOP "The GNU General Public License"
-!insertmacro MUI_PAGE_LICENSE "${ARCH}\share\emacs\${EMACS_VERSION}\lisp\COPYING"
+!insertmacro MUI_PAGE_LICENSE "emacs-${VERSION_BRANCH}\share\emacs\${EMACS_VERSION}\lisp\COPYING"
!insertmacro MUI_PAGE_DIRECTORY
!insertmacro MUI_PAGE_INSTFILES
@@ -36,19 +36,7 @@ Var StartMenuFolder
Name Emacs-${EMACS_VERSION}
function .onInit
- ${If} ${RunningX64}
- ${If} ${ARCH} == "x86_64"
- StrCpy $INSTDIR "$PROGRAMFILES64\Emacs"
- ${Else}
- StrCpy $INSTDIR "$PROGRAMFILES32\Emacs"
- ${Endif}
- ${Else}
- ${If} ${ARCH} == "x86_64"
- Quit
- ${Else}
- StrCpy $INSTDIR "$PROGRAMFILES\Emacs"
- ${Endif}
- ${EndIf}
+ StrCpy $INSTDIR "$PROGRAMFILES64\Emacs"
functionend
@@ -56,7 +44,8 @@ Section
SetOutPath $INSTDIR
- File /r ${ARCH}
+ File /r emacs-${VERSION_BRANCH}
+
# define uninstaller name
WriteUninstaller $INSTDIR\Uninstall.exe
@@ -66,7 +55,7 @@ Section
CreateShortcut "$SMPROGRAMS\$StartMenuFolder\Uninstall.lnk" "$INSTDIR\Uninstall.exe"
!insertmacro MUI_STARTMENU_WRITE_END
- CreateShortCut "$SMPROGRAMS\$StartMenuFolder\Emacs.lnk" "$INSTDIR\${ARCH}\bin\runemacs.exe"
+ CreateShortCut "$SMPROGRAMS\$StartMenuFolder\Emacs.lnk" "$INSTDIR\emacs-${VERSION_BRANCH}\bin\runemacs.exe"
SectionEnd
@@ -78,7 +67,7 @@ Section "Uninstall"
Delete "$INSTDIR\Uninstall.exe"
# now delete installed directory
- RMDir /r "$INSTDIR\${ARCH}"
+ RMDir /r "$INSTDIR"
RMDir "$INSTDIR"
!insertmacro MUI_STARTMENU_GETFOLDER Application $StartMenuFolder
diff --git a/admin/quick-install-emacs b/admin/quick-install-emacs
index 0439c77d016..475658ae93e 100755
--- a/admin/quick-install-emacs
+++ b/admin/quick-install-emacs
@@ -1,7 +1,7 @@
#!/bin/sh
### quick-install-emacs --- do a halfway-decent job of installing emacs quickly
-## Copyright (C) 2001-2020 Free Software Foundation, Inc.
+## Copyright (C) 2001-2021 Free Software Foundation, Inc.
## Author: Miles Bader <miles@gnu.org>
diff --git a/admin/release-process b/admin/release-process
index 4d973d33610..ef698f51666 100644
--- a/admin/release-process
+++ b/admin/release-process
@@ -179,8 +179,9 @@ What paper size are the English versions supposed to be on?
On Debian testing, the packages texlive-lang-czechslovak and
texlive-lang-polish will let you generate the cs-* and sk-* pdfs.
(You may need texlive-lang-cyrillic, texlive-lang-german,
-and texlive-fonts-extra for others.) On Fedora-like systems,
-texlive-lh may help.
+and texlive-fonts-extra for others.) Gnus refcards need
+texlive-latex-extra and/or texlive-latex-recommended. On Fedora-like
+systems, texlive-lh may help.
** Ask maintainers of refcard translations to update them.
diff --git a/admin/unidata/Makefile.in b/admin/unidata/Makefile.in
index f3e1c786114..f31e1bb09fd 100644
--- a/admin/unidata/Makefile.in
+++ b/admin/unidata/Makefile.in
@@ -1,6 +1,6 @@
### @configure_input@
-# Copyright (C) 2012-2020 Free Software Foundation, Inc.
+# Copyright (C) 2012-2021 Free Software Foundation, Inc.
# Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010, 2011
# National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/admin/unidata/blocks.awk b/admin/unidata/blocks.awk
index 70e96ed802d..4ecb233fe7b 100755
--- a/admin/unidata/blocks.awk
+++ b/admin/unidata/blocks.awk
@@ -1,6 +1,6 @@
#!/usr/bin/awk -f
-## Copyright (C) 2015-2020 Free Software Foundation, Inc.
+## Copyright (C) 2015-2021 Free Software Foundation, Inc.
## Author: Glenn Morris <rgm@gnu.org>
## Maintainer: emacs-devel@gnu.org
@@ -203,7 +203,7 @@ function name2alias(name , w, w2) {
}
END {
- print ";;; charscript.el --- character script table"
+ print ";;; charscript.el --- character script table -*- lexical-binding:t -*-"
print ";;; Automatically generated from admin/unidata/Blocks.txt"
print "(let (script-list)"
print " (dolist (elt '("
diff --git a/admin/unidata/unidata-gen.el b/admin/unidata/unidata-gen.el
index 510bb7959f1..3918853088f 100644
--- a/admin/unidata/unidata-gen.el
+++ b/admin/unidata/unidata-gen.el
@@ -1,6 +1,6 @@
;; unidata-gen.el -- Create files containing character property data -*- lexical-binding:t -*-
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/admin/unidata/uvs.el b/admin/unidata/uvs.el
index 6b8909ce66a..0141b638fb2 100644
--- a/admin/unidata/uvs.el
+++ b/admin/unidata/uvs.el
@@ -1,6 +1,6 @@
;;; uvs.el --- utility for UVS (format 14) cmap subtables in OpenType fonts -*- lexical-binding:t -*-
-;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2021 Free Software Foundation, Inc.
;; Author: YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
diff --git a/admin/update-copyright b/admin/update-copyright
index a70d7a3ff93..86953838bdd 100755
--- a/admin/update-copyright
+++ b/admin/update-copyright
@@ -7,7 +7,7 @@
# By default, this script uses the local-time calendar year.
# Set the UPDATE_COPYRIGHT_YEAR environment variable to override the default.
-# Copyright 2013-2020 Free Software Foundation, Inc.
+# Copyright 2013-2021 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
diff --git a/admin/update_autogen b/admin/update_autogen
index d60984e13f6..35c391da19e 100755
--- a/admin/update_autogen
+++ b/admin/update_autogen
@@ -1,7 +1,7 @@
#!/usr/bin/env bash
### update_autogen - update some auto-generated files in the Emacs tree
-## Copyright (C) 2011-2020 Free Software Foundation, Inc.
+## Copyright (C) 2011-2021 Free Software Foundation, Inc.
## Author: Glenn Morris <rgm@gnu.org>
## Maintainer: emacs-devel@gnu.org
diff --git a/admin/upload-manuals b/admin/upload-manuals
index b7187971df0..52999c2997a 100755
--- a/admin/upload-manuals
+++ b/admin/upload-manuals
@@ -2,7 +2,7 @@
### upload-manuals - upload the Emacs manuals to the gnu.org website
-## Copyright 2018-2020 Free Software Foundation, Inc.
+## Copyright 2018-2021 Free Software Foundation, Inc.
## Author: Glenn Morris <rgm@gnu.org>
## Maintainer: emacs-devel@gnu.org
diff --git a/autogen.sh b/autogen.sh
index c5e14900d68..531e5775f96 100755
--- a/autogen.sh
+++ b/autogen.sh
@@ -1,7 +1,7 @@
#!/bin/sh
### autogen.sh - tool to help build Emacs from a repository checkout
-## Copyright (C) 2011-2020 Free Software Foundation, Inc.
+## Copyright (C) 2011-2021 Free Software Foundation, Inc.
## Author: Glenn Morris <rgm@gnu.org>
## Maintainer: emacs-devel@gnu.org
diff --git a/build-aux/config.guess b/build-aux/config.guess
index 9aff91cfd03..7f748177972 100755
--- a/build-aux/config.guess
+++ b/build-aux/config.guess
@@ -2,7 +2,7 @@
# Attempt to guess a canonical system name.
# Copyright 1992-2020 Free Software Foundation, Inc.
-timestamp='2020-08-17'
+timestamp='2020-12-22'
# 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
@@ -27,12 +27,12 @@ timestamp='2020-08-17'
# Originally written by Per Bothner; maintained since 2000 by Ben Elliston.
#
# You can get the latest version of this script from:
-# https://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess
+# https://git.savannah.gnu.org/cgit/config.git/plain/config.guess
#
# Please send patches to <config-patches@gnu.org>.
-me=`echo "$0" | sed -e 's,.*/,,'`
+me=$(echo "$0" | sed -e 's,.*/,,')
usage="\
Usage: $0 [OPTION]
@@ -103,7 +103,7 @@ set_cc_for_build() {
test "$tmp" && return 0
: "${TMPDIR=/tmp}"
# shellcheck disable=SC2039
- { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } ||
+ { tmp=$( (umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null) && test -n "$tmp" && test -d "$tmp" ; } ||
{ test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir "$tmp" 2>/dev/null) ; } ||
{ tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir "$tmp" 2>/dev/null) && echo "Warning: creating insecure temp directory" >&2 ; } ||
{ echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; }
@@ -131,16 +131,14 @@ if test -f /.attbin/uname ; then
PATH=$PATH:/.attbin ; export PATH
fi
-UNAME_MACHINE=`(uname -m) 2>/dev/null` || UNAME_MACHINE=unknown
-UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown
-UNAME_SYSTEM=`(uname -s) 2>/dev/null` || UNAME_SYSTEM=unknown
-UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown
+UNAME_MACHINE=$( (uname -m) 2>/dev/null) || UNAME_MACHINE=unknown
+UNAME_RELEASE=$( (uname -r) 2>/dev/null) || UNAME_RELEASE=unknown
+UNAME_SYSTEM=$( (uname -s) 2>/dev/null) || UNAME_SYSTEM=unknown
+UNAME_VERSION=$( (uname -v) 2>/dev/null) || UNAME_VERSION=unknown
case "$UNAME_SYSTEM" in
Linux|GNU|GNU/*)
- # If the system lacks a compiler, then just pick glibc.
- # We could probably try harder.
- LIBC=gnu
+ LIBC=unknown
set_cc_for_build
cat <<-EOF > "$dummy.c"
@@ -149,17 +147,29 @@ Linux|GNU|GNU/*)
LIBC=uclibc
#elif defined(__dietlibc__)
LIBC=dietlibc
- #else
+ #elif defined(__GLIBC__)
LIBC=gnu
+ #else
+ #include <stdarg.h>
+ /* First heuristic to detect musl libc. */
+ #ifdef __DEFINED_va_list
+ LIBC=musl
+ #endif
#endif
EOF
- eval "`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^LIBC' | sed 's, ,,g'`"
+ eval "$($CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^LIBC' | sed 's, ,,g')"
- # If ldd exists, use it to detect musl libc.
- if command -v ldd >/dev/null && \
- ldd --version 2>&1 | grep -q ^musl
- then
- LIBC=musl
+ # Second heuristic to detect musl libc.
+ if [ "$LIBC" = unknown ] &&
+ command -v ldd >/dev/null &&
+ ldd --version 2>&1 | grep -q ^musl; then
+ LIBC=musl
+ fi
+
+ # If the system lacks a compiler, then just pick glibc.
+ # We could probably try harder.
+ if [ "$LIBC" = unknown ]; then
+ LIBC=gnu
fi
;;
esac
@@ -179,19 +189,20 @@ case "$UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION" in
# Note: NetBSD doesn't particularly care about the vendor
# portion of the name. We always set it to "unknown".
sysctl="sysctl -n hw.machine_arch"
- UNAME_MACHINE_ARCH=`(uname -p 2>/dev/null || \
+ UNAME_MACHINE_ARCH=$( (uname -p 2>/dev/null || \
"/sbin/$sysctl" 2>/dev/null || \
"/usr/sbin/$sysctl" 2>/dev/null || \
- echo unknown)`
+ echo unknown))
case "$UNAME_MACHINE_ARCH" in
+ aarch64eb) machine=aarch64_be-unknown ;;
armeb) machine=armeb-unknown ;;
arm*) machine=arm-unknown ;;
sh3el) machine=shl-unknown ;;
sh3eb) machine=sh-unknown ;;
sh5el) machine=sh5le-unknown ;;
earmv*)
- arch=`echo "$UNAME_MACHINE_ARCH" | sed -e 's,^e\(armv[0-9]\).*$,\1,'`
- endian=`echo "$UNAME_MACHINE_ARCH" | sed -ne 's,^.*\(eb\)$,\1,p'`
+ arch=$(echo "$UNAME_MACHINE_ARCH" | sed -e 's,^e\(armv[0-9]\).*$,\1,')
+ endian=$(echo "$UNAME_MACHINE_ARCH" | sed -ne 's,^.*\(eb\)$,\1,p')
machine="${arch}${endian}"-unknown
;;
*) machine="$UNAME_MACHINE_ARCH"-unknown ;;
@@ -222,7 +233,7 @@ case "$UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION" in
case "$UNAME_MACHINE_ARCH" in
earm*)
expr='s/^earmv[0-9]/-eabi/;s/eb$//'
- abi=`echo "$UNAME_MACHINE_ARCH" | sed -e "$expr"`
+ abi=$(echo "$UNAME_MACHINE_ARCH" | sed -e "$expr")
;;
esac
# The OS release
@@ -235,7 +246,7 @@ case "$UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION" in
release='-gnu'
;;
*)
- release=`echo "$UNAME_RELEASE" | sed -e 's/[-_].*//' | cut -d. -f1,2`
+ release=$(echo "$UNAME_RELEASE" | sed -e 's/[-_].*//' | cut -d. -f1,2)
;;
esac
# Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM:
@@ -244,15 +255,15 @@ case "$UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION" in
echo "$machine-${os}${release}${abi-}"
exit ;;
*:Bitrig:*:*)
- UNAME_MACHINE_ARCH=`arch | sed 's/Bitrig.//'`
+ UNAME_MACHINE_ARCH=$(arch | sed 's/Bitrig.//')
echo "$UNAME_MACHINE_ARCH"-unknown-bitrig"$UNAME_RELEASE"
exit ;;
*:OpenBSD:*:*)
- UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'`
+ UNAME_MACHINE_ARCH=$(arch | sed 's/OpenBSD.//')
echo "$UNAME_MACHINE_ARCH"-unknown-openbsd"$UNAME_RELEASE"
exit ;;
*:LibertyBSD:*:*)
- UNAME_MACHINE_ARCH=`arch | sed 's/^.*BSD\.//'`
+ UNAME_MACHINE_ARCH=$(arch | sed 's/^.*BSD\.//')
echo "$UNAME_MACHINE_ARCH"-unknown-libertybsd"$UNAME_RELEASE"
exit ;;
*:MidnightBSD:*:*)
@@ -288,17 +299,17 @@ case "$UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION" in
alpha:OSF1:*:*)
case $UNAME_RELEASE in
*4.0)
- UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'`
+ UNAME_RELEASE=$(/usr/sbin/sizer -v | awk '{print $3}')
;;
*5.*)
- UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'`
+ UNAME_RELEASE=$(/usr/sbin/sizer -v | awk '{print $4}')
;;
esac
# According to Compaq, /usr/sbin/psrinfo has been available on
# OSF/1 and Tru64 systems produced since 1995. I hope that
# covers most systems running today. This code pipes the CPU
# types through head -n 1, so we only detect the type of CPU 0.
- ALPHA_CPU_TYPE=`/usr/sbin/psrinfo -v | sed -n -e 's/^ The alpha \(.*\) processor.*$/\1/p' | head -n 1`
+ ALPHA_CPU_TYPE=$(/usr/sbin/psrinfo -v | sed -n -e 's/^ The alpha \(.*\) processor.*$/\1/p' | head -n 1)
case "$ALPHA_CPU_TYPE" in
"EV4 (21064)")
UNAME_MACHINE=alpha ;;
@@ -336,7 +347,7 @@ case "$UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION" in
# A Tn.n version is a released field test version.
# A Xn.n version is an unreleased experimental baselevel.
# 1.2 uses "1.2" for uname -r.
- echo "$UNAME_MACHINE"-dec-osf"`echo "$UNAME_RELEASE" | sed -e 's/^[PVTX]//' | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz`"
+ echo "$UNAME_MACHINE"-dec-osf"$(echo "$UNAME_RELEASE" | sed -e 's/^[PVTX]//' | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz)"
# Reset EXIT trap before exiting to avoid spurious non-zero exit code.
exitcode=$?
trap '' 0
@@ -370,7 +381,7 @@ case "$UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION" in
exit ;;
Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*)
# akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE.
- if test "`(/bin/universe) 2>/dev/null`" = att ; then
+ if test "$( (/bin/universe) 2>/dev/null)" = att ; then
echo pyramid-pyramid-sysv3
else
echo pyramid-pyramid-bsd
@@ -383,17 +394,17 @@ case "$UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION" in
echo sparc-icl-nx6
exit ;;
DRS?6000:UNIX_SV:4.2*:7* | DRS?6000:isis:4.2*:7*)
- case `/usr/bin/uname -p` in
+ case $(/usr/bin/uname -p) in
sparc) echo sparc-icl-nx7; exit ;;
esac ;;
s390x:SunOS:*:*)
- echo "$UNAME_MACHINE"-ibm-solaris2"`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'`"
+ echo "$UNAME_MACHINE"-ibm-solaris2"$(echo "$UNAME_RELEASE" | sed -e 's/[^.]*//')"
exit ;;
sun4H:SunOS:5.*:*)
- echo sparc-hal-solaris2"`echo "$UNAME_RELEASE"|sed -e 's/[^.]*//'`"
+ echo sparc-hal-solaris2"$(echo "$UNAME_RELEASE"|sed -e 's/[^.]*//')"
exit ;;
sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*)
- echo sparc-sun-solaris2"`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'`"
+ echo sparc-sun-solaris2"$(echo "$UNAME_RELEASE" | sed -e 's/[^.]*//')"
exit ;;
i86pc:AuroraUX:5.*:* | i86xen:AuroraUX:5.*:*)
echo i386-pc-auroraux"$UNAME_RELEASE"
@@ -412,30 +423,30 @@ case "$UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION" in
SUN_ARCH=x86_64
fi
fi
- echo "$SUN_ARCH"-pc-solaris2"`echo "$UNAME_RELEASE"|sed -e 's/[^.]*//'`"
+ echo "$SUN_ARCH"-pc-solaris2"$(echo "$UNAME_RELEASE"|sed -e 's/[^.]*//')"
exit ;;
sun4*:SunOS:6*:*)
# According to config.sub, this is the proper way to canonicalize
# SunOS6. Hard to guess exactly what SunOS6 will be like, but
# it's likely to be more like Solaris than SunOS4.
- echo sparc-sun-solaris3"`echo "$UNAME_RELEASE"|sed -e 's/[^.]*//'`"
+ echo sparc-sun-solaris3"$(echo "$UNAME_RELEASE"|sed -e 's/[^.]*//')"
exit ;;
sun4*:SunOS:*:*)
- case "`/usr/bin/arch -k`" in
+ case "$(/usr/bin/arch -k)" in
Series*|S4*)
- UNAME_RELEASE=`uname -v`
+ UNAME_RELEASE=$(uname -v)
;;
esac
# Japanese Language versions have a version number like `4.1.3-JL'.
- echo sparc-sun-sunos"`echo "$UNAME_RELEASE"|sed -e 's/-/_/'`"
+ echo sparc-sun-sunos"$(echo "$UNAME_RELEASE"|sed -e 's/-/_/')"
exit ;;
sun3*:SunOS:*:*)
echo m68k-sun-sunos"$UNAME_RELEASE"
exit ;;
sun*:*:4.2BSD:*)
- UNAME_RELEASE=`(sed 1q /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null`
+ UNAME_RELEASE=$( (sed 1q /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null)
test "x$UNAME_RELEASE" = x && UNAME_RELEASE=3
- case "`/bin/arch`" in
+ case "$(/bin/arch)" in
sun3)
echo m68k-sun-sunos"$UNAME_RELEASE"
;;
@@ -515,8 +526,8 @@ case "$UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION" in
}
EOF
$CC_FOR_BUILD -o "$dummy" "$dummy.c" &&
- dummyarg=`echo "$UNAME_RELEASE" | sed -n 's/\([0-9]*\).*/\1/p'` &&
- SYSTEM_NAME=`"$dummy" "$dummyarg"` &&
+ dummyarg=$(echo "$UNAME_RELEASE" | sed -n 's/\([0-9]*\).*/\1/p') &&
+ SYSTEM_NAME=$("$dummy" "$dummyarg") &&
{ echo "$SYSTEM_NAME"; exit; }
echo mips-mips-riscos"$UNAME_RELEASE"
exit ;;
@@ -543,7 +554,7 @@ EOF
exit ;;
AViiON:dgux:*:*)
# DG/UX returns AViiON for all architectures
- UNAME_PROCESSOR=`/usr/bin/uname -p`
+ UNAME_PROCESSOR=$(/usr/bin/uname -p)
if test "$UNAME_PROCESSOR" = mc88100 || test "$UNAME_PROCESSOR" = mc88110
then
if test "$TARGET_BINARY_INTERFACE"x = m88kdguxelfx || \
@@ -571,17 +582,17 @@ EOF
echo m68k-tektronix-bsd
exit ;;
*:IRIX*:*:*)
- echo mips-sgi-irix"`echo "$UNAME_RELEASE"|sed -e 's/-/_/g'`"
+ echo mips-sgi-irix"$(echo "$UNAME_RELEASE"|sed -e 's/-/_/g')"
exit ;;
????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX.
echo romp-ibm-aix # uname -m gives an 8 hex-code CPU id
- exit ;; # Note that: echo "'`uname -s`'" gives 'AIX '
+ exit ;; # Note that: echo "'$(uname -s)'" gives 'AIX '
i*86:AIX:*:*)
echo i386-ibm-aix
exit ;;
ia64:AIX:*:*)
if test -x /usr/bin/oslevel ; then
- IBM_REV=`/usr/bin/oslevel`
+ IBM_REV=$(/usr/bin/oslevel)
else
IBM_REV="$UNAME_VERSION.$UNAME_RELEASE"
fi
@@ -601,7 +612,7 @@ EOF
exit(0);
}
EOF
- if $CC_FOR_BUILD -o "$dummy" "$dummy.c" && SYSTEM_NAME=`"$dummy"`
+ if $CC_FOR_BUILD -o "$dummy" "$dummy.c" && SYSTEM_NAME=$("$dummy")
then
echo "$SYSTEM_NAME"
else
@@ -614,15 +625,15 @@ EOF
fi
exit ;;
*:AIX:*:[4567])
- IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'`
+ IBM_CPU_ID=$(/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }')
if /usr/sbin/lsattr -El "$IBM_CPU_ID" | grep ' POWER' >/dev/null 2>&1; then
IBM_ARCH=rs6000
else
IBM_ARCH=powerpc
fi
if test -x /usr/bin/lslpp ; then
- IBM_REV=`/usr/bin/lslpp -Lqc bos.rte.libc |
- awk -F: '{ print $3 }' | sed s/[0-9]*$/0/`
+ IBM_REV=$(/usr/bin/lslpp -Lqc bos.rte.libc |
+ awk -F: '{ print $3 }' | sed s/[0-9]*$/0/)
else
IBM_REV="$UNAME_VERSION.$UNAME_RELEASE"
fi
@@ -650,14 +661,14 @@ EOF
echo m68k-hp-bsd4.4
exit ;;
9000/[34678]??:HP-UX:*:*)
- HPUX_REV=`echo "$UNAME_RELEASE"|sed -e 's/[^.]*.[0B]*//'`
+ HPUX_REV=$(echo "$UNAME_RELEASE"|sed -e 's/[^.]*.[0B]*//')
case "$UNAME_MACHINE" in
9000/31?) HP_ARCH=m68000 ;;
9000/[34]??) HP_ARCH=m68k ;;
9000/[678][0-9][0-9])
if test -x /usr/bin/getconf; then
- sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null`
- sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null`
+ sc_cpu_version=$(/usr/bin/getconf SC_CPU_VERSION 2>/dev/null)
+ sc_kernel_bits=$(/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null)
case "$sc_cpu_version" in
523) HP_ARCH=hppa1.0 ;; # CPU_PA_RISC1_0
528) HP_ARCH=hppa1.1 ;; # CPU_PA_RISC1_1
@@ -704,7 +715,7 @@ EOF
exit (0);
}
EOF
- (CCOPTS="" $CC_FOR_BUILD -o "$dummy" "$dummy.c" 2>/dev/null) && HP_ARCH=`"$dummy"`
+ (CCOPTS="" $CC_FOR_BUILD -o "$dummy" "$dummy.c" 2>/dev/null) && HP_ARCH=$("$dummy")
test -z "$HP_ARCH" && HP_ARCH=hppa
fi ;;
esac
@@ -732,7 +743,7 @@ EOF
echo "$HP_ARCH"-hp-hpux"$HPUX_REV"
exit ;;
ia64:HP-UX:*:*)
- HPUX_REV=`echo "$UNAME_RELEASE"|sed -e 's/[^.]*.[0B]*//'`
+ HPUX_REV=$(echo "$UNAME_RELEASE"|sed -e 's/[^.]*.[0B]*//')
echo ia64-hp-hpux"$HPUX_REV"
exit ;;
3050*:HI-UX:*:*)
@@ -762,7 +773,7 @@ EOF
exit (0);
}
EOF
- $CC_FOR_BUILD -o "$dummy" "$dummy.c" && SYSTEM_NAME=`"$dummy"` &&
+ $CC_FOR_BUILD -o "$dummy" "$dummy.c" && SYSTEM_NAME=$("$dummy") &&
{ echo "$SYSTEM_NAME"; exit; }
echo unknown-hitachi-hiuxwe2
exit ;;
@@ -831,14 +842,14 @@ EOF
echo craynv-cray-unicosmp"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/'
exit ;;
F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*)
- FUJITSU_PROC=`uname -m | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz`
- FUJITSU_SYS=`uname -p | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/\///'`
- FUJITSU_REL=`echo "$UNAME_RELEASE" | sed -e 's/ /_/'`
+ FUJITSU_PROC=$(uname -m | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz)
+ FUJITSU_SYS=$(uname -p | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/\///')
+ FUJITSU_REL=$(echo "$UNAME_RELEASE" | sed -e 's/ /_/')
echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}"
exit ;;
5000:UNIX_System_V:4.*:*)
- FUJITSU_SYS=`uname -p | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/\///'`
- FUJITSU_REL=`echo "$UNAME_RELEASE" | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/ /_/'`
+ FUJITSU_SYS=$(uname -p | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/\///')
+ FUJITSU_REL=$(echo "$UNAME_RELEASE" | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/ /_/')
echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}"
exit ;;
i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*)
@@ -851,25 +862,25 @@ EOF
echo "$UNAME_MACHINE"-unknown-bsdi"$UNAME_RELEASE"
exit ;;
arm:FreeBSD:*:*)
- UNAME_PROCESSOR=`uname -p`
+ UNAME_PROCESSOR=$(uname -p)
set_cc_for_build
if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \
| grep -q __ARM_PCS_VFP
then
- echo "${UNAME_PROCESSOR}"-unknown-freebsd"`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`"-gnueabi
+ echo "${UNAME_PROCESSOR}"-unknown-freebsd"$(echo ${UNAME_RELEASE}|sed -e 's/[-(].*//')"-gnueabi
else
- echo "${UNAME_PROCESSOR}"-unknown-freebsd"`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`"-gnueabihf
+ echo "${UNAME_PROCESSOR}"-unknown-freebsd"$(echo ${UNAME_RELEASE}|sed -e 's/[-(].*//')"-gnueabihf
fi
exit ;;
*:FreeBSD:*:*)
- UNAME_PROCESSOR=`/usr/bin/uname -p`
+ UNAME_PROCESSOR=$(/usr/bin/uname -p)
case "$UNAME_PROCESSOR" in
amd64)
UNAME_PROCESSOR=x86_64 ;;
i386)
UNAME_PROCESSOR=i586 ;;
esac
- echo "$UNAME_PROCESSOR"-unknown-freebsd"`echo "$UNAME_RELEASE"|sed -e 's/[-(].*//'`"
+ echo "$UNAME_PROCESSOR"-unknown-freebsd"$(echo "$UNAME_RELEASE"|sed -e 's/[-(].*//')"
exit ;;
i*:CYGWIN*:*)
echo "$UNAME_MACHINE"-pc-cygwin
@@ -905,15 +916,15 @@ EOF
echo x86_64-pc-cygwin
exit ;;
prep*:SunOS:5.*:*)
- echo powerpcle-unknown-solaris2"`echo "$UNAME_RELEASE"|sed -e 's/[^.]*//'`"
+ echo powerpcle-unknown-solaris2"$(echo "$UNAME_RELEASE"|sed -e 's/[^.]*//')"
exit ;;
*:GNU:*:*)
# the GNU system
- echo "`echo "$UNAME_MACHINE"|sed -e 's,[-/].*$,,'`-unknown-$LIBC`echo "$UNAME_RELEASE"|sed -e 's,/.*$,,'`"
+ echo "$(echo "$UNAME_MACHINE"|sed -e 's,[-/].*$,,')-unknown-$LIBC$(echo "$UNAME_RELEASE"|sed -e 's,/.*$,,')"
exit ;;
*:GNU/*:*:*)
# other systems with GNU libc and userland
- echo "$UNAME_MACHINE-unknown-`echo "$UNAME_SYSTEM" | sed 's,^[^/]*/,,' | tr "[:upper:]" "[:lower:]"``echo "$UNAME_RELEASE"|sed -e 's/[-(].*//'`-$LIBC"
+ echo "$UNAME_MACHINE-unknown-$(echo "$UNAME_SYSTEM" | sed 's,^[^/]*/,,' | tr "[:upper:]" "[:lower:]")$(echo "$UNAME_RELEASE"|sed -e 's/[-(].*//')-$LIBC"
exit ;;
*:Minix:*:*)
echo "$UNAME_MACHINE"-unknown-minix
@@ -926,7 +937,7 @@ EOF
echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
exit ;;
alpha:Linux:*:*)
- case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' /proc/cpuinfo 2>/dev/null` in
+ case $(sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' /proc/cpuinfo 2>/dev/null) in
EV5) UNAME_MACHINE=alphaev5 ;;
EV56) UNAME_MACHINE=alphaev56 ;;
PCA56) UNAME_MACHINE=alphapca56 ;;
@@ -985,6 +996,9 @@ EOF
k1om:Linux:*:*)
echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
exit ;;
+ loongarch32:Linux:*:* | loongarch64:Linux:*:* | loongarchx32:Linux:*:*)
+ echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
+ exit ;;
m32r*:Linux:*:*)
echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
exit ;;
@@ -1035,7 +1049,7 @@ EOF
#endif
#endif
EOF
- eval "`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^CPU\|^MIPS_ENDIAN\|^LIBCABI'`"
+ eval "$($CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^CPU\|^MIPS_ENDIAN\|^LIBCABI')"
test "x$CPU" != x && { echo "$CPU${MIPS_ENDIAN}-unknown-linux-$LIBCABI"; exit; }
;;
mips64el:Linux:*:*)
@@ -1055,7 +1069,7 @@ EOF
exit ;;
parisc:Linux:*:* | hppa:Linux:*:*)
# Look for CPU level
- case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in
+ case $(grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2) in
PA7*) echo hppa1.1-unknown-linux-"$LIBC" ;;
PA8*) echo hppa2.0-unknown-linux-"$LIBC" ;;
*) echo hppa-unknown-linux-"$LIBC" ;;
@@ -1145,7 +1159,7 @@ EOF
echo "$UNAME_MACHINE"-pc-msdosdjgpp
exit ;;
i*86:*:4.*:*)
- UNAME_REL=`echo "$UNAME_RELEASE" | sed 's/\/MP$//'`
+ UNAME_REL=$(echo "$UNAME_RELEASE" | sed 's/\/MP$//')
if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then
echo "$UNAME_MACHINE"-univel-sysv"$UNAME_REL"
else
@@ -1154,7 +1168,7 @@ EOF
exit ;;
i*86:*:5:[678]*)
# UnixWare 7.x, OpenUNIX and OpenServer 6.
- case `/bin/uname -X | grep "^Machine"` in
+ case $(/bin/uname -X | grep "^Machine") in
*486*) UNAME_MACHINE=i486 ;;
*Pentium) UNAME_MACHINE=i586 ;;
*Pent*|*Celeron) UNAME_MACHINE=i686 ;;
@@ -1163,10 +1177,10 @@ EOF
exit ;;
i*86:*:3.2:*)
if test -f /usr/options/cb.name; then
- UNAME_REL=`sed -n 's/.*Version //p' </usr/options/cb.name`
+ UNAME_REL=$(sed -n 's/.*Version //p' </usr/options/cb.name)
echo "$UNAME_MACHINE"-pc-isc"$UNAME_REL"
elif /bin/uname -X 2>/dev/null >/dev/null ; then
- UNAME_REL=`(/bin/uname -X|grep Release|sed -e 's/.*= //')`
+ UNAME_REL=$( (/bin/uname -X|grep Release|sed -e 's/.*= //'))
(/bin/uname -X|grep i80486 >/dev/null) && UNAME_MACHINE=i486
(/bin/uname -X|grep '^Machine.*Pentium' >/dev/null) \
&& UNAME_MACHINE=i586
@@ -1216,7 +1230,7 @@ EOF
3[345]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 3[34]??/*:*:4.0:3.0 | 4400:*:4.0:3.0 | 4850:*:4.0:3.0 | SKA40:*:4.0:3.0 | SDS2:*:4.0:3.0 | SHG2:*:4.0:3.0 | S7501*:*:4.0:3.0)
OS_REL=''
test -r /etc/.relid \
- && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid`
+ && OS_REL=.$(sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid)
/bin/uname -p 2>/dev/null | grep 86 >/dev/null \
&& { echo i486-ncr-sysv4.3"$OS_REL"; exit; }
/bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \
@@ -1227,7 +1241,7 @@ EOF
NCR*:*:4.2:* | MPRAS*:*:4.2:*)
OS_REL='.3'
test -r /etc/.relid \
- && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid`
+ && OS_REL=.$(sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid)
/bin/uname -p 2>/dev/null | grep 86 >/dev/null \
&& { echo i486-ncr-sysv4.3"$OS_REL"; exit; }
/bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \
@@ -1260,7 +1274,7 @@ EOF
exit ;;
*:SINIX-*:*:*)
if uname -p 2>/dev/null >/dev/null ; then
- UNAME_MACHINE=`(uname -p) 2>/dev/null`
+ UNAME_MACHINE=$( (uname -p) 2>/dev/null)
echo "$UNAME_MACHINE"-sni-sysv4
else
echo ns32k-sni-sysv
@@ -1346,7 +1360,7 @@ EOF
echo aarch64-apple-darwin"$UNAME_RELEASE"
exit ;;
*:Darwin:*:*)
- UNAME_PROCESSOR=`uname -p`
+ UNAME_PROCESSOR=$(uname -p)
case $UNAME_PROCESSOR in
unknown) UNAME_PROCESSOR=powerpc ;;
esac
@@ -1383,7 +1397,7 @@ EOF
echo "$UNAME_PROCESSOR"-apple-darwin"$UNAME_RELEASE"
exit ;;
*:procnto*:*:* | *:QNX:[0123456789]*:*)
- UNAME_PROCESSOR=`uname -p`
+ UNAME_PROCESSOR=$(uname -p)
if test "$UNAME_PROCESSOR" = x86; then
UNAME_PROCESSOR=i386
UNAME_MACHINE=pc
@@ -1451,10 +1465,10 @@ EOF
echo mips-sei-seiux"$UNAME_RELEASE"
exit ;;
*:DragonFly:*:*)
- echo "$UNAME_MACHINE"-unknown-dragonfly"`echo "$UNAME_RELEASE"|sed -e 's/[-(].*//'`"
+ echo "$UNAME_MACHINE"-unknown-dragonfly"$(echo "$UNAME_RELEASE"|sed -e 's/[-(].*//')"
exit ;;
*:*VMS:*:*)
- UNAME_MACHINE=`(uname -p) 2>/dev/null`
+ UNAME_MACHINE=$( (uname -p) 2>/dev/null)
case "$UNAME_MACHINE" in
A*) echo alpha-dec-vms ; exit ;;
I*) echo ia64-dec-vms ; exit ;;
@@ -1464,7 +1478,7 @@ EOF
echo i386-pc-xenix
exit ;;
i*86:skyos:*:*)
- echo "$UNAME_MACHINE"-pc-skyos"`echo "$UNAME_RELEASE" | sed -e 's/ .*$//'`"
+ echo "$UNAME_MACHINE"-pc-skyos"$(echo "$UNAME_RELEASE" | sed -e 's/ .*$//')"
exit ;;
i*86:rdos:*:*)
echo "$UNAME_MACHINE"-pc-rdos
@@ -1522,7 +1536,7 @@ main ()
#define __ARCHITECTURE__ "m68k"
#endif
int version;
- version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`;
+ version=$( (hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null);
if (version < 4)
printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version);
else
@@ -1614,7 +1628,7 @@ main ()
}
EOF
-$CC_FOR_BUILD -o "$dummy" "$dummy.c" 2>/dev/null && SYSTEM_NAME=`$dummy` &&
+$CC_FOR_BUILD -o "$dummy" "$dummy.c" 2>/dev/null && SYSTEM_NAME=$($dummy) &&
{ echo "$SYSTEM_NAME"; exit; }
# Apollos put the system type in the environment.
@@ -1639,14 +1653,14 @@ This script (version $timestamp), has failed to recognize the
operating system you are using. If your script is old, overwrite *all*
copies of config.guess and config.sub with the latest versions from:
- https://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess
+ https://git.savannah.gnu.org/cgit/config.git/plain/config.guess
and
- https://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub
+ https://git.savannah.gnu.org/cgit/config.git/plain/config.sub
EOF
-year=`echo $timestamp | sed 's,-.*,,'`
+year=$(echo $timestamp | sed 's,-.*,,')
# shellcheck disable=SC2003
-if test "`expr "\`date +%Y\`" - "$year"`" -lt 3 ; then
+if test "$(expr "$(date +%Y)" - "$year")" -lt 3 ; then
cat >&2 <<EOF
If $0 has already been updated, send the following data and any
@@ -1655,20 +1669,20 @@ provide the necessary information to handle your system.
config.guess timestamp = $timestamp
-uname -m = `(uname -m) 2>/dev/null || echo unknown`
-uname -r = `(uname -r) 2>/dev/null || echo unknown`
-uname -s = `(uname -s) 2>/dev/null || echo unknown`
-uname -v = `(uname -v) 2>/dev/null || echo unknown`
+uname -m = $( (uname -m) 2>/dev/null || echo unknown)
+uname -r = $( (uname -r) 2>/dev/null || echo unknown)
+uname -s = $( (uname -s) 2>/dev/null || echo unknown)
+uname -v = $( (uname -v) 2>/dev/null || echo unknown)
-/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null`
-/bin/uname -X = `(/bin/uname -X) 2>/dev/null`
+/usr/bin/uname -p = $( (/usr/bin/uname -p) 2>/dev/null)
+/bin/uname -X = $( (/bin/uname -X) 2>/dev/null)
-hostinfo = `(hostinfo) 2>/dev/null`
-/bin/universe = `(/bin/universe) 2>/dev/null`
-/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null`
-/bin/arch = `(/bin/arch) 2>/dev/null`
-/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null`
-/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null`
+hostinfo = $( (hostinfo) 2>/dev/null)
+/bin/universe = $( (/bin/universe) 2>/dev/null)
+/usr/bin/arch -k = $( (/usr/bin/arch -k) 2>/dev/null)
+/bin/arch = $( (/bin/arch) 2>/dev/null)
+/usr/bin/oslevel = $( (/usr/bin/oslevel) 2>/dev/null)
+/usr/convex/getsysinfo = $( (/usr/convex/getsysinfo) 2>/dev/null)
UNAME_MACHINE = "$UNAME_MACHINE"
UNAME_RELEASE = "$UNAME_RELEASE"
diff --git a/build-aux/config.sub b/build-aux/config.sub
index 0753e308458..90bb8aeda63 100755
--- a/build-aux/config.sub
+++ b/build-aux/config.sub
@@ -2,7 +2,7 @@
# Configuration validation subroutine script.
# Copyright 1992-2020 Free Software Foundation, Inc.
-timestamp='2020-08-17'
+timestamp='2020-12-22'
# 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
@@ -33,7 +33,7 @@ timestamp='2020-08-17'
# Otherwise, we print the canonical config type on stdout and succeed.
# You can get the latest version of this script from:
-# https://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub
+# https://git.savannah.gnu.org/cgit/config.git/plain/config.sub
# This file is supposed to be the same for all GNU packages
# and recognize all the CPU types, system types and aliases
@@ -50,7 +50,7 @@ timestamp='2020-08-17'
# CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM
# It is wrong to echo any other type of specification.
-me=`echo "$0" | sed -e 's,.*/,,'`
+me=$(echo "$0" | sed -e 's,.*/,,')
usage="\
Usage: $0 [OPTION] CPU-MFR-OPSYS or ALIAS
@@ -769,22 +769,22 @@ case $basic_machine in
vendor=hp
;;
i*86v32)
- cpu=`echo "$1" | sed -e 's/86.*/86/'`
+ cpu=$(echo "$1" | sed -e 's/86.*/86/')
vendor=pc
basic_os=sysv32
;;
i*86v4*)
- cpu=`echo "$1" | sed -e 's/86.*/86/'`
+ cpu=$(echo "$1" | sed -e 's/86.*/86/')
vendor=pc
basic_os=sysv4
;;
i*86v)
- cpu=`echo "$1" | sed -e 's/86.*/86/'`
+ cpu=$(echo "$1" | sed -e 's/86.*/86/')
vendor=pc
basic_os=sysv
;;
i*86sol2)
- cpu=`echo "$1" | sed -e 's/86.*/86/'`
+ cpu=$(echo "$1" | sed -e 's/86.*/86/')
vendor=pc
basic_os=solaris2
;;
@@ -917,7 +917,7 @@ case $basic_machine in
;;
leon-*|leon[3-9]-*)
cpu=sparc
- vendor=`echo "$basic_machine" | sed 's/-.*//'`
+ vendor=$(echo "$basic_machine" | sed 's/-.*//')
;;
*-*)
@@ -1084,7 +1084,7 @@ case $cpu-$vendor in
cpu=mipsisa64sb1el
;;
sh5e[lb]-*)
- cpu=`echo "$cpu" | sed 's/^\(sh.\)e\(.\)$/\1\2e/'`
+ cpu=$(echo "$cpu" | sed 's/^\(sh.\)e\(.\)$/\1\2e/')
;;
spur-*)
cpu=spur
@@ -1102,7 +1102,7 @@ case $cpu-$vendor in
cpu=x86_64
;;
xscale-* | xscalee[bl]-*)
- cpu=`echo "$cpu" | sed 's/^xscale/arm/'`
+ cpu=$(echo "$cpu" | sed 's/^xscale/arm/')
;;
arm64-*)
cpu=aarch64
@@ -1185,6 +1185,7 @@ case $cpu-$vendor in
| k1om \
| le32 | le64 \
| lm32 \
+ | loongarch32 | loongarch64 | loongarchx32 \
| m32c | m32r | m32rle \
| m5200 | m68000 | m680[012346]0 | m68360 | m683?2 | m68k \
| m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x \
@@ -1241,6 +1242,7 @@ case $cpu-$vendor in
| sparcv8 | sparcv9 | sparcv9b | sparcv9v | sv1 | sx* \
| spu \
| tahoe \
+ | thumbv7* \
| tic30 | tic4x | tic54x | tic55x | tic6x | tic80 \
| tron \
| ubicom32 \
@@ -1286,11 +1288,15 @@ then
case $basic_os in
gnu/linux*)
kernel=linux
- os=`echo $basic_os | sed -e 's|gnu/linux|gnu|'`
+ os=$(echo $basic_os | sed -e 's|gnu/linux|gnu|')
+ ;;
+ os2-emx)
+ kernel=os2
+ os=$(echo $basic_os | sed -e 's|os2-emx|emx|')
;;
nto-qnx*)
kernel=nto
- os=`echo $basic_os | sed -e 's|nto-qnx|qnx|'`
+ os=$(echo $basic_os | sed -e 's|nto-qnx|qnx|')
;;
*-*)
# shellcheck disable=SC2162
@@ -1301,11 +1307,11 @@ EOF
# Default OS when just kernel was specified
nto*)
kernel=nto
- os=`echo $basic_os | sed -e 's|nto|qnx|'`
+ os=$(echo $basic_os | sed -e 's|nto|qnx|')
;;
linux*)
kernel=linux
- os=`echo $basic_os | sed -e 's|linux|gnu|'`
+ os=$(echo $basic_os | sed -e 's|linux|gnu|')
;;
*)
kernel=
@@ -1326,7 +1332,7 @@ case $os in
os=cnk
;;
solaris1 | solaris1.*)
- os=`echo $os | sed -e 's|solaris1|sunos4|'`
+ os=$(echo $os | sed -e 's|solaris1|sunos4|')
;;
solaris)
os=solaris2
@@ -1355,7 +1361,7 @@ case $os in
os=sco3.2v4
;;
sco3.2.[4-9]*)
- os=`echo $os | sed -e 's/sco3.2./sco3.2v/'`
+ os=$(echo $os | sed -e 's/sco3.2./sco3.2v/')
;;
sco*v* | scout)
# Don't match below
@@ -1367,13 +1373,7 @@ case $os in
os=psos
;;
qnx*)
- case $cpu in
- x86 | i*86)
- ;;
- *)
- os=nto-$os
- ;;
- esac
+ os=qnx
;;
hiux*)
os=hiuxwe2
@@ -1391,7 +1391,7 @@ case $os in
os=lynxos
;;
mac[0-9]*)
- os=`echo "$os" | sed -e 's|mac|macos|'`
+ os=$(echo "$os" | sed -e 's|mac|macos|')
;;
opened*)
os=openedition
@@ -1400,10 +1400,10 @@ case $os in
os=os400
;;
sunos5*)
- os=`echo "$os" | sed -e 's|sunos5|solaris2|'`
+ os=$(echo "$os" | sed -e 's|sunos5|solaris2|')
;;
sunos6*)
- os=`echo "$os" | sed -e 's|sunos6|solaris3|'`
+ os=$(echo "$os" | sed -e 's|sunos6|solaris3|')
;;
wince*)
os=wince
@@ -1437,7 +1437,7 @@ case $os in
;;
# Preserve the version number of sinix5.
sinix5.*)
- os=`echo $os | sed -e 's|sinix|sysv|'`
+ os=$(echo $os | sed -e 's|sinix|sysv|')
;;
sinix*)
os=sysv4
@@ -1722,7 +1722,7 @@ case $os in
| skyos* | haiku* | rdos* | toppers* | drops* | es* \
| onefs* | tirtos* | phoenix* | fuchsia* | redox* | bme* \
| midnightbsd* | amdhsa* | unleashed* | emscripten* | wasi* \
- | nsk* | powerunix* | genode* | zvmoe* )
+ | nsk* | powerunix* | genode* | zvmoe* | qnx* | emx*)
;;
# This one is extra strict with allowed versions
sco3.2v2 | sco3.2v[4-9]* | sco5v6*)
@@ -1741,6 +1741,8 @@ esac
case $kernel-$os in
linux-gnu* | linux-dietlibc* | linux-android* | linux-newlib* | linux-musl* | linux-uclibc* )
;;
+ uclinux-uclibc* )
+ ;;
-dietlibc* | -newlib* | -musl* | -uclibc* )
# These are just libc implementations, not actual OSes, and thus
# require a kernel.
@@ -1751,6 +1753,8 @@ case $kernel-$os in
;;
nto-qnx*)
;;
+ os2-emx)
+ ;;
*-eabi* | *-gnueabi*)
;;
-*)
diff --git a/build-aux/git-hooks/commit-msg b/build-aux/git-hooks/commit-msg
index e84be4cbafe..cf0f74c6441 100755
--- a/build-aux/git-hooks/commit-msg
+++ b/build-aux/git-hooks/commit-msg
@@ -1,7 +1,7 @@
#!/bin/sh
# Check the format of GNU Emacs change log entries.
-# Copyright 2014-2020 Free Software Foundation, Inc.
+# Copyright 2014-2021 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
diff --git a/build-aux/git-hooks/pre-commit b/build-aux/git-hooks/pre-commit
index 59fdaf58c1a..719bfefc50a 100755
--- a/build-aux/git-hooks/pre-commit
+++ b/build-aux/git-hooks/pre-commit
@@ -1,7 +1,7 @@
#!/bin/sh
# Check file names in git commits for GNU Emacs.
-# Copyright 2014-2020 Free Software Foundation, Inc.
+# Copyright 2014-2021 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
diff --git a/build-aux/git-hooks/prepare-commit-msg b/build-aux/git-hooks/prepare-commit-msg
index dbb1264b495..dd8434479d4 100755
--- a/build-aux/git-hooks/prepare-commit-msg
+++ b/build-aux/git-hooks/prepare-commit-msg
@@ -1,7 +1,7 @@
#!/bin/sh
# Check the format of GNU Emacs change log entries.
-# Copyright 2019-2020 Free Software Foundation, Inc.
+# Copyright 2019-2021 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
@@ -24,9 +24,9 @@ SHA1=$3
# Prefer gawk if available, as it handles NUL bytes properly.
if type gawk >/dev/null 2>&1; then
- awk=gawk
+ awk="gawk"
else
- awk=awk
+ awk="awk"
fi
exec $awk '
diff --git a/build-aux/gitlog-to-changelog b/build-aux/gitlog-to-changelog
index be8082e7ffd..de76f658d48 100755
--- a/build-aux/gitlog-to-changelog
+++ b/build-aux/gitlog-to-changelog
@@ -3,7 +3,7 @@
# Convert git log output to ChangeLog format.
-# Copyright (C) 2008-2020 Free Software Foundation, Inc.
+# Copyright (C) 2008-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
diff --git a/build-aux/gitlog-to-emacslog b/build-aux/gitlog-to-emacslog
index 23702807efc..30b2d78659d 100755
--- a/build-aux/gitlog-to-emacslog
+++ b/build-aux/gitlog-to-emacslog
@@ -2,7 +2,7 @@
# Convert git log output to ChangeLog format for GNU Emacs.
-# Copyright (C) 2014-2020 Free Software Foundation, Inc.
+# Copyright (C) 2014-2021 Free Software Foundation, Inc.
# Author: Paul Eggert
diff --git a/build-aux/install-sh b/build-aux/install-sh
index b34a8fc5ab9..ec298b53740 100755
--- a/build-aux/install-sh
+++ b/build-aux/install-sh
@@ -1,7 +1,7 @@
#!/bin/sh
# install - install a program, script, or datafile
-scriptversion=2020-07-26.22; # UTC
+scriptversion=2020-11-14.01; # UTC
# This originates from X11R5 (mit/util/scripts/install.sh), which was
# later released in X11R6 (xc/config/util/install.sh) with the
@@ -73,6 +73,7 @@ mode=0755
# This is like GNU 'install' as of coreutils 8.32 (2020).
mkdir_umask=22
+backupsuffix=
chgrpcmd=
chmodcmd=$chmodprog
chowncmd=
@@ -103,18 +104,28 @@ Options:
--version display version info and exit.
-c (ignored)
- -C install only if different (preserve the last data modification time)
+ -C install only if different (preserve data modification time)
-d create directories instead of installing files.
-g GROUP $chgrpprog installed files to GROUP.
-m MODE $chmodprog installed files to MODE.
-o USER $chownprog installed files to USER.
+ -p pass -p to $cpprog.
-s $stripprog installed files.
+ -S SUFFIX attempt to back up existing files, with suffix SUFFIX.
-t DIRECTORY install into DIRECTORY.
-T report an error if DSTFILE is a directory.
Environment variables override the default commands:
CHGRPPROG CHMODPROG CHOWNPROG CMPPROG CPPROG MKDIRPROG MVPROG
RMPROG STRIPPROG
+
+By default, rm is invoked with -f; when overridden with RMPROG,
+it's up to you to specify -f if you want it.
+
+If -S is not specified, no backups are attempted.
+
+Email bug reports to bug-automake@gnu.org.
+Automake home page: https://www.gnu.org/software/automake/
"
while test $# -ne 0; do
@@ -141,8 +152,13 @@ while test $# -ne 0; do
-o) chowncmd="$chownprog $2"
shift;;
+ -p) cpprog="$cpprog -p";;
+
-s) stripcmd=$stripprog;;
+ -S) backupsuffix="$2"
+ shift;;
+
-t)
is_target_a_directory=always
dst_arg=$2
@@ -259,6 +275,10 @@ do
dstdir=$dst
test -d "$dstdir"
dstdir_status=$?
+ # Don't chown directories that already exist.
+ if test $dstdir_status = 0; then
+ chowncmd=""
+ fi
else
# Waiting for this to be detected by the "$cpprog $src $dsttmp" command
@@ -473,6 +493,13 @@ do
then
rm -f "$dsttmp"
else
+ # If $backupsuffix is set, and the file being installed
+ # already exists, attempt a backup. Don't worry if it fails,
+ # e.g., if mv doesn't support -f.
+ if test -n "$backupsuffix" && test -f "$dst"; then
+ $doit $mvcmd -f "$dst" "$dst$backupsuffix" 2>/dev/null
+ fi
+
# Rename the file to the real destination.
$doit $mvcmd -f "$dsttmp" "$dst" 2>/dev/null ||
@@ -487,9 +514,9 @@ do
# file should still install successfully.
{
test ! -f "$dst" ||
- $doit $rmcmd -f "$dst" 2>/dev/null ||
+ $doit $rmcmd "$dst" 2>/dev/null ||
{ $doit $mvcmd -f "$dst" "$rmtmp" 2>/dev/null &&
- { $doit $rmcmd -f "$rmtmp" 2>/dev/null; :; }
+ { $doit $rmcmd "$rmtmp" 2>/dev/null; :; }
} ||
{ echo "$0: cannot unlink or rename $dst" >&2
(exit 1); exit 1
diff --git a/build-aux/make-info-dir b/build-aux/make-info-dir
index ee2197beb34..ea26479cd96 100755
--- a/build-aux/make-info-dir
+++ b/build-aux/make-info-dir
@@ -2,7 +2,7 @@
### make-info-dir - create info/dir, for systems without install-info
-## Copyright (C) 2013-2020 Free Software Foundation, Inc.
+## Copyright (C) 2013-2021 Free Software Foundation, Inc.
## Author: Glenn Morris <rgm@gnu.org>
## Maintainer: emacs-devel@gnu.org
diff --git a/build-aux/move-if-change b/build-aux/move-if-change
index 653dc981599..e85e90af501 100755
--- a/build-aux/move-if-change
+++ b/build-aux/move-if-change
@@ -8,7 +8,7 @@ VERSION='2018-03-07 03:47'; # UTC
# If you change this file with Emacs, please let the write hook
# do its job. Otherwise, update this string manually.
-# Copyright (C) 2002-2020 Free Software Foundation, Inc.
+# Copyright (C) 2002-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
diff --git a/build-aux/msys-to-w32 b/build-aux/msys-to-w32
index 4e0b2aaebad..e4e5e086415 100755
--- a/build-aux/msys-to-w32
+++ b/build-aux/msys-to-w32
@@ -2,7 +2,7 @@
# Convert a MSYS path list to Windows-native format.
# Status is zero if successful, nonzero otherwise.
-# Copyright (C) 2013-2020 Free Software Foundation, Inc.
+# Copyright (C) 2013-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
diff --git a/build-aux/update-copyright b/build-aux/update-copyright
index d9b7f683a08..fae3a5fb33b 100755
--- a/build-aux/update-copyright
+++ b/build-aux/update-copyright
@@ -3,7 +3,7 @@
# Update an FSF copyright year list to include the current year.
-# Copyright (C) 2009-2020 Free Software Foundation, Inc.
+# Copyright (C) 2009-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
diff --git a/build-aux/update-subdirs b/build-aux/update-subdirs
index 96712f0b32e..e56eea44def 100755
--- a/build-aux/update-subdirs
+++ b/build-aux/update-subdirs
@@ -1,7 +1,7 @@
#!/bin/sh
# Write into $1/subdirs.el a list of subdirs of directory $1.
-# Copyright (C) 1994-1995, 1997, 1999, 2001-2020 Free Software
+# Copyright (C) 1994-1995, 1997, 1999, 2001-2021 Free Software
# Foundation, Inc.
# This file is part of GNU Emacs.
@@ -41,7 +41,7 @@ if [ "x$subdirs" = x ]; then
rm -f subdirs.el
else
rm -f subdirs.el~
- echo ";; In load-path, after this directory should come
+ echo ";; In load-path, after this directory should come -*- lexical-binding: t -*-
;; certain of its subdirectories. Here we specify them.
(normal-top-level-add-to-load-path '($subdirs))
;; Local" "Variables:
diff --git a/config.bat b/config.bat
index 6938e556711..cba73360992 100644
--- a/config.bat
+++ b/config.bat
@@ -1,7 +1,7 @@
@echo off
rem ----------------------------------------------------------------------
rem Configuration script for MSDOS
-rem Copyright (C) 1994-1999, 2001-2020 Free Software Foundation, Inc.
+rem Copyright (C) 1994-1999, 2001-2021 Free Software Foundation, Inc.
rem This file is part of GNU Emacs.
diff --git a/configure.ac b/configure.ac
index f0c8e5210f9..bea28338090 100644
--- a/configure.ac
+++ b/configure.ac
@@ -4,7 +4,7 @@ dnl autoconf
dnl in the directory containing this script.
dnl If you changed any AC_DEFINES, also run autoheader.
dnl
-dnl Copyright (C) 1994-1996, 1999-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 1994-1996, 1999-2021 Free Software Foundation, Inc.
dnl
dnl This file is part of GNU Emacs.
dnl
@@ -3291,7 +3291,12 @@ fi
# Check for XRender
HAVE_XRENDER=no
if test "${HAVE_X11}" = "yes"; then
- AC_CHECK_HEADER([X11/extensions/Xrender.h],
+ AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#include <X11/Intrinsic.h>
+ #include <X11/extensions/Xrender.h>
+ ]],
+ [[return !XRenderQueryExtension;]])],
[AC_CHECK_LIB([Xrender], [XRenderQueryExtension], [HAVE_XRENDER=yes])])
if test $HAVE_XRENDER = yes; then
XRENDER_LIBS="-lXrender"
@@ -3444,16 +3449,17 @@ else # "${HAVE_X11}" != "yes"
fi # "${HAVE_X11}" != "yes"
HAVE_HARFBUZZ=no
+### On MS-Windows we use hb_font_get_nominal_glyph, which appeared
+### in HarfBuzz version 1.2.3
+if test "${HAVE_W32}" = "yes"; then
+ harfbuzz_required_ver=1.2.3
+else
+ harfbuzz_required_ver=0.9.42
+fi
if test "${HAVE_X11}" = "yes" && test "${HAVE_FREETYPE}" = "yes" \
|| test "${HAVE_W32}" = "yes"; then
if test "${with_harfbuzz}" != "no"; then
- ### On MS-Windows we use hb_font_get_nominal_glyph, which appeared
- ### in HarfBuzz version 1.2.3
- if test "${HAVE_W32}" = "yes"; then
- EMACS_CHECK_MODULES([HARFBUZZ], [harfbuzz >= 1.2.3])
- else
- EMACS_CHECK_MODULES([HARFBUZZ], [harfbuzz >= 0.9.42])
- fi
+ EMACS_CHECK_MODULES([HARFBUZZ], [harfbuzz >= $harfbuzz_required_ver])
if test "$HAVE_HARFBUZZ" = "yes"; then
AC_DEFINE(HAVE_HARFBUZZ, 1, [Define to 1 if using HarfBuzz.])
### mingw32 and Cygwin-w32 don't use -lharfbuzz, since they load
@@ -4387,6 +4393,18 @@ TERMCAP_OBJ=tparam.o
if test $TERMINFO = yes; then
AC_DEFINE(TERMINFO, 1, [Define to 1 if you use terminfo instead of termcap.])
TERMCAP_OBJ=terminfo.o
+ AC_CACHE_CHECK([whether $LIBS_TERMCAP library defines BC],
+ [emacs_cv_terminfo_defines_BC],
+ [OLD_LIBS=$LIBS
+ LIBS="$LIBS $LIBS_TERMCAP"
+ AC_LINK_IFELSE([AC_LANG_PROGRAM([[extern char *BC;]], [[return !*BC;]])],
+ [emacs_cv_terminfo_defines_BC=yes],
+ [emacs_cv_terminfo_defines_BC=no])
+ LIBS=$OLD_LIBS])
+ if test "$emacs_cv_terminfo_defines_BC" = yes; then
+ AC_DEFINE([TERMINFO_DEFINES_BC], 1, [Define to 1 if the
+ terminfo library defines the variables BC, PC, and UP.])
+ fi
fi
if test "X$LIBS_TERMCAP" = "X-lncurses"; then
AC_DEFINE(USE_NCURSES, 1, [Define to 1 if you use ncurses.])
@@ -4925,7 +4943,7 @@ case $opsys in
AC_DEFINE(FIRST_PTY_LETTER, ['z'])
AC_DEFINE(PTY_NAME_SPRINTF, [strcpy (pty_name, "/dev/ptmx");])
dnl Push various streams modules onto a PTY channel. Used in process.c.
- AC_DEFINE(SETUP_SLAVE_PTY, [if (ioctl (forkin, I_PUSH, "ptem") == -1) fatal ("ioctl I_PUSH ptem"); if (ioctl (forkin, I_PUSH, "ldterm") == -1) fatal ("ioctl I_PUSH ldterm"); if (ioctl (forkin, I_PUSH, "ttcompat") == -1) fatal ("ioctl I_PUSH ttcompat");], [How to set up a slave PTY, if needed.])
+ AC_DEFINE(SETUP_SLAVE_PTY, [if (ioctl (std_in, I_PUSH, "ptem") == -1) fatal ("ioctl I_PUSH ptem"); if (ioctl (std_in, I_PUSH, "ldterm") == -1) fatal ("ioctl I_PUSH ldterm"); if (ioctl (std_in, I_PUSH, "ttcompat") == -1) fatal ("ioctl I_PUSH ttcompat");], [How to set up a slave PTY, if needed.])
;;
esac
@@ -5214,7 +5232,7 @@ fi
version=$PACKAGE_VERSION
-copyright="Copyright (C) 2020 Free Software Foundation, Inc."
+copyright="Copyright (C) 2021 Free Software Foundation, Inc."
AC_DEFINE_UNQUOTED(COPYRIGHT, ["$copyright"],
[Short copyright string for this version of Emacs.])
AC_SUBST(copyright)
@@ -5490,7 +5508,7 @@ case "$opsys" in
if test "$HAVE_NS" = "yes"; then
libs_nsgui="-framework AppKit"
if test "$NS_IMPL_COCOA" = "yes"; then
- libs_nsgui="$libs_nsgui -framework IOKit -framework Carbon"
+ libs_nsgui="$libs_nsgui -framework IOKit -framework Carbon -framework IOSurface"
fi
else
libs_nsgui=
@@ -5588,7 +5606,7 @@ AC_SUBST(WINDOW_SYSTEM_OBJ)
AH_TOP([/* GNU Emacs site configuration template file.
-Copyright (C) 1988, 1993-1994, 1999-2002, 2004-2020
+Copyright (C) 1988, 1993-1994, 1999-2002, 2004-2021
Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -5639,6 +5657,12 @@ else
ACL_SUMMARY=no
fi
+if test -z "$GMP_H"; then
+ HAVE_GMP=yes
+else
+ HAVE_GMP=no
+fi
+
emacs_standard_dirs='Standard dirs'
AS_ECHO(["
Configured for '${canonical}'.
@@ -5653,12 +5677,14 @@ Configured for '${canonical}'.
Where do we find X Windows header files? ${x_includes:-$emacs_standard_dirs}
Where do we find X Windows libraries? ${x_libraries:-$emacs_standard_dirs}"])
+#### Please respect alphabetical ordering when making additions.
optsep=
emacs_config_features=
-for opt in XAW3D XPM JPEG TIFF GIF PNG RSVG CAIRO IMAGEMAGICK SOUND GPM DBUS \
- GCONF GSETTINGS GLIB NOTIFY ACL LIBSELINUX GNUTLS LIBXML2 FREETYPE HARFBUZZ M17N_FLT \
- LIBOTF XFT ZLIB TOOLKIT_SCROLL_BARS X_TOOLKIT OLDXMENU X11 XDBE XIM \
- NS MODULES THREADS XWIDGETS LIBSYSTEMD JSON PDUMPER UNEXEC LCMS2 GMP; do
+for opt in ACL CAIRO DBUS FREETYPE GCONF GIF GLIB GMP GNUTLS GPM GSETTINGS \
+ HARFBUZZ IMAGEMAGICK JPEG JSON LCMS2 LIBOTF LIBSELINUX LIBSYSTEMD LIBXML2 \
+ M17N_FLT MODULES NOTIFY NS OLDXMENU PDUMPER PNG RSVG SOUND THREADS TIFF \
+ TOOLKIT_SCROLL_BARS UNEXEC X11 XAW3D XDBE XFT XIM XPM XWIDGETS X_TOOLKIT \
+ ZLIB; do
case $opt in
PDUMPER) val=${with_pdumper} ;;
@@ -5695,11 +5721,6 @@ done
AC_DEFINE_UNQUOTED(EMACS_CONFIG_FEATURES, "${emacs_config_features}",
[Summary of some of the main features enabled by configure.])
-if test -z "$GMP_H"; then
- HAVE_GMP=yes
-else
- HAVE_GMP=no
-fi
AS_ECHO([" Does Emacs use -lXaw3d? ${HAVE_XAW3D}
Does Emacs use -lXpm? ${HAVE_XPM}
Does Emacs use -ljpeg? ${HAVE_JPEG}
@@ -5877,6 +5898,12 @@ if test $AUTO_DEPEND = yes; then
AS_MKDIR_P([$dir/deps])
done
fi
+if $gl_gnulib_enabled_scratch_buffer; then
+ AS_MKDIR_P([lib/malloc])
+ if test $AUTO_DEPEND = yes; then
+ AS_MKDIR_P([lib/deps/malloc])
+ fi
+fi
AC_OUTPUT
@@ -5918,9 +5945,9 @@ fi
if test "${HAVE_CAIRO}" = "yes" && test "${HAVE_HARFBUZZ}" = no; then
AC_MSG_WARN([This configuration uses the Cairo graphics library,
- but not the HarfBuzz font shaping library. We recommend the use
- of HarfBuzz when using Cairo, please install HarfBuzz development
- packages.])
+ but not the HarfBuzz font shaping library (minimum version $harfbuzz_required_ver).
+ We recommend the use of HarfBuzz when using Cairo, please install
+ appropriate HarfBuzz development packages.])
fi
# Let plain 'make' work.
diff --git a/doc/emacs/ChangeLog.1 b/doc/emacs/ChangeLog.1
index cf641beec1f..bc4dbd47052 100644
--- a/doc/emacs/ChangeLog.1
+++ b/doc/emacs/ChangeLog.1
@@ -10919,7 +10919,7 @@
;; coding: utf-8
;; End:
- Copyright (C) 1993-1999, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1993-1999, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/doc/emacs/Makefile.in b/doc/emacs/Makefile.in
index 53b7d074512..2a3f53f740d 100644
--- a/doc/emacs/Makefile.in
+++ b/doc/emacs/Makefile.in
@@ -1,6 +1,6 @@
### @configure_input@
-# Copyright (C) 1994, 1996-2020 Free Software Foundation, Inc.
+# Copyright (C) 1994, 1996-2021 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
diff --git a/doc/emacs/abbrevs.texi b/doc/emacs/abbrevs.texi
index e3766aae9e8..c83da8aaec6 100644
--- a/doc/emacs/abbrevs.texi
+++ b/doc/emacs/abbrevs.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985--1987, 1993--1995, 1997, 2001--2020 Free Software
+@c Copyright (C) 1985--1987, 1993--1995, 1997, 2001--2021 Free Software
@c Foundation, Inc.
@c See file emacs.texi for copying conditions.
@node Abbrevs
diff --git a/doc/emacs/ack.texi b/doc/emacs/ack.texi
index 4658cd4723e..d771393ffa1 100644
--- a/doc/emacs/ack.texi
+++ b/doc/emacs/ack.texi
@@ -1,6 +1,6 @@
@c -*- coding: utf-8 -*-
@c This is part of the Emacs manual.
-@c Copyright (C) 1994--1997, 1999--2020 Free Software Foundation, Inc.
+@c Copyright (C) 1994--1997, 1999--2021 Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
@c
@node Acknowledgments
diff --git a/doc/emacs/anti.texi b/doc/emacs/anti.texi
index d1e67e66560..49da473fa51 100644
--- a/doc/emacs/anti.texi
+++ b/doc/emacs/anti.texi
@@ -1,6 +1,6 @@
@c -*- coding: utf-8 -*-
@c This is part of the Emacs manual.
-@c Copyright (C) 2005--2020 Free Software Foundation, Inc.
+@c Copyright (C) 2005--2021 Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
@node Antinews
diff --git a/doc/emacs/arevert-xtra.texi b/doc/emacs/arevert-xtra.texi
index ef42fb2a7c0..5dede6246cc 100644
--- a/doc/emacs/arevert-xtra.texi
+++ b/doc/emacs/arevert-xtra.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 2004--2020 Free Software Foundation, Inc.
+@c Copyright (C) 2004--2021 Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
@c
@c This file is included either in emacs-xtra.texi (when producing the
diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi
index 2e03d0c04a3..444b28f24be 100644
--- a/doc/emacs/basic.texi
+++ b/doc/emacs/basic.texi
@@ -1,6 +1,6 @@
@c -*- coding: utf-8 -*-
@c This is part of the Emacs manual.
-@c Copyright (C) 1985--1987, 1993--1995, 1997, 2000--2020 Free Software
+@c Copyright (C) 1985--1987, 1993--1995, 1997, 2000--2021 Free Software
@c Foundation, Inc.
@c See file emacs.texi for copying conditions.
@node Basic
@@ -145,6 +145,12 @@ the buffer.
A numeric argument to @kbd{C-q} or @kbd{C-x 8 ...} specifies
how many copies of the character to insert (@pxref{Arguments}).
+ As an alternative to @kbd{C-x 8}, you can select the corresponding
+transient input method by typing @kbd{C-u C-x \ iso-transl @key{RET}},
+then temporarily activating this transient input method by typing
+@kbd{C-x \ [} will insert the same character @t{‘} (@pxref{transient
+input method}).
+
In addition, in some contexts, if you type a quotation using grave
accent and apostrophe @kbd{`like this'}, it is converted to a form
@t{‘like this’} using single quotation marks, even without @kbd{C-x 8}
@@ -304,7 +310,10 @@ Scroll one screen backward, and move point onscreen if necessary
@kindex M-g c
@findex goto-char
Read a number @var{n} and move point to buffer position @var{n}.
-Position 1 is the beginning of the buffer.
+Position 1 is the beginning of the buffer. If point is on or just
+after a number in the buffer, that is the default for @var{n}. Just
+type @key{RET} in the minibuffer to use it. You can also specify
+@var{n} by giving @kbd{M-g c} a numeric prefix argument.
@item M-g M-g
@itemx M-g g
diff --git a/doc/emacs/buffers.texi b/doc/emacs/buffers.texi
index 537c6536085..9cdfa493ed4 100644
--- a/doc/emacs/buffers.texi
+++ b/doc/emacs/buffers.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985--1987, 1993--1995, 1997, 2000--2020 Free Software
+@c Copyright (C) 1985--1987, 1993--1995, 1997, 2000--2021 Free Software
@c Foundation, Inc.
@c See file emacs.texi for copying conditions.
@node Buffers
diff --git a/doc/emacs/building.texi b/doc/emacs/building.texi
index 3e09f243226..7194eb90ca9 100644
--- a/doc/emacs/building.texi
+++ b/doc/emacs/building.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985--1987, 1993--1995, 1997, 2000--2020 Free Software
+@c Copyright (C) 1985--1987, 1993--1995, 1997, 2000--2021 Free Software
@c Foundation, Inc.
@c See file emacs.texi for copying conditions.
@node Building
@@ -1092,13 +1092,12 @@ code that has already executed, in order to examine its execution in
more detail.
@vindex gdb-mi-decode-strings
- If the file names of the source files are shown with octal escapes,
-set the variable @code{gdb-mi-decode-strings} to the appropriate
-coding-system, most probably @code{utf-8}. (This is @code{nil} by
-default because GDB may emit octal escapes in situations where
-decoding is undesirable, and also because the program being debugged
-might use an encoding different from the one used to encode non-ASCII
-file names on your system.)
+ By default, source file names and non-ASCII strings in the program
+being debugged are decoded using the default coding-system. If you
+prefer a different decoding, perhaps because the program being
+debugged uses a different character encoding, set the variable
+@code{gdb-mi-decode-strings} to the appropriate coding-system, or to
+@code{nil} to leave non-ASCII characters as undecoded octal escapes.
@node Breakpoints Buffer
@subsubsection Breakpoints Buffer
diff --git a/doc/emacs/cal-xtra.texi b/doc/emacs/cal-xtra.texi
index 3f1198987d9..aec2e6cc5a8 100644
--- a/doc/emacs/cal-xtra.texi
+++ b/doc/emacs/cal-xtra.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual. -*- coding: utf-8 -*-
-@c Copyright (C) 2004--2020 Free Software Foundation, Inc.
+@c Copyright (C) 2004--2021 Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
@c
@c This file is included either in emacs-xtra.texi (when producing the
diff --git a/doc/emacs/calendar.texi b/doc/emacs/calendar.texi
index e5ee7e94bcf..3750e78e709 100644
--- a/doc/emacs/calendar.texi
+++ b/doc/emacs/calendar.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual. -*- coding: utf-8 -*-
-@c Copyright (C) 1985--1987, 1993--1995, 1997, 2000--2020 Free Software
+@c Copyright (C) 1985--1987, 1993--1995, 1997, 2000--2021 Free Software
@c Foundation, Inc.
@c See file emacs.texi for copying conditions.
@node Calendar/Diary
diff --git a/doc/emacs/cmdargs.texi b/doc/emacs/cmdargs.texi
index 3dd1fe9a308..b7f0bda7851 100644
--- a/doc/emacs/cmdargs.texi
+++ b/doc/emacs/cmdargs.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985--1987, 1993--1995, 1997, 2001--2020 Free Software
+@c Copyright (C) 1985--1987, 1993--1995, 1997, 2001--2021 Free Software
@c Foundation, Inc.
@c See file emacs.texi for copying conditions.
@node Emacs Invocation
@@ -654,7 +654,8 @@ Used by the Gnus package.
@item SHELL
@vindex SHELL@r{, environment variable}
The name of an interpreter used to parse and execute programs run from
-inside Emacs.
+inside Emacs. This is used to initialize the variable
+@code{shell-file-name} (@pxref{Single Shell}).
@item SMTPSERVER
@vindex SMTPSERVER@r{, environment variable}
The name of the outgoing mail server. This is used to initialize the
diff --git a/doc/emacs/commands.texi b/doc/emacs/commands.texi
index ad0cbc6f659..82a917ce7d1 100644
--- a/doc/emacs/commands.texi
+++ b/doc/emacs/commands.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985--1987, 1993--1995, 1997, 2001--2020 Free Software
+@c Copyright (C) 1985--1987, 1993--1995, 1997, 2001--2021 Free Software
@c Foundation, Inc.
@c See file emacs.texi for copying conditions.
@iftex
diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi
index fb60caa773b..ccf5f1932f9 100644
--- a/doc/emacs/custom.texi
+++ b/doc/emacs/custom.texi
@@ -1,6 +1,6 @@
@c -*- coding: utf-8 -*-
@c This is part of the Emacs manual.
-@c Copyright (C) 1985--1987, 1993--1995, 1997, 2000--2020 Free Software
+@c Copyright (C) 1985--1987, 1993--1995, 1997, 2000--2021 Free Software
@c Foundation, Inc.
@c See file emacs.texi for copying conditions.
@node Customization
diff --git a/doc/emacs/dired-xtra.texi b/doc/emacs/dired-xtra.texi
index 25cffe49161..fc8130d8e6f 100644
--- a/doc/emacs/dired-xtra.texi
+++ b/doc/emacs/dired-xtra.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 2004--2020 Free Software Foundation, Inc.
+@c Copyright (C) 2004--2021 Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
@c
@c This file is included either in emacs-xtra.texi (when producing the
diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi
index fdc4703e86f..34d12acc349 100644
--- a/doc/emacs/dired.texi
+++ b/doc/emacs/dired.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985--1987, 1993--1995, 1997, 2000--2020 Free Software
+@c Copyright (C) 1985--1987, 1993--1995, 1997, 2000--2021 Free Software
@c Foundation, Inc.
@c See file emacs.texi for copying conditions.
@node Dired
diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi
index 7dadb0966f2..f4b18541429 100644
--- a/doc/emacs/display.texi
+++ b/doc/emacs/display.texi
@@ -1,6 +1,6 @@
@c -*- coding: utf-8 -*-
@c This is part of the Emacs manual.
-@c Copyright (C) 1985--1987, 1993--1995, 1997, 2000--2020 Free Software
+@c Copyright (C) 1985--1987, 1993--1995, 1997, 2000--2021 Free Software
@c Foundation, Inc.
@c See file emacs.texi for copying conditions.
diff --git a/doc/emacs/emacs-xtra.texi b/doc/emacs/emacs-xtra.texi
index 544b808c7d4..2d511bffbc6 100644
--- a/doc/emacs/emacs-xtra.texi
+++ b/doc/emacs/emacs-xtra.texi
@@ -16,7 +16,7 @@
@copying
This manual describes specialized features of Emacs.
-Copyright @copyright{} 2004--2020 Free Software Foundation, Inc.
+Copyright @copyright{} 2004--2021 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi
index bd40e10052d..4054b094def 100644
--- a/doc/emacs/emacs.texi
+++ b/doc/emacs/emacs.texi
@@ -20,7 +20,7 @@ This is the @cite{GNU Emacs Manual},
@end ifclear
updated for Emacs version @value{EMACSVER}.
-Copyright @copyright{} 1985--1987, 1993--2020 Free Software Foundation,
+Copyright @copyright{} 1985--1987, 1993--2021 Free Software Foundation,
Inc.
@quotation
diff --git a/doc/emacs/emerge-xtra.texi b/doc/emacs/emerge-xtra.texi
index d5759650c23..7bf24151e57 100644
--- a/doc/emacs/emerge-xtra.texi
+++ b/doc/emacs/emerge-xtra.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 2004--2020 Free Software Foundation, Inc.
+@c Copyright (C) 2004--2021 Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
@c
@c This file is included either in emacs-xtra.texi (when producing the
diff --git a/doc/emacs/entering.texi b/doc/emacs/entering.texi
index 4cd5c65df57..0476466da5d 100644
--- a/doc/emacs/entering.texi
+++ b/doc/emacs/entering.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985--1987, 1993--1995, 2001--2020 Free Software
+@c Copyright (C) 1985--1987, 1993--1995, 2001--2021 Free Software
@c Foundation, Inc.
@c See file emacs.texi for copying conditions.
@iftex
diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi
index eb4353b6784..ede382c146c 100644
--- a/doc/emacs/files.texi
+++ b/doc/emacs/files.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985--1987, 1993--1995, 1997, 1999--2020 Free Software
+@c Copyright (C) 1985--1987, 1993--1995, 1997, 1999--2021 Free Software
@c Foundation, Inc.
@c See file emacs.texi for copying conditions.
@node Files
diff --git a/doc/emacs/fixit.texi b/doc/emacs/fixit.texi
index db77ae4ec26..6b41849ccc8 100644
--- a/doc/emacs/fixit.texi
+++ b/doc/emacs/fixit.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985--1987, 1993--1995, 1997, 2001--2020 Free Software
+@c Copyright (C) 1985--1987, 1993--1995, 1997, 2001--2021 Free Software
@c Foundation, Inc.
@c See file emacs.texi for copying conditions.
@node Fixit
diff --git a/doc/emacs/fortran-xtra.texi b/doc/emacs/fortran-xtra.texi
index 11222e532eb..c8efd56c37f 100644
--- a/doc/emacs/fortran-xtra.texi
+++ b/doc/emacs/fortran-xtra.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 2004--2020 Free Software Foundation, Inc.
+@c Copyright (C) 2004--2021 Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
@c
@c This file is included either in emacs-xtra.texi (when producing the
diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi
index 1a44d8dc628..e1a4e64a7d4 100644
--- a/doc/emacs/frames.texi
+++ b/doc/emacs/frames.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985--1987, 1993--1995, 1997, 1999--2020 Free Software
+@c Copyright (C) 1985--1987, 1993--1995, 1997, 1999--2021 Free Software
@c Foundation, Inc.
@c See file emacs.texi for copying conditions.
@node Frames
@@ -214,7 +214,11 @@ speed is linked to how fast you move the wheel. This mode also
supports increasing or decreasing the height of the default face, by
default bound to scrolling with the @key{Ctrl} modifier.
-Emacs also supports horizontal scrolling with the @key{Shift} modifier.
+@vindex mouse-wheel-scroll-amount-horizontal
+Emacs also supports horizontal scrolling with the @key{Shift}
+modifier. Typing a numeric prefix arg (e.g., @kbd{M-5}) before
+starting horizontal scrolling changes its step value defined
+by the user option @code{mouse-wheel-scroll-amount-horizontal}.
@vindex mouse-wheel-tilt-scroll
@vindex mouse-wheel-flip-direction
diff --git a/doc/emacs/glossary.texi b/doc/emacs/glossary.texi
index 4d622ec0e3f..35df06591eb 100644
--- a/doc/emacs/glossary.texi
+++ b/doc/emacs/glossary.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985--1987, 1993--1995, 1997, 2001--2020 Free Software
+@c Copyright (C) 1985--1987, 1993--1995, 1997, 2001--2021 Free Software
@c Foundation, Inc.
@c See file emacs.texi for copying conditions.
@node Glossary
diff --git a/doc/emacs/gnu.texi b/doc/emacs/gnu.texi
index 0028b484c95..4d48dcdb8ed 100644
--- a/doc/emacs/gnu.texi
+++ b/doc/emacs/gnu.texi
@@ -1,4 +1,4 @@
-@c Copyright (C) 1985--1987, 1993, 1995, 2001--2020 Free Software
+@c Copyright (C) 1985--1987, 1993, 1995, 2001--2021 Free Software
@c Foundation, Inc.
@c
@c Permission is granted to anyone to make or distribute verbatim copies
diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi
index c5b59e54928..81cdeb4be54 100644
--- a/doc/emacs/help.texi
+++ b/doc/emacs/help.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985--1987, 1993--1995, 1997, 2000--2020 Free Software
+@c Copyright (C) 1985--1987, 1993--1995, 1997, 2000--2021 Free Software
@c Foundation, Inc.
@c See file emacs.texi for copying conditions.
@node Help
diff --git a/doc/emacs/indent.texi b/doc/emacs/indent.texi
index d6395ef155d..df9e67fee68 100644
--- a/doc/emacs/indent.texi
+++ b/doc/emacs/indent.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985--1987, 1993--1995, 1997, 2001--2020 Free Software
+@c Copyright (C) 1985--1987, 1993--1995, 1997, 2001--2021 Free Software
@c Foundation, Inc.
@c See file emacs.texi for copying conditions.
@node Indentation
@@ -255,7 +255,7 @@ indentation; otherwise, it inserts a tab character.
indent can be further customized via the @code{tab-first-completion}
variable. For instance, if that variable is @code{eol}, only complete
if point is at the end of a line. @xref{Mode-Specific Indent,,,
-elisp, The Emacs Lisp Reference Manual} for further details.
+elisp, The Emacs Lisp Reference Manual}, for further details.
@cindex Electric Indent mode
@cindex mode, Electric Indent
diff --git a/doc/emacs/killing.texi b/doc/emacs/killing.texi
index bd7dbb6f515..9bc786dc47b 100644
--- a/doc/emacs/killing.texi
+++ b/doc/emacs/killing.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985--1987, 1993--1995, 1997, 2000--2020 Free Software
+@c Copyright (C) 1985--1987, 1993--1995, 1997, 2000--2021 Free Software
@c Foundation, Inc.
@c See file emacs.texi for copying conditions.
@@ -362,7 +362,7 @@ through the possibilities.
that was yanked and replaces it with the text from an earlier kill.
So, to recover the text of the next-to-the-last kill, first use
@kbd{C-y} to yank the last kill, and then use @kbd{M-y} to replace it
-with the previous kill. @kbd{M-y} is allowed only after a @kbd{C-y}
+with the previous kill. This works only after a @kbd{C-y}
or another @kbd{M-y}.
You can understand @kbd{M-y} in terms of a last-yank pointer which
@@ -394,6 +394,15 @@ pointer remains at the same place in the kill ring, so repeating
When you call @kbd{C-y} with a numeric argument, that also sets the
last-yank pointer to the entry that it yanks.
+ Alternatively, when the previous command was not a yank command,
+@kbd{M-y} activates the minibuffer where you can browse previous kills
+using the minibuffer history commands (@pxref{Minibuffer History}), or
+you can use completion commands (@pxref{Completion}) on a list of
+previously killed blocks of text from the kill ring. Exiting the
+minibuffer will insert the selected text to the buffer. With a plain
+prefix argument (@kbd{C-u M-y}), this command leaves the cursor in
+front of the inserted text, and sets the mark at the end.
+
@node Appending Kills
@subsection Appending Kills
diff --git a/doc/emacs/kmacro.texi b/doc/emacs/kmacro.texi
index 7b1d365ff04..adb2ab8d561 100644
--- a/doc/emacs/kmacro.texi
+++ b/doc/emacs/kmacro.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985--1987, 1993--1995, 1997, 2000--2020 Free Software
+@c Copyright (C) 1985--1987, 1993--1995, 1997, 2000--2021 Free Software
@c Foundation, Inc.
@c See file emacs.texi for copying conditions.
@node Keyboard Macros
diff --git a/doc/emacs/m-x.texi b/doc/emacs/m-x.texi
index b18c334acf4..865220fb218 100644
--- a/doc/emacs/m-x.texi
+++ b/doc/emacs/m-x.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985--1987, 1993--1995, 1997, 2001--2020 Free Software
+@c Copyright (C) 1985--1987, 1993--1995, 1997, 2001--2021 Free Software
@c Foundation, Inc.
@c See file emacs.texi for copying conditions.
@node M-x
diff --git a/doc/emacs/macos.texi b/doc/emacs/macos.texi
index 00daa8b35d3..cd1db1a7bab 100644
--- a/doc/emacs/macos.texi
+++ b/doc/emacs/macos.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 2000--2020 Free Software Foundation, Inc.
+@c Copyright (C) 2000--2021 Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
@node Mac OS / GNUstep
@appendix Emacs and macOS / GNUstep
diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi
index 1f10b68b8a7..415815473e5 100644
--- a/doc/emacs/maintaining.texi
+++ b/doc/emacs/maintaining.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual., Abbrevs, This is part of the Emacs manual., Top
-@c Copyright (C) 1985--1987, 1993--1995, 1997, 1999--2020 Free Software
+@c Copyright (C) 1985--1987, 1993--1995, 1997, 1999--2021 Free Software
@c Foundation, Inc.
@c See file emacs.texi for copying conditions.
@node Maintaining
@@ -2199,12 +2199,22 @@ Display the reference on the current line.
Move to the next reference and display it in the other window
(@code{xref-next-line}).
+@item N
+@findex xref-next-group
+Move to the first reference of the next reference group and display it
+in the other window (@code{xref-next-group}).
+
@item p
@itemx ,
@findex xref-prev-line
Move to the previous reference and display it in the other window
(@code{xref-prev-line}).
+@item P
+@findex xref-prev-group
+Move to the first reference of the previous reference group and
+display it in the other window (@code{xref-prev-group}).
+
@item C-o
@findex xref-show-location-at-point
Display the reference on the current line in the other window
diff --git a/doc/emacs/mark.texi b/doc/emacs/mark.texi
index 97aeed896a0..20cb8ee2c65 100644
--- a/doc/emacs/mark.texi
+++ b/doc/emacs/mark.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985--1987, 1993--1995, 1997, 2001--2020 Free Software
+@c Copyright (C) 1985--1987, 1993--1995, 1997, 2001--2021 Free Software
@c Foundation, Inc.
@c See file emacs.texi for copying conditions.
@node Mark
diff --git a/doc/emacs/mini.texi b/doc/emacs/mini.texi
index 54f046a7e05..f81e64bdf9b 100644
--- a/doc/emacs/mini.texi
+++ b/doc/emacs/mini.texi
@@ -1,6 +1,6 @@
@c -*- coding: utf-8 -*-
@c This is part of the Emacs manual.
-@c Copyright (C) 1985--1987, 1993--1995, 1997, 2000--2020 Free Software
+@c Copyright (C) 1985--1987, 1993--1995, 1997, 2000--2021 Free Software
@c Foundation, Inc.
@c See file emacs.texi for copying conditions.
@node Minibuffer
@@ -69,6 +69,21 @@ the minibuffer for a few seconds, or until you type something; then
the minibuffer comes back. While the minibuffer is in use, Emacs does
not echo keystrokes.
+@vindex minibuffer-follows-selected-frame
+ While using the minibuffer, you can switch to a different frame,
+perhaps to note text you need to enter (@pxref{Frame Commands}). By
+default, the active minibuffer moves to this new frame. If you set
+the user option @code{minibuffer-follows-selected-frame} to
+@code{nil}, then the minibuffer stays in the frame where you opened
+it, and you must switch back to that frame in order to complete (or
+abort) the current command. If you set that option to a value which
+is neither @code{nil} nor @code{t}, the minibuffer moves frame only
+after a recursive minibuffer has been opened in the current command
+(@pxref{Recursive Mini,,, elisp}). This option is mainly to retain
+(approximately) the behavior prior to Emacs 28.1. Note that the
+effect of the command, when you finally finish using the minibuffer,
+always takes place in the frame where you first opened it.
+
@node Minibuffer File
@section Minibuffers for File Names
diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi
index 4865ee17518..fbb8122a1b8 100644
--- a/doc/emacs/misc.texi
+++ b/doc/emacs/misc.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985--1987, 1993--1995, 1997, 2000--2020 Free Software
+@c Copyright (C) 1985--1987, 1993--1995, 1997, 2000--2021 Free Software
@c Foundation, Inc.
@c See file emacs.texi for copying conditions.
@iftex
@@ -810,6 +810,7 @@ to @command{gpg}. This will output the list of keys to the
buffer whose name is the value of @code{shell-command-buffer-name}.
@vindex shell-file-name
+@cindex @env{SHELL} environment variable
The above commands use the shell specified by the variable
@code{shell-file-name}. Its default value is determined by the
@env{SHELL} environment variable when Emacs is started. If the file
@@ -889,7 +890,6 @@ Subshells in different buffers run independently and in parallel.
@vindex explicit-shell-file-name
@cindex environment variables for subshells
@cindex @env{ESHELL} environment variable
-@cindex @env{SHELL} environment variable
To specify the shell file name used by @kbd{M-x shell}, customize
the variable @code{explicit-shell-file-name}. If this is @code{nil}
(the default), Emacs uses the environment variable @env{ESHELL} if it
@@ -1709,6 +1709,7 @@ connections. A setup to use this functionality could be:
@example
[Socket]
ListenStream=/path/to/.emacs.socket
+DirectoryMode=0700
[Install]
WantedBy=sockets.target
@@ -1893,6 +1894,12 @@ with @kbd{C-x #}. But @kbd{C-x #} is the way to tell
window or a frame, @kbd{C-x #} always displays the next server buffer
in that window or in that frame.
+@vindex server-client-instructions
+ When @command{emacsclient} connects, the server will normally output
+a message that says how to exit the client frame. If
+@code{server-client-instructions} is set to @code{nil}, this message
+is inhibited.
+
@node emacsclient Options
@subsection @code{emacsclient} Options
@cindex @code{emacsclient} options
@@ -2255,13 +2262,18 @@ off.
@vindex ps-print-color-p
If your printer doesn't support colors, you should turn off color
processing by setting @code{ps-print-color-p} to @code{nil}. By
-default, if the display supports colors, Emacs produces hardcopy output
-with color information; on black-and-white printers, colors are emulated
-with shades of gray. This might produce illegible output, even if your
-screen colors only use shades of gray.
-
- Alternatively, you can set @code{ps-print-color-p} to @code{black-white} to
-print colors on black/white printers.
+default, if the display supports colors, Emacs produces hardcopy
+output with color information; on black-and-white printers, colors are
+emulated with shades of gray. This might produce barely-readable or
+even illegible output, even if your screen colors only use shades of
+gray.
+
+@vindex ps-black-white-faces
+ Alternatively, you can set @code{ps-print-color-p} to @code{black-white}
+to have colors display better on black/white printers. This works by
+using information in @code{ps-black-white-faces} to express colors by
+customizable list of shades of gray, augmented by bold and italic
+face attributes.
@vindex ps-use-face-background
By default, PostScript printing ignores the background colors of the
diff --git a/doc/emacs/modes.texi b/doc/emacs/modes.texi
index c9c175d51e8..cc25d3e1e33 100644
--- a/doc/emacs/modes.texi
+++ b/doc/emacs/modes.texi
@@ -1,6 +1,6 @@
@c -*- coding: utf-8 -*-
@c This is part of the Emacs manual.
-@c Copyright (C) 1985--1987, 1993--1995, 1997, 2000--2020 Free Software
+@c Copyright (C) 1985--1987, 1993--1995, 1997, 2000--2021 Free Software
@c Foundation, Inc.
@c See file emacs.texi for copying conditions.
@node Modes
diff --git a/doc/emacs/msdos-xtra.texi b/doc/emacs/msdos-xtra.texi
index 045ac6c4605..fce6ae46f81 100644
--- a/doc/emacs/msdos-xtra.texi
+++ b/doc/emacs/msdos-xtra.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 2004--2020 Free Software Foundation, Inc.
+@c Copyright (C) 2004--2021 Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
@c
@c This file is included either in emacs-xtra.texi (when producing the
diff --git a/doc/emacs/msdos.texi b/doc/emacs/msdos.texi
index 48492ab2f22..4b58f6aa2f7 100644
--- a/doc/emacs/msdos.texi
+++ b/doc/emacs/msdos.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985--1987, 1993--1995, 1997, 2000--2020 Free Software
+@c Copyright (C) 1985--1987, 1993--1995, 1997, 2000--2021 Free Software
@c Foundation, Inc.
@c See file emacs.texi for copying conditions.
@node Microsoft Windows
diff --git a/doc/emacs/mule.texi b/doc/emacs/mule.texi
index b78019020a6..922eec7426e 100644
--- a/doc/emacs/mule.texi
+++ b/doc/emacs/mule.texi
@@ -1,6 +1,6 @@
@c -*- coding: utf-8 -*-
@c This is part of the Emacs manual.
-@c Copyright (C) 1997, 1999--2020 Free Software Foundation, Inc.
+@c Copyright (C) 1997, 1999--2021 Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
@node International
@chapter International Character Set Support
@@ -563,6 +563,12 @@ method's keys by defining key bindings in the keymap returned by the
function @code{quail-translation-keymap}, using @code{define-key}.
@xref{Init Rebinding}.
+ Input methods are inhibited when the text in the buffer is read-only
+for some reason. This is so single-character key bindings work in
+modes that make buffer text or parts of it read-only, such as
+@code{read-only-mode} and @code{image-mode}, even when an input method
+is active.
+
Another facility for typing characters not on your keyboard is by
using @kbd{C-x 8 @key{RET}} (@code{insert-char}) to insert a single
character based on its Unicode name or code-point; see @ref{Inserting
@@ -578,6 +584,11 @@ Enable or disable use of the selected input method (@code{toggle-input-method}).
@item C-x @key{RET} C-\ @var{method} @key{RET}
Select a new input method for the current buffer (@code{set-input-method}).
+@item C-x \ @var{method} @key{RET}
+Temporarily enable the selected transient input method ; it will be
+automatically disabled after inserting a single character
+(@code{activate-transient-input-method}).
+
@item C-h I @var{method} @key{RET}
@itemx C-h C-\ @var{method} @key{RET}
@findex describe-input-method
@@ -675,6 +686,21 @@ character.
input methods. The list gives information about each input method,
including the string that stands for it in the mode line.
+@findex activate-transient-input-method
+@kindex C-x \
+@anchor{transient input method}
+ Sometimes it can be convenient to enable an input method
+@dfn{transiently}, for inserting only a single character. Typing
+@kbd{C-x \} (@code{activate-transient-input-method}) will temporarily
+enable an input method, let you insert a single character using the input
+method rules, and then automatically disable the input method. If no
+transient input method was selected yet, @kbd{C-x \} will prompt you
+for an input method; subsequent invocations of this command will
+enable the selected transient input method. To select a different
+transient input method, type @kbd{C-u C-x \}. You can select a
+transient method that is different from the input method which you
+selected using @kbd{C-u C-\}.
+
@node Coding Systems
@section Coding Systems
@cindex coding systems
diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi
index 56e8ee1363a..038a31a35b9 100644
--- a/doc/emacs/package.texi
+++ b/doc/emacs/package.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985--1987, 1993--1995, 1997, 2000--2020 Free Software
+@c Copyright (C) 1985--1987, 1993--1995, 1997, 2000--2021 Free Software
@c Foundation, Inc.
@c See file emacs.texi for copying conditions.
@node Packages
@@ -187,6 +187,14 @@ Filter package list by archive (@code{package-menu-filter-by-archive}).
This prompts for a package archive (e.g., @samp{gnu}), then shows only
packages from that archive.
+@item / d
+@kindex / d @r{(Package Menu)}
+@findex package-menu-filter-by-description
+Filter package list by description
+(@code{package-menu-filter-by-description}). This prompts for a
+regular expression, then shows only packages with descriptions
+matching that regexp.
+
@item / k
@kindex / k @r{(Package Menu)}
@findex package-menu-filter-by-keyword
@@ -194,6 +202,14 @@ Filter package list by keyword (@code{package-menu-filter-by-keyword}).
This prompts for a keyword (e.g., @samp{games}), then shows only
packages with that keyword.
+@item / N
+@kindex / N @r{(Package Menu)}
+@findex package-menu-filter-by-name-or-description
+Filter package list by name or description
+(@code{package-menu-filter-by-name-or-description}). This prompts for
+a regular expression, then shows only packages with a name or
+description matching that regexp.
+
@item / n
@kindex / n @r{(Package Menu)}
@findex package-menu-filter-by-name
diff --git a/doc/emacs/picture-xtra.texi b/doc/emacs/picture-xtra.texi
index 9decda30daa..a04b72d38d3 100644
--- a/doc/emacs/picture-xtra.texi
+++ b/doc/emacs/picture-xtra.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 2004--2020 Free Software Foundation, Inc.
+@c Copyright (C) 2004--2021 Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
@c
@c This file is included either in emacs-xtra.texi (when producing the
diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi
index f0dd62dad45..fe3ee57ac0a 100644
--- a/doc/emacs/programs.texi
+++ b/doc/emacs/programs.texi
@@ -1,6 +1,6 @@
@c -*- coding: utf-8 -*-
@c This is part of the Emacs manual.
-@c Copyright (C) 1985--1987, 1993--1995, 1997, 1999--2020 Free Software
+@c Copyright (C) 1985--1987, 1993--1995, 1997, 1999--2021 Free Software
@c Foundation, Inc.
@c See file emacs.texi for copying conditions.
@node Programs
diff --git a/doc/emacs/regs.texi b/doc/emacs/regs.texi
index d1b9ea8f679..59fa0ff0a1c 100644
--- a/doc/emacs/regs.texi
+++ b/doc/emacs/regs.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985--1987, 1993--1995, 1997, 2001--2020 Free Software
+@c Copyright (C) 1985--1987, 1993--1995, 1997, 2001--2021 Free Software
@c Foundation, Inc.
@c See file emacs.texi for copying conditions.
@node Registers
diff --git a/doc/emacs/rmail.texi b/doc/emacs/rmail.texi
index 14ee062b6cf..e7ca2ae48bd 100644
--- a/doc/emacs/rmail.texi
+++ b/doc/emacs/rmail.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985--1987, 1993--1995, 1997, 2001--2020 Free Software
+@c Copyright (C) 1985--1987, 1993--1995, 1997, 2001--2021 Free Software
@c Foundation, Inc.
@c See file emacs.texi for copying conditions.
@node Rmail
@@ -1273,9 +1273,9 @@ temporary buffer to display the current @acronym{MIME} message.
@findex rmail-epa-decrypt
@cindex encrypted mails (reading in Rmail)
- If the current message is an encrypted one, use the command @kbd{M-x
-rmail-epa-decrypt} to decrypt it, using the EasyPG library
-(@pxref{Top,, EasyPG, epa, EasyPG Assistant User's Manual}).
+ If the current message is an encrypted one, use the command
+@kbd{C-c C-d} (@code{rmail-epa-decrypt}) to decrypt it, using the
+EasyPG library (@pxref{Top,, EasyPG, epa, EasyPG Assistant User's Manual}).
You can highlight and activate URLs in the Rmail buffer using Goto
Address mode:
@@ -1591,6 +1591,14 @@ value is used.
Otherwise, Rmail will ask you for the password to use.
@end enumerate
+On some mail servers the usernames include domain information, which
+can mean they contain the @samp{@@} character. The inbox specifier
+string uses @samp{@@} to signal the start of the mailserver name.
+This creates confusion for movemail. If your username contains
+@samp{@@} and you're using Mailutils @command{movemail} then you can
+fix this: Replace @code{@@} in the user name with its @acronym{URL}
+encoding @samp{%40}.
+
@vindex rmail-movemail-flags
If you need to pass additional command-line flags to @command{movemail},
set the variable @code{rmail-movemail-flags} a list of the flags you
diff --git a/doc/emacs/screen.texi b/doc/emacs/screen.texi
index 5c5a5da5511..2ff808e0400 100644
--- a/doc/emacs/screen.texi
+++ b/doc/emacs/screen.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985--1987, 1993--1995, 1997, 2001--2020 Free Software
+@c Copyright (C) 1985--1987, 1993--1995, 1997, 2001--2021 Free Software
@c Foundation, Inc.
@c See file emacs.texi for copying conditions.
@node Screen
diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi
index 91b433f1738..637867b8115 100644
--- a/doc/emacs/search.texi
+++ b/doc/emacs/search.texi
@@ -1,6 +1,6 @@
@c -*- coding: utf-8 -*-
@c This is part of the Emacs manual.
-@c Copyright (C) 1985--1987, 1993--1995, 1997, 2000--2020 Free Software
+@c Copyright (C) 1985--1987, 1993--1995, 1997, 2000--2021 Free Software
@c Foundation, Inc.
@c See file emacs.texi for copying conditions.
@node Search
@@ -295,9 +295,12 @@ from point to the @var{n}th occurrence of the specified character.
appends the current kill to the search string. @kbd{M-y}
(@code{isearch-yank-pop}), if called after @kbd{C-y}, replaces that
appended text with an earlier kill, similar to the usual @kbd{M-y}
-(@code{yank-pop}) command (@pxref{Yanking}). Clicking @kbd{mouse-2}
-in the echo area appends the current X selection (@pxref{Primary
-Selection}) to the search string (@code{isearch-yank-x-selection}).
+(@code{yank-pop}) command. When @kbd{M-y} is called not after
+@kbd{C-y}, then it activates the minibuffer where you can select
+a previous kill to append to the search string (@pxref{Earlier
+Kills}). Clicking @kbd{mouse-2} in the echo area appends the current
+X selection (@pxref{Primary Selection}) to the search string
+(@code{isearch-yank-x-selection}).
@kindex C-M-d @r{(Incremental search)}
@kindex C-M-y @r{(Incremental search)}
@@ -419,6 +422,7 @@ character into the search string, similar to the usual
@kindex C-^ @r{(Incremental Search)}
@findex isearch-toggle-input-method
@findex isearch-toggle-specified-input-method
+@findex isearch-transient-input-method
Use an input method (@pxref{Input Methods}). If an input method is
enabled in the current buffer when you start the search, the same
method will be active in the minibuffer when you type the search
@@ -437,7 +441,11 @@ I-search [@var{im}]:
@noindent
where @var{im} is the mnemonic of the active input method. Any input
method you enable during incremental search remains enabled in the
-current buffer afterwards.
+current buffer afterwards. Finally, you can temporarily enable a
+transient input method (@pxref{transient input method}) with
+@kbd{C-x \} (@code{isearch-transient-input-method}) to insert a single
+character to the search string using an input method, and
+automatically disable the input method afterwards.
@end itemize
@kindex M-s o @r{(Incremental Search)}
@@ -1763,6 +1771,7 @@ occurrence of @var{string}. When done, exit the recursive editing level
with @kbd{C-M-c} to proceed to the next occurrence.
@item e
+@itemx E
to edit the replacement string in the minibuffer. When you exit the
minibuffer by typing @key{RET}, the minibuffer contents replace the
current occurrence of the pattern. They also become the new
diff --git a/doc/emacs/sending.texi b/doc/emacs/sending.texi
index e3f9fbec071..174e52ac9a8 100644
--- a/doc/emacs/sending.texi
+++ b/doc/emacs/sending.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985--1987, 1993--1995, 1997, 2000--2020 Free Software
+@c Copyright (C) 1985--1987, 1993--1995, 1997, 2000--2021 Free Software
@c Foundation, Inc.
@c See file emacs.texi for copying conditions.
@node Sending Mail
diff --git a/doc/emacs/text.texi b/doc/emacs/text.texi
index c77dcf7fbce..54e16698a74 100644
--- a/doc/emacs/text.texi
+++ b/doc/emacs/text.texi
@@ -1,6 +1,6 @@
@c -*- coding: utf-8 -*-
@c This is part of the Emacs manual.
-@c Copyright (C) 1985--1987, 1993--1995, 1997, 2000--2020 Free Software
+@c Copyright (C) 1985--1987, 1993--1995, 1997, 2000--2021 Free Software
@c Foundation, Inc.
@c See file emacs.texi for copying conditions.
@node Text
diff --git a/doc/emacs/trouble.texi b/doc/emacs/trouble.texi
index dbd1a075573..9a638818c91 100644
--- a/doc/emacs/trouble.texi
+++ b/doc/emacs/trouble.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985--1987, 1993--1995, 1997, 2001--2020 Free Software
+@c Copyright (C) 1985--1987, 1993--1995, 1997, 2001--2021 Free Software
@c Foundation, Inc.
@c See file emacs.texi for copying conditions.
@iftex
@@ -57,6 +57,13 @@ incremental search, @kbd{C-g} behaves specially; it may take two
successive @kbd{C-g} characters to get out of a search.
@xref{Incremental Search}, for details.
+ If you type @kbd{C-g} in a minibuffer, this quits the command that
+opened that minibuffer, closing it. If that minibuffer is not the
+most recently opened one (which can happen when
+@code{minibuffer-follows-selected-frame} is @code{nil} (@pxref{Basic
+Minibuffer})), @kbd{C-g} also closes the more recently opened ones,
+quitting their associated commands, after asking you for confirmation.
+
On MS-DOS, the character @kbd{C-@key{Break}} serves as a quit character
like @kbd{C-g}. The reason is that it is not feasible, on MS-DOS, to
recognize @kbd{C-g} while a command is running, between interactions
diff --git a/doc/emacs/vc-xtra.texi b/doc/emacs/vc-xtra.texi
index 37804242eaf..51b9d667784 100644
--- a/doc/emacs/vc-xtra.texi
+++ b/doc/emacs/vc-xtra.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 2004--2020 Free Software Foundation, Inc.
+@c Copyright (C) 2004--2021 Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
@c
@c This file is included in emacs-xtra.texi when producing the printed
diff --git a/doc/emacs/vc1-xtra.texi b/doc/emacs/vc1-xtra.texi
index 26199924d58..4cd00cba6c3 100644
--- a/doc/emacs/vc1-xtra.texi
+++ b/doc/emacs/vc1-xtra.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 2004--2020 Free Software Foundation, Inc.
+@c Copyright (C) 2004--2021 Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
@c
@c This file is included either in vc-xtra.texi (when producing the
diff --git a/doc/emacs/windows.texi b/doc/emacs/windows.texi
index bc1dcd7f419..e851f1b1b58 100644
--- a/doc/emacs/windows.texi
+++ b/doc/emacs/windows.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985--1987, 1993--1995, 1997, 2000--2020 Free Software
+@c Copyright (C) 1985--1987, 1993--1995, 1997, 2000--2021 Free Software
@c Foundation, Inc.
@c See file emacs.texi for copying conditions.
@node Windows
@@ -589,7 +589,7 @@ buffer. @xref{Follow Mode}.
@findex windmove-default-keybindings
@findex windmove-display-default-keybindings
@findex windmove-delete-default-keybindings
-@findex windmove-swap-states-in-direction
+@findex windmove-swap-states-default-keybindings
The Windmove package defines commands for moving directionally
between neighboring windows in a frame. @kbd{M-x windmove-right}
selects the window immediately to the right of the currently selected
@@ -603,7 +603,7 @@ keybindings for commands that specify in what direction to display the
window for the buffer that the next command is going to display.
Also there is @w{@kbd{M-x windmove-delete-default-keybindings}} to
define keybindings for commands that delete windows directionally, and
-@w{@kbd{M-x windmove-swap-states-in-direction}} that define
+@w{@kbd{M-x windmove-swap-states-default-keybindings}} that defines
keybindings for commands that swap the window contents of the selected
window with the window in the specified direction.
diff --git a/doc/emacs/xresources.texi b/doc/emacs/xresources.texi
index 730cf304e2b..00fa6c0aa31 100644
--- a/doc/emacs/xresources.texi
+++ b/doc/emacs/xresources.texi
@@ -1,5 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1987, 1993--1995, 1997, 2001--2020 Free Software
+@c Copyright (C) 1987, 1993--1995, 1997, 2001--2021 Free Software
@c Foundation, Inc.
@c See file emacs.texi for copying conditions.
@node X Resources
diff --git a/doc/lispintro/ChangeLog.1 b/doc/lispintro/ChangeLog.1
index 75f5872dc3c..bb4323a7734 100644
--- a/doc/lispintro/ChangeLog.1
+++ b/doc/lispintro/ChangeLog.1
@@ -782,7 +782,7 @@
;; coding: utf-8
;; End:
- Copyright (C) 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/doc/lispintro/Makefile.in b/doc/lispintro/Makefile.in
index 7a2b6f0a580..d8b909c9c10 100644
--- a/doc/lispintro/Makefile.in
+++ b/doc/lispintro/Makefile.in
@@ -1,6 +1,6 @@
### @configure_input@
-# Copyright (C) 1994-1999, 2001-2020 Free Software Foundation, Inc.
+# Copyright (C) 1994-1999, 2001-2021 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
diff --git a/doc/lispintro/README b/doc/lispintro/README
index 6361f5a65ce..eca19c76a42 100644
--- a/doc/lispintro/README
+++ b/doc/lispintro/README
@@ -1,4 +1,4 @@
-Copyright (C) 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 2001-2021 Free Software Foundation, Inc.
See the end of the file for license conditions.
diff --git a/doc/lispintro/cons-1.eps b/doc/lispintro/cons-1.eps
index c5d414c7589..4877df7135e 100644
--- a/doc/lispintro/cons-1.eps
+++ b/doc/lispintro/cons-1.eps
@@ -4,7 +4,7 @@
%%CreationDate: Wed Mar 8 14:26:58 1995
%%Creator: Tgif-2.16-p4 by William Chia-Wei Cheng (william@cs.UCLA.edu)
-% Copyright (C) 1995, 1997, 2001-2020 Free Software Foundation, Inc.
+% Copyright (C) 1995, 1997, 2001-2021 Free Software Foundation, Inc.
%
% This file is part of GNU Emacs.
%
diff --git a/doc/lispintro/cons-2.eps b/doc/lispintro/cons-2.eps
index f6d97c7cc09..48fdc7e8768 100644
--- a/doc/lispintro/cons-2.eps
+++ b/doc/lispintro/cons-2.eps
@@ -4,7 +4,7 @@
%%CreationDate: Wed Mar 8 14:26:39 1995
%%Creator: Tgif-2.16-p4 by William Chia-Wei Cheng (william@cs.UCLA.edu)
-% Copyright (C) 1995, 1997, 2001-2020 Free Software Foundation, Inc.
+% Copyright (C) 1995, 1997, 2001-2021 Free Software Foundation, Inc.
%
% This file is part of GNU Emacs.
%
diff --git a/doc/lispintro/cons-2a.eps b/doc/lispintro/cons-2a.eps
index 57b96eba163..81053d3f26c 100644
--- a/doc/lispintro/cons-2a.eps
+++ b/doc/lispintro/cons-2a.eps
@@ -4,7 +4,7 @@
%%CreationDate: Tue Mar 14 15:09:30 1995
%%Creator: Tgif-2.16-p4 by William Chia-Wei Cheng (william@cs.UCLA.edu)
-% Copyright (C) 1995, 1997, 2001-2020 Free Software Foundation, Inc.
+% Copyright (C) 1995, 1997, 2001-2021 Free Software Foundation, Inc.
%
% This file is part of GNU Emacs.
%
diff --git a/doc/lispintro/cons-3.eps b/doc/lispintro/cons-3.eps
index e51c2c4008b..e6a80f1c8ba 100644
--- a/doc/lispintro/cons-3.eps
+++ b/doc/lispintro/cons-3.eps
@@ -4,7 +4,7 @@
%%CreationDate: Wed Mar 8 14:25:41 1995
%%Creator: Tgif-2.16-p4 by William Chia-Wei Cheng (william@cs.UCLA.edu)
-% Copyright (C) 1995, 1997, 2001-2020 Free Software Foundation, Inc.
+% Copyright (C) 1995, 1997, 2001-2021 Free Software Foundation, Inc.
%
% This file is part of GNU Emacs.
%
diff --git a/doc/lispintro/cons-4.eps b/doc/lispintro/cons-4.eps
index 1cbf44fab02..c1aac9c09bc 100644
--- a/doc/lispintro/cons-4.eps
+++ b/doc/lispintro/cons-4.eps
@@ -4,7 +4,7 @@
%%CreationDate: Wed Mar 8 14:25:06 1995
%%Creator: Tgif-2.16-p4 by William Chia-Wei Cheng (william@cs.UCLA.edu)
-% Copyright (C) 1995, 1997, 2001-2020 Free Software Foundation, Inc.
+% Copyright (C) 1995, 1997, 2001-2021 Free Software Foundation, Inc.
%
% This file is part of GNU Emacs.
%
diff --git a/doc/lispintro/cons-5.eps b/doc/lispintro/cons-5.eps
index 85a553bcbce..a0918a92c53 100644
--- a/doc/lispintro/cons-5.eps
+++ b/doc/lispintro/cons-5.eps
@@ -4,7 +4,7 @@
%%CreationDate: Wed Mar 8 14:27:28 1995
%%Creator: Tgif-2.16-p4 by William Chia-Wei Cheng (william@cs.UCLA.edu)
-% Copyright (C) 1995, 1997, 2001-2020 Free Software Foundation, Inc.
+% Copyright (C) 1995, 1997, 2001-2021 Free Software Foundation, Inc.
%
% This file is part of GNU Emacs.
%
diff --git a/doc/lispintro/drawers.eps b/doc/lispintro/drawers.eps
index b71bdb82aee..725bd9723ce 100644
--- a/doc/lispintro/drawers.eps
+++ b/doc/lispintro/drawers.eps
@@ -9,7 +9,7 @@
%%EndComments
%%BeginProlog
-% Copyright (C) 2001-2020 Free Software Foundation, Inc.
+% Copyright (C) 2001-2021 Free Software Foundation, Inc.
%
% This file is part of GNU Emacs.
%
diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi
index b13b16285c7..d5c280b7924 100644
--- a/doc/lispintro/emacs-lisp-intro.texi
+++ b/doc/lispintro/emacs-lisp-intro.texi
@@ -117,7 +117,7 @@ Edition @value{edition-number}, @value{update-date}
@sp 1
Distributed with Emacs version @value{EMACSVER}.
@sp 1
-Copyright @copyright{} 1990--1995, 1997, 2001--2020 Free Software
+Copyright @copyright{} 1990--1995, 1997, 2001--2021 Free Software
Foundation, Inc.
@sp 1
diff --git a/doc/lispintro/lambda-1.eps b/doc/lispintro/lambda-1.eps
index 08bd6007b79..43b2d08aedc 100644
--- a/doc/lispintro/lambda-1.eps
+++ b/doc/lispintro/lambda-1.eps
@@ -4,7 +4,7 @@
%%CreationDate: Wed Mar 8 14:31:53 1995
%%Creator: Tgif-2.16-p4 by William Chia-Wei Cheng (william@cs.UCLA.edu)
-% Copyright (C) 1995, 1997, 2001-2020 Free Software Foundation, Inc.
+% Copyright (C) 1995, 1997, 2001-2021 Free Software Foundation, Inc.
%
% This file is part of GNU Emacs.
%
diff --git a/doc/lispintro/lambda-2.eps b/doc/lispintro/lambda-2.eps
index 6ccf9993e33..c6c71f2b776 100644
--- a/doc/lispintro/lambda-2.eps
+++ b/doc/lispintro/lambda-2.eps
@@ -4,7 +4,7 @@
%%CreationDate: Wed Mar 8 14:33:09 1995
%%Creator: Tgif-2.16-p4 by William Chia-Wei Cheng (william@cs.UCLA.edu)
-% Copyright (C) 1995, 1997, 2001-2020 Free Software Foundation, Inc.
+% Copyright (C) 1995, 1997, 2001-2021 Free Software Foundation, Inc.
%
% This file is part of GNU Emacs.
%
diff --git a/doc/lispintro/lambda-3.eps b/doc/lispintro/lambda-3.eps
index aac0392c4ba..ae939d537f4 100644
--- a/doc/lispintro/lambda-3.eps
+++ b/doc/lispintro/lambda-3.eps
@@ -4,7 +4,7 @@
%%CreationDate: Wed Mar 8 14:33:49 1995
%%Creator: Tgif-2.16-p4 by William Chia-Wei Cheng (william@cs.UCLA.edu)
-% Copyright (C) 1995, 1997, 2001-2020 Free Software Foundation, Inc.
+% Copyright (C) 1995, 1997, 2001-2021 Free Software Foundation, Inc.
%
% This file is part of GNU Emacs.
%
diff --git a/doc/lispref/ChangeLog.1 b/doc/lispref/ChangeLog.1
index 8d92a943d57..bd7a9c4e793 100644
--- a/doc/lispref/ChangeLog.1
+++ b/doc/lispref/ChangeLog.1
@@ -13989,7 +13989,7 @@
;; coding: utf-8
;; End:
- Copyright (C) 1998-2020 Free Software Foundation, Inc.
+ Copyright (C) 1998-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/doc/lispref/Makefile.in b/doc/lispref/Makefile.in
index bd650091116..271f06edddc 100644
--- a/doc/lispref/Makefile.in
+++ b/doc/lispref/Makefile.in
@@ -1,6 +1,6 @@
### @configure_input@
-# Copyright (C) 1990-1996, 1998-2020 Free Software Foundation, Inc.
+# Copyright (C) 1990-1996, 1998-2021 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
diff --git a/doc/lispref/README b/doc/lispref/README
index ac0c2b554eb..9b998371303 100644
--- a/doc/lispref/README
+++ b/doc/lispref/README
@@ -1,4 +1,4 @@
-Copyright (C) 2001-2020 Free Software Foundation, Inc. -*- outline -*-
+Copyright (C) 2001-2021 Free Software Foundation, Inc. -*- outline -*-
See the end of the file for license conditions.
diff --git a/doc/lispref/abbrevs.texi b/doc/lispref/abbrevs.texi
index 575be187d3f..71fac1ae3b6 100644
--- a/doc/lispref/abbrevs.texi
+++ b/doc/lispref/abbrevs.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990--1994, 1999, 2001--2020 Free Software Foundation,
+@c Copyright (C) 1990--1994, 1999, 2001--2021 Free Software Foundation,
@c Inc.
@c See the file elisp.texi for copying conditions.
@node Abbrevs
diff --git a/doc/lispref/anti.texi b/doc/lispref/anti.texi
index a134e883588..ced8082f6a4 100644
--- a/doc/lispref/anti.texi
+++ b/doc/lispref/anti.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1999, 2002--2020 Free Software Foundation, Inc.
+@c Copyright (C) 1999, 2002--2021 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@c This node must have no pointers.
diff --git a/doc/lispref/back.texi b/doc/lispref/back.texi
index 817249ee01a..c238863833d 100644
--- a/doc/lispref/back.texi
+++ b/doc/lispref/back.texi
@@ -1,6 +1,6 @@
\input texinfo @c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 2001--2020 Free Software Foundation, Inc.
+@c Copyright (C) 2001--2021 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@c
@c %**start of header
diff --git a/doc/lispref/backups.texi b/doc/lispref/backups.texi
index 379279575ca..c0a4065bdbf 100644
--- a/doc/lispref/backups.texi
+++ b/doc/lispref/backups.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990--1995, 1999, 2001--2020 Free Software Foundation,
+@c Copyright (C) 1990--1995, 1999, 2001--2021 Free Software Foundation,
@c Inc.
@c See the file elisp.texi for copying conditions.
@node Backups and Auto-Saving
@@ -706,7 +706,11 @@ contents and the file contents are identical before the revert
operation, reverting preserves all the markers. If they are not
identical, reverting does change the buffer; in that case, it preserves
the markers in the unchanged text (if any) at the beginning and end of
-the buffer. Preserving any additional markers would be problematical.
+the buffer. Preserving any additional markers would be problematic.
+
+When reverting from non-file sources, markers are usually not
+preserved, but this is up to the specific @code{revert-buffer-function}
+implementation.
@end deffn
@defvar revert-buffer-in-progress-p
diff --git a/doc/lispref/buffers.texi b/doc/lispref/buffers.texi
index 28603436284..69733f91c4a 100644
--- a/doc/lispref/buffers.texi
+++ b/doc/lispref/buffers.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990--1995, 1998--1999, 2001--2020 Free Software
+@c Copyright (C) 1990--1995, 1998--1999, 2001--2021 Free Software
@c Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@node Buffers
@@ -225,13 +225,22 @@ current buffer is restored even in case of an abnormal exit via
@defmac with-temp-buffer body@dots{}
@anchor{Definition of with-temp-buffer}
-The @code{with-temp-buffer} macro evaluates the @var{body} forms
-with a temporary buffer as the current buffer. It saves the identity of
+The @code{with-temp-buffer} macro evaluates the @var{body} forms with
+a temporary buffer as the current buffer. It saves the identity of
the current buffer, creates a temporary buffer and makes it current,
evaluates the @var{body} forms, and finally restores the previous
-current buffer while killing the temporary buffer. By default, undo
-information (@pxref{Undo}) is not recorded in the buffer created by
-this macro (but @var{body} can enable that, if needed).
+current buffer while killing the temporary buffer.
+
+@cindex undo in temporary buffers
+@cindex @code{kill-buffer-hook} in temporary buffers
+@cindex @code{kill-buffer-query-functions} in temporary buffers
+@cindex @code{buffer-list-update-hook} in temporary buffers
+By default, undo information (@pxref{Undo}) is not recorded in the
+buffer created by this macro (but @var{body} can enable that, if
+needed). The temporary buffer also does not run the hooks
+@code{kill-buffer-hook}, @code{kill-buffer-query-functions}
+(@pxref{Killing Buffers}), and @code{buffer-list-update-hook}
+(@pxref{Buffer List}).
The return value is the value of the last form in @var{body}. You can
return the contents of the temporary buffer by using
@@ -345,9 +354,9 @@ incrementing the number until it is not the name of an existing buffer.
If the optional second argument @var{ignore} is non-@code{nil}, it
should be a string, a potential buffer name. It means to consider
-that potential buffer acceptable, if it is tried, even it is the name
-of an existing buffer (which would normally be rejected). Thus, if
-buffers named @samp{foo}, @samp{foo<2>}, @samp{foo<3>} and
+that potential buffer acceptable, if it is tried, even if it is the
+name of an existing buffer (which would normally be rejected). Thus,
+if buffers named @samp{foo}, @samp{foo<2>}, @samp{foo<3>} and
@samp{foo<4>} exist,
@example
@@ -932,13 +941,17 @@ window.
@defvar buffer-list-update-hook
This is a normal hook run whenever the buffer list changes. Functions
(implicitly) running this hook are @code{get-buffer-create}
-(@pxref{Creating Buffers}), @code{rename-buffer} (@pxref{Buffer Names}),
-@code{kill-buffer} (@pxref{Killing Buffers}), @code{bury-buffer} (see
-above) and @code{select-window} (@pxref{Selecting Windows}).
+(@pxref{Creating Buffers}), @code{rename-buffer} (@pxref{Buffer
+Names}), @code{kill-buffer} (@pxref{Killing Buffers}),
+@code{bury-buffer} (see above), and @code{select-window}
+(@pxref{Selecting Windows}). This hook is not run for internal or
+temporary buffers created by @code{get-buffer-create} or
+@code{generate-new-buffer} with a non-@code{nil} argument
+@var{inhibit-buffer-hooks}.
Functions run by this hook should avoid calling @code{select-window}
-with a nil @var{norecord} argument or @code{with-temp-buffer} since
-either may lead to infinite recursion.
+with a @code{nil} @var{norecord} argument since this may lead to
+infinite recursion.
@end defvar
@node Creating Buffers
@@ -951,12 +964,20 @@ either may lead to infinite recursion.
with the specified name; @code{generate-new-buffer} always creates a new
buffer and gives it a unique name.
+ Both functions accept an optional argument @var{inhibit-buffer-hooks}.
+If it is non-@code{nil}, the buffer they create does not run the hooks
+@code{kill-buffer-hook}, @code{kill-buffer-query-functions}
+(@pxref{Killing Buffers}), and @code{buffer-list-update-hook}
+(@pxref{Buffer List}). This avoids slowing down internal or temporary
+buffers that are never presented to users or passed on to other
+applications.
+
Other functions you can use to create buffers include
@code{with-output-to-temp-buffer} (@pxref{Temporary Displays}) and
@code{create-file-buffer} (@pxref{Visiting Files}). Starting a
subprocess can also create a buffer (@pxref{Processes}).
-@defun get-buffer-create buffer-or-name
+@defun get-buffer-create buffer-or-name &optional inhibit-buffer-hooks
This function returns a buffer named @var{buffer-or-name}. The buffer
returned does not become the current buffer---this function does not
change which buffer is current.
@@ -980,7 +1001,7 @@ level; see @ref{Auto Major Mode}.) If the name begins with a space, the
buffer initially disables undo information recording (@pxref{Undo}).
@end defun
-@defun generate-new-buffer name
+@defun generate-new-buffer name &optional inhibit-buffer-hooks
This function returns a newly created, empty buffer, but does not make
it current. The name of the buffer is generated by passing @var{name}
to the function @code{generate-new-buffer-name} (@pxref{Buffer
@@ -1092,6 +1113,10 @@ with no arguments. The buffer being killed is the current buffer when
they are called. The idea of this feature is that these functions will
ask for confirmation from the user. If any of them returns @code{nil},
@code{kill-buffer} spares the buffer's life.
+
+This hook is not run for internal or temporary buffers created by
+@code{get-buffer-create} or @code{generate-new-buffer} with a
+non-@code{nil} argument @var{inhibit-buffer-hooks}.
@end defvar
@defvar kill-buffer-hook
@@ -1100,6 +1125,10 @@ questions it is going to ask, just before actually killing the buffer.
The buffer to be killed is current when the hook functions run.
@xref{Hooks}. This variable is a permanent local, so its local binding
is not cleared by changing major modes.
+
+This hook is not run for internal or temporary buffers created by
+@code{get-buffer-create} or @code{generate-new-buffer} with a
+non-@code{nil} argument @var{inhibit-buffer-hooks}.
@end defvar
@defopt buffer-offer-save
diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi
index ebfda01671e..3a2c7d019ef 100644
--- a/doc/lispref/commands.texi
+++ b/doc/lispref/commands.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990--1995, 1998--1999, 2001--2020 Free Software
+@c Copyright (C) 1990--1995, 1998--1999, 2001--2021 Free Software
@c Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@node Command Loop
@@ -928,6 +928,13 @@ remapping), and @code{this-original-command} gives the command that
was specified to run but remapped into another command.
@end defvar
+@defvar current-minibuffer-command
+This has the same value as @code{this-command}, but is bound
+recursively when entering a minibuffer. This variable can be used
+from minibuffer hooks and the like to determine what command opened
+the current minibuffer session.
+@end defvar
+
@defun this-command-keys
This function returns a string or vector containing the key sequence
that invoked the present command. Any events read by the command
@@ -2689,9 +2696,11 @@ from the terminal---not counting those generated by keyboard macros.
@code{read-event}, @code{read-char}, and @code{read-char-exclusive} do
not perform the translations described in @ref{Translation Keymaps}.
If you wish to read a single key taking these translations into
-account, use the function @code{read-key}:
+account (for example, to read @ref{Function Keys} in a terminal or
+@ref{Mouse Events} from @code{xterm-mouse-mode}), use the function
+@code{read-key}:
-@defun read-key &optional prompt
+@defun read-key &optional prompt disable-fallbacks
This function reads a single key. It is intermediate between
@code{read-key-sequence} and @code{read-event}. Unlike the former, it
reads a single key, not a key sequence. Unlike the latter, it does
@@ -2701,6 +2710,14 @@ and @code{key-translation-map} (@pxref{Translation Keymaps}).
The argument @var{prompt} is either a string to be displayed in the
echo area as a prompt, or @code{nil}, meaning not to display a prompt.
+
+If argument @var{disable-fallbacks} is non-@code{nil} then the usual
+fallback logic for unbound keys in @code{read-key-sequence} is not
+applied. This means that mouse button-down and multi-click events
+will not be discarded and @code{local-function-key-map} and
+@code{key-translation-map} will not get applied. If @code{nil} or
+unspecified, the only fallback disabled is downcasing of the last
+event.
@end defun
@defun read-char-choice prompt chars &optional inhibit-quit
diff --git a/doc/lispref/compile.texi b/doc/lispref/compile.texi
index ad8afaae608..66242343157 100644
--- a/doc/lispref/compile.texi
+++ b/doc/lispref/compile.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990--1994, 2001--2020 Free Software Foundation, Inc.
+@c Copyright (C) 1990--1994, 2001--2021 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@node Byte Compilation
@chapter Byte Compilation
@@ -199,7 +199,7 @@ $ ls -l push*
@end example
@end deffn
-@deffn Command byte-recompile-directory directory &optional flag force
+@deffn Command byte-recompile-directory directory &optional flag force follow-symlinks
@cindex library compilation
This command recompiles every @samp{.el} file in @var{directory} (or
its subdirectories) that needs recompilation. A file needs
@@ -218,6 +218,10 @@ Interactively, @code{byte-recompile-directory} prompts for
If @var{force} is non-@code{nil}, this command recompiles every
@samp{.el} file that has a @samp{.elc} file.
+This command will normally not compile @samp{.el} files that are
+symlinked. If the optional @var{follow-symlink} parameter is
+non-@code{nil}, symlinked @samp{.el} will also be compiled.
+
The returned value is unpredictable.
@end deffn
diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi
index d2419f415bf..80e9eb7dd8e 100644
--- a/doc/lispref/control.texi
+++ b/doc/lispref/control.texi
@@ -1,6 +1,6 @@
@c -*- mode: texinfo; coding: utf-8 -*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990--1995, 1998--1999, 2001--2020 Free Software
+@c Copyright (C) 1990--1995, 1998--1999, 2001--2021 Free Software
@c Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@node Control Structures
@@ -557,8 +557,9 @@ Likewise, it makes no sense to bind keyword symbols
@item (pred @var{function})
Matches if the predicate @var{function} returns non-@code{nil}
-when called on @var{expval}.
-the predicate @var{function} can have one of the following forms:
+when called on @var{expval}. The test can be negated with the syntax
+@code{(pred (not @var{function}))}.
+The predicate @var{function} can have one of the following forms:
@table @asis
@item function name (a symbol)
diff --git a/doc/lispref/customize.texi b/doc/lispref/customize.texi
index 85912470795..8fd12f79026 100644
--- a/doc/lispref/customize.texi
+++ b/doc/lispref/customize.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1997--2020 Free Software Foundation, Inc.
+@c Copyright (C) 1997--2021 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@node Customization
@chapter Customization Settings
diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi
index 3fea604184c..8e4b0ebfe96 100644
--- a/doc/lispref/debugging.texi
+++ b/doc/lispref/debugging.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990--1994, 1998--1999, 2001--2020 Free Software
+@c Copyright (C) 1990--1994, 1998--1999, 2001--2021 Free Software
@c Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@node Debugging
@@ -424,7 +424,7 @@ move to it and type @key{RET}, to visit the source code. You can also
type @key{RET} while point is on any name of a function or variable
which is not underlined, to see help information for that symbol in a
help buffer, if any exists. The @code{xref-find-definitions} command,
-bound to @key{M-.}, can also be used on any identifier in a backtrace
+bound to @kbd{M-.}, can also be used on any identifier in a backtrace
(@pxref{Looking Up Identifiers,,,emacs, The GNU Emacs Manual}).
In backtraces, the tails of long lists and the ends of long strings,
@@ -1009,13 +1009,14 @@ profiling, so we don't recommend leaving it active except when you are
actually running the code you want to examine).
The profiler report buffer shows, on each line, a function that was
-called, followed by how much resources (cpu or memory) it used in
+called, preceded by how much resources (cpu or memory) it used in
absolute and percentage terms since profiling started. If a given
-line has a @samp{+} symbol at the left-hand side, you can expand that
-line by typing @kbd{@key{RET}}, in order to see the function(s) called
-by the higher-level function. Use a prefix argument (@kbd{C-u
-@key{RET}}) to see the whole call tree below a function. Pressing
-@kbd{@key{RET}} again will collapse back to the original state.
+line has a @samp{+} symbol to the left of the function name, you can
+expand that line by typing @kbd{@key{RET}}, in order to see the
+function(s) called by the higher-level function. Use a prefix
+argument (@kbd{C-u @key{RET}}) to see the whole call tree below a
+function. Pressing @kbd{@key{RET}} again will collapse back to the
+original state.
Press @kbd{j} or @kbd{mouse-2} to jump to the definition of a function
at point. Press @kbd{d} to view a function's documentation. You can
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index 6fc8587fe52..93e935ccf86 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -1,6 +1,6 @@
@c -*- mode: texinfo; coding: utf-8 -*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990--1995, 1998--2020 Free Software Foundation, Inc.
+@c Copyright (C) 1990--1995, 1998--2021 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@node Display
@chapter Emacs Display
@@ -2485,15 +2485,16 @@ avoiding any increase in the character height or width. For simplification
the width could be specified with only a single number @var{n} instead
of a list, such case is equivalent to @code{((abs @var{n}) . @var{n})}.
-The value @var{color} specifies the color to draw with. The default is
-the foreground color of the face for simple boxes, and the background
-color of the face for 3D boxes.
-
The value @var{style} specifies whether to draw a 3D box. If it is
-@code{released-button}, the box looks like a 3D button that is not being
-pressed. If it is @code{pressed-button}, the box looks like a 3D button
-that is being pressed. If it is @code{nil} or omitted, a plain 2D box
-is used.
+@code{released-button}, the box looks like a 3D button that is not
+being pressed. If it is @code{pressed-button}, the box looks like a
+3D button that is being pressed. If it is @code{nil},
+@code{flat-button} or omitted, a plain 2D box is used.
+
+The value @var{color} specifies the color to draw with. The default
+is the background color of the face for 3D boxes and
+@code{flat-button}, and the foreground color of the face for other
+boxes.
@end table
@item :inverse-video
@@ -2632,10 +2633,12 @@ appearance of @var{face} will again be determined by its default face
spec.
@cindex @code{eval-defun}, and @code{defface} forms
+@cindex @code{eval-last-sexp}, and @code{defface} forms
As an exception, if you evaluate a @code{defface} form with
-@kbd{C-M-x} in Emacs Lisp mode (@code{eval-defun}), a special feature
-of @code{eval-defun} overrides any custom face specs on the face,
-causing the face to reflect exactly what the @code{defface} says.
+@kbd{C-M-x} (@code{eval-defun}) or with @kbd{C-x C-e}
+(@code{eval-last-sexp}) in Emacs Lisp mode, a special feature of these
+commands overrides any custom face specs on the face, causing the face
+to reflect exactly what the @code{defface} says.
The @var{spec} argument is a @dfn{face spec}, which states how the
face should appear on different kinds of terminals. It should be an
@@ -3754,6 +3757,20 @@ Additional typographic style information for the font, such as
The charset registry and encoding of the font, such as
@samp{iso8859-1}. The value should be a string or a symbol.
+@item :dpi
+The resolution in dots per inch for which the font is designed. The
+value must be a non-negative number.
+
+@item :spacing
+The spacing of the font: proportional, dual, mono, or charcell. The
+value should be either an integer (0 for proportional, 90 for dual,
+100 for mono, 110 for charcell) or a one-letter symbol (one of
+@code{P}, @code{D}, @code{M}, or @code{C}).
+
+@item :avgwidth
+The average width of the font in 1/10 pixel units. The value should
+be a non-negative number.
+
@item :script
The script that the font must support (a symbol).
@@ -5884,6 +5901,32 @@ string containing the image data as raw bytes. @var{image-type} should be a
@end lisp
@end defun
+@defun svg-embed-base-uri-image svg relative-filename &rest args
+To @var{svg} add an embedded (raster) image placed at
+@var{relative-filename}. @var{relative-filename} is searched inside
+@code{file-name-directory} of the @code{:base-uri} svg image property.
+@code{:base-uri} specifies a (possibly non-existing) file name of the
+svg image to be created, thus all the embedded files are searched
+relatively to the @code{:base-uri} filename's directory. If
+@code{:base-uri} is ommited, then filename from where svg image is
+loaded is used. Using @code{:base-uri} improves the performance of
+embedding large images, comparing to @code{svg-embed}, because all the
+work is done directly by librsvg.
+
+@lisp
+;; Embeding /tmp/subdir/rms.jpg and /tmp/another/rms.jpg
+(svg-embed-base-uri-image svg "subdir/rms.jpg"
+ :width "100px" :height "100px"
+ :x "50px" :y "75px")
+(svg-embed-base-uri-image svg "another/rms.jpg"
+ :width "100px" :height "100px"
+ :x "75px" :y "50px")
+(svg-image svg :scale 1.0
+ :base-uri "/tmp/dummy"
+ :width 175 :height 175)
+@end lisp
+@end defun
+
@defun svg-clip-path svg &rest args
Add a clipping path to @var{svg}. If applied to a shape via the
@var{:clip-path} property, parts of that shape which lie outside of
@@ -6561,6 +6604,12 @@ except when you explicitly clear it. This mode can be useful for
debugging.
@end defvar
+@defun image-cache-size
+This function returns the total size of the current image cache, in
+bytes. An image of size 200x100 with 24 bits per color will have a
+cache size of 60000 bytes, for instance.
+@end defun
+
@node Xwidgets
@section Embedded Native Widgets
@cindex xwidget
@@ -6865,6 +6914,16 @@ This inserts a button with the label @var{label} at point, using text
properties.
@end defun
+@defun button-buttonize string callback &optional data
+Sometimes it's more convenient to make a string into a button without
+inserting it into a buffer immediately, for instance when creating
+data structures that may then, later, be inserted into a buffer. This
+function makes @var{string} into such a string, and @var{callback}
+will be called when the user clicks on the button. The optional
+@var{data} parameter will be used as the parameter when @var{callback}
+is called. If @code{nil}, the button is used as the parameter instead.
+@end defun
+
@node Manipulating Buttons
@subsection Manipulating Buttons
@cindex manipulating buttons
diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi
index 6e9ec47f7b0..569545d83f1 100644
--- a/doc/lispref/edebug.texi
+++ b/doc/lispref/edebug.texi
@@ -1,6 +1,6 @@
@comment -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1992--1994, 1998--1999, 2001--2020 Free Software
+@c Copyright (C) 1992--1994, 1998--1999, 2001--2021 Free Software
@c Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@@ -425,7 +425,8 @@ arrange to deinstrument it.
@item ?
Display the help message for Edebug (@code{edebug-help}).
-@item C-]
+@item a
+@itemx C-]
Abort one level back to the previous command level
(@code{abort-recursive-edit}).
@@ -446,7 +447,7 @@ Redisplay the most recently known expression result in the echo area
@item d
Display a backtrace, excluding Edebug's own functions for clarity
-(@code{edebug-backtrace}).
+(@code{edebug-pop-to-backtrace}).
@xref{Backtraces}, for a description of backtraces
and the commands which work on them.
@@ -640,7 +641,8 @@ configuration is the collection of windows and contents that were in
effect outside of Edebug.
@table @kbd
-@item v
+@item P
+@itemx v
Switch to viewing the outside window configuration
(@code{edebug-view-outside}). Type @kbd{C-x X w} to return to Edebug.
@@ -875,8 +877,8 @@ If non-@code{nil}, Edebug binds @code{print-circle} to this value while
printing results. The default value is @code{t}.
@end defopt
- See @xref{Output Functions} for further details about how printing
-can be customized.
+ For further details about how printing can be customized, see
+@pxref{Output Functions}.
@node Trace Buffer
@subsection Trace Buffer
diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi
index 9a6796790c4..12255d122f9 100644
--- a/doc/lispref/elisp.texi
+++ b/doc/lispref/elisp.texi
@@ -99,7 +99,7 @@ This is the @cite{GNU Emacs Lisp Reference Manual}
@end ifclear
corresponding to Emacs version @value{EMACSVER}.
-Copyright @copyright{} 1990--1996, 1998--2020 Free Software Foundation,
+Copyright @copyright{} 1990--1996, 1998--2021 Free Software Foundation,
Inc.
@quotation
@@ -739,6 +739,7 @@ Minibuffers
* Minibuffer Windows:: Operating on the special minibuffer windows.
* Minibuffer Contents:: How such commands access the minibuffer text.
* Recursive Mini:: Whether recursive entry to minibuffer is allowed.
+* Inhibiting Interaction:: Running Emacs when no interaction is possible.
* Minibuffer Misc:: Various customization hooks and variables.
Completion
diff --git a/doc/lispref/errors.texi b/doc/lispref/errors.texi
index cd8694be8a3..fb393b951f1 100644
--- a/doc/lispref/errors.texi
+++ b/doc/lispref/errors.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990--1993, 1999, 2001--2020 Free Software Foundation,
+@c Copyright (C) 1990--1993, 1999, 2001--2021 Free Software Foundation,
@c Inc.
@c See the file elisp.texi for copying conditions.
@node Standard Errors
@@ -129,9 +129,18 @@ This is a subcategory of @code{file-error}. @xref{Modification Time}.
This is a subcategory of @code{file-error}. It happens, when a file
could not be watched for changes. @xref{File Notifications}.
+@item remote-file-error
+This is a subcategory of @code{file-error}, which results from
+problems in accessing a remote file. @xref{Remote Files,,, emacs, The
+GNU Emacs Manual}. Often, this error appears when timers, process
+filters, process sentinels or special events in general try to access
+a remote file, and collide with another remote file operation. In
+general it is a good idea to write a bug report.
+@xref{Bugs,,, emacs, The GNU Emacs Manual}.
+
@c net/ange-ftp.el
@item ftp-error
-This is a subcategory of @code{file-error}, which results from
+This is a subcategory of @code{remote-file-error}, which results from
problems in accessing a remote file using ftp. @xref{Remote Files,,,
emacs, The GNU Emacs Manual}.
@@ -221,6 +230,11 @@ The message is @samp{Wrong type argument}. @xref{Type Predicates}.
@item unknown-image-type
The message is @samp{Cannot determine image type}. @xref{Images}.
+
+@item inhibited-interaction
+The message is @samp{User interaction while inhibited}. This error is
+signalled when @code{inhibit-interaction} is non-@code{nil} and a user
+interaction function (like @code{read-from-minibuffer}) is called.
@end table
@ignore The following seem to be unused now.
diff --git a/doc/lispref/eval.texi b/doc/lispref/eval.texi
index 39f342a798b..80e038c96d9 100644
--- a/doc/lispref/eval.texi
+++ b/doc/lispref/eval.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990--1994, 1998, 2001--2020 Free Software Foundation,
+@c Copyright (C) 1990--1994, 1998, 2001--2021 Free Software Foundation,
@c Inc.
@c See the file elisp.texi for copying conditions.
@node Evaluation
diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index fc66d1c085d..4110c51099d 100644
--- a/doc/lispref/files.texi
+++ b/doc/lispref/files.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990--1995, 1998--1999, 2001--2020 Free Software
+@c Copyright (C) 1990--1995, 1998--1999, 2001--2021 Free Software
@c Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@node Files
@@ -701,8 +701,11 @@ in @var{body}.
The current buffer is restored even in case of an abnormal exit via
@code{throw} or error (@pxref{Nonlocal Exits}).
-See also @code{with-temp-buffer} in @ref{Definition of
-with-temp-buffer,, The Current Buffer}.
+Like @code{with-temp-buffer} (@pxref{Definition of with-temp-buffer,,
+Current Buffer}), the temporary buffer used by this macro does not run
+the hooks @code{kill-buffer-hook}, @code{kill-buffer-query-functions}
+(@pxref{Killing Buffers}), and @code{buffer-list-update-hook}
+(@pxref{Buffer List}).
@end defmac
@node File Locks
@@ -2917,7 +2920,7 @@ or display the names in a buffer using the @code{ls} shell command. In
the latter case, it can optionally display information about each file,
depending on the options passed to the @code{ls} command.
-@defun directory-files directory &optional full-name match-regexp nosort
+@defun directory-files directory &optional full-name match-regexp nosort count
This function returns a list of the names of the files in the directory
@var{directory}. By default, the list is in alphabetical order.
@@ -2937,6 +2940,10 @@ you want the utmost possible speed and don't care what order the files
are processed in. If the order of processing is visible to the user,
then the user will probably be happier if you do sort the names.
+If @var{count} is non-@code{nil}, the function will return names of
+first @var{count} number of files, or names of all files, whichever
+occurs first. @var{count} has to be an integer greater than zero.
+
@example
@group
(directory-files "~lewis")
@@ -2950,6 +2957,16 @@ An error is signaled if @var{directory} is not the name of a directory
that can be read.
@end defun
+@defun directory-empty-p directory
+This utility function returns @code{t} if given @var{directory} is an
+accessible directory and it does not contain any files, i.e., is an
+empty directory. It will ignore @samp{.} and @samp{..} on systems
+that return them as files in a directory.
+
+Symbolic links to directories count as directories.
+See @var{file-symlink-p} to distinguish symlinks.
+@end defun
+
@cindex recursive traverse of directory tree
@defun directory-files-recursively directory regexp &optional include-directories predicate follow-symlinks
Return all files under @var{directory} whose names match @var{regexp}.
@@ -2996,7 +3013,7 @@ is called with one argument (the file or directory) and should return
non-@code{nil} if that directory is the one it is looking for.
@end defun
-@defun directory-files-and-attributes directory &optional full-name match-regexp nosort id-format
+@defun directory-files-and-attributes directory &optional full-name match-regexp nosort id-format count
This is similar to @code{directory-files} in deciding which files
to report on and how to report their names. However, instead
of returning a list of file names, it returns for each file a
diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi
index e3d0fdeb277..7f2a6f75422 100644
--- a/doc/lispref/frames.texi
+++ b/doc/lispref/frames.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990--1995, 1998--1999, 2001--2020 Free Software
+@c Copyright (C) 1990--1995, 1998--1999, 2001--2021 Free Software
@c Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@node Frames
diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi
index e8e22078d9b..414035f684b 100644
--- a/doc/lispref/functions.texi
+++ b/doc/lispref/functions.texi
@@ -1,6 +1,6 @@
@c -*- mode: texinfo; coding: utf-8 -*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990--1995, 1998--1999, 2001--2020 Free Software
+@c Copyright (C) 1990--1995, 1998--1999, 2001--2021 Free Software
@c Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@node Functions
@@ -2368,6 +2368,8 @@ argument @var{fileonly} non-@code{nil} means check only that
@var{file} exists, not that it actually defines @var{function}.
@end defmac
+@findex check-declare-file
+@findex check-declare-directory
To verify that these functions really are declared where
@code{declare-function} says they are, use @code{check-declare-file}
to check all @code{declare-function} calls in one source file, or use
diff --git a/doc/lispref/hash.texi b/doc/lispref/hash.texi
index 12781c6cb95..8781fad30cd 100644
--- a/doc/lispref/hash.texi
+++ b/doc/lispref/hash.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1999, 2001--2020 Free Software Foundation, Inc.
+@c Copyright (C) 1999, 2001--2021 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@node Hash Tables
@chapter Hash Tables
diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi
index 2fa54e3b66b..298bec5230c 100644
--- a/doc/lispref/help.texi
+++ b/doc/lispref/help.texi
@@ -1,6 +1,6 @@
@c -*- mode: texinfo; coding: utf-8 -*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990--1995, 1998--1999, 2001--2020 Free Software
+@c Copyright (C) 1990--1995, 1998--1999, 2001--2021 Free Software
@c Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@node Documentation
@@ -545,7 +545,7 @@ brackets.
@end group
@group
(single-key-description 'C-mouse-1)
- @result{} "<C-mouse-1>"
+ @result{} "C-<mouse-1>"
@end group
@group
(single-key-description 'C-mouse-1 t)
@@ -676,8 +676,9 @@ If this variable is non-@code{nil}, its value is a form to evaluate
whenever the character @code{help-char} is read. If evaluating the form
produces a string, that string is displayed.
-A command that calls @code{read-event}, @code{read-char-choice}, or
-@code{read-char} probably should bind @code{help-form} to a
+A command that calls @code{read-event}, @code{read-char-choice},
+@code{read-char}, @code{read-char-from-minibuffer}, or
+@code{y-or-n-p} probably should bind @code{help-form} to a
non-@code{nil} expression while it does input. (The time when you
should not do this is when @kbd{C-h} has some other meaning.)
Evaluating this expression should result in a string that explains
diff --git a/doc/lispref/hooks.texi b/doc/lispref/hooks.texi
index a8b4d5619d3..b1c7e613719 100644
--- a/doc/lispref/hooks.texi
+++ b/doc/lispref/hooks.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990--1993, 1998, 2001--2020 Free Software Foundation,
+@c Copyright (C) 1990--1993, 1998, 2001--2021 Free Software Foundation,
@c Inc.
@c See the file elisp.texi for copying conditions.
@node Standard Hooks
diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi
index bb25983aa4b..4150a2b21b8 100644
--- a/doc/lispref/internals.texi
+++ b/doc/lispref/internals.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990--1993, 1998--1999, 2001--2020 Free Software
+@c Copyright (C) 1990--1993, 1998--1999, 2001--2021 Free Software
@c Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@node GNU Emacs Internals
@@ -615,6 +615,19 @@ during garbage collection so far in this Emacs session, as a
floating-point number.
@end defvar
+@defun memory-report
+It can sometimes be useful to see where Emacs is using memory (in
+various variables, buffers, and caches). This command will open a new
+buffer (called @samp{"*Memory Report*"}) that will give an overview,
+in addition to listing the ``largest'' buffers and variables.
+
+All the data here is approximate, because there's really no consistent
+way to compute the size of a variable. For instance, two variables
+may share parts of a data structure, and this will be counted twice,
+but this command may still give a useful high-level overview of which
+parts of Emacs are using memory.
+@end defun
+
@node Stack-allocated Objects
@section Stack-allocated Objects
@@ -1851,7 +1864,10 @@ byte, is @var{len}. The original string in @var{str} can be either an
it can include embedded null bytes, and doesn't have to end in a
terminating null byte at @code{@var{str}[@var{len}]}. The function
raises the @code{overflow-error} error condition if @var{len} is
-negative or exceeds the maximum length of an Emacs string.
+negative or exceeds the maximum length of an Emacs string. If
+@var{len} is zero, then @var{str} can be @code{NULL}, otherwise it
+must point to valid memory. For nonzero @var{len}, @code{make_string}
+returns unique mutable string objects.
@end deftypefn
@deftypefn Function emacs_value make_unibyte_string (emacs_env *@var{env}, const char *@var{str}, ptrdiff_t @var{len})
@@ -2375,6 +2391,15 @@ This flag indicates that narrowing has changed in the buffer.
This flag indicates that redisplay optimizations should not be used to
display this buffer.
+@item inhibit_buffer_hooks
+This flag indicates that the buffer should not run the hooks
+@code{kill-buffer-hook}, @code{kill-buffer-query-functions}
+(@pxref{Killing Buffers}), and @code{buffer-list-update-hook}
+(@pxref{Buffer List}). It is set at buffer creation (@pxref{Creating
+Buffers}), and avoids slowing down internal or temporary buffers, such
+as those created by @code{with-temp-buffer} (@pxref{Definition of
+with-temp-buffer,, Current Buffer}).
+
@item overlay_center
This field holds the current overlay center position. @xref{Managing
Overlays}.
@@ -2388,8 +2413,6 @@ after the current overlay center. @xref{Managing Overlays}.
and @code{overlays_after} is sorted in order of increasing beginning
position.
-@c FIXME? the following are now all Lisp_Object BUFFER_INTERNAL_FIELD (foo).
-
@item name
A Lisp string that names the buffer. It is guaranteed to be unique.
@xref{Buffer Names}. This and the following fields have their names
diff --git a/doc/lispref/intro.texi b/doc/lispref/intro.texi
index a4b479597ea..35f852b7e4b 100644
--- a/doc/lispref/intro.texi
+++ b/doc/lispref/intro.texi
@@ -1,6 +1,6 @@
@c -*-coding: utf-8-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990--1994, 2001--2020 Free Software Foundation, Inc.
+@c Copyright (C) 1990--1994, 2001--2021 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@node Introduction
diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi
index 130ff0d8671..37bab7ea9bc 100644
--- a/doc/lispref/keymaps.texi
+++ b/doc/lispref/keymaps.texi
@@ -1,6 +1,6 @@
@c -*- mode: texinfo; coding: utf-8 -*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990--1994, 1998--2020 Free Software Foundation, Inc.
+@c Copyright (C) 1990--1994, 1998--2021 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@node Keymaps
@chapter Keymaps
@@ -2167,9 +2167,10 @@ string. Thus, the string need not be a constant.
The third element, @var{real-binding}, can be the command to execute
(in which case you get a normal menu item). It can also be a keymap,
-which will result in a submenu. Finally, it can be @code{nil}, in
-which case you will get a non-selectable menu item. This is mostly
-useful when creating separator lines and the like.
+which will result in a submenu, and @var{item-name} is used as the
+submenu name. Finally, it can be @code{nil}, in which case you will
+get a non-selectable menu item. This is mostly useful when creating
+separator lines and the like.
The tail of the list, @var{item-property-list}, has the form of a
property list which contains other information.
@@ -2811,6 +2812,11 @@ the shift modifier:
@xref{Function Keys}, for more information about how to add modifiers to
function keys.
+If you have functions that change whether a tool bar item is enabled
+or not, this status is not necessarily updated visually immediately.
+To force recalculation of the tool bar, call
+@code{force-mode-line-update} (@pxref{Mode Line Format}).
+
@node Modifying Menus
@subsection Modifying Menus
@cindex menu modification
diff --git a/doc/lispref/lay-flat.texi b/doc/lispref/lay-flat.texi
index 3cca5189b1b..4ea58e61726 100644
--- a/doc/lispref/lay-flat.texi
+++ b/doc/lispref/lay-flat.texi
@@ -1,6 +1,6 @@
\input texinfo @c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 2001--2020 Free Software Foundation, Inc.
+@c Copyright (C) 2001--2021 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@c
@comment %**start of header
diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi
index ae793d5e15e..c54496f6168 100644
--- a/doc/lispref/lists.texi
+++ b/doc/lispref/lists.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990--1995, 1998--1999, 2001--2020 Free Software
+@c Copyright (C) 1990--1995, 1998--1999, 2001--2021 Free Software
@c Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@node Lists
diff --git a/doc/lispref/loading.texi b/doc/lispref/loading.texi
index e5364152d52..22f0dde593a 100644
--- a/doc/lispref/loading.texi
+++ b/doc/lispref/loading.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990--1995, 1998--1999, 2001--2020 Free Software
+@c Copyright (C) 1990--1995, 1998--1999, 2001--2021 Free Software
@c Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@node Loading
diff --git a/doc/lispref/macros.texi b/doc/lispref/macros.texi
index eeb4152a5ba..e56a85c7478 100644
--- a/doc/lispref/macros.texi
+++ b/doc/lispref/macros.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990--1995, 1998, 2001--2020 Free Software Foundation,
+@c Copyright (C) 1990--1995, 1998, 2001--2021 Free Software Foundation,
@c Inc.
@c See the file elisp.texi for copying conditions.
@node Macros
diff --git a/doc/lispref/maps.texi b/doc/lispref/maps.texi
index 1e84f9b3bb1..aea02424086 100644
--- a/doc/lispref/maps.texi
+++ b/doc/lispref/maps.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990--1993, 1999, 2001--2020 Free Software Foundation,
+@c Copyright (C) 1990--1993, 1999, 2001--2021 Free Software Foundation,
@c Inc.
@c See the file elisp.texi for copying conditions.
@node Standard Keymaps
diff --git a/doc/lispref/markers.texi b/doc/lispref/markers.texi
index 686b87771fd..cdd0938b458 100644
--- a/doc/lispref/markers.texi
+++ b/doc/lispref/markers.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990--1995, 1998--1999, 2001--2020 Free Software
+@c Copyright (C) 1990--1995, 1998--1999, 2001--2021 Free Software
@c Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@node Markers
diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index e5a0233b3c7..0ce17ed571a 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990--1995, 1998--1999, 2001--2020 Free Software
+@c Copyright (C) 1990--1995, 1998--1999, 2001--2021 Free Software
@c Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@node Minibuffers
@@ -32,6 +32,7 @@ argument.
* Minibuffer Windows:: Operating on the special minibuffer windows.
* Minibuffer Contents:: How such commands access the minibuffer text.
* Recursive Mini:: Whether recursive entry to minibuffer is allowed.
+* Inhibiting Interaction:: Running Emacs when no interaction is possible.
* Minibuffer Misc:: Various customization hooks and variables.
@end menu
@@ -82,10 +83,12 @@ there is an active minibuffer; such a minibuffer is called a
incrementing the number at the end of the name. (The names begin with
a space so that they won't show up in normal buffer lists.) Of
several recursive minibuffers, the innermost (or most recently
-entered) is the active minibuffer. We usually call this @emph{the}
-minibuffer. You can permit or forbid recursive minibuffers by setting
-the variable @code{enable-recursive-minibuffers}, or by putting
-properties of that name on command symbols (@xref{Recursive Mini}.)
+entered) is the @dfn{active minibuffer}--it is the one you can
+terminate by typing @key{RET} (@code{exit-minibuffer}) in. We usually
+call this @emph{the} minibuffer. You can permit or forbid recursive
+minibuffers by setting the variable
+@code{enable-recursive-minibuffers}, or by putting properties of that
+name on command symbols (@xref{Recursive Mini}.)
Like other buffers, a minibuffer uses a local keymap
(@pxref{Keymaps}) to specify special key bindings. The function that
@@ -348,7 +351,7 @@ default, it makes the following bindings:
@item @key{RET}
@code{exit-minibuffer}
-@item @key{M-<}
+@item @kbd{M-<}
@code{minibuffer-beginning-of-buffer}
@item @kbd{C-g}
@@ -1798,6 +1801,14 @@ 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.
+@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}.
+
@item :exit-function
The value should be a function to run after performing completion.
The function should accept two arguments, @var{string} and
@@ -1897,6 +1908,16 @@ 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.
+@item affixation-function
+The value should be a function for adding prefixes and suffixes to
+completions. The function should take one argument,
+@var{completions}, which is a list of possible completions. It should
+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}.
+
@item display-sort-function
The value should be a function for sorting completions. The function
should take one argument, a list of completion strings, and return a
@@ -2109,6 +2130,11 @@ special responses @code{recenter}, @code{scroll-up},
@kbd{C-v}, @kbd{M-v}, @kbd{C-M-v} and @kbd{C-M-S-v} in
@code{query-replace-map}), this function performs the specified window
recentering or scrolling operation, and poses the question again.
+
+If you bind @code{help-form} (@pxref{Help Functions}) to
+a non-@code{nil} value while calling @code{y-or-n-p}, then pressing
+@code{help-char} causes it to evaluate @code{help-form} and display
+the result. @code{help-char} is automatically added to @var{prompt}.
@end defun
@defun y-or-n-p-with-timeout prompt seconds default
@@ -2317,6 +2343,11 @@ character. Optionally, it ignores any input that is not a member of
@var{chars}, a list of accepted characters. The @var{history}
argument specifies the history list symbol to use; if it is omitted or
@code{nil}, this function doesn't use the history.
+
+If you bind @code{help-form} (@pxref{Help Functions}) to
+a non-@code{nil} value while calling @code{read-char-from-minibuffer},
+then pressing @code{help-char} causes it to evaluate @code{help-form}
+and display the result.
@end defun
@node Reading a Password
@@ -2352,7 +2383,8 @@ minibuffer.
@deffn Command exit-minibuffer
This command exits the active minibuffer. It is normally bound to
-keys in minibuffer local keymaps.
+keys in minibuffer local keymaps. The command throws an error if the
+current buffer is not the active minibuffer.
@end deffn
@deffn Command self-insert-and-exit
@@ -2566,8 +2598,11 @@ returns zero.
If this variable is non-@code{nil}, you can invoke commands (such as
@code{find-file}) that use minibuffers even while the minibuffer is
active. Such invocation produces a recursive editing level for a new
-minibuffer. The outer-level minibuffer is invisible while you are
-editing the inner one.
+minibuffer. By default, the outer-level minibuffer is invisible while
+you are editing the inner one. If you have
+@code{minibuffer-follows-selected-frame} set to @code{nil}, you can
+have minibuffers visible on several frames at the same time.
+@xref{Basic Minibuffer,,, emacs}.
If this variable is @code{nil}, you cannot invoke minibuffer commands
when the minibuffer is active, not even if you switch to another window
@@ -2583,17 +2618,51 @@ to @code{t} in the interactive declaration (@pxref{Using Interactive}).
The minibuffer command @code{next-matching-history-element} (normally
@kbd{M-s} in the minibuffer) does the latter.
+@node Inhibiting Interaction
+@section Inhibiting Interaction
+
+It's sometimes useful to be able to run Emacs as a headless server
+process that responds to commands given over a network connection.
+However, Emacs is primarily a platform for interactive usage, so many
+commands prompt the user for feedback in certain anomalous situations.
+This makes this use case more difficult, since the server process will
+just hang waiting for user input.
+
+@vindex inhibit-interaction
+Binding the @code{inhibit-interaction} variable to something
+non-@code{nil} makes Emacs signal a @code{inhibited-interaction} error
+instead of prompting, which can then be used by the server process to
+handle these situations.
+
+Here's a typical use case:
+
+@lisp
+(let ((inhibit-interaction t))
+ (respond-to-client
+ (condition-case err
+ (my-client-handling-function)
+ (inhibited-interaction err))))
+@end lisp
+
+If @code{my-client-handling-function} ends up calling something that
+asks the user for something (via @code{y-or-n-p} or
+@code{read-from-minibuffer} or the like), an
+@code{inhibited-interaction} error is signalled instead. The server
+code then catches that error and reports it to the client.
+
@node Minibuffer Misc
@section Minibuffer Miscellany
-@defun minibufferp &optional buffer-or-name
+@defun minibufferp &optional buffer-or-name live
This function returns non-@code{nil} if @var{buffer-or-name} is a
-minibuffer. If @var{buffer-or-name} is omitted, it tests the current
-buffer.
+minibuffer. If @var{buffer-or-name} is omitted or @code{nil}, it
+tests the current buffer. When @var{live} is non-@code{nil}, the
+function returns non-@code{nil} only when @var{buffer-or-name} is an
+active minibuffer.
@end defun
@defvar minibuffer-setup-hook
-This is a normal hook that is run whenever the minibuffer is entered.
+This is a normal hook that is run whenever a minibuffer is entered.
@xref{Hooks}.
@end defvar
@@ -2611,7 +2680,7 @@ called once, for the outermost use of the minibuffer.
@end defmac
@defvar minibuffer-exit-hook
-This is a normal hook that is run whenever the minibuffer is exited.
+This is a normal hook that is run whenever a minibuffer is exited.
@xref{Hooks}.
@end defvar
diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi
index 98aa94e90d4..abc12546410 100644
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990--1995, 1998--1999, 2001--2020 Free Software
+@c Copyright (C) 1990--1995, 1998--1999, 2001--2021 Free Software
@c Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@node Modes
@@ -1930,6 +1930,17 @@ This function also forces an update of the menu bar and frame title.
color using the face @code{mode-line}. Other windows' mode lines appear
in the face @code{mode-line-inactive} instead. @xref{Faces}.
+@vindex mode-line-compact
+ Some modes put a lot of data in the mode line, pushing elements at
+the end of the mode line off to the right. Emacs can ``compress'' the
+mode line if the @code{mode-line-compact} variable is non-@code{nil}
+by turning stretches of spaces into a single space. If this variable
+is @code{long}, this is only done when the mode line is wider than the
+currently selected window. (This computation is approximate, based on
+the number of characters, and not their displayed width.) This
+variable can be buffer-local to only compress mode-lines in certain
+buffers.
+
@node Mode Line Data
@subsection The Data Structure of the Mode Line
@cindex mode line construct
@@ -1982,9 +1993,15 @@ variables without prompting the user.)
@item (@var{string} @var{rest}@dots{})
@itemx (@var{list} @var{rest}@dots{})
-A list whose first element is a string or list means to process all the
-elements recursively and concatenate the results. This is the most
-common form of mode line construct.
+A list whose first element is a string or list means to process all
+the elements recursively and concatenate the results. This is the
+most common form of mode line construct. (Note that text properties
+are handled specially (for reasons of efficiency) when displaying
+strings in the mode line: Only the text property on the first
+character of the string are considered, and they are then used over
+the entire string. If you need a string with different text
+properties, you have to use the special @code{:propertize} mode line
+construct.)
@item (:eval @var{form})
A list whose first element is the symbol @code{:eval} says to evaluate
@@ -2439,7 +2456,7 @@ line:
@enumerate
@item
Put a string with a text property directly into the mode line data
-structure.
+structure, but see @ref{Mode Line Data} for caveats for that.
@item
Put a text property on a mode line %-construct such as @samp{%12b}; then
@@ -4224,7 +4241,7 @@ Here is an example of an indentation function:
(`(:elem . basic) sample-indent-basic)
(`(,_ . ",") (smie-rule-separator kind))
(`(:after . ":=") sample-indent-basic)
- (`(:before . ,(or `"begin" `"(" `"@{")))
+ (`(:before . ,(or `"begin" `"(" `"@{"))
(if (smie-rule-hanging-p) (smie-rule-parent)))
(`(:before . "if")
(and (not (smie-rule-bolp)) (smie-rule-prev-p "else")
diff --git a/doc/lispref/nonascii.texi b/doc/lispref/nonascii.texi
index 97bc85f152e..84f5d2f0819 100644
--- a/doc/lispref/nonascii.texi
+++ b/doc/lispref/nonascii.texi
@@ -1,6 +1,6 @@
@c -*- mode: texinfo; coding: utf-8 -*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1998--1999, 2001--2020 Free Software Foundation, Inc.
+@c Copyright (C) 1998--1999, 2001--2021 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@node Non-ASCII Characters
@chapter Non-@acronym{ASCII} Characters
diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi
index 9a5bff5a5b2..63e3e0bace5 100644
--- a/doc/lispref/numbers.texi
+++ b/doc/lispref/numbers.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990--1995, 1998--1999, 2001--2020 Free Software
+@c Copyright (C) 1990--1995, 1998--1999, 2001--2021 Free Software
@c Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@node Numbers
diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi
index 83066744121..64e7d53d935 100644
--- a/doc/lispref/objects.texi
+++ b/doc/lispref/objects.texi
@@ -1,6 +1,6 @@
@c -*- mode: texinfo; coding: utf-8 -*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990--1995, 1998--1999, 2001--2020 Free Software
+@c Copyright (C) 1990--1995, 1998--1999, 2001--2021 Free Software
@c Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@node Lisp Data Types
diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi
index 2c30d8ad892..37fde0a953d 100644
--- a/doc/lispref/os.texi
+++ b/doc/lispref/os.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990--1995, 1998--1999, 2001--2020 Free Software
+@c Copyright (C) 1990--1995, 1998--1999, 2001--2021 Free Software
@c Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@node System Interface
@@ -1077,12 +1077,19 @@ directories in a search path (as found in an environment variable). Its
value is @code{":"} for Unix and GNU systems, and @code{";"} for MS systems.
@end defvar
+@defun path-separator
+This function returns the connection-local value of variable
+@code{path-separator}. That is @code{";"} for MS systems and a local
+@code{default-directory}, and @code{":"} for Unix and GNU systems, or
+a remote @code{default-directory}.
+@end defun
+
@defun parse-colon-path path
This function takes a search path string such as the value of
the @env{PATH} environment variable, and splits it at the separators,
returning a list of directories. @code{nil} in this list means
the current directory. Although the function's name says
-``colon'', it actually uses the value of @code{path-separator}.
+``colon'', it actually uses the value of variable @code{path-separator}.
@example
(parse-colon-path ":/foo:/bar")
@@ -1155,6 +1162,19 @@ in the system's terminal driver, before Emacs was started.
@c The value is @code{nil} if Emacs is running under a window system.
@end defvar
+@defvar null-device
+This variable holds the system null device. Its value is
+@code{"/dev/null"} for Unix and GNU systems, and @code{"NUL"} for MS
+systems.
+@end defvar
+
+@defun null-device
+This function returns the connection-local value of variable
+@code{null-device}. That is @code{"NUL"} for MS systems and a local
+@code{default-directory}, and @code{"/dev/null"} for Unix and GNU
+systems, or a remote @code{default-directory}.
+@end defun
+
@node User Identification
@section User Identification
@cindex user identification
@@ -2086,6 +2106,19 @@ run while waiting. If a timer function needs to perform an action
after a certain time has elapsed, it can do this by scheduling a new
timer.
+ If a timer function performs a remote file operation, it can be in
+conflict with an already running remote file operation of the same
+connection. Such conflicts are detected, and they result in a
+@code{remote-file-error} error (@pxref{Standard Errors}). This should
+be protected by wrapping the timer function body with
+
+@lisp
+@group
+(ignore-error 'remote-file-error
+ @dots{})
+@end group
+@end lisp
+
If a timer function calls functions that can change the match data,
it should save and restore the match data. @xref{Saving Match Data}.
@@ -2613,14 +2646,14 @@ calls @var{function} with no arguments, or @samp{--eval=@var{form}}.
Any Lisp program output that would normally go to the echo area,
either using @code{message}, or using @code{prin1}, etc., with
-@code{t} as the stream, goes instead to Emacs's standard descriptors
-when in batch mode: @code{message} writes to the standard error
-descriptor, while @code{prin1} and other print functions write to the
-standard output. Similarly, input that would normally come from the
-minibuffer is read from the standard input descriptor. Thus, Emacs
-behaves much like a noninteractive application program. (The echo
-area output that Emacs itself normally generates, such as command
-echoing, is suppressed entirely.)
+@code{t} as the stream (@pxref{Output Streams}), goes instead to
+Emacs's standard descriptors when in batch mode: @code{message} writes
+to the standard error descriptor, while @code{prin1} and other print
+functions write to the standard output. Similarly, input that would
+normally come from the minibuffer is read from the standard input
+descriptor. Thus, Emacs behaves much like a noninteractive
+application program. (The echo area output that Emacs itself normally
+generates, such as command echoing, is suppressed entirely.)
Non-ASCII text written to the standard output or error descriptors is
by default encoded using @code{locale-coding-system} (@pxref{Locales})
diff --git a/doc/lispref/package.texi b/doc/lispref/package.texi
index af87479c7d2..e8aaa3ae1d1 100644
--- a/doc/lispref/package.texi
+++ b/doc/lispref/package.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 2010--2020 Free Software Foundation, Inc.
+@c Copyright (C) 2010--2021 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@node Packaging
@chapter Preparing Lisp code for distribution
diff --git a/doc/lispref/positions.texi b/doc/lispref/positions.texi
index 751adcff5a8..dc0c7442d8d 100644
--- a/doc/lispref/positions.texi
+++ b/doc/lispref/positions.texi
@@ -1,6 +1,6 @@
@c -*- mode: texinfo; coding: utf-8 -*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990--1995, 1998--2020 Free Software Foundation, Inc.
+@c Copyright (C) 1990--1995, 1998--2021 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@node Positions
@chapter Positions
diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index 5fefab99d4c..6dedaa31f2e 100644
--- a/doc/lispref/processes.texi
+++ b/doc/lispref/processes.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990--1995, 1998--1999, 2001--2020 Free Software
+@c Copyright (C) 1990--1995, 1998--1999, 2001--2021 Free Software
@c Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@node Processes
@@ -729,7 +729,9 @@ coding systems (@pxref{Default Coding Systems}). On the other hand,
it will use @var{query-flag} as its query-on-exit flag (@pxref{Query
Before Exit}). It will be associated with the @var{stderr} buffer
(@pxref{Process Buffers}) and send its output (which is the standard
-error of the main process) there.
+error of the main process) there. To get the process object for the
+standard error process, pass the @var{stderr} buffer to
+@code{get-buffer-process}.
If @var{stderr} is a pipe process, Emacs will use it as standard error
process for the new process.
@@ -1942,6 +1944,29 @@ code:
(while (accept-process-output stderr-process))
@end example
+If you passed a buffer to the @var{stderr} argument of
+@code{make-process}, you still have to wait for the standard error
+process, like so:
+
+@example
+(let* ((stdout (generate-new-buffer "stdout"))
+ (stderr (generate-new-buffer "stderr"))
+ (process (make-process :name "test"
+ :command '("my-program")
+ :buffer stdout
+ :stderr stderr))
+ (stderr-process (get-buffer-process stderr)))
+ (unless (and process stderr-process)
+ (error "Process unexpectedly nil"))
+ (while (accept-process-output process))
+ (while (accept-process-output stderr-process)))
+@end example
+
+@noindent
+Only when both @code{accept-process-output} forms return @code{nil},
+you can be sure that the process has exited and Emacs has read all its
+output.
+
Reading pending standard error from a process running on a remote host
is not possible this way.
@@ -3111,7 +3136,8 @@ signaled. Call @code{puny-encode-domain} on @var{name}
first if you wish to lookup internationalized hostnames.
If successful it returns a list of Lisp representations of network
-addresses, otherwise it returns @code{nil}.
+addresses, otherwise it returns @code{nil}. In the latter case, it
+also displays the error message hopefully explaining what went wrong.
By default both IPv4 and IPv6 lookups are attempted. The optional
argument @var{family} controls this behavior, specifying the symbol
diff --git a/doc/lispref/records.texi b/doc/lispref/records.texi
index f7a21a4b8c6..573caf1672d 100644
--- a/doc/lispref/records.texi
+++ b/doc/lispref/records.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 2017--2020 Free Software Foundation, Inc.
+@c Copyright (C) 2017--2021 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@node Records
@chapter Records
diff --git a/doc/lispref/searching.texi b/doc/lispref/searching.texi
index 592b876644c..16a8e56e90a 100644
--- a/doc/lispref/searching.texi
+++ b/doc/lispref/searching.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990--1995, 1998--1999, 2001--2020 Free Software
+@c Copyright (C) 1990--1995, 1998--1999, 2001--2021 Free Software
@c Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@node Searching and Matching
@@ -1484,8 +1484,8 @@ Corresponding string regexp: @samp{\_>}
@cindex @code{submatch} in rx
Match the @var{rx}s, making the matched text and position accessible
in the match data. The first group in a regexp is numbered 1;
-subsequent groups will be numbered one higher than the previous
-group.@*
+subsequent groups will be numbered one above the previously
+highest-numbered group in the pattern so far.@*
Corresponding string regexp: @samp{\(@dots{}\)}
@item (group-n @var{n} @var{rx}@dots{})
diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi
index 952834bd4e3..0c74dbe2aa4 100644
--- a/doc/lispref/sequences.texi
+++ b/doc/lispref/sequences.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990--1995, 1998--1999, 2001--2020 Free Software
+@c Copyright (C) 1990--1995, 1998--1999, 2001--2021 Free Software
@c Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@node Sequences Arrays Vectors
@@ -116,6 +116,21 @@ If you need to compute the width of a string on display, you should use
since @code{length} only counts the number of characters, but does not
account for the display width of each character.
+@defun length< sequence length
+Return non-@code{nil} if @var{sequence} is shorter than @var{length}.
+This may be more efficient than computing the length of @var{sequence}
+if @var{sequence} is a long list.
+@end defun
+
+@defun length> sequence length
+Return non-@code{nil} if @var{sequence} is longer than @var{length}.
+@end defun
+
+@defun length= sequence length
+Return non-@code{nil} if the length of @var{sequence} is equal to
+@var{length}.
+@end defun
+
@defun elt sequence index
@anchor{Definition of elt}
@cindex elements of sequences
diff --git a/doc/lispref/streams.texi b/doc/lispref/streams.texi
index f171f137790..535fc958f26 100644
--- a/doc/lispref/streams.texi
+++ b/doc/lispref/streams.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990--1994, 1998--1999, 2001--2020 Free Software
+@c Copyright (C) 1990--1994, 1998--1999, 2001--2021 Free Software
@c Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@node Read and Print
@@ -123,13 +123,13 @@ came from. In this case, it makes no difference what value
@code{t} used as a stream means that the input is read from the
minibuffer. In fact, the minibuffer is invoked once and the text
given by the user is made into a string that is then used as the
-input stream. If Emacs is running in batch mode, standard input is used
-instead of the minibuffer. For example,
+input stream. If Emacs is running in batch mode (@pxref{Batch Mode}),
+standard input is used instead of the minibuffer. For example,
@example
(message "%s" (read t))
@end example
-will read a Lisp expression from standard input and print the result
-to standard output.
+will in batch mode read a Lisp expression from standard input and
+print the result to standard output.
@item @code{nil}
@cindex @code{nil} input stream
@@ -392,13 +392,15 @@ is responsible for storing the characters wherever you want to put them.
@item @code{t}
@cindex @code{t} output stream
-The output characters are displayed in the echo area.
+The output characters are displayed in the echo area. If Emacs is
+running in batch mode (@pxref{Batch Mode}), the output is written to
+the standard output descriptor instead.
@item @code{nil}
@cindex @code{nil} output stream
-@code{nil} specified as an output stream means to use the value of
-@code{standard-output} instead; that value is the @dfn{default output
-stream}, and must not be @code{nil}.
+@code{nil} specified as an output stream means to use the value of the
+@code{standard-output} variable instead; that value is the
+@dfn{default output stream}, and must not be @code{nil}.
@item @var{symbol}
A symbol as output stream is equivalent to the symbol's function
@@ -903,10 +905,16 @@ in the C function @code{sprintf}. For further restrictions on what
you can use, see the variable's documentation string.
@end defvar
-@defvar integer-output-format
-This variable specifies how to print integer numbers. The default is
-@code{nil}, meaning use the decimal format. When bound to @code{t},
-print integers as characters when an integer represents a character
-(@pxref{Basic Char Syntax}). When bound to the number @code{16},
-print non-negative integers in the hexadecimal format.
+@defvar print-integers-as-characters
+When this variable is non-@code{nil}, integers that represent
+graphic base characters will be printed using Lisp character syntax
+(@pxref{Basic Char Syntax}). Other numbers are printed the usual way.
+For example, the list @code{(4 65 -1 10)} would be printed as
+@samp{(4 ?A -1 ?\n)}.
+
+More precisely, values printed in character syntax are those
+representing characters belonging to the Unicode general categories
+Letter, Number, Punctuation, Symbol and Private-use
+(@pxref{Character Properties}), as well as the control characters
+having their own escape syntax such as newline.
@end defvar
diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi
index 0f157c39d63..5cae939b7bf 100644
--- a/doc/lispref/strings.texi
+++ b/doc/lispref/strings.texi
@@ -1,6 +1,6 @@
@c -*- mode: texinfo; coding: utf-8 -*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990--1995, 1998--1999, 2001--2020 Free Software
+@c Copyright (C) 1990--1995, 1998--1999, 2001--2021 Free Software
@c Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@node Strings and Characters
@@ -120,7 +120,10 @@ character (i.e., an integer), @code{nil} otherwise.
@cindex string creation
The following functions create strings, either from scratch, or by
-putting strings together, or by taking them apart.
+putting strings together, or by taking them apart. (For functions
+that create strings based on the modified contents of other strings,
+like @code{string-replace} and @code{replace-regexp-in-string}, see
+@ref{Search and Replace}.)
@defun make-string count character &optional multibyte
This function returns a string made up of @var{count} repetitions of
@@ -381,6 +384,52 @@ The default value of @var{separators} for @code{split-string}. Its
usual value is @w{@code{"[ \f\t\n\r\v]+"}}.
@end defvar
+@defun string-clean-whitespace string
+Clean up the whitespace in @var{string} by collapsing stretches of
+whitespace to a single space character, as well as removing all
+whitespace from the start and the end of @var{string}.
+@end defun
+
+@defun string-fill string length
+Attempt to Word-wrap @var{string} so that no lines are longer than
+@var{length}. Filling is done on whitespace boundaries only. If
+there are individual words that are longer than @var{length}, these
+will not be shortened.
+@end defun
+
+@defun string-limit string length &optional end coding-system
+If @var{string} is shorter than @var{length}, @var{string} is returned
+as is. Otherwise, return a substring of @var{string} consisting of
+the first @var{length} characters. If the optional @var{end}
+parameter is given, return a string of the @var{length} last
+characters instead.
+
+If @var{coding-system} is non-@code{nil}, @var{string} will be encoded
+before limiting, and the result will be a unibyte string that's
+shorter than @code{length}. If @var{string} contains characters that
+are encoded into several bytes (for instance, when using
+@code{utf-8}), the resulting unibyte string is never truncated in the
+middle of a character representation.
+@end defun
+
+@defun string-lines string &optional omit-nulls
+Split @var{string} into a list of strings on newline boundaries. If
+@var{omit-nulls}, remove empty lines from the results.
+@end defun
+
+@defun string-pad string length &optional padding start
+Pad @var{string} to the be of @var{length} using @var{padding} as the
+padding character (defaulting to the space character). If
+@var{string} is shorter than @var{length}, no padding is done. If
+@var{start} is @code{nil} (or not present), the padding is done to the
+end of the string, and if it's non-@code{nil}, to the start of the
+string.
+@end defun
+
+@defun string-chop-newline string
+Remove the final newline, if any, from @var{string}.
+@end defun
+
@node Modifying Strings
@section Modifying Strings
@cindex modifying strings
@@ -1167,7 +1216,7 @@ The function @code{format-spec} described in this section performs a
similar function to @code{format}, except it operates on format
control strings that use arbitrary specification characters.
-@defun format-spec template spec-alist &optional ignore-missing
+@defun format-spec template spec-alist &optional ignore-missing split
This function returns a string produced from the format string
@var{template} according to conversions specified in @var{spec-alist},
which is an alist (@pxref{Association Lists}) of the form
@@ -1209,6 +1258,16 @@ any; if it is @code{delete}, those format specifications are removed
from the output; any other non-@code{nil} value is handled like
@code{ignore}, but any occurrences of @samp{%%} are also left verbatim
in the output.
+
+If the optional argument @var{split} is non-@code{nil}, instead of
+returning a single string, @code{format-spec} will split the result
+into a list of strings, based on where the substitutions were
+performed. For instance:
+
+@example
+(format-spec "foo %b bar" '((?b . "zot")) nil t)
+ @result{} ("foo " "zot" " bar")
+@end example
@end defun
The syntax of format specifications accepted by @code{format-spec} is
diff --git a/doc/lispref/symbols.texi b/doc/lispref/symbols.texi
index d6b0494d1ad..ed36f5139a8 100644
--- a/doc/lispref/symbols.texi
+++ b/doc/lispref/symbols.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990--1995, 1998--1999, 2001--2020 Free Software
+@c Copyright (C) 1990--1995, 1998--1999, 2001--2021 Free Software
@c Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@node Symbols
diff --git a/doc/lispref/syntax.texi b/doc/lispref/syntax.texi
index b99b5de0b31..d27053a1799 100644
--- a/doc/lispref/syntax.texi
+++ b/doc/lispref/syntax.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990--1995, 1998--1999, 2001--2020 Free Software
+@c Copyright (C) 1990--1995, 1998--1999, 2001--2021 Free Software
@c Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@node Syntax Tables
@@ -252,7 +252,7 @@ comment and a newline or formfeed ends one.
@item Inherit standard syntax: @samp{@@}
This syntax class does not specify a particular syntax. It says to
-look in the standard syntax table to find the syntax of this
+look in the parent syntax table to find the syntax of this
character.
@item Generic comment delimiters: @samp{!}
diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 550e7feee2e..0b567d82c61 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990--1995, 1998--2020 Free Software Foundation, Inc.
+@c Copyright (C) 1990--1995, 1998--2021 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@node Text
@chapter Text
@@ -1100,7 +1100,7 @@ one, it rotates the kill ring to place the yanked string at the front.
This command replaces the just-yanked entry from the kill ring with a
different entry from the kill ring.
-This is allowed only immediately after a @code{yank} or another
+This works only immediately after a @code{yank} or another
@code{yank-pop}. At such a time, the region contains text that was just
inserted by yanking. @code{yank-pop} deletes that text and inserts in
its place a different piece of killed text. It does not add the deleted
@@ -2931,6 +2931,22 @@ used instead. Here is an example:
@end example
@end defvar
+@defun object-intervals OBJECT
+This function returns a copy of the intervals (i.e., text properties)
+in @var{object} as a list of intervals. @var{object} must be a string
+or a buffer. Altering the structure of this list does not change the
+intervals in the object.
+
+@example
+(object-intervals (propertize "foo" 'face 'bold))
+ @result{} ((0 3 (face bold)))
+@end example
+
+Each element in the returned list represents one interval. Each
+interval has three parts: The first is the start, the second is the
+end, and the third part is the text property itself.
+@end defun
+
@node Changing Properties
@subsection Changing Text Properties
@cindex changing text properties
diff --git a/doc/lispref/threads.texi b/doc/lispref/threads.texi
index de19c0604c2..a06bd3e801b 100644
--- a/doc/lispref/threads.texi
+++ b/doc/lispref/threads.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 2012--2020 Free Software Foundation, Inc.
+@c Copyright (C) 2012--2021 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@node Threads
@chapter Threads
diff --git a/doc/lispref/tips.texi b/doc/lispref/tips.texi
index 40d01d47468..4a7793a976d 100644
--- a/doc/lispref/tips.texi
+++ b/doc/lispref/tips.texi
@@ -1,6 +1,6 @@
@c -*- mode: texinfo; coding: utf-8 -*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990--1993, 1995, 1998--1999, 2001--2020 Free Software
+@c Copyright (C) 1990--1993, 1995, 1998--1999, 2001--2021 Free Software
@c Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@node Tips
@@ -139,17 +139,8 @@ your file do not need to load the extra library.
@item
If you need Common Lisp extensions, use the @code{cl-lib} library
-rather than the old @code{cl} library. The latter does not
-use a clean namespace (i.e., its definitions do not
-start with a @samp{cl-} prefix). If your package loads @code{cl} at
-run time, that could cause name clashes for users who don't use that
-package.
-
-There is no problem with using the @code{cl} package at @emph{compile}
-time, with @code{(eval-when-compile (require 'cl))}. That's
-sufficient for using the macros in the @code{cl} package, because the
-compiler expands them before generating the byte-code. It is still
-better to use the more modern @code{cl-lib} in this case, though.
+rather than the old @code{cl} library. The latter library is
+deprecated and will be removed in a future version of Emacs.
@item
When defining a major mode, please follow the major mode
@@ -998,7 +989,7 @@ explains these conventions, starting with an example:
@group
;;; foo.el --- Support for the Foo programming language -*- lexical-binding: t; -*-
-;; Copyright (C) 2010-2020 Your Name
+;; Copyright (C) 2010-2021 Your Name
@end group
;; Author: Your Name <yourname@@example.com>
diff --git a/doc/lispref/two-volume-cross-refs.txt b/doc/lispref/two-volume-cross-refs.txt
index 63f55634649..ad13d98dd97 100644
--- a/doc/lispref/two-volume-cross-refs.txt
+++ b/doc/lispref/two-volume-cross-refs.txt
@@ -1,4 +1,4 @@
-Copyright (C) 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 2001-2021 Free Software Foundation, Inc.
See end for copying conditions.
Two Volume Cross References
diff --git a/doc/lispref/two-volume.make b/doc/lispref/two-volume.make
index 133c50be23e..cf612b12573 100644
--- a/doc/lispref/two-volume.make
+++ b/doc/lispref/two-volume.make
@@ -1,4 +1,4 @@
-# Copyright (C) 2007-2020 Free Software Foundation, Inc.
+# Copyright (C) 2007-2021 Free Software Foundation, Inc.
# See end for copying conditions.
# although it would be nice to use tex rather than pdftex to avoid
diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi
index 095ea9dce24..63438170d1a 100644
--- a/doc/lispref/variables.texi
+++ b/doc/lispref/variables.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990--1995, 1998--2020 Free Software Foundation, Inc.
+@c Copyright (C) 1990--1995, 1998--2021 Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@node Variables
@chapter Variables
@@ -481,10 +481,12 @@ form occurs in a @code{let} form with lexical binding enabled), then
effect until its binding construct exits. @xref{Variable Scoping}.
@cindex @code{eval-defun}, and @code{defvar} forms
-When you evaluate a top-level @code{defvar} form with @kbd{C-M-x} in
-Emacs Lisp mode (@code{eval-defun}), a special feature of
-@code{eval-defun} arranges to set the variable unconditionally, without
-testing whether its value is void.
+@cindex @code{eval-last-sexp}, and @code{defvar} forms
+When you evaluate a top-level @code{defvar} form with @kbd{C-M-x}
+(@code{eval-defun}) or with @kbd{C-x C-e} (@code{eval-last-sexp}) in
+Emacs Lisp mode, a special feature of these two commands arranges to
+set the variable unconditionally, without testing whether its value is
+void.
If the @var{doc-string} argument is supplied, it specifies the
documentation string for the variable (stored in the symbol's
@@ -1285,7 +1287,7 @@ be used.)
@subsubheading Cross-file variable checking
-@strong{Note:} This is an experimental feature that may change or
+@strong{Caution:} This is an experimental feature that may change or
disappear without prior notice.
The byte-compiler can also warn about lexical variables that are
diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi
index 5ec23a9c876..f305d1a8ee8 100644
--- a/doc/lispref/windows.texi
+++ b/doc/lispref/windows.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990--1995, 1998--1999, 2001--2020 Free Software
+@c Copyright (C) 1990--1995, 1998--1999, 2001--2021 Free Software
@c Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@node Windows
@@ -365,7 +365,7 @@ appears right below @var{window}.
@end defun
@cindex window in direction
-@defun window-in-direction direction &optional window ignore sign wrap mini
+@defun window-in-direction direction &optional window ignore sign wrap minibuf
This function returns the nearest live window in direction
@var{direction} as seen from the position of @code{window-point} in
window @var{window}. The argument @var{direction} must be one of
@@ -392,11 +392,13 @@ is at the top of the frame and @var{direction} is @code{above}, then
this function usually returns the frame's minibuffer window if it's
active and a window at the bottom of the frame otherwise.
-If the optional argument @var{mini} is @code{nil}, this means to return
-the minibuffer window if and only if it is currently active. If
-@var{mini} is non-@code{nil}, this function may return the minibuffer
-window even when it's not active. However, if @var{wrap} is
-non-@code{nil}, it always acts as if @var{mini} were @code{nil}.
+If the optional argument @var{minibuf} is @code{t}, this function may
+return the minibuffer window even when it's not active. If the
+optional argument @var{minibuf} is @code{nil}, this means to return
+the minibuffer window if and only if it is currently active.
+If @var{minibuf} is neither @code{nil} nor @code{t}, this function
+never returns the minibuffer window. However, if @var{wrap} is
+non-@code{nil}, it always acts as if @var{minibuf} were @code{nil}.
If it doesn't find a suitable window, this function returns
@code{nil}.
@@ -2632,6 +2634,12 @@ window and displaying the buffer in that window. It can fail if all
windows are dedicated to other buffers (@pxref{Dedicated Windows}).
@end defun
+@defun display-buffer-use-least-recent-window buffer alist
+This function is like @code{display-buffer-use-some-window}, but will
+not reuse the current window, and will use the least recently
+switched-to window.
+@end defun
+
@defun display-buffer-in-direction buffer alist
This function tries to display @var{buffer} at a location specified by
@var{alist}. For this purpose, @var{alist} should contain a
@@ -5869,13 +5877,16 @@ which window parameters (if any) are saved by this function.
@xref{Window Parameters}.
@end defun
-@defun set-window-configuration configuration
+@defun set-window-configuration configuration &optional dont-set-frame
This function restores the configuration of windows and buffers as
specified by @var{configuration}, for the frame that
@var{configuration} was created for, regardless of whether that frame
is selected or not. The argument @var{configuration} must be a value
that was previously returned by @code{current-window-configuration}
-for that frame.
+for that frame. Normally the function also selects the frame which is
+recorded in the configuration, but if @var{dont-set-frame} is
+non-@code{nil}, it leaves selected the frame which was current at the
+start of the function.
If the frame from which @var{configuration} was saved is dead, all
this function does is to restore the value of the variable
diff --git a/doc/man/ChangeLog.1 b/doc/man/ChangeLog.1
index 5e23bb3e305..9ad144a457a 100644
--- a/doc/man/ChangeLog.1
+++ b/doc/man/ChangeLog.1
@@ -176,7 +176,7 @@
;; coding: utf-8
;; End:
- Copyright (C) 2007-2020 Free Software Foundation, Inc.
+ Copyright (C) 2007-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/doc/man/ebrowse.1 b/doc/man/ebrowse.1
index 330c1ea523e..7bb32b80d46 100644
--- a/doc/man/ebrowse.1
+++ b/doc/man/ebrowse.1
@@ -82,7 +82,7 @@ should give you access to the complete manual.
was written by Gerd Moellmann.
.
.SH COPYING
-Copyright 2008-2020 Free Software Foundation, Inc.
+Copyright 2008-2021 Free Software Foundation, Inc.
.PP
Permission is granted to make and distribute verbatim copies of this
document provided the copyright notice and this permission notice are
diff --git a/doc/man/emacs.1.in b/doc/man/emacs.1.in
index 3a5758e1aaa..da912bd5112 100644
--- a/doc/man/emacs.1.in
+++ b/doc/man/emacs.1.in
@@ -657,7 +657,7 @@ For detailed credits and acknowledgments, see the GNU Emacs manual.
.
.
.SH COPYING
-Copyright 1995, 1999-2020 Free Software Foundation, Inc.
+Copyright 1995, 1999-2021 Free Software Foundation, Inc.
.PP
Permission is granted to make and distribute verbatim copies of this
document provided the copyright notice and this permission notice are
diff --git a/doc/man/etags.1 b/doc/man/etags.1
index 8053e863fce..c5c15fb1826 100644
--- a/doc/man/etags.1
+++ b/doc/man/etags.1
@@ -281,7 +281,7 @@ Stallman.
.BR vi ( 1 ).
.SH COPYING
-Copyright 1992, 1999, 2001-2020 Free Software Foundation, Inc.
+Copyright 1992, 1999, 2001-2021 Free Software Foundation, Inc.
.PP
Permission is granted to make and distribute verbatim copies of this
document provided the copyright notice and this permission notice are
diff --git a/doc/misc/ChangeLog.1 b/doc/misc/ChangeLog.1
index f74e51f400e..c050e5d4cb8 100644
--- a/doc/misc/ChangeLog.1
+++ b/doc/misc/ChangeLog.1
@@ -12116,7 +12116,7 @@
;; coding: utf-8
;; End:
- Copyright (C) 1993-1999, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1993-1999, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/doc/misc/Makefile.in b/doc/misc/Makefile.in
index f4fb7d2ee64..d627055ae1d 100644
--- a/doc/misc/Makefile.in
+++ b/doc/misc/Makefile.in
@@ -1,6 +1,6 @@
### @configure_input@
-# Copyright (C) 1994, 1996-2020 Free Software Foundation, Inc.
+# Copyright (C) 1994, 1996-2021 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
diff --git a/doc/misc/auth.texi b/doc/misc/auth.texi
index f8fcb642901..034004d1df4 100644
--- a/doc/misc/auth.texi
+++ b/doc/misc/auth.texi
@@ -9,7 +9,7 @@
@copying
This file describes the Emacs auth-source library.
-Copyright @copyright{} 2008--2020 Free Software Foundation, Inc.
+Copyright @copyright{} 2008--2021 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -107,6 +107,18 @@ The @code{user} is the user name. It's known as @var{:user} in
@code{auth-source-search} queries. You can also use @code{login} and
@code{account}.
+Matching entries are usually used in the order they appear, so placing
+the most specific entries first in the file is a good idea. For
+instance:
+
+@example
+machine example.com login foobar password geheimnis port smtp
+machine example.com login foobar password hemmelig
+@end example
+
+Here we're using one password for the @code{smtp} service, and a
+different one for all the other services.
+
You can also use this file to specify client certificates to use when
setting up TLS connections. The format is:
diff --git a/doc/misc/autotype.texi b/doc/misc/autotype.texi
index 7b7f8827a79..72ba73697d3 100644
--- a/doc/misc/autotype.texi
+++ b/doc/misc/autotype.texi
@@ -11,7 +11,7 @@
@c @cindex autotypist
@copying
-Copyright @copyright{} 1994--1995, 1999, 2001--2020 Free Software
+Copyright @copyright{} 1994--1995, 1999, 2001--2021 Free Software
Foundation, Inc.
@quotation
diff --git a/doc/misc/bovine.texi b/doc/misc/bovine.texi
index 8ee985046d9..780f0addb59 100644
--- a/doc/misc/bovine.texi
+++ b/doc/misc/bovine.texi
@@ -24,7 +24,7 @@
@c %**end of header
@copying
-Copyright @copyright{} 1999--2004, 2012--2020 Free Software Foundation,
+Copyright @copyright{} 1999--2004, 2012--2021 Free Software Foundation,
Inc.
@quotation
diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi
index 6a6f585ce20..c4ccea3caf4 100644
--- a/doc/misc/calc.texi
+++ b/doc/misc/calc.texi
@@ -95,7 +95,7 @@ This file documents Calc, the GNU Emacs calculator, included with
GNU Emacs @value{EMACSVER}.
@end ifnotinfo
-Copyright @copyright{} 1990--1991, 2001--2020 Free Software Foundation,
+Copyright @copyright{} 1990--1991, 2001--2021 Free Software Foundation,
Inc.
@quotation
@@ -28047,13 +28047,7 @@ defined as the distance that light will travel in a vacuum in
vacuum is exactly 299792458 m/s. Many other units have been
redefined in terms of fundamental physical processes; a second, for
example, is currently defined as 9192631770 periods of a certain
-radiation related to the cesium-133 atom. The only SI unit that is not
-based on a fundamental physical process (although there are efforts to
-change this) is the kilogram, which was originally defined as the mass
-of one liter of water, but is now defined as the mass of the
-international prototype of the kilogram (IPK), a cylinder of platinum-iridium
-kept at the Bureau international des poids et mesures in Sèvres,
-France. (There are several copies of the IPK throughout the world.)
+radiation related to the cesium-133 atom.
The British imperial units, once defined in terms of physical objects,
were redefined in 1963 in terms of SI units. The US customary units,
which were the same as British units until the British imperial system
diff --git a/doc/misc/cc-mode.texi b/doc/misc/cc-mode.texi
index adc233d99dd..24ab4b773c6 100644
--- a/doc/misc/cc-mode.texi
+++ b/doc/misc/cc-mode.texi
@@ -167,7 +167,7 @@ CC Mode
@copying
This manual is for CC Mode in Emacs.
-Copyright @copyright{} 1995--2020 Free Software Foundation, Inc.
+Copyright @copyright{} 1995--2021 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -197,7 +197,7 @@ modify this GNU manual.''
@titlepage
@sp 10
-@center @titlefont{CC Mode 5.34}
+@center @titlefont{CC Mode 5.35}
@sp 2
@center A GNU Emacs mode for editing C and C-like languages
@sp 2
@@ -388,7 +388,7 @@ was added in version 5.30.
This manual describes @ccmode{}
@comment The following line must appear on its own, so that the
-version 5.34.
+version 5.35.
@comment Release.py script can update the version number automatically
@ccmode{} supports the editing of C, C++, Objective-C,
diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi
index 2b38544dc87..7464ba2eb1d 100644
--- a/doc/misc/cl.texi
+++ b/doc/misc/cl.texi
@@ -7,7 +7,7 @@
@copying
This file documents the GNU Emacs Common Lisp emulation package.
-Copyright @copyright{} 1993, 2001--2020 Free Software Foundation, Inc.
+Copyright @copyright{} 1993, 2001--2021 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -210,17 +210,10 @@ behave in exactly the same way as the @file{cl-lib.el} versions.
@c There is also cl-mapc, which was called cl-mapc even before cl-lib.el.
@c But not autoloaded, so maybe not much used?
-Since the old @file{cl.el} does not use a clean namespace, Emacs has a
-policy that packages distributed with Emacs must not load @code{cl} at
-run time. (It is ok for them to load @code{cl} at @emph{compile}
-time, with @code{eval-when-compile}, and use the macros it provides.)
-There is no such restriction on the use of @code{cl-lib}. New code
-should use @code{cl-lib} rather than @code{cl}.
-
-There is one more file, @file{cl-compat.el}, which defines some
-routines from the older Quiroz @file{cl.el} package that are not otherwise
-present in the new package. This file is obsolete and should not be
-used in new code.
+The old file @file{cl.el}, as well as the even older
+@file{cl-compat.el}, are deprecated and will be removed in a future
+version of Emacs. Any existing code that uses them should be updated
+to use @file{cl-lib.el} instead.
@node Naming Conventions
@section Naming Conventions
@@ -1104,10 +1097,9 @@ by @var{x} if specified.
@defmac cl-pushnew x place @t{&key :test :test-not :key}
This macro inserts @var{x} at the front of the list stored in
-@var{place}, but only if @var{x} was not @code{eql} to any
-existing element of the list. The optional keyword arguments
-are interpreted in the same way as for @code{cl-adjoin}.
-@xref{Lists as Sets}.
+@var{place}, but only if @var{x} isn't present in the list already.
+The optional keyword arguments are interpreted in the same way as for
+@code{cl-adjoin}. @xref{Lists as Sets}.
@end defmac
@defmac cl-shiftf place@dots{} newvalue
@@ -3803,8 +3795,10 @@ This is a destructive version of @code{cl-sublis}.
@section Lists as Sets
@noindent
-These functions perform operations on lists that represent sets
-of elements.
+These functions perform operations on lists that represent sets of
+elements. All these functions (unless otherwise specified) default to
+using @code{eql} as the test function, but that can be modified by the
+@code{:test} parameter.
@defun cl-member item list @t{&key :test :test-not :key}
This function searches @var{list} for an element matching @var{item}.
diff --git a/doc/misc/dbus.texi b/doc/misc/dbus.texi
index 5a1dd55248d..e8e99db76ba 100644
--- a/doc/misc/dbus.texi
+++ b/doc/misc/dbus.texi
@@ -10,7 +10,7 @@
@syncodeindex fn cp
@copying
-Copyright @copyright{} 2007--2020 Free Software Foundation, Inc.
+Copyright @copyright{} 2007--2021 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
diff --git a/doc/misc/dired-x.texi b/doc/misc/dired-x.texi
index 243b59b242a..87a127c4f39 100644
--- a/doc/misc/dired-x.texi
+++ b/doc/misc/dired-x.texi
@@ -20,7 +20,7 @@
@comment %**end of header (This is for running Texinfo on a region.)
@copying
-Copyright @copyright{} 1994--1995, 1999, 2001--2020 Free Software
+Copyright @copyright{} 1994--1995, 1999, 2001--2021 Free Software
Foundation, Inc.
@quotation
diff --git a/doc/misc/ebrowse.texi b/doc/misc/ebrowse.texi
index 1751a775d71..8962f7c8cf1 100644
--- a/doc/misc/ebrowse.texi
+++ b/doc/misc/ebrowse.texi
@@ -11,7 +11,7 @@
@copying
This file documents Ebrowse, a C++ class browser for GNU Emacs.
-Copyright @copyright{} 2000--2020 Free Software Foundation, Inc.
+Copyright @copyright{} 2000--2021 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -735,7 +735,7 @@ context menu.
Classes can be marked for operations similar to the standard Emacs
commands @kbd{M-x tags-search} and @kbd{M-x tags-query-replace} (see
-also @xref{Tags-like Functions}.)
+also @pxref{Tags-like Functions}.)
@table @kbd
@cindex toggle mark
diff --git a/doc/misc/ede.texi b/doc/misc/ede.texi
index 63e3595a509..a53f879c961 100644
--- a/doc/misc/ede.texi
+++ b/doc/misc/ede.texi
@@ -6,7 +6,7 @@
@copying
This file describes EDE, the Emacs Development Environment.
-Copyright @copyright{} 1998--2001, 2004--2005, 2008--2020 Free Software
+Copyright @copyright{} 1998--2001, 2004--2005, 2008--2021 Free Software
Foundation, Inc.
@quotation
diff --git a/doc/misc/ediff.texi b/doc/misc/ediff.texi
index 1ef13716b11..8162a84f61a 100644
--- a/doc/misc/ediff.texi
+++ b/doc/misc/ediff.texi
@@ -26,7 +26,7 @@
This file documents Ediff, a comprehensive visual interface to Unix diff
and patch utilities.
-Copyright @copyright{} 1995--2020 Free Software Foundation, Inc.
+Copyright @copyright{} 1995--2021 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
diff --git a/doc/misc/edt.texi b/doc/misc/edt.texi
index b0200b47456..b4dabdb938d 100644
--- a/doc/misc/edt.texi
+++ b/doc/misc/edt.texi
@@ -6,7 +6,7 @@
@copying
This file documents the EDT emulation package for Emacs.
-Copyright @copyright{} 1986, 1992, 1994--1995, 1999--2020 Free Software
+Copyright @copyright{} 1986, 1992, 1994--1995, 1999--2021 Free Software
Foundation, Inc.
@quotation
diff --git a/doc/misc/efaq-w32.texi b/doc/misc/efaq-w32.texi
index c875d58ef16..2abde2c2843 100644
--- a/doc/misc/efaq-w32.texi
+++ b/doc/misc/efaq-w32.texi
@@ -15,7 +15,7 @@ Answers to Frequently asked Questions about using Emacs on Microsoft Windows.
@include emacsver.texi
@copying
-Copyright @copyright{} 2008, 2010--2020 Free Software Foundation, Inc.
+Copyright @copyright{} 2008, 2010--2021 Free Software Foundation, Inc.
@quotation
This list of frequently asked questions about GNU Emacs on MS Windows
diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi
index 1bc9d41f9bb..f26ae637788 100644
--- a/doc/misc/efaq.texi
+++ b/doc/misc/efaq.texi
@@ -12,7 +12,7 @@
@c appreciate a notice if you do).
@copying
-Copyright @copyright{} 2001--2020 Free Software Foundation, Inc.@*
+Copyright @copyright{} 2001--2021 Free Software Foundation, Inc.@*
Copyright @copyright{} 1994, 1995, 1996, 1997, 1998, 1999, 2000
Reuven M. Lerner@*
Copyright @copyright{} 1992, 1993 Steven Byrnes@*
@@ -512,10 +512,10 @@ This chapter tells you how to get help with Emacs.
@cindex Help system, entering the
Type @kbd{C-h t} to invoke the self-paced tutorial. Just typing
-@kbd{C-h} enters the help system. Starting with Emacs 22, the tutorial
-is available in many foreign languages such as French, German, Japanese,
-Russian, etc. Use @kbd{M-x help-with-tutorial-spec-language @key{RET}}
-to choose your language and start the tutorial.
+@kbd{C-h} enters the help system. The tutorial is available in many
+foreign languages such as French, German, Japanese, Russian, etc. Use
+@kbd{M-x help-with-tutorial-spec-language @key{RET}} to choose your
+language and start the tutorial.
Your system administrator may have changed @kbd{C-h} to act like
@key{DEL} to deal with local keyboards. You can use @kbd{M-x
@@ -594,11 +594,11 @@ You can get a printed reference card listing commands and keys to
invoke them. You can order one from the FSF for $2 (or 10 for $18),
or you can print your own from the @file{etc/refcards/refcard.tex} or
@file{etc/refcards/refcard.pdf} files in the Emacs distribution.
-Beginning with version 21.1, the Emacs distribution comes with
-translations of the reference card into several languages; look for
-files named @file{etc/refcards/@var{lang}-refcard.*}, where @var{lang}
-is a two-letter code of the language. For example, the German version
-of the reference card is in the files @file{etc/refcards/de-refcard.tex}
+The Emacs distribution comes with translations of the reference card
+into several languages; look for files named
+@file{etc/refcards/@var{lang}-refcard.*}, where @var{lang} is a
+two-letter code of the language. For example, the German version of
+the reference card is in the files @file{etc/refcards/de-refcard.tex}
and @file{etc/refcards/de-refcard.pdf}.
@item
@@ -901,6 +901,7 @@ status of its latest version.
@menu
* Origin of the term Emacs::
* Latest version of Emacs::
+* New in Emacs 27::
* New in Emacs 26::
* New in Emacs 25::
* New in Emacs 24::
@@ -951,7 +952,7 @@ conventions}).
Emacs @value{EMACSVER} is the current version as of this writing. A version
number with two components (e.g., @samp{24.5}) indicates a released
version; three components indicate a development
-version (e.g., @samp{27.0.50} is what will eventually become @samp{27.1}).
+version (e.g., @samp{28.0.50} is what will eventually become @samp{28.1}).
Emacs is under active development, hosted at
@uref{https://savannah.gnu.org/projects/emacs/, Savannah}.
@@ -966,9 +967,66 @@ latest features, you may want to stick to the releases.
The following sections list some of the major new features in the last
few Emacs releases. For full details of the changes in any version of
-Emacs, type @kbd{C-h C-n} (@kbd{M-x view-emacs-news}). As of Emacs 22,
-you can give this command a prefix argument to read about which features
-were new in older versions.
+Emacs, type @kbd{C-h C-n} (@kbd{M-x view-emacs-news}). You can give
+this command a prefix argument to read about which features were new
+in older versions.
+
+@node New in Emacs 27
+@section What is different about Emacs 27?
+@cindex Differences between Emacs 26 and Emacs 27
+@cindex Emacs 27, new features in
+
+@itemize
+@cindex bignum support
+@item
+Emacs now uses the GNU Multiple Precision (@acronym{GMP}) library to
+support integers whose size is too large to support natively. The
+integers supported natively are known as ``fixnums'', while the larger
+ones are ``bignums''. All the arithmetic, comparison, and logical
+(also known as ``bitwise'') operations where bignums make sense now
+support both fixnums and bignums.
+
+@cindex HarfBuzz
+@item
+Emacs now uses HarfBuzz as its default shaping engine.
+
+@cindex JSON, native parsing
+@item
+Native support for @acronym{JSON} parsing that is much faster than
+@file{json.el}.
+
+@item
+Cairo drawing is no longer experimental.
+
+@cindex portable dumper
+@item
+Emacs now uses a ``portable dumper'' instead of unexec. This improves
+compatibility with memory allocation on modern systems, and in
+particular better supports the Address Space Layout Randomization
+(@acronym{ASLR}) feature, a security technique used by most modern
+operating systems.
+
+@cindex XDG convention
+@item
+Emacs can now use the @acronym{XDG} convention for init files.
+
+@cindex early init file
+@item
+Emacs can now be configured using an early init file. The primary
+purpose is to allow customizing how the package system is initialized
+given that initialization now happens before loading the regular init
+file.
+
+@cindex tabs
+@item
+Built-in support for tabs (tab bar and tab line).
+
+@item
+Support for resizing and rotating of images without ImageMagick.
+@end itemize
+
+Consult the Emacs @file{NEWS} file (@kbd{C-h n}) for the full list of
+changes in Emacs 27.
@node New in Emacs 26
@section What is different about Emacs 26?
@@ -1672,8 +1730,6 @@ would use with @code{display-line-numbers}.
There is also the @samp{linum} package (distributed with Emacs since
version 23.1) which will henceforth become obsolete. Users and
developers are encouraged to use @samp{display-line-numbers} instead.
-The packages @samp{setnu} and @samp{wb-line-number} (not distributed
-with Emacs) also implement this feature.
@node Displaying the current file name in the titlebar
@section How can I modify the titlebar to contain the current file name?
@@ -1694,7 +1750,7 @@ machine at which Emacs was invoked. This is done by setting
@code{frame-title-format} to the default value of
@lisp
-(multiple-frames "%b" ("" invocation-name "@@" (system-name)))
+(multiple-frames "%b" ("" "%b - GNU Emacs at " system-name))
@end lisp
To modify the behavior such that frame titlebars contain the buffer's
@@ -1725,14 +1781,6 @@ buffer by default, put this in your @file{.emacs} file:
(setq abbrev-mode t)))
@end lisp
-@noindent If your Emacs version is older then 22.1, you will also need to use:
-
-@lisp
-(condition-case ()
- (quietly-read-abbrev-file)
- (file-error nil))
-@end lisp
-
@node Associating modes with files
@section How do I make Emacs use a certain major mode for certain files?
@cindex Associating modes with files
@@ -2583,16 +2631,14 @@ effective way of doing that. Emacs automatically intercepts the compile
error messages, inserts them into a special buffer called
@file{*compilation*}, and lets you visit the locus of each message in
the source. Type @kbd{C-x `} to step through the offending lines one by
-one (starting with Emacs 22, you can also use @kbd{M-g M-p} and
-@kbd{M-g M-n} to go to the previous and next matches directly). Click
-@kbd{mouse-2} or press @key{RET} on a message text in the
-@file{*compilation*} buffer to go to the line whose number is mentioned
-in that message.
+one (you can also use @kbd{M-g M-p} and @kbd{M-g M-n} to go to the
+previous and next matches directly). Click @kbd{mouse-2} or press
+@key{RET} on a message text in the @file{*compilation*} buffer to go
+to the line whose number is mentioned in that message.
But if you indeed need to go to a certain text line, type @kbd{M-g M-g}
-(which is the default binding of the @code{goto-line} function starting
-with Emacs 22). Emacs will prompt you for the number of the line and go
-to that line.
+(which is the default binding of the @code{goto-line} function).
+Emacs will prompt you for the number of the line and go to that line.
You can do this faster by invoking @code{goto-line} with a numeric
argument that is the line's number. For example, @kbd{C-u 286 M-g M-g}
@@ -2825,13 +2871,13 @@ Add the following line to your @file{.emacs} file:
@cindex @code{ls} in Shell mode
In many systems, @code{ls} is aliased to @samp{ls --color}, which
-prints using ANSI color escape sequences. Emacs version 21.1 and
-later includes the @code{ansi-color} package, which lets Shell mode
-recognize these escape sequences. In Emacs 23.2 and later, the
-package is enabled by default; in earlier versions you can enable it
-by typing @kbd{M-x ansi-color-for-comint-mode} in the Shell buffer, or
-by adding @code{(add-hook 'shell-mode-hook
-'ansi-color-for-comint-mode-on)} to your init file.
+prints using ANSI color escape sequences. Emacs includes the
+@code{ansi-color} package, which lets Shell mode recognize these
+escape sequences. In Emacs 23.2 and later, the package is enabled by
+default; in earlier versions you can enable it by typing @kbd{M-x
+ansi-color-for-comint-mode} in the Shell buffer, or by adding
+@code{(add-hook 'shell-mode-hook 'ansi-color-for-comint-mode-on)} to
+your init file.
@node Fullscreen mode on MS-Windows
@section How can I start Emacs in fullscreen mode on MS-Windows?
@@ -3210,12 +3256,11 @@ arbitrary Emacs Lisp code evaluated when the file is visited.
Obviously, there is a potential for Trojan horses to exploit this
feature.
-As of Emacs 22, Emacs has a list of local variables that are known to
-be safe to set. If a file tries to set any variable outside this
-list, it asks the user to confirm whether the variables should be set.
-You can also tell Emacs whether to allow the evaluation of Emacs Lisp
-code found at the bottom of files by setting the variable
-@code{enable-local-eval}.
+Emacs has a list of local variables that are known to be safe to set.
+If a file tries to set any variable outside this list, it asks the
+user to confirm whether the variables should be set. You can also tell
+Emacs whether to allow the evaluation of Emacs Lisp code found at the
+bottom of files by setting the variable @code{enable-local-eval}.
@xref{File Variables,,, emacs, The GNU Emacs Manual}.
@@ -3333,7 +3378,7 @@ the main GNU distribution site, sources are available as
@c Don't include VER in the file name, because pretests are not there.
@uref{https://ftp.gnu.org/pub/gnu/emacs/emacs-VERSION.tar.gz}
-(Replace @samp{VERSION} with the relevant version number, e.g., @samp{23.1}.)
+(Replace @samp{VERSION} with the relevant version number, e.g., @samp{28.1}.)
@item
Next uncompress and extract the source files. This requires
@@ -3403,7 +3448,7 @@ problem (@pxref{Reporting bugs}).
* Packages that do not come with Emacs::
* Spell-checkers::
* Current GNU distributions::
-* Difference between Emacs and XEmacs::
+* What was XEmacs?::
* Emacs for minimalists::
* Emacs for MS-DOS::
* Emacs for MS-Windows::
@@ -3539,35 +3584,21 @@ A list of sites mirroring @samp{ftp.gnu.org} can be found at
@uref{https://www.gnu.org/prep/ftp}
-@node Difference between Emacs and XEmacs
-@section What is the difference between Emacs and XEmacs (formerly Lucid Emacs)?
+@node What was XEmacs?
+@section What was XEmacs?
@cindex XEmacs
-@cindex Difference Emacs and XEmacs
-@cindex Lucid Emacs
-@cindex Epoch
XEmacs was a branch version of Emacs that is no longer actively
-developed. XEmacs was first called Lucid Emacs, and was initially
-derived from a prerelease version of Emacs 19. In this FAQ, we use
-the name ``Emacs'' only for the official version.
-
-XEmacs last released a new version on January 30, 2009, and it lacks
-many important features that exists in Emacs. In the past, it was not
-uncommon for Emacs packages to include code for compatibility with
-XEmacs. Nowadays, although some packages still maintain such
-compatibility code, several of the more popular built-in and third
-party packages have either stopped supporting XEmacs or were developed
-exclusively for Emacs.
+developed. XEmacs last released a new version on January 30, 2009,
+and it lacks many important features that exist in Emacs. Since its
+development has stopped, we do not expect to see any new releases.
-Some XEmacs code has been contributed to Emacs, and we would like to
-use other parts, but the earlier XEmacs maintainers did not always
-keep track of the authors of contributed code, which makes it
-impossible for the FSF to get copyright papers signed for that code.
-(The FSF requires these papers for all the code included in the Emacs
-release, aside from generic C support packages that retain their
-separate identity and are not integrated into the code of Emacs
-proper.)
+In the past, it was not uncommon for Emacs packages to include code
+for compatibility with XEmacs. Nowadays, most built-in and third party
+packages have either stopped supporting XEmacs or were developed
+exclusively for Emacs.
+XEmacs was initially derived from a prerelease version of Emacs 19.
If you want to talk about these two versions and distinguish them,
please call them ``Emacs'' and ``XEmacs.'' To contrast ``XEmacs''
with ``GNU Emacs'' would be misleading, since XEmacs too has its
@@ -3633,8 +3664,8 @@ For MS-DOS, @pxref{Emacs for MS-DOS}.
@section Where can I get Emacs for GNUstep?
@cindex GNUstep, Emacs for
-Beginning with version 23.1, Emacs supports GNUstep natively.
-See the file @file{nextstep/INSTALL} in the distribution.
+Emacs supports GNUstep natively. See the file @file{nextstep/INSTALL}
+in the distribution.
@node Emacs for macOS
@section Where can I get Emacs for macOS?
@@ -3642,8 +3673,8 @@ See the file @file{nextstep/INSTALL} in the distribution.
@cindex Macintosh, Emacs for
@cindex macOS, Emacs for
-Beginning with version 22.1, Emacs supports macOS natively.
-See the file @file{nextstep/INSTALL} in the distribution.
+Emacs supports macOS natively. See the file @file{nextstep/INSTALL}
+in the distribution.
@c ------------------------------------------------------------
@node Key bindings
diff --git a/doc/misc/eieio.texi b/doc/misc/eieio.texi
index 8dd394cb848..4952e909902 100644
--- a/doc/misc/eieio.texi
+++ b/doc/misc/eieio.texi
@@ -12,7 +12,7 @@
@copying
This manual documents EIEIO, an object framework for Emacs Lisp.
-Copyright @copyright{} 2007--2020 Free Software Foundation, Inc.
+Copyright @copyright{} 2007--2021 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
diff --git a/doc/misc/emacs-gnutls.texi b/doc/misc/emacs-gnutls.texi
index bb13ebdf238..fbc4443c0ad 100644
--- a/doc/misc/emacs-gnutls.texi
+++ b/doc/misc/emacs-gnutls.texi
@@ -9,7 +9,7 @@
@copying
This file describes the Emacs GnuTLS integration.
-Copyright @copyright{} 2012--2020 Free Software Foundation, Inc.
+Copyright @copyright{} 2012--2021 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
diff --git a/doc/misc/emacs-mime.texi b/doc/misc/emacs-mime.texi
index 316a1baf576..0cf5ba96506 100644
--- a/doc/misc/emacs-mime.texi
+++ b/doc/misc/emacs-mime.texi
@@ -10,7 +10,7 @@
@copying
This file documents the Emacs MIME interface functionality.
-Copyright @copyright{} 1998--2020 Free Software Foundation, Inc.
+Copyright @copyright{} 1998--2021 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
diff --git a/doc/misc/epa.texi b/doc/misc/epa.texi
index fa1833a3da6..cca0d300fa7 100644
--- a/doc/misc/epa.texi
+++ b/doc/misc/epa.texi
@@ -10,7 +10,7 @@
@copying
This file describes EasyPG Assistant @value{VERSION}.
-Copyright @copyright{} 2007--2020 Free Software Foundation, Inc.
+Copyright @copyright{} 2007--2021 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi
index cb2e83270e6..d635cac5abb 100644
--- a/doc/misc/erc.texi
+++ b/doc/misc/erc.texi
@@ -10,7 +10,7 @@
@copying
This manual is for ERC as distributed with Emacs @value{EMACSVER}.
-Copyright @copyright{} 2005--2020 Free Software Foundation, Inc.
+Copyright @copyright{} 2005--2021 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -284,8 +284,8 @@ Complete the given word, using ispell.
@item C-c C-a (@code{erc-bol})
Go to beginning of line or end of prompt.
-@item C-c C-b (@code{erc-iswitchb})
-Use @code{iswitchb-read-buffer} to prompt for a ERC buffer to switch to.
+@item C-c C-b (@code{erc-switch-to-buffer})
+Use @code{read-buffer} to prompt for a ERC buffer to switch to.
@item C-c C-c (@code{erc-toggle-interpret-controls})
Toggle interpretation of control sequences in messages.
diff --git a/doc/misc/ert.texi b/doc/misc/ert.texi
index bc56a4af99f..a4e2cb506a3 100644
--- a/doc/misc/ert.texi
+++ b/doc/misc/ert.texi
@@ -15,7 +15,7 @@
@end direntry
@copying
-Copyright @copyright{} 2008, 2010--2020 Free Software Foundation, Inc.
+Copyright @copyright{} 2008, 2010--2021 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi
index c33ca0ea02c..e106f39cdd9 100644
--- a/doc/misc/eshell.texi
+++ b/doc/misc/eshell.texi
@@ -10,7 +10,7 @@
@copying
This manual is for Eshell, the Emacs shell.
-Copyright @copyright{} 1999--2020 Free Software Foundation, Inc.
+Copyright @copyright{} 1999--2021 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -652,7 +652,7 @@ Eshell solves this problem by running such programs in Emacs's
terminal emulator.
Programs that need a terminal to display output properly are referred
-to in this manual as ``visual commands,'' because they are not simply
+to in this manual as ``visual commands'', because they are not simply
line-oriented. You must tell Eshell which commands are visual, by
adding them to @code{eshell-visual-commands}; for commands that are
visual for only certain @emph{sub}-commands -- e.g., @samp{git log} but
diff --git a/doc/misc/eudc.texi b/doc/misc/eudc.texi
index 69a8512f175..b40277003c3 100644
--- a/doc/misc/eudc.texi
+++ b/doc/misc/eudc.texi
@@ -14,7 +14,7 @@ This file documents EUDC version 1.40.0.
EUDC is the Emacs Unified Directory Client, a common interface to
directory servers and contact information.
-Copyright @copyright{} 1998, 2000--2020 Free Software Foundation, Inc.
+Copyright @copyright{} 1998, 2000--2021 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
diff --git a/doc/misc/eww.texi b/doc/misc/eww.texi
index 1bccbd7261a..6e82a97030e 100644
--- a/doc/misc/eww.texi
+++ b/doc/misc/eww.texi
@@ -8,7 +8,7 @@
@copying
This file documents the GNU Emacs Web Wowser (EWW) package.
-Copyright @copyright{} 2014--2020 Free Software Foundation, Inc.
+Copyright @copyright{} 2014--2021 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -262,6 +262,12 @@ fetching images that originate from the same source as the
retrieving these images'' and @code{t} means ``always send cookies
when retrieving these images''.
+@vindex eww-use-browse-url
+ When following links in EWW, @acronym{URL}s that match the
+@code{eww-use-browse-url} regexp will be passed to @code{browse-url}
+instead of EWW handling them itself. The action can be further
+customized by altering @code{browse-url-handlers}.
+
@vindex eww-header-line-format
@cindex Header
The header line of the EWW buffer can be changed by customizing
diff --git a/doc/misc/flymake.texi b/doc/misc/flymake.texi
index b4757938e99..9c838a8341a 100644
--- a/doc/misc/flymake.texi
+++ b/doc/misc/flymake.texi
@@ -14,7 +14,7 @@
This manual is for GNU Flymake (version @value{VERSION}, @value{UPDATED}),
which is a universal on-the-fly syntax checker for GNU Emacs.
-Copyright @copyright{} 2004--2020 Free Software Foundation, Inc.
+Copyright @copyright{} 2004--2021 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -213,6 +213,13 @@ This section summarizes customization variables used for the
configuration of the Flymake user interface.
@vtable @code
+@item flymake-mode-line-format
+Format to use for the Flymake mode line indicator.
+
+@item flymake-mode-line-counter-format
+Mode-line construct for formatting Flymake diagnostic counters inside
+the Flymake mode line indicator.
+
@item flymake-no-changes-timeout
If any changes are made to the buffer, syntax check is automatically
started after this many seconds, unless the user makes another change,
@@ -581,7 +588,8 @@ can use the following function:
Compute @var{buffer}'s region (@var{beg} . @var{end}) corresponding
to @var{line} and @var{col}. If @var{col} is @code{nil}, return a
region just for @var{line}. Return @code{nil} if the region is
-invalid.
+invalid. This function saves match data (@pxref{Saving Match Data,,,
+elisp, The Emacs Lisp Reference Manual}).
@end deffn
@cindex add a log message
diff --git a/doc/misc/forms.texi b/doc/misc/forms.texi
index 20b0904ad1a..3d7ac96cc24 100644
--- a/doc/misc/forms.texi
+++ b/doc/misc/forms.texi
@@ -19,7 +19,7 @@
@copying
This file documents Forms mode, a form-editing major mode for GNU Emacs.
-Copyright @copyright{} 1989, 1997, 2001--2020 Free Software Foundation,
+Copyright @copyright{} 1989, 1997, 2001--2021 Free Software Foundation,
Inc.
@quotation
diff --git a/doc/misc/gnus-coding.texi b/doc/misc/gnus-coding.texi
index 9a14a95f797..94d952b423d 100644
--- a/doc/misc/gnus-coding.texi
+++ b/doc/misc/gnus-coding.texi
@@ -8,7 +8,7 @@
@syncodeindex pg cp
@copying
-Copyright @copyright{} 2004--2005, 2007--2020 Free Software Foundation,
+Copyright @copyright{} 2004--2005, 2007--2021 Free Software Foundation,
Inc.
@quotation
diff --git a/doc/misc/gnus-faq.texi b/doc/misc/gnus-faq.texi
index adb812f5728..4c29976c05e 100644
--- a/doc/misc/gnus-faq.texi
+++ b/doc/misc/gnus-faq.texi
@@ -1,7 +1,7 @@
@c \input texinfo @c -*-texinfo-*-
@c Uncomment 1st line before texing this file alone.
@c %**start of header
-@c Copyright (C) 1995, 2001--2020 Free Software Foundation, Inc.
+@c Copyright (C) 1995, 2001--2021 Free Software Foundation, Inc.
@c
@c @setfilename gnus-faq.info
@c @settitle Frequently Asked Questions
@@ -1523,10 +1523,10 @@ Now you only have to tell Gnus to include the X-face in your postings by saying
@example
(setq message-default-headers
- (with-temp-buffer
- (insert "X-Face: ")
- (insert-file-contents "~/.xface")
- (buffer-string)))
+ (with-temp-buffer
+ (insert "X-Face: ")
+ (insert-file-contents "~/.xface")
+ (buffer-string)))
@end example
@noindent
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 69ac05d5aa9..5a79cbc08fc 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -8,7 +8,7 @@
@syncodeindex pg cp
@copying
-Copyright @copyright{} 1995--2020 Free Software Foundation, Inc.
+Copyright @copyright{} 1995--2021 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -795,19 +795,11 @@ Advanced Scoring
Searching
-* nnir:: Searching with various engines.
+* Search Engines:: Selecting and configuring search engines.
+* Creating Search Groups:: Creating search groups.
+* Search Queries:: Gnus' built-in search syntax.
* nnmairix:: Searching with Mairix.
-nnir
-
-* What is nnir?:: What does nnir do.
-* Basic Usage:: How to perform simple searches.
-* Setting up nnir:: How to set up nnir.
-
-Setting up nnir
-
-* Associating Engines:: How to associate engines.
-
Various
* Process/Prefix:: A convention used by many treatment commands.
@@ -5036,10 +5028,37 @@ Nothing if the article is a root and lots of spaces if it isn't (it
pushes everything after it off the screen).
@item [
Opening bracket, which is normally @samp{[}, but can also be @samp{<}
-for adopted articles (@pxref{Customizing Threading}).
+for adopted articles (@pxref{Customizing Threading}). This can be
+customized using following settings:
+
+@table @code
+@item gnus-sum-opening-bracket
+@vindex gnus-sum-opening-bracket
+Opening bracket for normal (non-adopted) articles. The default is
+@samp{[}.
+
+@item gnus-sum-opening-bracket-adopted
+@vindex gnus-sum-opening-bracket-adopted
+Opening bracket for adopted articles. The default is @samp{<}.
+
+@end table
+
@item ]
Closing bracket, which is normally @samp{]}, but can also be @samp{>}
-for adopted articles.
+for adopted articles. This can be customised using following settings:
+
+@table @code
+@item gnus-sum-closing-bracket
+@vindex gnus-sum-closing-bracket
+Closing bracket for normal (non-adopted) articles. The default is
+@samp{]}.
+
+@item gnus-sum-closing-bracket-adopted
+@vindex gnus-sum-opening-bracket-adopted
+Closing bracket for adopted articles. The default is @samp{>}.
+
+@end table
+
@item >
One space for each thread level.
@item <
@@ -5369,6 +5388,15 @@ articles with the same subject, go to the first unread article.
This variable is not particularly useful if you use a threaded display.
+@item gnus-paging-select-next
+@vindex gnus-paging-select-next
+Control whether to select the next/previous article when paging (with
+commands like @kbd{SPC} or @kbd{DEL}). If non-@code{nil}, select the
+next article when reaching the end of the article (or the previous
+article when paging backwards).
+
+If @code{nil}, don't do anything at the end/start of the articles.
+
@item gnus-summary-check-current
@vindex gnus-summary-check-current
If non-@code{nil}, all the ``unread'' movement commands will not proceed
@@ -14520,6 +14548,14 @@ The default is @samp{(%Deleted %Seen)}.
@end table
+@vindex nnimap-split-download-body
+By default, the nnimap back end only retrieves the message headers;
+the option @code{nnimap-split-download-body} (which is a regular
+customization option, not a server variable) tells it to retrieve the
+message bodies as well. We don't set this by default because it will
+slow @acronym{IMAP} down, and that is not an appropriate decision to
+make on behalf of the user.
+
Here's a complete example @code{nnimap} backend with a client-side
``fancy'' splitting method:
@@ -17919,12 +17955,11 @@ Or we may wish to create a group from the results of a search query:
@lisp
(nnselect-specs
- (nnselect-function . nnir-run-query)
+ (nnselect-function . gnus-search-run-query)
(nnselect-args
- (nnir-query-spec
- (query . "FLAGGED")
- (criteria . ""))
- (nnir-group-spec
+ (search-query-spec
+ (query . "mark:flag"))
+ (search-group-spec
("nnimap:home")
("nnimap:work"))))
@end lisp
@@ -17945,9 +17980,8 @@ find all message that have been received recently from certain groups:
(days-to-time (car args)))))
(cons 'criteria "")))
(group-spec (cadr args)))
- (nnir-run-query (cons 'nnir-specs
- (list (cons 'nnir-query-spec query-spec)
- (cons 'nnir-group-spec group-spec))))))
+ (gnus-search-run-query (list (cons 'search-query-spec query-spec)
+ (cons 'search-group-spec group-spec)))))
@end lisp
Then the following @code{nnselect-specs}:
@@ -17970,18 +18004,13 @@ parameter of @code{nnselect-rescan} will allow automatic refreshing.
A refresh can always be invoked manually through
@code{gnus-group-get-new-news-this-group}.
-The nnir interface (@pxref{nnir}) includes engines for searching a
-variety of backends. While the details of each search engine vary,
-the result of an nnir search is always a vector of the sort used by
-the nnselect method, and the results of nnir queries are usually
-viewed using an nnselect group. Indeed the standard search function
-@code{gnus-group-read-ephemeral-search-group} just creates an
-ephemeral nnselect group with the appropriate nnir query as the
-@code{nnselect-specs}. nnir originally included both the search
-engines and the glue to connect search results to gnus. Over time
-this glue evolved into the nnselect method. The two had a mostly
-amicable parting so that nnselect could pursue its dream of becoming a
-fully functioning backend, but occasional conflicts may still linger.
+Gnus includes engines for searching a variety of backends. While the
+details of each search engine vary, the result of a search is always a
+vector of the sort used by the nnselect method, and the results of
+queries are usually viewed using an nnselect group. Indeed the
+standard search function @code{gnus-group-read-ephemeral-search-group}
+just creates an ephemeral nnselect group with the appropriate search
+query as the @code{nnselect-specs}.
@node Combined Groups
@subsection Combined Groups
@@ -20166,7 +20195,7 @@ Phu.
For example, to do hierarchical scoring but use a non-server-specific
overall score file, you could use the value
@example
-(list (lambda (group) ("all.SCORE"))
+(list (lambda (group) (list "all.SCORE"))
'gnus-score-find-hierarchical)
@end example
@@ -21445,9 +21474,6 @@ four days, Gnus will decay the scores four times, for instance.
@chapter Searching
@cindex searching
-FIXME: A brief comparison of nnir, nnmairix, contrib/gnus-namazu would
-be nice.
-
Gnus has various ways of finding articles that match certain criteria
(from a particular author, on a certain subject, etc.). The simplest
method is to enter a group and then either "limit" the summary buffer
@@ -21455,50 +21481,166 @@ to the desired articles using the limiting commands (@pxref{Limiting}),
or searching through messages in the summary buffer (@pxref{Searching
for Articles}).
-Limiting commands and summary buffer searching work on subsets of the
-articles already fetched from the servers, and these commands won't
-query the server for additional articles. While simple, these methods
-are therefore inadequate if the desired articles span multiple groups,
-or if the group is so large that fetching all articles is impractical.
-Many backends (such as imap, notmuch, namazu, etc.) provide their own
-facilities to search for articles directly on the server and Gnus can
-take advantage of these methods. This chapter describes tools for
-searching groups and servers for articles matching a query.
+Limiting commands and summary buffer searching work on articles
+already fetched from the servers, and these commands won't query the
+server for additional articles. While simple, these methods are
+therefore inadequate if the desired articles span multiple groups, or
+if the group is so large that fetching all articles is impractical.
+
+It's possible to search a backend more thoroughly using an associated
+search engine. Some backends come with their own search engine: IMAP
+servers, for instance, do their own searching. Other backends, for
+example a local @code{nnmaildir} installation, might require the user
+to manually set up some sort of search indexing. Default associations
+between backends and engines can be defined in
+@code{gnus-search-default-engines}, and engines can also be defined on
+a per-backend basis (@pxref{Search Engines}).
+
+Once the search engines are set up, you can search for messages in
+groups from one or more backends, and show the results in a group.
+The groups that hold search results are created on the nnselect
+backend, and can be either ephemeral or persistent (@pxref{Creating
+Search Groups}).
+
+@vindex gnus-search-use-parsed-queries
+Search queries can be specified one of two ways: either using the
+syntax of the engine responsible for the group you're searching, or
+using Gnus' generalized search syntax. Set the option
+@code{gnus-search-use-parsed-queries} to a non-nil value to used the
+generalized syntax. The advantage of this syntax is that, if you have
+multiple backends indexed by different engines, you don't need to
+remember which one you're searching---it's also possible to issue the
+same query against multiple groups, indexed by different engines, at
+the same time. It also provides a few other conveniences including
+relative date parsing and tie-ins into other Emacs packages. For
+details on Gnus' query language, see @ref{Search Queries}.
@menu
-* nnir:: Searching with various engines.
-* nnmairix:: Searching with Mairix.
+* Search Engines:: Selecting and configuring search engines.
+* Creating Search Groups:: How and where.
+* Search Queries:: Gnus' built-in search syntax.
+* nnmairix:: Searching with Mairix.
@end menu
-@node nnir
-@section nnir
-@cindex nnir
+@node Search Engines
+@section Search Engines
+@cindex search engines
+@cindex configuring search
+
+In order to search for messages from any given server, that server
+must have a search engine associated with it. IMAP servers do their
+own searching (theoretically it is possible to use a different engine
+to search an IMAP store, but we don't recommend it), but in all other
+cases the user will have to manually specify an engine to use. This
+can be done at two different levels: by server type, or on a
+per-server basis.
+
+@vindex gnus-search-default-engines
+The option @code{gnus-search-default-engines} assigns search engines
+by server type. Its value is an alist mapping symbols indicating a
+server type (e.g.@: @code{nnmaildir} or @code{nnml}) to symbols
+indicating a search engine class. The built-in search engine symbols
+are:
-This section describes how to use @code{nnir} to search for articles
-within gnus.
+@itemize
+@item
+@code{gnus-search-imap}
-@menu
-* What is nnir?:: What does @code{nnir} do?
-* Basic Usage:: How to perform simple searches.
-* Setting up nnir:: How to set up @code{nnir}.
-@end menu
+@item
+@code{gnus-search-find-grep}
-@node What is nnir?
-@subsection What is nnir?
+@item
+@code{gnus-search-notmuch}
-@code{nnir} is a Gnus interface to a number of tools for searching
-through mail and news repositories. Different backends (like
-@code{nnimap} and @code{nntp}) work with different tools (called
-@dfn{engines} in @code{nnir} lingo), but all use the same basic search
-interface.
+@item
+@code{gnus-search-swish-e}
+
+@item
+@code{gnus-search-swish++}
+
+@item
+@code{gnus-search-mairix}
-The @code{nnimap} search engine should work with no configuration.
-Other engines may require a local index that needs to be created and
-maintained outside of Gnus.
+@item
+@code{gnus-search-namazu}
+@end itemize
+
+If you need more granularity, you can specify a search engine in the
+server definition, using the @code{gnus-search-engine} key, whether
+that be in your @file{.gnus.el} config file, or through Gnus' server
+buffer. That might look like:
+@example
+'(nnmaildir "My Mail"
+ (directory "/home/user/.mail")
+ (gnus-search-engine gnus-search-notmuch
+ (config-file "/home/user/.mail/.notmuch_config")))
+@end example
-@node Basic Usage
-@subsection Basic Usage
+Search engines like notmuch, namazu and mairix are similar in
+behavior: they use a local executable to create an index of a message
+store, and run command line search queries against those messages,
+and return a list of absolute file names of matching messages.
+
+These engines have a handful of configuration parameters in common.
+These common parameters are:
+
+@table @code
+@item program
+The name of the executable. Defaults to the plain
+program name such as @command{notmuch} or @command{namazu}.
+
+@item config-file
+The absolute filename of the configuration file for this search
+engine.
+
+@item remove-prefix
+The directory part to be removed from the filenames returned by the
+search query. This absolute path should include everything up to the
+top level of the message store.
+
+@item switches
+Additional command-line switches to be fed to the search program. The
+value of this parameter must be a list of strings, one string per
+switch.
+@end table
+
+The options above can be set in one of two ways: using a customization
+option that is set for all engines of that type, or on a per-engine
+basis in your server configuration files.
+
+The customization options are formed on the pattern
+@code{gnus-search-@var{engine}-@var{parameter}}. For instance, to use a
+non-standard notmuch program, you might set
+@code{gnus-search-notmuch-program} to @file{/usr/local/bin/notmuch}.
+This would apply to all notmuch engines. The engines that use these
+options are: ``notmuch'', ``namazu'', ``mairix'', ``swish-e'' and
+``swish++''.
+
+Alternately, the options can be set directly on your Gnus server
+definitions, for instance, in the @code{nnmaildir} example above.
+Note that the server options are part of the @code{gnus-search-engine}
+sexp, and the option symbol and value form a two-element list, not a
+cons cell.
+
+The namazu and swish-e engines each have one additional option,
+specifying where to store their index files. For namazu it is
+@code{index-directory}, and should be a single directory path. For
+swish-e it is @code{index-files}, and should be a list of strings.
+
+All indexed search engines come with their own method of updating
+their search indexes to include newly-arrived messages. Gnus
+currently provides no convenient interface for this, and you'll have
+to manage updates yourself, though this will likely change in the
+future.
+
+Lastly, all search engines accept a @code{raw-queries-p} option. This
+indicates that engines of this type (or this particular engine) should
+always use raw queries, never parsed (@pxref{Search Queries}).
+
+@node Creating Search Groups
+@section Creating Search Groups
+@cindex creating search groups
In the group buffer typing @kbd{G G} will search the group on the
current line by calling @code{gnus-group-read-ephemeral-search-group}.
@@ -21525,297 +21667,133 @@ in their original group. You can @emph{warp} (i.e., jump) to the
original group for the article on the current line with @kbd{A W}, aka
@code{gnus-warp-to-article}.
-You say you want to search more than just the group on the current line?
-No problem: just process-mark the groups you want to search. You want
-even more? Calling for an nnir search with the cursor on a topic heading
-will search all the groups under that heading.
+You say you want to search more than just the group on the current
+line? No problem: just process-mark the groups you want to search.
+You want even more? Initiating a search with the cursor on a topic
+heading will search all the groups under that topic.
+@vindex gnus-search-ignored-newsgroups
Still not enough? OK, in the server buffer
-@code{gnus-group-read-ephemeral-search-group} (now bound to @kbd{G})
+@code{gnus-group-read-ephemeral-search-group} (here bound to @kbd{G})
will search all groups from the server on the current line. Too much?
Want to ignore certain groups when searching, like spam groups? Just
-customize @code{nnir-ignored-newsgroups}.
-
-One more thing: individual search engines may have special search
-features. You can access these special features by giving a
-prefix-arg to @code{gnus-group-read-ephemeral-search-group}. If you
-are searching multiple groups with different search engines you will
-be prompted for the special search features for each engine
-separately.
-
-
-@node Setting up nnir
-@subsection Setting up nnir
-
-To set up nnir you may need to do some prep work. Firstly, you may
-need to configure the search engines you plan to use. Some of them,
-like @code{imap}, need no special configuration. Others, like
-@code{namazu} and @code{swish}, require configuration as described
-below. Secondly, you need to associate a search engine with a server
-or a backend.
-
-If you just want to use the @code{imap} engine to search @code{nnimap}
-servers then you don't have to do anything. But you might want to
-read the details of the query language anyway.
-
-@menu
-* Associating Engines:: How to associate engines.
-* The imap Engine:: Imap configuration and usage.
-* The swish++ Engine:: Swish++ configuration and usage.
-* The swish-e Engine:: Swish-e configuration and usage.
-* The namazu Engine:: Namazu configuration and usage.
-* The notmuch Engine:: Notmuch configuration and usage.
-* The hyrex Engine:: Hyrex configuration and usage.
-* Customizations:: User customizable settings.
-@end menu
-
-@node Associating Engines
-@subsubsection Associating Engines
-
-
-When searching a group, @code{nnir} needs to know which search engine to
-use. You can configure a given server to use a particular engine by
-setting the server variable @code{nnir-search-engine} to the engine
-name. For example to use the @code{namazu} engine to search the server
-named @code{home} you can use
-
-@lisp
-(setq gnus-secondary-select-methods
- '((nnml "home"
- (nnimap-address "localhost")
- (nnir-search-engine namazu))))
-@end lisp
-
-Alternatively you might want to use a particular engine for all servers
-with a given backend. For example, you might want to use the @code{imap}
-engine for all servers using the @code{nnimap} backend. In this case you
-can customize the variable @code{nnir-method-default-engines}. This is
-an alist of pairs of the form @code{(backend . engine)}. By default this
-variable is set to use the @code{imap} engine for all servers using the
-@code{nnimap} backend. But if you wanted to use @code{namazu} for all
-your servers with an @code{nnimap} backend you could change this to
-
-@lisp
-'((nnimap . namazu))
-@end lisp
-
-@node The imap Engine
-@subsubsection The imap Engine
-
-The @code{imap} engine requires no configuration.
-
-Queries using the @code{imap} engine follow a simple query language.
-The search is always case-insensitive and supports the following
-features (inspired by the Google search input language):
-
-@table @samp
-
-@item Boolean query operators
-AND, OR, and NOT are supported, and parentheses can be used to control
-operator precedence, e.g., (emacs OR xemacs) AND linux. Note that
-operators must be written with all capital letters to be
-recognized. Also preceding a term with a @minus{} sign is equivalent
-to NOT term.
+customize @code{gnus-search-ignored-newsgroups}: groups matching this
+regexp will not be searched.
+
+@node Search Queries
+@section Search Queries
+@cindex search queries
+@cindex search syntax
+
+Gnus provides an optional unified search syntax that can be used
+across all supported search engines. This can be convenient in that
+you don't have to remember different search syntaxes; it's also
+possible to mark multiple groups indexed by different engines and
+issue a single search against them.
+
+@vindex gnus-search-use-parsed-queries
+Set the option @code{gnus-search-use-parsed-queries} to non-@code{nil}
+to enable this---it is @code{nil} by default. Even if it is
+non-@code{nil}, it's still possible to turn off parsing for a class of
+engines or a single engine (@pxref{Search Engines}), or a single
+search by giving a prefix argument to any of the search commands.
+
+The search syntax is fairly simple: keys and values are separated by a
+colon, multi-word values must be quoted, ``and'' is implicit, ``or''
+is explicit, ``not'' will negate the following expression (or keys can
+be prefixed with a ``-''),and parentheses can be used to group logical
+sub-clauses. For example:
-@item Automatic AND queries
-If you specify multiple words then they will be treated as an AND
-expression intended to match all components.
-
-@item Phrase searches
-If you wrap your query in double-quotes then it will be treated as a
-literal string.
-
-@end table
-
-By default the whole message will be searched. The query can be limited
-to a specific part of a message by using a prefix-arg. After inputting
-the query this will prompt (with completion) for a message part.
-Choices include ``Whole message'', ``Subject'', ``From'', and
-``To''. Any unrecognized input is interpreted as a header name. For
-example, typing @kbd{Message-ID} in response to this prompt will limit
-the query to the Message-ID header.
-
-Finally selecting ``Imap'' will interpret the query as a raw
-@acronym{IMAP} search query. The format of such queries can be found in
-RFC3501.
-
-If you don't like the default of searching whole messages you can
-customize @code{nnir-imap-default-search-key}. For example to use
-@acronym{IMAP} queries by default
-
-@lisp
-(setq nnir-imap-default-search-key "Imap")
-@end lisp
-
-@node The swish++ Engine
-@subsubsection The swish++ Engine
-
-FIXME: Say something more here.
-
-Documentation for swish++ may be found at the swish++ sourceforge page:
-@uref{http://swishplusplus.sourceforge.net}
-
-@table @code
-
-@item nnir-swish++-program
-The name of the swish++ executable. Defaults to @code{search}
-
-@item nnir-swish++-additional-switches
-A list of strings to be given as additional arguments to
-swish++. @code{nil} by default.
-
-@item nnir-swish++-remove-prefix
-The prefix to remove from each file name returned by swish++ in order
-to get a group name. By default this is @code{$HOME/Mail}.
-
-@end table
-
-@node The swish-e Engine
-@subsubsection The swish-e Engine
-
-FIXME: Say something more here.
-
-@table @code
-
-@item nnir-swish-e-program
-The name of the swish-e search program. Defaults to @code{swish-e}.
-
-@item nnir-swish-e-additional-switches
-A list of strings to be given as additional arguments to
-swish-e. @code{nil} by default.
-
-@item nnir-swish-e-remove-prefix
-The prefix to remove from each file name returned by swish-e in order
-to get a group name. By default this is @code{$HOME/Mail}.
-
-@end table
-
-@node The namazu Engine
-@subsubsection The namazu Engine
-
-Using the namazu engine requires creating and maintaining index files.
-One directory should contain all the index files, and nnir must be told
-where to find them by setting the @code{nnir-namazu-index-directory}
-variable.
-
-To work correctly the @code{nnir-namazu-remove-prefix} variable must
-also be correct. This is the prefix to remove from each file name
-returned by Namazu in order to get a proper group name (albeit with @samp{/}
-instead of @samp{.}).
-
-For example, suppose that Namazu returns file names such as
-@samp{/home/john/Mail/mail/misc/42}. For this example, use the
-following setting: @code{(setq nnir-namazu-remove-prefix
-"/home/john/Mail/")} Note the trailing slash. Removing this prefix from
-the directory gives @samp{mail/misc/42}. @code{nnir} knows to remove
-the @samp{/42} and to replace @samp{/} with @samp{.} to arrive at the
-correct group name @samp{mail.misc}.
-
-Extra switches may be passed to the namazu search command by setting the
-variable @code{nnir-namazu-additional-switches}. It is particularly
-important not to pass any switches to namazu that will change the
-output format. Good switches to use include @option{--sort},
-@option{--ascending}, @option{--early} and @option{--late}.
-Refer to the Namazu documentation for further
-information on valid switches.
-
-Mail must first be indexed with the @command{mknmz} program. Read the
-documentation for namazu to create a configuration file. Here is an
-example:
-
-@cartouche
@example
- package conf; # Don't remove this line!
-
- # Paths which will not be indexed. Don't use '^' or '$' anchors.
- $EXCLUDE_PATH = "spam|sent";
-
- # Header fields which should be searchable. case-insensitive
- $REMAIN_HEADER = "from|date|message-id|subject";
-
- # Searchable fields. case-insensitive
- $SEARCH_FIELD = "from|date|message-id|subject";
-
- # The max length of a word.
- $WORD_LENG_MAX = 128;
-
- # The max length of a field.
- $MAX_FIELD_LENGTH = 256;
+(from:john or from:peter) subject:"lunch tomorrow" since:3d
@end example
-@end cartouche
-For this example, mail is stored in the directories @samp{~/Mail/mail/},
-@samp{~/Mail/lists/} and @samp{~/Mail/archive/}, so to index them go to
-the index directory set in @code{nnir-namazu-index-directory} and issue
-the following command:
+The syntax is made to be accepted by a wide range of engines, and thus
+will happily accept most input, valid or not. Some terms will only be
+meaningful to some engines; other engines will drop them silently.
-@example
-mknmz --mailnews ~/Mail/archive/ ~/Mail/mail/ ~/Mail/lists/
-@end example
-
-For maximum searching efficiency you might want to have a cron job run
-this command periodically, say every four hours.
-
-
-@node The notmuch Engine
-@subsubsection The notmuch Engine
+Key completion is offered on @key{TAB}, but it's also possible to
+enter the query with abbreviated keys, which will be expanded during
+parsing. If a key is abbreviated to the point of ambiguity (for
+instance, ``s:'' could be ``subject:'' or ``since:''), an error will
+be raised.
-@table @code
-@item nnir-notmuch-program
-The name of the notmuch search executable. Defaults to
-@samp{notmuch}.
-
-@item nnir-notmuch-additional-switches
-A list of strings, to be given as additional arguments to notmuch.
-
-@item nnir-notmuch-remove-prefix
-The prefix to remove from each file name returned by notmuch in order
-to get a group name (albeit with @samp{/} instead of @samp{.}). This
-is a regular expression.
-
-@item nnir-notmuch-filter-group-names-function
-A function used to transform the names of groups being searched in,
-for use as a ``path:'' search keyword for notmuch. If nil, the
-default, ``path:'' keywords are not used. Otherwise, this should be a
-callable which accepts a single group name and returns a transformed
-name as notmuch expects to see it. In many mail backends, for
-instance, dots in group names must be converted to forward slashes: to
-achieve this, set this option to
-@example
-(lambda (g) (replace-regexp-in-string "\\." "/" g))
-@end example
+Supported keys include all the usual mail headers: ``from'',
+``subject'', ``cc'', etc. Other keys are:
+@table @samp
+@item body
+The body of the message.
+@item recipient
+Equivalent to @samp{to or cc or bcc}.
+@item address
+Equivalent to @samp{from or recipient}.
+@item id
+The keys @samp{message-id} and @samp{id} are equivalent.
+@item mark
+Accepts @samp{flag}, @samp{seen}, @samp{read} or @samp{replied}, or
+any of Gnus' single-letter representations of those marks, e.g.@:
+@samp{mark:R} for @samp{read}.
+@item tag
+This is interpreted as @samp{keyword} for IMAP and @samp{tag} for
+notmuch.
+@item attachment
+Matches the attachment file name.
+@item before
+Date is exclusive; see below for date parsing.
+@item after
+Date is inclusive; can also use @samp{since}.
+@item thread
+Return entire message threads, not just individual messages.
+@item raw
+Do not parse this particular search.
+@item limit
+Limit the results to this many messages. When searching multiple
+groups this may give undesired results, as the limiting happens before
+sorting.
+@item grep
+Only applicable to ``local index'' engines such as mairix or notmuch.
+On systems with a grep command, additionally filter the results by
+using the value of this term as a grep regexp.
@end table
+@vindex gnus-search-contact-tables
+Elisp-based contact management packages (e.g.@: BBDB or EBDB) can push
+completion tables onto the variable @code{gnus-search-contact-tables},
+allowing auto-completion of contact names and addresses for keys like
+@samp{from} or @samp{to}.
-@node The hyrex Engine
-@subsubsection The hyrex Engine
-This engine is obsolete.
+@subsection Date value parsing
-@node Customizations
-@subsubsection Customizations
+@vindex gnus-search-date-keys
+Date-type keys (see @code{gnus-search-date-keys}) will accept a wide
+variety of values. First, anything that @code{parse-time-string} can
+parse is acceptable. Dates with missing values will be interpreted as
+the most recent occurrence thereof: for instance ``march 03'' is the
+most recent March 3rd. Lastly, it's possible to use relative
+specifications, such as ``3d'' (three days ago). This format also accepts
+w, m and y.
-@table @code
+When creating persistent search groups, the search is saved unparsed,
+and re-parsed every time the group is updated. So a permanent search
+group with a query like:
-@item nnir-method-default-engines
-Alist of pairs of server backends and search engines. The default
-association is
@example
-(nnimap . imap)
+from:"my boss" mark:flag since:1w
@end example
-@item nnir-ignored-newsgroups
-A regexp to match newsgroups in the active file that should be skipped
-when searching all groups on a server.
-
-@end table
-
+would always contain only messages from the past seven days.
@node nnmairix
@section nnmairix
@cindex mairix
@cindex nnmairix
+
+This section is now mostly obsolete, as mairix can be used as a regular
+search engine, including persistent search groups, with
+@code{nnselect}.
+
This paragraph describes how to set up mairix and the back end
@code{nnmairix} for indexing and searching your mail from within
Gnus. Additionally, you can create permanent ``smart'' groups which are
@@ -24679,13 +24657,7 @@ the value @samp{spam} means @samp{nnimap+your-server:spam}. The value
Note for IMAP users: if you use the @code{spam-check-bogofilter},
@code{spam-check-ifile}, and @code{spam-check-stat} spam back ends,
you should also set the variable @code{nnimap-split-download-body} to
-@code{t}. These spam back ends are most useful when they can ``scan''
-the full message body. By default, the nnimap back end only retrieves
-the message headers; @code{nnimap-split-download-body} tells it to
-retrieve the message bodies as well. We don't set this by default
-because it will slow @acronym{IMAP} down, and that is not an
-appropriate decision to make on behalf of the user. @xref{Client-Side
-IMAP Splitting}.
+@code{t}. @xref{Client-Side IMAP Splitting}.
You have to specify one or more spam back ends for @code{spam-split}
to use, by setting the @code{spam-use-*} variables. @xref{Spam Back
@@ -26315,6 +26287,16 @@ registry will keep. If the registry has reached or exceeded this
size, it will reject insertion of new entries.
@end defvar
+@defvar gnus-registry-register-all
+If this option is non-nil, the registry will register all messages, as
+you see them. This is important to making split-to-parent and
+Message-ID references work correctly, as the registry needs to know
+where all messages are, but it can slow down group opening and the
+saving of Gnus. If this option is nil, entries must be created
+manually, for instance by storing a custom flag or keyword for the
+message.
+@end defvar
+
@defvar gnus-registry-prune-factor
This option (a float between 0 and 1) controls how much the registry
is cut back during pruning. In order to prevent constant pruning, the
@@ -26404,8 +26386,14 @@ have to put a rule like this:
"mail")
@end lisp
-in your fancy split setup. In addition, you may want to customize the
-following variables.
+in your fancy split setup.
+
+If @code{gnus-registry-register-all} is non-nil (the default), the
+registry will perform splitting for all messages. If it is nil,
+splitting will only happen for children of messages you've explicitly
+registered.
+
+In addition, you may want to customize the following variables.
@defvar gnus-registry-track-extra
This is a list of symbols, so it's best to change it from the
@@ -26478,7 +26466,9 @@ Store @code{value} under @code{key} for message @code{id}.
@end defun
@defun gnus-registry-get-id-key (id key)
-Get the data under @code{key} for message @code{id}.
+Get the data under @code{key} for message @code{id}. If the option
+@code{gnus-registry-register-all} is non-nil, this function will also
+create an entry for @code{id} if one doesn't exist.
@end defun
@defvar gnus-registry-extra-entries-precious
@@ -29217,7 +29207,7 @@ again and again. @xref{MIME Commands}.
@item
The new hooks @code{gnus-gcc-pre-body-encode-hook} and
@code{gnus-gcc-post-body-encode-hook} are run before/after encoding
-the message body of the Gcc copy of a sent message. See
+the message body of the Gcc copy of a sent message.
@xref{Archived Messages}.
@end itemize
diff --git a/doc/misc/htmlfontify.texi b/doc/misc/htmlfontify.texi
index fc4f32020e9..1674565cdac 100644
--- a/doc/misc/htmlfontify.texi
+++ b/doc/misc/htmlfontify.texi
@@ -10,7 +10,7 @@
This manual documents Htmlfontify, a source code -> crosslinked +
formatted + syntax colorized html transformer.
-Copyright @copyright{} 2002--2003, 2013--2020 Free Software Foundation,
+Copyright @copyright{} 2002--2003, 2013--2021 Free Software Foundation,
Inc.
@quotation
diff --git a/doc/misc/idlwave.texi b/doc/misc/idlwave.texi
index 538c088282b..3cd53c71daf 100644
--- a/doc/misc/idlwave.texi
+++ b/doc/misc/idlwave.texi
@@ -23,7 +23,7 @@ Emacs, and interacting with an IDL shell run as a subprocess.
This is edition @value{EDITION} of the IDLWAVE User Manual for IDLWAVE
@value{VERSION}.
-Copyright @copyright{} 1999--2020 Free Software Foundation, Inc.
+Copyright @copyright{} 1999--2021 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
diff --git a/doc/misc/ido.texi b/doc/misc/ido.texi
index 7cc4edd2865..1c960940a0b 100644
--- a/doc/misc/ido.texi
+++ b/doc/misc/ido.texi
@@ -7,7 +7,7 @@
@copying
This file documents the Ido package for GNU Emacs.
-Copyright @copyright{} 2013--2020 Free Software Foundation, Inc.
+Copyright @copyright{} 2013--2021 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
diff --git a/doc/misc/info.texi b/doc/misc/info.texi
index 85e04a99608..27c00f39257 100644
--- a/doc/misc/info.texi
+++ b/doc/misc/info.texi
@@ -15,7 +15,7 @@
This file describes how to use Info, the menu-driven GNU
documentation system.
-Copyright @copyright{} 1989, 1992, 1996--2020 Free Software Foundation,
+Copyright @copyright{} 1989, 1992, 1996--2021 Free Software Foundation,
Inc.
@quotation
diff --git a/doc/misc/mairix-el.texi b/doc/misc/mairix-el.texi
index 30f5f006775..a571c744870 100644
--- a/doc/misc/mairix-el.texi
+++ b/doc/misc/mairix-el.texi
@@ -5,7 +5,7 @@
@include docstyle.texi
@copying
-Copyright @copyright{} 2008--2020 Free Software Foundation, Inc.
+Copyright @copyright{} 2008--2021 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
diff --git a/doc/misc/message.texi b/doc/misc/message.texi
index b192822fac6..f2680b4a797 100644
--- a/doc/misc/message.texi
+++ b/doc/misc/message.texi
@@ -9,7 +9,7 @@
@copying
This file documents Message, the Emacs message composition mode.
-Copyright @copyright{} 1996--2020 Free Software Foundation, Inc.
+Copyright @copyright{} 1996--2021 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
diff --git a/doc/misc/mh-e.texi b/doc/misc/mh-e.texi
index 962f22af5d2..308ea3f34c9 100644
--- a/doc/misc/mh-e.texi
+++ b/doc/misc/mh-e.texi
@@ -25,7 +25,7 @@
This is version @value{VERSION}@value{EDITION} of @cite{The MH-E
Manual}, last updated @value{UPDATED}.
-Copyright @copyright{} 1995, 2001--2003, 2005--2020 Free Software
+Copyright @copyright{} 1995, 2001--2003, 2005--2021 Free Software
Foundation, Inc.
@c This dual license has been agreed upon by the FSF.
diff --git a/doc/misc/modus-themes.texi b/doc/misc/modus-themes.texi
index de3ccd27c4b..b16aece2ee5 100644
--- a/doc/misc/modus-themes.texi
+++ b/doc/misc/modus-themes.texi
@@ -33,7 +33,7 @@ released on 2020-10-08. Any reference to a newer feature which does
not yet form part of the latest tagged commit, is explicitly marked as
such.
-Copyright (C) 2020 Free Software Foundation, Inc.
+Copyright (C) 2020--2021 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this
diff --git a/doc/misc/newsticker.texi b/doc/misc/newsticker.texi
index f144975451c..5d052cc27dc 100644
--- a/doc/misc/newsticker.texi
+++ b/doc/misc/newsticker.texi
@@ -15,7 +15,7 @@ This manual documents Newsticker, a feed reader for Emacs. It
corresponds to Emacs version @value{EMACSVER}.
@noindent
-Copyright @copyright{} 2004--2020 Free Software Foundation, Inc.
+Copyright @copyright{} 2004--2021 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
diff --git a/doc/misc/nxml-mode.texi b/doc/misc/nxml-mode.texi
index 1741222d4b0..3671ac8f3d2 100644
--- a/doc/misc/nxml-mode.texi
+++ b/doc/misc/nxml-mode.texi
@@ -9,7 +9,7 @@
This manual documents nXML mode, an Emacs major mode for editing
XML with RELAX NG support.
-Copyright @copyright{} 2007--2020 Free Software Foundation, Inc.
+Copyright @copyright{} 2007--2021 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
diff --git a/doc/misc/octave-mode.texi b/doc/misc/octave-mode.texi
index 2005a8e181d..1adc2689697 100644
--- a/doc/misc/octave-mode.texi
+++ b/doc/misc/octave-mode.texi
@@ -6,7 +6,7 @@
@c %**end of header
@copying
-Copyright @copyright{} 1996--2020 Free Software Foundation, Inc.
+Copyright @copyright{} 1996--2021 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
diff --git a/doc/misc/org.texi b/doc/misc/org.texi
index b7e05feb0f1..5eeb098cc72 100644
--- a/doc/misc/org.texi
+++ b/doc/misc/org.texi
@@ -7,15 +7,15 @@
@set txicodequoteundirected
@set txicodequotebacktick
@set MAINTAINERSITE @uref{https://orgmode.org,maintainers webpage}
-@set MAINTAINER Carsten Dominik
-@set MAINTAINEREMAIL @email{carsten at orgmode dot org}
-@set MAINTAINERCONTACT @uref{mailto:carsten at orgmode dot org,contact the maintainer}
+@set MAINTAINER Bastien Guerry
+@set MAINTAINEREMAIL @email{bzg@gnu.org}
+@set MAINTAINERCONTACT @uref{mailto:bzg@gnu.org,contact the maintainer}
@c %**end of header
@copying
-This manual is for Org version 9.3.
+This manual is for Org version 9.4.
-Copyright @copyright{} 2004--2020 Free Software Foundation, Inc.
+Copyright @copyright{} 2004--2021 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -39,7 +39,7 @@ modify this GNU manual.''
@finalout
@titlepage
@title The Org Manual
-@subtitle Release 9.3
+@subtitle Release 9.4
@author The Org Mode Developers
@page
@vskip 0pt plus 1filll
@@ -402,6 +402,10 @@ Texinfo Export
* Special blocks in Texinfo export:: Special block attributes.
* A Texinfo example:: Processing Org to Texinfo.
+Export in Foreign Buffers
+
+* Bare HTML:: Exporting HTML without CSS, Javascript, etc.
+
Publishing
* Configuration:: Defining projects.
@@ -427,6 +431,7 @@ Sample Configuration
Working with Source Code
+* Features Overview:: Enjoy the versatility of source blocks.
* Structure of Code Blocks:: Code block syntax described.
* Using Header Arguments:: Different ways to set header arguments.
* Environment of a Code Block:: Arguments, sessions, working directory...
@@ -447,12 +452,13 @@ Miscellaneous
* Structure Templates:: Quick insertion of structural elements.
* Speed Keys:: Electric commands at the beginning of a headline.
* Clean View:: Getting rid of leading stars in the outline.
+* Execute commands in the active region:: Execute commands on multiple items in Org or agenda view.
* Dynamic Headline Numbering:: Display and update outline numbering.
* The Very Busy @kbd{C-c C-c} Key:: When in doubt, press @kbd{C-c C-c}.
* In-buffer Settings:: Overview of keywords.
* Org Syntax:: Formal description of Org's syntax.
* Documentation Access:: Read documentation about current syntax.
-* Escape Character::
+* Escape Character:: Prevent Org from interpreting your writing.
* Code Evaluation Security:: Org files evaluate in-line code.
* Interaction:: With other Emacs packages.
* TTY Keys:: Using Org on a tty.
@@ -549,7 +555,7 @@ Markdown. New export backends can be derived from existing ones, or
defined from scratch.
Org files can include source code blocks, which makes Org uniquely
-suited for authoring technical documents with code examples. Org
+suited for authoring technical documents with code examples. Org
source code blocks are fully functional; they can be evaluated in
place and their results can be captured in the file. This makes it
possible to create a single file reproducible research compendium.
@@ -603,7 +609,8 @@ We @strong{strongly recommend} sticking to a single installation method.
@subheading Using Emacs packaging system
Recent Emacs distributions include a packaging system which lets you
-install Elisp libraries. You can install Org with @kbd{M-x package-install @key{RET} org}.
+install Elisp libraries. You can install Org from the ``package menu'',
+with @kbd{M-x list-packages}. See @ref{Package Menu,Package Menu,,emacs,}.
@quotation Important
You need to do this in a session where no @samp{.org} file has been
@@ -619,7 +626,7 @@ page}.
@subheading Downloading Org as an archive
You can download Org latest release from @uref{https://orgmode.org/, Org's website}. In this case,
-make sure you set the load-path correctly in your Emacs init file:
+make sure you set the load path correctly in your Emacs init file:
@lisp
(add-to-list 'load-path "~/path/to/orgdir/lisp")
@@ -627,7 +634,7 @@ make sure you set the load-path correctly in your Emacs init file:
The downloaded archive contains contributed libraries that are not
included in Emacs. If you want to use them, add the @samp{contrib/}
-directory to your load-path:
+directory to your load path:
@lisp
(add-to-list 'load-path "~/path/to/orgdir/contrib/lisp" t)
@@ -643,7 +650,7 @@ You can clone Org's repository and install Org like this:
@example
$ cd ~/src/
-$ git clone git@@code.orgmode.org:bzg/org-mode.git
+$ git clone https://code.orgmode.org/bzg/org-mode.git
$ cd org-mode/
$ make autoloads
@end example
@@ -652,7 +659,7 @@ Note that in this case, @samp{make autoloads} is mandatory: it defines
Org's version in @samp{org-version.el} and Org's autoloads in
@samp{org-loaddefs.el}.
-Remember to add the correct load-path as described in the method
+Remember to add the correct load path as described in the method
above.
You can also compile with @samp{make}, generate the documentation with
@@ -731,7 +738,9 @@ ideas about it, please send an email to the Org mailing list
@email{emacs-orgmode@@gnu.org}. You can subscribe to the list @uref{https://lists.gnu.org/mailman/listinfo/emacs-orgmode, from this
web page}. If you are not a member of the mailing list, your mail will
be passed to the list after a moderator has approved it@footnote{Please consider subscribing to the mailing list in order to
-minimize the work the mailing list moderators have to do.}.
+minimize the work the mailing list moderators have to do.}. We ask
+you to read and respect the @uref{https://www.gnu.org/philosophy/kind-communication.html, GNU Kind Communications Guidelines} when
+sending messages on this mailing list.
@findex org-version
@findex org-submit-bug-report
@@ -827,7 +836,7 @@ or, from the menu: Org @arrow{} Refresh/Reload @arrow{} Reload Org uncompiled.
Then, activate the debugger:
@example
-M-x toggle-debug-or-error <RET>
+M-x toggle-debug-on-error <RET>
@end example
@@ -925,13 +934,13 @@ the entire show and hide functionalities into a single command,
@vindex org-special-ctrl-k
@vindex org-ctrl-k-protect-subtree
-Headlines define the structure of an outline tree. The headlines in
-Org start with one or more stars, on the left margin@footnote{See the variables @code{org-special-ctrl-a/e}, @code{org-special-ctrl-k},
+Headlines define the structure of an outline tree. Org headlines
+start on the left margin@footnote{See the variables @code{org-special-ctrl-a/e}, @code{org-special-ctrl-k},
and @code{org-ctrl-k-protect-subtree} to configure special behavior of
@kbd{C-a}, @kbd{C-e}, and @kbd{C-k} in headlines. Note
also that clocking only works with headings indented less than 30
-stars.}. For
-example:
+stars.} with one or more stars followed by
+a space. For example:
@example
* Top level headline
@@ -1020,10 +1029,12 @@ Point must be on a headline for this to work@footnote{See, however, the option @
'--------------------------------------'
@end example
-When @kbd{S-@key{TAB}} is called with a numeric prefix argument N,
-the CONTENTS view up to headlines of level N are shown. Note that
-inside tables (see @ref{Tables}), @kbd{S-@key{TAB}} jumps to the previous
-field instead.
+When @kbd{S-@key{TAB}} is called with a numeric prefix argument
+@var{N}, view contents only up to headlines of level
+@var{N}.
+
+Note that inside tables (see @ref{Tables}), @kbd{S-@key{TAB}} jumps to the
+previous field instead.
@vindex org-cycle-global-at-bob
You can run global cycling using @kbd{@key{TAB}} only if point is at
@@ -1047,9 +1058,9 @@ Show all, including drawers.
@kindex C-c C-r
@findex org-reveal
Reveal context around point, showing the current entry, the
-following heading and the hierarchy above. Useful for working near
-a location that has been exposed by a sparse tree command (see
-@ref{Sparse Trees}) or an agenda command (see @ref{Agenda Commands}). With a prefix argument show, on each level, all sibling
+following heading and the hierarchy above. It is useful for working
+near a location that has been exposed by a sparse tree command (see
+@ref{Sparse Trees}) or an agenda command (see @ref{Agenda Commands}). With a prefix argument, show, on each level, all sibling
headings. With a double prefix argument, also show the entire
subtree of the parent.
@@ -1057,15 +1068,15 @@ subtree of the parent.
@cindex show branches, command
@kindex C-c C-k
@findex outline-show-branches
-Expose all the headings of the subtree, CONTENTS view for just one
-subtree.
+Expose all the headings of the subtree, but not their bodies.
@item @kbd{C-c @key{TAB}} (@code{outline-show-children})
@cindex show children, command
@kindex C-c TAB
@findex outline-show-children
Expose all direct children of the subtree. With a numeric prefix
-argument N, expose all children down to level N@.
+argument @var{N}, expose all children down to level
+@var{N}.
@item @kbd{C-c C-x b} (@code{org-tree-to-indirect-buffer})
@kindex C-c C-x b
@@ -1074,10 +1085,10 @@ Show the current subtree in an indirect buffer@footnote{The indirect buffer cont
to the current tree. Editing the indirect buffer also changes the
original buffer, but without affecting visibility in that buffer. For
more information about indirect buffers, see @ref{Indirect Buffers,GNU Emacs Manual,,emacs,}.}. With
-a numeric prefix argument, N, go up to level N and then take that
-tree. If N is negative then go up that many levels. With
-a @kbd{C-u} prefix, do not remove the previously used indirect
-buffer.
+a numeric prefix argument @var{N}, go up to level @var{N}
+and then take that tree. If @var{N} is negative then go up
+that many levels. With a @kbd{C-u} prefix, do not remove the
+previously used indirect buffer.
@item @kbd{C-c C-x v} (@code{org-copy-visible})
@kindex C-c C-x v
@@ -1090,10 +1101,10 @@ Copy the @emph{visible} text in the region into the kill ring.
@vindex org-startup-folded
When Emacs first visits an Org file, the global state is set to
-OVERVIEW, i.e., only the top level headlines are visible@footnote{When @code{org-agenda-inhibit-startup} is non-@code{nil}, Org does not
+@code{showeverything}, i.e., all file content is visible@footnote{When @code{org-agenda-inhibit-startup} is non-@code{nil}, Org does not
honor the default visibility state when first opening a file for the
-agenda (see @ref{Speeding Up Your Agendas}).}. This
-can be configured through the variable @code{org-startup-folded}, or on
+agenda (see @ref{Speeding Up Your Agendas}).}. This can
+be configured through the variable @code{org-startup-folded}, or on
a per-file basis by adding one of the following lines anywhere in the
buffer:
@@ -1270,14 +1281,22 @@ level. Yet another @kbd{@key{TAB}}, and you are back to the initial
level.
@item @kbd{M-@key{LEFT}} (@code{org-do-promote})
+@itemx @kbd{M-@key{RIGHT}} (@code{org-do-demote})
@kindex M-LEFT
@findex org-do-promote
-Promote current heading by one level.
-
-@item @kbd{M-@key{RIGHT}} (@code{org-do-demote})
@kindex M-RIGHT
@findex org-do-demote
-Demote current heading by one level.
+Promote or demote current heading by one level.
+
+@cindex region, active
+@cindex active region
+@cindex transient mark mode
+When there is an active region---i.e., when Transient Mark mode is
+active---promotion and demotion work on all headlines in the region.
+To select a region of headlines, it is best to place both point and
+mark at the beginning of a line, mark at the beginning of the first
+headline, and point at the line just after the last headline to
+change.
@item @kbd{M-S-@key{LEFT}} (@code{org-promote-subtree})
@kindex M-S-LEFT
@@ -1396,16 +1415,8 @@ Finally, if the first line is a headline, remove the stars from all
headlines in the region.
@end table
-@cindex region, active
-@cindex active region
-@cindex transient mark mode
-When there is an active region---i.e., when Transient Mark mode is
-active---promotion and demotion work on all headlines in the region.
-To select a region of headlines, it is best to place both point and
-mark at the beginning of a line, mark at the beginning of the first
-headline, and point at the line just after the last headline to
-change. Note that when point is inside a table (see @ref{Tables}), the
-Meta-Cursor keys have different functionality.
+Note that when point is inside a table (see @ref{Tables}), the Meta-Cursor
+keys have different functionality.
@node Sparse Trees
@section Sparse Trees
@@ -1481,12 +1492,12 @@ matching the string @samp{FIXME}.
The other sparse tree commands select headings based on TODO keywords,
tags, or properties and are discussed later in this manual.
-@kindex C-c C-e v
+@kindex C-c C-e C-v
@cindex printing sparse trees
@cindex visible text, printing
To print a sparse tree, you can use the Emacs command
@code{ps-print-buffer-with-faces} which does not print invisible parts of
-the document. Or you can use the command @kbd{C-c C-e v} to
+the document. Or you can use the command @kbd{C-c C-e C-v} to
export only the visible part of the document and print the resulting
file.
@@ -1560,7 +1571,7 @@ My favorite scenes are (in this order)
But in the end, no individual scenes matter but the film as a whole.
Important actors in this film are:
- Elijah Wood :: He plays Frodo
-- Sean Astin :: He plays Sam, Frodo's friend. I still remember him
+- Sean Astin :: He plays Sam, Frodo's friend. I still remember him
very well from his role as Mikey Walsh in /The Goonies/.
@end example
@@ -1677,11 +1688,11 @@ bullets (@samp{-}, @samp{+}, @samp{*}, @samp{1.}, @samp{1)}) or a subset of them
on @code{org-plain-list-ordered-item-terminator}, the type of list, and
its indentation. With a numeric prefix argument N, select the Nth
bullet from this list. If there is an active region when calling
-this, selected text is changed into an item. With a prefix
-argument, all lines are converted to list items. If the first line
-already was a list item, any item marker is removed from the list.
-Finally, even without an active region, a normal line is converted
-into a list item.
+this, all lines are converted to list items. With a prefix
+argument, the selected text is changed into a single item. If the
+first line already was a list item, any item marker is removed from
+the list. Finally, even without an active region, a normal line is
+converted into a list item.
@item @kbd{C-c *}
@kindex C-c *
@@ -1812,7 +1823,7 @@ as the first non-whitespace character is considered part of a table.
@samp{|} is also the column separator@footnote{To insert a vertical bar into a table field, use @samp{\vert} or,
inside a word @samp{abc\vert@{@}def}.}. Moreover, a line starting
with @samp{|-} is a horizontal rule. It separates rows explicitly. Rows
-before the first horizontal rule are header lines. A table might look
+before the first horizontal rule are header lines. A table might look
like this:
@example
@@ -1937,7 +1948,8 @@ Kill the current column.
@item @kbd{M-S-@key{RIGHT}} (@code{org-table-insert-column})
@kindex M-S-RIGHT
@findex org-table-insert-column
-Insert a new column to the left of point position.
+Insert a new column at point position. Move the recent column and
+all cells to the right of this column to the right.
@item @kbd{M-@key{UP}} (@code{org-table-move-row-up})
@kindex M-UP
@@ -2121,6 +2133,18 @@ format used to export the file can be configured in the variable
name and the format for table export in a subtree. Org supports
quite general formats for exported tables. The exporter format is
the same as the format used by Orgtbl radio tables, see @ref{Translator functions}, for a detailed description.
+
+@item @kbd{M-x org-table-header-line-mode}
+@findex org-table-header-line-mode
+@vindex org-table-header-line-p
+Turn on the display of the first data row of the table at point in
+the window header line when this first row is not visible anymore in
+the buffer. You can activate this minor mode by default by setting
+the option @code{org-table-header-line-p} to @code{t}.
+
+@item @kbd{M-x org-table-transpose-table-at-point}
+@findex org-table-transpose-table-at-point
+Transpose the table at point and eliminate hlines.
@end table
@node Column Width and Alignment
@@ -2163,12 +2187,12 @@ several columns or display them with a fixed width, regardless of
content, as shown in the following example.
@example
-|---+---------------------+--------| |---+-------…|…|
+|---+---------------------+--------| |---+-------…+…|
| | <6> | | | | <6> …|…|
| 1 | one | some | ----\ | 1 | one …|…|
| 2 | two | boring | ----/ | 2 | two …|…|
| 3 | This is a long text | column | | 3 | This i…|…|
-|---+---------------------+--------| |---+-------…|…|
+|---+---------------------+--------| |---+-------…+…|
@end example
To set the width of a column, one field anywhere in the column may
@@ -2396,11 +2420,12 @@ Here are a few examples:
@cindex range references
@cindex references, to ranges
You may reference a rectangular range of fields by specifying two
-field references connected by two dots @samp{..}. If both fields are in
-the current row, you may simply use @samp{$2..$7}, but if at least one
-field is in a different row, you need to use the general @samp{@@ROW$COLUMN}
-format at least for the first field, i.e., the reference must start
-with @samp{@@} in order to be interpreted correctly. Examples:
+field references connected by two dots @samp{..}. The ends are included in
+the range. If both fields are in the current row, you may simply use
+@samp{$2..$7}, but if at least one field is in a different row, you need to
+use the general @samp{@@ROW$COLUMN} format at least for the first field,
+i.e., the reference must start with @samp{@@} in order to be interpreted
+correctly. Examples:
@multitable @columnfractions 0.2 0.8
@item @samp{$1..$3}
@@ -2410,7 +2435,7 @@ with @samp{@@} in order to be interpreted correctly. Examples:
@item @samp{$<<<..$>>}
@tab start in third column, continue to the last but one
@item @samp{@@2$1..@@4$3}
-@tab six fields between these two fields (same as @samp{A2..C4})
+@tab nine fields between these two fields (same as @samp{A2..C4})
@item @samp{@@-1$-2..@@-1}
@tab 3 fields in the row above, starting from 2 columns on the left
@item @samp{@@I..II}
@@ -2446,7 +2471,7 @@ Insert column number on odd rows, set field to empty on even rows.
Copy text or values of each row of column 1 of the table named
@var{FOO} into column 2 of the current table.
-@item @samp{@@3 = 2 * remote(FOO, @@@@1$$#)}
+@item @samp{@@3 = 2 * remote(FOO, @@1$$#)}
Insert the doubled value of each column of row 1 of the table
named @var{FOO} into row 3 of the current table.
@end table
@@ -3429,29 +3454,26 @@ or alternatively
@cindex escape syntax, for links
@cindex backslashes, in links
-Some @samp{\} and @samp{]} characters in the @var{LINK} part need to be
-``escaped'', i.e., preceded by another @samp{\} character. More
-specifically, the following character categories, and only them, must
-be escaped, in order:
+Some @samp{\}, @samp{[} and @samp{]} characters in the @var{LINK} part need to
+be ``escaped'', i.e., preceded by another @samp{\} character. More
+specifically, the following characters, and only them, must be
+escaped:
@enumerate
@item
-all consecutive @samp{\} characters at the end of the link,
-@item
-any @samp{]} character at the very end of the link,
+all @samp{[} and @samp{]} characters,
@item
-all consecutive @samp{\} characters preceding @samp{][} or @samp{]]} patterns,
+every @samp{\} character preceding either @samp{]} or @samp{[},
@item
-any @samp{]} character followed by either @samp{[} or @samp{]}.
+every @samp{\} character at the end of the link.
@end enumerate
@findex org-link-escape
-Org takes for granted that such links are correctly escaped.
-Functions inserting links (see @ref{Handling Links}) take care of this.
-You only need to bother about those rules when inserting directly, or
-yanking, a URI within square brackets. When in doubt, you may use the
-function @code{org-link-escape}, which turns a link string into its
-properly escaped form.
+Functions inserting links (see @ref{Handling Links}) properly escape
+ambiguous characters. You only need to bother about the rules above
+when inserting directly, or yanking, a URI within square brackets.
+When in doubt, you may use the function @code{org-link-escape}, which turns
+a link string into its escaped form.
Once a link in the buffer is complete, with all brackets present, Org
changes the display so that @samp{DESCRIPTION} is displayed instead of
@@ -3479,29 +3501,32 @@ Literal links.
@cindex internal links
@cindex links, internal
-@cindex targets, for links
-@cindex @samp{CUSTOM_ID}, property
-If the link does not look like a URL, it is considered to be internal
-in the current file. The most important case is a link like
-@samp{[[#my-custom-id]]} which links to the entry with the @samp{CUSTOM_ID} property
-@samp{my-custom-id}. You are responsible yourself to make sure these
-custom IDs are unique in a file.
+A link that does not look like a URL---i.e., does not start with
+a known scheme or a file name---refers to the current document. You
+can follow it with @kbd{C-c C-o} when point is on the link, or
+with a mouse click (see @ref{Handling Links}).
-Links such as @samp{[[My Target]]} or @samp{[[My Target][Find my target]]} lead to a text search in
-the current file.
+@cindex @samp{CUSTOM_ID}, property
+Org provides several refinements to internal navigation within
+a document. Most notably, a construct like @samp{[[#my-custom-id]]}
+specifically targets the entry with the @samp{CUSTOM_ID} property set to
+@samp{my-custom-id}. Also, an internal link looking like @samp{[[*Some
+section]]} points to a headline with the name @samp{Some section}@footnote{To insert a link targeting a headline, in-buffer completion
+can be used. Just type a star followed by a few optional letters into
+the buffer and press @kbd{M-@key{TAB}}. All headlines in the current
+buffer are offered as completions.}.
-The link can be followed with @kbd{C-c C-o} when point is on
-the link, or with a mouse click (see @ref{Handling Links}). Links to
-custom IDs point to the corresponding headline. The preferred match
-for a text link is a @emph{dedicated target}: the same string in double
-angular brackets, like @samp{<<My Target>>}.
+@cindex targets, for links
+When the link does not belong to any of the cases above, Org looks for
+a @emph{dedicated target}: the same string in double angular brackets, like
+@samp{<<My Target>>}.
@cindex @samp{NAME}, keyword
If no dedicated target exists, the link tries to match the exact name
-of an element within the buffer. Naming is done with the @samp{NAME}
-keyword, which has to be put in the line before the element it refers
-to, as in the following example
+of an element within the buffer. Naming is done, unsurprisingly, with
+the @samp{NAME} keyword, which has to be put in the line before the element
+it refers to, as in the following example
@example
#+NAME: My Target
@@ -3510,12 +3535,15 @@ to, as in the following example
| of | four cells |
@end example
-If none of the above succeeds, Org searches for a headline that is
-exactly the link text but may also include a TODO keyword and
-tags@footnote{To insert a link targeting a headline, in-buffer completion
-can be used. Just type a star followed by a few optional letters into
-the buffer and press @kbd{M-@key{TAB}}. All headlines in the current
-buffer are offered as completions.}.
+@vindex org-link-search-must-match-exact-headline
+Ultimately, if none of the above succeeds, Org searches for a headline
+that is exactly the link text but may also include a TODO keyword and
+tags, or initiates a plain text search, according to the value of
+@code{org-link-search-must-match-exact-headline}.
+
+Note that you must make sure custom IDs, dedicated targets, and names
+are unique throughout the document. Org provides a linter to assist
+you in the process, if needed. See @ref{Org Syntax}.
During export, internal links are used to mark objects and assign them
a number. Marked objects are then referenced by links pointing to
@@ -3673,7 +3701,7 @@ options:
@item
@tab @samp{file:projects.org}
@item
-@tab @samp{file:projects.org::some words} (text search) @footnote{The actual behavior of the search depends on the value of the
+@tab @samp{file:projects.org::some words} (text search)@footnote{The actual behavior of the search depends on the value of the
variable @code{org-link-search-must-match-exact-headline}. If its value is
@code{nil}, then a fuzzy text search is done. If it is @code{t}, then only the
exact headline is matched, ignoring spaces and statistic cookies. If
@@ -3834,7 +3862,7 @@ user/channel/server under the point.
For any other file, the link points to the file, with a search
string (see @ref{Search Options}) pointing to the contents
of the current line. If there is an active region, the selected
-words form the basis of the search string. You can write custom Lisp
+words form the basis of the search string. You can write custom Lisp
functions to select the search string and perform the search for
particular file types (see @ref{Custom Searches}).
@@ -3980,8 +4008,8 @@ this also to @kbd{M-n} and @kbd{M-p}.
@lisp
(with-eval-after-load 'org
- (define-key org-mode-map "\M-n" 'org-next-link)
- (define-key org-mode-map "\M-p" 'org-previous-link))
+ (define-key org-mode-map (kbd "M-n") 'org-next-link)
+ (define-key org-mode-map (kbd "M-p") 'org-previous-link))
@end lisp
@end table
@@ -4022,12 +4050,11 @@ replacement text. Here is an example:
@lisp
(setq org-link-abbrev-alist
- '(("bugzilla" . "http://10.1.2.9/bugzilla/show_bug.cgi?id=")
- ("url-to-ja" . "http://translate.google.fr/translate?sl=en&tl=ja&u=%h")
- ("google" . "http://www.google.com/search?q=")
- ("gmap" . "http://maps.google.com/maps?q=%s")
- ("omap" . "http://nominatim.openstreetmap.org/search?q=%s&polygon=1")
- ("ads" . "https://ui.adsabs.harvard.edu/search/q=%20author%3A\"%s\"")))
+ '(("bugzilla" . "http://10.1.2.9/bugzilla/show_bug.cgi?id=")
+ ("Nu Html Checker" . "https://validator.w3.org/nu/?doc=%h")
+ ("duckduckgo" . "https://duckduckgo.com/?q=%s")
+ ("omap" . "http://nominatim.openstreetmap.org/search?q=%s&polygon=1")
+ ("ads" . "https://ui.adsabs.harvard.edu/search/q=%20author%3A\"%s\"")))
@end lisp
If the replacement text contains the string @samp{%s}, it is replaced with
@@ -4852,8 +4879,8 @@ example.
If you use Org mode extensively, you may end up with enough TODO items
that it starts to make sense to prioritize them. Prioritizing can be
-done by placing a @emph{priority cookie} into the headline of a TODO item,
-like this
+done by placing a @emph{priority cookie} into the headline of a TODO item
+right after the TODO keyword, like this:
@example
*** TODO [#A] Write letter to Sam Fortune
@@ -4864,11 +4891,22 @@ like this
By default, Org mode supports three priorities: @samp{A}, @samp{B}, and @samp{C}.
@samp{A} is the highest priority. An entry without a cookie is treated as
equivalent if it had priority @samp{B}. Priorities make a difference only
-for sorting in the agenda (see @ref{Weekly/daily agenda}); outside the
+for sorting in the agenda (see @ref{Weekly/daily agenda}). Outside the
agenda, they have no inherent meaning to Org mode. The cookies are
displayed with the face defined by the variable @code{org-priority-faces},
which can be customized.
+You can also use numeric values for priorities, such as
+
+@example
+*** TODO [#1] Write letter to Sam Fortune
+@end example
+
+
+When using numeric priorities, you need to set @code{org-priority-highest},
+@code{org-priority-lowest} and @code{org-priority-default} to integers, which
+must all be strictly inferior to 65.
+
Priorities can be attached to any outline node; they do not need to be
TODO items.
@@ -4894,12 +4932,12 @@ that these keys are also used to modify timestamps (see @ref{Creating Timestamps
a discussion of the interaction with shift-selection.
@end table
-@vindex org-highest-priority
-@vindex org-lowest-priority
-@vindex org-default-priority
+@vindex org-priority-highest
+@vindex org-priority-lowest
+@vindex org-priority-default
You can change the range of allowed priorities by setting the
-variables @code{org-highest-priority}, @code{org-lowest-priority}, and
-@code{org-default-priority}. For an individual buffer, you may set these
+variables @code{org-priority-highest}, @code{org-priority-lowest}, and
+@code{org-priority-default}. For an individual buffer, you may set these
values (highest, lowest, default) like this (please make sure that the
highest priority is earlier in the alphabet than the lowest priority):
@@ -4908,6 +4946,13 @@ highest priority is earlier in the alphabet than the lowest priority):
#+PRIORITIES: A C B
@end example
+
+Or, using numeric values:
+
+@example
+#+PRIORITIES: 1 10 5
+@end example
+
@node Breaking Down Tasks
@section Breaking Down Tasks into Subtasks
@@ -5061,6 +5106,21 @@ this headline and the next---so @emph{not} the entire subtree.
If there is no active region, just toggle the checkbox at point.
@end itemize
+@item @kbd{C-c C-x C-r} (@code{org-toggle-radio-button})
+@kindex C-c C-x C-r
+@findex org-toggle-radio-button
+@cindex radio button, checkbox as
+Toggle checkbox status by using the checkbox of the item at point as
+a radio button: when the checkbox is turned on, all other checkboxes
+on the same level will be turned off. With a universal prefix
+argument, toggle the presence of the checkbox. With a double prefix
+argument, set it to @samp{[-]}.
+
+@findex org-list-checkbox-radio-mode
+@kbd{C-c C-c} can be told to consider checkboxes as radio buttons by
+setting @samp{#+ATTR_ORG: :radio t} right before the list or by calling
+@kbd{M-x org-list-checkbox-radio-mode} to activate this minor mode.
+
@item @kbd{M-S-@key{RET}} (@code{org-insert-todo-heading})
@kindex M-S-RET
@findex org-insert-todo-heading
@@ -5549,7 +5609,7 @@ with many examples, see @ref{Matching tags and properties}.
A property is a key-value pair associated with an entry. Properties
can be set so they are associated with a single entry, with every
-entry in a tree, or with every entry in an Org file.
+entry in a tree, or with the whole buffer.
There are two main applications for properties in Org mode. First,
properties are like tags, but with a value. Imagine maintaining
@@ -5619,8 +5679,12 @@ disks in a box like this:
:END:
@end example
-If you want to set properties that can be inherited by any entry in
-a file, use a line like:
+Properties can be inserted on buffer level. That means they apply
+before the first headline and can be inherited by all entries in a
+file. Property blocks defined before first headline needs to be
+located at the top of the buffer, allowing only comments above.
+
+Properties can also be defined using lines like:
@cindex @samp{_ALL} suffix, in properties
@cindex @samp{PROPERTY}, keyword
@@ -5685,7 +5749,8 @@ necessary, the property drawer is created as well.
@findex org-insert-drawer
Insert a property drawer into the current entry. The drawer is
inserted early in the entry, but after the lines with planning
-information like deadlines.
+information like deadlines. If before first headline the drawer is
+inserted at the top of the drawer after any potential comments.
@item @kbd{C-c C-c} (@code{org-property-action})
@kindex C-c C-c
@@ -5767,7 +5832,7 @@ not be used as keys in the properties drawer:
@item @samp{CLOSED}
@tab When was this entry closed?
@item @samp{DEADLINE}
-@tab The deadline time string, without the angular brackets.
+@tab The deadline timestamp.
@item @samp{FILE}
@tab The filename the entry is located in.
@item @samp{ITEM}
@@ -5775,7 +5840,7 @@ not be used as keys in the properties drawer:
@item @samp{PRIORITY}
@tab The priority of the entry, a string with a single letter.
@item @samp{SCHEDULED}
-@tab The scheduling timestamp, without the angular brackets.
+@tab The scheduling timestamp.
@item @samp{TAGS}
@tab The tags defined directly in the headline.
@item @samp{TIMESTAMP}
@@ -5804,7 +5869,7 @@ Create a sparse tree with all matching entries. With
a @kbd{C-u} prefix argument, ignore headlines that are not
a TODO line.
-@item @kbd{M-x org-agenda m}, @code{org-tags-view}
+@item @kbd{M-x org-agenda m} (@code{org-tags-view})
@kindex m @r{(Agenda dispatcher)}
@findex org-tags-view
Create a global list of tag/property matches from all agenda files.
@@ -5922,14 +5987,6 @@ done by defining a column format line.
@node Scope of column definitions
@subsubsection Scope of column definitions
-To define a column format for an entire file, use a line like:
-
-@cindex @samp{COLUMNS}, keyword
-@example
-#+COLUMNS: %25ITEM %TAGS %PRIORITY %TODO
-@end example
-
-
To specify a format that only applies to a specific tree, add
a @samp{COLUMNS} property to the top node of that tree, for example:
@@ -5940,6 +5997,16 @@ a @samp{COLUMNS} property to the top node of that tree, for example:
:END:
@end example
+A @samp{COLUMNS} property within a property drawer before first headline
+will apply to the entire file. As an addition to property drawers,
+keywords can also be defined for an entire file using a line like:
+
+@cindex @samp{COLUMNS}, keyword
+@example
+#+COLUMNS: %25ITEM %TAGS %PRIORITY %TODO
+@end example
+
+
If a @samp{COLUMNS} property is present in an entry, it defines columns for
the entry itself, and for the entire subtree below it. Since the
column definition is part of the hierarchical structure of the
@@ -6097,15 +6164,16 @@ format is taken from the @samp{#+COLUMNS} line or from the variable
@code{org-columns-default-format}, and column view is established for the
current entry and its subtree.
-@item @kbd{r} or @kbd{g} (@code{org-columns-redo})
+@item @kbd{r} or @kbd{g} on a columns view line (@code{org-columns-redo})
@kindex r
@kindex g
@findex org-columns-redo
Recreate the column view, to include recent changes made in the
buffer.
-@item @kbd{q} (@code{org-columns-quit})
+@item @kbd{C-c C-c} or @kbd{q} on a columns view line (@code{org-columns-quit})
@kindex q
+@kindex C-c C-c
@findex org-columns-quit
Exit column view.
@end table
@@ -6141,10 +6209,11 @@ invokes the same interface that you normally use to change that
property. For example, the tag completion or fast selection
interface pops up when editing a @samp{TAGS} property.
-@item @kbd{C-c C-c} (@code{org-columns-set-tags-or-toggle})
+@item @kbd{C-c C-c} (@code{org-columns-toggle-or-columns-quit})
@kindex C-c C-c
-@findex org-columns-set-tags-or-toggle
-When there is a checkbox at point, toggle it.
+@findex org-columns-toggle-or-columns-quit
+When there is a checkbox at point, toggle it. Else exit column
+view.
@item @kbd{v} (@code{org-columns-show-value})
@kindex v
@@ -6227,6 +6296,14 @@ create a globally unique ID for the current entry and copy it to
the kill-ring.
@end table
+@item @samp{:match}
+When set to a string, use this as a tags/property match filter to
+select only a subset of the headlines in the scope set by the @code{:id}
+parameter.
+@end table
+
+
+@table @asis
@item @samp{:hlines}
When @code{t}, insert an hline after every line. When a number N, insert
an hline before each headline with level @code{<= N}.
@@ -6256,12 +6333,16 @@ block.
The following commands insert or update the dynamic block:
@table @asis
-@item @kbd{C-c C-x i} (@code{org-insert-columns-dblock})
-@kindex C-c C-x i
-@findex org-insert-columns-dblock
+@item @code{org-columns-insert-dblock}
+@kindex C-c C-x x
+@findex org-columns-insert-dblock
Insert a dynamic block capturing a column view. Prompt for the
scope or ID of the view.
+This command can be invoked by calling
+@code{org-dynamic-block-insert-dblock} (@kbd{C-c C-x x}) and
+selecting ``columnview'' (see @ref{Dynamic Blocks}).
+
@item @kbd{C-c C-c} @kbd{C-c C-x C-u} (@code{org-dblock-update})
@kindex C-c C-c
@kindex C-c C-x C-u
@@ -6634,6 +6715,8 @@ can control the calendar fully from the minibuffer:
@kindex M-S-RIGHT
@kindex M-S-LEFT
@kindex RET
+@kindex .
+@kindex C-.
@multitable @columnfractions 0.25 0.55
@item @kbd{@key{RET}}
@tab Choose date at point in calendar.
@@ -6659,6 +6742,11 @@ can control the calendar fully from the minibuffer:
@tab Scroll calendar forward by 3 months.
@item @kbd{C-v}
@tab Scroll calendar backward by 3 months.
+@item @kbd{C-.}
+@tab Select today's date@footnote{You can also use the calendar command @kbd{.} to jump to
+today's date, but if you are inserting an hour specification for your
+timestamp, @kbd{.} will then insert a dot after the hour. By contrast,
+@kbd{C-.} will always jump to today's date.}
@end multitable
@vindex org-read-date-display-live
@@ -6898,7 +6986,7 @@ organize such tasks using a so-called repeater in a @samp{DEADLINE},
the @samp{+1m} is a repeater; the intended interpretation is that the task
has a deadline on @samp{<2005-10-01>} and repeats itself every (one) month
starting from that time. You can use yearly, monthly, weekly, daily
-and hourly repeat cookies by using the @samp{y}, @samp{w}, @samp{m}, @samp{d} and @samp{h}
+and hourly repeat cookies by using the @samp{y}, @samp{m}, @samp{w}, @samp{d} and @samp{h}
letters. If you need both a repeater and a special warning period in
a deadline entry, the repeater should come first and the warning
period last
@@ -6948,8 +7036,8 @@ if you have not paid the rent for three months, marking this entry
DONE still keeps it as an overdue deadline. Depending on the task,
this may not be the best way to handle it. For example, if you forgot
to call your father for 3 weeks, it does not make sense to call him
-3 times in a single day to make up for it. Finally, there are tasks
-like changing batteries which should always repeat a certain time
+3 times in a single day to make up for it. Finally, there are tasks,
+like changing batteries, which should always repeat a certain time
@emph{after} the last time you did it. For these tasks, Org mode has
special repeaters @samp{++} and @samp{.+}. For example:
@@ -6971,7 +7059,11 @@ special repeaters @samp{++} and @samp{.+}. For example:
** TODO Check the batteries in the smoke detectors
DEADLINE: <2005-11-01 Tue .+1m>
- Marking this DONE will shift the date to one month after today.
+ Marking this DONE shifts the date to one month after today.
+
+** TODO Wash my hands
+ DEADLINE: <2019-04-05 08:00 Sun .+1h>
+ Marking this DONE shifts the date to exactly one hour from now.
@end example
@vindex org-agenda-skip-scheduled-if-deadline-is-shown
@@ -7004,7 +7096,7 @@ recorded. It also computes the total time spent on each
subtree@footnote{Clocking only works if all headings are indented with less
than 30 stars. This is a hard-coded limitation of @code{lmax} in
@code{org-clock-sum}.} of a project. And it remembers a history or tasks
-recently clocked, to that you can jump quickly between a number of
+recently clocked, so that you can jump quickly between a number of
tasks absorbing your time.
To save the clock history across Emacs sessions, use:
@@ -7173,12 +7265,18 @@ Org mode can produce quite complex reports based on the time clocking
information. Such a report is called a @emph{clock table}, because it is
formatted as one or several Org tables.
-You can insert, or update, a clock table through Org dynamic blocks
-insert command (see @ref{Dynamic Blocks}), by pressing @kbd{C-c C-x x c l o c k t a b l e @key{RET}}. When called with a prefix argument,
+@table @asis
+@item @code{org-clock-report}
+@kindex C-c C-x x
+@findex org-clock-report
+Insert or update a clock table. When called with a prefix argument,
jump to the first clock table in the current document and update it.
The clock table includes archived trees.
-@table @asis
+This command can be invoked by calling
+@code{org-dynamic-block-insert-dblock} (@kbd{C-c C-x x}) and
+selecting ``clocktable'' (see @ref{Dynamic Blocks}).
+
@item @kbd{C-c C-c} or @kbd{C-c C-x C-u} (@code{org-dblock-update})
@kindex C-c C-c
@kindex C-c C-x C-u
@@ -7202,7 +7300,7 @@ needs to be in the @samp{#+BEGIN: clocktable} line for this command. If
@end table
Here is an example of the frame for a clock table as it is inserted
-into the buffer with the @kbd{C-c C-x C-r} command:
+into the buffer by @code{org-clock-report}:
@cindex @samp{BEGIN clocktable}
@example
@@ -7211,10 +7309,9 @@ into the buffer with the @kbd{C-c C-x C-r} command:
@end example
@vindex org-clocktable-defaults
-The @samp{#+BEGIN} line and specify a number of options to define the
-scope, structure, and formatting of the report. Defaults for all
-these options can be configured in the variable
-@code{org-clocktable-defaults}.
+The @samp{#+BEGIN} line contains options to define the scope, structure,
+and formatting of the report. Defaults for all these options can be
+configured in the variable @code{org-clocktable-defaults}.
First there are options that determine which clock entries are to
be selected:
@@ -7302,9 +7399,9 @@ The starting day of the week. The default is 1 for Monday.
The starting day of the month. The default is 1 for the first.
@item @samp{:step}
-Set to @samp{day}, @samp{week}, @samp{month} or @samp{year} to split the table into
-chunks. To use this, either @samp{:block}, or @samp{:tstart} and @samp{:tend} are
-required.
+Set to @samp{day}, @samp{week}, @samp{semimonth}, @samp{month}, or @samp{year} to split the
+table into chunks. To use this, either @samp{:block}, or @samp{:tstart} and
+@samp{:tend} are required.
@item @samp{:stepskip0}
When non-@code{nil}, do not show steps that have zero time.
@@ -7539,6 +7636,23 @@ If you only want this from time to time, use three universal prefix
arguments with @code{org-clock-in} and two @kbd{C-u C-u} with
@code{org-clock-in-last}.
+@anchor{Clocking out automatically after some idle time}
+@subsubheading Clocking out automatically after some idle time
+
+@cindex auto clocking out after idle time
+
+@vindex org-clock-auto-clockout-timer
+When you often forget to clock out before being idle and you don't
+want to manually set the clocking time to take into account, you can
+set @code{org-clock-auto-clockout-timer} to a number of seconds and add
+@samp{(org-clock-auto-clockout-insinuate)} to your @samp{.emacs} file.
+
+When the clock is running and Emacs is idle for more than this number
+of seconds, the clock will be clocked out automatically.
+
+Use @samp{M-x org-clock-toggle-auto-clockout RET} to temporarily turn this
+on or off.
+
@node Effort Estimates
@section Effort Estimates
@@ -7551,9 +7665,14 @@ to produce offers with quotations of the estimated work effort, you
may want to assign effort estimates to entries. If you are also
clocking your work, you may later want to compare the planned effort
with the actual working time, a great way to improve planning
-estimates. Effort estimates are stored in a special property
-@samp{EFFORT}. You can set the effort for an entry with the following
-commands:
+estimates.
+
+Effort estimates are stored in a special property @samp{EFFORT}. Multiple
+formats are supported, such as @samp{3:12}, @samp{1:23:45}, or @samp{1d3h5min}; see
+the file @samp{org-duration.el} for more detailed information about the
+format.
+
+You can set the effort for an entry with the following commands:
@table @asis
@item @kbd{C-c C-x e} (@code{org-set-effort})
@@ -7767,9 +7886,9 @@ Clear the target cache. Caching of refile targets can be turned on
by setting @code{org-refile-use-cache}. To make the command see new
possible targets, you have to clear the cache with this command.
-@item @kbd{C-c M-w} (@code{org-copy})
+@item @kbd{C-c M-w} (@code{org-refile-copy})
@kindex C-c M-w
-@findex org-copy
+@findex org-refile-copy
Copying works like refiling, except that the original note is not
deleted.
@end table
@@ -7860,6 +7979,10 @@ came, its outline path the archiving time etc. Configure the variable
@code{org-archive-save-context-info} to adjust the amount of information
added.
+@vindex org-archive-subtree-save-file-p
+When @code{org-archive-subtree-save-file-p} is non-@code{nil}, save the target
+archive buffer.
+
@node Internal archiving
@subsection Internal archiving
@@ -7924,7 +8047,7 @@ none is found, the command offers to set the @samp{ARCHIVE} tag for the
child. If point is @emph{not} on a headline when this command is
invoked, check the level 1 trees.
-@item @kbd{C-@key{TAB}} (@code{org-force-cycle-archived})
+@item @kbd{C-c C-@key{TAB}} (@code{org-force-cycle-archived})
@kindex C-TAB
Cycle a tree even if it is tagged with @samp{ARCHIVE}.
@@ -8106,7 +8229,7 @@ going through the interactive template selection, you can create your
key binding like this:
@lisp
-(define-key global-map "\C-cx"
+(define-key global-map (kbd "C-c x")
(lambda () (interactive) (org-capture nil "x")))
@end lisp
@@ -8225,9 +8348,15 @@ file and moves point to the right location.
The template for creating the capture item. If you leave this
empty, an appropriate default template will be used. Otherwise this
is a string with escape codes, which will be replaced depending on
-time and context of the capture call. The string with escapes may
-be loaded from a template file, using the special syntax @samp{(file
- "template filename")}. See below for more details.
+time and context of the capture call. You may also get this
+template string from a file@footnote{When the file name is not absolute, Org assumes it is relative
+to @code{org-directory}.}, or dynamically, from a function
+using either syntax:
+
+@example
+(file "/path/to/template-file")
+(function FUNCTION-RETURNING-THE-TEMPLATE)
+@end example
@item properties
The rest of the entry is a property list of additional options.
@@ -8244,10 +8373,23 @@ When set, do not offer to edit the information, just file it away
immediately. This makes sense if the template only needs
information that can be added automatically.
+@item @code{:jump-to-captured}
+When set, jump to the captured entry when finished.
+
@item @code{:empty-lines}
Set this to the number of lines to insert before and after the new
item. Default 0, and the only other common value is 1.
+@item @code{:empty-lines-after}
+Set this to the number of lines that should be inserted after the
+new item. Overrides @code{:empty-lines} for the number of lines
+inserted after.
+
+@item @code{:empty-lines-before}
+Set this to the number of lines that should be inserted before the
+new item. Overrides @code{:empty-lines} for the number lines inserted
+before.
+
@item @code{:clock-in}
Start the clock in this item.
@@ -8269,9 +8411,10 @@ you can force the same behavior by calling @code{org-capture} with
a @kbd{C-1} prefix argument.
@item @code{:tree-type}
-When @code{week}, make a week tree instead of the month tree, i.e.,
-place the headings for each day under a heading with the current
-ISO week.
+Use @code{week} to make a week tree instead of the month-day tree,
+i.e., place the headings for each day under a heading with the
+current ISO week. Use @code{month} to group entries by month
+only. Default is to group entries by day.
@item @code{:unnarrowed}
Do not narrow the target buffer, simply show the full buffer.
@@ -8469,8 +8612,8 @@ See the docstring of the variable for more information.
It is often useful to associate reference material with an outline
node. Small chunks of plain text can simply be stored in the subtree
of a project. Hyperlinks (see @ref{Hyperlinks}) can establish associations
-with files that live elsewhere on your computer or in the cloud, like
-emails or source code files belonging to a project.
+with files that live elsewhere on a local, or even remote, computer,
+like emails or source code files belonging to a project.
Another method is @emph{attachments}, which are files located in a
directory belonging to an outline node. Org uses directories either
@@ -8487,18 +8630,19 @@ named by a unique ID of each entry, or by a @samp{DIR} property.
@node Attachment defaults and dispatcher
@subsection Attachment defaults and dispatcher
-By default, org-attach will use ID properties when adding attachments
-to outline nodes. This makes working with attachments fully
-automated. There is no decision needed for folder-name or location.
-ID-based directories are by default located in the @samp{data/} directory,
-which lives in the same directory where your Org file lives@footnote{If you move entries or Org files from one directory to
+By default, Org attach uses ID properties when adding attachments to
+outline nodes. This makes working with attachments fully automated.
+There is no decision needed for folder-name or location. ID-based
+directories are by default located in the @samp{data/} directory, which
+lives in the same directory where your Org file lives@footnote{If you move entries or Org files from one directory to
another, you may want to configure @code{org-attach-id-dir} to contain
an absolute path.}.
-For more control over the setup, see @ref{Attachment options}.
When attachments are made using @code{org-attach} a default tag @samp{ATTACH} is
added to the node that gets the attachments.
+For more control over the setup, see @ref{Attachment options}.
+
The following commands deal with attachments:
@table @asis
@@ -8616,11 +8760,11 @@ This option changes that to relative links.
@vindex org-attach-use-inheritance
By default folders attached to an outline node are inherited from
parents according to @code{org-use-property-inheritance}. If one instead
-want to set inheritance specifically for org-attach that can be done
+want to set inheritance specifically for Org attach that can be done
using @code{org-attach-use-inheritance}. Inheriting documents through
-the node hierarchy makes a lot of sense in most cases. Especially
-since the introduction of @ref{Attachment links}. The following example
-shows one use case for attachment inheritance:
+the node hierarchy makes a lot of sense in most cases. Especially
+when using attachment links (see @ref{Attachment links}). The following
+example shows one use case for attachment inheritance:
@example
* Chapter A ...
@@ -8631,11 +8775,11 @@ shows one use case for attachment inheritance:
Some text
#+NAME: Image 1
-[[Attachment:image 1.jpg]]
+[[attachment:image 1.jpg]]
@end example
Without inheritance one would not be able to resolve the link to
-image @samp{1.jpg}, since the link is inside a sub-heading to @samp{Chapter
+@samp{image 1.jpg}, since the link is inside a sub-heading to @samp{Chapter
A}.
Inheritance works the same way for both @samp{ID} and @samp{DIR} property. If
@@ -8677,6 +8821,18 @@ structure in any other way. All functions in this list will be
tried when resolving existing ID's into paths, to maintain backward
compatibility with existing folders in your system.
+@item @code{org-attach-store-link-p}
+@vindex org-attach-store-link-p
+Stores a link to the file that is being attached. The link is
+stored in @code{org-stored-links} for later insertion with @kbd{C-c C-l} (see @ref{Handling Links}). Depending on what option is set in
+@code{org-attach-store-link-p}, the link is stored to either the original
+location as a file link, the attachment location as an attachment
+link or to the attachment location as a file link.
+
+@item @code{org-attach-commands}
+@vindex org-attach-commands
+List of all commands used in the attach dispatcher.
+
@item @code{org-attach-expert}
@vindex org-attach-expert
Do not show the splash buffer with the attach dispatcher when
@@ -8722,6 +8878,7 @@ the following to your Emacs config:
@cindex attach from Dired
@findex org-attach-dired-to-subtree
+
It is possible to attach files to a subtree from a Dired buffer. To
use this feature, have one window in Dired mode containing the file(s)
to be attached and another window with point in the subtree that shall
@@ -9005,9 +9162,11 @@ to specify the number of context lines for each match, default is
@end enumerate
@item @kbd{#}
-@itemx @kbd{!}
Create a list of stuck projects (see @ref{Stuck projects}).
+@item @kbd{!}
+Configure the list of stuck projects (see @ref{Stuck projects}).
+
@item @kbd{<}
@kindex < @r{(Agenda dispatcher)}
Restrict an agenda command to the current buffer@footnote{For backward compatibility, you can also press @kbd{1} to
@@ -9755,7 +9914,7 @@ then applied to the view and persists as a basic filter through
refreshes and more secondary filtering. The filter is a global
property of the entire agenda view---in a block agenda, you should
only set this in the global options section, not in the section of an
-individual block.}. You can switch quickly between
+individual block.}. You can switch quickly between
different filters without having to recreate the agenda. @emph{Limits} on
the other hand take effect before the agenda buffer is populated, so
they are mostly useful when defined as local variables within custom
@@ -9803,7 +9962,7 @@ again by pressing @kbd{<}.
@item @kbd{=} (@code{org-agenda-filter-by-regexp})
@findex org-agenda-filter-by-regexp
Filter the agenda view by a regular expression: only show agenda
-entries matching the regular expression the user entered. To clear
+entries matching the regular expression the user entered. To clear
the filter, call the command again by pressing @kbd{=}.
@item @kbd{_} (@code{org-agenda-filter-by-effort})
@@ -9845,17 +10004,18 @@ in a single string, with full completion support. For example,
+work-John+<0:10-/plot/
@end example
-selects entries with category `work' and effort estimates below 10
-minutes, and deselects entries with tag `John' or matching the
-regexp `plot'. `+' can be left out if that does not lead to
+
+selects entries with category @samp{work} and effort estimates below 10
+minutes, and deselects entries with tag @samp{John} or matching the
+regexp @samp{plot}. You can leave @samp{+} out if that does not lead to
ambiguities. The sequence of elements is arbitrary. The filter
-syntax assumes that there is no overlap between categories and tags
-(tags will take priority). If you reply to the prompt with the
+syntax assumes that there is no overlap between categories and tags.
+Otherwise, tags take priority. If you reply to the prompt with the
empty string, all filtering is removed. If a filter is specified,
-it replaces all current filters. But if you call the command with a
-double prefix argument, or if you add an additional `+'
-(e.g. `++work') to the front of the string, the new filter elements
-are added to the active ones. A single prefix argument applies the
+it replaces all current filters. But if you call the command with
+a double prefix argument, or if you add an additional @samp{+} (e.g.,
+@samp{++work}) to the front of the string, the new filter elements are
+added to the active ones. A single prefix argument applies the
entire filter in a negative sense.
@item @kbd{|} (@code{org-agenda-filter-remove-all})
@@ -9866,35 +10026,34 @@ Remove all filters in the current agenda view.
@subsubheading Computed tag filtering
@vindex org-agenda-auto-exclude-function
-If the variable @code{org-agenda-auto-exclude-function} is set to a
-user-defined function, that function can select tags that should be
+If the variable @code{org-agenda-auto-exclude-function} is set to
+a user-defined function, that function can select tags that should be
used as a tag filter when requested. The function will be called with
-lower-case versions of all tags represented in the current view. The
-function should the return @samp{"-tag"} if the filter should remove
+lower-case versions of all tags represented in the current view. The
+function should return @samp{"-tag"} if the filter should remove
entries with that tag, @samp{"+tag"} if only entries with this tag should
-be kept, or @samp{nil} if that tag is irrelevant. For example, let's say
+be kept, or @samp{nil} if that tag is irrelevant. For example, let's say
you use a @samp{Net} tag to identify tasks which need network access, an
@samp{Errand} tag for errands in town, and a @samp{Call} tag for making phone
calls. You could auto-exclude these tags based on the availability of
the Internet, and outside of business hours, with something like this:
@lisp
-(defun org-my-auto-exclude-fn (tag)
- (if (cond
- ((string= tag "net")
- (/= 0 (call-process "/sbin/ping" nil nil nil
- "-c1" "-q" "-t1" "mail.gnu.org")))
- ((member tag '("errand" "call"))
- (let ((hr (nth 2 (decode-time))))
- (or (< hr 8) (> hr 21)))))
- (concat "-" tag)))
-
-(setq org-agenda-auto-exclude-function 'org-my-auto-exclude-fn)
+(defun my-auto-exclude-fn (tag)
+ (when (cond ((string= tag "net")
+ (/= 0 (call-process "/sbin/ping" nil nil nil
+ "-c1" "-q" "-t1" "mail.gnu.org")))
+ ((member tag '("errand" "call"))
+ (let ((hr (nth 2 (decode-time))))
+ (or (< hr 8) (> hr 21)))))
+ (concat "-" tag)))
+
+(setq org-agenda-auto-exclude-function #'my-auto-exclude-fn)
@end lisp
-You can apply this self-adapting filter by using a double prefix
-argument to @code{org-agenda-filter}, i.e. press @kbd{C-u C-u /}, or
-by pressing @kbd{@key{RET}} in @code{org-agenda-filter-by-tag}.
+You can apply this self-adapting filter by using a triple prefix
+argument to @code{org-agenda-filter}, i.e.@tie{}press @kbd{C-u C-u C-u /},
+or by pressing @kbd{@key{RET}} in @code{org-agenda-filter-by-tag}.
@anchor{Setting limits for the agenda}
@subsubheading Setting limits for the agenda
@@ -10293,7 +10452,7 @@ both in the agenda buffer and in the remote buffer.
@kindex t
@findex org-agenda-todo
Change the TODO state of the item, both in the agenda and in the
-original Org file. A prefix arg is passed through to the @code{org-todo}
+original Org file. A prefix arg is passed through to the @code{org-todo}
command, so for example a @kbd{C-u} prefix are will trigger
taking a note to document the state change.
@@ -10370,11 +10529,6 @@ Set the priority for the current item. Org mode prompts for the
priority character. If you reply with @kbd{@key{SPC}}, the priority
cookie is removed from the entry.
-@item @kbd{P} (@code{org-agenda-show-priority})
-@kindex P
-@findex org-agenda-show-priority
-Display weighted priority of current item.
-
@item @kbd{+} or @kbd{S-@key{UP}} (@code{org-agenda-priority-up})
@kindex +
@kindex S-UP
@@ -10389,6 +10543,12 @@ in the original buffer, but the agenda is not resorted. Use the
@findex org-agenda-priority-down
Decrease the priority of the current item.
+@item @kbd{C-c C-x e} or short @kbd{e} (@code{org-agenda-set-effort})
+@kindex e
+@kindex C-c C-x e
+@findex org-agenda-set-effort
+Set the effort property for the current item.
+
@item @kbd{C-c C-z} or short @kbd{z} (@code{org-agenda-add-note})
@kindex z
@kindex C-c C-z
@@ -10806,8 +10966,10 @@ Another possibility is the construction of agenda views that comprise
the results of @emph{several} commands, each of which creates a block in
the agenda buffer. The available commands include @code{agenda} for the
daily or weekly agenda (as created with @kbd{a}) , @code{alltodo} for
-the global TODO list (as constructed with @kbd{t}), and the
+the global TODO list (as constructed with @kbd{t}), @code{stuck} for
+the list of stuck projects (as obtained with @kbd{#}) and the
matching commands discussed above: @code{todo}, @code{tags}, and @code{tags-todo}.
+
Here are two examples:
@lisp
@@ -11248,6 +11410,13 @@ get in your way. Configure the variable @code{org-use-sub-superscripts} to
change this convention. For example, when setting this variable to
@code{@{@}}, @samp{a_b} is not interpreted as a subscript, but @samp{a_@{b@}} is.
+You can set @code{org-use-sub-superscripts} in a file using the export
+option @samp{^:} (see @ref{Export Settings}). For example, @samp{#+OPTIONS: ^:@{@}}
+sets @code{org-use-sub-superscripts} to @code{@{@}} and limits super- and
+subscripts to the curly bracket notation.
+
+You can also toggle the visual display of super- and subscripts:
+
@table @asis
@item @kbd{C-c C-x \} (@code{org-toggle-pretty-entities})
@kindex C-c C-x \
@@ -11255,6 +11424,13 @@ change this convention. For example, when setting this variable to
This command formats sub- and superscripts in a WYSIWYM way.
@end table
+@vindex org-pretty-entities
+@vindex org-pretty-entities-include-sub-superscripts
+Set both @code{org-pretty-entities} and
+@code{org-pretty-entities-include-sub-superscripts} to @code{t} to start with
+super- and subscripts @emph{visually} interpreted as specified by the
+option @code{org-use-sub-superscripts}.
+
@node Special Symbols
@section Special Symbols
@@ -11891,7 +12067,7 @@ back-ends:
@end itemize
Users can install libraries for additional formats from the Emacs
-packaging system. For easy discovery, these packages have a common
+packaging system. For easy discovery, these packages have a common
naming scheme: @code{ox-NAME}, where @var{NAME} is a format. For
example, @code{ox-koma-letter} for @emph{koma-letter} back-end. More libraries
can be found in the @samp{contrib/} directory (see @ref{Installation}).
@@ -12067,9 +12243,7 @@ The email address (@code{user-mail-address}).
Language to use for translating certain strings
(@code{org-export-default-language}). With @samp{#+LANGUAGE: fr}, for
example, Org translates @samp{Table of contents} to the French @samp{Table des
- matières}@footnote{For export to @LaTeX{} format---or @LaTeX{}-related formats such as
-Beamer---, the @samp{org-latex-package-alist} variable needs further
-configuration. See @ref{@LaTeX{} specific export settings}.}.
+ matières}@footnote{DEFINITION NOT FOUND@.}.
@item @samp{SELECT_TAGS}
@cindex @samp{SELECT_TAGS}, keyword
@@ -13399,7 +13573,7 @@ following lines before the table in the Org file:
@cindex @samp{ATTR_HTML}, keyword
@example
#+CAPTION: This is a table with lines around and between cells
-#+ATTR_HTML: border="2" rules="all" frame="border"
+#+ATTR_HTML: :border 2 :rules all :frame border
@end example
The HTML export back-end preserves column groupings in Org tables (see
@@ -13695,17 +13869,15 @@ simpler ways of customizing as described above.
@subsection JavaScript supported display of web pages
Sebastian Rose has written a JavaScript program especially designed to
-enhance the web viewing experience of HTML files created with Org.
-This program enhances large files in two different ways of viewing.
-One is an @emph{Info}-like mode where each section is displayed separately
-and navigation can be done with the @kbd{n} and @kbd{p}
-keys, and some other keys as well, press @kbd{?} for an overview
-of the available keys. The second one has a @emph{folding} view, much like
-Org provides inside Emacs. The script is available at
-@uref{https://orgmode.org/org-info.js} and the documentation at
-@uref{https://orgmode.org/worg/code/org-info-js/}. The script is hosted on
-@uref{https://orgmode.org}, but for reliability, prefer installing it on your
-own web server.
+allow two different ways of viewing HTML files created with Org. One
+is an @emph{Info}-like mode where each section is displayed separately and
+navigation can be done with the @kbd{n} and @kbd{p} keys, and some other
+keys as well, press @kbd{?} for an overview of the available keys. The
+second one has a @emph{folding} view, much like Org provides inside Emacs.
+The script is available at @uref{https://orgmode.org/org-info.js} and the
+documentation at @uref{https://orgmode.org/worg/code/org-info-js/}. The
+script is hosted on @uref{https://orgmode.org}, but for reliability, prefer
+installing it on your own web server.
To use this program, just add this line to the Org file:
@@ -16269,6 +16441,33 @@ tables and lists in foreign buffers. For example, in an HTML buffer,
write a list in Org syntax, select it, and convert it to HTML with
@kbd{M-x org-html-convert-region-to-html}.
+@menu
+* Bare HTML:: Exporting HTML without CSS, Javascript, etc.
+@end menu
+
+@node Bare HTML
+@subsection Exporting to minimal HTML
+
+If you want to output a minimal HTML file, with no CSS, no Javascript,
+no preamble or postamble, here are the variable you would need to set:
+
+@vindex org-html-head
+@vindex org-html-head-extra
+@vindex org-html-head-include-default-style
+@vindex org-html-head-include-scripts
+@vindex org-html-preamble
+@vindex org-html-postamble
+@vindex org-html-use-infojs
+@lisp
+(setq org-html-head ""
+ org-html-head-extra ""
+ org-html-head-include-default-style nil
+ org-html-head-include-scripts nil
+ org-html-preamble nil
+ org-html-postamble nil
+ org-html-use-infojs nil)
+@end lisp
+
@node Publishing
@chapter Publishing
@@ -16654,6 +16853,8 @@ any, during publishing. Options set within a file (see @ref{Export Settings}),
@tab @code{org-html-mathjax-options}
@item @code{:html-mathjax-template}
@tab @code{org-html-mathjax-template}
+@item @code{:html-equation-reference-format}
+@tab @code{org-html-equation-reference-format}
@item @code{:html-metadata-timestamp-format}
@tab @code{org-html-metadata-timestamp-format}
@item @code{:html-postamble-format}
@@ -17169,6 +17370,34 @@ Here is an example source code block in the Emacs Lisp language:
#+END_SRC
@end example
+Source code blocks are one of many Org block types, which also include
+``center'', ``comment'', ``dynamic'', ``example'', ``export'', ``quote'',
+``special'', and ``verse''. This section pertains to blocks between
+@samp{#+BEGIN_SRC} and @samp{#+END_SRC}.
+
+Details of Org's facilities for working with source code are described
+in the following sections.
+
+@menu
+* Features Overview:: Enjoy the versatility of source blocks.
+* Structure of Code Blocks:: Code block syntax described.
+* Using Header Arguments:: Different ways to set header arguments.
+* Environment of a Code Block:: Arguments, sessions, working directory...
+* Evaluating Code Blocks:: Place results of evaluation in the Org buffer.
+* Results of Evaluation:: Choosing a results type, post-processing...
+* Exporting Code Blocks:: Export contents and/or results.
+* Extracting Source Code:: Create pure source code files.
+* Languages:: List of supported code block languages.
+* Editing Source Code:: Language major-mode editing.
+* Noweb Reference Syntax:: Literate programming in Org mode.
+* Library of Babel:: Use and contribute to a library of useful code blocks.
+* Key bindings and Useful Functions:: Work quickly with code blocks.
+* Batch Execution:: Call functions from the command line.
+@end menu
+
+@node Features Overview
+@section Features Overview
+
Org can manage the source code in the block delimited by @samp{#+BEGIN_SRC}
@dots{} @samp{#+END_SRC} in several ways that can simplify housekeeping tasks
essential to modern source code maintenance. Org can edit, format,
@@ -17177,13 +17406,7 @@ and execute a source code block, then capture the results. The Org
mode literature sometimes refers to source code blocks as @emph{live code}
blocks because they can alter the content of the Org document or the
material that it exports. Users can control how live they want each
-source code block by tweaking the header arguments (see @ref{Using Header Arguments}) for compiling, execution, extraction, and
-exporting.
-
-Source code blocks are one of many Org block types, which also include
-``center'', ``comment'', ``dynamic'', ``example'', ``export'', ``quote'',
-``special'', and ``verse''. This section pertains to blocks between
-@samp{#+BEGIN_SRC} and @samp{#+END_SRC}.
+source code block by tweaking the header arguments (see @ref{Using Header Arguments}) for compiling, execution, extraction, and exporting.
For editing and formatting a source code block, Org uses an
appropriate Emacs major mode that includes features specifically
@@ -17221,25 +17444,6 @@ configuration settings of the execution environment, the results of
the execution, and associated narratives, claims, references, and
internal and external links in a single Org document.
-Details of Org's facilities for working with source code are described
-in the following sections.
-
-@menu
-* Structure of Code Blocks:: Code block syntax described.
-* Using Header Arguments:: Different ways to set header arguments.
-* Environment of a Code Block:: Arguments, sessions, working directory...
-* Evaluating Code Blocks:: Place results of evaluation in the Org buffer.
-* Results of Evaluation:: Choosing a results type, post-processing...
-* Exporting Code Blocks:: Export contents and/or results.
-* Extracting Source Code:: Create pure source code files.
-* Languages:: List of supported code block languages.
-* Editing Source Code:: Language major-mode editing.
-* Noweb Reference Syntax:: Literate programming in Org mode.
-* Library of Babel:: Use and contribute to a library of useful code blocks.
-* Key bindings and Useful Functions:: Work quickly with code blocks.
-* Batch Execution:: Call functions from the command line.
-@end menu
-
@node Structure of Code Blocks
@section Structure of Code Blocks
@@ -17988,7 +18192,7 @@ variable @code{org-babel-inline-result-wrap}, which by default is set to
This is the name of the code block (see @ref{Structure of Code Blocks})
to be evaluated in the current document. If the block is located in
another file, start @samp{<name>} with the file name followed by
-a colon. For example, in order to execute a block named @samp{clear-data}
+a colon. For example, in order to execute a block named @samp{clear-data}
in @samp{file.org}, you can write the following:
@example
@@ -18080,8 +18284,7 @@ A note of warning: when @samp{cache} is used in a session, caching may
cause unexpected results.
When the caching mechanism tests for any source code changes, it does
-not expand Noweb style references (see @ref{Noweb Reference Syntax}). For
-reasons why, see @uref{http://thread.gmane.org/gmane.emacs.orgmode/79046}.
+not expand noweb style references (see @ref{Noweb Reference Syntax}).
The @samp{cache} header argument can have one of two values: @samp{yes} or @samp{no}.
@@ -18155,20 +18358,20 @@ they are mutually exclusive.
@table @asis
@item @samp{value}
-Default. Functional mode. Org gets the value by wrapping the code
-in a function definition in the language of the source block. That
-is why when using @samp{:results value}, code should execute like
-a function and return a value. For languages like Python, an
-explicit @code{return} statement is mandatory when using @samp{:results
- value}. Result is the value returned by the last statement in the
-code block.
+Default for most Babel libraries@footnote{Actually, the constructs @samp{call_<name>()} and @samp{src_<lang>@{@}}
+are not evaluated when they appear in a keyword (see @ref{In-buffer Settings}).}. Functional mode. Org
+gets the value by wrapping the code in a function definition in the
+language of the source block. That is why when using @samp{:results
+ value}, code should execute like a function and return a value. For
+languages like Python, an explicit @code{return} statement is mandatory
+when using @samp{:results value}. Result is the value returned by the
+last statement in the code block.
When evaluating the code block in a session (see @ref{Environment of a Code Block}), Org passes the code to an interpreter running as an
-interactive Emacs inferior process. Org gets the value from the
+interactive Emacs inferior process. Org gets the value from the
source code interpreter's last statement output. Org has to use
language-specific methods to obtain the value. For example, from
-the variable @code{_} in Python and Ruby, and the value of @code{.Last.value}
-in R@.
+the variable @code{_} in Ruby, and the value of @code{.Last.value} in R@.
@item @samp{output}
Scripting mode. Org passes the code to an external process running
@@ -18178,41 +18381,6 @@ stream as text results.
When using a session, Org passes the code to the interpreter running
as an interactive Emacs inferior process. Org concatenates any text
output from the interpreter and returns the collection as a result.
-
-Note that this collection is not the same as that would be collected
-from stdout of a non-interactive interpreter running as an external
-process. Compare for example these two blocks:
-
-@example
-#+BEGIN_SRC python :results output
- print "hello"
- 2
- print "bye"
-#+END_SRC
-
-#+RESULTS:
-: hello
-: bye
-@end example
-
-In the above non-session mode, the ``2'' is not printed; so it does
-not appear in results.
-
-@example
-#+BEGIN_SRC python :results output :session
- print "hello"
- 2
- print "bye"
-#+END_SRC
-
-#+RESULTS:
-: hello
-: 2
-: bye
-@end example
-
-In the above session, the interactive interpreter receives and
-prints ``2''. Results show that.
@end table
@anchor{Type}
@@ -18312,14 +18480,25 @@ and the extension are mandatory.
@cindex @samp{file-desc}, header argument
The @samp{file-desc} header argument defines the description (see
-@ref{Link Format}) for the link. If @samp{file-desc} has no value, Org
-uses the generated file name for both the ``link'' and
-``description'' parts of the link.
+@ref{Link Format}) for the link. If @samp{file-desc} is present but has no value,
+the @samp{file} value is used as the link description. When this
+argument is not present, the description is omitted.
@cindex @samp{sep}, header argument
By default, Org assumes that a table written to a file has
TAB-delimited output. You can choose a different separator with
the @samp{sep} header argument.
+
+@cindex @samp{file-mode}, header argument
+The @samp{file-mode} header argument defines the file permissions. To
+make it executable, use @samp{:file-mode (identity #o755)}.
+
+@example
+#+BEGIN_SRC shell :results file :file script.sh :file-mode (identity #o755)
+ echo "#!/bin/bash"
+ echo "echo Hello World"
+#+END_SRC
+@end example
@end table
@anchor{Format}
@@ -18349,13 +18528,13 @@ Results enclosed in a @samp{BEGIN_EXPORT latex} block. Usage example:
@item @samp{link}
@itemx @samp{graphics}
-Result is a link to the file specified in @samp{:file} header argument.
-However, unlike plain @samp{:file}, nothing is written to the disk. The
-block is used for its side-effects only, as in the following
-example:
+When used along with @samp{file} type, the result is a link to the file
+specified in @samp{:file} header argument. However, unlike plain @samp{file}
+type, nothing is written to the disk. The block is used for its
+side-effects only, as in the following example:
@example
-#+begin_src shell :results link :file "download.tar.gz"
+#+begin_src shell :results file link :file "download.tar.gz"
wget -c "http://example.com/download.tar.gz"
#+end_src
@end example
@@ -18557,7 +18736,7 @@ code.
When Org tangles code blocks, it expands, merges, and transforms them.
Then Org recomposes them into one or more separate files, as
configured through the options. During this tangling process, Org
-expands variables in the source code, and resolves any Noweb style
+expands variables in the source code, and resolves any noweb style
references (see @ref{Noweb Reference Syntax}).
@anchor{Header arguments}
@@ -18615,7 +18794,7 @@ the source block.
Includes both @samp{link} and @samp{org} options.
@item @samp{noweb}
-Includes @samp{link} option, expands Noweb references (see @ref{Noweb Reference Syntax}), and wraps them in link comments inside the body
+Includes @samp{link} option, expands noweb references (see @ref{Noweb Reference Syntax}), and wraps them in link comments inside the body
of the code block.
@end table
@@ -18654,7 +18833,7 @@ By default Org expands code blocks during tangling. The @samp{no-expand}
header argument turns off such expansions. Note that one side-effect
of expansion by @code{org-babel-expand-src-block} also assigns values (see
@ref{Environment of a Code Block}) to variables. Expansions also replace
-Noweb references with their targets (see @ref{Noweb Reference Syntax}).
+noweb references with their targets (see @ref{Noweb Reference Syntax}).
Some of these expansions may cause premature assignment, hence this
option. This option makes a difference only for tangling. It has no
effect when exporting since code blocks for execution have to be
@@ -18715,7 +18894,7 @@ file.
Code blocks in the following languages are supported.
-@multitable @columnfractions 0.20 0.35 0.20 0.20
+@multitable @columnfractions 0.25 0.25 0.25 0.20
@headitem Language
@tab Identifier
@tab Language
@@ -18915,11 +19094,13 @@ for Python and Emacs Lisp languages.
@node Noweb Reference Syntax
@section Noweb Reference Syntax
-@cindex code block, Noweb reference
-@cindex syntax, Noweb
-@cindex source code, Noweb reference
+@cindex code block, noweb reference
+@cindex syntax, noweb
+@cindex source code, noweb reference
-Org supports named blocks in Noweb@footnote{For Noweb literate programming details, see
+@cindex @samp{noweb-ref}, header argument
+Source code blocks can include references to other source code blocks,
+using a noweb@footnote{For noweb literate programming details, see
@uref{http://www.cs.tufts.edu/~nr/noweb/}.} style syntax:
@example
@@ -18927,42 +19108,48 @@ Org supports named blocks in Noweb@footnote{For Noweb literate programming detai
@end example
-Org can replace the construct with the source code, or the results of
-evaluation, of the code block identified as @var{CODE-BLOCK-ID}.
+@noindent
+where @var{CODE-BLOCK-ID} refers to either the @samp{NAME} of a single
+source code block, or a collection of one or more source code blocks
+sharing the same @samp{noweb-ref} header argument (see @ref{Using Header Arguments}). Org can replace such references with the source code of
+the block or blocks being referenced, or, in the case of a single
+source code block named with @samp{NAME}, with the results of an evaluation
+of that block.
@cindex @samp{noweb}, header argument
-The @samp{noweb} header argument controls expansion of Noweb syntax
+The @samp{noweb} header argument controls expansion of noweb syntax
references. Expansions occur when source code blocks are evaluated,
tangled, or exported.
@table @asis
@item @samp{no}
-Default. No expansion of Noweb syntax references in the body of the
+Default. No expansion of noweb syntax references in the body of the
code when evaluating, tangling, or exporting.
@item @samp{yes}
-Expansion of Noweb syntax references in the body of the code block
+Expansion of noweb syntax references in the body of the code block
when evaluating, tangling, or exporting.
@item @samp{tangle}
-Expansion of Noweb syntax references in the body of the code block
+Expansion of noweb syntax references in the body of the code block
when tangling. No expansion when evaluating or exporting.
@item @samp{no-export}
-Expansion of Noweb syntax references in the body of the code block
+Expansion of noweb syntax references in the body of the code block
when evaluating or tangling. No expansion when exporting.
@item @samp{strip-export}
-Expansion of Noweb syntax references in the body of the code block
-when expanding prior to evaluating or tangling. Removes Noweb
+Expansion of noweb syntax references in the body of the code block
+when expanding prior to evaluating or tangling. Removes noweb
syntax references when exporting.
@item @samp{eval}
-Expansion of Noweb syntax references in the body of the code block
+Expansion of noweb syntax references in the body of the code block
only before evaluating.
@end table
-In the following example,
+In the most simple case, the contents of a single source block is
+inserted within other blocks. Thus, in following example,
@example
#+NAME: initialization
@@ -18986,88 +19173,11 @@ the second code block is expanded as
#+END_SRC
@end example
-Noweb insertions honor prefix characters that appear before the Noweb
-syntax reference. This behavior is illustrated in the following
-example. Because the @samp{<<example>>} Noweb reference appears behind the
-SQL comment syntax, each line of the expanded Noweb reference is
-commented. With:
-
-@example
-#+NAME: example
-#+BEGIN_SRC text
- this is the
- multi-line body of example
-#+END_SRC
-@end example
-
-@noindent
-this code block:
-
-@example
-#+BEGIN_SRC sql :noweb yes
- ---<<example>>
-#+END_SRC
-@end example
-
-@noindent
-expands to:
-
-@example
-#+BEGIN_SRC sql :noweb yes
- ---this is the
- ---multi-line body of example
-#+END_SRC
-@end example
-
-Since this change does not affect Noweb replacement text without
-newlines in them, inline Noweb references are acceptable.
-
-This feature can also be used for management of indentation in
-exported code snippets. With:
-
-@example
-#+NAME: if-true
-#+BEGIN_SRC python :exports none
- print('do things when true')
-#+end_src
-
-#+name: if-false
-#+begin_src python :exports none
- print('do things when false')
-#+end_src
-@end example
-
-@noindent
-this code block:
-
-@example
-#+begin_src python :noweb yes :results output
- if true:
- <<if-true>>
- else:
- <<if-false>>
-#+end_src
-@end example
-
-@noindent
-expands to:
-
-@example
-if true:
- print('do things when true')
-else:
- print('do things when false')
-@end example
-
-@cindex @samp{noweb-ref}, header argument
-When expanding Noweb style references, Org concatenates code blocks by
-matching the reference name to either the code block name or, if none
-is found, to the @samp{noweb-ref} header argument.
-
-For simple concatenation, set this @samp{noweb-ref} header argument at the
-sub-tree or file level. In the example Org file shown next, the body
-of the source code in each block is extracted for concatenation to
-a pure code file when tangled.
+You may also include the contents of multiple blocks sharing a common
+@samp{noweb-ref} header argument, which can be set at the file, sub-tree,
+or code block level. In the example Org file shown next, the body of
+the source code in each block is extracted for concatenation to a pure
+code file when tangled.
@example
#+BEGIN_SRC sh :tangle yes :noweb yes :shebang #!/bin/sh
@@ -19096,24 +19206,25 @@ a pure code file when tangled.
@cindex @samp{noweb-sep}, header argument
By default a newline separates each noweb reference concatenation. To
-change this newline separator, edit the @samp{noweb-sep} header argument.
+use a different separator, edit the @samp{noweb-sep} header argument.
-Eventually, Org can include the results of a code block rather than
-its body. To that effect, append parentheses, possibly including
-arguments, to the code block name, as shown below.
+Alternatively, Org can include the results of evaluation of a single
+code block rather than its body. Evaluation occurs when parentheses,
+possibly including arguments, are appended to the code block name, as
+shown below.
@example
-<<code-block-name(optional arguments)>>
+<<NAME(optional arguments)>>
@end example
-Note that when using the above approach to a code block's results, the
-code block name set by @samp{NAME} keyword is required; the reference set
-by @samp{noweb-ref} does not work in that case.
+Note that in this case, a code block name set by @samp{NAME} keyword is
+required; the reference set by @samp{noweb-ref} will not work when
+evaluation is desired.
Here is an example that demonstrates how the exported content changes
-when Noweb style references are used with parentheses versus without.
-With:
+when noweb style references are used with parentheses versus without.
+Given:
@example
#+NAME: some-code
@@ -19139,7 +19250,7 @@ print(num*10)
@end example
-Below, a similar Noweb style reference is used, but with parentheses,
+Below, a similar noweb style reference is used, but with parentheses,
while setting a variable @samp{num} to 10:
@example
@@ -19149,13 +19260,99 @@ while setting a variable @samp{num} to 10:
@end example
@noindent
-Note that now the expansion contains the results of the code block
+Note that the expansion now contains the results of the code block
@samp{some-code}, not the code block itself:
@example
100
@end example
+
+Noweb insertions honor prefix characters that appear before the noweb
+syntax reference. This behavior is illustrated in the following
+example. Because the @samp{<<example>>} noweb reference appears behind the
+SQL comment syntax, each line of the expanded noweb reference is
+commented. With:
+
+@example
+#+NAME: example
+#+BEGIN_SRC text
+ this is the
+ multi-line body of example
+#+END_SRC
+@end example
+
+@noindent
+this code block:
+
+@example
+#+BEGIN_SRC sql :noweb yes
+ ---<<example>>
+#+END_SRC
+@end example
+
+@noindent
+expands to:
+
+@example
+#+BEGIN_SRC sql :noweb yes
+ ---this is the
+ ---multi-line body of example
+#+END_SRC
+@end example
+
+Since this change does not affect noweb replacement text without
+newlines in them, inline noweb references are acceptable.
+
+This feature can also be used for management of indentation in
+exported code snippets. With:
+
+@example
+#+NAME: if-true
+#+BEGIN_SRC python :exports none
+ print('do things when true')
+#+end_src
+
+#+name: if-false
+#+begin_src python :exports none
+ print('do things when false')
+#+end_src
+@end example
+
+@noindent
+this code block:
+
+@example
+#+begin_src python :noweb yes :results output
+ if true:
+ <<if-true>>
+ else:
+ <<if-false>>
+#+end_src
+@end example
+
+@noindent
+expands to:
+
+@example
+if true:
+ print('do things when true')
+else:
+ print('do things when false')
+@end example
+
+When in doubt about the outcome of a source code block expansion, you
+can preview the results with the following command:
+
+@table @asis
+@item @kbd{C-c C-v v} or @kbd{C-c C-v C-v} (@code{org-babel-expand-src-block})
+@findex org-babel-expand-src-block
+@kindex C-c C-v v
+@kindex C-c C-v C-v
+Expand the current source code block according to its header
+arguments and pop open the results in a preview buffer.
+@end table
+
@node Library of Babel
@section Library of Babel
@@ -19357,12 +19554,13 @@ emacs -Q --batch --eval "
* Structure Templates:: Quick insertion of structural elements.
* Speed Keys:: Electric commands at the beginning of a headline.
* Clean View:: Getting rid of leading stars in the outline.
+* Execute commands in the active region:: Execute commands on multiple items in Org or agenda view.
* Dynamic Headline Numbering:: Display and update outline numbering.
* The Very Busy @kbd{C-c C-c} Key:: When in doubt, press @kbd{C-c C-c}.
* In-buffer Settings:: Overview of keywords.
* Org Syntax:: Formal description of Org's syntax.
* Documentation Access:: Read documentation about current syntax.
-* Escape Character::
+* Escape Character:: Prevent Org from interpreting your writing.
* Code Evaluation Security:: Org files evaluate in-line code.
* Interaction:: With other Emacs packages.
* TTY Keys:: Using Org on a tty.
@@ -19411,10 +19609,6 @@ At the beginning of an empty headline, complete TODO keywords.
After @samp{\}, complete @TeX{} symbols supported by the exporter.
@item
-After @samp{*}, complete headlines in the current buffer so that they
-can be used in search links like: @samp{[[*find this headline]]}
-
-@item
After @samp{:} in a headline, complete tags. Org deduces the list of
tags from the @samp{TAGS} in-buffer option (see @ref{Setting Tags}), the
variable @code{org-tag-alist}, or from all tags used in the current
@@ -19426,7 +19620,11 @@ of keys is constructed dynamically from all keys used in the
current buffer.
@item
-After @samp{[}, complete link abbreviations (see @ref{Link Abbreviations}).
+After @samp{[[}, complete link abbreviations (see @ref{Link Abbreviations}).
+
+@item
+After @samp{[[*}, complete headlines in the current buffer so that they
+can be used in search links like: @samp{[[*find this headline]]}
@item
After @samp{#+}, complete the special keywords like @samp{TYP_TODO} or
@@ -19580,9 +19778,16 @@ through @code{word-wrap}.}.
@vindex org-indent-indentation-per-level
To make more horizontal space, the headlines are shifted by two
characters. Configure @code{org-indent-indentation-per-level} variable for
-a different number. Only one star on each headline is visible, the
-rest are masked with the same font color as the background@footnote{Note that turning on Org Indent mode sets
-@code{org-hide-leading-stars} to @code{t} and @code{org-adapt-indentation} to @code{nil}.}.
+a different number.
+
+@vindex org-indent-mode-turns-on-hiding-stars
+@vindex org-indent-mode-turns-off-org-adapt-indentation
+By default, Org Indent mode turns off @code{org-adapt-indentation} and does
+hide leading stars by locally setting @code{org-hide-leading-stars} to @code{t}:
+only one star on each headline is visible, the rest are masked with
+the same font color as the background. If you want to customize this
+default behavior, see @code{org-indent-mode-turns-on-hiding-stars} and
+@code{org-indent-mode-turns-off-org-adapt-indentation}.
@vindex org-startup-indented
To globally turn on Org Indent mode for all files, customize the
@@ -19601,7 +19806,9 @@ It is possible to use hard spaces to achieve the indentation instead,
if the bare ASCII file should have the indented look also outside
Emacs@footnote{This works, but requires extra effort. Org Indent mode is
more convenient for most applications.}. With Org's support, you have to indent all lines to
-line up with the outline headers. You would use these settings:
+line up with the outline headers. You would use these
+settings@footnote{@code{org-adapt-indentation} can also be set to @samp{'headline-data},
+in which case only data lines below the headline will be indented.}:
@lisp
(setq org-adapt-indentation t
@@ -19631,7 +19838,7 @@ face @code{org-hide} to them. For per-file preference, use these file
@item @emph{Odd levels} (@code{org-odd-levels-only})
@vindex org-odd-levels-only
The third setting makes Org use only odd levels, 1, 3, 5, @dots{}, in
-the outline to create more indentation. On a per-file level,
+the outline to create more indentation. On a per-file level,
control this with:
@example
@@ -19643,6 +19850,26 @@ To convert a file between single and double stars layouts, use
@kbd{M-x org-convert-to-odd-levels} and @kbd{M-x org-convert-to-oddeven-levels}.
@end table
+@node Execute commands in the active region
+@section Execute commands in the active region
+
+@vindex org-loop-over-headlines-in-active-region
+When in an Org buffer and the region is active, some commands will
+apply to all the subtrees in the active region. For example, hitting
+@kbd{C-c C-s} when multiple headlines are within the active region will
+successively prompt you for a new schedule date and time. To disable
+this, set the option @code{org-loop-over-headlines-in-active-region} to
+non-@code{t}, activate the region and run the command normally.
+
+@vindex org-agenda-loop-over-headlines-in-active-region
+@code{org-agenda-loop-over-headlines-in-active-region} is the equivalent
+option of the agenda buffer, where you can also use @ref{Bulk remote editing selected entries, , bulk editing of
+selected entries}.
+
+Not all commands can loop in the active region and what subtrees or
+headlines are considered can be refined: see the docstrings of these
+options for more details.
+
@node Dynamic Headline Numbering
@section Dynamic Headline Numbering
@@ -19671,6 +19898,11 @@ If @code{org-num-skip-footnotes} is non-@code{nil}, footnotes sections (see
You can control how the numbering is displayed by setting
@code{org-num-face} and @code{org-num-format-function}.
+@vindex org-startup-numerated
+You can also turn this mode globally for all Org files by setting the
+option @code{org-startup-numerated} to @samp{t}, or locally on a file by using
+@samp{#+startup: num}.
+
@node The Very Busy @kbd{C-c C-c} Key
@section The Very Busy @kbd{C-c C-c} Key
@@ -19684,6 +19916,9 @@ manual, but here is a consolidated list for easy reference.
@itemize
@item
+If column view (see @ref{Column View}) is on, exit column view.
+
+@item
If any highlights shown in the buffer from the creation of a sparse
tree, or from clock display, remove such highlights.
@@ -19753,7 +19988,7 @@ Closing and reopening the Org file in Emacs also activates the
changes.
@table @asis
-@item @samp{#+ARCHIVE: %s_done}
+@item @samp{#+ARCHIVE: %s_done::}
@cindex @samp{ARCHIVE}, keyword
@vindex org-archive-location
Sets the archive location of the agenda file. The corresponding
@@ -19793,9 +20028,9 @@ corresponding variable is @code{org-link-abbrev-alist}.
@item @samp{#+PRIORITIES: highest lowest default}
@cindex @samp{PRIORITIES}, keyword
-@vindex org-highest-priority
-@vindex org-lowest-priority
-@vindex org-default-priority
+@vindex org-priority-highest
+@vindex org-priority-lowest
+@vindex org-priority-default
This line sets the limits and the default for the priorities. All
three must be either letters A--Z or numbers 0--9. The highest
priority must have a lower ASCII number than the lowest priority.
@@ -19827,8 +20062,8 @@ Startup options Org uses when first visiting a file.
@vindex org-startup-folded
The first set of options deals with the initial visibility of the
outline tree. The corresponding variable for global default
-settings is @code{org-startup-folded} with a default value of @code{t}, which
-is the same as @code{overview}.
+settings is @code{org-startup-folded} with a default value of
+@code{showeverything}.
@multitable {aaaaaaaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaa}
@item @samp{overview}
@@ -19854,6 +20089,17 @@ wraps long lines, including headlines, correctly indented.}.
@tab Start with Org Indent mode turned off.
@end multitable
+@vindex org-startup-numerated
+Dynamic virtual numeration of headlines is controlled by the variable
+@code{org-startup-numerated}.
+
+@multitable {aaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
+@item @samp{num}
+@tab Start with Org num mode turned on.
+@item @samp{nonum}
+@tab Start with Org num mode turned off.
+@end multitable
+
@vindex org-startup-align-all-tables
Aligns tables consistently upon visiting a file. The
corresponding variable is @code{org-startup-align-all-tables} with
@@ -20116,8 +20362,10 @@ using it on a headline displays ``Document Structure'' section.
@cindex zero width space
You may sometimes want to write text that looks like Org syntax, but
should really read as plain text. Org may use a specific escape
-character in some situations, e.g., a backslash in macros (see @ref{Macro Replacement}) or a comma in source and example blocks (see @ref{Literal Examples}). In the general case, however, we suggest to use the zero
-width space. You can insert one with any of the following:
+character in some situations, i.e., a backslash in macros (see @ref{Macro Replacement}) and links (see @ref{Link Format}), or a comma in source and
+example blocks (see @ref{Literal Examples}). In the general case, however,
+we suggest to use the zero width space. You can insert one with any
+of the following:
@example
C-x 8 <RET> zero width space <RET>
@@ -20617,8 +20865,8 @@ javascript:location.href='org-protocol://capture?template=x'+
@vindex org-protocol-default-template-key
The capture template to be used can be specified in the bookmark (like
-@samp{X} above). If unspecified, the template key is set in the variable
-@code{org-protocol-default-template-key}. The following template
+@samp{X} above). If unspecified, the template key is set in the variable
+@code{org-protocol-default-template-key}. The following template
placeholders are available:
@example
@@ -20778,13 +21026,11 @@ compatible with Org Mobile. It also describes synchronizing changes,
such as to notes, between the mobile application and the computer.
To change tags and TODO states in the mobile application, first
-customize the variables @code{org-todo-keywords} and @code{org-tag-alist}.
-These should cover all the important tags and TODO keywords, even if
-Org files use only some of them. Though the mobile application is
-expected to support in-buffer settings, it is required to understand
-TODO states @emph{sets} (see @ref{Per-file keywords}) and
-@emph{mutually exclusive} tags (see @ref{Setting Tags}) only for those set in
-these variables.
+customize the variables @code{org-todo-keywords}, @code{org-tag-alist} and
+@code{org-tag-persistent-alist}. These should cover all the important tags
+and TODO keywords, even if Org files use only some of them. Though
+the mobile application is expected to support in-buffer settings, it
+is required to understand TODO states @emph{sets} (see @ref{Per-file keywords}) and @emph{mutually exclusive} tags (see @ref{Setting Tags}) only for those set in these variables.
@menu
* Setting up the staging area:: For the mobile device.
@@ -20966,14 +21212,14 @@ process of adding Org links to Unix man pages, which look like this
@noindent
-The following @samp{org-man.el} file implements it
+The following @samp{ol-man.el} file implements it
@lisp
-;;; org-man.el - Support for links to man pages in Org mode
-(require 'org)
+;;; ol-man.el - Support for links to man pages in Org mode
+(require 'ol)
(org-link-set-parameters "man"
- :follow org-man-command
+ :follow #'org-man-open
:export #'org-man-export
:store #'org-man-store-link)
@@ -20982,6 +21228,11 @@ The following @samp{org-man.el} file implements it
:group 'org-link
:type '(choice (const man) (const woman)))
+(defun org-man-open (path _)
+ "Visit the manpage on PATH.
+PATH should be a topic that can be thrown at the man command."
+ (funcall org-man-command path))
+
(defun org-man-store-link ()
"Store a link to a man page."
(when (memq major-mode '(Man-mode woman-mode))
@@ -20989,7 +21240,7 @@ The following @samp{org-man.el} file implements it
(let* ((page (org-man-get-page-name))
(link (concat "man:" page))
(description (format "Man page for %s" page)))
- (org-store-link-props
+ (org-link-store-props
:type "man"
:link link
:description description))))
@@ -21001,7 +21252,7 @@ The following @samp{org-man.el} file implements it
(match-string 1 (buffer-name))
(error "Cannot create link to this man page")))
-(defun org-man-export (link description format)
+(defun org-man-export (link description format _)
"Export a man page link from Org files."
(let ((path (format "http://man.he.net/?topic=%s&section=all" link))
(desc (or description link)))
@@ -21012,8 +21263,8 @@ The following @samp{org-man.el} file implements it
(`ascii (format "%s (%s)" desc path))
(t path))))
-(provide 'org-man)
-;;; org-man.el ends here
+(provide ol-man)
+;;; ol-man.el ends here
@end lisp
@noindent
@@ -21021,15 +21272,15 @@ To activate links to man pages in Org, enter this in the Emacs init
file:
@lisp
-(require 'org-man)
+(require 'ol-man)
@end lisp
@noindent
-A review of @samp{org-man.el}:
+A review of @samp{ol-man.el}:
@enumerate
@item
-First, @samp{(require 'org)} ensures @samp{org.el} is loaded.
+First, @samp{(require 'ol)} ensures that @samp{ol.el} is loaded.
@item
@findex org-link-set-parameters
@@ -21384,7 +21635,7 @@ Update all dynamic blocks in the current file.
Before updating a dynamic block, Org removes content between the
@samp{BEGIN} and @samp{END} markers. Org then reads the parameters on the
-@samp{BEGIN} line for passing to the writer function as a plist. The
+@samp{BEGIN} line for passing to the writer function as a plist. The
previous content of the dynamic block becomes erased from the buffer
and appended to the plist under @code{:content}.
@@ -21986,7 +22237,7 @@ a JavaScript program for displaying webpages derived from Org using
an Info-like or a folding interface with single-key navigation.
@end table
-See below for the full list of contributions! Again, please let me
+See below for the full list of contributions! Again, please let me
know what I am missing here!
@anchor{From Bastien}
@@ -22043,7 +22294,7 @@ be complete if the ones above were not mentioned in this manual.
@itemize
@item
-Russel Adams came up with the idea for drawers.
+Russell Adams came up with the idea for drawers.
@item
Thomas Baumann wrote @samp{ol-bbdb.el} and @samp{ol-mhe.el}.
diff --git a/doc/misc/pcl-cvs.texi b/doc/misc/pcl-cvs.texi
index d1951f581c9..0d4f9769115 100644
--- a/doc/misc/pcl-cvs.texi
+++ b/doc/misc/pcl-cvs.texi
@@ -7,7 +7,7 @@
@c %**end of header
@copying
-Copyright @copyright{} 1991--2020 Free Software Foundation, Inc.
+Copyright @copyright{} 1991--2021 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
diff --git a/doc/misc/pgg.texi b/doc/misc/pgg.texi
index 261897b735c..82495275fca 100644
--- a/doc/misc/pgg.texi
+++ b/doc/misc/pgg.texi
@@ -10,7 +10,7 @@
This file describes PGG @value{VERSION}, an Emacs interface to various
PGP implementations.
-Copyright @copyright{} 2001, 2003--2020 Free Software Foundation, Inc.
+Copyright @copyright{} 2001, 2003--2021 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
diff --git a/doc/misc/rcirc.texi b/doc/misc/rcirc.texi
index 2054ca5860d..ff8133b2a1f 100644
--- a/doc/misc/rcirc.texi
+++ b/doc/misc/rcirc.texi
@@ -6,7 +6,7 @@
@c %**end of header
@copying
-Copyright @copyright{} 2006--2020 Free Software Foundation, Inc.
+Copyright @copyright{} 2006--2021 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
diff --git a/doc/misc/reftex.texi b/doc/misc/reftex.texi
index 0dab5241517..599252fabf7 100644
--- a/doc/misc/reftex.texi
+++ b/doc/misc/reftex.texi
@@ -46,7 +46,7 @@ This manual documents @RefTeX{} (version @value{VERSION}), a package
to do labels, references, citations and indices for LaTeX documents
with Emacs.
-Copyright @copyright{} 1997--2020 Free Software Foundation, Inc.
+Copyright @copyright{} 1997--2021 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
diff --git a/doc/misc/remember.texi b/doc/misc/remember.texi
index df845372f4d..80065be0a16 100644
--- a/doc/misc/remember.texi
+++ b/doc/misc/remember.texi
@@ -9,7 +9,7 @@
@copying
This manual is for Remember Mode, version 2.0
-Copyright @copyright{} 2001, 2004--2005, 2007--2020 Free Software
+Copyright @copyright{} 2001, 2004--2005, 2007--2021 Free Software
Foundation, Inc.
@quotation
diff --git a/doc/misc/sasl.texi b/doc/misc/sasl.texi
index a25f98566c7..847ad5ed763 100644
--- a/doc/misc/sasl.texi
+++ b/doc/misc/sasl.texi
@@ -9,7 +9,7 @@
@copying
This file describes the Emacs SASL library, version @value{VERSION}.
-Copyright @copyright{} 2000, 2004--2020 Free Software Foundation, Inc.
+Copyright @copyright{} 2000, 2004--2021 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
diff --git a/doc/misc/sc.texi b/doc/misc/sc.texi
index ccf5b9efb05..3f5b5917a0b 100644
--- a/doc/misc/sc.texi
+++ b/doc/misc/sc.texi
@@ -15,7 +15,7 @@
This document describes Supercite, an Emacs package for citing and
attributing replies to mail and news messages.
-Copyright @copyright{} 1993, 2001--2020 Free Software Foundation, Inc.
+Copyright @copyright{} 1993, 2001--2021 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
diff --git a/doc/misc/sem-user.texi b/doc/misc/sem-user.texi
index d151cee02cc..c37291ac143 100644
--- a/doc/misc/sem-user.texi
+++ b/doc/misc/sem-user.texi
@@ -1,5 +1,5 @@
@c This is part of the Semantic manual.
-@c Copyright (C) 1999--2005, 2007, 2009--2020 Free Software Foundation,
+@c Copyright (C) 1999--2005, 2007, 2009--2021 Free Software Foundation,
@c Inc.
@c See file semantic.texi for copying conditions.
diff --git a/doc/misc/semantic.texi b/doc/misc/semantic.texi
index c2b2be2282e..3c4f2f0c0e5 100644
--- a/doc/misc/semantic.texi
+++ b/doc/misc/semantic.texi
@@ -25,7 +25,7 @@
@copying
This manual documents the Semantic library and utilities.
-Copyright @copyright{} 1999--2005, 2007, 2009--2020 Free Software
+Copyright @copyright{} 1999--2005, 2007, 2009--2021 Free Software
Foundation, Inc.
@quotation
diff --git a/doc/misc/ses.texi b/doc/misc/ses.texi
index 6edd6a65762..b529f0b836c 100644
--- a/doc/misc/ses.texi
+++ b/doc/misc/ses.texi
@@ -12,7 +12,7 @@
@copying
This file documents @acronym{SES}: the Simple Emacs Spreadsheet.
-Copyright @copyright{} 2002--2020 Free Software Foundation, Inc.
+Copyright @copyright{} 2002--2021 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
diff --git a/doc/misc/sieve.texi b/doc/misc/sieve.texi
index 0813caebd0f..c30409fc32c 100644
--- a/doc/misc/sieve.texi
+++ b/doc/misc/sieve.texi
@@ -10,7 +10,7 @@
@copying
This file documents the Emacs Sieve package, for server-side mail filtering.
-Copyright @copyright{} 2001--2020 Free Software Foundation, Inc.
+Copyright @copyright{} 2001--2021 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
diff --git a/doc/misc/smtpmail.texi b/doc/misc/smtpmail.texi
index f4367b35377..dd481d2101e 100644
--- a/doc/misc/smtpmail.texi
+++ b/doc/misc/smtpmail.texi
@@ -4,7 +4,7 @@
@include docstyle.texi
@syncodeindex vr fn
@copying
-Copyright @copyright{} 2003--2020 Free Software Foundation, Inc.
+Copyright @copyright{} 2003--2021 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
diff --git a/doc/misc/speedbar.texi b/doc/misc/speedbar.texi
index c9c3daf963b..9991917b3fd 100644
--- a/doc/misc/speedbar.texi
+++ b/doc/misc/speedbar.texi
@@ -5,7 +5,7 @@
@syncodeindex fn cp
@copying
-Copyright @copyright{} 1999--2020 Free Software Foundation, Inc.
+Copyright @copyright{} 1999--2021 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
diff --git a/doc/misc/srecode.texi b/doc/misc/srecode.texi
index 79734685e9d..a0e999b6812 100644
--- a/doc/misc/srecode.texi
+++ b/doc/misc/srecode.texi
@@ -16,7 +16,7 @@
@c %**end of header
@copying
-Copyright @copyright{} 2007--2020 Free Software Foundation, Inc.
+Copyright @copyright{} 2007--2021 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex
index 0a26e9f702c..3c7051d1c74 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-06-25.17}
+\def\texinfoversion{2020-10-24.12}
%
% Copyright 1985, 1986, 1988, 1990-2020 Free Software Foundation, Inc.
%
@@ -1088,7 +1088,7 @@ where each line of input produces a line of output.}
}
% The -2 in the arguments here gives all the input to TeX catcode 12
% (other) or 10 (space), preventing undefined control sequence errors. See
- % https://lists.gnu.org/r/bug-texinfo/2019-08/msg00031.html
+ % https://lists.gnu.org/archive/html/bug-texinfo/2019-08/msg00031.html
%
\endgroup
\def\pdfescapestring#1{\directlua{PDFescstr('\luaescapestring{#1}')}}
@@ -3038,10 +3038,18 @@ end
% arg (if given), and not the url (which is then just the link target).
\newif\ifurefurlonlylink
+% The default \pretolerance setting stops the penalty inserted in
+% \urefallowbreak being a discouragement to line breaking. Set it to
+% a negative value for this paragraph only. Hopefully this does not
+% conflict with redefinitions of \par done elsewhere.
+\def\nopretolerance{%
+\pretolerance=-1
+\def\par{\endgraf\pretolerance=100 \let\par\endgraf}%
+}
+
% The main macro is \urefbreak, which allows breaking at expected
-% places within the url. (There used to be another version, which
-% didn't support automatic breaking.)
-\def\urefbreak{\begingroup \urefcatcodes \dourefbreak}
+% places within the url.
+\def\urefbreak{\nopretolerance \begingroup \urefcatcodes \dourefbreak}
\let\uref=\urefbreak
%
\def\dourefbreak#1{\urefbreakfinish #1,,,\finish}
@@ -3152,14 +3160,14 @@ end
% Allow a ragged right output to aid breaking long URL's. There can
% be a break at the \allowbreak with no extra glue (if the existing stretch in
-% the line is sufficient), a break at the \penalty100 with extra glue added
+% the line is sufficient), a break at the \penalty with extra glue added
% at the end of the line, or no break at all here.
% Changing the value of the penalty and/or the amount of stretch affects how
% preferable one choice is over the other.
\def\urefallowbreak{%
- \allowbreak
+ \penalty0\relax
\hskip 0pt plus 2 em\relax
- \penalty300
+ \penalty1000\relax
\hskip 0pt plus -2 em\relax
}
@@ -3356,6 +3364,25 @@ end
\def\sup{\ifmmode \expandafter\ptexsp \else \expandafter\finishsup\fi}
\def\finishsup#1{$\ptexsp{\hbox{\switchtolllsize #1}}$}%
+% provide this command from LaTeX as it is very common
+\def\frac#1#2{{{#1}\over{#2}}}
+
+% @displaymath.
+% \globaldefs is needed to recognize the end lines in \tex and
+% \end tex. Set \thisenv as @end displaymath is seen before @end tex.
+{\obeylines
+\globaldefs=1
+\envdef\displaymath{%
+\tex
+\def\thisenv{\displaymath}%
+$$%
+}
+
+\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.
@@ -7639,7 +7666,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\endgroup
%
\envdef\verbatim{%
- \setupverbatim\doverbatim
+ \setnormaldispenv\setupverbatim\doverbatim
}
\let\Everbatim = \afterenvbreak
@@ -11459,6 +11486,18 @@ directory should work if nowhere else does.}
\globaldefs = 0
}}
+\def\bsixpaper{{\globaldefs = 1
+ \afourpaper
+ \internalpagesizes{140mm}{100mm}%
+ {-6.35mm}{-12.7mm}%
+ {\bindingoffset}{14pt}%
+ {176mm}{125mm}%
+ \let\SETdispenvsize=\smallword
+ \lispnarrowing = 0.2in
+ \globaldefs = 0
+}}
+
+
% @pagesizes TEXTHEIGHT[,TEXTWIDTH]
% Perhaps we should allow setting the margins, \topskip, \parskip,
% and/or leading, also. Or perhaps we should compute them somehow.
@@ -11472,12 +11511,12 @@ directory should work if nowhere else does.}
\setleading{\textleading}%
%
\dimen0 = #1\relax
- \advance\dimen0 by \voffset
- \advance\dimen0 by 1in % reference point for DVI is 1 inch from top of page
+ \advance\dimen0 by 2.5in % default 1in margin above heading line
+ % and 1.5in to include heading, footing and
+ % bottom margin
%
\dimen2 = \hsize
- \advance\dimen2 by \normaloffset
- \advance\dimen2 by 1in % reference point is 1 inch from left edge of page
+ \advance\dimen2 by 2in % default to 1 inch margin on each side
%
\internalpagesizes{#1}{\hsize}%
{\voffset}{\normaloffset}%
diff --git a/doc/misc/todo-mode.texi b/doc/misc/todo-mode.texi
index 428df56f6ea..dbd7f3d02f7 100644
--- a/doc/misc/todo-mode.texi
+++ b/doc/misc/todo-mode.texi
@@ -9,7 +9,7 @@
@c %**end of header
@copying
-Copyright @copyright{} 2013--2020 Free Software Foundation, Inc.
+Copyright @copyright{} 2013--2021 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 6738ed5123d..e9ffd6a8c43 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -12,7 +12,7 @@
@footnotestyle end
@copying
-Copyright @copyright{} 1999--2020 Free Software Foundation, Inc.
+Copyright @copyright{} 1999--2021 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -319,14 +319,14 @@ behind the scenes when you open a file with @value{tramp}.
@uref{https://ftp.gnu.org/gnu/tramp/}. The version number of
@value{tramp} can be obtained by the variable @code{tramp-version}.
For released @value{tramp} versions, this is a three-number string
-like ``2.4.3''.
+like ``2.4.5''.
A @value{tramp} release, which is packaged with Emacs, could differ
slightly from the corresponding standalone release. This is because
it isn't always possible to synchronize release dates between Emacs
and @value{tramp}. Such version numbers have the Emacs version number
-as suffix, like ``2.4.3.27.1''. This means @w{@value{tramp} 2.4.3} as
-integrated in @w{Emacs 27.1}. A complete list of @value{tramp}
+as suffix, like ``2.4.5.27.2''. This means @w{@value{tramp} 2.4.5} as
+integrated in @w{Emacs 27.2}. A complete list of @value{tramp}
versions packaged with Emacs can be retrieved by
@vindex customize-package-emacs-version-alist
@@ -338,7 +338,7 @@ versions packaged with Emacs can be retrieved by
ELPA} package. Besides the standalone releases, further minor version
of @value{tramp} will appear on GNU ELPA, until the next @value{tramp}
release appears. These minor versions have a four-number string, like
-``2.4.3.1''.
+``2.4.5.1''.
@value{tramp} development versions are available on Git servers.
Development versions contain new and incomplete features. The
@@ -443,7 +443,7 @@ are optional, in case of a missing part a default value is assumed.
The default value for an empty local file name part is the remote
user's home directory. The shortest remote file name is
@file{@trampfn{-,,}}, therefore. The @samp{-} notation for the
-default host is used for syntactical reasons, @ref{Default Host}.
+default method is used for syntactical reasons, @ref{Default Method}.
The @code{method} part describes the connection method used to reach
the remote host, see below.
@@ -558,8 +558,8 @@ of the local file name is the share exported by the remote host,
@cindex method @option{davs}
@cindex @option{dav} method
@cindex @option{davs} method
-@cindex method @option{media}
-@cindex @option{media} method
+@cindex method @option{mtp}
+@cindex @option{mtp} method
On systems, which have installed @acronym{GVFS, the GNOME Virtual File
System}, its offered methods could be used by @value{tramp}. Examples
@@ -567,7 +567,7 @@ are @file{@trampfn{sftp,user@@host,/path/to/file}},
@file{@trampfn{afp,user@@host,/path/to/file}} (accessing Apple's AFP
file system), @file{@trampfn{dav,user@@host,/path/to/file}},
@file{@trampfn{davs,user@@host,/path/to/file}} (for WebDAV shares) and
-@file{@trampfn{media,device,/path/to/file}} (for media devices).
+@file{@trampfn{mtp,device,/path/to/file}} (for media devices).
@anchor{Quick Start Guide: GNOME Online Accounts based methods}
@@ -1246,13 +1246,13 @@ Since Google Drive uses cryptic blob file names internally,
could produce unexpected behavior in case two files in the same
directory have the same @code{display-name}, such a situation must be avoided.
-@item @option{media}
-@cindex method @option{media}
-@cindex @option{media} method
+@item @option{mtp}
+@cindex method @option{mtp}
+@cindex @option{mtp} method
@cindex media
Media devices, like cell phones, tablets, cameras, can be accessed via
-the @option{media} method. Just the device name is needed in order to
+the @option{mtp} method. Just the device name is needed in order to
specify the host in the file name. However, the device must already
be connected via USB, before accessing it. Possible device names are
visible via host name completion, @ref{File name completion}.
@@ -1263,7 +1263,7 @@ different parts of their file system.
@value{tramp} does not require a host name as part of the remote file
name when a single media device is connected. @value{tramp} instead
-uses @file{@trampfn{media,,}} as the default name.
+uses @file{@trampfn{mtp,,}} as the default name.
@item @option{nextcloud}
@cindex method @option{nextcloud}
@@ -1289,7 +1289,7 @@ that for security reasons refuse @command{ssh} connections.
@defopt tramp-gvfs-methods
This user option is a list of external methods for @acronym{GVFS}@.
By default, this list includes @option{afp}, @option{dav},
-@option{davs}, @option{gdrive}, @option{media}, @option{nextcloud} and
+@option{davs}, @option{gdrive}, @option{mtp}, @option{nextcloud} and
@option{sftp}. Other methods to include are @option{ftp},
@option{http}, @option{https} and @option{smb}. These methods are not
intended to be used directly as @acronym{GVFS}-based method. Instead,
@@ -1622,6 +1622,7 @@ support this command.
@subsection Tunneling with ssh
+@vindex ProxyCommand@r{, ssh option}
With @command{ssh}, you could use the @option{ProxyCommand} entry in
@file{~/.ssh/config}:
@@ -2056,9 +2057,11 @@ default value is @t{"/data/local/tmp"} for the @option{adb} method,
@item @t{"direct-async-process"}
When this property is non-@code{nil}, an alternative, more performant
-implementation of @code{make-process} and
-@code{start-file-process} is applied. @ref{Improving performance of
-asynchronous remote processes} for a discussion of constraints.
+implementation of @code{make-process} and @code{start-file-process} is
+applied. The connection method must also be marked with a
+non-@code{nil} @code{tramp-direct-async} parameter in
+@code{tramp-methods}. @ref{Improving performance of asynchronous
+remote processes} for a discussion of constraints.
@item @t{"posix"}
@@ -2180,7 +2183,7 @@ be recomputed. To force @value{tramp} to recompute afresh, call
Per default, @value{tramp} uses the command @command{/bin/sh} for
starting a shell on the remote host. This can be changed by setting
-the connection property @t{"remote-shell"}, see @xref{Predefined
+the connection property @t{"remote-shell"}; see @pxref{Predefined
connection information}. If you want, for example, use
@command{/usr/bin/zsh} on a remote host, you might apply
@@ -2214,6 +2217,11 @@ overwrite this, you might apply
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}.
+
@subsection Other remote shell setup hints
@cindex remote shell setup
@@ -2335,7 +2343,7 @@ string of that environment variable looks always like
@example
@group
echo $INSIDE_EMACS
-@result{} 27.1,tramp:2.4.3
+@result{} 27.2,tramp:2.4.5
@end group
@end example
@@ -2361,8 +2369,7 @@ that can identify such questions using
@lisp
@group
(defconst my-tramp-prompt-regexp
- (concat (regexp-opt '("Enter the birth date of your mother:") t)
- "\\s-*")
+ "Enter the birth date of your mother:\\s-*"
"Regular expression matching my login prompt question.")
@end group
@@ -2381,6 +2388,11 @@ that can identify such questions using
@end group
@end lisp
+The regular expressions used in @code{tramp-actions-before-shell} must
+match the end of the connection buffer. Due to performance reasons,
+this search starts at the end of the buffer, and it is limited to 256
+characters backwards.
+
@item Conflicting names for users and variables in @file{.profile}
@@ -2508,7 +2520,7 @@ whatever shell is installed on the device with this setting:
@lisp
@group
(add-to-list 'tramp-connection-properties
- (list (regexp-quote "192.168.0.26") "remote-shell" "sh"))
+ (list (regexp-quote "192.168.0.26") "remote-shell" "sh"))
@end group
@end lisp
@@ -2560,7 +2572,7 @@ the previous example, fix the connection properties as follows:
@lisp
@group
(add-to-list 'tramp-connection-properties
- (list (regexp-quote "android") "remote-shell" "sh"))
+ (list (regexp-quote "android") "remote-shell" "sh"))
@end group
@end lisp
@@ -3193,9 +3205,9 @@ integrated to work with @value{tramp}: @file{shell.el},
@value{tramp} always modifies the @env{INSIDE_EMACS} environment
variable for remote processes. Per default, this environment variable
shows the Emacs version. @value{tramp} adds its own version string,
-so it looks like @samp{27.1,tramp:2.4.3.1}. However, other packages
+so it looks like @samp{27.2,tramp:2.4.5.1}. However, other packages
might also add their name to this environment variable, like
-@samp{27.1,comint,tramp:2.4.3.1}.
+@samp{27.2,comint,tramp:2.4.5.1}.
For @value{tramp} to find the command on the remote, it must be
accessible through the default search path as setup by @value{tramp}
@@ -3304,6 +3316,8 @@ whatever reason, then replace @code{(getenv "DISPLAY")} with a
hard-coded, fixed name. Note that using @code{:0} for X11 display name
here will not work as expected.
+@vindex ForwardX11@r{, ssh option}
+@vindex ForwardX11Trusted@r{, ssh option}
An alternate approach is specify @option{ForwardX11 yes} or
@option{ForwardX11Trusted yes} in @file{~/.ssh/config} on the local
host.
@@ -3566,6 +3580,7 @@ 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
@@ -3584,9 +3599,6 @@ It does not set process property @code{remote-pid}.
@item
It does not use @code{tramp-remote-path} and
@code{tramp-remote-process-environment}.
-
-@item
-It does not set environment variable @env{INSIDE_EMACS}.
@end itemize
In order to gain even more performance, it is recommended to bind
@@ -3948,7 +3960,7 @@ row are possible, like @file{/path/to/dir/file.tar.gz.uu/dir/file}.
@vindex tramp-archive-all-gvfs-methods
An archive file name could be a remote file name, as in
-@file{/ftp:anonymous@@ftp.gnu.org:/gnu/tramp/tramp-2.4.3.tar.gz/INSTALL}.
+@file{/ftp:anonymous@@ftp.gnu.org:/gnu/tramp/tramp-2.4.5.tar.gz/INSTALL}.
Since all file operations are mapped internally to @acronym{GVFS}
operations, remote file names supported by @code{tramp-gvfs} perform
better, because no local copy of the file archive must be downloaded
@@ -3959,7 +3971,7 @@ the similar @samp{/scp:user@@host:...}. See the constant
If @code{url-handler-mode} is enabled, archives could be visited via
URLs, like
-@file{https://ftp.gnu.org/gnu/tramp/tramp-2.4.3.tar.gz/INSTALL}. This
+@file{https://ftp.gnu.org/gnu/tramp/tramp-2.4.5.tar.gz/INSTALL}. This
allows complex file operations like
@lisp
@@ -3967,8 +3979,8 @@ allows complex file operations like
(progn
(url-handler-mode 1)
(ediff-directories
- "https://ftp.gnu.org/gnu/tramp/tramp-2.4.2.tar.gz/tramp-2.4.2"
- "https://ftp.gnu.org/gnu/tramp/tramp-2.4.3.tar.gz/tramp-2.4.3" ""))
+ "https://ftp.gnu.org/gnu/tramp/tramp-2.4.4.tar.gz/tramp-2.4.4"
+ "https://ftp.gnu.org/gnu/tramp/tramp-2.4.5.tar.gz/tramp-2.4.5" ""))
@end group
@end lisp
@@ -4272,6 +4284,7 @@ In order to disable those optimizations, set user option
@item
@value{tramp} does not recognize if a @command{ssh} session hangs
+@vindex ServerAliveInterval@r{, ssh option}
@command{ssh} sessions on the local host hang when the network is
down. @value{tramp} cannot safely detect such hangs. The network
configuration for @command{ssh} can be configured to kill such hangs
@@ -4288,6 +4301,8 @@ Host *
@item
@value{tramp} does not use default @command{ssh} @option{ControlPath}
+@vindex ControlPath@r{, ssh option}
+@vindex ControlPersist@r{, ssh option}
@value{tramp} overwrites @option{ControlPath} settings when initiating
@command{ssh} sessions. @value{tramp} does this to fend off a stall
if a master session opened outside the Emacs session is no longer
@@ -4309,8 +4324,8 @@ which allows you to set the @option{ControlPath} provided the variable
@end group
@end lisp
-Note how "%r", "%h" and "%p" must be encoded as "%%r", "%%h" and
-"%%p".
+Note how @samp{%r}, @samp{%h} and @samp{%p} must be encoded as
+@samp{%%r}, @samp{%%h} and @samp{%%p}.
@vindex tramp-use-ssh-controlmaster-options
If the @file{~/.ssh/config} is configured appropriately for the above
@@ -4321,6 +4336,8 @@ this @code{nil} setting:
(customize-set-variable 'tramp-use-ssh-controlmaster-options nil)
@end lisp
+@vindex ProxyCommand@r{, ssh option}
+@vindex ProxyJump@r{, ssh option}
This shall also be set to @code{nil} if you use the
@option{ProxyCommand} or @option{ProxyJump} options in your
@command{ssh} configuration.
@@ -4341,9 +4358,9 @@ configure @file{~/.ssh/config} on the proxy host:
@example
@group
Host *
- ControlMaster auto
- ControlPath tramp.%C
- ControlPersist no
+ ControlMaster auto
+ ControlPath tramp.%C
+ ControlPersist no
@end group
@end example
@@ -4878,6 +4895,27 @@ In case you have installed it from its Git repository, @ref{Recompilation}.
@item
+I get an error @samp{Remote file error: Forbidden reentrant call of Tramp}
+
+@vindex remote-file-error
+@vindex debug-ignored-errors
+Timers, process filters and sentinels, and other event based functions
+can run at any time, when a remote file operation is still running.
+This can cause @value{tramp} to block. When such a situation is
+detected, this error is triggered. It shall be fixed in the
+respective function (an error report will help), but for the time
+being you can suppress this error by the following code in your
+@file{~/.emacs}:
+
+@lisp
+@group
+(setq debug-ignored-errors
+ (cons 'remote-file-error debug-ignored-errors))
+@end group
+@end lisp
+
+
+@item
How to disable other packages from calling @value{tramp}?
There are packages that call @value{tramp} without the user ever
@@ -4982,7 +5020,7 @@ handlers.
@node External packages
@section Integrating with external Lisp packages
-@subsection File name completion.
+@subsection File name completion
@vindex non-essential
Sometimes, it is not convenient to open a new connection to a remote
@@ -5000,8 +5038,9 @@ bind it to non-@code{nil} value.
@end lisp
-@subsection File attributes cache.
+@subsection File attributes cache
+@vindex process-file-side-effects
Keeping a local cache of remote file attributes in sync with the
remote host is a time-consuming operation. Flushing and re-querying
these attributes can tax @value{tramp} to a grinding halt on busy
@@ -5040,9 +5079,30 @@ root-directory, it is most likely sufficient to make the
@code{default-directory} of the process buffer as the root directory.
+@subsection Timers
+
+@vindex remote-file-error
+Timers run asynchronously at any time when Emacs is waiting for
+sending a string to a process, or waiting for process output. They
+can run any remote file operation, which would conflict with the
+already running remote file operation, if the same connection is
+affected. @value{tramp} detects this situation, and raises the
+@code{remote-file-error} error. A timer function shall avoid this
+situation. At least, it shall protect itself against this error, by
+wrapping the timer function body with
+
+@lisp
+@group
+(ignore-error 'remote-file-error
+ @dots{})
+@end group
+@end lisp
+
+
@node Traces and Profiles
@chapter How to Customize Traces
@vindex tramp-verbose
+@vindex tramp-debug-to-file
@value{tramp} messages are raised with verbosity levels ranging from 0
to 10. @value{tramp} does not display all messages; only those with a
@@ -5095,6 +5155,20 @@ If @code{tramp-verbose} is greater than or equal to 10, Lisp
backtraces are also added to the @value{tramp} debug buffer in case of
errors.
+In very rare cases it could happen, that @value{tramp} blocks Emacs.
+Killing Emacs does not allow to inspect the debug buffer. In that
+case, you might instruct @value{tramp} to mirror the debug buffer to
+file:
+
+@lisp
+(customize-set-variable 'tramp-debug-to-file t)
+@end lisp
+
+The debug buffer is written as file in your
+@code{temporary-file-directory}, which is usually @file{/tmp/}. Use
+this option with care, because it could decrease the performance of
+@value{tramp} actions.
+
To enable stepping through @value{tramp} function call traces, they
have to be specifically enabled as shown in this code:
diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi
index dbebbc36812..827c4773285 100644
--- a/doc/misc/trampver.texi
+++ b/doc/misc/trampver.texi
@@ -2,13 +2,13 @@
@c texi/trampver.texi. Generated from trampver.texi.in by configure.
@c This is part of the Emacs manual.
-@c Copyright (C) 2003--2020 Free Software Foundation, Inc.
+@c Copyright (C) 2003--2021 Free Software Foundation, Inc.
@c See file doclicense.texi for copying conditions.
@c In the Tramp GIT, the version numbers are auto-frobbed from
@c tramp.el, and the bug report address is auto-frobbed from
@c configure.ac.
-@set trampver 2.5.0-pre
+@set trampver 2.5.1-pre
@set trampurl https://www.gnu.org/software/tramp/
@set tramp-bug-report-address tramp-devel@@gnu.org
@set emacsver 25.1
diff --git a/doc/misc/url.texi b/doc/misc/url.texi
index 0304ff4b9f1..8f15e11007e 100644
--- a/doc/misc/url.texi
+++ b/doc/misc/url.texi
@@ -21,7 +21,7 @@
@copying
This is the manual for the @code{url} Emacs Lisp library.
-Copyright @copyright{} 1993--1999, 2002, 2004--2020 Free Software
+Copyright @copyright{} 1993--1999, 2002, 2004--2021 Free Software
Foundation, Inc.
@quotation
diff --git a/doc/misc/vhdl-mode.texi b/doc/misc/vhdl-mode.texi
index 527302e0cb0..fef98a74636 100644
--- a/doc/misc/vhdl-mode.texi
+++ b/doc/misc/vhdl-mode.texi
@@ -10,7 +10,7 @@
@copying
This file documents VHDL Mode, an Emacs mode for editing VHDL code.
-Copyright @copyright{} 1995--2008, 2010, 2012, 2015--2020 Free Software
+Copyright @copyright{} 1995--2008, 2010, 2012, 2015--2021 Free Software
Foundation, Inc.
@quotation
diff --git a/doc/misc/vip.texi b/doc/misc/vip.texi
index fe50309dd90..92c76ad2518 100644
--- a/doc/misc/vip.texi
+++ b/doc/misc/vip.texi
@@ -4,7 +4,7 @@
@include docstyle.texi
@copying
-Copyright @copyright{} 1987, 2001--2020 Free Software Foundation, Inc.
+Copyright @copyright{} 1987, 2001--2021 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
diff --git a/doc/misc/viper.texi b/doc/misc/viper.texi
index 661eb7c947a..e127f62bb5d 100644
--- a/doc/misc/viper.texi
+++ b/doc/misc/viper.texi
@@ -8,7 +8,7 @@
@include docstyle.texi
@copying
-Copyright @copyright{} 1995--1997, 2001--2020 Free Software Foundation,
+Copyright @copyright{} 1995--1997, 2001--2021 Free Software Foundation,
Inc.
@quotation
diff --git a/doc/misc/widget.texi b/doc/misc/widget.texi
index 3ce27a12a04..7fd9212d714 100644
--- a/doc/misc/widget.texi
+++ b/doc/misc/widget.texi
@@ -9,7 +9,7 @@
@c %**end of header
@copying
-Copyright @copyright{} 2000--2020 Free Software Foundation, Inc.
+Copyright @copyright{} 2000--2021 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -484,9 +484,21 @@ are interpreted in a widget specific way.
The following keyword arguments apply to all widgets:
@table @code
+@cindex internal format
+@cindex external format
@vindex value@r{ keyword}
@item :value
-The initial value for widgets of this type.
+The initial value for widgets of this type. Typically, a widget
+represents its value in two formats: external and internal. The
+external format is the value as the rest of Emacs sees it, and the
+internal format is a representation that the widget defines and uses
+in a widget specific way.
+
+Both formats might be the same for certain widgets and might differ
+for others, and there is no guarantee about which format the value
+stored in the @code{:value} property has. However, when creating a
+widget or defining a new one (@pxref{Defining New Widgets}), the
+@code{:value} should be in the external format.
@vindex format@r{ keyword}
@item :format
@@ -629,8 +641,9 @@ representation of the @code{:value} property if not.
@vindex match@r{ keyword}
@item :match
-Should be a function called with two arguments, the widget and a value,
-and returning non-@code{nil} if the widget can represent the specified value.
+Should be a function called with two arguments, the widget and an
+external value, and should return non-@code{nil} if the widget can
+represent the specified value.
@vindex validate@r{ keyword}
@item :validate
@@ -679,14 +692,14 @@ arguments, which will be used when creating the @code{radio-button} or
@end table
-@deffn {User Option} widget-glyph-directory
-Directory where glyphs are found.
+@deffn {User Option} widget-image-directory
+Directory where Widget should look for images.
Widget will look here for a file with the same name as specified for the
image, with either a @file{.xpm} (if supported) or @file{.xbm} extension.
@end deffn
-@deffn{User Option} widget-glyph-enable
-If non-@code{nil}, allow glyphs to appear on displays where they are supported.
+@deffn{User Option} widget-image-enable
+If non-@code{nil}, allow images to appear on displays where they are supported.
@end deffn
diff --git a/doc/misc/wisent.texi b/doc/misc/wisent.texi
index 8b6929be273..dc5b8e4d205 100644
--- a/doc/misc/wisent.texi
+++ b/doc/misc/wisent.texi
@@ -24,7 +24,7 @@
@c %**end of header
@copying
-Copyright @copyright{} 1988--1993, 1995, 1998--2004, 2007, 2012--2020
+Copyright @copyright{} 1988--1993, 1995, 1998--2004, 2007, 2012--2021
Free Software Foundation, Inc.
@c Since we are both GNU manuals, we do not need to ack each other here.
diff --git a/doc/misc/woman.texi b/doc/misc/woman.texi
index a114415e3a8..4470afcad20 100644
--- a/doc/misc/woman.texi
+++ b/doc/misc/woman.texi
@@ -15,7 +15,7 @@
This file documents WoMan: A program to browse Unix manual pages ``W.O.
(without) man''.
-Copyright @copyright{} 2001--2020 Free Software Foundation, Inc.
+Copyright @copyright{} 2001--2021 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
diff --git a/etc/CALC-NEWS b/etc/CALC-NEWS
index a0b9cdf696e..da9ed66f15d 100644
--- a/etc/CALC-NEWS
+++ b/etc/CALC-NEWS
@@ -1,4 +1,4 @@
-Copyright (C) 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 2001-2021 Free Software Foundation, Inc.
See the end of the file for license conditions.
Calc is an advanced desk calculator for GNU Emacs.
diff --git a/etc/ChangeLog.1 b/etc/ChangeLog.1
index 5a7cd59c979..629ab0b1fd4 100644
--- a/etc/ChangeLog.1
+++ b/etc/ChangeLog.1
@@ -6891,7 +6891,7 @@
;; coding: utf-8
;; End:
- Copyright (C) 1993-1999, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1993-1999, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/etc/DEBUG b/etc/DEBUG
index 7fb7e447583..fae87261865 100644
--- a/etc/DEBUG
+++ b/etc/DEBUG
@@ -1,6 +1,6 @@
Debugging GNU Emacs
-Copyright (C) 1985, 2000-2020 Free Software Foundation, Inc.
+Copyright (C) 1985, 2000-2021 Free Software Foundation, Inc.
See the end of the file for license conditions.
** Preliminaries
diff --git a/etc/DISTRIB b/etc/DISTRIB
index 767dac6a2ff..610c347289e 100644
--- a/etc/DISTRIB
+++ b/etc/DISTRIB
@@ -1,7 +1,7 @@
-*- text -*-
GNU Emacs availability information
-Copyright (C) 1986-1993, 1995, 1998, 2000-2020 Free Software Foundation,
+Copyright (C) 1986-1993, 1995, 1998, 2000-2021 Free Software Foundation,
Inc.
See the end of the file for license conditions.
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 78cb5401772..8c9306b5cac 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -1,6 +1,6 @@
ERC NEWS -*- outline -*-
-Copyright (C) 2006-2020 Free Software Foundation, Inc.
+Copyright (C) 2006-2021 Free Software Foundation, Inc.
See the end of the file for license conditions.
* For changes after ERC 5.3, see the main Emacs NEWS file
diff --git a/etc/ETAGS.EBNF b/etc/ETAGS.EBNF
index 80deb162186..c72ac6f721f 100644
--- a/etc/ETAGS.EBNF
+++ b/etc/ETAGS.EBNF
@@ -52,7 +52,7 @@ pattern ::= regstring /* a tag pattern */
tagname ::= regchar regstring /* a tag name */
-position ::= realposition | "," /* charpos,linepos */
+position ::= realposition | "," /* linepos,charpos */
realposition ::= "," unsint | unsint "," | unsint "," unsint
@@ -94,7 +94,7 @@ those.
===================== end of discussion of tag names =====================
-Copyright (C) 2002-2020 Free Software Foundation, Inc.
+Copyright (C) 2002-2021 Free Software Foundation, Inc.
COPYING PERMISSIONS:
diff --git a/etc/ETAGS.README b/etc/ETAGS.README
index 314e3215ab3..3c56021524f 100644
--- a/etc/ETAGS.README
+++ b/etc/ETAGS.README
@@ -28,7 +28,7 @@ ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-Copyright (C) 1984, 1987-1989, 1993-1995, 1998-2020 Free Software
+Copyright (C) 1984, 1987-1989, 1993-1995, 1998-2021 Free Software
Foundation, Inc.
This file is not considered part of GNU Emacs.
diff --git a/etc/HELLO b/etc/HELLO
index 9ea7ebc2de3..0cebb2bb7c2 100644
--- a/etc/HELLO
+++ b/etc/HELLO
@@ -30,20 +30,16 @@ Bengali (বাংলা) নমস্কার
Braille ⠓⠑⠇⠇⠕
Burmese (မြန်မာ) မင်္ဂလာပါ
C printf ("Hello, world!\n");
+Cham (ꨌꩌ) ꨦꨤꩌ ꨦꨁꨰ
Cherokee (ᏣᎳᎩ ᎦᏬᏂᎯᏍᏗ) ᎣᏏᏲ / ᏏᏲ
Comanche /kəˈmæntʃiː/ Haa marʉ́awe
-
Cree (ᓀᐦᐃᔭᐍᐏᐣ) ᑕᓂᓯ / ᐙᒋᔮ
-
Czech (čeština) Dobrý den
Danish (dansk) Hej / Goddag / Halløj
Dutch (Nederlands) Hallo / Dag
Efik /ˈɛfɪk/ Mɔkɔm
-
Egyptian Hieroglyphs (𓂋𓐰𓏤𓈖𓆎𓅓𓏏𓐰𓊖) 𓅓𓊵𓐰𓐷𓏏𓊪𓐸, 𓇍𓇋𓂻𓍘𓇋
-
Emacs emacs --no-splash -f view-hello-file
-
Emoji 👋
English /ˈɪŋɡlɪʃ/ Hello
Esperanto Saluton (Eĥoŝanĝo ĉiuĵaŭde)
@@ -59,7 +55,6 @@ Hebrew (עִבְרִית) שָׁלוֹם
Hungarian (magyar) Szép jó napot!
Hindi (हिंदी) नमस्ते / नमस्कार ।
Inuktitut (ᐃᓄᒃᑎᑐᑦ) ᐊᐃ
-
Italian (italiano) Ciao / Buon giorno
Javanese (ꦧꦱꦗꦮꦶ) console.log("ꦲꦭꦺꦴ");
Kannada (ಕನ್ನಡ) ನಮಸ್ಕಾರ
@@ -67,7 +62,6 @@ Khmer (ភាសាខ្មែរ) ជំរាបសួរ
Lao (ພາສາລາວ) ສະບາຍດີ / ຂໍໃຫ້ໂຊກດີ
Malayalam (മലയാളം) നമസ്കാരം
Maldivian (ދިވެހި) އައްސަލާމު ޢަލައިކުމް / ކިހިނެހް؟
-
Maltese (il-Malti) Bonġu / Saħħa
Mathematics ∀ p ∈ world • hello p □
Mongolian (монгол хэл) Сайн байна уу?
@@ -83,7 +77,6 @@ Swedish (svenska) Hej / Goddag / Hallå
Tamil (தமிழ்) வணக்கம்
Telugu (తెలుగు) నమస్కారం
TaiViet (ꪁꪫꪱꪣ ꪼꪕ) ꪅꪰꪙꫂ ꪨꪮꫂ ꪁꪫꪱ / ꪅꪽ ꪨꪷ ꪁꪫꪱ
-
Thai (ภาษาไทย) สวัสดีครับ / สวัสดีค่ะ
Tibetan (བོད་སྐད་) བཀྲ་ཤིས་བདེ་ལེགས༎
Tigrigna (ትግርኛ) ሰላማት
@@ -97,13 +90,12 @@ Vietnamese (tiếng Việt) Chào bạn
</x-charset><x-charset><param>chinese-gb2312</param>Chinese (中文,普通话,汉语) 你好
</x-charset><x-charset><param>chinese-big5-1</param>Cantonese (粵語,廣東話) 早晨, 你好
</x-charset><x-charset><param>korean-ksc5601</param>Korean (한글) 안녕하세요 / 안녕하십니까
-
</x-charset>
-Copyright (C) 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/etc/MACHINES b/etc/MACHINES
index 78e9cef0fd7..97995777370 100644
--- a/etc/MACHINES
+++ b/etc/MACHINES
@@ -1,6 +1,6 @@
Emacs machines list
-Copyright (C) 1989-1990, 1992-1993, 1998, 2001-2020 Free Software
+Copyright (C) 1989-1990, 1992-1993, 1998, 2001-2021 Free Software
Foundation, Inc.
See the end of the file for license conditions.
diff --git a/etc/MH-E-NEWS b/etc/MH-E-NEWS
index 420ddd026f4..29c48c72147 100644
--- a/etc/MH-E-NEWS
+++ b/etc/MH-E-NEWS
@@ -1,6 +1,6 @@
* COPYRIGHT
-Copyright (C) 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 2001-2021 Free Software Foundation, Inc.
See the end of the file for license conditions.
* Changes in MH-E 8.6
diff --git a/etc/NEWS b/etc/NEWS
index 59a0f26f269..7a012b48912 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1,6 +1,6 @@
GNU Emacs NEWS -- history of user-visible changes.
-Copyright (C) 2017-2020 Free Software Foundation, Inc.
+Copyright (C) 2017-2021 Free Software Foundation, Inc.
See the end of the file for license conditions.
Please send Emacs bug reports to 'bug-gnu-emacs@gnu.org'.
@@ -85,16 +85,44 @@ useful on systems such as FreeBSD which ships only with "etc/termcap".
* Changes in Emacs 28.1
+** The new NonGNU ELPA archive is enabled by default alongside GNU ELPA
+
** Minibuffer scrolling is now conservative by default.
This is controlled by the new variable 'scroll-minibuffer-conservatively'.
+In addition, there is a new variable
+'redisplay-adhoc-scroll-in-resize-mini-windows' to disable the
+ad-hoc auto-scrolling when resizing minibuffer windows. It has been
+found that its heuristic can be counter productive in some corner
+cases, tho the cure may be worse than the disease. This said, the
+effect should be negligible in the vast majority of cases anyway.
+
++++
+** Improved handling of minibuffers on switching frames.
+By default, when you switch to another frame, an active minibuffer now
+moves to the newly selected frame. Nevertheless, the effect of what
+you type in the minibuffer happens in the frame where the minibuffer
+was first activated. An alternative behavior is available by
+customizing 'minibuffer-follows-selected-frame' to nil. Here, the
+minibuffer stays in the frame where you first opened it, and you must
+switch back to this frame to continue or abort its command. The old
+behavior, which mixed these two, can be approximated by customizing
+'minibuffer-follows-selected-frame' to a value which is neither nil
+nor t.
+
+++
** New system for displaying documentation for groups of functions.
This can either be used by saying 'M-x shortdoc-display-group' and
-choosing a group, or clicking a button in the *Help* buffers when
+choosing a group, or clicking a button in the "*Help*" buffers when
looking at the doc string of a function that belongs to one of these
groups.
+---
+** Improved "find definition" feature of *Help* buffers.
+Now clicking on the link to find the definition of functions generated
+by 'cl-defstruct', or variables generated by 'define-derived-mode',
+for example, will go to the exact place where they are defined.
+
** New variable 'redisplay-skip-initial-frame' to enable batch redisplay tests.
Setting it to nil forces the redisplay to do its job even in the
initial frame used in batch mode.
@@ -133,11 +161,6 @@ characters. In particular, this significantly improves word-wrapping
for CJK text mixed with Latin text.
---
-** Improved language transliteration in Malayalam input methods.
-Added a new Mozhi scheme. The inapplicable ITRANS scheme is now
-deprecated. Errors in the Inscript method were corrected.
-
----
** Rudimentary support for the 'st' terminal emulator.
Emacs now supports 256 color display on the 'st' terminal emulator.
@@ -153,7 +176,9 @@ displays.)
+++
** Mouse wheel scrolling with Shift modifier now scrolls horizontally.
-This works in text buffers and over images.
+This works in text buffers and over images. Typing a numeric prefix arg
+(e.g. 'M-5') before starting horizontal scrolling changes its step value.
+The value is saved in the user option 'mouse-wheel-scroll-amount-horizontal'.
---
** The default value of 'frame-title-format' and 'icon-title-format' has changed.
@@ -178,6 +203,29 @@ space characters.
freenode IRC network for years now. Occurrences of "irc.freenode.net"
have been replaced with "chat.freenode.net" throughout Emacs.
++++
+** New functions 'null-device' and 'path-separator'.
+These functions return the connection local value of the respective
+variables. This can be used for remote hosts.
+
+** Emacs now prints a backtrace when signaling an error in batch mode.
+This makes debugging Emacs Lisp scripts run in batch mode easier. To
+get back the old behavior, set the new variable
+'backtrace-on-error-noninteractive' to a nil value.
+
+** 'redisplay-skip-fontification-on-input' helps Emacs keep up with fast input.
+This is another attempt to solve the problem of handling high key repeat rate
+and other "slow scrolling" situations. It is hoped it behaves better
+than 'fast-but-imprecise-scrolling' and 'jit-lock-defer-time'.
+It is not enabled by default.
+
++++
+** Modifiers now go outside angle brackets in pretty-printed key bindings.
+For example, <return> with Control and Meta modifiers is now shown as
+C-M-<return> instead of <C-M-return>. Either variant can be used as
+input; functions such as 'kbd' and 'read-kbd-macro' accept both styles
+as equivalent (they have done so for a long time).
+
* Editing Changes in Emacs 28.1
@@ -195,6 +243,20 @@ forms, but this command has now been changed to work more like
'eval-defun', and reset the values as specified.
+++
+** Standalone 'M-y' uses the minibuffer to complete previous kills.
+When 'M-y' is typed not after a yank command, it activates the minibuffer
+where you can browse previous kills using the minibuffer history or
+completion. In Isearch, you can bind 'C-s M-y' to the command
+`isearch-yank-pop' that uses the minibuffer with completion on
+previous kills to read a string and append it to the search string.
+
+---
+** New user options 'copy-region-blink-delay' and 'delete-pair-blink-delay'.
+'copy-region-blink-delay' specifies a delay to indicate the region
+copied by 'kill-ring-save'. 'delete-pair-blink-delay' specifies
+a delay to show a paired character to delete.
+
++++
** New command 'undo-redo'.
It undoes previous undo commands, but doesn't record itself as an
undoable command.
@@ -219,6 +281,10 @@ buffer to be able to move point to the inaccessible portion.
'goto-line-relative' is bound to 'C-x n g'.
+++
+** When called interactively, 'goto-char' now offers the number at
+point as default.
+
++++
** When 'suggest-key-bindings' is non-nil, the completion list of 'M-x'
shows equivalent key bindings for all commands that have them.
@@ -243,6 +309,11 @@ preserving markers, properties and overlays. The new variable
number of seconds that 'revert-buffer-with-fine-grain' should spend
trying to be non-destructive.
++++
+** New command 'memory-report'.
+This command opens a new buffer called "*Memory Report*" and gives a
+summary of where Emacs is using memory currently.
+
** Outline
+++
@@ -255,8 +326,46 @@ the buffer cycles the whole buffer between "only top-level headings",
* Changes in Specialized Modes and Packages in Emacs 28.1
+** 'blink-cursor-mode' is now enabled by default regardless of the UI.
+It used to be enabled when Emacs is started in GUI mode but not when started
+in text mode. The cursor still only actually blinks in GUI frames.
+
+** pcase
++++
+*** The `pred` pattern can now take the form (pred (not FUN)).
+This is like (pred (lambda (x) (not (FUN x)))) but results
+in better code.
+
++++
+** profiler.el
+The results displayed by 'profiler-report' now have the usage figures
+at the left hand side followed by the function name. This is intended
+to make better use of the horizontal space, in particular eliminating
+the truncation of function names. There is no way to get the former
+layout back.
+
+** Loading dunnet.el in batch mode doesn't start the game any more.
+Instead you need to do "emacs -f dun-batch" to start the game in
+batch mode.
+
+** Emacs Server
+
++++
+*** New user option 'server-client-instructions'.
+When emacsclient connects, Emacs will (by default) output a message
+about how to exit the client frame. If 'server-client-instructions'
+is set to nil, this message is inhibited.
+
+** Perl mode
+
+---
+*** New face 'perl-non-scalar-variable'.
+This is used to fontify non-scalar variables.
+
** Python mode
+*** 'python-shell-interpreter' now defaults to python3 on systems with python3.
+
*** 'C-c C-r' can now be used on arbitrary regions.
The command previously extended the start of the region to the start
of the line, but will now actually send the marked region, as
@@ -273,7 +382,7 @@ indentation is done using SMIE or with the old ad-hoc code.
When a warning is displayed to the user, the resulting buffer now has
buttons which allow making permanent changes to the treatment of that
warning. Automatic showing of the warning can be disabled (although
-it is still logged to the *Messages* buffer), or the warning can be
+it is still logged to the "*Messages*" buffer), or the warning can be
disabled entirely.
** mspool.el
@@ -283,6 +392,15 @@ disabled entirely.
** Windows
++++
+*** New 'display-buffer' function 'display-buffer-use-least-recent-window'
+This is like 'display-buffer-use-some-window', but won't reuse the
+current window, and when called repeatedly will try not to reuse a
+previously selected window.
+
+*** New function 'window-bump-use-time'.
+This updates the use time of a window.
+
*** The key prefix 'C-x 4 1' displays next command buffer in the same window.
It's bound to the command 'same-window-prefix' that requests the buffer
of the next command to be displayed in the same window.
@@ -306,15 +424,36 @@ of the next command to be displayed in a new tab.
+++
*** New command 'C-x t C-r' to open file read-only in other tab.
+---
*** The tab bar is frame-local when 'tab-bar-show' is a number.
Show/hide the tab bar independently for each frame, according to the
value of 'tab-bar-show'.
---
+*** New command 'toggle-frame-tab-bar'.
+It can be used to enable/disable the tab bar individually on each frame
+independently from the value of 'tab-bar-mode' and 'tab-bar-show'.
+
+---
+*** New user option 'tab-bar-tab-name-format-function'.
+
+---
*** The tabs in the tab line can now be scrolled using horizontal scroll.
If your mouse or trackpad supports it, you can now scroll tabs when
the mouse pointer is in the tab line by scrolling left or right.
+---
+*** New tab-line faces and options.
+The face 'tab-line-tab-special' is used for tabs whose buffers are
+special, i.e. not file-backed. The face
+'tab-line-tab-inactive-alternate' is used to display inactive tabs
+with an alternating background color, making them easier to
+distinguish between, especially if the face 'tab-line-tab' is
+configured to not display with a box; this alternate face is only
+applied when the option 'tab-line-tab-face-functions' is
+so-configured. That option may also be used to customize tab-line
+faces in other ways.
+
** New bindings in occur-mode, 'next-error-no-select' bound to 'n' and
'previous-error-no-select' bound to 'p'.
@@ -427,6 +566,11 @@ their 'default-directory' under VC.
*** New command 'vc-dir-root' uses the root directory without asking.
---
+*** New face 'log-view-commit-body'.
+This is used when expanding commit messages from 'vc-print-root-log'
+and similar commands.
+
+---
*** The responsible VC backend is now the most specific one.
'vc-responsible-backend' loops over the backends in
'vc-handled-backends' to determine which backend is responsible for a
@@ -457,6 +601,37 @@ tags to be considered as well.
** Gnus
+++
+*** New user option 'gnus-registry-register-all'.
+If non-nil (the default), create registry entries for all messages.
+If nil, don't automatically create entries, they must be created
+manually.
+
++++
+*** New user options to customise the summary line specs "%[" and "%]".
+Four new options introduced in customisation group
+'gnus-summary-format'. These are 'gnus-sum-opening-bracket',
+'gnus-sum-closing-bracket', 'gnus-sum-opening-bracket-adopted', and
+'gnus-sum-closing-bracket-adopted'. Their default values are "[", "]",
+"<", ">" respectively. These options control the appearance of "%["
+and "%]" specs in the summary line format. "%[" will normally display
+the value of 'gnus-sum-opening-bracket', but can also be
+'gnus-sum-opening-bracket-adopted' for the adopted articles. "%]" will
+normally display the value of 'gnus-sum-closing-bracket', but can also
+be 'gnus-sum-closing-bracket-adopted' for the adopted articles.
+
++++
+*** New user option 'gnus-paging-select-next'.
+This controls what happens when using commands like 'SPC' and 'DEL' to
+page the current article. If non-nil (the default), go to the
+next/prev article, but if nil, do nothing at the end/start of the article.
+
++++
+*** New gnus-search library.
+A new unified search syntax which can be used across multiple
+supported search engines. Set 'gnus-search-use-parsed-queries' to
+non-nil to enable.
+
++++
*** New value for user option 'smiley-style'.
Smileys can now be rendered with emojis instead of small images when
using the new 'emoji' value in 'smiley-style'.
@@ -543,6 +718,13 @@ not.
** Message
+---
+*** 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 now supports the OpenPGP header.
To generate these headers, add the new function
@@ -626,6 +808,39 @@ recorded for the purpose of 'view-lossage'.
The menu bar "Help" menu now has a "Show Recent Inputs" item under the
"Describe" sub-menu.
+** Input methods
+
++++
+*** Emacs now supports "transient" input methods.
+A transient input method is enabled for inserting a single character,
+and is then automatically disabled. 'C-x \' temporarily enables the
+selected transient input method. Use 'C-u C-x \' to select a
+transient input method (which can be different from the input method
+enabled by 'C-\'). For example, 'C-u C-x \ compose RET' selects the
+'compose' input method; then typing 'C-x \ 1 2' will insert the
+character '½', and disable the 'compose' input method afterwards.
+You can use 'C-x \' in incremental search to insert a single character
+to the search string.
+
+---
+*** New input method 'compose' based on X Multi_key sequences.
+
+---
+*** New input method 'iso-transl' with the same keys as 'C-x 8'.
+After selecting it as a transient input method with 'C-u C-x \
+iso-transl RET', it supports the same key sequences as 'C-x 8',
+so e.g. like 'C-x 8 [' inserts a left single quotation mark,
+'C-x \ [' does the same.
+
+---
+*** Improved language transliteration in Malayalam input methods.
+Added a new Mozhi scheme. The inapplicable ITRANS scheme is now
+deprecated. Errors in the Inscript method were corrected.
+
+---
+*** New input method 'cham'.
+There's also a Cham greeting in 'etc/HELLO'.
+
** Ispell
+++
@@ -657,6 +872,16 @@ This file was a compatibility kludge which is no longer needed.
To revert to the previous behavior,
'(setq lisp-indent-function 'lisp-indent-function)' from 'lisp-mode-hook'.
+** Customize
+
+*** Most customize commands now hide obsolete user options.
+Obsolete user options are no longer shown in the listings produced by
+the commands 'customize', 'customize-group', 'customize-apropos' and
+'customize-changed-options'.
+
+To customize obsolete user options, use 'customize-option' or
+'customize-saved'.
+
** Edebug
+++
@@ -735,7 +960,7 @@ preferred over the eudcb-mab.el backend.
** Tramp
+++
-*** New connection method "media", which allows accessing media devices
+*** New connection method "mtp", which allows accessing media devices
like cell phones, tablets or cameras.
+++
@@ -759,6 +984,12 @@ performance of asynchronous remote processes" node of the Tramp manual
for details, and also for a discussion or restrictions. This feature
is experimental.
++++
+*** New user option 'tramp-debug-to-file'.
+When non-nil, this user option instructs Tramp to mirror the debug
+buffer to a file under the "/tmp/" directory. This is useful, if (in
+rare cases) Tramp blocks Emacs, and we need further debug information.
+
** Tempo
---
@@ -776,12 +1007,14 @@ equivalent to '(map (:sym sym))'.
+++
*** New commands to filter the package list.
-The filter command key bindings are as follows:
+The filter commands are bound to the following keys:
key binding
--- -------
/ a package-menu-filter-by-archive
+/ d package-menu-filter-by-description
/ k package-menu-filter-by-keyword
+/ N package-menu-filter-by-name-or-description
/ n package-menu-filter-by-name
/ s package-menu-filter-by-status
/ v package-menu-filter-by-version
@@ -818,6 +1051,11 @@ Now GDB only uses one source window to display source file by default.
Customize 'gdb-max-source-window-count' to use more than one window.
Control source file display by 'gdb-display-source-buffer-action'.
++++
+*** The default value of 'gdb-mi-decode-strings' is now t.
+This means that the default coding-system is now used to decode strings
+and source file names from GDB.
+
** Gravatar
---
@@ -981,6 +1219,22 @@ If 'shr-width' is non-nil, it overrides this variable.
** Images
---
+*** You can explicitly specify base_uri for svg images.
+':base-uri' image property can be used to explicitly specify base_uri
+for embedded images into svg. ':base-uri' is supported for both file
+and data svg images.
+
++++
+*** 'svg-embed-base-uri-image' added to embed images.
+'svg-embed-base-uri-image' can be used to embed images located
+relatively to 'file-name-directory' of the ':base-uri' svg image property.
+This works much faster then 'svg-embed'.
+
++++
+*** New function 'image-cache-size'.
+This function returns the size of the current image cache, in bytes.
+
+---
*** Animated images stop automatically under high CPU pressure sooner.
Previously, an animated image would stop animating if any single image
took more than two seconds to display. The new algorithm maintains a
@@ -1023,6 +1277,10 @@ background colors or transparency, such as xbm, pbm, svg, png and gif.
** EWW
+++
+*** New user option 'eww-use-browse-url'.
+This is a regexp that can be set to alter how links are followed in eww.
+
++++
*** New user option 'eww-retrieve-command'.
This can be used to download data via an external command. If nil
(the default), then 'url-retrieve' is used.
@@ -1080,6 +1338,41 @@ project's root directory, respectively.
+++
*** New user option 'project-list-file'.
+** xref
+
+---
+*** Prefix arg of 'xref-goto-xref' quits the "*xref*" buffer.
+So typing 'C-u RET' in the "*xref*" buffer quits its window
+before navigating to the selected location.
+
+*** New user options 'xref-search-program' and 'xref-search-program-alist'.
+So far 'grep' and 'ripgrep' are supported. 'ripgrep' seems to offer better
+performance in certain cases, in particular for case-insensitive
+searches.
+
++++
+*** New commands 'xref-prev-group' and 'xref-next-group'.
+These commands are bound respectively to 'P' and 'N', and navigate to
+the first item of the previous or next group in the "*xref*" buffer.
+
+*** New alternative value for 'xref-show-definitions-function':
+'xref-show-definitions-completing-read'.
+
+*** The two existing alternatives for 'xref-show-definitions-function'
+have been renamed to have "proper" public names and documented
+('xref-show-definitions-buffer' and
+'xref-show-definitions-buffer-at-bottom').
+
+*** New command 'xref-quit-and-pop-marker-stack' and a binding for it
+in Xref buffers ('M-,'). This combination is easy to press
+semi-accidentally if the user wants to go back in the middle of
+choosing the exact definition to go to, and this should do TRT.
+
+---
+*** New value 'project-relative' for 'xref-file-name-display'
+If chosen, file names in *xref* buffers will be displayed relative
+to the 'project-root' of the current project, when available.
+
** json.el
---
@@ -1099,6 +1392,15 @@ https://www.w3.org/TR/xml/#charsets). Now it rejects such strings.
** erc
---
+*** erc-services.el now supports NickServ passwords from auth-source.
+The 'erc-use-auth-source-for-nickserv-password' variable enables querying
+auth-source for NickServ passwords. To enable this, add the following
+to your init file:
+
+ (setq erc-prompt-for-nickserv-password nil
+ erc-use-auth-source-for-nickserv-password t)
+
+---
*** The '/ignore' command will now ask for a timeout to stop ignoring the user.
Allowed inputs are seconds or ISO8601-like periods like "1h" or "4h30m".
@@ -1196,6 +1498,11 @@ and the result is not truncated in any way.
*** The '/' operator now has higher precedence in (La)TeX input mode.
It no longer has lower precedence than '+' and '-'.
+---
+*** Calc now marks its windows dedicated.
+The new user option 'calc-make-windows-dedicated' controls this. It
+is t by default; set to nil to get back the old behavior.
+
** term-mode
---
@@ -1233,8 +1540,103 @@ This face is used for error messages from 'diff'.
*** New command 'diff-refresh-hunk'.
This new command (bound to 'C-c C-l') regenerates the current hunk.
+** Buttons
+
++++
+*** New minor mode 'button-mode'.
+This minor mode does nothing else than install 'button-buffer-map' as
+a minor mode map (which binds the 'TAB' / 'S-TAB' key bindings to navigate
+to buttons), and can be used in any view-mode-like buffer that has
+buttons in it.
+
++++
+*** New utility function 'button-buttonize'.
+This function takes a string and returns a string propertized in a way
+that makes it a valid button.
+
+
** Miscellaneous
+*** New function 'buffer-line-statistics'.
+This function returns some statistics about the line lengths in a buffer.
+
++++
+*** New variable 'inhibit-interaction' to make user prompts signal an error.
+If this is bound to something non-nil, functions like
+`read-from-minibuffer', `read-char' (and related) will signal an
+`inhibited-interaction' error.
+
+---
+*** 'process-attributes' now works under OpenBSD, too.
+
++++
+*** New button face 'flat-button'.
+This is a plain 2D button, but uses the background color instead of
+the foreground color.
+
++++
+*** New predicate functions 'length<', 'length>' and 'length='.
+Using these functions may be more efficient than using 'length' (if
+the length of a (long) list is being computed just to compare this
+length to a number).
+
+---
+*** 'remove-hook' is now an interactive command.
+
+---
+*** New user option 'authinfo-hide-elements'.
+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.
+
++++
+*** New function 'object-intervals'.
+This function returns a copy of the list of intervals (i.e., text
+properties) in the object in question (which must either be a string
+or a buffer).
+
+---
+*** 'hexl-mode' scrolling commands now heed 'next-screen-context-lines'.
+Previously, 'hexl-scroll-down' and 'hexl-scroll-up' would scroll
+up/down an entire window, but they now work more like the standard
+scrolling commands.
+
+---
+*** Errors in 'kill-emacs-hook' no longer prevent Emacs from shutting down.
+If a function in that hook signals an error in an interactive Emacs,
+the user will be prompted on whether to continue. If the user doesn't
+answer within five seconds, Emacs will continue shutting down anyway.
+
+---
+*** iso-transl is now preloaded.
+This means that keystrokes like 'Alt-[' are defined by default,
+instead of only becoming available after doing (for instance)
+'C-x 8 <letter>'.
+
+*** New user option 'completions-detailed'.
+When non-nil, some commands like 'describe-symbol' show more detailed
+completions with more information in completion prefix and suffix.
+
+---
+*** User option 'completions-format' supports a new value 'one-column'.
+
+---
+*** New user option 'bibtex-unify-case-function'.
+This new option allows the user to customize how case is converted
+when unifying entries.
+
+---
+*** The user option 'bibtex-maintain-sorted-entries' now permits
+user-defined sorting schemes.
+
+++
*** 'format-seconds' can now be used for sub-second times.
The new optional "," parameter has been added, and
@@ -1250,7 +1652,7 @@ buffers. This can be controlled by customizing the variable
---
*** New user option 'compilation-search-all-directories'.
When doing parallel builds, directories and compilation errors may
-arrive in the *compilation* buffer out-of-order. If this variable is
+arrive in the "*compilation*" buffer out-of-order. If this variable is
non-nil (the default), Emacs will now search backwards in the buffer
for any directory the file with errors may be in. If nil, this won't
be done (and this restores how this previously worked).
@@ -1268,6 +1670,11 @@ If 'tab-always-indent' is 'complete', this new user option can be used to
further tweak whether to complete or indent.
---
+*** 'dired-query' now uses 'read-char-from-minibuffer'.
+Using it instead of 'read-char-choice' allows using 'C-x o'
+to switch to the help window displayed after typing 'C-h'.
+
+---
*** 'zap-up-to-char' now uses 'read-char-from-minibuffer'.
This allows navigating through the history of characters that have
been input. This is mostly useful for characters that have complex
@@ -1306,24 +1713,17 @@ the column number format (when 'column-number-mode' is on), and
both modes are on).
+++
+*** New user option 'mode-line-compact'.
+If non-nil, repeating spaces are compressed into a single space. If
+'long', this is only done when the mode line is longer than the
+current window width (in characters).
+
++++
*** New command 'submit-emacs-patch'.
This works like 'report-emacs-bug', but is more geared towards sending
patches to the Emacs issue tracker.
+++
-*** New minor mode 'button-mode'.
-This minor mode does nothing else than install 'button-buffer-map' as
-a minor mode map (which binds the 'TAB' / 'S-TAB' key bindings to navigate
-to buttons), and can be used in any view-mode-like buffer that has
-buttons in it.
-
----
-*** 'icomplete-show-matches-on-no-input' behavior change.
-Previously, choosing a different completion with commands like 'C-.'
-and then hitting 'RET' would choose the default completion. Doing
-this will now choose the completion under point.
-
-+++
*** The user can now customize how "default" values are prompted for.
The new utility function 'format-prompt' has been added which uses the
new 'minibuffer-default-prompt-format' user option to format "default"
@@ -1373,7 +1773,9 @@ horizontally and vertically, respectively.
*** Change in meaning of 'icomplete-show-matches-on-no-input'.
Previously, choosing a different completion with commands like 'C-.'
and then hitting 'RET' would choose the default completion. Doing this
-will now choose the completion under point instead.
+will now choose the completion under point instead. Also when this option
+is nil, completions are not shown when the minibuffer reads a file name
+with initial input as the default directory.
---
*** The width of the buffer-name column in 'list-buffers' is now dynamic.
@@ -1400,6 +1802,18 @@ mouse now pops up a TTY menu by default instead of running the command
'tmm-menubar'. To restore the old behavior, set the user option
'tty-menu-open-use-tmm' to non-nil.
+** text-scale-mode
+
+---
+*** 'text-scale-mode' can now adjust font size of the header line.
+When the new buffer local variable 'text-scale-remap-header-line'
+is non-nil, 'text-scale-adjust' will also scale the text in the header
+line when displaying that buffer.
+
+This is useful for major modes that arrange their display in a tabular
+form below the header line. It is enabled by default in
+'tabulated-list-mode' and its derived modes.
+
** xwidget-webkit mode
*** New xwidget commands.
@@ -1422,6 +1836,19 @@ height of lines or width of chars.
When non-nil, use a new xwidget webkit session after bookmark jump.
Otherwise, it will use 'xwidget-webkit-last-session'.
+** Flymake mode
+
++++
+*** New user options to customize Flymake's mode-line.
+
+The new customization variable 'flymake-mode-line-format' is a mix of
+strings and symbols like 'flymake-mode-line-title' ,
+'flymake-mode-line-exception' and 'flymake-mode-line-counters'. The
+new customization variable 'flymake-mode-line-counter-format' is a mix
+of strings and symbols like 'flymake-mode-line-error-counter',
+'flymake-mode-line-warning-counter' and
+'flymake-mode-line-note-counter'.
+
** Flyspell mode
+++
@@ -1490,6 +1917,9 @@ also keep the type information of their arguments. Use the
** CPerl Mode
---
+*** New face 'perl-heredoc', used for heredoc elements.
+
+---
*** The command 'cperl-set-style' offers the new value "PBP".
This value customizes Emacs to use the style recommended in Damian
Conway's book "Perl Best Practices" for indentation and formatting
@@ -1509,14 +1939,12 @@ used instead.
* New Modes and Packages in Emacs 28.1
** Lisp Data mode
-
The new command 'lisp-data-mode' enables a major mode for buffers
composed of Lisp symbolic expressions that do not form a computer
program. The ".dir-locals.el" file is automatically set to use this
mode, as are other data files produced by Emacs.
** hierarchy.el
-
It's a library to create, query, navigate and display hierarchy structures.
** New themes 'modus-vivendi' and 'modus-operandi'.
@@ -1526,6 +1954,14 @@ using 'M-x customize-themes' or 'load-theme' from your init file.
Consult the Modus Themes Info manual for more information on the user
options they provide.
+** Dictionary mode
+This is a mode for searching a RFC 2229 dictionary server.
+'dictionary' opens a buffer for starting operations.
+'dictionary-search' performs a lookup for a word. It also supports a
+'dictionary-tooltip-mode' which performs a lookup of the word under
+the mouse in 'dictionary-tooltip-dictionary' (which must be customized
+first).
+
* Incompatible Editing Changes in Emacs 28.1
@@ -1559,6 +1995,13 @@ modifies the string's text properties; instead, it uses and returns
a copy of the string. This helps avoid trouble when strings are
shared or constants.
++++
+** Temporary buffers no longer run certain buffer hooks.
+The macros 'with-temp-buffer' and 'with-temp-file' no longer run the
+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.
+
---
** The obsolete function 'thread-alive-p' has been removed.
@@ -1576,6 +2019,7 @@ parameter.
'previous-system-time-locale' have been removed, as they were created
by mistake and were not useful to Lisp code.
+---
** The 'load-dangerous-libraries' variable is now obsolete.
It was used to allow loading Lisp libraries compiled by XEmacs, a
modified version of Emacs which is no longer actively maintained.
@@ -1585,11 +2029,7 @@ This is no longer supported, and setting this variable has no effect.
** The macro 'with-displayed-buffer-window' is now obsolete.
Use macro 'with-current-buffer-window' with action alist entry 'body-function'.
-+++
-** 'byte-compile-file' optional argument LOAD is now obsolete.
-To load the file after byte-compiling, add a call to 'load' from Lisp
-or use 'M-x emacs-lisp-byte-compile-and-load' interactively.
-
+---
** The metamail.el library is now marked obsolete.
---
@@ -1671,14 +2111,43 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el.
'vcursor-toggle-vcursor-map', 'w32-focus-frame', 'w32-select-font',
'wisent-lex-make-token-table'.
+** The 'when' argument of `make-obsolete` and related functions is mandatory.
+The use of those functions without a 'when' argument was marked
+obsolete back in Emacs-23.1. The affected functions are:
+make-obsolete, define-obsolete-function-alias, make-obsolete-variable,
+define-obsolete-variable-alias.
+
* Lisp Changes in Emacs 28.1
-** New variable 'integer-output-format' determines how to print integer values.
-When this variable is bound to the value 't', integers are printed by
-printing functions as characters when an integer represents a character.
-When bound to the number 16, non-negative integers are printed in the
-hexadecimal format.
+** New function 'garbage-collect-maybe' to trigger GC early.
+
+---
+** 'defvar' detects the error of defining a variable currently lexically bound.
+Such mixes are always signs that the outer lexical binding was an
+error and should have used dynamic binding instead.
+
++++
+** New completion function 'affixation-function' to add prefix/suffix.
+It accepts a list of completions and should return a list where
+each element is a list with three elements: a completion,
+a prefix string, and a suffix string.
+
++++
+** 'read-char-from-minibuffer' and 'y-or-n-p' support 'help-form'.
+If you bind 'help-form' to a non-nil value while calling these functions,
+then pressing 'C-h' ('help-char') causes the function to evaluate 'help-form'
+and display the result.
+
+---
+** New variables 'read-char-choice-use-read-key' and 'y-or-n-p-use-read-key'.
+When non-nil, then functions 'read-char-choice' and 'y-or-n-p' (respectively)
+use the function 'read-key' to read a character instead of using the minibuffer.
+
++++
+** 'set-window-configuration' now takes an optional 'dont-set-frame'
+parameter which, when non-nil, instructs the function not to select
+the frame recorded in the configuration.
+++
** 'define-globalized-minor-mode' now takes a ':predicate' parameter.
@@ -1688,42 +2157,54 @@ used in.
+++
** 'truncate-string-ellipsis' now uses '…' by default.
Modes that use 'truncate-string-to-width' with non-nil, non-string
-argument 'ellipsis', will now indicate truncation using '…' when
+argument ELLIPSIS, will now indicate truncation using '…' when
the selected frame can display it, and using "..." otherwise.
+++
-*** New command 'make-directory-autoloads'.
+** New command 'make-directory-autoloads'.
This does the same as the old command 'update-directory-autoloads',
but has different semantics: Instead of passing in the output file via
the dynamically bound 'generated-autoload-file' variable, the output
file is now a explicit parameter.
+++
-*** New function 'string-search'.
+** New function 'string-search'.
This function takes two string parameters and returns the position of
the first instance of the former string in the latter.
+++
-*** New function 'string-replace'.
+** New function 'string-replace'.
This function works along the line of 'replace-regexp-in-string', but
matching on strings instead of regexps, and does not change the global
match state.
+++
-*** New function 'process-lines-ignore-status'.
+** New function 'process-lines-ignore-status'.
This is like 'process-lines', but does not signal an error if the
return status is non-zero. 'process-lines-handling-status' has also
been added, and takes a callback to handle the return status.
---
-*** 'ascii' is now a coding system alias for 'us-ascii'.
+** 'ascii' is now a coding system alias for 'us-ascii'.
+++
-*** New function 'file-backup-file-names'.
+** New function 'file-backup-file-names'.
This function returns the list of file names of all the backup files
of its file argument.
+++
+** New utility function 'directory-empty-p'.
+This predicate tests whether a given file name is an accessible
+directory and whether it contains no other directories or files.
+
++++
+** 'directory-files' now takes an additional COUNT parameter.
+The parameter makes 'directory-files' return COUNT first file names
+from a directory. If MATCH is also given, the function will return
+first COUNT file names that match the expression. The same COUNT
+parameter has been added to 'directory-files-and-attributes'.
+
++++
** The 'count-lines' function now takes an optional parameter to
ignore invisible lines.
@@ -1824,6 +2305,11 @@ In order for the two functions to behave more consistently,
length, and also supports format specifications that include a
truncating precision field, such as "%.2a".
++++
+** 'format-spec' now takes an optional SPLIT parameter.
+If non-nil, 'format-spec' will split the resulting string into a list
+of strings, based on where the format specs (and expansions) were.
+
---
** New function 'color-values-from-color-spec'.
This can be used to parse RGB color specs in several formats and
@@ -1845,13 +2331,29 @@ menu handling.
+++
** 'inhibit-nul-byte-detection' is renamed to 'inhibit-null-byte-detection'.
+** Byte compiler
+
+++
-** New byte-compiler check for missing dynamic variable declarations.
+*** New byte-compiler check for missing dynamic variable declarations.
It is meant as an (experimental) aid for converting Emacs Lisp code
to lexical binding, where dynamic (special) variables bound in one
file can affect code in another. For details, see the manual section
"(Elisp) Converting to Lexical Binding".
++++
+*** 'byte-recompile-directory' can now compile symlinked ".el" files.
+This is achieved by giving a non-nil FOLLOW-SYMLINKS parameter.
+
+*** The byte-compiler now warns about too wide documentation strings.
+By default, it will warn if a documentation string is wider than the
+largest of 80 characters or 'fill-column'. This is controlled by the
+new user option 'byte-compile-docstring-max-column'.
+
++++
+*** 'byte-compile-file' optional argument LOAD is now obsolete.
+To load the file after byte-compiling, add a call to 'load' from Lisp
+or use 'M-x emacs-lisp-byte-compile-and-load' interactively.
+
---
** 'unload-feature' now also tries to undo additions to buffer-local hooks.
@@ -1860,6 +2362,53 @@ file can affect code in another. For details, see the manual section
'replace-regexp-in-string', 'catch', 'throw', 'error', 'signal'
and 'play-sound-file'.
++++
+** New variable 'print-integers-as-characters' modifies integer printing.
+If this variable is non-nil, character syntax is used for printing
+numbers when this makes sense, such as '?A' for 65.
+
++++
+** New error 'remote-file-error', a subcategory of 'file-error'.
+It is signaled if a remote file operation fails due to internal
+reasons, and could block Emacs. It does not replace 'file-error'
+signals for the usual cases. Timers, process filters and process
+functions, which run remote file operations, shall protect themselves
+against this error.
+
+If such an error occurs, please report this as bug via 'M-x report-emacs-bug'.
+Until it is solved you could ignore such errors by performing
+
+ (setq debug-ignored-errors (cons 'remote-file-error debug-ignored-errors))
+
++++
+** The error 'ftp-error' belongs also to category 'remote-file-error'.
+
++++
+** Buffers can now be created with certain hooks disabled.
+The functions 'get-buffer-create' and 'generate-new-buffer' accept a
+new optional argument INHIBIT-BUFFER-HOOKS. If non-nil, the new
+buffer does not run the hooks 'kill-buffer-hook',
+'kill-buffer-query-functions', and 'buffer-list-update-hook'. This
+avoids slowing down internal or temporary buffers that are never
+presented to users or passed on to other applications.
+
+---
+** 'start-process-shell-command' and 'start-file-process-shell-command'
+do not support the old calling conventions any longer.
+
+** Functions operating on local file names now check that the file names
+don't contain any NUL bytes. This avoids subtle bugs caused by
+silently using only the part of the file name until the first NUL byte.
+
+** New coding-systems for EBCDIC variants.
+New coding-systems 'ibm256', 'ibm273', 'ibm274', 'ibm277', 'ibm278',
+'ibm280', 'ibm281', 'ibm284', 'ibm285', 'ibm290', 'ibm297'. These are
+variants of the EBCDIC encoding tailored to some European and Japanese
+locales. They are also available as aliases 'ebcdic-cp-*' (e.g.,
+'ebcdic-cp-fi' for the Finnish variant 'ibm278'), and 'cp2xx' (e.g.,
+'cp278' for 'ibm278'). There are also new charsets 'ibm2xx' to
+support these coding-systems.
+
* Changes in Emacs 28.1 on Non-Free Operating Systems
@@ -1904,6 +2453,11 @@ image API via 'M-x report-emacs-bug'.
---
** The user option 'make-pointer-invisible' is now honored on macOS.
+--
+** On macOS, 's-<left>' and 's-<right>' are now bound to
+'move-beginning-of-line' and 'move-end-of-line' respectively. The commands
+to select previous/next frame are still bound to 's-~' and 's-`'.
+
----------------------------------------------------------------------
This file is part of GNU Emacs.
diff --git a/etc/NEWS.1-17 b/etc/NEWS.1-17
index c4ff83bb706..42a3ced1c3a 100644
--- a/etc/NEWS.1-17
+++ b/etc/NEWS.1-17
@@ -1,6 +1,6 @@
GNU Emacs NEWS -- history of user-visible changes. 26-Mar-1986
-Copyright (C) 1985-1986, 2006-2020 Free Software Foundation, Inc.
+Copyright (C) 1985-1986, 2006-2021 Free Software Foundation, Inc.
See the end of the file for license conditions.
diff --git a/etc/NEWS.18 b/etc/NEWS.18
index e044f663c45..b11a189c30f 100644
--- a/etc/NEWS.18
+++ b/etc/NEWS.18
@@ -1,6 +1,6 @@
GNU Emacs NEWS -- history of user-visible changes. 17-Aug-1988
-Copyright (C) 1988, 2006-2020 Free Software Foundation, Inc.
+Copyright (C) 1988, 2006-2021 Free Software Foundation, Inc.
See the end of the file for license conditions.
diff --git a/etc/NEWS.19 b/etc/NEWS.19
index d919608d270..f2cef62971b 100644
--- a/etc/NEWS.19
+++ b/etc/NEWS.19
@@ -1,6 +1,6 @@
GNU Emacs NEWS -- history of user-visible changes. 1992.
-Copyright (C) 1993-1995, 2001, 2006-2020 Free Software Foundation, Inc.
+Copyright (C) 1993-1995, 2001, 2006-2021 Free Software Foundation, Inc.
See the end of the file for license conditions.
@@ -2824,6 +2824,8 @@ the text of the region according to the new value.
the fill-column has been exceeded; the function can determine on its
own whether filling (or justification) is necessary.
+**** New helper function 'indent-line-to'
+
** Processes
*** process-tty-name is a new function that returns the name of the
diff --git a/etc/NEWS.20 b/etc/NEWS.20
index 69ce24a301a..efd0e5d5c26 100644
--- a/etc/NEWS.20
+++ b/etc/NEWS.20
@@ -1,6 +1,6 @@
GNU Emacs NEWS -- history of user-visible changes. 2006-05-31
-Copyright (C) 1999-2001, 2006-2020 Free Software Foundation, Inc.
+Copyright (C) 1999-2001, 2006-2021 Free Software Foundation, Inc.
See the end of the file for license conditions.
diff --git a/etc/NEWS.21 b/etc/NEWS.21
index 1228984fe8c..b9d59594a4f 100644
--- a/etc/NEWS.21
+++ b/etc/NEWS.21
@@ -1,6 +1,6 @@
GNU Emacs NEWS -- history of user-visible changes. 2006-05-31
-Copyright (C) 2000-2020 Free Software Foundation, Inc.
+Copyright (C) 2000-2021 Free Software Foundation, Inc.
See the end of the file for license conditions.
diff --git a/etc/NEWS.22 b/etc/NEWS.22
index 4df1792fbc7..1f03dc3a134 100644
--- a/etc/NEWS.22
+++ b/etc/NEWS.22
@@ -1,6 +1,6 @@
GNU Emacs NEWS -- history of user-visible changes.
-Copyright (C) 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 2001-2021 Free Software Foundation, Inc.
See the end of the file for license conditions.
Please send Emacs bug reports to bug-gnu-emacs@gnu.org.
diff --git a/etc/NEWS.23 b/etc/NEWS.23
index 331ed281a37..8611ba53d2e 100644
--- a/etc/NEWS.23
+++ b/etc/NEWS.23
@@ -1,6 +1,6 @@
GNU Emacs NEWS -- history of user-visible changes.
-Copyright (C) 2007-2020 Free Software Foundation, Inc.
+Copyright (C) 2007-2021 Free Software Foundation, Inc.
See the end of the file for license conditions.
Please send Emacs bug reports to bug-gnu-emacs@gnu.org.
diff --git a/etc/NEWS.24 b/etc/NEWS.24
index 60c2b4dfc66..acf6219f74f 100644
--- a/etc/NEWS.24
+++ b/etc/NEWS.24
@@ -1,6 +1,6 @@
GNU Emacs NEWS -- history of user-visible changes.
-Copyright (C) 2010-2020 Free Software Foundation, Inc.
+Copyright (C) 2010-2021 Free Software Foundation, Inc.
See the end of the file for license conditions.
Please send Emacs bug reports to bug-gnu-emacs@gnu.org.
diff --git a/etc/NEWS.25 b/etc/NEWS.25
index 8c04d940907..c533f277091 100644
--- a/etc/NEWS.25
+++ b/etc/NEWS.25
@@ -1,6 +1,6 @@
GNU Emacs NEWS -- history of user-visible changes.
-Copyright (C) 2014-2020 Free Software Foundation, Inc.
+Copyright (C) 2014-2021 Free Software Foundation, Inc.
See the end of the file for license conditions.
Please send Emacs bug reports to bug-gnu-emacs@gnu.org.
diff --git a/etc/NEWS.26 b/etc/NEWS.26
index c6306a6d45c..05e86726251 100644
--- a/etc/NEWS.26
+++ b/etc/NEWS.26
@@ -1,6 +1,6 @@
GNU Emacs NEWS -- history of user-visible changes.
-Copyright (C) 2016-2020 Free Software Foundation, Inc.
+Copyright (C) 2016-2021 Free Software Foundation, Inc.
See the end of the file for license conditions.
Please send Emacs bug reports to 'bug-gnu-emacs@gnu.org'.
diff --git a/etc/NEWS.27 b/etc/NEWS.27
index f0b5dd088af..9232a308c57 100644
--- a/etc/NEWS.27
+++ b/etc/NEWS.27
@@ -1,6 +1,6 @@
GNU Emacs NEWS -- history of user-visible changes.
-Copyright (C) 2017-2020 Free Software Foundation, Inc.
+Copyright (C) 2017-2021 Free Software Foundation, Inc.
See the end of the file for license conditions.
Please send Emacs bug reports to 'bug-gnu-emacs@gnu.org'.
@@ -35,10 +35,10 @@ This is a bug-fix release with no new features.
* Lisp Changes in Emacs 27.2
-*** The behavior of the user option 'resize-mini-frames' has changed.
-If set to non-nil, resize the mini frame using the new function
-'fit-mini-frame-to-buffer' which won't skip leading or trailing empty
-lines of the buffer.
+** The behavior of the user option 'resize-mini-frames' has changed.
+If set to a non-nil value which isn't a function, resize the mini
+frame using the new function 'fit-mini-frame-to-buffer' which won't
+skip leading or trailing empty lines of the buffer.
* Editing Changes in Emacs 27.2
@@ -48,7 +48,7 @@ lines of the buffer.
** Tramp
-*** The user option 'tramp-completion-reread-directory-timeout' is made obsolete.
+*** The user option 'tramp-completion-reread-directory-timeout' is now obsolete.
* New Modes and Packages in Emacs 27.2
@@ -62,6 +62,13 @@ lines of the buffer.
* Changes in Emacs 27.2 on Non-Free Operating Systems
+** Emacs now ignores modifier keys when IME input is used.
+By default, pressing Ctrl, Shift, and Alt keys while using IME input
+will no longer apply the modifiers to the produced characters, as
+there are IMEs which use keys with modifiers to input some
+characters. Customize the variable 'w32-ignore-modifiers-on-IME-input'
+to nil to get back the old behavior.
+
* Installation Changes in Emacs 27.1
diff --git a/etc/NEXTSTEP b/etc/NEXTSTEP
index 5ac3b6b1741..5dd2e646ed4 100644
--- a/etc/NEXTSTEP
+++ b/etc/NEXTSTEP
@@ -1,4 +1,4 @@
-Copyright (C) 2008-2020 Free Software Foundation, Inc.
+Copyright (C) 2008-2021 Free Software Foundation, Inc.
See the end of the file for license conditions.
This file contains information about GNU Emacs on "Nextstep" platforms.
diff --git a/etc/NXML-NEWS b/etc/NXML-NEWS
index 5df9790c2f4..cdce6e72bab 100644
--- a/etc/NXML-NEWS
+++ b/etc/NXML-NEWS
@@ -1,4 +1,4 @@
-Copyright (C) 2007-2020 Free Software Foundation, Inc.
+Copyright (C) 2007-2021 Free Software Foundation, Inc.
See the end of the file for license conditions.
diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index ce08496b20b..2cae8b92ace 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -5,11 +5,551 @@ ORG NEWS -- history of user-visible changes. -*- mode: org; coding: utf-8 -*-
#+LINK: doc https://orgmode.org/worg/doc.html#%s
#+LINK: git https://code.orgmode.org/bzg/org-mode/commit/%s
-Copyright (C) 2012-2020 Free Software Foundation, Inc.
+Copyright (C) 2012-2021 Free Software Foundation, Inc.
See the end of the file for license conditions.
Please send Org bug reports to mailto:emacs-orgmode@gnu.org.
+* Version 9.4
+** Incompatible changes
+*** Possibly broken internal file links: please check and fix
+
+A bug has been affecting internal links to headlines, like
+
+: [[*Headline][A link to a headline]]
+
+Storing a link to a headline may have been broken in your setup and
+those links may appear as
+
+: [[*TODO Headline][A link to a headline]]
+
+Following the link above will result in an error: the TODO keyword
+should not be part of internal file links.
+
+You can use the following command to fix links in an Org buffer:
+
+#+begin_src emacs-lisp
+(defun org-fix-links ()
+ "Fix ill-formatted internal links.
+E.g. replace [[*TODO Headline][headline]] by [[*Headline][headline]].
+Go through the buffer and ask for the replacement."
+ (interactive)
+ (visible-mode 1)
+ (save-excursion
+ (goto-char (point-min))
+ (let ((regexp (format "\\[\\[\\*%s\\s-+"
+ (regexp-opt org-todo-keywords-1 t))))
+ (while (re-search-forward regexp nil t)
+ (when (and (save-excursion
+ (goto-char (match-beginning 0))
+ (looking-at-p org-link-bracket-re))
+ (y-or-n-p "Fix link (remove TODO keyword)? "))
+ (replace-match "[[*")))))
+ (visible-mode -1))
+#+end_src
+
+*** Calling conventions changes when opening or exporting custom links
+
+This changes affects export back-ends, and libraries providing new
+link types.
+
+Function used in ~:follow~ link parameter is required to accept a
+second argument. Likewise, function used in ~:export~ parameter needs
+to accept a fourth argument. See ~org-link-set-parameters~ for
+details.
+
+Eventually, the function ~org-export-custom-protocol-maybe~ is now
+called with a fourth argument. Even though the 3-arguments definition
+is still supported, at least for now, we encourage back-end developers
+to switch to the new signature.
+
+*** Python session return values must be top-level expression statements
+
+Python blocks with ~:session :results value~ header arguments now only
+return a value if the last line is a top-level expression statement.
+Also, when a None value is returned, "None" will be printed under
+"#+RESULTS:", as it already did with ~:results value~ for non-session
+blocks.
+
+*** In HTML export, change on how outline-container-* is set
+
+When the headline has a =CUSTOM_ID=, use this custom id to build the
+div id. For example, if you have =:CUSTOM_ID: my-headline= then the
+resulting <div> will be ~<div id="outline-container-my-headline">~.
+
+You may want to check whether your HTML files are rendered differently
+after this change.
+
+*** New keybinding =<C-c C-TAB>= for ~org-force-cycle-archived~
+
+~org-force-cycle-archived~ used to be associated with =<C-TAB>= but
+this keybinding is used in Emacs for navigating tabs in Emacs. The
+new keybinding is =<C-c C-TAB>=.
+
+** New default settings for some options
+
+These options now default to =t=:
+
+- ~org-loop-over-headlines-in-active-region~
+- ~org-fontify-done-headline~
+- ~org-src-tab-acts-natively~
+
+You may want to read the docstrings of these options to understand the
+consequences of this change.
+
+Also, ~org-startup-folded~ now defaults to ~showeverything~.
+
+** New features
+
+*** Looping agenda commands over headlines
+
+~org-agenda-loop-over-headlines-in-active-region~ allows you to loop
+agenda commands over the active region.
+
+When set to =t= (the default), loop over all headlines. When set to
+='start-level=, loop over headlines with the same level as the first
+headline in the region. When set to a string, loop over lines
+matching this regular expression.
+
+*** New minor mode ~org-table-header-line-mode~
+
+Turn on the display of the first data row of the table at point in the
+window header line when this first row is not visible anymore in the
+buffer.
+
+You can activate this minor mode by default by setting the option
+~org-table-header-line-p~ to =t=. You can also change the face for
+the header line by customizing the ~org-table-header~ face.
+
+*** New minor mode ~org-list-checkbox-radio-mode~
+
+When this minor mode is on, checkboxes behave as radio buttons: if a
+checkbox is turned on, other checkboxes at the same level are turned
+off.
+
+If you want to occasionally toggle a checkbox as a radio button
+without turning this minor mode on, you can use =<C-c C-x C-r>= to
+call ~org-toggle-radio-button~.
+
+You can also add =#+ATTR_ORG: :radio t= right before the list to tell
+Org to use radio buttons for this list only.
+
+*** New allowed value for ~org-adapt-indentation~
+
+~org-adapt-indentation~ now accepts a new value, ='headline-data=.
+
+When set to this value, Org will only adapt indentation of headline
+data lines, such as planning/clock lines and property/logbook drawers.
+Also, with this setting, =org-indent-mode= will keep these data lines
+correctly aligned with the headline above.
+
+*** Numeric priorities are now allowed (up to 65)
+
+You can now set ~org-priority-highest/lowest/default~ to integers to
+use numeric priorities globally or set, for example
+
+#+PRIORITIES: 1 10 5
+
+to define a buffer-local range and default for priorities. Priority
+commands should work as usual. You cannot use numbers superior to 64
+for numeric priorities, as it would clash with priorities like [#A]
+where the "A" is internally converted to its numeric value of 65.
+
+*** Property drawers allowed before first headline
+
+Property drawers are now allowed before the first headline.
+
+Org mode is moving more towards making things before the first
+headline behave just as if it was at outline level 0. Inheritance for
+properties will work also for this level. In other words: defining
+things in a property drawer before the first headline will make them
+"inheritable" for all headlines.
+
+*** Refinement in window behavior on exiting Org source buffer
+
+After editing a source block, Org will restore the window layout when
+~org-src-window-setup~ is set to a value that modifies the layout.
+
+*** Display remote inline images
+
+Org now knows how to display remote images inline.
+
+Whether the images are actually displayed is controlled by the new
+option ~org-display-remote-inline-images~.
+
+*** New option to resolve open clock at a provided time
+
+~org-resolve-clocks~ now has a `t' option, which works just like the
+`k' option, but the user specifies a time of day, not a number of
+minutes.
+
+*** New step value =semimonth= accepted for clock tables
+
+*** Allow text rescaling in column view
+
+You can now use =C-x C-+= in column view: the columns face size will
+increase or decrease, together with the column header size.
+
+*** New startup option =#+startup: num=
+
+When this startup option is set, display headings as numerated.
+
+Use =#+startup: nonum= to turn this off.
+
+*** New tool for custom links
+
+Org provides a new tool ~org-link-open-as-file~, useful when defining
+new link types similar to "file"-type links. See docstring for
+details.
+
+*** New optional numeric argument for ~org-return~
+
+In situations where ~org-return~ calls ~newline~, multiple newlines
+can now be inserted with this prefix argument.
+
+*** New source code block header argument =:file-mode=
+
+Source code block header argument =:file-mode= can set file
+permissions if =:file= argument is provided.
+
+*** =RET= and =C-j= now obey ~electric-indent-mode~
+
+Since Emacs 24.4, ~electric-indent-mode~ is enabled by default. In
+most major modes, this causes =RET= to reindent the current line and
+indent the new line, and =C-j= to insert a newline without indenting.
+
+Org mode now obeys this minor mode: when ~electric-indent-mode~ is
+enabled, and point is neither in a table nor on a timestamp or a link:
+
+- =RET= (bound to ~org-return~) reindents the current line and indents
+ the new line;
+- =C-j= (bound to the new command ~org-return-and-maybe-indent~)
+ merely inserts a newline.
+
+To get the previous behaviour back, disable ~electric-indent-mode~
+explicitly:
+
+#+begin_src emacs-lisp
+(add-hook 'org-mode-hook (lambda () (electric-indent-local-mode -1)))
+#+end_src
+
+Alternatively, if you wish to keep =RET= as the "smart-return" key,
+but dislike Org's default indentation of sections, you may prefer to
+customize ~org-adapt-indentation~ to either =nil= or ='headline-data=.
+
+*** =ob-C.el= allows the inclusion of non-system header files
+
+In C and C++ blocks, ~:includes~ arguments that do not start with a
+~<~ character will now be formatted as double-quoted ~#include~
+statements.
+
+*** =ob-clojure.el= supports inf-clojure.el and ClojureScript evaluation
+
+You can now set ~(setq org-babel-clojure-backend 'inf-clojure)~ and
+evaluate Clojure source blocks using [[https://github.com/clojure-emacs/inf-clojure][inf-clojure]]. With a header
+argument like =:alias "alias"= the Clojure REPL will boot with
+=clojure -Aalias=. Otherwise Clojure will boot with =lein=, =boot= or
+=tools.deps=, depending on whether the current directory contains a
+=project.clj=, =build.boot= or =deps.edn=, falling back on
+~inf-clojure-generic-cmd~ in case no such file is present.
+
+Also, when using [[https://github.com/clojure-emacs/cider][cider]], you can now use =#+begin_src clojurescript= to
+execute ClojureScript code from Org files. Note that this works only
+if your Org file is associated with a cider session that knows how to
+run ClojureScript code. A bare =lein repl= session outside of a
+directory configured for ClojureScript will /not/ work.
+
+*** =ob-java.el= supports Java command line arguments
+
+Babel Java blocks recognize header argument =:cmdargs= and pass its
+value in call to =java=.
+
+*** =ob-screen.el= now accepts =:screenrc= header argument
+
+Screen blocks now recognize the =:screenrc= header argument and pass
+its value to the screen command via the "-c" option. The default
+remains =/dev/null= (i.e. a clean screen session)
+
+*** =ob-plantuml=: now supports using PlantUML executable to generate diagrams
+
+Set =org-plantuml-exec-mode= to ='plantuml= in order to use the
+executable instead of JAR. When using an executable it is also
+possible to configure executable location as well as arguments via:
+=org-plantuml-executable-path= and =org-plantuml-executable-args=.
+
+** New commands
+*** ~org-table-header-line-mode~
+
+Turn on a minor mode to display the first data row of the table at
+point in the header-line when the beginning of the table is invisible.
+
+*** ~org-agenda-ctrl-c-ctrl-c~
+
+Hitting =<C-c C-c>= in an agenda view now calls ~org-agenda-set-tags~.
+
+*** ~org-hide-entry~
+
+This command is the counterpart of ~org-show-entry~.
+
+*** ~org-columns-toggle-or-columns-quit~
+
+=<C-c C-c>= bound to ~org-columns-toggle-or-columns-quit~ replaces the
+recent ~org-columns-set-tags-or-toggle~. Tag setting is still
+possible via column view value edit or with =<C-c C-q>=.
+
+*** ~org-datetree-find-month-create~
+
+Find or create a month entry for a date.
+
+** New options and settings
+*** New option ~org-html-prefer-user-labels~
+
+When non-nil, use =NAME= affiliated keyword, or raw target values, to
+generate anchor's ID. Otherwise, consistently use internal naming
+scheme.
+
+=CUSTOM_ID= values are still always used, when available.
+*** New option for using tabs in ~org-agenda-window-setup~
+
+Choosing ~other-tab~ for ~org-agenda-window-setup~ will open the
+agenda view in a new tab. This will work with versions of Emacs since
+27.1 when ~tab-bar-mode~ was introduced.
+
+*** New option ~org-table-header-line-p~
+
+Setting this option to =t= will activate ~org-table-header-line-mode~
+in org-mode buffers.
+
+*** New option ~org-startup-numerated~
+
+When this option is =t=, Org files will start using ~(org-num-mode 1)~
+and headings will be visually numerated.
+
+You can turn this on/off on a per-file basis with =#+startup: num= or
+=#+startup: nonum=.
+
+*** New option ~org-clock-auto-clockout-timer~
+
+When this option is set to a number and the user configuration
+contains =(org-clock-auto-clockout-insinuate)=, Org will clock out the
+currently clocked in task after that number of seconds of idle time.
+
+This is useful when you often forget to clock out before being idle
+and don't want to have to manually set the clocking time to take into
+account.
+
+*** New option to group captured datetime entries by month
+
+A new `:tree-type month' option was added to org-capture-templates to
+group new datetime entries by month.
+
+*** New option to show source buffers using "plain" display-buffer
+
+There is a new option ~plain~ to ~org-src-window-setup~ to show source
+buffers using ~display-buffer~. This allows users to control how
+source buffers are displayed by modifying ~display-buffer-alist~ or
+~display-buffer-base-action~.
+
+*** New option ~org-archive-subtree-save-file-p~
+
+Archiving a subtree used to always save the target archive buffer.
+Commit [[https://code.orgmode.org/bzg/org-mode/commit/b186d1d7][b186d1d7]] changed this behavior by always not saving the target
+buffer, because batch archiving from agenda could take too much time.
+
+This new option ~org-archive-subtree-save-file-p~ defaults to the
+value =from-org= so that archiving a subtree will save the target
+buffer when done from an org-mode buffer, but not from the agenda.
+You can also set this option to =t= or to =from-agenda=.
+
+*** New option ~org-show-notification-timeout~
+
+This option will add a timeout to notifications.
+
+*** New option ~org-latex-to-html-convert-command~
+
+This new option allows you to convert a LaTeX fragment directly into
+HTML.
+
+*** New option ~org-babel-shell-results-defaults-to-output~
+
+By default, source code blocks are executed in "functional mode": it
+means that the results of executing them are the value of their last
+statement (see [[https://orgmode.org/manual/Results-of-Evaluation.html][the documentation]].)
+
+The value of a shell script's execution is its exit code. But most
+users expect the results of executing a shell script to be its output,
+not its exit code.
+
+So we introduced this option, that you can set to =nil= if you want
+to stick using ~:results value~ as the implicit header.
+
+In all Babel libraries, the absence of a ~:results~ header should
+produce the same result than setting ~:results value~, unless there is
+an option to explicitly create an exception.
+
+See [[https://orgmode.org/list/CA+A2iZaziAfMeGpBqL6qGrzrWEVvLvC0DUw++T4gCF3NGuW-DQ@mail.gmail.com/][this thread]] for more context.
+
+*** New option in ~org-attach-store-link-p~
+
+~org-attach-store-link-p~ has a new option to store a file link to the
+attachment.
+*** New option ~org-fontify-todo-headline~
+
+This feature is the same as ~org-fontify-done-headline~, but for TODO
+headlines instead. This allows you to distinguish TODO headlines from
+normal headlines. The face can be customized via ~org-headline-todo~.
+
+*** New default value for ~org-file-apps~
+
+The new value uses Emacs as the application for opening directory.
+
+*** New hook ~org-agenda-filter-hook~
+
+Functions in this hook are run after ~org-agenda-filter~ is called.
+
+** Removed or renamed functions and variables
+*** Deprecated ~org-flag-drawer~ function
+
+Use ~org-hide-drawer-toggle~ instead.
+
+*** Deprecated ~org-hide-block-toggle-maybe~ function
+
+Use ~org-hide-block-toggle~ instead.
+
+*** Deprecated ~org-hide-block-toggle-all~ function
+
+This function was not used in the code base, and has no clear use
+either. It has been marked for future removal. Please contact the
+mailing list if you use this function.
+
+*** Deprecated ~org-return-indent~ function
+
+In Elisp code, use ~(org-return t)~ instead. Interactively, =C-j= is
+now bound to ~org-return-and-maybe-indent~, which indents the new line
+when ~electric-indent-mode~ is disabled.
+
+*** Removed ~org-maybe-keyword-time-regexp~
+
+The variable was not used in the code base.
+
+*** Removed ~org-export-special-keywords~
+
+The variable was not used in the code base.
+
+*** Renamed ~org-at-property-block-p~
+
+The new name is ~org-at-property-drawer-p~, which is less confusing.
+
+*** Renamed ~org-columns-set-tags-or-toggle~
+
+See [[*~org-columns-toggle-or-columns-quit~]].
+
+*** Renamed priority options
+
+From ~org-lowest-priority~ to ~org-priority-lowest~.
+From ~org-default-priority~ to ~org-priority-default~.
+From ~org-highest-priority~ to ~org-priority-highest~.
+From ~org-enable-priority-commands~ to ~org-priority-enable-commands~.
+From ~org-show-priority~ to ~org-priority-show~.
+
+** Miscellaneous
+*** =ob-screen.el= now respects screen =:session= name
+
+Screen babel session are now named based on the =:session= header
+argument (defaults to ~default~).
+
+Previously all session names had ~org-babel-session-~ prepended.
+
+*** Forward/backward paragraph functions in line with the rest of Emacs
+
+~org-forward-paragraph~ and ~org-backward-paragraph~, bound to
+~<C-UP>~ and ~<C-DOWN>~ functions mimic more closely behaviour of
+~forward-paragraph~ and ~backward-paragraph~ functions when
+available.
+
+They also accept an optional argument for multiple calls.
+
+See their docstring for details.
+*** ~org-table-to-lisp~ no longer checks if point is at a table
+
+The caller is now responsible for the check. It can use, e.g.,
+~org-at-table-p~.
+
+The function is also much more efficient than it used to be, even on
+very large tables.
+
+*** New function ~org-collect-keywords~
+*** Drawers' folding use an API similar to block's
+
+Tooling for folding drawers interactively or programmatically is now
+on par with block folding. In particular, ~org-hide-drawer-toggle~,
+a new function, is the central place for drawer folding.
+
+*** Duration can be read and written in compact form
+
+~org-duration-to-minutes~ understands =1d3h5min= as a duration,
+whereas ~org-duration-from-minutes~ can output this compact form if
+the duration format contains the symbol ~compact~.
+
+*** C-n, C-p, SPC and DEL in agenda commands dispatch window
+
+You can now use =<C-n>=, =<C-p>=, =<SPC>= and =<DEL>= key to scroll up
+and down the agenda and attach dispatch window.
+
+*** =<C-c C-c>= in agenda calls ~org-agenda-set-tags~
+
+Both =<C-c C-q>= and =<C-c C-c>= set the tags of the headline in the
+Org buffer. Both keybindings are now available from the agenda too.
+
+*** Allow to use an empty HTML extension
+
+Using =(setq org-html-extension "")= or setting the HTML extension in
+any fashion will produce the expected output, with no trailing period
+to the resulting HTML file.
+
+*** Handle repeated tasks with =.+= type and hours step
+
+A task using a =.+= repeater and hours step is repeated starting from
+now. E.g.,
+
+#+begin_example
+,,** TODO Wash my hands
+ DEADLINE: <2019-04-05 08:00 Sun .+1h>
+ Marking this DONE shifts the date to exactly one hour from now.
+#+end_example
+
+*** The format of equation reference in HTML export can now be specified
+
+By default, HTML (via MathJax) and LaTeX export equation references
+using different commands. LaTeX must use ~\ref{%s}~ because it is used
+for all labels; however, HTML (via MathJax) uses ~\eqref{%s}~ for
+equations producing inconsistent output. New option
+~org-html-equation-reference-format~ sets the command used in HTML
+export.
+
+*** =ob-haskell.el= supports compilation with =:compile= header argument
+
+By default, Haskell blocks are interpreted. By adding =:compile yes=
+to a Haskell source block, it will be compiled, executed and the
+results will be displayed.
+
+*** Support for ~org-edit-special~ with LaTeX fragments
+
+Calling ~org-edit-special~ on an inline LaTeX fragment calls a new
+function, ~org-edit-latex-fragment~. This functions in a comparable
+manner to editing inline source blocks, bringing up a minibuffer set
+to LaTeX mode. The math-mode deliminators are read only.
+
+*** ~org-capture-current-plist~ is now accessible during ~org-capture-mode-hook~
+*** New =org-refile.el= file
+
+Org refile variables and functions have been moved to a new file.
+
+*** The end of a 7 years old bug
+
+This bug [[https://lists.gnu.org/archive/html/emacs-orgmode/2013-08/msg00072.html][originally reported]] by Matt Lundin and investigated by Andrew
+Hyatt has been fixed. Thanks to both of them.
+
* Version 9.3
** Incompatible changes
@@ -19,15 +559,11 @@ Org used to percent-encode sensitive characters in the URI part of the
bracket links.
Now, escaping mechanism uses the usual backslash character, according
-to the following rules, applied in order:
+to the following rules:
-1. All consecutive =\= characters at the end of the link must be
- escaped;
-2. Any =]= character at the very end of the link must be escaped;
-3. All consecutive =\= characters preceding =][= or =]]= patterns must
- be escaped;
-4. Any =]= character followed by either =[= or =]= must be escaped;
-5. Others =]= and =\= characters need not be escaped.
+1. All =[= and =]= characters in the URI must be escaped;
+2. Every =\= character preceding either =[= or =]= must be escaped;
+3. Every =\= character at the end of the URI must be escaped.
When in doubt, use the function ~org-link-escape~ in order to turn
a link string into its properly escaped form.
@@ -141,7 +677,7 @@ Export ignore done tasks with a deadline when
Likewise, scheduled done tasks are also ignored when
~org-icalendar-use-scheduled~ contains the same symbol.
-*** Add split-window-right option for src block edit window placement
+*** Add ~split-window-right~ option for src block edit window placement
Given the increasing popularity of wide screen monitors, splitting
horizontally may make more sense than splitting vertically. An
@@ -364,7 +900,6 @@ the headline to use for making the table of contents.
,* Another section
,#+TOC: headlines 1 :target "#TargetSection"
#+end_example
-
** New functions
*** ~org-dynamic-block-insert-dblock~
@@ -474,6 +1009,16 @@ I.e. treat the whole file as if it was a subtree.
*** Respect narrowing when agenda command is restricted to buffer
+*** ~org-table-insert-column~ inserts the column at point position
+
+Before, the new column was inserted to the right of the column at
+point position.
+
+*** Table column deletion now consistent with row deletion
+
+Point stays in the column at deletion, except when deleting the
+rightmost column.
+
* Version 9.2
** Incompatible changes
*** Removal of OrgStruct mode mode and radio lists
@@ -484,7 +1029,7 @@ and ~org-list-radio-lists-templates~) are removed from the code base.
Note that only radio /lists/ have been removed, not radio tables.
If you want to manipulate lists like in Org in other modes, we suggest
-to use orgalist.el, which you can install from GNU ELPA.
+to use =orgalist.el=, which you can install from GNU ELPA.
If you want to use Org folding outside of Org buffers, you can have a
look at the outshine package in the MELPA repository.
@@ -1276,9 +1821,9 @@ removed from Gnus circa September 2010.
*** ~org-agenda-repeating-timestamp-show-all~ is removed.
-For an equivalent to a ~nil~ value, set
+For an equivalent to a =nil= value, set
~org-agenda-show-future-repeats~ to nil and
-~org-agenda-prefer-last-repeat~ to ~t~.
+~org-agenda-prefer-last-repeat~ to =t=.
*** ~org-gnus-nnimap-query-article-no-from-file~ is removed.
@@ -1296,7 +1841,7 @@ equivalent to the removed format string.
*** ~org-enable-table-editor~ is removed.
-Setting it to a ~nil~ value broke some other features (e.g., speed
+Setting it to a =nil= value broke some other features (e.g., speed
keys).
*** ~org-export-use-babel~ cannot be set to ~inline-only~
@@ -1377,16 +1922,20 @@ is now obsolete.
Now ~=...=~ markup uses ~@samp{}~ instead of ~@verb{}~. You can use
~@verb{}~ again by customizing the variable.
+
*** Texinfo exports example blocks as ~@example~
*** Texinfo exports inline source blocks as ~@code{}~
*** Texinfo default table markup is ~@asis~
+
It used to be ~@samp~ but ~@asis~ is neutral and, therefore, more
suitable as a default value.
+
*** Texinfo default process includes ~--no-split~ option
*** New entities : ~\dollar~ and ~\USD~
*** Support for date style URLs in =org-protocol://open-source=
- URLs like =https://cool-blog.com/2017/05/20/cool-post/= are
- covered by rewrite rules.
+
+URLs like =https://cool-blog.com/2017/05/20/cool-post/= are covered by
+rewrite rules.
*** Add (C) =COMMENT= support to ~org-structure-template-alist~
@@ -1476,7 +2025,7 @@ Moreover, ~:export-block~ keyword used in ~org-export-define-backend~ and
~org-export-define-derived-backend~ is no longer used and needs to be
removed.
-*** Footnotes
+*** Footnotes changes
**** [1]-like constructs are not valid footnotes
@@ -2216,7 +2765,7 @@ without changing the headline.
*** Hierarchies of tags
-The functionality of nesting tags in hierarchies is added to org-mode.
+The functionality of nesting tags in hierarchies is added to Org mode.
This is the generalization of what was previously called "Tag groups"
in the manual. That term is now changed to "Tag hierarchy".
@@ -4105,7 +4654,7 @@ See https://orgmode.org/elpa/
You can temporarily activate continuous clocking with =C-u C-u
C-u M-x= [[doc::org-clock-in][org-clock-in]] =RET= (three universal prefix arguments)
- and =C-u C-u M-x= [[org-clock-in-last][org-clock-in-last]] =RET= (two universal prefix
+ and =C-u C-u M-x= [[doc::org-clock-in-last][org-clock-in-last]] =RET= (two universal prefix
arguments).
@@ -4581,7 +5130,7 @@ that Calc formulas can operate on them.
The new system has a technically cleaner implementation and more
possibilities for capturing different types of data. See
- [[http://thread.gmane.org/gmane.emacs.orgmode/26441/focus%3D26441][Carsten's announcement]] for more details.
+ [[https://orgmode.org/list/C46F10DC-DE51-43D4-AFFE-F71E440D1E1F@gmail.com][Carsten's announcement]] for more details.
To switch over to the new system:
@@ -4712,7 +5261,7 @@ that Calc formulas can operate on them.
**** Modified link escaping
- David Maus worked on `org-link-escape'. See [[http://article.gmane.org/gmane.emacs.orgmode/37888][his message]]:
+ David Maus worked on `org-link-escape'. See [[https://orgmode.org/list/87k4gysacq.wl%dmaus@ictsoc.de][his message]]:
: Percent escaping is used in Org mode to escape certain characters
: in links that would either break the parser (e.g. square brackets
@@ -5151,7 +5700,7 @@ that Calc formulas can operate on them.
Thanks to Nicolas Goaziou for coding these changes.
-**** A property value of "nil" now means to unset a property
+**** A property value of =nil= now means to unset a property
This can be useful in particular with property inheritance, if
some upper level has the property, and some grandchild of it
diff --git a/etc/PROBLEMS b/etc/PROBLEMS
index 8ed92ab75e0..15e34ea06f8 100644
--- a/etc/PROBLEMS
+++ b/etc/PROBLEMS
@@ -1,6 +1,6 @@
Known Problems with GNU Emacs
-Copyright (C) 1987-1989, 1993-1999, 2001-2020 Free Software Foundation,
+Copyright (C) 1987-1989, 1993-1999, 2001-2021 Free Software Foundation,
Inc.
See the end of the file for license conditions.
@@ -352,11 +352,11 @@ is the current directory.
*** Set find-function-C-source-directory accordingly.
Once you have installed the source package, for example at
-/home/myself/deb-src/emacs-26.3, add the following line to your
+/home/myself/deb-src/emacs-27.1, add the following line to your
startup file:
(setq find-function-C-source-directory
- "/home/myself/deb-src/emacs-26.3/src/")
+ "/home/myself/deb-src/emacs-27.1/src/")
The installation directory of the Emacs source package will contain
the exact package name and version number of Emacs that is installed
@@ -386,7 +386,7 @@ To get describe-function and similar commands to work, you can then
add something like the following to your startup file:
(setq find-function-C-source-directory
- "/usr/src/debug/emacs-26.3-1.fc31.x86_64/src/")
+ "/usr/src/debug/emacs-27.1-1.fc31.x86_64/src/")
However, the exact directory name will depend on the system, and you
will need to both upgrade source and debug info when your system
@@ -746,6 +746,11 @@ versions of gnutls-cli, or use Emacs's built-in gnutls support.
** Characters are displayed as empty boxes or with wrong font under X.
+*** This may be due to your local fontconfig customization.
+Try removing or moving aside "$XDG_CONFIG_HOME/fontconfig/conf.d" and
+"$XDG_CONFIG_HOME/fontconfig/fonts.conf"
+($XDG_CONFIG_HOME is treated as "~/.config" if not set)
+
*** This can occur when two different versions of FontConfig are used.
For example, XFree86 4.3.0 has one version and Gnome usually comes
with a newer version. Emacs compiled with Gtk+ will then use the
diff --git a/etc/README b/etc/README
index b9b4bc4f0e7..6d7a15a6f2d 100644
--- a/etc/README
+++ b/etc/README
@@ -7,5 +7,5 @@ COPYRIGHT AND LICENSE INFORMATION FOR IMAGE FILES
File: emacs.icon
Author: Sun Microsystems, Inc
- Copyright (C) 1999, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1999, 2001-2021 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later (see COPYING)
diff --git a/etc/TERMS b/etc/TERMS
index 20c0a9a68c4..80b39c80e9f 100644
--- a/etc/TERMS
+++ b/etc/TERMS
@@ -1,4 +1,4 @@
-Copyright (C) 1999, 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 1999, 2001-2021 Free Software Foundation, Inc.
See the end of the file for copying permissions.
This file describes what you must or might want to do to termcap entries
diff --git a/etc/TODO b/etc/TODO
index 8e93e7fb10a..9448617626d 100644
--- a/etc/TODO
+++ b/etc/TODO
@@ -1,6 +1,6 @@
Emacs TODO List -*-outline-*-
-Copyright (C) 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 2001-2021 Free Software Foundation, Inc.
See the end of the file for license conditions.
@@ -242,6 +242,36 @@ https://lists.gnu.org/r/emacs-devel/2013-11/msg00515.html
processing. That is why we added text properties and variable
width fonts. However, more features are still needed to achieve this.
+Specifically, a major mode with the following features and abilities
+should be added to Emacs:
+
+ . import / export MS Office documents
+ . import / export Open Document Format (.odt) files
+ . import / export RTF files
+ . export to a PDF file
+ . select a font and its size
+ . apply a bold / italic / underline / strikethrough effect
+ . superscripts / subscripts
+ . apply a left / center / right / justified effect
+ . change the font color and the background color
+ . pixel-level text fill, justification, and indentation (so that
+ variable-pitch fonts could be freely used)
+ . create a list
+ . insert and change a table
+ . insert a picture
+ . define / use / modify styles
+ . print preview / print, in a way that is similar to what's on screen
+ (e.g., wrt the place where lines wrap)
+ . use footnotes
+ . support for "track changes" markings, including those which come
+ from Office documents
+ . multiple columns
+ . change page headers and footers
+ . save all the properties and settings mentioned above with the text
+ to a file, so that they are restored when later visiting that file
+
+The existing Enriched mode can be used as a starting point.
+
** Support ligatures out of the box
For the list of frequently-used typographical ligatures, see
@@ -536,6 +566,42 @@ This should go with point, so that motion commands can also move
through tall images. This value would be to point as window-vscroll
is to window-start.
+** Make redisplay smarter about which parts to redraw
+Currently, redisplay has only 2 levels of redrawing: either it
+redisplays only the selected window on the selected frame, or it
+redisplays all the windows on all the frames. This doesn't scale well
+when the number of visible frames is large.
+
+Currently, two variables are used to make the decision what to
+redisplay: update_mode_lines and windows_or_buffers_changed. These
+are set by various functions called from Lisp, and if redisplay finds
+one of them to be non-zero, it considers all the windows on all the
+frames for redisplay.
+
+The idea is to make the decision which parts need to be redrawn more
+fine-grained. Instead of simple boolean variables, we could have a
+bitmapped variable which records the kinds of changes done by Lisp
+since the previous redisplay cycle. Then the decision what exactly
+needs to be redrawn could be made based on the bits that are set.
+
+For example, one reason to consider all frames is that some scrolling
+command sets the update_mode_lines variable non-zero. This is done
+because the frame title, which doesn't belong to any window, needs to
+be reconsidered when the selected window is scrolled. But considering
+the frame title doesn't have to redisplay all the other windows on the
+frame, doesn't need to recompute the menu items and the tool-bar
+buttons, and doesn't need to consider frames other than the selected
+one. Being selective about what parts of the Emacs display need to be
+reconsidered and redrawn given the changes since the last redisplay
+will go along way towards making redisplay more scalable.
+
+One way of making this change is to go through all the places that set
+update_mode_lines and windows_or_buffers_changed, figure out which
+portions of the Emacs display could be affected by each change, and
+then implement the bitmap which will record each of these affected
+display portions. The logic in redisplay_internal will then need to
+be restructured so as to support this fine-grained redisplay.
+
** Address internationalization of symbols names
Essentially as if they were documentation, e.g. in command names and
Custom.
@@ -572,8 +638,6 @@ Do this for some or all errors associated with using subprocesses.
** Maybe reinterpret 'parse-error' as a category of errors
Put some other errors under it.
-** Make byte-compiler warn when a doc string is too wide
-
** Make byte-optimization warnings issue accurate line numbers
** Record the sxhash of the default value for customized variables
diff --git a/etc/charsets/README b/etc/charsets/README
index 3312367f29e..0045a0f638e 100644
--- a/etc/charsets/README
+++ b/etc/charsets/README
@@ -1,6 +1,6 @@
# README file for charset mapping files in this directory.
-# Copyright (C) 2003-2020 Free Software Foundation, Inc.
+# Copyright (C) 2003-2021 Free Software Foundation, Inc.
# Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
# National Institute of Advanced Industrial Science and Technology (AIST)
# Registration Number H13PRO009
diff --git a/etc/compilation.txt b/etc/compilation.txt
index 7e406389d44..e56d3b68476 100644
--- a/etc/compilation.txt
+++ b/etc/compilation.txt
@@ -676,7 +676,7 @@ Compilation segmentation fault at Thu Jul 13 10:55:49
Compilation finished at Thu Jul 21 15:02:15
-Copyright (C) 2004-2020 Free Software Foundation, Inc.
+Copyright (C) 2004-2021 Free Software Foundation, Inc.
COPYING PERMISSIONS:
diff --git a/etc/edt-user.el b/etc/edt-user.el
index 2852f936f22..8e1a599f0d1 100644
--- a/etc/edt-user.el
+++ b/etc/edt-user.el
@@ -1,6 +1,6 @@
;;; edt-user.el --- Sample user customizations for Emacs EDT emulation -*- lexical-binding: t -*-
-;; Copyright (C) 1986, 1992-1993, 2000-2020 Free Software Foundation,
+;; Copyright (C) 1986, 1992-1993, 2000-2021 Free Software Foundation,
;; Inc.
;; Author: Kevin Gallagher <kevin.gal@verizon.net>
diff --git a/etc/emacs-buffer.gdb b/etc/emacs-buffer.gdb
index e2377424077..41af836599b 100644
--- a/etc/emacs-buffer.gdb
+++ b/etc/emacs-buffer.gdb
@@ -1,6 +1,6 @@
# emacs-buffer.gdb --- gdb macros for recovering buffers from emacs coredumps
-# Copyright (C) 2005-2020 Free Software Foundation, Inc.
+# Copyright (C) 2005-2021 Free Software Foundation, Inc.
# Author: Noah Friedman <friedman@splode.com>
# Created: 2005-04-28
diff --git a/etc/emacs.appdata.xml b/etc/emacs.appdata.xml
index 1b5d7f9aae9..ca6233a59ae 100644
--- a/etc/emacs.appdata.xml
+++ b/etc/emacs.appdata.xml
@@ -1,5 +1,5 @@
<?xml version="1.0" encoding="UTF-8"?>
-<!-- Copyright (C) 2014-2020 Free Software Foundation, Inc. -->
+<!-- Copyright (C) 2014-2021 Free Software Foundation, Inc. -->
<component type="desktop-application">
<id>org.gnu.emacs</id>
<metadata_license>GFDL-1.3+</metadata_license>
diff --git a/etc/emacs.service b/etc/emacs.service
index c99c6779f58..809c49cdbc5 100644
--- a/etc/emacs.service
+++ b/etc/emacs.service
@@ -9,7 +9,11 @@ Documentation=info:emacs man:emacs(1) https://gnu.org/software/emacs/
[Service]
Type=notify
ExecStart=emacs --fg-daemon
-ExecStop=emacsclient --eval "(kill-emacs)"
+
+# Emacs will exit with status 15 after having received SIGTERM, which
+# is the default "KillSignal" value systemd uses to stop services.
+SuccessExitStatus=15
+
# The location of the SSH auth socket varies by distribution, and some
# set it from PAM, so don't override by default.
# Environment=SSH_AUTH_SOCK=%t/keyring/ssh
diff --git a/etc/enriched.txt b/etc/enriched.txt
index 1e1dc46c410..dd269e313cb 100644
--- a/etc/enriched.txt
+++ b/etc/enriched.txt
@@ -253,7 +253,7 @@ it.</indent>
-Copyright (C) 1995, 1997, 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 1995, 1997, 2001-2021 Free Software Foundation, Inc.
COPYING PERMISSIONS:
diff --git a/etc/forms/forms-d2.el b/etc/forms/forms-d2.el
index 1b0d6426e03..cd4231cf2de 100644
--- a/etc/forms/forms-d2.el
+++ b/etc/forms/forms-d2.el
@@ -1,6 +1,6 @@
;;; forms-d2.el --- demo forms-mode -*- lexical-binding:t -*-
-;; Copyright (C) 1991, 1994-1997, 2001-2020 Free Software Foundation,
+;; Copyright (C) 1991, 1994-1997, 2001-2021 Free Software Foundation,
;; Inc.
;; Author: Johan Vromans <jvromans@squirrel.nl>
diff --git a/etc/gnus-tut.txt b/etc/gnus-tut.txt
index 2001b913d24..27e868b79cb 100644
--- a/etc/gnus-tut.txt
+++ b/etc/gnus-tut.txt
@@ -24,7 +24,7 @@ was done by moi, yours truly, your humble servant, Lars Magne
Ingebrigtsen. If you have a WWW browser, you can investigate to your
heart's delight at <URL:http://www.ifi.uio.no/~larsi/larsi.html>.
-;; Copyright (C) 1995, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 2001-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
;; Keywords: news
diff --git a/etc/grep.txt b/etc/grep.txt
index 19a3b4b47b7..b5b78459b5c 100644
--- a/etc/grep.txt
+++ b/etc/grep.txt
@@ -85,6 +85,12 @@ git --no-pager grep -inH -p -e "org-element-map"
lisp/org/org.el=20969=(defun org-fill-paragraph (&optional justify)
lisp/org/org.el:21047: (org-element-map
+* ripgrep
+
+rg -nH --color always --no-heading -e grep-match-regexp
+lisp/progmodes/grep.el:608: (while (re-search-forward grep-match-regexp end 1)
+Binary file emacs.info matches (found "\u{0}" byte around offset 2222525)
+
* unknown greps
grep -nH -e "xyzxyz" ../info/*
@@ -97,7 +103,7 @@ grep -nH -e "xyzxyz" ../info/*
-Copyright (C) 2005-2020 Free Software Foundation, Inc.
+Copyright (C) 2005-2021 Free Software Foundation, Inc.
COPYING PERMISSIONS:
diff --git a/etc/images/README b/etc/images/README
index 2cee207e246..00aac4f510a 100644
--- a/etc/images/README
+++ b/etc/images/README
@@ -27,19 +27,19 @@ COPYRIGHT AND LICENSE INFORMATION FOR IMAGE FILES
File: mh-logo.xpm
Author: Satyaki Das
- Copyright (C) 2003-2020 Free Software Foundation, Inc.
+ Copyright (C) 2003-2021 Free Software Foundation, Inc.
Files: gnus.pbm
Author: Luis Fernandes <elf@ee.ryerson.ca>
- Copyright (C) 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 2001-2021 Free Software Foundation, Inc.
Files: splash.png, splash.svg, splash.pbm, splash.xpm
Author: Francesc Rocher <francesc.rocher@gmail.com>
- Copyright (C) 2008-2020 Free Software Foundation, Inc.
+ Copyright (C) 2008-2021 Free Software Foundation, Inc.
Files: checked.xpm, unchecked.xpm
Author: Chong Yidong <cyd@stupidchicken.com>
- Copyright (C) 2010-2020 Free Software Foundation, Inc.
+ Copyright (C) 2010-2021 Free Software Foundation, Inc.
* The following icons are from GTK+ 2.x. They are not part of Emacs, but
diff --git a/etc/images/checked.xpm b/etc/images/checked.xpm
index 9f60b368422..3e7e76f254e 100644
--- a/etc/images/checked.xpm
+++ b/etc/images/checked.xpm
@@ -1,5 +1,5 @@
/* XPM */
-/* Copyright (C) 2010-2020 Free Software Foundation, Inc.
+/* Copyright (C) 2010-2021 Free Software Foundation, Inc.
*
* Author: Chong Yidong <cyd@stupidchicken.com>
*
diff --git a/etc/images/custom/README b/etc/images/custom/README
index 7eb87c44000..fc9cd8d7f12 100644
--- a/etc/images/custom/README
+++ b/etc/images/custom/README
@@ -6,5 +6,5 @@ COPYRIGHT AND LICENSE INFORMATION FOR IMAGE FILES
Files: down.xpm down-pushed.xpm right.xpm right-pushed.xpm
Author: Juri Linkov
-Copyright (C) 2008-2020 Free Software Foundation, Inc.
+Copyright (C) 2008-2021 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later (see COPYING)
diff --git a/etc/images/ezimage/README b/etc/images/ezimage/README
index 2aef056abe6..865ce5b4c07 100644
--- a/etc/images/ezimage/README
+++ b/etc/images/ezimage/README
@@ -7,5 +7,5 @@ Files: bits.xpm bitsbang.xpm box-minus.xpm box-plus.xpm
tag-gt.xpm tag-minus.xpm tag-plus.xpm tag-type.xpm tag-v.xpm
tag.xpm unlock.xpm
Author: Eric M. Ludlam
-Copyright (C) 1999-2020 Free Software Foundation, Inc.
+Copyright (C) 1999-2021 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later (see COPYING)
diff --git a/etc/images/gnus/README b/etc/images/gnus/README
index f9c51f02c7b..4acfc0c7db9 100644
--- a/etc/images/gnus/README
+++ b/etc/images/gnus/README
@@ -7,7 +7,7 @@ COPYRIGHT AND LICENSE INFORMATION FOR IMAGE FILES
Files: important.xpm, unimportant.xpm
Author: Simon Josefsson <simon@josefsson.org>
-Copyright (C) 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 2001-2021 Free Software Foundation, Inc.
Files: catchup.pbm catchup.xpm cu-exit.pbm cu-exit.xpm
describe-group.pbm describe-group.xpm exit-gnus.pbm exit-gnus.xpm
@@ -21,11 +21,11 @@ Files: catchup.pbm catchup.xpm cu-exit.pbm cu-exit.xpm
unsubscribe.pbm unsubscribe.xpm uu-decode.pbm uu-decode.xpm
uu-post.pbm uu-post.xpm
Author: Luis Fernandes <elf@ee.ryerson.ca>
-Copyright (C) 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 2001-2021 Free Software Foundation, Inc.
Files: gnus.png, gnus.svg
Author: Francesc Rocher <rocher@member.fsf.org>
- Copyright (C) 2008-2020 Free Software Foundation, Inc.
+ Copyright (C) 2008-2021 Free Software Foundation, Inc.
* The following icons are from GNOME 2.x. They are not part of Emacs,
diff --git a/etc/images/gnus/gnus.svg b/etc/images/gnus/gnus.svg
index 7514f344631..362dc16cb6f 100644
--- a/etc/images/gnus/gnus.svg
+++ b/etc/images/gnus/gnus.svg
@@ -1,7 +1,7 @@
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
<!-- Gnu Emacs Logo
- Copyright (C) 2008-2020 Free Software Foundation, Inc.
+ Copyright (C) 2008-2021 Free Software Foundation, Inc.
Author: Francesc Rocher <f.rocher@member.fsf.org>
diff --git a/etc/images/gud/README b/etc/images/gud/README
index 4bf11eca8f5..0ef5258b9a8 100644
--- a/etc/images/gud/README
+++ b/etc/images/gud/README
@@ -1,7 +1,7 @@
COPYRIGHT AND LICENSE INFORMATION FOR IMAGE FILES
The following icons were created by Nick Roberts <nickrob@snap.net.nz>.
-Copyright (C) 2002-2020 Free Software Foundation, Inc.
+Copyright (C) 2002-2021 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later (see COPYING)
break.pbm, nexti.pbm, go.pbm, pp.pbm, print.pbm, pstar.pbm, remove.pbm
@@ -31,7 +31,7 @@ their copyright assignment included the icons.
The following icons are converted from the Insight Windows style icon
set in src/gdb/gdbtk/library/images2.
-Copyright (C) 2002-2020 Free Software Foundation, Inc.
+Copyright (C) 2002-2021 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later (see COPYING)
cont.pbm and cont.xpm were converted from continue.gif
@@ -47,7 +47,7 @@ License: GNU General Public License version 3 or later (see COPYING)
The following icons are created from the Insight Windows style icon
set in src/gdb/gdbtk/library/images2.
-Copyright (C) 2002-2020 Free Software Foundation, Inc.
+Copyright (C) 2002-2021 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later (see COPYING)
rcont.xpm rfinish.xpm
diff --git a/etc/images/icons/README b/etc/images/icons/README
index ee25f4ab92c..a0a2e9303d5 100644
--- a/etc/images/icons/README
+++ b/etc/images/icons/README
@@ -6,7 +6,7 @@ Files: hicolor/16x16/apps/emacs.png hicolor/24x24/apps/emacs.png
hicolor/scalable/mimetypes/emacs-document.svg
Author: Nicolas Petton <nicolas@petton.fr>
-Copyright (C) 2015-2020 Free Software Foundation, Inc.
+Copyright (C) 2015-2021 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later (see COPYING)
Files: hicolor/16x16/apps/emacs23.png hicolor/24x24/apps/emacs23.png
@@ -14,7 +14,7 @@ Files: hicolor/16x16/apps/emacs23.png hicolor/24x24/apps/emacs23.png
hicolor/128x128/apps/emacs23.png hicolor/scalable/apps/emacs23.svg
Author: Kentaro Ohkouchi <nanasess@fsm.ne.jp>
-Copyright (C) 2007-2020 Free Software Foundation, Inc.
+Copyright (C) 2007-2021 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later (see COPYING)
@@ -22,7 +22,7 @@ Files: hicolor/16x16/apps/emacs22.png hicolor/24x24/apps/emacs22.png
hicolor/32x32/apps/emacs22.png hicolor/48x48/apps/emacs22.png
Author: Andrew Zhilin <andrew_zhilin@yahoo.com>
-Copyright (C) 2005-2020 Free Software Foundation, Inc.
+Copyright (C) 2005-2021 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later (see COPYING)
Files: allout-widgets-dark-bg/closed.png
@@ -71,5 +71,5 @@ Files: allout-widgets-dark-bg/closed.png
allout-widgets-light-bg/through-descender.xpm
Author: Ken Manheimer <ken.manheimer@gmail.com>
-Copyright (C) 2011-2020 Free Software Foundation, Inc.
+Copyright (C) 2011-2021 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later (see COPYING)
diff --git a/etc/images/icons/hicolor/scalable/apps/emacs.svg b/etc/images/icons/hicolor/scalable/apps/emacs.svg
index 902ee9db7eb..a2bc4412475 100644
--- a/etc/images/icons/hicolor/scalable/apps/emacs.svg
+++ b/etc/images/icons/hicolor/scalable/apps/emacs.svg
@@ -15,7 +15,7 @@
id="metadata70"><rdf:RDF><cc:Work
rdf:about=""><dc:format>image/svg+xml</dc:format><dc:type
rdf:resource="http://purl.org/dc/dcmitype/StillImage" /><dc:title></dc:title></cc:Work></rdf:RDF></metadata><!-- Gnu Emacs Icon
- Copyright (C) 2008-2020 Free Software Foundation, Inc.
+ Copyright (C) 2008-2021 Free Software Foundation, Inc.
Author: Nicolas Petton <nicolas@petton.fr>
diff --git a/etc/images/icons/hicolor/scalable/apps/emacs23.svg b/etc/images/icons/hicolor/scalable/apps/emacs23.svg
index 6365a4dec22..31db7b9cef4 100644
--- a/etc/images/icons/hicolor/scalable/apps/emacs23.svg
+++ b/etc/images/icons/hicolor/scalable/apps/emacs23.svg
@@ -10,7 +10,7 @@
id="svg4768"
xml:space="preserve">
<!-- Gnu Emacs Icon
- Copyright (C) 2008-2020 Free Software Foundation, Inc.
+ Copyright (C) 2008-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/etc/images/icons/hicolor/scalable/mimetypes/emacs-document23.svg b/etc/images/icons/hicolor/scalable/mimetypes/emacs-document23.svg
index bd3f0c0abd9..b11c5bd0524 100644
--- a/etc/images/icons/hicolor/scalable/mimetypes/emacs-document23.svg
+++ b/etc/images/icons/hicolor/scalable/mimetypes/emacs-document23.svg
@@ -1,7 +1,7 @@
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
<!-- Gnu Emacs Document Icon
- Copyright (C) 2008-2020 Free Software Foundation, Inc.
+ Copyright (C) 2008-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/etc/images/mh-logo.xpm b/etc/images/mh-logo.xpm
index 97848e06ce9..fd7598d5a6b 100644
--- a/etc/images/mh-logo.xpm
+++ b/etc/images/mh-logo.xpm
@@ -1,7 +1,7 @@
/* XPM */
/* MH-E Logo
*
- * Copyright (C) 2003-2020 Free Software Foundation, Inc.
+ * Copyright (C) 2003-2021 Free Software Foundation, Inc.
*
* Author: Satyaki Das
*
diff --git a/etc/images/mpc/README b/etc/images/mpc/README
index 709ae07a5c5..30e9ac0cf29 100644
--- a/etc/images/mpc/README
+++ b/etc/images/mpc/README
@@ -2,5 +2,5 @@ COPYRIGHT AND LICENSE INFORMATION FOR IMAGE FILES
Files: add.xpm ffwd.xpm next.xpm pause.xpm play.xpm prev.xpm rewind.xpm stop.xpm
Author: Stefan Monnier <monnier@iro.umontreal.ca>
-Copyright (C) 2009-2020 Free Software Foundation, Inc.
+Copyright (C) 2009-2021 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later (see COPYING)
diff --git a/etc/images/newsticker/README b/etc/images/newsticker/README
index 3adf691a370..30ecabb639f 100644
--- a/etc/images/newsticker/README
+++ b/etc/images/newsticker/README
@@ -4,5 +4,5 @@ Files: browse-url.xpm get-all.xpm mark-immortal.xpm mark-read.xpm
narrow.xpm next-feed.xpm next-item.xpm prev-feed.xpm
prev-item.xpm rss-feed.png rss-feed.svg update.xpm
Author: Ulf Jasper
-Copyright (C) 2011-2020 Free Software Foundation, Inc.
+Copyright (C) 2011-2021 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later (see COPYING)
diff --git a/etc/images/smilies/README b/etc/images/smilies/README
index 1563845dd98..9fddcfb9e7a 100644
--- a/etc/images/smilies/README
+++ b/etc/images/smilies/README
@@ -3,5 +3,5 @@ Files: blink.pbm blink.xpm braindamaged.xpm cry.xpm dead.xpm evil.xpm
sad.xpm smile.pbm smile.xpm wry.pbm wry.xpm
Authors: Reiner Steib, Simon Josefsson, Kai Grossjohann, Alex
Schroeder, Oliver Scholz, Per Abrahamsen, Kim F. Storm.
-Copyright (C) 1999-2020 Free Software Foundation, Inc.
+Copyright (C) 1999-2021 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later (see COPYING)
diff --git a/etc/images/smilies/grayscale/README b/etc/images/smilies/grayscale/README
index c2b0949b0aa..5d15f3cfbfd 100644
--- a/etc/images/smilies/grayscale/README
+++ b/etc/images/smilies/grayscale/README
@@ -3,5 +3,5 @@ Files: blink.xpm braindamaged.xpm cry.xpm dead.xpm evil.xpm forced.xpm
frown.xpm grin.xpm indifferent.xpm reverse-smile.xpm sad.xpm
smile.xpm wry.xpm
Author: Adam Sjøgren
-Copyright (C) 2007-2020 Free Software Foundation, Inc.
+Copyright (C) 2007-2021 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later (see COPYING)
diff --git a/etc/images/smilies/medium/README b/etc/images/smilies/medium/README
index c2b0949b0aa..5d15f3cfbfd 100644
--- a/etc/images/smilies/medium/README
+++ b/etc/images/smilies/medium/README
@@ -3,5 +3,5 @@ Files: blink.xpm braindamaged.xpm cry.xpm dead.xpm evil.xpm forced.xpm
frown.xpm grin.xpm indifferent.xpm reverse-smile.xpm sad.xpm
smile.xpm wry.xpm
Author: Adam Sjøgren
-Copyright (C) 2007-2020 Free Software Foundation, Inc.
+Copyright (C) 2007-2021 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later (see COPYING)
diff --git a/etc/images/splash.svg b/etc/images/splash.svg
index 5e3ac09c308..387ffad7c7a 100644
--- a/etc/images/splash.svg
+++ b/etc/images/splash.svg
@@ -1,7 +1,7 @@
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
<!-- Gnu Emacs Logo
- Copyright (C) 2008-2020 Free Software Foundation, Inc.
+ Copyright (C) 2008-2021 Free Software Foundation, Inc.
Author: Francesc Rocher <francesc.rocher@gmail.com>
Based on the original work by Luis Fernandes <elf@ee.ryerson.ca>
diff --git a/etc/images/tabs/README b/etc/images/tabs/README
index da149af94c6..f1429ef16f0 100644
--- a/etc/images/tabs/README
+++ b/etc/images/tabs/README
@@ -4,5 +4,5 @@ COPYRIGHT AND LICENSE INFORMATION FOR IMAGE FILES
Files: close.xpm new.xpm left-arrow.xpm right-arrow.xpm
Author: Juri Linkov <juri@linkov.net>
-Copyright (C) 2019-2020 Free Software Foundation, Inc.
+Copyright (C) 2019-2021 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later (see COPYING)
diff --git a/etc/images/tree-widget/default/README b/etc/images/tree-widget/default/README
index 2a7772e0337..a0c9c8e48dc 100644
--- a/etc/images/tree-widget/default/README
+++ b/etc/images/tree-widget/default/README
@@ -5,5 +5,5 @@ Files: close.png close.xpm empty.png empty.xpm end-guide.png end-guide.xpm
no-guide.png no-guide.xpm no-handle.png no-handle.xpm open.png
open.xpm
Author: David Ponce <david.ponce@wanadoo.fr>
-Copyright (C) 2004-2020 Free Software Foundation, Inc.
+Copyright (C) 2004-2021 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later (see COPYING)
diff --git a/etc/images/tree-widget/folder/README b/etc/images/tree-widget/folder/README
index 5af0e9b28ca..2a9c8a211b4 100644
--- a/etc/images/tree-widget/folder/README
+++ b/etc/images/tree-widget/folder/README
@@ -5,5 +5,5 @@ Files: close.png close.xpm empty.png empty.xpm end-guide.png
leaf.png leaf.xpm no-guide.png no-guide.xpm no-handle.png
no-handle.xpm open.png open.xpm
Author: David Ponce <david.ponce@wanadoo.fr>
-Copyright (C) 2004-2020 Free Software Foundation, Inc.
+Copyright (C) 2004-2021 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later (see COPYING)
diff --git a/etc/images/unchecked.xpm b/etc/images/unchecked.xpm
index 128fcd1b47c..5e18534e77e 100644
--- a/etc/images/unchecked.xpm
+++ b/etc/images/unchecked.xpm
@@ -1,5 +1,5 @@
/* XPM */
-/* Copyright (C) 2010-2020 Free Software Foundation, Inc.
+/* Copyright (C) 2010-2021 Free Software Foundation, Inc.
*
* Author: Chong Yidong <cyd@stupidchicken.com>
*
diff --git a/etc/org/README b/etc/org/README
index 100c577e194..07126fc31ba 100644
--- a/etc/org/README
+++ b/etc/org/README
@@ -1,7 +1,7 @@
The files OrgOdtContentTemplate.xml and OrgOdtStyles.xml have the
following copyright information:
-Copyright (C) 2010-2020 Free Software Foundation, Inc.
+Copyright (C) 2010-2021 Free Software Foundation, Inc.
These files are part of GNU Emacs.
diff --git a/etc/ps-prin0.ps b/etc/ps-prin0.ps
index d5f8a5e0609..72046666460 100644
--- a/etc/ps-prin0.ps
+++ b/etc/ps-prin0.ps
@@ -1,7 +1,7 @@
% === BEGIN ps-print prologue 0
% version: 6.0
-% Copyright (C) 2000-2020 Free Software Foundation, Inc.
+% Copyright (C) 2000-2021 Free Software Foundation, Inc.
% This file is part of GNU Emacs.
diff --git a/etc/ps-prin1.ps b/etc/ps-prin1.ps
index f68174b991e..d565e33d3ba 100644
--- a/etc/ps-prin1.ps
+++ b/etc/ps-prin1.ps
@@ -1,7 +1,7 @@
% === BEGIN ps-print prologue 1
% version: 6.1
-% Copyright (C) 2000-2020 Free Software Foundation, Inc.
+% Copyright (C) 2000-2021 Free Software Foundation, Inc.
% This file is part of GNU Emacs.
diff --git a/etc/publicsuffix.txt b/etc/publicsuffix.txt
index bcde6728b5c..1ede2b929a0 100644
--- a/etc/publicsuffix.txt
+++ b/etc/publicsuffix.txt
@@ -1152,7 +1152,7 @@ gov.gr
// gs : https://en.wikipedia.org/wiki/.gs
gs
-// gt : http://www.gt/politicas_de_registro.html
+// gt : https://www.gt/sitio/registration_policy.php?lang=en
gt
com.gt
edu.gt
@@ -4703,6 +4703,7 @@ nl
// Norid geographical second level domains : https://www.norid.no/en/om-domenenavn/regelverk-for-no/vedlegg-b/
// Norid category second level domains : https://www.norid.no/en/om-domenenavn/regelverk-for-no/vedlegg-c/
// Norid category second-level domains managed by parties other than Norid : https://www.norid.no/en/om-domenenavn/regelverk-for-no/vedlegg-d/
+// RSS feed: https://teknisk.norid.no/en/feed/
no
// Norid category second level domains : https://www.norid.no/en/om-domenenavn/regelverk-for-no/vedlegg-c/
fhs.no
@@ -7110,7 +7111,7 @@ org.zw
// newGTLDs
-// List of new gTLDs imported from https://www.icann.org/resources/registries/gtlds/v2/gtlds.json on 2020-10-08T17:45:32Z
+// List of new gTLDs imported from https://www.icann.org/resources/registries/gtlds/v2/gtlds.json on 2020-11-30T20:26:10Z
// This list is auto-generated, don't edit it manually.
// aaa : 2015-02-26 American Automobile Association, Inc.
aaa
@@ -7328,7 +7329,7 @@ author
// auto : 2014-11-13 XYZ.COM LLC
auto
-// autos : 2014-01-09 DERAutos, LLC
+// autos : 2014-01-09 XYZ.COM LLC
autos
// avianca : 2015-01-08 Avianca Holdings S.A.
@@ -7337,7 +7338,7 @@ avianca
// aws : 2015-06-25 Amazon Registry Services, Inc.
aws
-// axa : 2013-12-19 AXA SA
+// axa : 2013-12-19 AXA Group Operations SAS
axa
// azure : 2014-12-18 Microsoft Corporation
@@ -7478,7 +7479,7 @@ bmw
// bnpparibas : 2014-05-29 BNP Paribas
bnpparibas
-// boats : 2014-12-04 DERBoats, LLC
+// boats : 2014-12-04 XYZ.COM LLC
boats
// boehringer : 2015-07-09 Boehringer Ingelheim International GmbH
@@ -7517,7 +7518,7 @@ bot
// boutique : 2013-11-14 Binky Moon, LLC
boutique
-// box : 2015-11-12 .BOX INC.
+// box : 2015-11-12 Intercap Registry Inc.
box
// bradesco : 2014-12-18 Banco Bradesco S.A.
@@ -8501,7 +8502,7 @@ homedepot
// homegoods : 2015-07-16 The TJX Companies, Inc.
homegoods
-// homes : 2014-01-09 DERHomes, LLC
+// homes : 2014-01-09 XYZ.COM LLC
homes
// homesense : 2015-07-16 The TJX Companies, Inc.
@@ -8651,9 +8652,6 @@ java
// jcb : 2014-11-20 JCB Co., Ltd.
jcb
-// jcp : 2015-04-23 JCP Media, Inc.
-jcp
-
// jeep : 2015-07-30 FCA US LLC.
jeep
@@ -9077,7 +9075,7 @@ moscow
// moto : 2015-06-04 Motorola Trademark Holdings, LLC
moto
-// motorcycles : 2014-01-09 DERMotorcycles, LLC
+// motorcycles : 2014-01-09 XYZ.COM LLC
motorcycles
// mov : 2014-01-30 Charleston Road Registry Inc.
@@ -9242,7 +9240,7 @@ one
// ong : 2014-03-06 Public Interest Registry
ong
-// onl : 2013-09-16 I-Registry Ltd.
+// onl : 2013-09-16 iRegistry GmbH
onl
// online : 2015-01-15 DotOnline Inc.
@@ -9539,7 +9537,7 @@ reviews
// rexroth : 2015-06-18 Robert Bosch GMBH
rexroth
-// rich : 2013-11-21 I-Registry Ltd.
+// rich : 2013-11-21 iRegistry GmbH
rich
// richardli : 2015-05-14 Pacific Century Asset Management (HK) Limited
@@ -9758,9 +9756,6 @@ show
// showtime : 2015-08-06 CBS Domains Inc.
showtime
-// shriram : 2014-01-23 Shriram Capital Ltd.
-shriram
-
// silk : 2015-06-25 Amazon Registry Services, Inc.
silk
@@ -10073,7 +10068,7 @@ travelers
// travelersinsurance : 2015-03-26 Travelers TLD, LLC
travelersinsurance
-// trust : 2014-10-16 NCC Group Domain Services, Inc.
+// trust : 2014-10-16 UNR Corp.
trust
// trv : 2015-03-26 Travelers TLD, LLC
@@ -10595,7 +10590,7 @@ vermögensberatung
// xyz : 2013-12-05 XYZ.COM LLC
xyz
-// yachts : 2014-01-09 DERYachts, LLC
+// yachts : 2014-01-09 XYZ.COM LLC
yachts
// yahoo : 2015-04-02 Yahoo! Domain Services Inc.
@@ -10680,12 +10675,6 @@ barsy.ca
// Submitted by Werner Kaltofen <wk@all-inkl.com>
kasserver.com
-// Algorithmia, Inc. : algorithmia.com
-// Submitted by Eli Perelman <eperelman@algorithmia.io>
-*.algorithmia.com
-!teams.algorithmia.com
-!test.algorithmia.com
-
// Altervista: https://www.altervista.org
// Submitted by Carlo Cannas <tech_staff@altervista.it>
altervista.org
@@ -10868,6 +10857,10 @@ bnr.la
// Submitted by Paul Crowder <paul.crowder@blackbaud.com>
blackbaudcdn.net
+// Blatech : http://www.blatech.net
+// Submitted by Luke Bratch <luke@bratch.co.uk>
+of.je
+
// Boomla : https://boomla.com
// Submitted by Tibor Halter <thalter@boomla.com>
boomla.net
@@ -10981,10 +10974,6 @@ c.la
// Submitted by B. Blechschmidt <hostmaster@certmgr.org>
certmgr.org
-// Citrix : https://citrix.com
-// Submitted by Alex Stoddard <alex.stoddard@citrix.com>
-xenapponazure.com
-
// Civilized Discourse Construction Kit, Inc. : https://www.discourse.org/
// Submitted by Rishabh Nambiar & Michael Brown <team@discourse.org>
discourse.group
@@ -11073,10 +11062,6 @@ cloudns.pro
cloudns.pw
cloudns.us
-// Cloudeity Inc : https://cloudeity.com
-// Submitted by Stefan Dimitrov <contact@cloudeity.com>
-cloudeity.net
-
// CNPY : https://cnpy.gdn
// Submitted by Angelo Gladding <angelo@lahacker.net>
cnpy.gdn
@@ -11537,6 +11522,10 @@ ddnss.org
definima.net
definima.io
+// DigitalOcean : https://digitalocean.com/
+// Submitted by Braxton Huggins <bhuggins@digitalocean.com>
+ondigitalocean.app
+
// dnstrace.pro : https://dnstrace.pro/
// Submitted by Chris Partridge <chris@partridge.tech>
bci.dnstrace.pro
@@ -11802,6 +11791,10 @@ ukco.me
// submitted by Koen Van Isterdael <k.vanisterdael@fermax.be>
mydobiss.com
+// FH Muenster : https://www.fh-muenster.de
+// Submitted by Robin Naundorf <r.naundorf@fh-muenster.de>
+fh-muenster.io
+
// Filegear Inc. : https://www.filegear.com
// Submitted by Jason Zhu <jason@owtware.com>
filegear.me
@@ -11872,6 +11865,7 @@ usercontent.jp
gentapps.com
gentlentapis.com
lab.ms
+cdn-edges.net
// GitHub, Inc.
// Submitted by Patrick Toomey <security@github.com>
@@ -11931,9 +11925,10 @@ pagespeedmobilizer.com
publishproxy.com
withgoogle.com
withyoutube.com
-cloudfunctions.net
+*.gateway.dev
cloud.goog
translate.goog
+cloudfunctions.net
blogspot.ae
blogspot.al
@@ -12056,6 +12051,10 @@ ravendb.me
development.run
ravendb.run
+// Hong Kong Productivity Council: https://www.hkpc.org/
+// Submitted by SECaaS Team <summchan@hkpc.org>
+secaas.hk
+
// HOSTBIP REGISTRY : https://www.hostbip.com/
// Submitted by Atanunu Igbunuroghene <publicsuffixlist@hostbip.com>
bpl.biz
@@ -12165,7 +12164,7 @@ iserv.dev
// Submitted by Yuji Minagawa <domains-admin@iodata.jp>
iobb.net
-//Jelastic, Inc. : https://jelastic.com/
+// Jelastic, Inc. : https://jelastic.com/
// Submited by Ihor Kolodyuk <ik@jelastic.com>
mel.cloudlets.com.au
cloud.interhostsolutions.be
@@ -12180,6 +12179,9 @@ jele.cloud
it1.eur.aruba.jenv-aruba.cloud
it1.jenv-aruba.cloud
it1-eur.jenv-arubabiz.cloud
+oxa.cloud
+tn.oxa.cloud
+uk.oxa.cloud
primetel.cloud
uk.primetel.cloud
ca.reclaim.cloud
@@ -12250,6 +12252,7 @@ jelastic.regruhosting.ru
enscaled.sg
jele.site
jelastic.team
+orangecloud.tn
j.layershift.co.uk
phx.enscaled.us
mircloud.us
@@ -12327,10 +12330,6 @@ co.technology
// Submitted by Greg Holland <greg.holland@lmpm.com>
app.lmpm.com
-// Linki Tools UG : https://linki.tools
-// Submitted by Paulo Matos <pmatos@linki.tools>
-linkitools.space
-
// linkyard ldt: https://www.linkyard.ch/
// Submitted by Mario Siegenthaler <mario.siegenthaler@linkyard.ch>
linkyard.cloud
@@ -12369,7 +12368,6 @@ swidnik.pl
// Lug.org.uk : https://lug.org.uk
// Submitted by Jon Spriggs <admin@lug.org.uk>
-uklugs.org
glug.org.uk
lug.org.uk
lugs.org.uk
@@ -12446,11 +12444,17 @@ eu.meteorapp.com
co.pl
// Microsoft Corporation : http://microsoft.com
-// Submitted by Mostafa Elzeiny <moelzein@microsoft.com>
+// Submitted by Mitch Webster <miwebst@microsoft.com>
*.azurecontainer.io
azurewebsites.net
azure-mobile.net
cloudapp.net
+azurestaticapps.net
+centralus.azurestaticapps.net
+eastasia.azurestaticapps.net
+eastus2.azurestaticapps.net
+westeurope.azurestaticapps.net
+westus2.azurestaticapps.net
// minion.systems : http://minion.systems
// Submitted by Robert Böttinger <r@minion.systems>
@@ -12492,19 +12496,22 @@ cust.retrosnub.co.uk
ui.nabu.casa
// Names.of.London : https://names.of.london/
-// Submitted by James Stevens <registry@names.of.london> or <james@jrcs.net>
+// Submitted by James Stevens <registry[at]names.of.london> or <publiclist[at]jrcs.net>
pony.club
of.fashion
-on.fashion
-of.football
in.london
of.london
+from.marketing
+with.marketing
for.men
+repair.men
and.mom
for.mom
for.one
+under.one
for.sale
-of.work
+that.win
+from.work
to.work
// NCTU.ME : https://nctu.me/
@@ -12824,6 +12831,12 @@ mypep.link
// Submitted by Kenneth Van Alstyne <kvanalstyne@perspecta.com>
perspecta.cloud
+// PE Ulyanov Kirill Sergeevich : https://airy.host
+// Submitted by Kirill Ulyanov <k.ulyanov@airy.host>
+lk3.ru
+ra-ru.ru
+zsew.ru
+
// Planet-Work : https://www.planet-work.com/
// Submitted by Frédéric VANNIÈRE <f.vanniere@planet-work.com>
on-web.fr
@@ -12885,6 +12898,10 @@ byen.site
// Submitted by Kor Nielsen <kor@pubtls.org>
pubtls.org
+// QOTO, Org.
+// Submitted by Jeffrey Phillips Freeman <jeffrey.freeman@qoto.org>
+qoto.io
+
// Qualifio : https://qualifio.com/
// Submitted by Xavier De Cock <xdecock@gmail.com>
qualifioapp.com
@@ -12970,7 +12987,6 @@ hzc.io
// Revitalised Limited : http://www.revitalised.co.uk
// Submitted by Jack Price <jack@revitalised.co.uk>
wellbeingzone.eu
-ptplus.fit
wellbeingzone.co.uk
// Rochester Institute of Technology : http://www.rit.edu/
@@ -13344,7 +13360,7 @@ wafflecell.com
// Submitted by Fajar Sodik <official@wapblog.id>
idnblogger.com
indowapblog.com
-bloghp.id
+bloger.id
wblog.id
wbq.me
fastblog.net
diff --git a/etc/refcards/Makefile b/etc/refcards/Makefile
index c0f0233f921..ce2c534a93b 100644
--- a/etc/refcards/Makefile
+++ b/etc/refcards/Makefile
@@ -1,6 +1,6 @@
### Makefile for Emacs refcards
-## Copyright (C) 1993-1994, 2001-2020 Free Software Foundation, Inc.
+## Copyright (C) 1993-1994, 2001-2021 Free Software Foundation, Inc.
## This file is part of GNU Emacs.
#
diff --git a/etc/refcards/README b/etc/refcards/README
index f3de99f9610..30c82bc7140 100644
--- a/etc/refcards/README
+++ b/etc/refcards/README
@@ -1,4 +1,4 @@
-Copyright (C) 2013-2020 Free Software Foundation, Inc.
+Copyright (C) 2013-2021 Free Software Foundation, Inc.
See the end of the file for license conditions.
@@ -32,7 +32,7 @@ it is reproduced here for convenience.
File: gnus-logo.eps, gnus-logo.pdf
Author: Luis Fernandes <elf@ee.ryerson.ca>
- Copyright (C) 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 2001-2021 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later (see COPYING)
diff --git a/etc/refcards/calccard.tex b/etc/refcards/calccard.tex
index a562f1e9446..02607621cd4 100644
--- a/etc/refcards/calccard.tex
+++ b/etc/refcards/calccard.tex
@@ -20,7 +20,7 @@
% Typical command to format: tex calccard.tex
% Typical command to print (3 cols): dvips -t landscape calccard.dvi
-% Copyright (C) 1987, 1992, 2001--2020 Free Software Foundation, Inc.
+% Copyright (C) 1987, 1992, 2001--2021 Free Software Foundation, Inc.
% This document is free software: you can redistribute it and/or modify
% it under the terms of the GNU General Public License as published by
diff --git a/etc/refcards/cs-dired-ref.tex b/etc/refcards/cs-dired-ref.tex
index 9a37f16edd3..294d11d1ca4 100644
--- a/etc/refcards/cs-dired-ref.tex
+++ b/etc/refcards/cs-dired-ref.tex
@@ -1,6 +1,6 @@
% Reference Card for Dired -*- coding: utf-8 -*-
-% Copyright (C) 2000--2020 Free Software Foundation, Inc.
+% Copyright (C) 2000--2021 Free Software Foundation, Inc.
% Author: Evgeny Roubinchtein <eroubinc@u.washington.edu>
% Czech translation: Pavel Janík <Pavel@Janik.cz>, March 2001
diff --git a/etc/refcards/cs-refcard.tex b/etc/refcards/cs-refcard.tex
index 5a3adb80b3b..4d9a8b34aef 100644
--- a/etc/refcards/cs-refcard.tex
+++ b/etc/refcards/cs-refcard.tex
@@ -1,6 +1,6 @@
% Reference Card for GNU Emacs -*- coding: utf-8 -*-
-% Copyright (C) 1987, 1993, 1996--1997, 2001--2020 Free Software
+% Copyright (C) 1987, 1993, 1996--1997, 2001--2021 Free Software
% Foundation, Inc.
% Author: Stephen Gildea <stepheng+emacs@gildea.com>
diff --git a/etc/refcards/cs-survival.tex b/etc/refcards/cs-survival.tex
index 699dd9054d6..75a07eebd16 100644
--- a/etc/refcards/cs-survival.tex
+++ b/etc/refcards/cs-survival.tex
@@ -1,6 +1,6 @@
% Title: GNU Emacs Survival Card -*- coding: utf-8 -*-
-% Copyright (C) 2000--2020 Free Software Foundation, Inc.
+% Copyright (C) 2000--2021 Free Software Foundation, Inc.
% Author: Włodek Bzyl <matwb@univ.gda.pl>
% Czech translation: Pavel Janík <Pavel@Janik.cz>, March 2001
diff --git a/etc/refcards/de-refcard.tex b/etc/refcards/de-refcard.tex
index 29ddf12d49f..c890acb69f4 100644
--- a/etc/refcards/de-refcard.tex
+++ b/etc/refcards/de-refcard.tex
@@ -1,6 +1,6 @@
% Reference Card for GNU Emacs
-% Copyright (C) 1987, 1993, 1996, 2000--2020 Free Software Foundation,
+% Copyright (C) 1987, 1993, 1996, 2000--2021 Free Software Foundation,
% Inc.
% Author: Stephen Gildea <stepheng+emacs@gildea.com>
diff --git a/etc/refcards/dired-ref.tex b/etc/refcards/dired-ref.tex
index 85a70524948..8d5af71b6c7 100644
--- a/etc/refcards/dired-ref.tex
+++ b/etc/refcards/dired-ref.tex
@@ -1,6 +1,6 @@
% Reference Card for Dired
-% Copyright (C) 2000--2020 Free Software Foundation, Inc.
+% Copyright (C) 2000--2021 Free Software Foundation, Inc.
% Author: Evgeny Roubinchtein <eroubinc@u.washington.edu>
diff --git a/etc/refcards/emacsver.tex.in b/etc/refcards/emacsver.tex.in
index 2f5bfb924bb..ac80804bf1c 100644
--- a/etc/refcards/emacsver.tex.in
+++ b/etc/refcards/emacsver.tex.in
@@ -2,4 +2,4 @@
\def\versionemacs{@majorversion@} % major version of emacs
%% This one should not be automatically updated;
%% M-x set-copyright in admin.el handles it.
-\def\year{2020} % latest copyright year
+\def\year{2021} % latest copyright year
diff --git a/etc/refcards/fr-dired-ref.tex b/etc/refcards/fr-dired-ref.tex
index 968c58bb90a..fb8462f2767 100644
--- a/etc/refcards/fr-dired-ref.tex
+++ b/etc/refcards/fr-dired-ref.tex
@@ -1,6 +1,6 @@
% Reference Card for Dired -*- coding: utf-8 -*-
-% Copyright (C) 2000--2020 Free Software Foundation, Inc.
+% Copyright (C) 2000--2021 Free Software Foundation, Inc.
% Author: Evgeny Roubinchtein <eroubinc@u.washington.edu>
% French translation: Eric Jacoboni
diff --git a/etc/refcards/fr-refcard.tex b/etc/refcards/fr-refcard.tex
index fe303ee8a51..34d7ebda19e 100644
--- a/etc/refcards/fr-refcard.tex
+++ b/etc/refcards/fr-refcard.tex
@@ -1,6 +1,6 @@
% Reference Card for GNU Emacs
-% Copyright (C) 1987, 1993, 1996--1997, 2001--2020 Free Software
+% Copyright (C) 1987, 1993, 1996--1997, 2001--2021 Free Software
% Foundation, Inc.
% Author: Stephen Gildea <stepheng+emacs@gildea.com>
diff --git a/etc/refcards/fr-survival.tex b/etc/refcards/fr-survival.tex
index 1cd6852db83..e11fe175f87 100644
--- a/etc/refcards/fr-survival.tex
+++ b/etc/refcards/fr-survival.tex
@@ -1,7 +1,7 @@
%&tex
% Title: GNU Emacs Survival Card
-% Copyright (C) 2000--2020 Free Software Foundation, Inc.
+% Copyright (C) 2000--2021 Free Software Foundation, Inc.
% Author: Włodek Bzyl <matwb@univ.gda.pl>
% French translation: \'Eric Jacoboni <jaco@teaser.fr>, November 2001
diff --git a/etc/refcards/gnus-logo.eps b/etc/refcards/gnus-logo.eps
index d446b36a95f..eb774618212 100644
--- a/etc/refcards/gnus-logo.eps
+++ b/etc/refcards/gnus-logo.eps
@@ -1,5 +1,5 @@
%!PS-Adobe-2.0 EPSF-2.0
-% Copyright (C) 2000-2020 Free Software Foundation, Inc.
+% Copyright (C) 2000-2021 Free Software Foundation, Inc.
%
% Author: Luis Fernandes <elf@ee.ryerson.ca>
%
diff --git a/etc/refcards/gnus-refcard.tex b/etc/refcards/gnus-refcard.tex
index 895186decfe..4a1760c1b26 100644
--- a/etc/refcards/gnus-refcard.tex
+++ b/etc/refcards/gnus-refcard.tex
@@ -120,7 +120,7 @@
%% Gnus logo by Luis Fernandes.
\newcommand{\Copyright}{%
\begin{center}
- Copyright \copyright\ 1995, 2000, 2002--2020 Free Software Foundation, Inc.\\*
+ Copyright \copyright\ 1995, 2000, 2002--2021 Free Software Foundation, Inc.\\*
\end{center}
Released under the terms of the GNU General Public License version 3 or later.
diff --git a/etc/refcards/orgcard.tex b/etc/refcards/orgcard.tex
index a261cb5a5fb..dc28587b47d 100644
--- a/etc/refcards/orgcard.tex
+++ b/etc/refcards/orgcard.tex
@@ -1,5 +1,5 @@
% Reference Card for Org Mode
-\def\orgversionnumber{9.3}
+\def\orgversionnumber{9.4.2}
\def\versionyear{2019} % latest update
\input emacsver.tex
@@ -17,7 +17,7 @@
\pdflayout=(0l)
% Nothing else needs to be changed below this line.
-% Copyright (C) 1987, 1993, 1996--1997, 2001--2020 Free Software
+% Copyright (C) 1987, 1993, 1996--1997, 2001--2021 Free Software
% Foundation, Inc.
% This document is free software: you can redistribute it and/or modify
@@ -79,6 +79,9 @@
\centerline{Released under the terms of the GNU General Public License}
\centerline{version 3 or later.}
+\centerline{For more Emacs documentation, and the \TeX{} source for this card, see}
+\centerline{the Emacs distribution, or {\tt https://www.gnu.org/software/emacs}}
+
\endgroup}
% make \bye not \outer so that the \def\bye in the \else clause below
@@ -515,7 +518,7 @@ after ``{\tt :}'', and dictionary words elsewhere.
\key{special commands in property lines}{C-c C-c}
\key{next/previous allowed value}{S-LEFT/RIGHT}
\key{turn on column view}{C-c C-x C-c}
-\key{capture columns view in dynamic block}{C-c C-x i}
+\key{capture columns view in dynamic block}{C-c C-x x}
\key{quit column view}{q}
\key{show full value}{v}
@@ -558,7 +561,7 @@ after ``{\tt :}'', and dictionary words elsewhere.
\key{stop/cancel clock on current item}{C-c C-x C-o/x}
\key{display total subtree times}{C-c C-x C-d}
\key{remove displayed times}{C-c C-c}
-\key{insert/update table with clock report}{C-c C-x C-r}
+\key{insert/update table with clock report}{C-c C-x C-x}
\section{Agenda Views}
diff --git a/etc/refcards/pdflayout.sty b/etc/refcards/pdflayout.sty
index de7738c4fbd..91e67b109df 100644
--- a/etc/refcards/pdflayout.sty
+++ b/etc/refcards/pdflayout.sty
@@ -1,4 +1,4 @@
-% Copyright (C) 2007-2020 Free Software Foundation, Inc.
+% Copyright (C) 2007-2021 Free Software Foundation, Inc.
% This file is part of GNU Emacs.
diff --git a/etc/refcards/pl-refcard.tex b/etc/refcards/pl-refcard.tex
index 2b92fb5545d..b31b4270ab4 100644
--- a/etc/refcards/pl-refcard.tex
+++ b/etc/refcards/pl-refcard.tex
@@ -1,7 +1,7 @@
%&mex
% Reference Card for GNU Emacs
-% Copyright (C) 1999, 2001--2020 Free Software Foundation, Inc.
+% Copyright (C) 1999, 2001--2021 Free Software Foundation, Inc.
% Author: Stephen Gildea <stepheng+emacs@gildea.com>
% Polish translation: Włodek Bzyl <matwb@univ.gda.pl>
diff --git a/etc/refcards/pt-br-refcard.tex b/etc/refcards/pt-br-refcard.tex
index d4e3123458f..2d6680f7931 100644
--- a/etc/refcards/pt-br-refcard.tex
+++ b/etc/refcards/pt-br-refcard.tex
@@ -1,6 +1,6 @@
% Reference Card for GNU Emacs
-% Copyright (C) 1987, 1993, 1996--1997, 2002--2004, 2006--2020 Free
+% Copyright (C) 1987, 1993, 1996--1997, 2002--2004, 2006--2021 Free
% Software Foundation, Inc.
% Author: Stephen Gildea <stepheng+emacs@gildea.com>
diff --git a/etc/refcards/refcard.tex b/etc/refcards/refcard.tex
index 6cac28fabbb..f7b5da40b05 100644
--- a/etc/refcards/refcard.tex
+++ b/etc/refcards/refcard.tex
@@ -1,6 +1,6 @@
% Reference Card for GNU Emacs
-% Copyright (C) 1987, 1993, 1996--1997, 2001--2020 Free Software
+% Copyright (C) 1987, 1993, 1996--1997, 2001--2021 Free Software
% Foundation, Inc.
% Author: Stephen Gildea <stepheng+emacs@gildea.com>
diff --git a/etc/refcards/ru-refcard.tex b/etc/refcards/ru-refcard.tex
index 165c00d309c..179be0af885 100644
--- a/etc/refcards/ru-refcard.tex
+++ b/etc/refcards/ru-refcard.tex
@@ -1,4 +1,4 @@
-% Copyright (C) 1997, 2002--2020 Free Software Foundation, Inc.
+% Copyright (C) 1997, 2002--2021 Free Software Foundation, Inc.
% Author: Stephen Gildea <stepheng+emacs@gildea.com>
% Russian translation: Alex Ott <alexott@gmail.com>
@@ -41,7 +41,7 @@
\setlength{\ColThreeWidth}{25mm}
\newcommand{\versionemacs}[0]{28} % version of Emacs this is for
-\newcommand{\cyear}[0]{2020} % copyright year
+\newcommand{\cyear}[0]{2021} % copyright year
\newcommand\shortcopyrightnotice[0]{\vskip 1ex plus 2 fill
\centerline{\footnotesize \copyright\ \cyear\ Free Software Foundation, Inc.
diff --git a/etc/refcards/sk-dired-ref.tex b/etc/refcards/sk-dired-ref.tex
index 294c0e5cbe0..04db4e3fe83 100644
--- a/etc/refcards/sk-dired-ref.tex
+++ b/etc/refcards/sk-dired-ref.tex
@@ -1,6 +1,6 @@
% Reference Card for Dired -*- coding: utf-8 -*-
-% Copyright (C) 2000--2020 Free Software Foundation, Inc.
+% Copyright (C) 2000--2021 Free Software Foundation, Inc.
% Author: Evgeny Roubinchtein <eroubinc@u.washington.edu>
% Czech translation: Pavel Janík <Pavel@Janik.cz>, March 2001
diff --git a/etc/refcards/sk-refcard.tex b/etc/refcards/sk-refcard.tex
index b232ea8edf8..bda808f232b 100644
--- a/etc/refcards/sk-refcard.tex
+++ b/etc/refcards/sk-refcard.tex
@@ -1,6 +1,6 @@
% Reference Card for GNU Emacs -*- coding: utf-8 -*-
-% Copyright (C) 1987, 1993, 1996--1997, 2001--2020 Free Software
+% Copyright (C) 1987, 1993, 1996--1997, 2001--2021 Free Software
% Foundation, Inc.
% Author: Stephen Gildea <stepheng+emacs@gildea.com>
diff --git a/etc/refcards/sk-survival.tex b/etc/refcards/sk-survival.tex
index 8e5d85f4d39..9bf591a794e 100644
--- a/etc/refcards/sk-survival.tex
+++ b/etc/refcards/sk-survival.tex
@@ -1,6 +1,6 @@
% Title: GNU Emacs Survival Card -*- coding: utf-8 -*-
-% Copyright (C) 2000--2020 Free Software Foundation, Inc.
+% Copyright (C) 2000--2021 Free Software Foundation, Inc.
% Author: Włodek Bzyl <matwb@univ.gda.pl>
% Czech translation: Pavel Janík <Pavel@Janik.cz>, March 2001
diff --git a/etc/refcards/survival.tex b/etc/refcards/survival.tex
index 24204e52006..a5cd9b7e116 100644
--- a/etc/refcards/survival.tex
+++ b/etc/refcards/survival.tex
@@ -1,7 +1,7 @@
%&tex
% Title: GNU Emacs Survival Card
-% Copyright (C) 2000--2020 Free Software Foundation, Inc.
+% Copyright (C) 2000--2021 Free Software Foundation, Inc.
% Author: Włodek Bzyl <matwb@univ.gda.pl>
diff --git a/etc/refcards/vipcard.tex b/etc/refcards/vipcard.tex
index b55612b1a87..c62988a0506 100644
--- a/etc/refcards/vipcard.tex
+++ b/etc/refcards/vipcard.tex
@@ -1,6 +1,6 @@
% Quick Reference Card for VIP
-% Copyright (C) 1987, 2001--2020 Free Software Foundation, Inc.
+% Copyright (C) 1987, 2001--2021 Free Software Foundation, Inc.
% Author: Masahiko Sato <ms@sail.stanford.edu>, <masahiko@sato.riec.tohoku.junet>
diff --git a/etc/refcards/viperCard.tex b/etc/refcards/viperCard.tex
index 6476563bb45..24be19f14d3 100644
--- a/etc/refcards/viperCard.tex
+++ b/etc/refcards/viperCard.tex
@@ -1,6 +1,6 @@
% ViperCard -- The Reference Card for Viper under GNU Emacs
-% Copyright (C) 1995--1997, 2001--2020 Free Software Foundation, Inc.
+% Copyright (C) 1995--1997, 2001--2021 Free Software Foundation, Inc.
% Author: Michael Kifer <kifer@cs.stonybrook.edu> (Viper)
% Aamod Sane <sane@cs.uiuc.edu> (VIP 4.3)
diff --git a/etc/schema/locate.rnc b/etc/schema/locate.rnc
index d651c8291e3..697d1db11e9 100644
--- a/etc/schema/locate.rnc
+++ b/etc/schema/locate.rnc
@@ -1,4 +1,4 @@
-# Copyright (C) 2003-2004, 2007-2020 Free Software Foundation, Inc.
+# Copyright (C) 2003-2004, 2007-2021 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
diff --git a/etc/schema/relaxng.rnc b/etc/schema/relaxng.rnc
index 96efe9c08e1..d3a9d96617b 100644
--- a/etc/schema/relaxng.rnc
+++ b/etc/schema/relaxng.rnc
@@ -1,6 +1,6 @@
# RELAX NG XML syntax expressed in RELAX NG Compact syntax.
-# Copyright (C) 2003-2004, 2007-2020 Free Software Foundation, Inc.
+# Copyright (C) 2003-2004, 2007-2021 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
diff --git a/etc/schema/schemas.xml b/etc/schema/schemas.xml
index 40175b056b1..7fd91b8c72e 100644
--- a/etc/schema/schemas.xml
+++ b/etc/schema/schemas.xml
@@ -1,5 +1,5 @@
<?xml version="1.0"?>
-<!-- Copyright (C) 2003-2004, 2007-2020 Free Software Foundation, Inc.
+<!-- Copyright (C) 2003-2004, 2007-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/etc/ses-example.ses b/etc/ses-example.ses
index 2f65d1fa5d4..f73fbfba707 100644
--- a/etc/ses-example.ses
+++ b/etc/ses-example.ses
@@ -205,7 +205,7 @@ Sales summary - Acme fundraising
;;; ses--symbolic-formulas: (("Eastern area") ("West-district") ("North&South") ("Other"))
;;; End:
-;;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
+;;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;;; COPYING PERMISSIONS:
;;;
diff --git a/etc/srecode/c.srt b/etc/srecode/c.srt
index 0942e31cc92..753d1ee01b1 100644
--- a/etc/srecode/c.srt
+++ b/etc/srecode/c.srt
@@ -1,6 +1,6 @@
;;; c.srt --- SRecode templates for c-mode
-;; Copyright (C) 2007-2010, 2012-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2010, 2012-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/etc/srecode/cpp.srt b/etc/srecode/cpp.srt
index aa3bec23829..3d1f9cbf92d 100644
--- a/etc/srecode/cpp.srt
+++ b/etc/srecode/cpp.srt
@@ -1,6 +1,6 @@
;;; cpp.srt --- SRecode templates for c++-mode
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/etc/srecode/default.srt b/etc/srecode/default.srt
index 8df64e0d46e..0dff66187e6 100644
--- a/etc/srecode/default.srt
+++ b/etc/srecode/default.srt
@@ -1,6 +1,6 @@
;;; default.srt --- SRecode templates for srecode-template-mode
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/etc/srecode/doc-cpp.srt b/etc/srecode/doc-cpp.srt
index ecda96a740d..0de05ff15c2 100644
--- a/etc/srecode/doc-cpp.srt
+++ b/etc/srecode/doc-cpp.srt
@@ -1,6 +1,6 @@
;; doc-c.srt --- SRecode templates for "document" applications
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/etc/srecode/doc-default.srt b/etc/srecode/doc-default.srt
index 56a0ae0a4e3..4fc00ddf9e9 100644
--- a/etc/srecode/doc-default.srt
+++ b/etc/srecode/doc-default.srt
@@ -1,6 +1,6 @@
;; doc-default.srt --- SRecode templates for "document" applications
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/etc/srecode/doc-java.srt b/etc/srecode/doc-java.srt
index 17086bc483e..b7eb0dbf2c3 100644
--- a/etc/srecode/doc-java.srt
+++ b/etc/srecode/doc-java.srt
@@ -1,6 +1,6 @@
;; doc-java.srt --- SRecode templates for "document" applications
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/etc/srecode/ede-autoconf.srt b/etc/srecode/ede-autoconf.srt
index 197a2719911..042c05aa63a 100644
--- a/etc/srecode/ede-autoconf.srt
+++ b/etc/srecode/ede-autoconf.srt
@@ -1,6 +1,6 @@
;;; ede/templates/autoconf.srt --- Templates for autoconf used by EDE
-;; Copyright (C) 2010, 2012-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010, 2012-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/etc/srecode/ede-make.srt b/etc/srecode/ede-make.srt
index 259a001e284..ba380e40903 100644
--- a/etc/srecode/ede-make.srt
+++ b/etc/srecode/ede-make.srt
@@ -1,6 +1,6 @@
;; ede-make.srt --- SRecode templates for Makefiles used by EDE.
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/etc/srecode/el.srt b/etc/srecode/el.srt
index 7d5c64c86c0..a366434c3eb 100644
--- a/etc/srecode/el.srt
+++ b/etc/srecode/el.srt
@@ -1,6 +1,6 @@
;;; el.srt --- SRecode templates for Emacs Lisp mode
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/etc/srecode/getset-cpp.srt b/etc/srecode/getset-cpp.srt
index 16c9d5f31bd..af27cb2e8cb 100644
--- a/etc/srecode/getset-cpp.srt
+++ b/etc/srecode/getset-cpp.srt
@@ -1,6 +1,6 @@
;;; getset-cpp.srt --- SRecode templates for C++ class getter/setters.
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/etc/srecode/java.srt b/etc/srecode/java.srt
index 5ff0de3566e..5d8ce88b567 100644
--- a/etc/srecode/java.srt
+++ b/etc/srecode/java.srt
@@ -1,6 +1,6 @@
;; java.srt
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/etc/srecode/make.srt b/etc/srecode/make.srt
index eb486827430..f83ecf9e125 100644
--- a/etc/srecode/make.srt
+++ b/etc/srecode/make.srt
@@ -1,6 +1,6 @@
;; make.srt
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/etc/srecode/proj-test.srt b/etc/srecode/proj-test.srt
index 65ee9797e19..6825c6b8370 100644
--- a/etc/srecode/proj-test.srt
+++ b/etc/srecode/proj-test.srt
@@ -1,6 +1,6 @@
;; proj-test.srt --- SRecode template for testing project scoping.
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/etc/srecode/template.srt b/etc/srecode/template.srt
index ac97c14b9e7..5820b1d756c 100644
--- a/etc/srecode/template.srt
+++ b/etc/srecode/template.srt
@@ -1,6 +1,6 @@
;;; template.srt --- Templates for Semantic Recoders
-;; Copyright (C) 2005, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2005, 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/etc/srecode/test.srt b/etc/srecode/test.srt
index a9d706677cf..581c295383a 100644
--- a/etc/srecode/test.srt
+++ b/etc/srecode/test.srt
@@ -1,6 +1,6 @@
;; test.srt --- SRecode templates for testing
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/etc/srecode/texi.srt b/etc/srecode/texi.srt
index 243a53f52b4..cc4c50c780c 100644
--- a/etc/srecode/texi.srt
+++ b/etc/srecode/texi.srt
@@ -1,6 +1,6 @@
;; texi.srt --- SRecode templates for Texinfo
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/etc/srecode/wisent.srt b/etc/srecode/wisent.srt
index 445152d51eb..4e8f61bd091 100644
--- a/etc/srecode/wisent.srt
+++ b/etc/srecode/wisent.srt
@@ -1,6 +1,6 @@
;; wisent.srt --- SRecode templates for Emacs/WISENT grammar files.
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/etc/themes/adwaita-theme.el b/etc/themes/adwaita-theme.el
index 67a3b11763c..c98bec6cfa5 100644
--- a/etc/themes/adwaita-theme.el
+++ b/etc/themes/adwaita-theme.el
@@ -1,6 +1,6 @@
;;; adwaita-theme.el --- Tango-based custom theme for faces -*- lexical-binding:t -*-
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: William Stevenson <yhvh2000@gmail.com>
diff --git a/etc/themes/deeper-blue-theme.el b/etc/themes/deeper-blue-theme.el
index 2557918ed7e..cfe8a5bfb28 100644
--- a/etc/themes/deeper-blue-theme.el
+++ b/etc/themes/deeper-blue-theme.el
@@ -1,6 +1,6 @@
;;; deeper-blue-theme.el --- Custom theme for faces -*- lexical-binding:t -*-
-;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
;; Author: Scott Frazer <frazer.scott@gmail.com>
diff --git a/etc/themes/dichromacy-theme.el b/etc/themes/dichromacy-theme.el
index 89b5a4e4525..09f4454f9b1 100644
--- a/etc/themes/dichromacy-theme.el
+++ b/etc/themes/dichromacy-theme.el
@@ -1,6 +1,6 @@
;;; dichromacy-theme.el --- color theme suitable for color-blind users -*- lexical-binding:t -*-
-;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
;; Author: Chong Yidong <cyd@stupidchicken>
diff --git a/etc/themes/leuven-theme.el b/etc/themes/leuven-theme.el
index f104c845ff6..f643dd560cf 100644
--- a/etc/themes/leuven-theme.el
+++ b/etc/themes/leuven-theme.el
@@ -1,6 +1,6 @@
;;; leuven-theme.el --- Awesome Emacs color theme on white background -*- lexical-binding:t -*-
-;; Copyright (C) 2003-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
;; Author: Fabrice Niessen <(concat "fniessen" at-sign "pirilampo.org")>
;; URL: https://github.com/fniessen/emacs-leuven-theme
diff --git a/etc/themes/light-blue-theme.el b/etc/themes/light-blue-theme.el
index c6d3c92bce7..62528856da0 100644
--- a/etc/themes/light-blue-theme.el
+++ b/etc/themes/light-blue-theme.el
@@ -1,6 +1,6 @@
;;; light-blue-theme.el --- Custom theme for faces -*- lexical-binding:t -*-
-;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
;; Author: Drew Adams <drew.adams@oracle.com>
diff --git a/etc/themes/manoj-dark-theme.el b/etc/themes/manoj-dark-theme.el
index 195d40d7af6..1f4891c3168 100644
--- a/etc/themes/manoj-dark-theme.el
+++ b/etc/themes/manoj-dark-theme.el
@@ -1,6 +1,6 @@
;;; manoj-dark.el --- A dark theme from Manoj -*- lexical-binding:t -*-
-;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
;; Author: Manoj Srivastava <srivasta@ieee.org>
;; Keywords: lisp, faces
diff --git a/etc/themes/misterioso-theme.el b/etc/themes/misterioso-theme.el
index ff9af0c7440..e7a66c5650d 100644
--- a/etc/themes/misterioso-theme.el
+++ b/etc/themes/misterioso-theme.el
@@ -1,6 +1,6 @@
;;; misterioso-theme.el --- Custom face theme for Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
;; Author: Sebastian Hermida
diff --git a/etc/themes/modus-operandi-theme.el b/etc/themes/modus-operandi-theme.el
index db61c97b766..c7a0f72c103 100644
--- a/etc/themes/modus-operandi-theme.el
+++ b/etc/themes/modus-operandi-theme.el
@@ -1,6 +1,6 @@
;;; modus-operandi-theme.el --- Accessible light theme (WCAG AAA) -*- lexical-binding:t -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; Author: Protesilaos Stavrou <info@protesilaos.com>
;; URL: https://gitlab.com/protesilaos/modus-themes
diff --git a/etc/themes/modus-vivendi-theme.el b/etc/themes/modus-vivendi-theme.el
index d45c3ca2eed..6e71e8d8e3a 100644
--- a/etc/themes/modus-vivendi-theme.el
+++ b/etc/themes/modus-vivendi-theme.el
@@ -1,6 +1,6 @@
;;; modus-vivendi-theme.el --- Accessible dark theme (WCAG AAA) -*- lexical-binding:t -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; Author: Protesilaos Stavrou <info@protesilaos.com>
;; URL: https://gitlab.com/protesilaos/modus-themes
diff --git a/etc/themes/tango-dark-theme.el b/etc/themes/tango-dark-theme.el
index cf1a98bfee2..a8577108ed3 100644
--- a/etc/themes/tango-dark-theme.el
+++ b/etc/themes/tango-dark-theme.el
@@ -1,6 +1,6 @@
;;; tango-dark-theme.el --- Tango-based custom theme for faces -*- lexical-binding:t -*-
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Authors: Chong Yidong <cyd@stupidchicken>
;; Jan Moringen <jan.moringen@uni-bielefeld.de>
diff --git a/etc/themes/tango-theme.el b/etc/themes/tango-theme.el
index 6166657c145..286561eb4e2 100644
--- a/etc/themes/tango-theme.el
+++ b/etc/themes/tango-theme.el
@@ -1,6 +1,6 @@
;;; tango-theme.el --- Tango-based custom theme for faces -*- lexical-binding:t -*-
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Authors: Chong Yidong <cyd@stupidchicken>
;; Jan Moringen <jan.moringen@uni-bielefeld.de>
diff --git a/etc/themes/tsdh-dark-theme.el b/etc/themes/tsdh-dark-theme.el
index f3c9ced5b03..62ed7c81dc0 100644
--- a/etc/themes/tsdh-dark-theme.el
+++ b/etc/themes/tsdh-dark-theme.el
@@ -1,6 +1,6 @@
;;; tsdh-dark-theme.el --- Tassilo's dark custom theme -*- lexical-binding:t -*-
-;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/etc/themes/tsdh-light-theme.el b/etc/themes/tsdh-light-theme.el
index 46443edfd49..481a8f3733b 100644
--- a/etc/themes/tsdh-light-theme.el
+++ b/etc/themes/tsdh-light-theme.el
@@ -1,6 +1,6 @@
;;; tsdh-light-theme.el --- Tassilo's light custom theme -*- lexical-binding:t -*-
-;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/etc/themes/wheatgrass-theme.el b/etc/themes/wheatgrass-theme.el
index f1abdb38952..162f7975150 100644
--- a/etc/themes/wheatgrass-theme.el
+++ b/etc/themes/wheatgrass-theme.el
@@ -1,6 +1,6 @@
;;; wheatgrass-theme.el --- custom theme for faces -*- lexical-binding:t -*-
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/etc/themes/whiteboard-theme.el b/etc/themes/whiteboard-theme.el
index ee42e4f2155..729c082a331 100644
--- a/etc/themes/whiteboard-theme.el
+++ b/etc/themes/whiteboard-theme.el
@@ -1,6 +1,6 @@
;;; whiteboard-theme.el --- Custom theme for faces -*- lexical-binding:t -*-
-;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
;; Author: Scott Frazer <frazer.scott@gmail.com>
diff --git a/etc/themes/wombat-theme.el b/etc/themes/wombat-theme.el
index 4df5f5a3f1c..aaa7cceaf68 100644
--- a/etc/themes/wombat-theme.el
+++ b/etc/themes/wombat-theme.el
@@ -1,6 +1,6 @@
;;; wombat-theme.el --- Custom face theme for Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
;; Author: Kristoffer Grönlund <krig@koru.se>
diff --git a/etc/tutorials/TUTORIAL b/etc/tutorials/TUTORIAL
index 319ba52b670..6194e55ea35 100644
--- a/etc/tutorials/TUTORIAL
+++ b/etc/tutorials/TUTORIAL
@@ -1,13 +1,13 @@
Emacs tutorial. See end for copying conditions.
-Emacs commands generally involve the CONTROL key (sometimes labeled
-CTRL or CTL) or the META key (sometimes labeled EDIT or ALT). Rather than
-write that in full each time, we'll use the following abbreviations:
+Emacs commands generally involve the CONTROL key (often labeled CTRL)
+or the META key (usually labeled ALT). Rather than writing that
+in full each time, we'll use the following abbreviations:
C-<chr> means hold the CONTROL key while typing the character <chr>
Thus, C-f would be: hold the CONTROL key and type f.
- M-<chr> means hold the META or EDIT or ALT key down while typing <chr>.
- If there is no META, EDIT or ALT key, instead press and release the
+ M-<chr> means hold the META or ALT key down while typing <chr>.
+ If there is no META or ALT key, instead press and release the
ESC key and then type <chr>. We write <ESC> for the ESC key.
Important note: to end the Emacs session, type C-x C-c. (Two characters.)
@@ -33,7 +33,7 @@ that is called "editing" and that's what Emacs is for.
The first thing that you need to know is how to move around from place
to place in the text. You already know how to move forward one screen,
with C-v. To move backwards one screen, type M-v (hold down the META key
-and type v, or type <ESC>v if you do not have a META, EDIT, or ALT key).
+and type v, or type <ESC>v if you do not have a META or ALT key).
>> Try typing M-v and then C-v, a few times.
@@ -196,7 +196,7 @@ easily learn to use other advanced cursor motion commands as well.
Most Emacs commands accept a numeric argument; for most commands, this
serves as a repeat-count. The way you give a command a repeat count
is by typing C-u and then the digits before you type the command. If
-you have a META (or EDIT or ALT) key, there is another, alternative way
+you have a META (or ALT) key, there is another, alternative way
to enter a numeric argument: type the digits while holding down the
META key. We recommend learning the C-u method because it works on
any terminal. The numeric argument is also called a "prefix argument",
@@ -676,7 +676,7 @@ another in the buffer. When you type M-x, Emacs prompts you at the
bottom of the screen with M-x and you should type the name of the
command; in this case, "replace-string". Just type "repl s<TAB>" and
Emacs will complete the name. (<TAB> is the Tab key, usually found
-above the CapsLock or Shift key near the left edge of the keyboard.)
+above the Caps Lock or Shift key near the left edge of the keyboard.)
Submit the command name with <Return>.
The replace-string command requires two arguments--the string to be
@@ -1024,7 +1024,7 @@ very brief documentation--sufficient to remind you of commands you
have already learned.
Multi-character commands such as C-x C-s and <ESC>v (instead of M-v,
-if you have no META or EDIT or ALT key) are also allowed after C-h c.
+if you have no META or ALT key) are also allowed after C-h c.
To get more information about a command, use C-h k instead of C-h c.
@@ -1117,7 +1117,7 @@ starting with the one written by Stuart Cracraft for the original Emacs.
This version of the tutorial is a part of GNU Emacs. It is copyrighted
and comes with permission to distribute copies on certain conditions:
- Copyright (C) 1985, 1996, 1998, 2001-2020 Free Software Foundation,
+ Copyright (C) 1985, 1996, 1998, 2001-2021 Free Software Foundation,
Inc.
This file is part of GNU Emacs.
diff --git a/etc/tutorials/TUTORIAL.bg b/etc/tutorials/TUTORIAL.bg
index 381c66ffda3..3391e9b32e2 100644
--- a/etc/tutorials/TUTORIAL.bg
+++ b/etc/tutorials/TUTORIAL.bg
@@ -1162,7 +1162,7 @@ Dired ви позволява да гледате списъка от файло
This version of the tutorial, like GNU Emacs, is copyrighted, and
comes with permission to distribute copies on certain conditions:
- Copyright (C) 1985, 1996, 1998, 2001-2020 Free Software Foundation,
+ Copyright (C) 1985, 1996, 1998, 2001-2021 Free Software Foundation,
Inc.
This file is part of GNU Emacs.
diff --git a/etc/tutorials/TUTORIAL.cn b/etc/tutorials/TUTORIAL.cn
index e7fb9e58462..742de090da8 100644
--- a/etc/tutorials/TUTORIAL.cn
+++ b/etc/tutorials/TUTORIAL.cn
@@ -997,7 +997,7 @@ starting with the one written by Stuart Cracraft for the original Emacs.
This version of the tutorial is a part of GNU Emacs. It is copyrighted
and comes with permission to distribute copies on certain conditions:
- Copyright (C) 1985, 1996, 1998, 2001-2020 Free Software Foundation,
+ Copyright (C) 1985, 1996, 1998, 2001-2021 Free Software Foundation,
Inc.
This file is part of GNU Emacs.
@@ -1026,7 +1026,7 @@ using, writing, and sharing free software!
本篇指南是 GNU Emacs 的一部分,并允许在下列条件的约束下发行其拷贝:
- Copyright (C) 1985, 1996, 1998, 2001-2020 Free Software Foundation,
+ Copyright (C) 1985, 1996, 1998, 2001-2021 Free Software Foundation,
Inc.
本文件为 GNU Emacs 的一部分。
diff --git a/etc/tutorials/TUTORIAL.cs b/etc/tutorials/TUTORIAL.cs
index 161f6244d83..12c0d1e5cad 100644
--- a/etc/tutorials/TUTORIAL.cs
+++ b/etc/tutorials/TUTORIAL.cs
@@ -1015,7 +1015,7 @@ tutoriálem napsaným Stuartem Cracraftem pro původní Emacs.
Tato verze tutoriálu je, podobně jako GNU Emacs, chráněna copyrightem a
je šířena se svolením distribuovat kopie za jistých podmínek:
-Copyright (C) 1985, 1996, 1998, 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 1985, 1996, 1998, 2001-2021 Free Software Foundation, Inc.
Každému je zaručeno právo vytvářet a distribuovat přesné kopie tohoto
dokumentu tak, jak jej obdržel, na jakémkoliv médiu, s tím, že bude
diff --git a/etc/tutorials/TUTORIAL.de b/etc/tutorials/TUTORIAL.de
index ae58fc9a44b..7793094dc06 100644
--- a/etc/tutorials/TUTORIAL.de
+++ b/etc/tutorials/TUTORIAL.de
@@ -1,8 +1,8 @@
Einführung in Emacs. Siehe Dateiende für Vervielfältigungsbedingungen.
Emacs-Befehle beinhalten im allgemeinen die CONTROL-Taste (manchmal
-auch als CTRL, CTL oder STRG beschriftet) sowie die META-Taste (auch
-EDIT oder ALT genannt). Folgende Abkürzungen werden verwendet:
+auch als CTRL oder STRG beschriftet) sowie die META-Taste (oft
+ALT genannt). Folgende Abkürzungen werden verwendet:
C-<Zeichen> bedeutet, dass die CONTROL-Taste gedrückt sein muss,
während man das Zeichen <Zeichen> eingibt. Beispiel:
@@ -264,7 +264,7 @@ Die meisten Emacs-Befehle akzeptieren ein numerisches Argument, das in
der Regel als Wiederholungszähler dient (d.h., wie oft der Befehl
ausgeführt werden soll). Eingegeben wird diese Zahl mit C-u, dann die
Ziffern und dann der Befehl selbst. Alternativ können Sie die
-META-Taste (bzw. EDIT- oder ALT-Taste) gedrückt halten und dann die
+META-Taste (oder ALT-Taste) gedrückt halten und dann die
Ziffern des Wiederholungszählers eingeben. Wir empfehlen allerdings,
die C-u-Methode zu lernen, da sie mit jedem Terminal funktioniert.
Das numerische Argument wird auch »Präfix-Argument« genannt, da man es
@@ -1488,7 +1488,7 @@ Beachten Sie bitte, dass im Zweifelsfalle das englische Original
dieser Urheberrechtsnotiz gültig ist (zu finden in der Datei
TUTORIAL).
- Copyright (C) 1985, 1996-1997, 2001-2020 Free Software Foundation,
+ Copyright (C) 1985, 1996-1997, 2001-2021 Free Software Foundation,
Inc.
Diese Datei ist ein Bestandteil von GNU Emacs.
diff --git a/etc/tutorials/TUTORIAL.eo b/etc/tutorials/TUTORIAL.eo
index ef3cf54b81c..a1490cb99b2 100644
--- a/etc/tutorials/TUTORIAL.eo
+++ b/etc/tutorials/TUTORIAL.eo
@@ -1081,7 +1081,7 @@ la dosiero verkita de Stuart Cracraft por la originala Emakso.
kopirajton, kaj venas kun permeso por disdoni kopiojn se certaj
kondiĉoj estas observataj:
- Copyright (C) 1985, 1999, 2001-2002, 2005, 2007-2020 Free Software
+ Copyright (C) 1985, 1999, 2001-2002, 2005, 2007-2021 Free Software
Foundation, Inc.
Ĉi tiu dosiero estas parto de "GNU Emacs".
diff --git a/etc/tutorials/TUTORIAL.es b/etc/tutorials/TUTORIAL.es
index 66ff3c34c13..786a9f4130d 100644
--- a/etc/tutorials/TUTORIAL.es
+++ b/etc/tutorials/TUTORIAL.es
@@ -2,16 +2,16 @@ Tutorial de Emacs. Vea al final las condiciones de copiado.
Generalmente los comandos de Emacs involucran la tecla CONTROL
(algunas veces llamada CTRL O CTL) o la tecla meta (algunas veces
-llamada EDIT o ALT). En lugar de escribir completamente esto en cada
+llamada ALT). En lugar de escribir completamente esto en cada
ocasión, usaremos las siguientes abreviaturas.
C-<car> significa mantener presionada la tecla CONTROL mientras
teclea el carácter <car>. Por lo tanto C-f será: Mantenga
presionada la tecla CONTROL y teclee f.
- M-<car> significa mantener presionada la tecla META o EDIT o ALT
- mientras teclea <car>. Si no hay teclas META, EDIT o ALT, en
- su lugar presione y libere la tecla ESC y luego teclee
- <car>. Escribimos <ESC> para referirnos a la tecla ESC.
+ M-<car> significa mantener presionada la tecla META o ALT mientras
+ teclea <car>. Si no hay teclas META o ALT, en su lugar
+ presione y libere la tecla ESC y luego teclee <car>.
+ Escribimos <ESC> para referirnos a la tecla ESC.
Nota importante: para terminar la sesión de Emacs teclee C-x C-c (dos
caracteres). Para cancelar un comando parcialmente introducido,
@@ -32,7 +32,7 @@ texto.
Lo primero que necesita saber es cómo moverse de un lugar a otro en el
texto. Ya sabe cómo avanzar una pantalla, con C-v. Para retroceder
una pantalla teclee M-v (mantenga oprimida la tecla META y teclee v, o
-teclee <ESC>v si no tiene las teclas META, EDIT o ALT).
+teclee <ESC>v si no tiene las teclas META o ALT).
>> Intente teclear M-v y luego C-v, varias veces.
@@ -203,12 +203,12 @@ La mayoría de comandos de Emacs aceptan un argumento numérico; para la
mayoría de comandos esto sirve como un factor de repetición. La
manera de pasarle un factor de repetición a un comando es tecleando
C-u y luego los dígitos antes de introducir los comandos. Si tiene
-una tecla META (o EDIT o ALT), hay una manera alternativa para
-ingresar un argumento numérico: teclear los dígitos mientras presiona
-la tecla META. Recomendamos aprender el método C-u porque éste
-funciona en cualquier terminal. El argumento numérico es también
-llamado un «argumento prefijo», porque usted teclea el argumento antes
-del comando al que se aplica.
+una tecla META (o ALT), hay una manera alternativa para ingresar un
+argumento numérico: teclear los dígitos mientras presiona la tecla
+META. Recomendamos aprender el método C-u porque éste funciona en
+cualquier terminal. El argumento numérico es también llamado un
+«argumento prefijo», porque usted teclea el argumento antes del
+comando al que se aplica.
Por ejemplo, C-u 8 C-f mueve hacia adelante ocho caracteres.
@@ -1075,8 +1075,8 @@ como una breve documentación: suficiente para recordarle los comandos
que ha aprendido.
Los comandos de múltiples caracteres tales como C-x C-s y (si no tiene
-las teclas META o EDIT o ALT) <ESC>v también están permitidos después
-de C-h c.
+las teclas META o ALT) <ESC>v también están permitidos después de
+C-h c.
Para conseguir más información sobre un comando use C-h k en vez de
C-h c.
@@ -1204,7 +1204,7 @@ Por favor, en caso de duda, solo es válido el original en inglés de la
siguiente nota de derechos de reproducción (que puede encontrar en el
archivo TUTORIAL).
-Copyright (C) 1985, 1996, 1998, 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 1985, 1996, 1998, 2001-2021 Free Software Foundation, Inc.
Se permite a cualquiera hacer o distribuir copias literales de este
documento como se recibe, en cualquier medio, siempre que la nota
diff --git a/etc/tutorials/TUTORIAL.fr b/etc/tutorials/TUTORIAL.fr
index 3148c3f07e7..3c1d87cda03 100644
--- a/etc/tutorials/TUTORIAL.fr
+++ b/etc/tutorials/TUTORIAL.fr
@@ -1,13 +1,13 @@
Didacticiel d'Emacs. Voir la fin de ce document pour les conditions.
Les commandes Emacs utilisent généralement la touche CONTROLE (souvent
-désignée par CTRL ou CTL) ou la touche META (souvent désignée par EDIT
-ou ALT). Pour ces touches, nous utiliserons les abréviations suivantes :
+désignée par CTRL) ou la touche META (plus souvent désignée par ALT).
+Pour ces touches, nous utiliserons les abréviations suivantes :
C-<car> signifie qu'il faut maintenir la touche CONTROLE appuyée tout
en tapant le caractère <car>. Ainsi, C-f signifie : presser
sur la touche CONTROLE tout en pressant la touche f.
- M-<car> signifie qu'il faut maintenir la touche META ou EDIT ou ALT
+ M-<car> signifie qu'il faut maintenir la touche META ou ALT
appuyée tout en tapant le caractère <car>. Si aucune de ces
touches n'existe, pressez puis relâchez la touche ESC et
tapez <car>. Nous écrirons <ESC> pour désigner la touche ESC.
@@ -31,7 +31,7 @@ La première chose que vous devez savoir est comment vous déplacer à
travers le texte. Vous savez déjà comment avancer d'un écran avec
C-v. Pour revenir un écran en arrière, tapez M-v (pressez la touche
META tout en appuyant sur v ou faites <ESC>v si vous n'avez pas de
-touche META, EDIT ou ALT).
+touche META ou ALT).
>> Faites M-v, puis C-v plusieurs fois.
@@ -208,7 +208,7 @@ La plupart des commandes Emacs acceptent un paramètre numérique qui,
la plupart du temps, indique un nombre de répétitions. Pour indiquer à
une commande le nombre de fois que l'on souhaite la répéter, on
utilise C-u suivi du nombre avant de taper la commande. Si vous avez
-une touche META (ou EDIT ou ALT), il existe une autre façon d'entrer
+une touche META (ou ALT), il existe une autre façon d'entrer
un paramètre numérique : tapez le nombre tout en pressant la touche
META. Nous vous conseillons d'apprendre à utiliser la méthode C-u car
elle fonctionne sur tous les types de terminaux. Le paramètre
@@ -1101,7 +1101,7 @@ suffisant pour vous rappeler les commandes que vous avez déjà
apprises.
Les commandes multi-caractères, comme C-x C-s et (si vous n'avez ni
-touche META, ni touche EDIT, ni touche ALT) <ESC>v sont également
+touche META, ni touche ALT) <ESC>v sont également
possibles après C-h c.
Pour obtenir plus d'informations sur une commande, faites C-h k au
@@ -1202,7 +1202,7 @@ Cette version du didacticiel, comme GNU Emacs, est placée sous
droit d'auteur, et vous pouvez en distribuer des copies sous certaines
conditions :
-Copyright (C) 1985, 1996, 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 1985, 1996, 2001-2021 Free Software Foundation, Inc.
Chacun peut créer ou distribuer des copies de ce document tel qu'il
l'a reçu, sur n'importe quel support, pourvu que la note de
diff --git a/etc/tutorials/TUTORIAL.he b/etc/tutorials/TUTORIAL.he
index 907da242804..5cd1cac8fd1 100644
--- a/etc/tutorials/TUTORIAL.he
+++ b/etc/tutorials/TUTORIAL.he
@@ -1,13 +1,13 @@
שיעור ראשון בשימוש ב־‫Emacs‬. זכויות שימוש ראה בסוף המסמך.
-פקודות רבות של Emacs משתמשות במקש CONTROL (לפעמים הוא מסומן ב־CTRL או CTL)
-או במקש META (לפעמים מסומן EDIT או ALT). במקום לציין את כל השמות האפשריים
+פקודות רבות של Emacs משתמשות במקש CONTROL (בדרך־כלל מסומן ב־CTRL)
+או במקש META (בדרך־כלל מסומן ALT). במקום לציין את כל השמות האפשריים
בכל פעם, נשתמש בקיצורים הבאים:
‏<תו>-C משמעותו לחץ והחזק מקש CONTROL ואז הקש על מקש <תו>.
לדוגמא, C-f משמעותו: לחץ והחזק CONTROL והקש על f.
-‏<תו>-M משמעותו לחץ והחזק מקש META או EDIT או ALT ואז הקש על מקש <תו>.
- אם במקלדת אין אף אחד ממקשי META או EDIT או ALT, אפשר להקיש
+‏<תו>-M משמעותו לחץ והחזק מקש META או ALT ואז הקש על מקש <תו>.
+ אם במקלדת אין אף אחד ממקשי META או ALT, אפשר להקיש
ולשחרר מקש ESC ואז להקיש <תו>. אנו נכתוב <ESC> עבור מקש ESC.
הערה חשובה: כדי לצאת מ־Emacs יש להקיש C-x C-c (שני תוים, משמאל לימין).
@@ -32,7 +32,7 @@ Emacs.
דבר ראשון שעליכם ללמוד הוא כיצד לנוע ממקום אחד למשנהו בתוך הטקסט. אתם
כבר יודעים כיצד להתקדם לעמוד הבא, עם C-v. לחזרה לעמוד הקודם הקישו M-v
(החזיקו מקש META והקישו v או הקישו ‪<ESC>v‬ אם אין במקלדת מקש META
-או EDIT או ALT).
+או ALT).
>> נסו עתה כמה פעמים להקיש M-v ואחר־כך C-v.
@@ -181,7 +181,7 @@ M-f עובר את המילה הבאה ונעצר בסופה. M-b פועל באו
רוב הפקודות של Emacs מקבלות ארגומנט נומרי; עבור רוב הפקודות הארגומנט
משמש כמונה של מספר החזרות על הפקודה. כדי לספק ארגומנט לפקודה, יש להקיש
C-u ואחר־כך ספרות, וזאת לפני שמקישים את הפקודה עצמה. עם במקלדת קיים
-מקש META (או EDIT או ALT), יש גם אפשרות אחרת לציין ארגומנט נומרי:
+מקש META (או ALT), יש גם אפשרות אחרת לציין ארגומנט נומרי:
הקישו את הספרות תוך כדי החזקת מקש META. אנו ממליצים על C-u משום שהוא
יעבוד עם כל מקלדת. הארגומנט הנומרי נקרא גם "ארגומנט קידומת" (prefix
argument) משום מקישים אותו לפני הפקודה אליה הוא מתייחס.
@@ -605,7 +605,7 @@ replace-string (החלף מחרוזת) אשר מחליפה מחרוזת אחת
אחרי שתקישו M-x, ‏Emacs מציג M-x בתחתית התצוגה ומחכה שתקישו את שם
הפקודה, במקרה זה "replace-string". מספיק שתקישו "repl s<TAB>‎" ו־Emacs
ישלים את השם המלא. (<TAB> הוא מקש Tab, בדרך כלל תמצאו אותו מעל מקש
-ה־CapsLock או Shift, ליד הקצה השמאלי של המקלדת.) סיימו את הזנת הפקודה
+ה־Caps Lock או Shift, ליד הקצה השמאלי של המקלדת.) סיימו את הזנת הפקודה
ע״י הקשת <Return>.
הפקודה להחלפת מחרוזת זקוקה לשני ארגומנטים -- המחרוזת שתוחלף וזו שתחליף
@@ -919,8 +919,7 @@ M-x help <Return>‎ כתחליף.)
לכם את הפקודות שלמדתם בעבר.
ניתן לציין אחרי C-h c גם פקודות שמופעלות ע״י סדרת מקשים באורך גדול
-מאחד, כגון C-x C-s או ‏‎<ESC> v (כתחליף ל־M-v, אם אין מקש META או EDIT
-או ALT).
+מאחד, כגון C-x C-s או ‏‎<ESC> v (כתחליף ל־M-v, אם אין מקש META או ALT).
לקבלת מידע מפורט יותר על פקודה, השתמשו בפקודה C-h k במקום C-h c.
@@ -1005,7 +1004,7 @@ find-file.
גירסה זו של השיעור הינה חלק מחבילת GNU Emacs. היא מוגנת בזכויות יוצרים
וניתנת להעתקה והפצת עותקים בתנאים מסויימים כדלקמן:
- Copyright (C) 2010-2020 Free Software Foundation, Inc.
+ Copyright (C) 2010-2021 Free Software Foundation, Inc.
‏GNU Emacs הינו תכנה חפשית; זכותכם להפיצו ו\או לשנותו בכפוף לתנאי
הרשיון GNU General Public License, כפי שהוא יוצא לאור ע״י Free
diff --git a/etc/tutorials/TUTORIAL.it b/etc/tutorials/TUTORIAL.it
index e19486ac876..ac5937930bf 100644
--- a/etc/tutorials/TUTORIAL.it
+++ b/etc/tutorials/TUTORIAL.it
@@ -1,18 +1,18 @@
Esercitazione di Emacs. Condizioni d'uso alla fine del file.
-I comandi di Emacs comportano generalmente l'uso del tasto CONTROL (a
-volte indicato con CTRL o CTL) o del tasto META (a volte indicato con
-EDIT o ALT). Piuttosto che indicarli per esteso ogni volta, useremo
+I comandi di Emacs comportano generalmente l'uso del tasto CONTROL
+(spesso indicato con CTRL) o del tasto META (di solito indicato con
+ALT). Piuttosto che indicarli per esteso ogni volta, useremo
le seguenti abbreviazioni:
C-<car> significa che bisogna tenere abbassato il tasto CONTROL
mentre si preme il carattere <car>. Quindi C-f significa:
tieni premuto CONTROL e batti f.
- M-<car> significa che bisogna tenere abbassato il tasto META o EDIT
- o ALT mentre si preme il carattere <car>. Se non ci sono
- tasti META, EDIT o ALT, al loro posto si può premere e poi
- rilasciare il tasto ESC e quindi premere <car>. Useremo
- <ESC> per indicare il tasto ESC.
+ M-<car> significa che bisogna tenere abbassato il tasto META o ALT
+ mentre si preme il carattere <car>. Se non ci sono tasti
+ META o ALT, al loro posto si può premere e poi rilasciare
+ il tasto ESC e quindi premere <car>. Useremo <ESC> per
+ indicare il tasto ESC.
Nota importante: per chiudere una sessione di lavoro di Emacs usa C-x
C-c (due caratteri).
@@ -20,7 +20,7 @@ Per annullare un comando inserito parzialmente usa C-g.
Per terminare l'esercitazione, usa C-x k quindi <Invio> al prompt.
I caratteri “>>” posti al margine sinistro indicano le direttive per
provare a usare un comando. Per esempio:
-<<Blank lines inserted here by startup of help-with-tutorial>>
+<<Blank lines inserted around following line by help-with-tutorial>>
[Spaziatura inserita a scopo didattico. Il testo continua sotto]
>> Adesso premi C-v (vedi schermata successiva) per spostarti alla
prossima schermata (vai avanti, tieni premuto il tasto
@@ -33,11 +33,12 @@ alla schermata successiva, favorendo così la continuità di lettura.
La prima cosa che bisogna imparare è come raggiungere un certo punto
del testo. Sai già come andare avanti di una schermata, con C-v. Per
andare indietro di una schermata, premi M-v (tieni premuto il tasto
-META e poi premi v, oppure usa <ESC>v se non c'è un tasto META, EDIT o
-ALT).
+META e poi premi v, oppure usa <ESC>v se non c'è un tasto META o ALT).
>> Ora prova: premi M-v e quindi C-v alcune volte.
+Puoi ovviamente spostarti avanti e indietro in questo testo in altri
+modi, se li conosci.
* SOMMARIO
----------
@@ -207,11 +208,11 @@ Molti comandi di Emacs accettano un argomento numerico che spesso
serve a conteggiare per quante volte vanno ripetuti. Il modo in cui
si può fornire ad un comando il numero di ripetizioni è il seguente:
si usa C-u e quindi si indicano le cifre prima di impartire il comando
-stesso. Se esiste un tasto META (o EDIT o ALT) c'è un modo
-alternativo: si battono le cifre tenendo premuto il tasto META. Noi
-consigliamo di imparare il metodo con C-u perché funziona su tutti i
-terminali. L'argomento numerico è anche chiamato “argomento
-prefisso”, perché viene indicato prima del comando a cui si riferisce.
+stesso. Se esiste un tasto META (o ALT) c'è un modo alternativo: si
+battono le cifre tenendo premuto il tasto META. Noi consigliamo di
+imparare il metodo con C-u perché funziona su tutti i terminali.
+L'argomento numerico è anche chiamato “argomento prefisso”, perché
+viene indicato prima del comando a cui si riferisce.
Per esempio, C-u 8 C-f sposta il cursore in avanti di otto caratteri.
@@ -502,9 +503,10 @@ usare per annullare l'inserimento del testo).
>> Elimina questa riga con C-k poi usa C-/ e dovrebbe ricomparire.
C-_ è un comando di annullamento alternativo, funziona esattamente
-come C-/. Su alcuni terminali, la sequenza C-/ invia effettivamente
-C-_ a Emacs. Alternativamente, anche C-x u ha la stessa funzione di
-C-/, ma è leggermente più scomoda da inserire.
+come C-/. Su alcune tastiere non è necessario usare il tasto shift
+per inserire C-_. Su alcuni terminali, la sequenza C-/ invia
+effettivamente C-_ a Emacs. Alternativamente, anche C-x u ha la
+stessa funzione di C-/, ma è leggermente più scomoda da inserire.
Un argomento numerico per C-/, C-_ o C-x u agisce come numero delle
ripetizioni da effettuare.
@@ -651,11 +653,12 @@ la possibilità di salvare il buffer del primo file: sarebbe fastidioso
dover prima passare a quel buffer per salvarlo con C-x C-s. Così c'è
il comando
- C-x s Salva alcuni buffer
+ C-x s Salva alcuni buffer nei loro file
-C-x s chiede conferma del salvataggio per ogni buffer che contiene
-testo modificato e non ancora salvato. Chiede, per ognuno di quei
-buffer, se si voglia salvarne il contenuto nel file corrispondente.
+C-x s chiede conferma del salvataggio per ogni buffer associato ad un
+file che contiene testo modificato e non ancora salvato. Chiede, per
+ognuno di quei buffer, se si voglia salvarne il contenuto nel file
+corrispondente.
>> Inserisci una riga di testo e poi premi C-x s.
Dovrebbe chiederti se vuoi salvare il file chiamato “...TUTORIAL”.
@@ -701,14 +704,14 @@ gestisce la posta.
Ci sono molti comandi C-x. Ecco una lista di quelli già conosciuti:
- C-x C-f Apri un file.
- C-x C-s Salva un file.
- C-x s Salva alcuni buffer.
- C-x C-b Elenca buffer.
- C-x b Passa a un altro buffer.
- C-x C-c Chiudi Emacs.
- C-x 1 Elimina tutte le finestre tranne una.
- C-x u Annulla.
+ C-x C-f Apri un file
+ C-x C-s Salva il buffer sul file
+ C-x s Salva alcuni buffer sui loro file
+ C-x C-b Elenca buffer
+ C-x b Passa a un altro buffer
+ C-x C-c Chiudi Emacs
+ C-x 1 Elimina tutte le finestre tranne una
+ C-x u Annulla
I comandi estesi con nome sono usati ancora meno spesso, oppure sono
usati solo in certe modalità. Un esempio è il comando replace-string
@@ -749,7 +752,7 @@ salvataggio automatico.
Se il computer si blocca si può recuperare il file salvato
automaticamente aprendo il file in modo normale (il file che si stava
scrivendo, non quello di salvataggio automatico) e usando poi M-x
-recover-file<Invio>. Quando viene chiesta la conferma si risponda
+recover-this-file<Invio>. Quando viene chiesta la conferma si risponda
con yes<Invio> per procedere con il recupero dei dati salvati
automaticamente.
@@ -1091,8 +1094,8 @@ quindi anche come breve descrizione, sufficiente per ricordarsi di
comandi già imparati.
I comandi con più caratteri come ad esempio C-x C-s e (se non c'è il
-tasto META o EDIT o ALT) <ESC>v sono permessi allo stesso modo dopo
-una richiesta di aiuto fatta con C-h c.
+tasto META o ALT) <ESC>v sono permessi allo stesso modo dopo una
+richiesta di aiuto fatta con C-h c.
Per avere ulteriori informazioni su un comando si usa C-h k invece che
C-h c.
@@ -1156,7 +1159,7 @@ Puoi imparare di più su Emacs leggendo il suo manuale, sia nella forma
stampata piuttosto che da dentro Emacs stesso (usa il menu Help oppure
C-h r). Due funzionalità che possono farti comodo sono il
completamento automatico, che consente di ridurre il numero di
-caratteri da digitare, e dired, che semplifica la gestione dei file.
+caratteri da digitare, e Dired, che semplifica la gestione dei file.
Il completamento è un modo per evitare la pressione di tasti quando
non sia necessario. Ad esempio, quando vuoi passare al buffer
@@ -1203,7 +1206,7 @@ distribuito con il permesso di farne copie a determinate condizioni:
indicativo, restando comunque inteso il fatto che è quella
originale a fare fede.
-Copyright (C) 2003-2020 Free Software Foundation, Inc.
+Copyright (C) 2003-2021 Free Software Foundation, Inc.
È permesso a chiunque copiare e distribuire attraverso ogni mezzo
copie fedeli di questo documento così come viene ricevuto, a
diff --git a/etc/tutorials/TUTORIAL.ja b/etc/tutorials/TUTORIAL.ja
index 0dff756b138..db1e19b692b 100644
--- a/etc/tutorials/TUTORIAL.ja
+++ b/etc/tutorials/TUTORIAL.ja
@@ -1062,7 +1062,7 @@ starting with the one written by Stuart Cracraft for the original Emacs.
This version of the tutorial, like GNU Emacs, is copyrighted, and
comes with permission to distribute copies on certain conditions:
-Copyright (C) 1985, 1996, 1998, 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 1985, 1996, 1998, 2001-2021 Free Software Foundation, Inc.
Permission is granted to anyone to make or distribute verbatim copies
of this document as received, in any medium, provided that the
diff --git a/etc/tutorials/TUTORIAL.ko b/etc/tutorials/TUTORIAL.ko
index 39f503baf0f..d3ec8c240cd 100644
--- a/etc/tutorials/TUTORIAL.ko
+++ b/etc/tutorials/TUTORIAL.ko
@@ -981,7 +981,7 @@ C-x C-s와 (META쇠나 EDIT쇠 혹은 교체쇠가 있으면) <ESC>v와 같은
GNU 이맥스와 같이 이 지침서 판은 저작권이 있으며 특정한 조건을 만족할
때에 복사본을 배포할 수 있는 허가를 갖고 나온 것이다:
-Copyright (C) 1985, 1996, 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 1985, 1996, 2001-2021 Free Software Foundation, Inc.
이 문서는 이 저작권 공고와 허용 공고가 그대로 유지되고, 배포자가
수취자에게 이 공고에 따라 허용되는 것처럼 또 재분배하는 것을
diff --git a/etc/tutorials/TUTORIAL.nl b/etc/tutorials/TUTORIAL.nl
index c6b801c1183..0853e5ffbb7 100644
--- a/etc/tutorials/TUTORIAL.nl
+++ b/etc/tutorials/TUTORIAL.nl
@@ -1209,7 +1209,7 @@ Deze versie van de inleiding is onderdeel van GNU Emacs. Het valt
onder copyright. Je mag deze inleiding verspreiden onder bepaalde
voorwaarden:
- Copyright (C) 1985, 1996, 1998, 2001-2020 Free Software Foundation,
+ Copyright (C) 1985, 1996, 1998, 2001-2021 Free Software Foundation,
Inc.
Dit bestand is onderdeel van GNU Emacs.
@@ -1239,7 +1239,7 @@ Engels origineel van de copyrightmelding en condities:
This version of the tutorial is a part of GNU Emacs. It is copyrighted
and comes with permission to distribute copies on certain conditions:
- Copyright (C) 1985, 1996, 1998, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1985, 1996, 1998, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/etc/tutorials/TUTORIAL.pl b/etc/tutorials/TUTORIAL.pl
index f9a7b7b274d..b5ccccfad42 100644
--- a/etc/tutorials/TUTORIAL.pl
+++ b/etc/tutorials/TUTORIAL.pl
@@ -1209,7 +1209,7 @@ z pomocą Ryszarda Kubiaka i Janusza S. Bienia <jsbien@mail.uw.edu.pl>.
Ta wersja samouczka, podobnie jak GNU Emacs, jest chroniona prawem
autorskim, ale wolno ją kopiować pod następującymi warunkami:
-Copyright (C) 1985, 1994, 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 1985, 1994, 2001-2021 Free Software Foundation, Inc.
Zezwala się na wykonywanie lub rozpowszechnianie
wiernych kopii tego dokumentu w otrzymanej formie, na dowolnym
diff --git a/etc/tutorials/TUTORIAL.pt_BR b/etc/tutorials/TUTORIAL.pt_BR
index 8b7583c15c5..65ab3b56512 100644
--- a/etc/tutorials/TUTORIAL.pt_BR
+++ b/etc/tutorials/TUTORIAL.pt_BR
@@ -1056,7 +1056,7 @@ Essa versão do tutorial foi originalmente traduzida por Marcelo Toledo
<marcelo@gnu.org> e como o GNU Emacs, tem um copyright, e vem
com uma permissão de distribuição de cópias nas seguintes condições:
-Copyright (C) 2004-2020 Free Software Foundation, Inc.
+Copyright (C) 2004-2021 Free Software Foundation, Inc.
Permissão é garantida a qualquer um para fazer ou distribuir cópias
integrais deste documento como recebido, em qualquer meio, deixando
diff --git a/etc/tutorials/TUTORIAL.ro b/etc/tutorials/TUTORIAL.ro
index 05d5d8a90ed..f9e67caa1ea 100644
--- a/etc/tutorials/TUTORIAL.ro
+++ b/etc/tutorials/TUTORIAL.ro
@@ -4,7 +4,7 @@ Mulţumiri Aidei Hulubei <aida@chang.pub.ro> pentru corecturi şi sugestii.
Această versiune a fost produsă plecând de la versiunea în limba
engleză, care este
-Copyright (c) 1985, 2013-2020 Free Software Foundation, Inc.
+Copyright (c) 1985, 2013-2021 Free Software Foundation, Inc.
Citiţi acum versiunea românească a tutorialului de Emacs.
@@ -1082,7 +1082,7 @@ continuare noţita de copyright originală în limba engleză.
This version of the tutorial, like GNU Emacs, is copyrighted, and
comes with permission to distribute copies on certain conditions:
-Copyright (C) 1998, 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 1998, 2001-2021 Free Software Foundation, Inc.
Permission is granted to anyone to make or distribute verbatim copies
of this document as received, in any medium, provided that the
diff --git a/etc/tutorials/TUTORIAL.ru b/etc/tutorials/TUTORIAL.ru
index 96a858509f9..45bee48bd43 100644
--- a/etc/tutorials/TUTORIAL.ru
+++ b/etc/tutorials/TUTORIAL.ru
@@ -1105,7 +1105,7 @@ Dired позволяет вам отображать список файлов
(copyrighted) и приходит с ограничениями распространения копий со
следующими соглашениями:
-Copyright (C) 1985, 1996, 1998, 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 1985, 1996, 1998, 2001-2021 Free Software Foundation, Inc.
Permission is granted to anyone to make or distribute verbatim copies
of this document as received, in any medium, provided that the
diff --git a/etc/tutorials/TUTORIAL.sk b/etc/tutorials/TUTORIAL.sk
index 408de538fb4..525db248007 100644
--- a/etc/tutorials/TUTORIAL.sk
+++ b/etc/tutorials/TUTORIAL.sk
@@ -1074,7 +1074,7 @@ tútorialom napísaným Stuartom Cracraftom pre pôvodný Emacs.
Táto verzia tútorialu je, podobne ako GNU Emacs, chránená copyrightom
a je šírená s povolením distribuovať kópie za istých podmienok:
-Copyright (C) 1985, 1996, 1998, 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 1985, 1996, 1998, 2001-2021 Free Software Foundation, Inc.
Každému je zaručené právo vytvárať a distribuovať presné kópie tohto
dokumentu tak, ako ho dostal, na akomkoľvek médiu, s tým, že bude
diff --git a/etc/tutorials/TUTORIAL.sl b/etc/tutorials/TUTORIAL.sl
index bb8bfe2b7f6..be87588b263 100644
--- a/etc/tutorials/TUTORIAL.sl
+++ b/etc/tutorials/TUTORIAL.sl
@@ -1119,7 +1119,7 @@ Emacs. V slovenščino ga je prevedel Primož Peterlin.
To besedilo, kot sam GNU Emacs, je avtorsko delo, in njegovo
razmnoževanje in razširjanje je dovoljeno pod naslednjimi pogoji:
-Copyright © 1985, 1996, 1998, 2001-2020 Free Software Foundation, Inc.
+Copyright © 1985, 1996, 1998, 2001-2021 Free Software Foundation, Inc.
Ta datoteka je del paketa GNU Emacs.
diff --git a/etc/tutorials/TUTORIAL.sv b/etc/tutorials/TUTORIAL.sv
index 231d8a061bc..1eab2670795 100644
--- a/etc/tutorials/TUTORIAL.sv
+++ b/etc/tutorials/TUTORIAL.sv
@@ -1,14 +1,16 @@
Emacs användarhandledning. I slutet finns kopieringsvillkoren.
-Emacs-kommandon innebär ofta användning av kontrolltangenten (vanligen
-märkt CTRL eller CTL) eller META-tangenten (på vissa tangentbord märkt
-ALT eller EDIT). Vi använder här följande förkortningar:
-
- C-<chr> håll ner kontrolltangenten samtidigt som du skriver bokstaven
- <chr>. C-f betyder: håll ner kontrolltangenten och tryck f.
- M-<chr> håll ner META-tangenten samtidigt som du skriver <chr>. Om
- META-tangent saknas trycker du <ESC>, ESC-tangenten, släpper
- den och trycker sedan <chr>.
+Emacs-kommandon använder ofta kontrolltangenten (ofta märkt CONTROL
+eller CTRL) eller META-tangenten (vanligen märkt ALT).
+Istället för att skriva ut deras namn varje gång använder vi följande
+förkortningar:
+
+ C-<tkn> håll ner kontrolltangenten samtidigt som du skriver tecknet
+ <tkn>. C-f betyder: håll ner kontrolltangenten och tryck f.
+ M-<tkn> håll ner META- eller ALT-tangenten samtidigt som du skriver
+ <tkn>. Om det inte finns någon META- eller ALT-tangent
+ trycker du på ESC-tangenten, släpper den och trycker sedan
+ <tkn>. När vi skriver <ESC> menar vi ESC-tangenten (eller Escape).
Viktigt: För att avsluta Emacs trycker du C-x C-c (två tecken).
För att avsluta kommandon som inte skrivits in fullt, tryck C-g.
@@ -18,28 +20,28 @@ Tecknen ">>" i vänstermarginalen anger att du kan prova ett
kommando. Till exempel:
<<Tomma rader sätts in runt nästa rad när help-with-tutorial aktiveras>>
[Tomma rader av pedagogiska skäl. Texten fortsätter nedanför.]
->> Tryck C-v (View next screen) för att rulla nedåt i handledningen.
+>> Tryck C-v för att rulla nedåt i handledningen.
Prova nu. Håll ned kontrolltangenten och tryck v. Gör så i
fortsättningen när du når slutet av en skärmbild.
-Notera att det är ett överlapp på två rader när du rullar en hel sida.
-Detta är för att behålla sammanhanget när du bläddrar framåt i texten.
+Observera att det är ett överlapp på två rader när du rullar en hel sida.
+Detta sker för att behålla sammanhanget när du bläddrar framåt i texten.
-Det här är en kopia av Emacs användarhandledning, som anpassats något
-för dig. Längre fram kommer vi att instruera dig att prova olika
-kommandon som ändrar i texten. Var inte orolig om du ändrar texten
-innan vi säger till dig att göra det. Det kallas för att redigera och
-det är det som Emacs är till för.
+Det här är ett exemplar av Emacs användarhandledning som har anpassats
+något för dig. Längre fram kommer vi att be dig att prova olika kommandon
+som ändrar i texten. Var inte orolig om du ändrar texten innan vi säger
+till dig att göra det. Det kallas för att redigera och det är det som
+Emacs är till för.
Det första du behöver veta är hur du manövrerar från plats till plats
i texten. Du har redan lärt dig hur du flyttar en skärmbild framåt,
med C-v. För att flytta dig en skärmbild bakåt trycker du M-v. (Håll
ned META-tangenten och tryck v eller tryck <ESC>v om du inte har
-META-, EDIT- eller ALT-tangent.)
+en META- eller ALT-tangent.)
>> Prova att trycka M-v och C-v några gånger.
-Det är OK att rulla texten på andra sätt om du vet hur.
+Det går bra att rulla texten på andra sätt som du kanske känner till.
* SAMMANFATTNING
----------------
@@ -53,12 +55,12 @@ Följande kommandon är bra för att se hela skärmbilder:
KONTROLL-1.)
>> Leta reda på markören och se vad som står där. Tryck sedan C-l.
- Hitta markören igen och notera att det är samma text som står kring
- markören nu, men nu mitt på skärmen. Om du trycker C-l igen så
+ Hitta markören igen och observera att det är samma text som står
+ kring markören nu, men nu mitt på skärmen. Om du trycker C-l igen så
flyttas texten högst upp på skärmen. Tryck C-l igen och den flyttas
ner till botten.
-Du kan också använda PageUp och PageDn tangenterna, om din terminal
+Du kan också använda tangenterna PageUp och PageDn, om din terminal
har dem, för att flytta en hel skärmbild åt gången, men du redigerar
effektivare om du använder C-v och M-v.
@@ -86,10 +88,10 @@ fyra piltangenterna. Så här:
och C-p. Använd sedan C-l för att centrera diagrammet på
skärmbilden.
-Detta är enklare att komma ihåg om du tänker på dessa förkortningar: P
-för föregående (previous), N för nästa (next), B för bakåt (backward)
-och F för framåt (forward). Du kommer att använda dessa grundläggande
-kommandona hela tiden.
+Kommandona är enklare att komma ihåg om man tänker på vad de står för:
+P för föregående (eng. "previous"), N för nästa, B för bakåt
+och F för framåt.
+Du kommer att använda dessa grundläggande kommandon hela tiden.
>> Gör några C-n så att du kommer ned till den här raden.
@@ -102,8 +104,8 @@ avslutas också vanligtvis med ett radslut men Emacs kräver inte att
den gör det.
>> Prova med C-b i början av en rad. Detta gör att markören
- flyttas till slutet av den tidigare raden. Detta är för att den
- flyttar markören över radslutstecknet.
+ flyttas till slutet av den tidigare raden. Detta beror på att
+ markören flyttas över radslutstecknet.
C-f flyttar också över radslut, precis som C-b.
@@ -138,12 +140,13 @@ motsatt riktning.
Lägg märke till likheten mellan C-f och C-b å ena sidan och M-f och
M-b å den andra. Ofta används META-kommandon till språkrelaterade
operationer (ord, stycken, avsnitt), medan kontrollkommandon används
-till grundläggande operationer som inte beror av vad man redigerar
+till grundläggande operationer som inte beror på vad man redigerar
(bokstäver, rader, etc.).
Denna likhet finns också mellan rader och stycken: C-a och C-e flyttar
-markören till början av en rad eller till slutet av en rad, medan M-a
-och M-e flyttar den till början respektive slutet av ett stycke.
+markören till början och till slutet av en rad, medan M-a och M-e
+flyttar den till början respektive slutet av ett stycke.
+(Minnesregel: A och E för (tyska) Anfang och Ende.)
>> Prova några C-a och sedan några C-e.
Prova också några M-a och sedan några M-e.
@@ -153,8 +156,8 @@ M-a fortsätter att flytta markören till nästa stycke. Även om detta
inte verkar självklart är det ganska naturligt.
Platsen där markören är i texten kallas också för "arbetspunkt"
-(point). Eller omskrivet: Markören visar på skärmen var arbetspunkten
-är i texten.
+(point). Eller med andra ord: markören visar på skärmen var
+arbetspunkten är i texten.
Här är en kort sammanfattning av de enklaste markörförflyttnings-
kommandona, inklusive ord- och styckesförflyttningskommandon:
@@ -181,10 +184,10 @@ Två andra viktiga markörrörelsekommandon är M-< (META mindre-än), som
flyttar markören till början av texten, och M-> (META större-än), som
flyttar den till slutet av texten.
-På en del tangentbord är "<" placerad över komma, så att man måste
+På svenska tangentbord är ">" placerad över "<", så att man måste
använda skift för att få fram den. På dessa tangentbord måste man
-också använda skift för att skriva M-<. Utan skifttangenten skulle det
-bli M-komma.
+också använda skift för att skriva M->. Utan skifttangenten skulle det
+bli M-<.
>> Prova M-< nu för att flytta markören till början av vägledningen.
Använd sedan C-v för att flytta markören tillbaka hit igen.
@@ -195,7 +198,7 @@ bli M-komma.
Du kan också flytta markören med hjälp av piltangenterna, om
terminalen har piltangenter. Vi föreslår att du lär dig C-b, C-f, C-n
och C-p av tre skäl. För det första kommer de att fungera på alla
-slags terminaler. För det andra kommer du att finna, när du har fått
+slags terminaler. För det andra kommer du att märka, när du har fått
lite träning i att använda Emacs, att det går mycket snabbare att
använda kontrollfunktionerna än piltangenterna (för att du undviker
att ändra fingersättningen). Den tredje anledningen är att när man har
@@ -203,14 +206,13 @@ lärt sig att använda kontrolltangenten blir det lättare att lära sig
de mer avancerade kontrollfunktionerna.
De flesta kommandon i Emacs tar ett numeriskt argument och för de
-flesta kommandon leder detta till att de repeteras. Ett numeriskt
+flesta kommandon leder detta till att de upprepas. Ett numeriskt
argument anges genom att du skriver C-u och sedan talet, innan du
-skriver kommandot. Om du har en META- (eller EDIT- eller ALT-) tangent
-så finns det ett annat alternativ för att ge numeriska argument: skriv
-talet medan du håller ned META-tangenten. Vi föreslår att du använder
-C-u för det fungerar på alla slags terminaler. Det numeriska
-argumentet kallas också för "prefixargument" eftersom det skrivs före
-kommandot.
+skriver kommandot. Om du har en META- eller ALT-tangent så finns det
+ett annat alternativ för att ge numeriska argument: skriv talet medan
+du håller ned META-tangenten. Vi föreslår att du använder C-u eftersom
+det fungerar på alla slags terminaler. Det numeriska argumentet kallas
+också för "prefixargument" eftersom det skrivs före kommandot.
Till exempel: C-u 8 C-f flyttar markören åtta steg framåt.
@@ -218,8 +220,8 @@ Till exempel: C-u 8 C-f flyttar markören åtta steg framåt.
kommer så nära den här raden som möjligt med ett enda kommando.
De flesta kommandon använder det numeriska argumentet för ett
-repeterat utförande men det finns kommandon som använder det
-annorlunda. Flera kommandon, men inga av dem du lärt dig hittills,
+upprepat utförande men det finns kommandon som använder det på
+andra sätt. Flera kommandon, men inga av dem du lärt dig hittills,
använder det som en flagga. Med ett prefixargument, och oberoende av
dess värde, gör kommandot något annat.
@@ -231,7 +233,7 @@ uppåt.
>> Prova C-u 8 C-v nu.
-Detta borde ha flyttat skärmbilden 8 rader uppåt. Om du önskar flytta
+Detta borde ha flyttat skärmbilden 8 rader uppåt. Om du vill flytta
tillbaka igen är det bara att ge samma argument till M-v.
Om du använder ett fönstersystem, som X eller MS-Windows, finns det
@@ -239,7 +241,7 @@ troligen ett rektangulärt område på sidan av Emacs-fönstret, en så
kallad rullningslist. Genom att klicka i den med musen kan du rulla
texten.
-Om din mus har ett rullningshjul kan även den användas för att rulla
+Om din mus har ett rullningshjul kan även det användas för att rulla
texten.
@@ -263,15 +265,15 @@ Om du av misstag slår <ESC> blir du kvitt detta med ett C-g.
* SPÄRRADE KOMMANDON
--------------------
-En del Emacs-kommandon är "spärrade" så att nybörjare inte skall
+En del Emacs-kommandon är "spärrade" för att inte nybörjare skall
använda dem av misstag.
Om du provar ett av dessa spärrade kommandon kommer Emacs ge ett
-meddelande som berättar vilket kommando det är och kommer att fråga om
+meddelande som berättar vilket kommando det är och fråga om
du verkligen vill fortsätta och utföra detta kommando.
-Om du verkligen önskar att utföra kommandot skriver du <SPC>,
-(mellanslagstangenten) som svar på frågan. Normalt, om du inte önskar
+Om du verkligen önskar att utföra kommandot trycker du på
+mellanslagstangenten som svar på frågan. Normalt, om du inte önskar
att utföra detta kommando, svarar du "n" på frågan.
>> Skriv C-x C-l (som är ett spärrat kommando).
@@ -295,7 +297,7 @@ tas bort.
>> Flytta markören till den här raden och tryck C-u 0 C-l.
>> Tryck C-h k C-f.
Se hur det här fönstret krymper samtidigt som ett nytt uppträder
- för att visa dokumentationen av C-f-kommandot.
+ för att visa dokumentationen av kommandot C-f.
>> Slå C-x 1 och se hur dokumentationsfönstret nu försvinner.
@@ -309,13 +311,13 @@ kommandon är två, tre eller fyra tecken långa.
Om du önskar att sätta in text är det bara att skriva in texten.
Vanliga tecken, som A, 7, *, etc., sätts in direkt när du skriver dem.
-Tryck på <Return> för att sätta in en radbrytning. (Det är den tangent
-på tangentbordet som ibland är märkt med "Enter")
+Tryck på <Return>, returtangenten, för att sätta in en radbrytning.
+(Den är vanligen märkt "Return" eller "Enter" eller med en krokpil bakåt.)
För att radera tecknet omedelbart före aktuell markörposition, tryck
på <DEL>. Det är tangenten på tangentbordet som vanligtvis är markerad
-med "Backspace" -- det är samma tangent som du normal använder för att
-radera det sist inmatade tecknet utanför Emacs.
+med en lång vänsterpil eller "Backspace" -- det är samma tangent som du
+normalt använder för att radera det sist inmatade tecknet utanför Emacs.
Det kan finnas en annan tangent på ditt tangentbordet som är märkt med
"Delete", men det är inte den vi menar med <DEL>.
@@ -326,9 +328,9 @@ Det kan finnas en annan tangent på ditt tangentbordet som är märkt med
är bara en lokal kopia.
När en rad blir för lång för att rymmas på en skärmbredd så fortsätter
-den på raden under. Om du använder ett fönstersystem, visas små böjda
+den på raden under. Om du använder ett fönstersystem så visas små böjda
pilar i det lilla utrymmet på bägge sidor om textmassan (i vänster och
-höger marginal) för att ange var en rad fortsätter, Om du använder
+höger marginal) för att ange var en rad fortsätter. Om du använder
en textterminal anges med ett bakstreck (”\”) i kolumnen längst till
höger att raden fortsätter.
@@ -339,7 +341,7 @@ höger att raden fortsätter.
>> Använd <DEL> för att radera texten tills raden ryms på en
skärmbredd igen. Fortsättningstecknet kommer då att försvinna.
-Du kan radera radbrytning precis som andra tecken. Genom att radera
+Du kan radera radbrytningar precis som andra tecken. Genom att radera
radbrytningen mellan två rader slås dessa samman till en. Om
resultatet av denna sammanslagning blir för stor för att passa inom en
skärmbredd, så kommer den att visas med ett fortsättningstecken.
@@ -363,7 +365,7 @@ Du bör se att efter att den nya raden satts in, sätter Emacs in
blanktecken så att markören flyttas fram under "T" i "Tryck".
Tänk på att de flesta Emacs-kommandon kan ta numeriska argument. Detta
-gäller också texttecken. Genom att repetera ett texttecken kommer det
+gäller också texttecken. Genom att upprepa ett texttecken kommer det
skrivas flera gånger.
>> Prova det nu: Skriv C-u 8 * för att sätta in ********.
@@ -402,11 +404,11 @@ tryck C-w. Detta tar bort texten mellan de två positionerna.
>> Tryck C-w. Detta tar bort texten från och med D fram till just före
o.
-Skillnaden mellan att "ta bort" (killing) och "radera" (deleting) text
+Skillnaden mellan att "ta bort" (kill) och "radera" (delete) text
är att "borttagen" text kan sättas tillbaka (var som helst), medan
raderad text inte kan det på det sättet. (Du kan dock ångra en
radering--se nedan.) Återinsättning av borttagen text kallas
-"återhämtning" (yanking). Generellt kan man säga att kommandon som
+"återhämtning" (yank). Generellt kan man säga att kommandon som
tar bort fler än ett tecken sparar undan texten (så att den kan
återhämtas) medan kommandon som bara raderar ett tecken, eller bara
raderar tomma rader och mellanrum inte sparar någonting (och den
@@ -422,7 +424,7 @@ Lägg märke till att ett enstaka C-k bara raderar texten på raden och
att det andra C-k raderar själva raden och flyttar upp texten på raden
under ett steg. C-k hanterar numeriska argument lite speciellt. Den
raderar så många rader OCH innehållet i dem. Detta är alltså inte bara
-en repetition av kommandot. C-u 2 C-k raderar två rader samt de tomma
+en upprepning av kommandot. C-u 2 C-k raderar två rader samt de tomma
raderna, medan C-k två gånger inte kommer att göra det.
Du kan antingen hämta tillbaka borttagen text till samma plats som där
@@ -438,7 +440,7 @@ tillbaka den sist borttagna texten och placerar den där markören är.
>> Prova: Gör C-y för att få tillbaka texten.
-Om du gör flera C-k i rad så kommer all bortagen text att sparas
+Om du gör flera C-k i rad så kommer all borttagen text att sparas
samlat så att ett C-y återhämtar alla raderna på en gång.
>> Prova detta. Tryck C-k ett par gånger.
@@ -450,11 +452,11 @@ Och hämta så tillbaka igen:
Men vad gör du om du har en text du önskar att hämta tillbaka men du
har redan tagit bort något nytt? C-y skulle hämta tillbaka den senaste
-texten som blev borttagen men tidigare bortagen text är inte
+texten som blev borttagen men tidigare borttagen text är inte
förlorad. Du kan få tillbaka den med kommandot M-y. Efter att du har
använt C-y för att hämta tillbaka den sist borttagna texten kommer M-y
ersätta denna text med tidigare borttagen text. Genom att göra M-y om
-och om igen hämtas allt tidigare borttagen text tillbaka. När du har
+och om igen hämtas all tidigare borttagen text tillbaka. När du har
nått den önskade texten behöver du inte göra något ytterligare för att
behålla den. Fortsätt bara med din redigeringen och lämna den
återtagna texten där den är.
@@ -477,25 +479,25 @@ Om du gör en förändring i texten och sedan ångrar dig, så kan du
upphäva ändringen med ångra-kommandot C-/.
Normalt kommer C-/ upphäva förändringen som gjordes av det sist
-utförda kommandot. Om du repeterar C-/ flera gånger kommer varje
-repetition upphäva ett kommando till.
+utförda kommandot. Om du upprepar C-/ flera gånger kommer varje
+upprepning upphäva ett kommando till.
Det finns två undantag. Kommandon som inte förändrar texten räknas
inte (detta inkluderar markörförflyttningar och bläddringskommandon),
-och inskrivna enkelbokstäver blir vanligtvis grupperade i grupper om
-upp till 20 tecken. Detta är för att reducera antalet C-/ som behövs
+och inskrivna enkelbokstäver blir vanligtvis samlade i grupper om
+upp till 20 tecken. Detta görs för att reducera antalet C-/ som behövs
för att ångra inskriven text.
>> Ta bort den här raden med C-k, hämta sedan tillbaka den med C-/.
-C-_ är ett alternativt ångra-kommandot. Den fungerar exakt på samma
+C-_ är ett alternativt ångra-kommando. Det fungerar exakt på samma
sätt som C-/. På vissa textterminaler skickar C-/ faktiskt C-_ till
Emacs. Även C-x u fungerar precis som C-/, men är inte lika enkelt att
skriva.
Ett numeriskt argument till C-/, C-_ eller C-x u medför upprepning.
-Du kan ångra radering av text precis på samma sätt som du kan ångra
+Du kan ångra radering av text precis på samma sätt som att du kan ångra
att du tagit bort text. Skillnaden mellan att ta bort och att radera
någonting påverkar endast om du kan hämta tillbaka det med C-y. För
ångerfunktionen spelar det ingen roll hur texten försvunnit.
@@ -514,19 +516,18 @@ sätt är det som om du förändrar själva filen men förändringen du gör
kommer inte bli permanent förrän filen sparas (save). Detta är för att
undvika att halvförändrade filer sparas när du inte vill det. Till och
med när du sparar filen kommer Emacs att behålla originalet under ett
-nytt namn, som backup, ifall du senare ångrar alltihop.
+nytt namn, som säkerhetskopia, ifall du senare ångrar alltihop.
Om du tittar nästan längst ner på skärmbilden så kommer du se en rad
-som börjar med minustecken, och som startar med "-:--- TUTORIAL.sv"
+som börjar med minustecken, och som startar med "U:--- TUTORIAL.sv"
eller något snarlikt. Denna del av skärmbilden visar normalt namnet på
-filen du besöker. Just nu besöker du din personlig kopia av
+filen du besöker. Just nu besöker du ditt personliga exemplar av
vägledningen till Emacs, vilken heter "TUTORIAL.sv". Vilken fil du än
är inne i så kommer filnamnet stå där.
En annan sak med kommandot för att finna filer är att du måste ange
-vilket filnamn du önskar. Vi säger att kommandot "läser ett
-argument". I detta fall är argumentet namnet på filen. Efter att du
-gett kommandot
+vilket filnamn du önskar. Vi säger att kommandot "läser ett argument".
+I detta fall är argumentet namnet på filen. Efter att du gett kommandot
C-x C-f Finn en fil
@@ -569,7 +570,7 @@ för att titta på den. Du kan också finna en fil som inte existerar.
Det är så man skapar nya filer med Emacs: finn filen, som är tom till
att börja med, och sätt igång med att skriva texten som skall in i
filen. Först när du sparar filen kommer Emacs att verkligen skapa
-filen med den text du har skrivit. Från och med detta editerar du en
+filen med den text du har skrivit. Från och med detta redigerar du en
fil som existerar.
@@ -599,16 +600,16 @@ När du har flera buffertar så är bara en av dem "gällande" åt gången.
Det är den buffert du redigerar. Om du vill redigera en annan buffert
så måste du byta till den. Om du vill byta till en buffert som
motsvarar en fil kan du göra det genom att besöka den igen med C-x
-C-f. Det finns dock ett enklare sätt: använd C-x b kommandot. I det
+C-f. Det finns dock ett enklare sätt: använd kommandot C-x b. I det
kommandot anger du buffertens namn.
->> Skapa en fil med namnet "foo" genom att trycka C-x C-f foo <Return>.
+>> Skapa en fil med namnet "abc" genom att trycka C-x C-f abc <Return>.
Skriv sedan C-x b TUTORIAL.sv <Return> för att komma tillbaka till
den här handledningen.
-Mestadels är buffertens namn densamma som filens namn (utan
-katalogdel.) Det är dock inte alltid så. Bufferlistan du skapar med
-C-x C-b visar alltid namnen på varje buffert.
+Mestadels är buffertens namn densamma som filens namn (utan katalogdel).
+Det är dock inte alltid så. Bufferlistan som du skapar med C-x C-b
+visar alltid namnen på varje buffert.
En del buffertar är inte knutna till någon fil, till exempel bufferten
"*Buffer List*". Det är den buffert som innehåller buffertlistan som
@@ -641,7 +642,7 @@ vill spara eller ej.
* UTVIDGNING AV KOMMANDOMÄNGDEN
-------------------------------
-Det finns mycket fler Emacs-kommandon än antalet KONTROLL- eller
+Det finns många fler Emacs-kommandon än antalet KONTROLL- eller
META-tangenter. För att komma förbi denna begränsning har Emacs ett
"X"- (eXtend) kommando. Detta finns i två varianter:
@@ -669,8 +670,8 @@ Emacsprocessen förstörs. I de flesta vanliga kommandoskalen så kan man
återgå till Emacs med kommandot 'fg' eller med '%emacs'.
C-x C-c används när du skall avsluta Emacs. Det är klokt att avsluta
-Emacs om den har startats av ett mail-program eller andra
-applikationer.
+Emacs om den har startats av ett e-post-program eller annan
+applikation.
Det finns många C-x kommandon. Här är en lista över de du har lärt dig
hittills:
@@ -686,14 +687,13 @@ hittills:
Namngivna utvidgade kommandon är kommandon som används mycket sällan
eller bara i vissa lägen. Ett exempel på ett sådant kommando är
-replace-string, som globalt ersätter en teckensträng med en annan. När
+replace-string, som överallt ersätter en teckensträng med en annan. När
du skriver M-x kommer Emacs visa en prompt nederst i skärmbilden med
M-x där du skall skriva in kommandot du önskar att köra, i det här
fallet "replace-string". Det är bara att skriva "repl s<TAB>" och
Emacs kommer då att fylla i kommandonamnet. (<TAB> är
-tabulatortangenten, som vanligtvis finns över CapsLock- eller
-skifttangenten nära den vänstra kanten på tangentbordet.) Kör
-kommandot med <Return>.
+tabulatortangenten, som vanligtvis finns över skiftlåstangenten
+nära den vänstra kanten på tangentbordet.) Kör kommandot med <Return>.
Kommandot replace-string kräver två argument, teckensträngen som skall
ersättas och teckensträngen som den skall ersättas med. Du måste
@@ -715,7 +715,7 @@ När du har gjort förändringar i en fil men inte sparat den, så kommer
detta sparar Emacs periodiskt ändringarna i en autosparfil för varje
fil du redigerar. Denna fil har ett # i början och slutet av
filnamnet. Om du till exempel har en fil med namnet "hej.c" så kommer
-namnet på autosparfilen bli "#hej.c#". När du sparar filen på vanlig
+namnet på autosparfilen bli "#hej.c#". När du sparar filen på vanligt
sätt kommer Emacs radera autosparfilen.
Om maskinen kraschar kan du återfå dina automatiskt sparade ändringar
@@ -828,7 +828,7 @@ genom ett numeriskt argument.
att använda C-x f en gång till.
Om du gör förändringar mitt i en rad så kommer inte sidoläget Auto
-Fill att kunna omformattera raderna för dig.
+Fill att kunna formatera om raderna för dig.
För att göra detta kan du trycka M-q med markören inne i det avsnittet
du önskar att omformatera.
@@ -946,7 +946,7 @@ sig och inte en äkta "modifierare".
Om du hade skrivit C-x 1 i det nedre fönstret skulle det övre ha
försvunnit. Tänk på detta kommando som "Behåll bara ett fönster, det
-som markören står i."
+som markören står i".
Du måste inte ha samma buffert i bägge fönstren. Du kan använda C-x
C-f för att finna en ny fil i ett av fönstren samtidigt som det andra
@@ -964,7 +964,7 @@ filer:
1 för att bli kvitt det nedre igen.
-* MULTIPLA RAMAR
+* FLERA RAMAR
----------------
Emacs kan också skapa flera "ramar". En ram är vad vi kallar en
@@ -1042,8 +1042,7 @@ beskrivande namn kan de också fungera som en enkel dokumentation,
tillräckligt för att påminna dig om kommandon du redan lärt dig.
Flerteckenskommandon, så som C-x C-s och <ESC>v (i stället för M-v, om
-du inte har META, EDIT eller ALT tangenten) är också tillåtna efter
-C-h c.
+du inte har META- eller ALT-tangenten) är också tillåtna efter C-h c.
För att få mer information om ett kommando kan du använda C-h k
istället för C-h c.
@@ -1052,7 +1051,7 @@ istället för C-h c.
Detta kommer visa funktionens dokumentation och namn i ett eget
fönster. För att avsluta hjälpfönstret kan du trycka C-x 1. Du behöver
-inte göra det omedelbart. Du kan editera med hjälptexten som stöd för
+inte göra det omedelbart. Du kan redigera med hjälptexten som stöd för
att först senare ta bort fönstret med C-x 1.
Här är fler varianter på C-h:
@@ -1107,17 +1106,17 @@ Två finesser som du kan komma att gilla speciellt är komplettering
filhantering.
Komplettering är ett sätt att undvika onödiga tangenttryckningar. Till
-exempel, om du vill byta till *Messages* bufferten, kan du du skriva
+exempel, om du vill byta till bufferten *Messages* så kan du du skriva
C-x b *M<Tab> och Emacs kommer fylla i resten av buffertnamnet så
långt den kan räkna ut det från det du redan skrivit. Komplettering
finns beskrivet i Emacs-manualen i noden "Completion".
Dired gör det möjligt att lista filer i en katalog (och även dess
-subkataloger), flytta runt i listan, besöka, byta namn, ta bort och
+underkataloger), flytta runt i listan, besöka, byta namn, ta bort och
operera på olika sätt på filerna. Dired finns beskrivet i Info i
Emacs-manualen i noden "Dired".
-Manualen beskriver även många andra Emacs funktioner.
+Manualen beskriver även många andra funktioner i Emacs.
* SLUTORD
@@ -1135,12 +1134,12 @@ själv, klaga!
Denna vägledning härstammar från en hel rad Emacs-vägledningar och den
första skrevs av Stuart Cracraft för den ursprungliga Emacs. Mats
-Lidell översatte den till Svenska.
+Lidell översatte den till svenska.
This version of the tutorial, like GNU Emacs, is copyrighted, and
comes with permission to distribute copies on certain conditions:
-Copyright (C) 1985, 1996, 1998, 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 1985, 1996, 1998, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/etc/tutorials/TUTORIAL.th b/etc/tutorials/TUTORIAL.th
index 46119c024c8..8bd4f072609 100644
--- a/etc/tutorials/TUTORIAL.th
+++ b/etc/tutorials/TUTORIAL.th
@@ -964,7 +964,7 @@ starting with the one written by Stuart Cracraft for the original Emacs.
This version of the tutorial, like GNU Emacs, is copyrighted, and
comes with permission to distribute copies on certain conditions:
-Copyright (C) 1985, 1996, 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 1985, 1996, 2001-2021 Free Software Foundation, Inc.
Permission is granted to anyone to make or distribute verbatim copies
of this document as received, in any medium, provided that the
diff --git a/etc/tutorials/TUTORIAL.zh b/etc/tutorials/TUTORIAL.zh
index 3b4fb13c62e..a808cf83598 100644
--- a/etc/tutorials/TUTORIAL.zh
+++ b/etc/tutorials/TUTORIAL.zh
@@ -1049,7 +1049,7 @@ issue here>」。
這個版本的快速指南和 GNU Emacs 一樣都是版權化的,並且允許在某些條件下
散佈其拷貝:
-Copyright (C) 1985, 1996, 1998, 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 1985, 1996, 1998, 2001-2021 Free Software Foundation, Inc.
Permission is granted to anyone to make or distribute verbatim copies
of this document as received, in any medium, provided that the
diff --git a/etc/w32-feature.el b/etc/w32-feature.el
index 3c0f74175cf..364e9341ae3 100644
--- a/etc/w32-feature.el
+++ b/etc/w32-feature.el
@@ -1,6 +1,6 @@
;;; w32-feature.el --- Check Availability of Emacs Features -*- lexical-binding: t -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; Author: Phillip Lord <phillip.lord@russet.org.uk>
@@ -25,9 +25,21 @@
;; designed to check whether bundled binary distributions of Emacs on
;; windows are fully functional.
+;; By default is checks whether the features that we are expect to be
+;; available on Emacs for Windows are reported to be available. It
+;; should be possible to run these tests from a distributed version of
+;; Emacs.
+
+;; In addition, it provides a single command
+;; `w32-feature-load-tests'. If the full source repository of Emacs is
+;; available, this will load selected files from the repository which
+;; test these features.
+
;;; Code:
(require 'ert)
+(defvar w32-feature-core-tests nil)
+
(ert-deftest feature-optimization ()
(should
(string-match-p "CFLAGS=-O2" system-configuration-options)))
@@ -41,16 +53,24 @@
(ert-deftest feature-gnutls ()
(should (gnutls-available-p)))
+(add-to-list 'w32-feature-core-tests "lisp/net/gnutls-tests.el")
+
(ert-deftest feature-zlib ()
(should (zlib-available-p)))
+(add-to-list 'w32-feature-core-tests "src/decompress-tests.el")
+
(ert-deftest feature-thread ()
(should (fboundp 'make-thread)))
+(add-to-list 'w32-feature-core-tests "lisp/thread-tests.el")
+
(ert-deftest feature-json ()
(should
(fboundp 'json-serialize)))
+(add-to-list 'w32-feature-core-tests "src/json-tests.el")
+
(ert-deftest feature-gmp ()
(should
(string-match-p "GMP" system-configuration-features)))
@@ -61,9 +81,13 @@
(ert-deftest feature-libxml ()
(should (libxml-available-p)))
+(add-to-list 'w32-feature-core-tests "src/xml-tests.el")
+
(ert-deftest feature-lcms2 ()
(should (lcms2-available-p)))
+(add-to-list 'w32-feature-core-tests "src/lcms-tests.el")
+
(ert-deftest feature-xpm ()
(should (image-type-available-p 'xpm)))
@@ -73,8 +97,7 @@
(ert-deftest feature-png ()
(should (image-type-available-p 'png)))
-(ert-deftest feature-xpm ()
- (should (image-type-available-p 'xpm)))
+(add-to-list 'w32-feature-core-tests "lisp/image-file-tests.el")
(ert-deftest feature-jpeg ()
(should (image-type-available-p 'jpeg)))
@@ -84,4 +107,12 @@
(ert-deftest feature-svg ()
(should (image-type-available-p 'svg)))
+
+(defun w32-feature-load-tests (dir)
+ (interactive "D")
+ (mapc
+ (lambda(f)
+ (load-file (concat dir "test/" f)))
+ w32-feature-core-tests))
+
;;; feature.el ends here
diff --git a/leim/ChangeLog.1 b/leim/ChangeLog.1
index 20b23ca6d31..e2c01204452 100644
--- a/leim/ChangeLog.1
+++ b/leim/ChangeLog.1
@@ -2578,7 +2578,7 @@
;; coding: utf-8
;; End:
- Copyright (C) 1997-1999, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1997-1999, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/leim/Makefile.in b/leim/Makefile.in
index 171bc71e4d3..f3e530a11de 100644
--- a/leim/Makefile.in
+++ b/leim/Makefile.in
@@ -1,6 +1,6 @@
### @configure_input@
-# Copyright (C) 1997-2020 Free Software Foundation, Inc.
+# Copyright (C) 1997-2021 Free Software Foundation, Inc.
# Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
# 2006, 2007, 2008, 2009, 2010, 2011
# National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/leim/README b/leim/README
index 6b36c4490ad..baaf6610554 100644
--- a/leim/README
+++ b/leim/README
@@ -1,4 +1,4 @@
-Copyright (C) 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 2001-2021 Free Software Foundation, Inc.
See the end of the file for license conditions.
diff --git a/leim/leim-ext.el b/leim/leim-ext.el
index 404d91c0c0e..2378f6fdb4f 100644
--- a/leim/leim-ext.el
+++ b/leim/leim-ext.el
@@ -1,6 +1,6 @@
;; leim-ext.el -- extra leim configuration -*- coding:utf-8; -*-
-;; Copyright (C) 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H13PRO009
diff --git a/lib-src/ChangeLog.1 b/lib-src/ChangeLog.1
index 16f5142a01a..3c2698005d7 100644
--- a/lib-src/ChangeLog.1
+++ b/lib-src/ChangeLog.1
@@ -8609,7 +8609,7 @@
;; coding: utf-8
;; End:
- Copyright (C) 1988-1999, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1988-1999, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lib-src/Makefile.in b/lib-src/Makefile.in
index a2d27eab001..0a6dd826c10 100644
--- a/lib-src/Makefile.in
+++ b/lib-src/Makefile.in
@@ -1,6 +1,6 @@
### @configure_input@
-# Copyright (C) 1985, 1987-1988, 1993-1994, 2001-2020 Free Software
+# Copyright (C) 1985, 1987-1988, 1993-1994, 2001-2021 Free Software
# Foundation, Inc.
# This file is part of GNU Emacs.
@@ -204,14 +204,19 @@ LIBRESOLV=@LIBRESOLV@
LIBS_MAIL=@LIBS_MAIL@
## empty or -lrt or -lposix4 if HAVE_CLOCK_GETTIME
LIB_CLOCK_GETTIME = @LIB_CLOCK_GETTIME@
+## empty or -lbcrypt or -ladvapi32
+LIB_GETRANDOM = @LIB_GETRANDOM@
## Whatever libraries are needed for euidaccess
LIB_EACCESS=@LIB_EACCESS@
## empty or -lwsock2 for MinGW
LIB_WSOCK32=@LIB_WSOCK32@
+## Extra libraries for etags
+LIBS_ETAGS = $(LIB_CLOCK_GETTIME) $(LIB_GETRANDOM)
+
## Extra libraries to use when linking movemail.
LIBS_MOVE = $(LIBS_MAIL) $(KRB4LIB) $(DESLIB) $(KRB5LIB) $(CRYPTOLIB) \
- $(COM_ERRLIB) $(LIBHESIOD) $(LIBRESOLV) $(LIB_WSOCK32)
+ $(COM_ERRLIB) $(LIBHESIOD) $(LIBRESOLV) $(LIB_WSOCK32) $(LIBS_ETAGS)
## Extra libraries when linking emacsclient
## (empty or -lcomctl32 for MinGW)
@@ -360,7 +365,7 @@ TAGS: etags${EXEEXT} ${tagsfiles}
$(MAKE) -C ../lib all
etags_deps = ${srcdir}/etags.c $(NTLIB) $(config_h)
-etags_libs = $(NTLIB) $(LOADLIBES)
+etags_libs = $(NTLIB) $(LOADLIBES) $(LIBS_ETAGS)
etags${EXEEXT}: ${etags_deps}
$(AM_V_CCLD)$(CC) ${ALL_CFLAGS} -o $@ $< $(etags_libs)
diff --git a/lib-src/ebrowse.c b/lib-src/ebrowse.c
index 7d0650a4059..436b13a32c8 100644
--- a/lib-src/ebrowse.c
+++ b/lib-src/ebrowse.c
@@ -1,6 +1,6 @@
/* ebrowse.c --- parsing files for the ebrowse C++ browser
-Copyright (C) 1992-2020 Free Software Foundation, Inc.
+Copyright (C) 1992-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c
index 871fa7a8d3c..12ced4aadbd 100644
--- a/lib-src/emacsclient.c
+++ b/lib-src/emacsclient.c
@@ -1,6 +1,6 @@
/* Client process that communicates with GNU Emacs acting as server.
-Copyright (C) 1986-1987, 1994, 1999-2020 Free Software Foundation, Inc.
+Copyright (C) 1986-1987, 1994, 1999-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -251,7 +251,6 @@ get_current_dir_name (void)
bufsize_max = min (bufsize_max, PATH_MAX);
#endif
- char *buf;
struct stat dotstat, pwdstat;
size_t pwdlen;
/* If PWD is accurate, use it instead of calling getcwd. PWD is
@@ -265,37 +264,23 @@ get_current_dir_name (void)
&& stat (".", &dotstat) == 0
&& dotstat.st_ino == pwdstat.st_ino
&& dotstat.st_dev == pwdstat.st_dev)
- {
- buf = xmalloc (strlen (pwd) + 1);
- strcpy (buf, pwd);
- }
+ return strdup (pwd);
else
{
- size_t buf_size = 1024;
+ ptrdiff_t buf_size = min (bufsize_max, 1024);
for (;;)
- {
- int tmp_errno;
- buf = malloc (buf_size);
- if (! buf)
- break;
- if (getcwd (buf, buf_size) == buf)
- break;
- tmp_errno = errno;
+ {
+ char *buf = malloc (buf_size);
+ if (!buf)
+ return NULL;
+ if (getcwd (buf, buf_size) == buf)
+ return buf;
free (buf);
- if (tmp_errno != ERANGE)
- {
- errno = tmp_errno;
- return NULL;
- }
- buf_size *= 2;
- if (! buf_size)
- {
- errno = ENOMEM;
- return NULL;
- }
- }
+ if (errno != ERANGE || buf_size == bufsize_max)
+ return NULL;
+ buf_size = buf_size <= bufsize_max / 2 ? 2 * buf_size : bufsize_max;
+ }
}
- return buf;
}
#endif
diff --git a/lib-src/etags.c b/lib-src/etags.c
index 146cf612505..b5c18e0e019 100644
--- a/lib-src/etags.c
+++ b/lib-src/etags.c
@@ -28,7 +28,7 @@ OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-Copyright (C) 1984, 1987-1989, 1993-1995, 1998-2020 Free Software
+Copyright (C) 1984, 1987-1989, 1993-1995, 1998-2021 Free Software
Foundation, Inc.
This file is not considered part of GNU Emacs.
@@ -1643,19 +1643,10 @@ process_file_name (char *file, language *lang)
char *cmd = concat (cmd1, "' > ", tmp_name);
#endif
free (cmd1);
- int tmp_errno;
- if (system (cmd) == -1)
- {
- inf = NULL;
- tmp_errno = EINVAL;
- }
- else
- {
- inf = fopen (tmp_name, "r" FOPEN_BINARY);
- tmp_errno = errno;
- }
+ inf = (system (cmd) == -1
+ ? NULL
+ : fopen (tmp_name, "r" FOPEN_BINARY));
free (cmd);
- errno = tmp_errno;
}
if (!inf)
@@ -1974,14 +1965,13 @@ make_tag (const char *name, /* tag name, or NULL if unnamed */
/* Record a tag. */
static void
-pfnote (char *name, bool is_func, char *linestart, ptrdiff_t linelen,
- intmax_t lno, intmax_t cno)
- /* tag name, or NULL if unnamed */
- /* tag is a function */
- /* start of the line where tag is */
- /* length of the line where tag is */
- /* line number */
- /* character number */
+pfnote (char *name, /* tag name, or NULL if unnamed */
+ bool is_func, /* tag is a function */
+ char *linestart, /* start of the line where tag is */
+ ptrdiff_t linelen, /* length of the line where tag is */
+ intmax_t lno, /* line number */
+ intmax_t cno) /* character number */
+
{
register node *np;
@@ -2905,15 +2895,13 @@ static void make_C_tag (bool);
*/
static bool
-consider_token (char *str, ptrdiff_t len, int c, int *c_extp,
- ptrdiff_t bracelev, ptrdiff_t parlev, bool *is_func_or_var)
- /* IN: token pointer */
- /* IN: token length */
- /* IN: first char after the token */
- /* IN, OUT: C extensions mask */
- /* IN: brace level */
- /* IN: parenthesis level */
- /* OUT: function or variable found */
+consider_token (char *str, /* IN: token pointer */
+ ptrdiff_t len, /* IN: token length */
+ int c, /* IN: first char after the token */
+ int *c_extp, /* IN, OUT: C extensions mask */
+ ptrdiff_t bracelev, /* IN: brace level */
+ ptrdiff_t parlev, /* IN: parenthesis level */
+ bool *is_func_or_var) /* OUT: function or variable found */
{
/* When structdef is stagseen, scolonseen, or snone with bracelev > 0,
structtype is the type of the preceding struct-like keyword, and
@@ -3312,9 +3300,8 @@ perhaps_more_input (FILE *inf)
* C syntax and adds them to the list.
*/
static void
-C_entries (int c_ext, FILE *inf)
- /* extension of C */
- /* input file */
+C_entries (int c_ext, /* extension of C */
+ FILE *inf) /* input file */
{
char c; /* latest char read; '\0' for end of line */
char *lp; /* pointer one beyond the character `c' */
@@ -6067,6 +6054,7 @@ Erlang_functions (FILE *inf)
{
free (last);
last = NULL;
+ allocated = lastlen = 0;
}
}
else
@@ -7071,9 +7059,7 @@ etags_mktmp (void)
int fd = mkostemp (templt, O_CLOEXEC);
if (fd < 0 || close (fd) != 0)
{
- int temp_errno = errno;
free (templt);
- errno = temp_errno;
templt = NULL;
}
#if defined (DOS_NT)
diff --git a/lib-src/hexl.c b/lib-src/hexl.c
index b493df9689c..64866068f45 100644
--- a/lib-src/hexl.c
+++ b/lib-src/hexl.c
@@ -1,5 +1,5 @@
/* Convert files for Emacs Hexl mode.
- Copyright (C) 1989, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1989, 2001-2021 Free Software Foundation, Inc.
Author: Keith Gabryelski (according to authors.el)
diff --git a/lib-src/make-docfile.c b/lib-src/make-docfile.c
index da58358872f..d17c28be90b 100644
--- a/lib-src/make-docfile.c
+++ b/lib-src/make-docfile.c
@@ -1,6 +1,6 @@
/* Generate doc-string file for GNU Emacs from source files.
-Copyright (C) 1985-1986, 1992-1994, 1997, 1999-2020 Free Software
+Copyright (C) 1985-1986, 1992-1994, 1997, 1999-2021 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lib-src/make-fingerprint.c b/lib-src/make-fingerprint.c
index c013d0aca3b..485dd4b919c 100644
--- a/lib-src/make-fingerprint.c
+++ b/lib-src/make-fingerprint.c
@@ -1,6 +1,6 @@
/* Hash inputs and generate C file with the digest.
-Copyright (C) 1985-1986, 1992-1994, 1997, 1999-2016, 2018-2020 Free
+Copyright (C) 1985-1986, 1992-1994, 1997, 1999-2016, 2018-2021 Free
Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -19,9 +19,12 @@ You should have received a copy of the GNU General Public License
along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
-/* The arguments given to this program are all the object files that
- go into building GNU Emacs. There is no special search logic to find
- the files. */
+/* The argument given to this program is the initial version of the
+ temacs executable file used when building GNU Emacs. This program computes
+ a digest fingerprint for the executable, and modifies the binary in
+ place, replacing all instances of the existing fingerprint (normally
+ the default fingerprint from libgnu's lib/fingerprint.c) with the
+ new value. With option -r, it just prints the digest. */
#include <config.h>
diff --git a/lib-src/movemail.c b/lib-src/movemail.c
index 4f9abc998a3..cfdebccb8d0 100644
--- a/lib-src/movemail.c
+++ b/lib-src/movemail.c
@@ -1,7 +1,7 @@
/* movemail foo bar -- move file foo to file bar,
locking file foo the way /bin/mail respects.
-Copyright (C) 1986, 1992-1994, 1996, 1999, 2001-2020 Free Software
+Copyright (C) 1986, 1992-1994, 1996, 1999, 2001-2021 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lib-src/ntlib.c b/lib-src/ntlib.c
index 8f0285591ba..bcbc0064318 100644
--- a/lib-src/ntlib.c
+++ b/lib-src/ntlib.c
@@ -1,6 +1,6 @@
/* Utility and Unix shadow routines for GNU Emacs support programs on NT.
-Copyright (C) 1994, 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 1994, 2001-2021 Free Software Foundation, Inc.
Author: Geoff Voelker (voelker@cs.washington.edu)
Created: 10-8-94
diff --git a/lib-src/ntlib.h b/lib-src/ntlib.h
index 87716030b37..d62c19f16a3 100644
--- a/lib-src/ntlib.h
+++ b/lib-src/ntlib.h
@@ -1,5 +1,5 @@
/* Utility and Unix shadow routines for GNU Emacs support programs on NT.
- Copyright (C) 1994, 2002-2020 Free Software Foundation, Inc.
+ Copyright (C) 1994, 2002-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lib-src/pop.c b/lib-src/pop.c
index 886aa78275d..27ed89b836e 100644
--- a/lib-src/pop.c
+++ b/lib-src/pop.c
@@ -1,6 +1,6 @@
/* pop.c: client routines for talking to a POP3-protocol post-office server
-Copyright (C) 1991, 1993, 1996-1997, 1999, 2001-2020 Free Software
+Copyright (C) 1991, 1993, 1996-1997, 1999, 2001-2021 Free Software
Foundation, Inc.
Author: Jonathan Kamens <jik@security.ov.com>
diff --git a/lib-src/pop.h b/lib-src/pop.h
index 638671f5cc7..229714b68e3 100644
--- a/lib-src/pop.h
+++ b/lib-src/pop.h
@@ -1,5 +1,5 @@
/* pop.h: Header file for the "pop.c" client POP3 protocol.
- Copyright (C) 1991, 1993, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1991, 1993, 2001-2021 Free Software Foundation, Inc.
Author: Jonathan Kamens <jik@security.ov.com>
diff --git a/lib-src/rcs2log b/lib-src/rcs2log
index ba99538872b..7a033672f6d 100755
--- a/lib-src/rcs2log
+++ b/lib-src/rcs2log
@@ -2,7 +2,7 @@
# RCS to ChangeLog generator
-# Copyright (C) 1992-1998, 2001-2020 Free Software Foundation, Inc.
+# Copyright (C) 1992-1998, 2001-2021 Free Software Foundation, Inc.
# Author: Paul Eggert <eggert@cs.ucla.edu>
@@ -20,7 +20,7 @@
# along with this program. If not, see <https://www.gnu.org/licenses/>.
-Copyright='Copyright (C) 2020 Free Software Foundation, Inc.
+Copyright='Copyright (C) 2021 Free Software Foundation, Inc.
This program comes with NO WARRANTY, to the extent permitted by law.
You may redistribute copies of this program
under the terms of the GNU General Public License.
diff --git a/lib-src/update-game-score.c b/lib-src/update-game-score.c
index 93aa0393d94..f1242dfbe63 100644
--- a/lib-src/update-game-score.c
+++ b/lib-src/update-game-score.c
@@ -1,6 +1,6 @@
/* update-game-score.c --- Update a score file
-Copyright (C) 2002-2020 Free Software Foundation, Inc.
+Copyright (C) 2002-2021 Free Software Foundation, Inc.
Author: Colin Walters <walters@debian.org>
@@ -499,9 +499,9 @@ unlock_file (const char *filename, void *state)
char *lockpath = (char *) state;
int saved_errno = errno;
int ret = unlink (lockpath);
- int unlink_errno = errno;
+ if (0 <= ret)
+ errno = saved_errno;
free (lockpath);
- errno = ret < 0 ? unlink_errno : saved_errno;
return ret;
}
diff --git a/lib/Makefile.in b/lib/Makefile.in
index 06d8e56421b..91a6b5ff3f1 100644
--- a/lib/Makefile.in
+++ b/lib/Makefile.in
@@ -1,6 +1,6 @@
### @configure_input@
-# Copyright 2017-2020 Free Software Foundation, Inc.
+# Copyright 2017-2021 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
@@ -92,7 +92,7 @@ libegnu_a_OBJECTS = $(patsubst %.o,e-%.o,$(for_emacs_OBJECTS))
$(libegnu_a_OBJECTS) $(libgnu_a_OBJECTS): $(BUILT_SOURCES)
.c.o:
- $(AM_V_CC)$(CC) -c $(CPPFLAGS) $(ALL_CFLAGS) $<
+ $(AM_V_CC)$(CC) -c $(CPPFLAGS) $(ALL_CFLAGS) -o $@ $<
e-%.o: %.c
$(AM_V_CC)$(CC) -c $(CPPFLAGS) $(ALL_CFLAGS) -Demacs -o $@ $<
@@ -118,7 +118,7 @@ TAGS: $(ETAGS) $(tagsfiles)
.PHONY: $(ETAGS) tags
clean:
- rm -f ./*.[ao] ./*-t \#* $(DEPDIR)/*
+ rm -f ./*.[ao] ./*/*.o ./*-t \#* $(DEPDIR)/*.d $(DEPDIR)/*/*.d
mostlyclean: clean
rm -f $(filter-out %-t,$(MOSTLYCLEANFILES))
distclean bootstrap-clean: mostlyclean
@@ -127,7 +127,7 @@ distclean bootstrap-clean: mostlyclean
maintainer-clean: distclean
rm -f TAGS gnulib.mk
extraclean: distclean
- -rmdir sys 2>/dev/null
+ -rmdir malloc sys 2>/dev/null
.PHONY: mostlyclean clean distclean bootstrap-clean maintainer-clean
diff --git a/lib/_Noreturn.h b/lib/_Noreturn.h
index 394ca3c2aa2..38afe1d5672 100644
--- a/lib/_Noreturn.h
+++ b/lib/_Noreturn.h
@@ -1,5 +1,5 @@
/* A C macro for declaring that a function does not return.
- Copyright (C) 2011-2020 Free Software Foundation, Inc.
+ Copyright (C) 2011-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
diff --git a/lib/acl-errno-valid.c b/lib/acl-errno-valid.c
index cafae0b1b11..af1af82c9fc 100644
--- a/lib/acl-errno-valid.c
+++ b/lib/acl-errno-valid.c
@@ -1,6 +1,6 @@
/* Test whether ACLs are well supported on this system.
- Copyright 2013-2020 Free Software Foundation, Inc.
+ Copyright 2013-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
diff --git a/lib/acl-internal.c b/lib/acl-internal.c
index 1cb77a8338b..2b212e8fc45 100644
--- a/lib/acl-internal.c
+++ b/lib/acl-internal.c
@@ -1,6 +1,6 @@
/* Test whether a file has a nontrivial ACL. -*- coding: utf-8 -*-
- Copyright (C) 2002-2003, 2005-2020 Free Software Foundation, Inc.
+ Copyright (C) 2002-2003, 2005-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
diff --git a/lib/acl-internal.h b/lib/acl-internal.h
index 0e28e1a0d6d..ca302bf8cd5 100644
--- a/lib/acl-internal.h
+++ b/lib/acl-internal.h
@@ -1,6 +1,6 @@
/* Internal implementation of access control lists. -*- coding: utf-8 -*-
- Copyright (C) 2002-2003, 2005-2020 Free Software Foundation, Inc.
+ Copyright (C) 2002-2003, 2005-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
diff --git a/lib/acl.h b/lib/acl.h
index 374c147e8fb..7014b82f738 100644
--- a/lib/acl.h
+++ b/lib/acl.h
@@ -1,6 +1,6 @@
/* acl.c - access control lists
- Copyright (C) 2002, 2008-2020 Free Software Foundation, Inc.
+ Copyright (C) 2002, 2008-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
diff --git a/lib/acl_entries.c b/lib/acl_entries.c
index 14fca5f1732..6f70caf175e 100644
--- a/lib/acl_entries.c
+++ b/lib/acl_entries.c
@@ -1,6 +1,6 @@
/* Return the number of entries in an ACL.
- Copyright (C) 2002-2003, 2005-2020 Free Software Foundation, Inc.
+ Copyright (C) 2002-2003, 2005-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
diff --git a/lib/alloca.in.h b/lib/alloca.in.h
index c71e9bfed9e..0a6137e037c 100644
--- a/lib/alloca.in.h
+++ b/lib/alloca.in.h
@@ -1,6 +1,6 @@
/* Memory allocation on the stack.
- Copyright (C) 1995, 1999, 2001-2004, 2006-2020 Free Software Foundation,
+ Copyright (C) 1995, 1999, 2001-2004, 2006-2021 Free Software Foundation,
Inc.
This program is free software; you can redistribute it and/or modify it
diff --git a/lib/allocator.h b/lib/allocator.h
index 2b032383de2..cfa05357744 100644
--- a/lib/allocator.h
+++ b/lib/allocator.h
@@ -1,6 +1,6 @@
/* Memory allocators such as malloc+free.
- Copyright (C) 2011-2020 Free Software Foundation, Inc.
+ Copyright (C) 2011-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
diff --git a/lib/arg-nonnull.h b/lib/arg-nonnull.h
index db9d9ae116a..5b81b50a87d 100644
--- a/lib/arg-nonnull.h
+++ b/lib/arg-nonnull.h
@@ -1,5 +1,5 @@
/* A C macro for declaring that specific arguments must not be NULL.
- Copyright (C) 2009-2020 Free Software Foundation, Inc.
+ Copyright (C) 2009-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
diff --git a/lib/at-func.c b/lib/at-func.c
index 90022e05787..b6d9de754d1 100644
--- a/lib/at-func.c
+++ b/lib/at-func.c
@@ -1,5 +1,5 @@
/* Define at-style functions like fstatat, unlinkat, fchownat, etc.
- Copyright (C) 2006, 2009-2020 Free Software Foundation, Inc.
+ Copyright (C) 2006, 2009-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
diff --git a/lib/attribute.h b/lib/attribute.h
index 2836b99dad0..82245279eb1 100644
--- a/lib/attribute.h
+++ b/lib/attribute.h
@@ -1,6 +1,6 @@
/* ATTRIBUTE_* macros for using attributes in GCC and similar compilers
- Copyright 2020 Free Software Foundation, Inc.
+ Copyright 2020-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
@@ -80,7 +80,7 @@
/* Attributes for variadic functions. */
/* The variadic function expects a trailing NULL argument.
- ATTRIBUTE_SENTINEL () - The last argument is NULL.
+ ATTRIBUTE_SENTINEL () - The last argument is NULL (requires C99).
ATTRIBUTE_SENTINEL ((N)) - The (N+1)st argument from the end is NULL. */
/* Applies to: functions. */
#define ATTRIBUTE_SENTINEL(pos) _GL_ATTRIBUTE_SENTINEL (pos)
@@ -170,18 +170,21 @@
/* Applies to: function. */
#define ATTRIBUTE_ALWAYS_INLINE _GL_ATTRIBUTE_ALWAYS_INLINE
-/* The function does not affect observable state, and always returns a value.
- Compilers can omit duplicate calls with the same arguments if
- observable state is not changed between calls. (This attribute is
- looser than ATTRIBUTE_CONST.) */
+/* It is OK for a compiler to omit duplicate calls with the same arguments.
+ This attribute is safe for a function that neither depends on
+ nor affects observable state, and always returns exactly once -
+ e.g., does not loop forever, and does not call longjmp.
+ (This attribute is stricter than ATTRIBUTE_PURE.) */
/* Applies to: functions. */
-#define ATTRIBUTE_PURE _GL_ATTRIBUTE_PURE
+#define ATTRIBUTE_CONST _GL_ATTRIBUTE_CONST
-/* The function neither depends on nor affects observable state,
- and always returns a value. Compilers can omit duplicate calls with
- the same arguments. (This attribute is stricter than ATTRIBUTE_PURE.) */
+/* It is OK for a compiler to omit duplicate calls with the same
+ arguments if observable state is not changed between calls.
+ This attribute is safe for a function that does not affect
+ observable state, and always returns exactly once.
+ (This attribute is looser than ATTRIBUTE_CONST.) */
/* Applies to: functions. */
-#define ATTRIBUTE_CONST _GL_ATTRIBUTE_CONST
+#define ATTRIBUTE_PURE _GL_ATTRIBUTE_PURE
/* The function is rarely executed. */
/* Applies to: functions. */
diff --git a/lib/binary-io.c b/lib/binary-io.c
index e84e223fc88..f2678972ef7 100644
--- a/lib/binary-io.c
+++ b/lib/binary-io.c
@@ -1,5 +1,5 @@
/* Binary mode I/O.
- Copyright 2017-2020 Free Software Foundation, Inc.
+ Copyright 2017-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
diff --git a/lib/binary-io.h b/lib/binary-io.h
index d17af7c3807..8654fd2d39f 100644
--- a/lib/binary-io.h
+++ b/lib/binary-io.h
@@ -1,5 +1,5 @@
/* Binary mode I/O.
- Copyright (C) 2001, 2003, 2005, 2008-2020 Free Software Foundation, Inc.
+ Copyright (C) 2001, 2003, 2005, 2008-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
diff --git a/lib/byteswap.in.h b/lib/byteswap.in.h
index e690b3c17e0..2b7d5abe1b6 100644
--- a/lib/byteswap.in.h
+++ b/lib/byteswap.in.h
@@ -1,5 +1,5 @@
/* byteswap.h - Byte swapping
- Copyright (C) 2005, 2007, 2009-2020 Free Software Foundation, Inc.
+ Copyright (C) 2005, 2007, 2009-2021 Free Software Foundation, Inc.
Written by Oskar Liljeblad <oskar@osk.mine.nu>, 2005.
This program is free software: you can redistribute it and/or modify
diff --git a/lib/c++defs.h b/lib/c++defs.h
index 6a9bf295eb5..39df1bc76bc 100644
--- a/lib/c++defs.h
+++ b/lib/c++defs.h
@@ -1,5 +1,5 @@
/* C++ compatible function declaration macros.
- Copyright (C) 2010-2020 Free Software Foundation, Inc.
+ Copyright (C) 2010-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
@@ -181,6 +181,14 @@
_GL_EXTERN_C int _gl_cxxalias_dummy
#endif
+/* _GL_CXXALIAS_MDA_CAST (func, rettype, parameters);
+ is like _GL_CXXALIAS_MDA (func, rettype, parameters);
+ except that the C function func may have a slightly different declaration.
+ A cast is used to silence the "invalid conversion" error that would
+ otherwise occur. */
+#define _GL_CXXALIAS_MDA_CAST(func,rettype,parameters) \
+ _GL_CXXALIAS_RPL_CAST_1 (func, _##func, rettype, parameters)
+
/* _GL_CXXALIAS_SYS (func, rettype, parameters);
declares a C++ alias called GNULIB_NAMESPACE::func
that redirects to the system provided function func, if GNULIB_NAMESPACE
diff --git a/lib/c-ctype.h b/lib/c-ctype.h
index fbd11b34508..bf24a88310e 100644
--- a/lib/c-ctype.h
+++ b/lib/c-ctype.h
@@ -5,7 +5,7 @@
<ctype.h> functions' behaviour depends on the current locale set via
setlocale.
- Copyright (C) 2000-2003, 2006, 2008-2020 Free Software Foundation, Inc.
+ Copyright (C) 2000-2003, 2006, 2008-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
diff --git a/lib/c-strcase.h b/lib/c-strcase.h
index 3b711f5aa57..089edfe7ebe 100644
--- a/lib/c-strcase.h
+++ b/lib/c-strcase.h
@@ -1,5 +1,5 @@
/* Case-insensitive string comparison functions in C locale.
- Copyright (C) 1995-1996, 2001, 2003, 2005, 2009-2020 Free Software
+ Copyright (C) 1995-1996, 2001, 2003, 2005, 2009-2021 Free Software
Foundation, Inc.
This program is free software; you can redistribute it and/or modify
diff --git a/lib/c-strcasecmp.c b/lib/c-strcasecmp.c
index f1a4b98fa55..55479d6a338 100644
--- a/lib/c-strcasecmp.c
+++ b/lib/c-strcasecmp.c
@@ -1,5 +1,5 @@
/* c-strcasecmp.c -- case insensitive string comparator in C locale
- Copyright (C) 1998-1999, 2005-2006, 2009-2020 Free Software Foundation, Inc.
+ Copyright (C) 1998-1999, 2005-2006, 2009-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
diff --git a/lib/c-strncasecmp.c b/lib/c-strncasecmp.c
index 1d6e1411a67..02bc0f2ecd5 100644
--- a/lib/c-strncasecmp.c
+++ b/lib/c-strncasecmp.c
@@ -1,5 +1,5 @@
/* c-strncasecmp.c -- case insensitive string comparator in C locale
- Copyright (C) 1998-1999, 2005-2006, 2009-2020 Free Software Foundation, Inc.
+ Copyright (C) 1998-1999, 2005-2006, 2009-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
diff --git a/lib/canonicalize-lgpl.c b/lib/canonicalize-lgpl.c
index 0b89d2a1842..b6dc3a447ab 100644
--- a/lib/canonicalize-lgpl.c
+++ b/lib/canonicalize-lgpl.c
@@ -1,19 +1,20 @@
/* Return the canonical absolute name of a given file.
- Copyright (C) 1996-2020 Free Software Foundation, Inc.
+ Copyright (C) 1996-2021 Free Software Foundation, Inc.
This file is part of the GNU C Library.
- 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.
+ 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.
- This program is distributed in the hope that it will be useful,
+ 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.
+ 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/>. */
+ 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/>. */
#ifndef _LIBC
/* Don't use __attribute__ __nonnull__ in this compilation unit. Otherwise gcc
@@ -21,37 +22,35 @@
# define _GL_ARG_NONNULL(params)
# define _GL_USE_STDLIB_ALLOC 1
-# include <config.h>
+# include <libc-config.h>
#endif
-#if !HAVE_CANONICALIZE_FILE_NAME || !FUNC_REALPATH_WORKS || defined _LIBC
-
/* Specification. */
#include <stdlib.h>
-#include <alloca.h>
-#include <string.h>
-#include <unistd.h>
+#include <errno.h>
+#include <fcntl.h>
#include <limits.h>
-#if HAVE_SYS_PARAM_H || defined _LIBC
-# include <sys/param.h>
-#endif
+#include <stdbool.h>
+#include <string.h>
#include <sys/stat.h>
-#include <errno.h>
-#include <stddef.h>
+#include <unistd.h>
+
+#include <eloop-threshold.h>
+#include <filename.h>
+#include <idx.h>
+#include <intprops.h>
+#include <scratch_buffer.h>
#ifdef _LIBC
# include <shlib-compat.h>
+# define GCC_LINT 1
+# define _GL_ATTRIBUTE_PURE __attribute__ ((__pure__))
#else
-# define SHLIB_COMPAT(lib, introduced, obsoleted) 0
-# define versioned_symbol(lib, local, symbol, version) extern int dummy
-# define compat_symbol(lib, local, symbol, version)
-# define weak_alias(local, symbol)
# define __canonicalize_file_name canonicalize_file_name
# define __realpath realpath
# include "pathmax.h"
-# include "malloca.h"
-# include "filename.h"
+# define __faccessat faccessat
# if defined _WIN32 && !defined __CYGWIN__
# define __getcwd _getcwd
# elif HAVE_GETCWD
@@ -72,57 +71,141 @@
# else
# define __getcwd(buf, max) getwd (buf)
# endif
+# define __mempcpy mempcpy
+# define __pathconf pathconf
+# define __rawmemchr rawmemchr
# define __readlink readlink
-# define __set_errno(e) errno = (e)
-# ifndef MAXSYMLINKS
-# ifdef SYMLOOP_MAX
-# define MAXSYMLINKS SYMLOOP_MAX
-# else
-# define MAXSYMLINKS 20
-# endif
-# endif
+# define __stat stat
#endif
-#ifndef DOUBLE_SLASH_IS_DISTINCT_ROOT
-# define DOUBLE_SLASH_IS_DISTINCT_ROOT 0
+/* Suppress bogus GCC -Wmaybe-uninitialized warnings. */
+#if defined GCC_LINT || defined lint
+# define IF_LINT(Code) Code
+#else
+# define IF_LINT(Code) /* empty */
#endif
-/* Define this independently so that stdint.h is not a prerequisite. */
-#ifndef SIZE_MAX
-# define SIZE_MAX ((size_t) -1)
+/* 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
-#if !FUNC_REALPATH_WORKS || defined _LIBC
+#if defined _LIBC || !FUNC_REALPATH_WORKS
-static void
-alloc_failed (void)
+/* Return true if FILE's existence can be shown, false (setting errno)
+ otherwise. Follow symbolic links. */
+static bool
+file_accessible (char const *file)
{
-#if defined _WIN32 && ! defined __CYGWIN__
- /* Avoid errno problem without using the malloc or realloc modules; see:
- https://lists.gnu.org/r/bug-gnulib/2016-08/msg00025.html */
- errno = ENOMEM;
+# if defined _LIBC || HAVE_FACCESSAT
+ return __faccessat (AT_FDCWD, file, F_OK, AT_EACCESS) == 0;
+# else
+ struct stat st;
+ return __stat (file, &st) == 0 || errno == EOVERFLOW;
+# endif
+}
+
+/* True if concatenating END as a suffix to a file name means that the
+ code needs to check that the file name is that of a searchable
+ directory, since the canonicalize_filename_mode_stk code won't
+ check this later anyway when it checks an ordinary file name
+ component within END. END must either be empty, or start with a
+ slash. */
+
+static bool _GL_ATTRIBUTE_PURE
+suffix_requires_dir_check (char const *end)
+{
+ /* If END does not start with a slash, the suffix is OK. */
+ while (ISSLASH (*end))
+ {
+ /* Two or more slashes act like a single slash. */
+ do
+ end++;
+ while (ISSLASH (*end));
+
+ switch (*end++)
+ {
+ default: return false; /* An ordinary file name component is OK. */
+ case '\0': return true; /* Trailing "/" is trouble. */
+ case '.': break; /* Possibly "." or "..". */
+ }
+ /* Trailing "/.", or "/.." even if not trailing, is trouble. */
+ if (!*end || (*end == '.' && (!end[1] || ISSLASH (end[1]))))
+ return true;
+ }
+
+ return false;
+}
+
+/* Append this to a file name to test whether it is a searchable directory.
+ On POSIX platforms "/" suffices, but "/./" is sometimes needed on
+ 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
+static char const dir_suffix[] = "/";
+#else
+static char const dir_suffix[] = "/./";
#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.
+ Store garbage into DIREND[0 .. strlen (dir_suffix)]. */
+
+static bool
+dir_check (char *dir, char *dirend)
+{
+ strcpy (dirend, dir_suffix);
+ return file_accessible (dir);
}
-/* Return the canonical absolute name of file NAME. A canonical name
- does not contain any ".", ".." components nor any repeated path
- separators ('/') or symlinks. All path components must exist. If
- RESOLVED is null, the result is malloc'd; otherwise, if the
- canonical name is PATH_MAX chars or more, returns null with 'errno'
- set to ENAMETOOLONG; if the name fits in fewer than PATH_MAX chars,
- returns the name in RESOLVED. If the name cannot be resolved and
- RESOLVED is non-NULL, it contains the path of the first component
- that cannot be resolved. If the path can be resolved, RESOLVED
- holds the same value as the value returned. */
+static idx_t
+get_path_max (void)
+{
+# ifdef PATH_MAX
+ long int path_max = PATH_MAX;
+# else
+ /* The caller invoked realpath with a null RESOLVED, even though
+ PATH_MAX is not defined as a constant. The glibc manual says
+ programs should not do this, and POSIX says the behavior is undefined.
+ Historically, glibc here used the result of pathconf, or 1024 if that
+ failed; stay consistent with this (dubious) historical practice. */
+ int err = errno;
+ long int path_max = __pathconf ("/", _PC_PATH_MAX);
+ __set_errno (err);
+# endif
+ return path_max < 0 ? 1024 : path_max <= IDX_MAX ? path_max : IDX_MAX;
+}
-char *
-__realpath (const char *name, char *resolved)
+/* Act like __realpath (see below), with an additional argument
+ rname_buf that can be used as temporary storage.
+
+ If GCC_LINT is defined, do not inline this function with GCC 10.1
+ and later, to avoid creating a pointer to the stack that GCC
+ -Wreturn-local-addr incorrectly complains about. See:
+ https://gcc.gnu.org/bugzilla/show_bug.cgi?id=93644
+ Although the noinline attribute can hurt performance a bit, no better way
+ 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
+__attribute__ ((__noinline__))
+# elif __OPTIMIZE__ && !__NO_INLINE__
+# define GCC_BOGUS_WRETURN_LOCAL_ADDR
+# endif
+#endif
+static char *
+realpath_stk (const char *name, char *resolved,
+ struct scratch_buffer *rname_buf)
{
- char *rpath, *dest, *extra_buf = NULL;
- const char *start, *end, *rpath_limit;
- long int path_max;
+ char *dest;
+ char const *start;
+ char const *end;
int num_links = 0;
- size_t prefix_len;
if (name == NULL)
{
@@ -142,205 +225,148 @@ __realpath (const char *name, char *resolved)
return NULL;
}
-#ifdef PATH_MAX
- path_max = PATH_MAX;
-#else
- path_max = pathconf (name, _PC_PATH_MAX);
- if (path_max <= 0)
- path_max = 8192;
-#endif
-
- if (resolved == NULL)
- {
- rpath = malloc (path_max);
- if (rpath == NULL)
- {
- alloc_failed ();
- return NULL;
- }
- }
- else
- rpath = resolved;
- rpath_limit = rpath + path_max;
+ struct scratch_buffer extra_buffer, link_buffer;
+ scratch_buffer_init (&extra_buffer);
+ scratch_buffer_init (&link_buffer);
+ scratch_buffer_init (rname_buf);
+ char *rname_on_stack = rname_buf->data;
+ char *rname = rname_on_stack;
+ bool end_in_extra_buffer = false;
+ bool failed = true;
/* This is always zero for Posix hosts, but can be 2 for MS-Windows
and MS-DOS X:/foo/bar file names. */
- prefix_len = FILE_SYSTEM_PREFIX_LEN (name);
+ idx_t prefix_len = FILE_SYSTEM_PREFIX_LEN (name);
if (!IS_ABSOLUTE_FILE_NAME (name))
{
- if (!__getcwd (rpath, path_max))
+ while (!__getcwd (rname, rname_buf->length))
{
- rpath[0] = '\0';
- goto error;
+ if (errno != ERANGE)
+ {
+ dest = rname;
+ goto error;
+ }
+ if (!scratch_buffer_grow (rname_buf))
+ goto error_nomem;
+ rname = rname_buf->data;
}
- dest = strchr (rpath, '\0');
+ dest = __rawmemchr (rname, '\0');
start = name;
- prefix_len = FILE_SYSTEM_PREFIX_LEN (rpath);
+ prefix_len = FILE_SYSTEM_PREFIX_LEN (rname);
}
else
{
- dest = rpath;
- if (prefix_len)
- {
- memcpy (rpath, name, prefix_len);
- dest += prefix_len;
- }
+ dest = __mempcpy (rname, name, prefix_len);
*dest++ = '/';
if (DOUBLE_SLASH_IS_DISTINCT_ROOT)
{
- if (ISSLASH (name[1]) && !ISSLASH (name[2]) && !prefix_len)
+ if (prefix_len == 0 /* implies ISSLASH (name[0]) */
+ && ISSLASH (name[1]) && !ISSLASH (name[2]))
*dest++ = '/';
*dest = '\0';
}
start = name + prefix_len;
}
- for (end = start; *start; start = end)
+ for ( ; *start; start = end)
{
-#ifdef _LIBC
- struct stat64 st;
-#else
- struct stat st;
-#endif
-
- /* Skip sequence of multiple path-separators. */
+ /* Skip sequence of multiple file name separators. */
while (ISSLASH (*start))
++start;
- /* Find end of path component. */
+ /* Find end of component. */
for (end = start; *end && !ISSLASH (*end); ++end)
/* Nothing. */;
- if (end - start == 0)
+ /* Length of this file name component; it can be zero if a file
+ name ends in '/'. */
+ idx_t startlen = end - start;
+
+ if (startlen == 0)
break;
- else if (end - start == 1 && start[0] == '.')
+ else if (startlen == 1 && start[0] == '.')
/* nothing */;
- else if (end - start == 2 && start[0] == '.' && start[1] == '.')
+ else if (startlen == 2 && start[0] == '.' && start[1] == '.')
{
/* Back up to previous component, ignore if at root already. */
- if (dest > rpath + prefix_len + 1)
- for (--dest; dest > rpath && !ISSLASH (dest[-1]); --dest)
+ if (dest > rname + prefix_len + 1)
+ for (--dest; dest > rname && !ISSLASH (dest[-1]); --dest)
continue;
if (DOUBLE_SLASH_IS_DISTINCT_ROOT
- && dest == rpath + 1 && !prefix_len
+ && dest == rname + 1 && !prefix_len
&& ISSLASH (*dest) && !ISSLASH (dest[1]))
dest++;
}
else
{
- size_t new_size;
-
if (!ISSLASH (dest[-1]))
*dest++ = '/';
- if (dest + (end - start) >= rpath_limit)
+ while (rname + rname_buf->length - dest
+ < startlen + sizeof dir_suffix)
{
- ptrdiff_t dest_offset = dest - rpath;
- char *new_rpath;
-
- if (resolved)
- {
- __set_errno (ENAMETOOLONG);
- if (dest > rpath + prefix_len + 1)
- dest--;
- *dest = '\0';
- goto error;
- }
- new_size = rpath_limit - rpath;
- if (end - start + 1 > path_max)
- new_size += end - start + 1;
- else
- new_size += path_max;
- new_rpath = (char *) realloc (rpath, new_size);
- if (new_rpath == NULL)
- {
- alloc_failed ();
- goto error;
- }
- rpath = new_rpath;
- rpath_limit = rpath + new_size;
-
- dest = rpath + dest_offset;
+ idx_t dest_offset = dest - rname;
+ if (!scratch_buffer_grow_preserve (rname_buf))
+ goto error_nomem;
+ rname = rname_buf->data;
+ dest = rname + dest_offset;
}
-#ifdef _LIBC
- dest = __mempcpy (dest, start, end - start);
-#else
- memcpy (dest, start, end - start);
- dest += end - start;
-#endif
+ dest = __mempcpy (dest, start, startlen);
*dest = '\0';
- /* FIXME: if lstat fails with errno == EOVERFLOW,
- the entry exists. */
-#ifdef _LIBC
- if (__lxstat64 (_STAT_VER, rpath, &st) < 0)
-#else
- if (lstat (rpath, &st) < 0)
-#endif
- goto error;
-
- if (S_ISLNK (st.st_mode))
+ char *buf;
+ ssize_t n;
+ while (true)
{
- char *buf;
- size_t len;
- ssize_t n;
-
- if (++num_links > MAXSYMLINKS)
+ buf = link_buffer.data;
+ idx_t bufsize = link_buffer.length;
+ n = __readlink (rname, buf, bufsize - 1);
+ if (n < bufsize - 1)
+ break;
+ if (!scratch_buffer_grow (&link_buffer))
+ goto error_nomem;
+ }
+ if (0 <= n)
+ {
+ if (++num_links > __eloop_threshold ())
{
__set_errno (ELOOP);
goto error;
}
- buf = malloca (path_max);
- if (!buf)
- {
- __set_errno (ENOMEM);
- goto error;
- }
-
- n = __readlink (rpath, buf, path_max - 1);
- if (n < 0)
- {
- int saved_errno = errno;
- freea (buf);
- __set_errno (saved_errno);
- goto error;
- }
buf[n] = '\0';
- if (!extra_buf)
+ char *extra_buf = extra_buffer.data;
+ idx_t end_idx IF_LINT (= 0);
+ if (end_in_extra_buffer)
+ end_idx = end - extra_buf;
+ size_t len = strlen (end);
+ if (NARROW_ADDRESSES && INT_ADD_OVERFLOW (len, n))
{
- extra_buf = malloca (path_max);
- if (!extra_buf)
- {
- freea (buf);
- __set_errno (ENOMEM);
- goto error;
- }
+ __set_errno (ENOMEM);
+ goto error_nomem;
}
-
- len = strlen (end);
- /* Check that n + len + 1 doesn't overflow and is <= path_max. */
- if (n >= SIZE_MAX - len || n + len >= path_max)
+ while (extra_buffer.length <= len + n)
{
- freea (buf);
- __set_errno (ENAMETOOLONG);
- goto error;
+ if (!scratch_buffer_grow_preserve (&extra_buffer))
+ goto error_nomem;
+ extra_buf = extra_buffer.data;
}
+ if (end_in_extra_buffer)
+ end = extra_buf + end_idx;
/* Careful here, end may be a pointer into extra_buf... */
memmove (&extra_buf[n], end, len + 1);
name = end = memcpy (extra_buf, buf, n);
+ end_in_extra_buffer = true;
if (IS_ABSOLUTE_FILE_NAME (buf))
{
- size_t pfxlen = FILE_SYSTEM_PREFIX_LEN (buf);
+ idx_t pfxlen = FILE_SYSTEM_PREFIX_LEN (buf);
- if (pfxlen)
- memcpy (rpath, buf, pfxlen);
- dest = rpath + pfxlen;
+ dest = __mempcpy (rname, buf, pfxlen);
*dest++ = '/'; /* It's an absolute symlink */
if (DOUBLE_SLASH_IS_DISTINCT_ROOT)
{
@@ -355,44 +381,67 @@ __realpath (const char *name, char *resolved)
{
/* Back up to previous component, ignore if at root
already: */
- if (dest > rpath + prefix_len + 1)
- for (--dest; dest > rpath && !ISSLASH (dest[-1]); --dest)
+ if (dest > rname + prefix_len + 1)
+ for (--dest; dest > rname && !ISSLASH (dest[-1]); --dest)
continue;
- if (DOUBLE_SLASH_IS_DISTINCT_ROOT && dest == rpath + 1
+ if (DOUBLE_SLASH_IS_DISTINCT_ROOT && dest == rname + 1
&& ISSLASH (*dest) && !ISSLASH (dest[1]) && !prefix_len)
dest++;
}
}
- else if (!S_ISDIR (st.st_mode) && *end != '\0')
- {
- __set_errno (ENOTDIR);
- goto error;
- }
+ else if (! (suffix_requires_dir_check (end)
+ ? dir_check (rname, dest)
+ : errno == EINVAL))
+ goto error;
}
}
- if (dest > rpath + prefix_len + 1 && ISSLASH (dest[-1]))
+ if (dest > rname + prefix_len + 1 && ISSLASH (dest[-1]))
--dest;
- if (DOUBLE_SLASH_IS_DISTINCT_ROOT && dest == rpath + 1 && !prefix_len
+ if (DOUBLE_SLASH_IS_DISTINCT_ROOT && dest == rname + 1 && !prefix_len
&& ISSLASH (*dest) && !ISSLASH (dest[1]))
dest++;
- *dest = '\0';
+ failed = false;
- if (extra_buf)
- freea (extra_buf);
+error:
+ *dest++ = '\0';
+ if (resolved != NULL && dest - rname <= get_path_max ())
+ rname = strcpy (resolved, rname);
- return rpath;
+error_nomem:
+ scratch_buffer_free (&extra_buffer);
+ scratch_buffer_free (&link_buffer);
-error:
- {
- int saved_errno = errno;
- if (extra_buf)
- freea (extra_buf);
- if (resolved == NULL)
- free (rpath);
- __set_errno (saved_errno);
- }
- return NULL;
+ if (failed || rname == resolved)
+ {
+ scratch_buffer_free (rname_buf);
+ return failed ? NULL : resolved;
+ }
+
+ return scratch_buffer_dupfree (rname_buf, dest - rname);
+}
+
+/* Return the canonical absolute name of file NAME. A canonical name
+ does not contain any ".", ".." components nor any repeated file name
+ separators ('/') or symlinks. All file name components must exist. If
+ RESOLVED is null, the result is malloc'd; otherwise, if the
+ canonical name is PATH_MAX chars or more, returns null with 'errno'
+ set to ENAMETOOLONG; if the name fits in fewer than PATH_MAX chars,
+ returns the name in RESOLVED. If the name cannot be resolved and
+ RESOLVED is non-NULL, it contains the name of the first component
+ that cannot be resolved. If the name can be resolved, RESOLVED
+ holds the same value as the value returned. */
+
+char *
+__realpath (const char *name, char *resolved)
+{
+ #ifdef GCC_BOGUS_WRETURN_LOCAL_ADDR
+ #warning "GCC might issue a bogus -Wreturn-local-addr warning here."
+ #warning "See <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=93644>."
+ #endif
+ struct scratch_buffer rname_buffer;
+ return realpath_stk (name, resolved, &rname_buffer);
}
+libc_hidden_def (__realpath)
versioned_symbol (libc, __realpath, realpath, GLIBC_2_3);
#endif /* !FUNC_REALPATH_WORKS || defined _LIBC */
@@ -420,11 +469,3 @@ __canonicalize_file_name (const char *name)
return __realpath (name, NULL);
}
weak_alias (__canonicalize_file_name, canonicalize_file_name)
-
-#else
-
-/* This declaration is solely to ensure that after preprocessing
- this file is never empty. */
-typedef int dummy;
-
-#endif
diff --git a/lib/careadlinkat.c b/lib/careadlinkat.c
index e43aa42d5c4..18cfc114b69 100644
--- a/lib/careadlinkat.c
+++ b/lib/careadlinkat.c
@@ -1,6 +1,6 @@
/* Read symbolic links into a buffer without size limitation, relative to fd.
- Copyright (C) 2001, 2003-2004, 2007, 2009-2020 Free Software Foundation,
+ Copyright (C) 2001, 2003-2004, 2007, 2009-2021 Free Software Foundation,
Inc.
This program is free software: you can redistribute it and/or modify
@@ -51,8 +51,12 @@ enum { STACK_BUF_SIZE = 1024 };
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 (defined GCC_LINT || defined lint) && _GL_GNUC_PREREQ (10, 1)
+#if _GL_GNUC_PREREQ (10, 1)
+# if defined GCC_LINT || defined lint
__attribute__ ((__noinline__))
+# elif __OPTIMIZE__ && !__NO_INLINE__
+# define GCC_BOGUS_WRETURN_LOCAL_ADDR
+# endif
#endif
static char *
readlink_stk (int fd, char const *filename,
@@ -85,18 +89,13 @@ readlink_stk (int fd, char const *filename,
size_t link_size;
if (link_length < 0)
{
- /* On AIX 5L v5.3 and HP-UX 11i v2 04/09, readlink returns -1
- with errno == ERANGE if the buffer is too small. */
- int readlinkat_errno = errno;
- if (readlinkat_errno != ERANGE)
+ if (buf != buffer)
{
- if (buf != buffer)
- {
- alloc->free (buf);
- errno = readlinkat_errno;
- }
- return NULL;
+ int readlinkat_errno = errno;
+ alloc->free (buf);
+ errno = readlinkat_errno;
}
+ return NULL;
}
link_size = link_length;
@@ -180,10 +179,11 @@ careadlinkat (int fd, char const *filename,
/* Allocate the initial buffer on the stack. This way, in the
common case of a symlink of small size, we get away with a
single small malloc instead of a big malloc followed by a
- shrinking realloc.
-
- If GCC -Wreturn-local-addr warns about this buffer, the warning
- is bogus; see readlink_stk. */
+ shrinking realloc. */
+ #ifdef GCC_BOGUS_WRETURN_LOCAL_ADDR
+ #warning "GCC might issue a bogus -Wreturn-local-addr warning here."
+ #warning "See <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=93644>."
+ #endif
char stack_buf[STACK_BUF_SIZE];
return readlink_stk (fd, filename, buffer, buffer_size, alloc,
preadlinkat, stack_buf);
diff --git a/lib/careadlinkat.h b/lib/careadlinkat.h
index a4a37b274d0..c506fac3cbe 100644
--- a/lib/careadlinkat.h
+++ b/lib/careadlinkat.h
@@ -1,6 +1,6 @@
/* Read symbolic links into a buffer without size limitation, relative to fd.
- Copyright (C) 2011-2020 Free Software Foundation, Inc.
+ Copyright (C) 2011-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
diff --git a/lib/cdefs.h b/lib/cdefs.h
index ff7c628a264..2a3dc9666b9 100644
--- a/lib/cdefs.h
+++ b/lib/cdefs.h
@@ -1,4 +1,4 @@
-/* Copyright (C) 1992-2020 Free Software Foundation, Inc.
+/* Copyright (C) 1992-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
@@ -75,11 +75,11 @@
/* GCC can always grok prototypes. For C++ programs we add throw()
to help it optimize the function calls. But this works only with
- gcc 2.8.x and egcs. For gcc 3.2 and up we even mark C functions
+ 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, 3) || __glibc_clang_has_attribute (__nothrow__))
+ && (__GNUC_PREREQ (3, 4) || __glibc_clang_has_attribute (__nothrow__))
# define __THROW __attribute__ ((__nothrow__ __LEAF))
# define __THROWNL __attribute__ ((__nothrow__))
# define __NTH(fct) __attribute__ ((__nothrow__ __LEAF)) fct
diff --git a/lib/cloexec.c b/lib/cloexec.c
index 510be3d57ec..8363ddaa609 100644
--- a/lib/cloexec.c
+++ b/lib/cloexec.c
@@ -1,6 +1,6 @@
/* cloexec.c - set or clear the close-on-exec descriptor flag
- Copyright (C) 1991, 2004-2006, 2009-2020 Free Software Foundation, Inc.
+ Copyright (C) 1991, 2004-2006, 2009-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
diff --git a/lib/cloexec.h b/lib/cloexec.h
index f14a99736d5..5ca0e6413e7 100644
--- a/lib/cloexec.h
+++ b/lib/cloexec.h
@@ -1,6 +1,6 @@
/* cloexec.c - set or clear the close-on-exec descriptor flag
- Copyright (C) 2004, 2009-2020 Free Software Foundation, Inc.
+ Copyright (C) 2004, 2009-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
diff --git a/lib/close-stream.c b/lib/close-stream.c
index 04bc8009a57..86f6d6e1de2 100644
--- a/lib/close-stream.c
+++ b/lib/close-stream.c
@@ -1,6 +1,6 @@
/* Close a stream, with nicer error checking than fclose's.
- Copyright (C) 1998-2002, 2004, 2006-2020 Free Software Foundation, Inc.
+ Copyright (C) 1998-2002, 2004, 2006-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
diff --git a/lib/copy-file-range.c b/lib/copy-file-range.c
index 069f1444dc2..e73c78b5aa7 100644
--- a/lib/copy-file-range.c
+++ b/lib/copy-file-range.c
@@ -1,5 +1,5 @@
/* Stub for copy_file_range
- Copyright 2019-2020 Free Software Foundation, Inc.
+ Copyright 2019-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
diff --git a/lib/count-leading-zeros.h b/lib/count-leading-zeros.h
index 7cf605a5f64..575ec3b4d0e 100644
--- a/lib/count-leading-zeros.h
+++ b/lib/count-leading-zeros.h
@@ -1,5 +1,5 @@
/* count-leading-zeros.h -- counts the number of leading 0 bits in a word.
- Copyright (C) 2012-2020 Free Software Foundation, Inc.
+ Copyright (C) 2012-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
diff --git a/lib/count-one-bits.h b/lib/count-one-bits.h
index a9e166aed8c..1a14f11f152 100644
--- a/lib/count-one-bits.h
+++ b/lib/count-one-bits.h
@@ -1,5 +1,5 @@
/* count-one-bits.h -- counts the number of 1-bits in a word.
- Copyright (C) 2007-2020 Free Software Foundation, Inc.
+ Copyright (C) 2007-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
diff --git a/lib/count-trailing-zeros.h b/lib/count-trailing-zeros.h
index 727b21dcc56..5a8ef563ea2 100644
--- a/lib/count-trailing-zeros.h
+++ b/lib/count-trailing-zeros.h
@@ -1,5 +1,5 @@
/* count-trailing-zeros.h -- counts the number of trailing 0 bits in a word.
- Copyright 2013-2020 Free Software Foundation, Inc.
+ Copyright 2013-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
diff --git a/lib/diffseq.h b/lib/diffseq.h
index 26e10bdd043..1cac430eddd 100644
--- a/lib/diffseq.h
+++ b/lib/diffseq.h
@@ -1,6 +1,6 @@
/* Analyze differences between two vectors.
- Copyright (C) 1988-1989, 1992-1995, 2001-2004, 2006-2020 Free Software
+ Copyright (C) 1988-1989, 1992-1995, 2001-2004, 2006-2021 Free Software
Foundation, Inc.
This program is free software: you can redistribute it and/or modify
diff --git a/lib/dirent.in.h b/lib/dirent.in.h
index 23c4e055774..2e2c5119a11 100644
--- a/lib/dirent.in.h
+++ b/lib/dirent.in.h
@@ -1,5 +1,5 @@
/* A GNU-like <dirent.h>.
- Copyright (C) 2006-2020 Free Software Foundation, Inc.
+ Copyright (C) 2006-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
diff --git a/lib/dirfd.c b/lib/dirfd.c
index f6539772feb..ced7531c5e0 100644
--- a/lib/dirfd.c
+++ b/lib/dirfd.c
@@ -1,6 +1,6 @@
/* dirfd.c -- return the file descriptor associated with an open DIR*
- Copyright (C) 2001, 2006, 2008-2020 Free Software Foundation, Inc.
+ Copyright (C) 2001, 2006, 2008-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
diff --git a/lib/dtotimespec.c b/lib/dtotimespec.c
index 40adbe53f12..73061a3309c 100644
--- a/lib/dtotimespec.c
+++ b/lib/dtotimespec.c
@@ -1,6 +1,6 @@
/* Convert double to timespec.
- Copyright (C) 2011-2020 Free Software Foundation, Inc.
+ Copyright (C) 2011-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
diff --git a/lib/dup2.c b/lib/dup2.c
index 323e19b25ec..c4a0a29fbd0 100644
--- a/lib/dup2.c
+++ b/lib/dup2.c
@@ -1,6 +1,6 @@
/* Duplicate an open file descriptor to a specified file descriptor.
- Copyright (C) 1999, 2004-2007, 2009-2020 Free Software Foundation, Inc.
+ Copyright (C) 1999, 2004-2007, 2009-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
diff --git a/lib/eloop-threshold.h b/lib/eloop-threshold.h
new file mode 100644
index 00000000000..27d07a72960
--- /dev/null
+++ b/lib/eloop-threshold.h
@@ -0,0 +1,83 @@
+/* Threshold at which to diagnose ELOOP. Generic version.
+ Copyright (C) 2012-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/>. */
+
+#ifndef _ELOOP_THRESHOLD_H
+#define _ELOOP_THRESHOLD_H 1
+
+#include <limits.h>
+#ifdef _LIBC
+# include <sys/param.h>
+# define _GL_ATTRIBUTE_CONST __attribute__ ((const))
+#else
+# include <unistd.h>
+# include "minmax.h"
+# define __sysconf sysconf
+# if (!defined SYMLOOP_MAX \
+ && ! (defined _SC_SYMLOOP_MAX && defined _POSIX_SYMLOOP_MAX))
+# define SYMLOOP_MAX 8
+# endif
+#endif
+
+/* POSIX specifies SYMLOOP_MAX as the "Maximum number of symbolic
+ links that can be reliably traversed in the resolution of a
+ pathname in the absence of a loop." This makes it a minimum that
+ we should certainly accept. But it leaves open the possibility
+ that more might sometimes work--just not "reliably".
+
+ For example, Linux implements a complex policy whereby there is a
+ small limit on the number of direct symlink traversals (a symlink
+ to a symlink to a symlink), but larger limit on the total number of
+ symlink traversals overall. Hence the SYMLOOP_MAX number should be
+ the small one, but the limit library functions enforce on users
+ should be the larger one.
+
+ So, we use the larger of the reported SYMLOOP_MAX (if any) and our
+ own constant MIN_ELOOP_THRESHOLD, below. This constant should be
+ large enough that it never rules out a file name and directory tree
+ that the underlying system (i.e. calls to 'open' et al) would
+ resolve successfully. It should be small enough that actual loops
+ are detected without a huge number of iterations. */
+
+#ifndef MIN_ELOOP_THRESHOLD
+# define MIN_ELOOP_THRESHOLD 40
+#endif
+
+/* Return the maximum number of symlink traversals to permit
+ before diagnosing ELOOP. */
+static inline unsigned int _GL_ATTRIBUTE_CONST
+__eloop_threshold (void)
+{
+#ifdef SYMLOOP_MAX
+ const int symloop_max = SYMLOOP_MAX;
+#else
+ /* The function is marked 'const' even though we use memory and
+ call a function, because sysconf is required to return the
+ same value in every call and so it must always be safe to
+ call __eloop_threshold exactly once and reuse the value. */
+ static long int sysconf_symloop_max;
+ if (sysconf_symloop_max == 0)
+ sysconf_symloop_max = __sysconf (_SC_SYMLOOP_MAX);
+ const unsigned int symloop_max = (sysconf_symloop_max <= 0
+ ? _POSIX_SYMLOOP_MAX
+ : sysconf_symloop_max);
+#endif
+
+ return MAX (symloop_max, MIN_ELOOP_THRESHOLD);
+}
+
+#endif /* eloop-threshold.h */
diff --git a/lib/errno.in.h b/lib/errno.in.h
index c27e0c7ddee..c6ab4e88e15 100644
--- a/lib/errno.in.h
+++ b/lib/errno.in.h
@@ -1,6 +1,6 @@
/* A POSIX-like <errno.h>.
- Copyright (C) 2008-2020 Free Software Foundation, Inc.
+ Copyright (C) 2008-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
diff --git a/lib/euidaccess.c b/lib/euidaccess.c
index b352123ae18..ef65961d81d 100644
--- a/lib/euidaccess.c
+++ b/lib/euidaccess.c
@@ -1,6 +1,6 @@
/* euidaccess -- check if effective user id can access file
- Copyright (C) 1990-1991, 1995, 1998, 2000, 2003-2006, 2008-2020 Free
+ Copyright (C) 1990-1991, 1995, 1998, 2000, 2003-2006, 2008-2021 Free
Software Foundation, Inc.
This file is part of the GNU C Library.
@@ -107,7 +107,10 @@ euidaccess (const char *file, int mode)
safe. */
if (mode == F_OK)
- return stat (file, &stats);
+ {
+ int result = stat (file, &stats);
+ return result != 0 && errno == EOVERFLOW ? 0 : result;
+ }
else
{
int result;
@@ -142,8 +145,8 @@ euidaccess (const char *file, int mode)
/* If we are not set-uid or set-gid, access does the same. */
return access (file, mode);
- if (stat (file, &stats) != 0)
- return -1;
+ if (stat (file, &stats) == -1)
+ return mode == F_OK && errno == EOVERFLOW ? 0 : -1;
/* The super-user can read and write any file, and execute any file
that anyone can execute. */
diff --git a/lib/execinfo.in.h b/lib/execinfo.in.h
index b2fe44e65df..790bec087e1 100644
--- a/lib/execinfo.in.h
+++ b/lib/execinfo.in.h
@@ -1,6 +1,6 @@
/* Information about executables.
- Copyright (C) 2012-2020 Free Software Foundation, Inc.
+ Copyright (C) 2012-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
diff --git a/lib/explicit_bzero.c b/lib/explicit_bzero.c
index b1f5acb7771..feea4446c06 100644
--- a/lib/explicit_bzero.c
+++ b/lib/explicit_bzero.c
@@ -1,5 +1,5 @@
/* Erasure of sensitive data, generic implementation.
- Copyright (C) 2016-2020 Free Software Foundation, Inc.
+ Copyright (C) 2016-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/faccessat.c b/lib/faccessat.c
index 9f6a11bf6e3..3a776466cf2 100644
--- a/lib/faccessat.c
+++ b/lib/faccessat.c
@@ -1,5 +1,5 @@
/* Check the access rights of a file relative to an open directory.
- Copyright (C) 2009-2020 Free Software Foundation, Inc.
+ Copyright (C) 2009-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
diff --git a/lib/fchmodat.c b/lib/fchmodat.c
index eee0a1c56e4..d27c0d7734a 100644
--- a/lib/fchmodat.c
+++ b/lib/fchmodat.c
@@ -1,5 +1,5 @@
/* Change the protections of file relative to an open directory.
- Copyright (C) 2006, 2009-2020 Free Software Foundation, Inc.
+ Copyright (C) 2006, 2009-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
diff --git a/lib/fcntl.c b/lib/fcntl.c
index 8cd1531527d..9d6b10fa303 100644
--- a/lib/fcntl.c
+++ b/lib/fcntl.c
@@ -1,6 +1,6 @@
/* Provide file descriptor control.
- Copyright (C) 2009-2020 Free Software Foundation, Inc.
+ Copyright (C) 2009-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
@@ -491,7 +491,9 @@ rpl_fcntl_DUPFD_CLOEXEC (int fd, int target)
#if !HAVE_FCNTL
result = dupfd (fd, target, O_CLOEXEC);
#else /* HAVE_FCNTL */
-# if defined __HAIKU__
+# if defined __NetBSD__ || defined __HAIKU__
+ /* On NetBSD 9.0, the system fcntl (fd, F_DUPFD_CLOEXEC, target)
+ has only the same effect as fcntl (fd, F_DUPFD, target). */
/* On Haiku, the system fcntl (fd, F_DUPFD_CLOEXEC, target) sets
the FD_CLOEXEC flag on fd, not on target. Therefore avoid the
system fcntl in this case. */
diff --git a/lib/fcntl.in.h b/lib/fcntl.in.h
index 6f16bc66921..0b14467c54d 100644
--- a/lib/fcntl.in.h
+++ b/lib/fcntl.in.h
@@ -1,6 +1,6 @@
/* Like <fcntl.h>, but with non-working flags defined to 0.
- Copyright (C) 2006-2020 Free Software Foundation, Inc.
+ Copyright (C) 2006-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
@@ -112,9 +112,21 @@ _GL_CXXALIASWARN (creat);
/* Assume creat is always declared. */
_GL_WARN_ON_USE (creat, "creat is not always POSIX compliant - "
"use gnulib module creat for portability");
-#elif defined _WIN32 && !defined __CYGWIN__
-# undef creat
-# define creat _creat
+#elif @GNULIB_MDA_CREAT@
+/* On native Windows, map 'creat' to '_creat', so that -loldnames is not
+ required. In C++ with GNULIB_NAMESPACE, avoid differences between
+ platforms by defining GNULIB_NAMESPACE::creat always. */
+# if defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef creat
+# define creat _creat
+# endif
+/* Need to cast, because in mingw the last argument is 'int mode'. */
+_GL_CXXALIAS_MDA_CAST (creat, int, (const char *filename, mode_t mode));
+# else
+_GL_CXXALIAS_SYS (creat, int, (const char *filename, mode_t mode));
+# endif
+_GL_CXXALIASWARN (creat);
#endif
#if @GNULIB_FCNTL@
@@ -174,9 +186,22 @@ _GL_CXXALIASWARN (open);
/* Assume open is always declared. */
_GL_WARN_ON_USE (open, "open is not always POSIX compliant - "
"use gnulib module open for portability");
-#elif defined _WIN32 && !defined __CYGWIN__
-# undef open
-# define open _open
+#elif @GNULIB_MDA_OPEN@
+/* On native Windows, map 'open' to '_open', so that -loldnames is not
+ required. In C++ with GNULIB_NAMESPACE, avoid differences between
+ platforms by defining GNULIB_NAMESPACE::open always. */
+# if defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef open
+# define open _open
+# endif
+_GL_CXXALIAS_MDA (open, int, (const char *filename, int flags, ...));
+# else
+_GL_CXXALIAS_SYS (open, int, (const char *filename, int flags, ...));
+# endif
+# if !defined __hpux
+_GL_CXXALIASWARN (open);
+# endif
#endif
#if @GNULIB_OPENAT@
diff --git a/lib/fdopendir.c b/lib/fdopendir.c
index 883c0c43ec5..451b4e1321e 100644
--- a/lib/fdopendir.c
+++ b/lib/fdopendir.c
@@ -1,5 +1,5 @@
/* provide a replacement fdopendir function
- Copyright (C) 2004-2020 Free Software Foundation, Inc.
+ Copyright (C) 2004-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
diff --git a/lib/filemode.c b/lib/filemode.c
index e1b069093f8..357567281d7 100644
--- a/lib/filemode.c
+++ b/lib/filemode.c
@@ -1,6 +1,6 @@
/* filemode.c -- make a string describing file modes
- Copyright (C) 1985, 1990, 1993, 1998-2000, 2004, 2006, 2009-2020 Free
+ Copyright (C) 1985, 1990, 1993, 1998-2000, 2004, 2006, 2009-2021 Free
Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify
@@ -20,17 +20,6 @@
#include "filemode.h"
-/* The following is for Cray DMF (Data Migration Facility), which is a
- HSM file system. A migrated file has a 'st_dm_mode' that is
- different from the normal 'st_mode', so any tests for migrated
- files should use the former. */
-#if HAVE_ST_DM_MODE
-# define IS_MIGRATED_FILE(statp) \
- (S_ISOFD (statp->st_dm_mode) || S_ISOFL (statp->st_dm_mode))
-#else
-# define IS_MIGRATED_FILE(statp) 0
-#endif
-
#if ! HAVE_DECL_STRMODE
/* Return a character indicating the type of file described by
@@ -126,7 +115,6 @@ strmode (mode_t mode, char *str)
for files whose type cannot be determined solely from st_mode:
'F' semaphore
- 'M' migrated file (Cray DMF)
'Q' message queue
'S' shared memory object
'T' typed memory object
@@ -169,8 +157,6 @@ filemodestring (struct stat const *statp, char *str)
if (S_TYPEISSEM (statp))
str[0] = 'F';
- else if (IS_MIGRATED_FILE (statp))
- str[0] = 'M';
else if (S_TYPEISMQ (statp))
str[0] = 'Q';
else if (S_TYPEISSHM (statp))
diff --git a/lib/filemode.h b/lib/filemode.h
index f84a491625c..a02facb757d 100644
--- a/lib/filemode.h
+++ b/lib/filemode.h
@@ -1,6 +1,6 @@
/* Make a string describing file modes.
- Copyright (C) 1998-1999, 2003, 2006, 2009-2020 Free Software Foundation,
+ Copyright (C) 1998-1999, 2003, 2006, 2009-2021 Free Software Foundation,
Inc.
This program is free software: you can redistribute it and/or modify
diff --git a/lib/filename.h b/lib/filename.h
index 4598fb1d638..541ffec0d53 100644
--- a/lib/filename.h
+++ b/lib/filename.h
@@ -1,18 +1,20 @@
/* Basic filename support macros.
- Copyright (C) 2001-2004, 2007-2020 Free Software Foundation, Inc.
+ Copyright (C) 2001-2004, 2007-2021 Free Software Foundation, Inc.
+ This file is part of the GNU C Library.
- 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.
+ 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.
- This program is distributed in the hope that it will be useful,
+ 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.
+ 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/>. */
+ 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/>. */
/* From Paul Eggert and Jim Meyering. */
diff --git a/lib/filevercmp.c b/lib/filevercmp.c
index 9ecfe293ae8..6b7226de6c3 100644
--- a/lib/filevercmp.c
+++ b/lib/filevercmp.c
@@ -1,7 +1,7 @@
/*
Copyright (C) 1995 Ian Jackson <iwj10@cus.cam.ac.uk>
Copyright (C) 2001 Anthony Towns <aj@azure.humbug.org.au>
- Copyright (C) 2008-2020 Free Software Foundation, Inc.
+ Copyright (C) 2008-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
diff --git a/lib/filevercmp.h b/lib/filevercmp.h
index 3d0b6a694c4..5de212f4366 100644
--- a/lib/filevercmp.h
+++ b/lib/filevercmp.h
@@ -1,7 +1,7 @@
/*
Copyright (C) 1995 Ian Jackson <iwj10@cus.cam.ac.uk>
Copyright (C) 2001 Anthony Towns <aj@azure.humbug.org.au>
- Copyright (C) 2008-2020 Free Software Foundation, Inc.
+ Copyright (C) 2008-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
diff --git a/lib/fingerprint.c b/lib/fingerprint.c
index 2c19a5555ab..7266da9710d 100644
--- a/lib/fingerprint.c
+++ b/lib/fingerprint.c
@@ -1,6 +1,6 @@
/* Placeholder fingerprint for Emacs
-Copyright 2019-2020 Free Software Foundation, Inc.
+Copyright 2019-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lib/fingerprint.h b/lib/fingerprint.h
index 2faae8d0880..6ec0c80052f 100644
--- a/lib/fingerprint.h
+++ b/lib/fingerprint.h
@@ -1,6 +1,6 @@
/* Header file for the Emacs build fingerprint.
-Copyright (C) 2016, 2018-2020 Free Software Foundation, Inc.
+Copyright (C) 2016, 2018-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lib/flexmember.h b/lib/flexmember.h
index 0dc77c3c844..9f6e1bf1105 100644
--- a/lib/flexmember.h
+++ b/lib/flexmember.h
@@ -1,6 +1,6 @@
/* Sizes of structs with flexible array members.
- Copyright 2016-2020 Free Software Foundation, Inc.
+ Copyright 2016-2021 Free Software Foundation, Inc.
This file is part of the GNU C Library.
diff --git a/lib/fpending.c b/lib/fpending.c
index 802ebcba654..7c61f7eea75 100644
--- a/lib/fpending.c
+++ b/lib/fpending.c
@@ -1,5 +1,5 @@
/* fpending.c -- return the number of pending output bytes on a stream
- Copyright (C) 2000, 2004, 2006-2007, 2009-2020 Free Software Foundation,
+ Copyright (C) 2000, 2004, 2006-2007, 2009-2021 Free Software Foundation,
Inc.
This program is free software: you can redistribute it and/or modify
@@ -25,7 +25,8 @@
#include "stdio-impl.h"
/* This file is not used on systems that already have the __fpending function,
- namely glibc >= 2.2, Solaris >= 7, Android API >= 23. */
+ namely glibc >= 2.2, Solaris >= 7, UnixWare >= 7.1.4.MP4, Cygwin >= 1.7.34,
+ Android API >= 23. */
/* Return the number of pending (aka buffered, unflushed)
bytes on the stream, FP, that is open for writing. */
@@ -39,13 +40,13 @@ __fpending (FILE *fp)
/* GNU libc, BeOS, Haiku, Linux libc5 */
return fp->_IO_write_ptr - fp->_IO_write_base;
#elif defined __sferror || defined __DragonFly__ || defined __ANDROID__
- /* FreeBSD, NetBSD, OpenBSD, DragonFly, Mac OS X, Cygwin, Minix 3, Android */
+ /* FreeBSD, NetBSD, OpenBSD, DragonFly, Mac OS X, Cygwin < 1.7.34, Minix 3, Android */
return fp->_p - fp->_bf._base;
#elif defined __EMX__ /* emx+gcc */
return fp->_ptr - fp->_buffer;
#elif defined __minix /* Minix */
return fp_->_ptr - fp_->_buf;
-#elif defined _IOERR /* AIX, HP-UX, IRIX, OSF/1, Solaris, OpenServer, mingw, MSVC, NonStop Kernel, OpenVMS */
+#elif defined _IOERR /* AIX, HP-UX, IRIX, OSF/1, Solaris, OpenServer, UnixWare, mingw, MSVC, NonStop Kernel, OpenVMS */
return (fp_->_ptr ? fp_->_ptr - fp_->_base : 0);
#elif defined __UCLIBC__ /* uClibc */
return (fp->__modeflags & __FLAG_WRITING ? fp->__bufpos - fp->__bufstart : 0);
diff --git a/lib/fpending.h b/lib/fpending.h
index a8b8859726d..016341bab57 100644
--- a/lib/fpending.h
+++ b/lib/fpending.h
@@ -1,6 +1,6 @@
/* Declare __fpending.
- Copyright (C) 2000, 2003, 2005-2006, 2009-2020 Free Software Foundation,
+ Copyright (C) 2000, 2003, 2005-2006, 2009-2021 Free Software Foundation,
Inc.
This program is free software: you can redistribute it and/or modify
diff --git a/lib/free.c b/lib/free.c
new file mode 100644
index 00000000000..135c3eb16bc
--- /dev/null
+++ b/lib/free.c
@@ -0,0 +1,33 @@
+/* Make free() preserve errno.
+
+ Copyright (C) 2003, 2006, 2009-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 */
+
+#include <config.h>
+
+#include <stdlib.h>
+
+#include <errno.h>
+
+void
+rpl_free (void *p)
+#undef free
+{
+ int err = errno;
+ free (p);
+ errno = err;
+}
diff --git a/lib/fstatat.c b/lib/fstatat.c
index 9da12690d71..640a3754309 100644
--- a/lib/fstatat.c
+++ b/lib/fstatat.c
@@ -1,6 +1,6 @@
/* Work around an fstatat bug on Solaris 9.
- Copyright (C) 2006, 2009-2020 Free Software Foundation, Inc.
+ Copyright (C) 2006, 2009-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
diff --git a/lib/fsusage.c b/lib/fsusage.c
index 85bfe0e2837..35de136cd8e 100644
--- a/lib/fsusage.c
+++ b/lib/fsusage.c
@@ -1,6 +1,6 @@
/* fsusage.c -- return space usage of mounted file systems
- Copyright (C) 1991-1992, 1996, 1998-1999, 2002-2006, 2009-2020 Free Software
+ Copyright (C) 1991-1992, 1996, 1998-1999, 2002-2006, 2009-2021 Free Software
Foundation, Inc.
This program is free software: you can redistribute it and/or modify
diff --git a/lib/fsusage.h b/lib/fsusage.h
index 5e68709668a..e0657b3651a 100644
--- a/lib/fsusage.h
+++ b/lib/fsusage.h
@@ -1,6 +1,6 @@
/* fsusage.h -- declarations for file system space usage info
- Copyright (C) 1991-1992, 1997, 2003-2006, 2009-2020 Free Software
+ Copyright (C) 1991-1992, 1997, 2003-2006, 2009-2021 Free Software
Foundation, Inc.
This program is free software: you can redistribute it and/or modify
diff --git a/lib/fsync.c b/lib/fsync.c
index 2298aad3db3..a5280f281cb 100644
--- a/lib/fsync.c
+++ b/lib/fsync.c
@@ -7,7 +7,7 @@
Written by Richard W.M. Jones <rjones.at.redhat.com>
- Copyright (C) 2008-2020 Free Software Foundation, Inc.
+ Copyright (C) 2008-2021 Free Software Foundation, Inc.
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
diff --git a/lib/ftoastr.c b/lib/ftoastr.c
index 47a83152e3f..0ee0407ec27 100644
--- a/lib/ftoastr.c
+++ b/lib/ftoastr.c
@@ -1,6 +1,6 @@
/* floating point to accurate string
- Copyright (C) 2010-2020 Free Software Foundation, Inc.
+ Copyright (C) 2010-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
diff --git a/lib/ftoastr.h b/lib/ftoastr.h
index 78b569f3d97..d7ff9e05482 100644
--- a/lib/ftoastr.h
+++ b/lib/ftoastr.h
@@ -1,6 +1,6 @@
/* floating point to accurate string
- Copyright (C) 2010-2020 Free Software Foundation, Inc.
+ Copyright (C) 2010-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
diff --git a/lib/futimens.c b/lib/futimens.c
index 83fb27cb6aa..99eaba95df3 100644
--- a/lib/futimens.c
+++ b/lib/futimens.c
@@ -1,5 +1,5 @@
/* Set the access and modification time of an open fd.
- Copyright (C) 2009-2020 Free Software Foundation, Inc.
+ Copyright (C) 2009-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
diff --git a/lib/get-permissions.c b/lib/get-permissions.c
index e1bcd9f5298..fe376e5bb0b 100644
--- a/lib/get-permissions.c
+++ b/lib/get-permissions.c
@@ -1,6 +1,6 @@
/* Get permissions of a file. -*- coding: utf-8 -*-
- Copyright (C) 2002-2003, 2005-2020 Free Software Foundation, Inc.
+ Copyright (C) 2002-2003, 2005-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
diff --git a/lib/getdtablesize.c b/lib/getdtablesize.c
index 0fe70921f9d..56eaf5d32cf 100644
--- a/lib/getdtablesize.c
+++ b/lib/getdtablesize.c
@@ -1,5 +1,5 @@
/* getdtablesize() function: Return maximum possible file descriptor value + 1.
- Copyright (C) 2008-2020 Free Software Foundation, Inc.
+ Copyright (C) 2008-2021 Free Software Foundation, Inc.
Written by Bruno Haible <bruno@clisp.org>, 2008.
This program is free software: you can redistribute it and/or modify
diff --git a/lib/getgroups.c b/lib/getgroups.c
index 4396b4d64b7..af602a74d3a 100644
--- a/lib/getgroups.c
+++ b/lib/getgroups.c
@@ -1,6 +1,6 @@
/* provide consistent interface to getgroups for systems that don't allow N==0
- Copyright (C) 1996, 1999, 2003, 2006-2020 Free Software Foundation, Inc.
+ Copyright (C) 1996, 1999, 2003, 2006-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
diff --git a/lib/getloadavg.c b/lib/getloadavg.c
index 468e2506709..d42d0cd2797 100644
--- a/lib/getloadavg.c
+++ b/lib/getloadavg.c
@@ -1,6 +1,6 @@
/* Get the system load averages.
- Copyright (C) 1985-1989, 1991-1995, 1997, 1999-2000, 2003-2020 Free Software
+ Copyright (C) 1985-1989, 1991-1995, 1997, 1999-2000, 2003-2021 Free Software
Foundation, Inc.
NOTE: The canonical source of this file is maintained with gnulib.
diff --git a/lib/getopt-cdefs.in.h b/lib/getopt-cdefs.in.h
index 674838c666a..11fe536ff24 100644
--- a/lib/getopt-cdefs.in.h
+++ b/lib/getopt-cdefs.in.h
@@ -1,5 +1,5 @@
/* getopt-on-non-glibc compatibility macros.
- Copyright (C) 1989-2020 Free Software Foundation, Inc.
+ Copyright (C) 1989-2021 Free Software Foundation, Inc.
This file is part of gnulib.
Unlike most of the getopt implementation, it is NOT shared
with the GNU C Library.
diff --git a/lib/getopt-core.h b/lib/getopt-core.h
index d4d942ef221..05d16b07401 100644
--- a/lib/getopt-core.h
+++ b/lib/getopt-core.h
@@ -1,5 +1,5 @@
/* Declarations for getopt (basic, portable features only).
- Copyright (C) 1989-2020 Free Software Foundation, Inc.
+ Copyright (C) 1989-2021 Free Software Foundation, Inc.
This file is part of the GNU C Library and is also part of gnulib.
Patches to this file should be submitted to both projects.
diff --git a/lib/getopt-ext.h b/lib/getopt-ext.h
index 05f7083ac6a..9b11b47f0fe 100644
--- a/lib/getopt-ext.h
+++ b/lib/getopt-ext.h
@@ -1,5 +1,5 @@
/* Declarations for getopt (GNU extensions).
- Copyright (C) 1989-2020 Free Software Foundation, Inc.
+ Copyright (C) 1989-2021 Free Software Foundation, Inc.
This file is part of the GNU C Library and is also part of gnulib.
Patches to this file should be submitted to both projects.
diff --git a/lib/getopt-pfx-core.h b/lib/getopt-pfx-core.h
index ec545c1b51c..78990a345a7 100644
--- a/lib/getopt-pfx-core.h
+++ b/lib/getopt-pfx-core.h
@@ -1,5 +1,5 @@
/* getopt (basic, portable features) gnulib wrapper header.
- Copyright (C) 1989-2020 Free Software Foundation, Inc.
+ Copyright (C) 1989-2021 Free Software Foundation, Inc.
This file is part of gnulib.
Unlike most of the getopt implementation, it is NOT shared
with the GNU C Library.
diff --git a/lib/getopt-pfx-ext.h b/lib/getopt-pfx-ext.h
index 647fae63522..61ea8d2b1d3 100644
--- a/lib/getopt-pfx-ext.h
+++ b/lib/getopt-pfx-ext.h
@@ -1,5 +1,5 @@
/* getopt (GNU extensions) gnulib wrapper header.
- Copyright (C) 1989-2020 Free Software Foundation, Inc.
+ Copyright (C) 1989-2021 Free Software Foundation, Inc.
This file is part of gnulib.
Unlike most of the getopt implementation, it is NOT shared
with the GNU C Library.
diff --git a/lib/getopt.c b/lib/getopt.c
index a6389d8ea9b..dd96c184075 100644
--- a/lib/getopt.c
+++ b/lib/getopt.c
@@ -1,5 +1,5 @@
/* Getopt for GNU.
- Copyright (C) 1987-2020 Free Software Foundation, Inc.
+ Copyright (C) 1987-2021 Free Software Foundation, Inc.
This file is part of the GNU C Library and is also part of gnulib.
Patches to this file should be submitted to both projects.
diff --git a/lib/getopt.in.h b/lib/getopt.in.h
index 36e04bb0883..541fb9da2e8 100644
--- a/lib/getopt.in.h
+++ b/lib/getopt.in.h
@@ -1,5 +1,5 @@
/* Declarations for getopt.
- Copyright (C) 1989-2020 Free Software Foundation, Inc.
+ Copyright (C) 1989-2021 Free Software Foundation, Inc.
This file is part of gnulib.
Unlike most of the getopt implementation, it is NOT shared
with the GNU C Library, which supplies a different version of
diff --git a/lib/getopt1.c b/lib/getopt1.c
index 0902efe68e3..ca24eb811f9 100644
--- a/lib/getopt1.c
+++ b/lib/getopt1.c
@@ -1,5 +1,5 @@
/* getopt_long and getopt_long_only entry points for GNU getopt.
- Copyright (C) 1987-2020 Free Software Foundation, Inc.
+ Copyright (C) 1987-2021 Free Software Foundation, Inc.
This file is part of the GNU C Library and is also part of gnulib.
Patches to this file should be submitted to both projects.
diff --git a/lib/getopt_int.h b/lib/getopt_int.h
index afcd8a67fb2..b70ff5badf8 100644
--- a/lib/getopt_int.h
+++ b/lib/getopt_int.h
@@ -1,5 +1,5 @@
/* Internal declarations for getopt.
- Copyright (C) 1989-2020 Free Software Foundation, Inc.
+ Copyright (C) 1989-2021 Free Software Foundation, Inc.
This file is part of the GNU C Library and is also part of gnulib.
Patches to this file should be submitted to both projects.
diff --git a/lib/getrandom.c b/lib/getrandom.c
index f8695abf30a..41212fb329d 100644
--- a/lib/getrandom.c
+++ b/lib/getrandom.c
@@ -1,6 +1,6 @@
/* Obtain a series of random bytes.
- Copyright 2020 Free Software Foundation, Inc.
+ Copyright 2020-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
diff --git a/lib/gettext.h b/lib/gettext.h
index 0bd1e13348a..3552157efd9 100644
--- a/lib/gettext.h
+++ b/lib/gettext.h
@@ -1,5 +1,5 @@
/* Convenience header for conditional use of GNU <libintl.h>.
- Copyright (C) 1995-1998, 2000-2002, 2004-2006, 2009-2020 Free Software
+ Copyright (C) 1995-1998, 2000-2002, 2004-2006, 2009-2021 Free Software
Foundation, Inc.
This program is free software; you can redistribute it and/or modify
diff --git a/lib/gettime.c b/lib/gettime.c
index f5b8ca53b5f..fb721b2cda1 100644
--- a/lib/gettime.c
+++ b/lib/gettime.c
@@ -1,6 +1,6 @@
/* gettime -- get the system clock
- Copyright (C) 2002, 2004-2007, 2009-2020 Free Software Foundation, Inc.
+ Copyright (C) 2002, 2004-2007, 2009-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
diff --git a/lib/gettimeofday.c b/lib/gettimeofday.c
index 5301e7c144a..b1c93e1c3a3 100644
--- a/lib/gettimeofday.c
+++ b/lib/gettimeofday.c
@@ -1,6 +1,6 @@
/* Provide gettimeofday for systems that don't have it or for which it's broken.
- Copyright (C) 2001-2003, 2005-2007, 2009-2020 Free Software Foundation, Inc.
+ Copyright (C) 2001-2003, 2005-2007, 2009-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
diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in
index 9953198fb31..c457ac61209 100644
--- a/lib/gnulib.mk.in
+++ b/lib/gnulib.mk.in
@@ -1,5 +1,5 @@
## DO NOT EDIT! GENERATED AUTOMATICALLY!
-# Copyright (C) 2002-2020 Free Software Foundation, Inc.
+# Copyright (C) 2002-2021 Free Software Foundation, Inc.
#
# 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
@@ -103,6 +103,7 @@
# filevercmp \
# flexmember \
# fpieee \
+# free-posix \
# fstatat \
# fsusage \
# fsync \
@@ -241,7 +242,6 @@ GETOPT_CDEFS_H = @GETOPT_CDEFS_H@
GETOPT_H = @GETOPT_H@
GFILENOTIFY_CFLAGS = @GFILENOTIFY_CFLAGS@
GFILENOTIFY_LIBS = @GFILENOTIFY_LIBS@
-GLIBC21 = @GLIBC21@
GL_COND_LIBTOOL = @GL_COND_LIBTOOL@
GL_GENERATE_ALLOCA_H = @GL_GENERATE_ALLOCA_H@
GL_GENERATE_BYTESWAP_H = @GL_GENERATE_BYTESWAP_H@
@@ -257,6 +257,7 @@ GL_GENERATE_STDINT_H = @GL_GENERATE_STDINT_H@
GMALLOC_OBJ = @GMALLOC_OBJ@
GMP_H = @GMP_H@
GNULIB_ACCESS = @GNULIB_ACCESS@
+GNULIB_ALIGNED_ALLOC = @GNULIB_ALIGNED_ALLOC@
GNULIB_ALPHASORT = @GNULIB_ALPHASORT@
GNULIB_ATOLL = @GNULIB_ATOLL@
GNULIB_CALLOC_POSIX = @GNULIB_CALLOC_POSIX@
@@ -275,6 +276,13 @@ GNULIB_DUP2 = @GNULIB_DUP2@
GNULIB_DUP3 = @GNULIB_DUP3@
GNULIB_ENVIRON = @GNULIB_ENVIRON@
GNULIB_EUIDACCESS = @GNULIB_EUIDACCESS@
+GNULIB_EXECL = @GNULIB_EXECL@
+GNULIB_EXECLE = @GNULIB_EXECLE@
+GNULIB_EXECLP = @GNULIB_EXECLP@
+GNULIB_EXECV = @GNULIB_EXECV@
+GNULIB_EXECVE = @GNULIB_EXECVE@
+GNULIB_EXECVP = @GNULIB_EXECVP@
+GNULIB_EXECVPE = @GNULIB_EXECVPE@
GNULIB_EXPLICIT_BZERO = @GNULIB_EXPLICIT_BZERO@
GNULIB_FACCESSAT = @GNULIB_FACCESSAT@
GNULIB_FCHDIR = @GNULIB_FCHDIR@
@@ -297,6 +305,7 @@ GNULIB_FPURGE = @GNULIB_FPURGE@
GNULIB_FPUTC = @GNULIB_FPUTC@
GNULIB_FPUTS = @GNULIB_FPUTS@
GNULIB_FREAD = @GNULIB_FREAD@
+GNULIB_FREE_POSIX = @GNULIB_FREE_POSIX@
GNULIB_FREOPEN = @GNULIB_FREOPEN@
GNULIB_FSCANF = @GNULIB_FSCANF@
GNULIB_FSEEK = @GNULIB_FSEEK@
@@ -359,10 +368,51 @@ GNULIB_MBSSPN = @GNULIB_MBSSPN@
GNULIB_MBSSTR = @GNULIB_MBSSTR@
GNULIB_MBSTOK_R = @GNULIB_MBSTOK_R@
GNULIB_MBTOWC = @GNULIB_MBTOWC@
+GNULIB_MDA_ACCESS = @GNULIB_MDA_ACCESS@
+GNULIB_MDA_CHDIR = @GNULIB_MDA_CHDIR@
+GNULIB_MDA_CHMOD = @GNULIB_MDA_CHMOD@
+GNULIB_MDA_CLOSE = @GNULIB_MDA_CLOSE@
+GNULIB_MDA_CREAT = @GNULIB_MDA_CREAT@
+GNULIB_MDA_DUP = @GNULIB_MDA_DUP@
+GNULIB_MDA_DUP2 = @GNULIB_MDA_DUP2@
+GNULIB_MDA_ECVT = @GNULIB_MDA_ECVT@
+GNULIB_MDA_EXECL = @GNULIB_MDA_EXECL@
+GNULIB_MDA_EXECLE = @GNULIB_MDA_EXECLE@
+GNULIB_MDA_EXECLP = @GNULIB_MDA_EXECLP@
+GNULIB_MDA_EXECV = @GNULIB_MDA_EXECV@
+GNULIB_MDA_EXECVE = @GNULIB_MDA_EXECVE@
+GNULIB_MDA_EXECVP = @GNULIB_MDA_EXECVP@
+GNULIB_MDA_EXECVPE = @GNULIB_MDA_EXECVPE@
+GNULIB_MDA_FCLOSEALL = @GNULIB_MDA_FCLOSEALL@
+GNULIB_MDA_FCVT = @GNULIB_MDA_FCVT@
+GNULIB_MDA_FDOPEN = @GNULIB_MDA_FDOPEN@
+GNULIB_MDA_FILENO = @GNULIB_MDA_FILENO@
+GNULIB_MDA_GCVT = @GNULIB_MDA_GCVT@
+GNULIB_MDA_GETCWD = @GNULIB_MDA_GETCWD@
+GNULIB_MDA_GETPID = @GNULIB_MDA_GETPID@
+GNULIB_MDA_GETW = @GNULIB_MDA_GETW@
+GNULIB_MDA_ISATTY = @GNULIB_MDA_ISATTY@
+GNULIB_MDA_LSEEK = @GNULIB_MDA_LSEEK@
+GNULIB_MDA_MEMCCPY = @GNULIB_MDA_MEMCCPY@
+GNULIB_MDA_MKDIR = @GNULIB_MDA_MKDIR@
+GNULIB_MDA_MKTEMP = @GNULIB_MDA_MKTEMP@
+GNULIB_MDA_OPEN = @GNULIB_MDA_OPEN@
+GNULIB_MDA_PUTENV = @GNULIB_MDA_PUTENV@
+GNULIB_MDA_PUTW = @GNULIB_MDA_PUTW@
+GNULIB_MDA_READ = @GNULIB_MDA_READ@
+GNULIB_MDA_RMDIR = @GNULIB_MDA_RMDIR@
+GNULIB_MDA_STRDUP = @GNULIB_MDA_STRDUP@
+GNULIB_MDA_SWAB = @GNULIB_MDA_SWAB@
+GNULIB_MDA_TEMPNAM = @GNULIB_MDA_TEMPNAM@
+GNULIB_MDA_TZSET = @GNULIB_MDA_TZSET@
+GNULIB_MDA_UMASK = @GNULIB_MDA_UMASK@
+GNULIB_MDA_UNLINK = @GNULIB_MDA_UNLINK@
+GNULIB_MDA_WRITE = @GNULIB_MDA_WRITE@
GNULIB_MEMCHR = @GNULIB_MEMCHR@
GNULIB_MEMMEM = @GNULIB_MEMMEM@
GNULIB_MEMPCPY = @GNULIB_MEMPCPY@
GNULIB_MEMRCHR = @GNULIB_MEMRCHR@
+GNULIB_MKDIR = @GNULIB_MKDIR@
GNULIB_MKDIRAT = @GNULIB_MKDIRAT@
GNULIB_MKDTEMP = @GNULIB_MKDTEMP@
GNULIB_MKFIFO = @GNULIB_MKFIFO@
@@ -388,6 +438,7 @@ GNULIB_PERROR = @GNULIB_PERROR@
GNULIB_PIPE = @GNULIB_PIPE@
GNULIB_PIPE2 = @GNULIB_PIPE2@
GNULIB_POPEN = @GNULIB_POPEN@
+GNULIB_POSIX_MEMALIGN = @GNULIB_POSIX_MEMALIGN@
GNULIB_POSIX_OPENPT = @GNULIB_POSIX_OPENPT@
GNULIB_PREAD = @GNULIB_PREAD@
GNULIB_PRINTF = @GNULIB_PRINTF@
@@ -506,6 +557,7 @@ GTK_OBJ = @GTK_OBJ@
GZIP_PROG = @GZIP_PROG@
HARFBUZZ_CFLAGS = @HARFBUZZ_CFLAGS@
HARFBUZZ_LIBS = @HARFBUZZ_LIBS@
+HAVE_ALIGNED_ALLOC = @HAVE_ALIGNED_ALLOC@
HAVE_ALLOCA_H = @HAVE_ALLOCA_H@
HAVE_ALPHASORT = @HAVE_ALPHASORT@
HAVE_ATOLL = @HAVE_ATOLL@
@@ -515,13 +567,18 @@ HAVE_CHOWN = @HAVE_CHOWN@
HAVE_CLOSEDIR = @HAVE_CLOSEDIR@
HAVE_COPY_FILE_RANGE = @HAVE_COPY_FILE_RANGE@
HAVE_DECL_DIRFD = @HAVE_DECL_DIRFD@
+HAVE_DECL_ECVT = @HAVE_DECL_ECVT@
HAVE_DECL_ENVIRON = @HAVE_DECL_ENVIRON@
+HAVE_DECL_EXECVPE = @HAVE_DECL_EXECVPE@
HAVE_DECL_FCHDIR = @HAVE_DECL_FCHDIR@
+HAVE_DECL_FCLOSEALL = @HAVE_DECL_FCLOSEALL@
+HAVE_DECL_FCVT = @HAVE_DECL_FCVT@
HAVE_DECL_FDATASYNC = @HAVE_DECL_FDATASYNC@
HAVE_DECL_FDOPENDIR = @HAVE_DECL_FDOPENDIR@
HAVE_DECL_FPURGE = @HAVE_DECL_FPURGE@
HAVE_DECL_FSEEKO = @HAVE_DECL_FSEEKO@
HAVE_DECL_FTELLO = @HAVE_DECL_FTELLO@
+HAVE_DECL_GCVT = @HAVE_DECL_GCVT@
HAVE_DECL_GETDELIM = @HAVE_DECL_GETDELIM@
HAVE_DECL_GETDOMAINNAME = @HAVE_DECL_GETDOMAINNAME@
HAVE_DECL_GETLINE = @HAVE_DECL_GETLINE@
@@ -557,6 +614,7 @@ HAVE_DIRENT_H = @HAVE_DIRENT_H@
HAVE_DPRINTF = @HAVE_DPRINTF@
HAVE_DUP3 = @HAVE_DUP3@
HAVE_EUIDACCESS = @HAVE_EUIDACCESS@
+HAVE_EXECVPE = @HAVE_EXECVPE@
HAVE_EXPLICIT_BZERO = @HAVE_EXPLICIT_BZERO@
HAVE_FACCESSAT = @HAVE_FACCESSAT@
HAVE_FCHDIR = @HAVE_FCHDIR@
@@ -621,6 +679,7 @@ HAVE_PDUMPER = @HAVE_PDUMPER@
HAVE_PIPE = @HAVE_PIPE@
HAVE_PIPE2 = @HAVE_PIPE2@
HAVE_POPEN = @HAVE_POPEN@
+HAVE_POSIX_MEMALIGN = @HAVE_POSIX_MEMALIGN@
HAVE_POSIX_OPENPT = @HAVE_POSIX_OPENPT@
HAVE_POSIX_SIGNALBLOCKING = @HAVE_POSIX_SIGNALBLOCKING@
HAVE_PREAD = @HAVE_PREAD@
@@ -863,6 +922,7 @@ PTRDIFF_T_SUFFIX = @PTRDIFF_T_SUFFIX@
RALLOC_OBJ = @RALLOC_OBJ@
RANLIB = @RANLIB@
REPLACE_ACCESS = @REPLACE_ACCESS@
+REPLACE_ALIGNED_ALLOC = @REPLACE_ALIGNED_ALLOC@
REPLACE_CALLOC = @REPLACE_CALLOC@
REPLACE_CANONICALIZE_FILE_NAME = @REPLACE_CANONICALIZE_FILE_NAME@
REPLACE_CHOWN = @REPLACE_CHOWN@
@@ -874,6 +934,13 @@ REPLACE_DIRFD = @REPLACE_DIRFD@
REPLACE_DPRINTF = @REPLACE_DPRINTF@
REPLACE_DUP = @REPLACE_DUP@
REPLACE_DUP2 = @REPLACE_DUP2@
+REPLACE_EXECL = @REPLACE_EXECL@
+REPLACE_EXECLE = @REPLACE_EXECLE@
+REPLACE_EXECLP = @REPLACE_EXECLP@
+REPLACE_EXECV = @REPLACE_EXECV@
+REPLACE_EXECVE = @REPLACE_EXECVE@
+REPLACE_EXECVP = @REPLACE_EXECVP@
+REPLACE_EXECVPE = @REPLACE_EXECVPE@
REPLACE_FACCESSAT = @REPLACE_FACCESSAT@
REPLACE_FCHMODAT = @REPLACE_FCHMODAT@
REPLACE_FCHOWNAT = @REPLACE_FCHOWNAT@
@@ -885,6 +952,7 @@ REPLACE_FFLUSH = @REPLACE_FFLUSH@
REPLACE_FOPEN = @REPLACE_FOPEN@
REPLACE_FPRINTF = @REPLACE_FPRINTF@
REPLACE_FPURGE = @REPLACE_FPURGE@
+REPLACE_FREE = @REPLACE_FREE@
REPLACE_FREOPEN = @REPLACE_FREOPEN@
REPLACE_FSEEK = @REPLACE_FSEEK@
REPLACE_FSEEKO = @REPLACE_FSEEKO@
@@ -932,6 +1000,7 @@ REPLACE_OPENAT = @REPLACE_OPENAT@
REPLACE_OPENDIR = @REPLACE_OPENDIR@
REPLACE_PERROR = @REPLACE_PERROR@
REPLACE_POPEN = @REPLACE_POPEN@
+REPLACE_POSIX_MEMALIGN = @REPLACE_POSIX_MEMALIGN@
REPLACE_PREAD = @REPLACE_PREAD@
REPLACE_PRINTF = @REPLACE_PRINTF@
REPLACE_PSELECT = @REPLACE_PSELECT@
@@ -1097,6 +1166,7 @@ gl_GNULIB_ENABLED_260941c0e5dc67ec9e87d1fb321c300b = @gl_GNULIB_ENABLED_260941c0
gl_GNULIB_ENABLED_5264294aa0a5557541b53c8c741f7f31 = @gl_GNULIB_ENABLED_5264294aa0a5557541b53c8c741f7f31@
gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c = @gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c@
gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec = @gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec@
+gl_GNULIB_ENABLED_925677f0343de64b89a9f0c790b4104c = @gl_GNULIB_ENABLED_925677f0343de64b89a9f0c790b4104c@
gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1 = @gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1@
gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36 = @gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36@
gl_GNULIB_ENABLED_cloexec = @gl_GNULIB_ENABLED_cloexec@
@@ -1104,9 +1174,11 @@ gl_GNULIB_ENABLED_dirfd = @gl_GNULIB_ENABLED_dirfd@
gl_GNULIB_ENABLED_euidaccess = @gl_GNULIB_ENABLED_euidaccess@
gl_GNULIB_ENABLED_getdtablesize = @gl_GNULIB_ENABLED_getdtablesize@
gl_GNULIB_ENABLED_getgroups = @gl_GNULIB_ENABLED_getgroups@
+gl_GNULIB_ENABLED_idx = @gl_GNULIB_ENABLED_idx@
gl_GNULIB_ENABLED_lchmod = @gl_GNULIB_ENABLED_lchmod@
-gl_GNULIB_ENABLED_malloca = @gl_GNULIB_ENABLED_malloca@
gl_GNULIB_ENABLED_open = @gl_GNULIB_ENABLED_open@
+gl_GNULIB_ENABLED_rawmemchr = @gl_GNULIB_ENABLED_rawmemchr@
+gl_GNULIB_ENABLED_scratch_buffer = @gl_GNULIB_ENABLED_scratch_buffer@
gl_GNULIB_ENABLED_strtoll = @gl_GNULIB_ENABLED_strtoll@
gl_GNULIB_ENABLED_utimens = @gl_GNULIB_ENABLED_utimens@
gl_LIBOBJS = @gl_LIBOBJS@
@@ -1512,6 +1584,17 @@ EXTRA_libgnu_a_SOURCES += dup2.c
endif
## end gnulib module dup2
+## begin gnulib module eloop-threshold
+ifeq (,$(OMIT_GNULIB_MODULE_eloop-threshold))
+
+ifneq (,$(gl_GNULIB_ENABLED_925677f0343de64b89a9f0c790b4104c))
+
+endif
+EXTRA_DIST += eloop-threshold.h
+
+endif
+## end gnulib module eloop-threshold
+
## begin gnulib module errno
ifeq (,$(OMIT_GNULIB_MODULE_errno))
@@ -1652,6 +1735,8 @@ fcntl.h: fcntl.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H)
-e 's/@''GNULIB_NONBLOCKING''@/$(GNULIB_NONBLOCKING)/g' \
-e 's/@''GNULIB_OPEN''@/$(GNULIB_OPEN)/g' \
-e 's/@''GNULIB_OPENAT''@/$(GNULIB_OPENAT)/g' \
+ -e 's/@''GNULIB_MDA_CREAT''@/$(GNULIB_MDA_CREAT)/g' \
+ -e 's/@''GNULIB_MDA_OPEN''@/$(GNULIB_MDA_OPEN)/g' \
-e 's|@''HAVE_FCNTL''@|$(HAVE_FCNTL)|g' \
-e 's|@''HAVE_OPENAT''@|$(HAVE_OPENAT)|g' \
-e 's|@''REPLACE_CREAT''@|$(REPLACE_CREAT)|g' \
@@ -1731,6 +1816,17 @@ EXTRA_libgnu_a_SOURCES += fpending.c
endif
## end gnulib module fpending
+## begin gnulib module free-posix
+ifeq (,$(OMIT_GNULIB_MODULE_free-posix))
+
+
+EXTRA_DIST += free.c
+
+EXTRA_libgnu_a_SOURCES += free.c
+
+endif
+## end gnulib module free-posix
+
## begin gnulib module fstatat
ifeq (,$(OMIT_GNULIB_MODULE_fstatat))
@@ -1912,6 +2008,16 @@ EXTRA_libgnu_a_SOURCES += group-member.c
endif
## end gnulib module group-member
+## begin gnulib module idx
+ifeq (,$(OMIT_GNULIB_MODULE_idx))
+
+ifneq (,$(gl_GNULIB_ENABLED_idx))
+libgnu_a_SOURCES += idx.h
+
+endif
+endif
+## end gnulib module idx
+
## begin gnulib module ieee754-h
ifeq (,$(OMIT_GNULIB_MODULE_ieee754-h))
@@ -2094,18 +2200,6 @@ EXTRA_libgnu_a_SOURCES += lstat.c
endif
## end gnulib module lstat
-## begin gnulib module malloca
-ifeq (,$(OMIT_GNULIB_MODULE_malloca))
-
-ifneq (,$(gl_GNULIB_ENABLED_malloca))
-libgnu_a_SOURCES += malloca.c
-
-endif
-EXTRA_DIST += malloca.h
-
-endif
-## end gnulib module malloca
-
## begin gnulib module memmem-simple
ifeq (,$(OMIT_GNULIB_MODULE_memmem-simple))
@@ -2263,6 +2357,19 @@ libgnu_a_SOURCES += qcopy-acl.c
endif
## end gnulib module qcopy-acl
+## begin gnulib module rawmemchr
+ifeq (,$(OMIT_GNULIB_MODULE_rawmemchr))
+
+ifneq (,$(gl_GNULIB_ENABLED_rawmemchr))
+
+endif
+EXTRA_DIST += rawmemchr.c rawmemchr.valgrind
+
+EXTRA_libgnu_a_SOURCES += rawmemchr.c
+
+endif
+## end gnulib module rawmemchr
+
## begin gnulib module readlink
ifeq (,$(OMIT_GNULIB_MODULE_readlink))
@@ -2307,6 +2414,18 @@ EXTRA_DIST += root-uid.h
endif
## end gnulib module root-uid
+## begin gnulib module scratch_buffer
+ifeq (,$(OMIT_GNULIB_MODULE_scratch_buffer))
+
+ifneq (,$(gl_GNULIB_ENABLED_scratch_buffer))
+libgnu_a_SOURCES += malloc/scratch_buffer_dupfree.c malloc/scratch_buffer_grow.c malloc/scratch_buffer_grow_preserve.c malloc/scratch_buffer_set_array_size.c
+
+endif
+EXTRA_DIST += malloc/scratch_buffer.h scratch_buffer.h
+
+endif
+## end gnulib module scratch_buffer
+
## begin gnulib module sig2str
ifeq (,$(OMIT_GNULIB_MODULE_sig2str))
@@ -2617,8 +2736,15 @@ stdio.h: stdio.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H)
-e 's/@''GNULIB_VPRINTF_POSIX''@/$(GNULIB_VPRINTF_POSIX)/g' \
-e 's/@''GNULIB_VSNPRINTF''@/$(GNULIB_VSNPRINTF)/g' \
-e 's/@''GNULIB_VSPRINTF_POSIX''@/$(GNULIB_VSPRINTF_POSIX)/g' \
+ -e 's/@''GNULIB_MDA_FCLOSEALL''@/$(GNULIB_MDA_FCLOSEALL)/g' \
+ -e 's/@''GNULIB_MDA_FDOPEN''@/$(GNULIB_MDA_FDOPEN)/g' \
+ -e 's/@''GNULIB_MDA_FILENO''@/$(GNULIB_MDA_FILENO)/g' \
+ -e 's/@''GNULIB_MDA_GETW''@/$(GNULIB_MDA_GETW)/g' \
+ -e 's/@''GNULIB_MDA_PUTW''@/$(GNULIB_MDA_PUTW)/g' \
+ -e 's/@''GNULIB_MDA_TEMPNAM''@/$(GNULIB_MDA_TEMPNAM)/g' \
< $(srcdir)/stdio.in.h | \
- sed -e 's|@''HAVE_DECL_FPURGE''@|$(HAVE_DECL_FPURGE)|g' \
+ sed -e 's|@''HAVE_DECL_FCLOSEALL''@|$(HAVE_DECL_FCLOSEALL)|g' \
+ -e 's|@''HAVE_DECL_FPURGE''@|$(HAVE_DECL_FPURGE)|g' \
-e 's|@''HAVE_DECL_FSEEKO''@|$(HAVE_DECL_FSEEKO)|g' \
-e 's|@''HAVE_DECL_FTELLO''@|$(HAVE_DECL_FTELLO)|g' \
-e 's|@''HAVE_DECL_GETDELIM''@|$(HAVE_DECL_GETDELIM)|g' \
@@ -2696,9 +2822,11 @@ stdlib.h: stdlib.in.h $(top_builddir)/config.status $(CXXDEFS_H) \
-e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \
-e 's|@''NEXT_STDLIB_H''@|$(NEXT_STDLIB_H)|g' \
-e 's/@''GNULIB__EXIT''@/$(GNULIB__EXIT)/g' \
+ -e 's/@''GNULIB_ALIGNED_ALLOC''@/$(GNULIB_ALIGNED_ALLOC)/g' \
-e 's/@''GNULIB_ATOLL''@/$(GNULIB_ATOLL)/g' \
-e 's/@''GNULIB_CALLOC_POSIX''@/$(GNULIB_CALLOC_POSIX)/g' \
-e 's/@''GNULIB_CANONICALIZE_FILE_NAME''@/$(GNULIB_CANONICALIZE_FILE_NAME)/g' \
+ -e 's/@''GNULIB_FREE_POSIX''@/$(GNULIB_FREE_POSIX)/g' \
-e 's/@''GNULIB_GETLOADAVG''@/$(GNULIB_GETLOADAVG)/g' \
-e 's/@''GNULIB_GETSUBOPT''@/$(GNULIB_GETSUBOPT)/g' \
-e 's/@''GNULIB_GRANTPT''@/$(GNULIB_GRANTPT)/g' \
@@ -2709,6 +2837,7 @@ stdlib.h: stdlib.in.h $(top_builddir)/config.status $(CXXDEFS_H) \
-e 's/@''GNULIB_MKOSTEMPS''@/$(GNULIB_MKOSTEMPS)/g' \
-e 's/@''GNULIB_MKSTEMP''@/$(GNULIB_MKSTEMP)/g' \
-e 's/@''GNULIB_MKSTEMPS''@/$(GNULIB_MKSTEMPS)/g' \
+ -e 's/@''GNULIB_POSIX_MEMALIGN''@/$(GNULIB_POSIX_MEMALIGN)/g' \
-e 's/@''GNULIB_POSIX_OPENPT''@/$(GNULIB_POSIX_OPENPT)/g' \
-e 's/@''GNULIB_PTSNAME''@/$(GNULIB_PTSNAME)/g' \
-e 's/@''GNULIB_PTSNAME_R''@/$(GNULIB_PTSNAME_R)/g' \
@@ -2730,10 +2859,19 @@ stdlib.h: stdlib.in.h $(top_builddir)/config.status $(CXXDEFS_H) \
-e 's/@''GNULIB_UNLOCKPT''@/$(GNULIB_UNLOCKPT)/g' \
-e 's/@''GNULIB_UNSETENV''@/$(GNULIB_UNSETENV)/g' \
-e 's/@''GNULIB_WCTOMB''@/$(GNULIB_WCTOMB)/g' \
+ -e 's/@''GNULIB_MDA_ECVT''@/$(GNULIB_MDA_ECVT)/g' \
+ -e 's/@''GNULIB_MDA_FCVT''@/$(GNULIB_MDA_FCVT)/g' \
+ -e 's/@''GNULIB_MDA_GCVT''@/$(GNULIB_MDA_GCVT)/g' \
+ -e 's/@''GNULIB_MDA_MKTEMP''@/$(GNULIB_MDA_MKTEMP)/g' \
+ -e 's/@''GNULIB_MDA_PUTENV''@/$(GNULIB_MDA_PUTENV)/g' \
< $(srcdir)/stdlib.in.h | \
sed -e 's|@''HAVE__EXIT''@|$(HAVE__EXIT)|g' \
+ -e 's|@''HAVE_ALIGNED_ALLOC''@|$(HAVE_ALIGNED_ALLOC)|g' \
-e 's|@''HAVE_ATOLL''@|$(HAVE_ATOLL)|g' \
-e 's|@''HAVE_CANONICALIZE_FILE_NAME''@|$(HAVE_CANONICALIZE_FILE_NAME)|g' \
+ -e 's|@''HAVE_DECL_ECVT''@|$(HAVE_DECL_ECVT)|g' \
+ -e 's|@''HAVE_DECL_FCVT''@|$(HAVE_DECL_FCVT)|g' \
+ -e 's|@''HAVE_DECL_GCVT''@|$(HAVE_DECL_GCVT)|g' \
-e 's|@''HAVE_DECL_GETLOADAVG''@|$(HAVE_DECL_GETLOADAVG)|g' \
-e 's|@''HAVE_GETSUBOPT''@|$(HAVE_GETSUBOPT)|g' \
-e 's|@''HAVE_GRANTPT''@|$(HAVE_GRANTPT)|g' \
@@ -2745,6 +2883,7 @@ stdlib.h: stdlib.in.h $(top_builddir)/config.status $(CXXDEFS_H) \
-e 's|@''HAVE_MKOSTEMPS''@|$(HAVE_MKOSTEMPS)|g' \
-e 's|@''HAVE_MKSTEMP''@|$(HAVE_MKSTEMP)|g' \
-e 's|@''HAVE_MKSTEMPS''@|$(HAVE_MKSTEMPS)|g' \
+ -e 's|@''HAVE_POSIX_MEMALIGN''@|$(HAVE_POSIX_MEMALIGN)|g' \
-e 's|@''HAVE_POSIX_OPENPT''@|$(HAVE_POSIX_OPENPT)|g' \
-e 's|@''HAVE_PTSNAME''@|$(HAVE_PTSNAME)|g' \
-e 's|@''HAVE_PTSNAME_R''@|$(HAVE_PTSNAME_R)|g' \
@@ -2767,12 +2906,15 @@ stdlib.h: stdlib.in.h $(top_builddir)/config.status $(CXXDEFS_H) \
-e 's|@''HAVE_SYS_LOADAVG_H''@|$(HAVE_SYS_LOADAVG_H)|g' \
-e 's|@''HAVE_UNLOCKPT''@|$(HAVE_UNLOCKPT)|g' \
-e 's|@''HAVE_DECL_UNSETENV''@|$(HAVE_DECL_UNSETENV)|g' \
+ -e 's|@''REPLACE_ALIGNED_ALLOC''@|$(REPLACE_ALIGNED_ALLOC)|g' \
-e 's|@''REPLACE_CALLOC''@|$(REPLACE_CALLOC)|g' \
-e 's|@''REPLACE_CANONICALIZE_FILE_NAME''@|$(REPLACE_CANONICALIZE_FILE_NAME)|g' \
+ -e 's|@''REPLACE_FREE''@|$(REPLACE_FREE)|g' \
-e 's|@''REPLACE_INITSTATE''@|$(REPLACE_INITSTATE)|g' \
-e 's|@''REPLACE_MALLOC''@|$(REPLACE_MALLOC)|g' \
-e 's|@''REPLACE_MBTOWC''@|$(REPLACE_MBTOWC)|g' \
-e 's|@''REPLACE_MKSTEMP''@|$(REPLACE_MKSTEMP)|g' \
+ -e 's|@''REPLACE_POSIX_MEMALIGN''@|$(REPLACE_POSIX_MEMALIGN)|g' \
-e 's|@''REPLACE_PTSNAME''@|$(REPLACE_PTSNAME)|g' \
-e 's|@''REPLACE_PTSNAME_R''@|$(REPLACE_PTSNAME_R)|g' \
-e 's|@''REPLACE_PUTENV''@|$(REPLACE_PUTENV)|g' \
@@ -2867,6 +3009,8 @@ string.h: string.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H
-e 's/@''GNULIB_SIGDESCR_NP''@/$(GNULIB_SIGDESCR_NP)/g' \
-e 's/@''GNULIB_STRSIGNAL''@/$(GNULIB_STRSIGNAL)/g' \
-e 's/@''GNULIB_STRVERSCMP''@/$(GNULIB_STRVERSCMP)/g' \
+ -e 's/@''GNULIB_MDA_MEMCCPY''@/$(GNULIB_MDA_MEMCCPY)/g' \
+ -e 's/@''GNULIB_MDA_STRDUP''@/$(GNULIB_MDA_STRDUP)/g' \
< $(srcdir)/string.in.h | \
sed -e 's|@''HAVE_EXPLICIT_BZERO''@|$(HAVE_EXPLICIT_BZERO)|g' \
-e 's|@''HAVE_FFSL''@|$(HAVE_FFSL)|g' \
@@ -3062,6 +3206,7 @@ sys/stat.h: sys_stat.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNU
-e 's/@''GNULIB_GETUMASK''@/$(GNULIB_GETUMASK)/g' \
-e 's/@''GNULIB_LCHMOD''@/$(GNULIB_LCHMOD)/g' \
-e 's/@''GNULIB_LSTAT''@/$(GNULIB_LSTAT)/g' \
+ -e 's/@''GNULIB_MKDIR''@/$(GNULIB_MKDIR)/g' \
-e 's/@''GNULIB_MKDIRAT''@/$(GNULIB_MKDIRAT)/g' \
-e 's/@''GNULIB_MKFIFO''@/$(GNULIB_MKFIFO)/g' \
-e 's/@''GNULIB_MKFIFOAT''@/$(GNULIB_MKFIFOAT)/g' \
@@ -3070,6 +3215,9 @@ sys/stat.h: sys_stat.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNU
-e 's/@''GNULIB_STAT''@/$(GNULIB_STAT)/g' \
-e 's/@''GNULIB_UTIMENSAT''@/$(GNULIB_UTIMENSAT)/g' \
-e 's/@''GNULIB_OVERRIDES_STRUCT_STAT''@/$(GNULIB_OVERRIDES_STRUCT_STAT)/g' \
+ -e 's/@''GNULIB_MDA_CHMOD''@/$(GNULIB_MDA_CHMOD)/g' \
+ -e 's/@''GNULIB_MDA_MKDIR''@/$(GNULIB_MDA_MKDIR)/g' \
+ -e 's/@''GNULIB_MDA_UMASK''@/$(GNULIB_MDA_UMASK)/g' \
-e 's|@''HAVE_FCHMODAT''@|$(HAVE_FCHMODAT)|g' \
-e 's|@''HAVE_FSTATAT''@|$(HAVE_FSTATAT)|g' \
-e 's|@''HAVE_FUTIMENS''@|$(HAVE_FUTIMENS)|g' \
@@ -3205,6 +3353,7 @@ time.h: time.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(
-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' \
+ -e 's/@''GNULIB_MDA_TZSET''@/$(GNULIB_MDA_TZSET)/g' \
-e 's|@''HAVE_DECL_LOCALTIME_R''@|$(HAVE_DECL_LOCALTIME_R)|g' \
-e 's|@''HAVE_NANOSLEEP''@|$(HAVE_NANOSLEEP)|g' \
-e 's|@''HAVE_STRPTIME''@|$(HAVE_STRPTIME)|g' \
@@ -3333,6 +3482,13 @@ unistd.h: unistd.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H
-e 's/@''GNULIB_DUP3''@/$(GNULIB_DUP3)/g' \
-e 's/@''GNULIB_ENVIRON''@/$(GNULIB_ENVIRON)/g' \
-e 's/@''GNULIB_EUIDACCESS''@/$(GNULIB_EUIDACCESS)/g' \
+ -e 's/@''GNULIB_EXECL''@/$(GNULIB_EXECL)/g' \
+ -e 's/@''GNULIB_EXECLE''@/$(GNULIB_EXECLE)/g' \
+ -e 's/@''GNULIB_EXECLP''@/$(GNULIB_EXECLP)/g' \
+ -e 's/@''GNULIB_EXECV''@/$(GNULIB_EXECV)/g' \
+ -e 's/@''GNULIB_EXECVE''@/$(GNULIB_EXECVE)/g' \
+ -e 's/@''GNULIB_EXECVP''@/$(GNULIB_EXECVP)/g' \
+ -e 's/@''GNULIB_EXECVPE''@/$(GNULIB_EXECVPE)/g' \
-e 's/@''GNULIB_FACCESSAT''@/$(GNULIB_FACCESSAT)/g' \
-e 's/@''GNULIB_FCHDIR''@/$(GNULIB_FCHDIR)/g' \
-e 's/@''GNULIB_FCHOWNAT''@/$(GNULIB_FCHOWNAT)/g' \
@@ -3378,11 +3534,33 @@ unistd.h: unistd.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H
-e 's/@''GNULIB_UNLINKAT''@/$(GNULIB_UNLINKAT)/g' \
-e 's/@''GNULIB_USLEEP''@/$(GNULIB_USLEEP)/g' \
-e 's/@''GNULIB_WRITE''@/$(GNULIB_WRITE)/g' \
+ -e 's/@''GNULIB_MDA_ACCESS''@/$(GNULIB_MDA_ACCESS)/g' \
+ -e 's/@''GNULIB_MDA_CHDIR''@/$(GNULIB_MDA_CHDIR)/g' \
+ -e 's/@''GNULIB_MDA_CLOSE''@/$(GNULIB_MDA_CLOSE)/g' \
+ -e 's/@''GNULIB_MDA_DUP''@/$(GNULIB_MDA_DUP)/g' \
+ -e 's/@''GNULIB_MDA_DUP2''@/$(GNULIB_MDA_DUP2)/g' \
+ -e 's/@''GNULIB_MDA_EXECL''@/$(GNULIB_MDA_EXECL)/g' \
+ -e 's/@''GNULIB_MDA_EXECLE''@/$(GNULIB_MDA_EXECLE)/g' \
+ -e 's/@''GNULIB_MDA_EXECLP''@/$(GNULIB_MDA_EXECLP)/g' \
+ -e 's/@''GNULIB_MDA_EXECV''@/$(GNULIB_MDA_EXECV)/g' \
+ -e 's/@''GNULIB_MDA_EXECVE''@/$(GNULIB_MDA_EXECVE)/g' \
+ -e 's/@''GNULIB_MDA_EXECVP''@/$(GNULIB_MDA_EXECVP)/g' \
+ -e 's/@''GNULIB_MDA_EXECVPE''@/$(GNULIB_MDA_EXECVPE)/g' \
+ -e 's/@''GNULIB_MDA_GETCWD''@/$(GNULIB_MDA_GETCWD)/g' \
+ -e 's/@''GNULIB_MDA_GETPID''@/$(GNULIB_MDA_GETPID)/g' \
+ -e 's/@''GNULIB_MDA_ISATTY''@/$(GNULIB_MDA_ISATTY)/g' \
+ -e 's/@''GNULIB_MDA_LSEEK''@/$(GNULIB_MDA_LSEEK)/g' \
+ -e 's/@''GNULIB_MDA_READ''@/$(GNULIB_MDA_READ)/g' \
+ -e 's/@''GNULIB_MDA_RMDIR''@/$(GNULIB_MDA_RMDIR)/g' \
+ -e 's/@''GNULIB_MDA_SWAB''@/$(GNULIB_MDA_SWAB)/g' \
+ -e 's/@''GNULIB_MDA_UNLINK''@/$(GNULIB_MDA_UNLINK)/g' \
+ -e 's/@''GNULIB_MDA_WRITE''@/$(GNULIB_MDA_WRITE)/g' \
< $(srcdir)/unistd.in.h | \
sed -e 's|@''HAVE_CHOWN''@|$(HAVE_CHOWN)|g' \
-e 's|@''HAVE_COPY_FILE_RANGE''@|$(HAVE_COPY_FILE_RANGE)|g' \
-e 's|@''HAVE_DUP3''@|$(HAVE_DUP3)|g' \
-e 's|@''HAVE_EUIDACCESS''@|$(HAVE_EUIDACCESS)|g' \
+ -e 's|@''HAVE_EXECVPE''@|$(HAVE_EXECVPE)|g' \
-e 's|@''HAVE_FACCESSAT''@|$(HAVE_FACCESSAT)|g' \
-e 's|@''HAVE_FCHDIR''@|$(HAVE_FCHDIR)|g' \
-e 's|@''HAVE_FCHOWNAT''@|$(HAVE_FCHOWNAT)|g' \
@@ -3412,6 +3590,7 @@ unistd.h: unistd.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H
-e 's|@''HAVE_UNLINKAT''@|$(HAVE_UNLINKAT)|g' \
-e 's|@''HAVE_USLEEP''@|$(HAVE_USLEEP)|g' \
-e 's|@''HAVE_DECL_ENVIRON''@|$(HAVE_DECL_ENVIRON)|g' \
+ -e 's|@''HAVE_DECL_EXECVPE''@|$(HAVE_DECL_EXECVPE)|g' \
-e 's|@''HAVE_DECL_FCHDIR''@|$(HAVE_DECL_FCHDIR)|g' \
-e 's|@''HAVE_DECL_FDATASYNC''@|$(HAVE_DECL_FDATASYNC)|g' \
-e 's|@''HAVE_DECL_GETDOMAINNAME''@|$(HAVE_DECL_GETDOMAINNAME)|g' \
@@ -3430,6 +3609,13 @@ unistd.h: unistd.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H
-e 's|@''REPLACE_CLOSE''@|$(REPLACE_CLOSE)|g' \
-e 's|@''REPLACE_DUP''@|$(REPLACE_DUP)|g' \
-e 's|@''REPLACE_DUP2''@|$(REPLACE_DUP2)|g' \
+ -e 's|@''REPLACE_EXECL''@|$(REPLACE_EXECL)|g' \
+ -e 's|@''REPLACE_EXECLE''@|$(REPLACE_EXECLE)|g' \
+ -e 's|@''REPLACE_EXECLP''@|$(REPLACE_EXECLP)|g' \
+ -e 's|@''REPLACE_EXECV''@|$(REPLACE_EXECV)|g' \
+ -e 's|@''REPLACE_EXECVE''@|$(REPLACE_EXECVE)|g' \
+ -e 's|@''REPLACE_EXECVP''@|$(REPLACE_EXECVP)|g' \
+ -e 's|@''REPLACE_EXECVPE''@|$(REPLACE_EXECVPE)|g' \
-e 's|@''REPLACE_FACCESSAT''@|$(REPLACE_FACCESSAT)|g' \
-e 's|@''REPLACE_FCHOWNAT''@|$(REPLACE_FCHOWNAT)|g' \
-e 's|@''REPLACE_FTRUNCATE''@|$(REPLACE_FTRUNCATE)|g' \
diff --git a/lib/group-member.c b/lib/group-member.c
index 6a6fc5605ef..52159016eab 100644
--- a/lib/group-member.c
+++ b/lib/group-member.c
@@ -1,6 +1,6 @@
/* group-member.c -- determine whether group id is in calling user's group list
- Copyright (C) 1994, 1997-1998, 2003, 2005-2006, 2009-2020 Free Software
+ Copyright (C) 1994, 1997-1998, 2003, 2005-2006, 2009-2021 Free Software
Foundation, Inc.
This program is free software: you can redistribute it and/or modify
diff --git a/lib/idx.h b/lib/idx.h
new file mode 100644
index 00000000000..681c8c90f10
--- /dev/null
+++ b/lib/idx.h
@@ -0,0 +1,114 @@
+/* A type for indices and sizes.
+ Copyright (C) 2020-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/>. */
+
+#ifndef _IDX_H
+#define _IDX_H
+
+/* Get ptrdiff_t. */
+#include <stddef.h>
+
+/* Get PTRDIFF_MAX. */
+#include <stdint.h>
+
+/* The type 'idx_t' holds an (array) index or an (object) size.
+ Its implementation promotes to a signed integer type,
+ which can hold the values
+ 0..2^63-1 (on 64-bit platforms) or
+ 0..2^31-1 (on 32-bit platforms).
+
+ Why a signed integer type?
+
+ * Security: Signed types can be checked for overflow via
+ '-fsanitize=undefined', but unsigned types cannot.
+
+ * Comparisons without surprises: ISO C99 § 6.3.1.8 specifies a few
+ surprising results for comparisons, such as
+
+ (int) -3 < (unsigned long) 7 => false
+ (int) -3 < (unsigned int) 7 => false
+ and on 32-bit machines:
+ (long) -3 < (unsigned int) 7 => false
+
+ This is surprising because the natural comparison order is by
+ value in the realm of infinite-precision signed integers (ℤ).
+
+ The best way to get rid of such surprises is to use signed types
+ for numerical integer values, and use unsigned types only for
+ bit masks and enums.
+
+ Why not use 'size_t' directly?
+
+ * Because 'size_t' is an unsigned type, and a signed type is better.
+ See above.
+
+ Why not use 'ptrdiff_t' directly?
+
+ * Maintainability: When reading and modifying code, it helps to know that
+ a certain variable cannot have negative values. For example, when you
+ have a loop
+
+ int n = ...;
+ for (int i = 0; i < n; i++) ...
+
+ or
+
+ ptrdiff_t n = ...;
+ for (ptrdiff_t i = 0; i < n; i++) ...
+
+ you have to ask yourself "what if n < 0?". Whereas in
+
+ idx_t n = ...;
+ for (idx_t i = 0; i < n; i++) ...
+
+ you know that this case cannot happen.
+
+ Similarly, when a programmer writes
+
+ idx_t = ptr2 - ptr1;
+
+ there is an implied assertion that ptr1 and ptr2 point into the same
+ object and that ptr1 <= ptr2.
+
+ * Being future-proof: In the future, range types (integers which are
+ constrained to a certain range of values) may be added to C compilers
+ or to the C standard. Several programming languages (Ada, Haskell,
+ Common Lisp, Pascal) already have range types. Such range types may
+ help producing good code and good warnings. The type 'idx_t' could
+ then be typedef'ed to a range type that is signed after promotion. */
+
+/* In the future, idx_t could be typedef'ed to a signed range type.
+ The clang "extended integer types", supported in Clang 11 or newer
+ <https://clang.llvm.org/docs/LanguageExtensions.html#extended-integer-types>,
+ are a special case of range types. However, these types don't support binary
+ operators with plain integer types (e.g. expressions such as x > 1).
+ Therefore, they don't behave like signed types (and not like unsigned types
+ either). So, we cannot use them here. */
+
+/* Use the signed type 'ptrdiff_t'. */
+/* Note: ISO C does not mandate that 'size_t' and 'ptrdiff_t' have the same
+ size, but it is so on all platforms we have seen since 1990. */
+typedef ptrdiff_t idx_t;
+
+/* IDX_MAX is the maximum value of an idx_t. */
+#define IDX_MAX PTRDIFF_MAX
+
+/* So far no need has been found for an IDX_WIDTH macro.
+ Perhaps there should be another macro IDX_VALUE_BITS that does not
+ count the sign bit and is therefore one less than PTRDIFF_WIDTH. */
+
+#endif /* _IDX_H */
diff --git a/lib/ieee754.in.h b/lib/ieee754.in.h
index d64bb46e9de..ce13efc918d 100644
--- a/lib/ieee754.in.h
+++ b/lib/ieee754.in.h
@@ -1,4 +1,4 @@
-/* Copyright (C) 1992-2020 Free Software Foundation, Inc.
+/* Copyright (C) 1992-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/ignore-value.h b/lib/ignore-value.h
index ec3288f0dfc..0a3cf1e95b4 100644
--- a/lib/ignore-value.h
+++ b/lib/ignore-value.h
@@ -1,6 +1,6 @@
/* ignore a function return without a compiler warning. -*- coding: utf-8 -*-
- Copyright (C) 2008-2020 Free Software Foundation, Inc.
+ Copyright (C) 2008-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
diff --git a/lib/intprops.h b/lib/intprops.h
index b27f2eea056..2a420ac8319 100644
--- a/lib/intprops.h
+++ b/lib/intprops.h
@@ -1,6 +1,6 @@
/* intprops.h -- properties of integer types
- Copyright (C) 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 2001-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
@@ -226,7 +226,9 @@
/* True if __builtin_add_overflow (A, B, P) and __builtin_sub_overflow
(A, B, P) work when P is non-null. */
-#if 5 <= __GNUC__ && !defined __ICC
+/* __builtin_{add,sub}_overflow exists but is not reliable in GCC 5.x and 6.x,
+ see <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=98269>. */
+#if 7 <= __GNUC__ && !defined __ICC
# define _GL_HAS_BUILTIN_ADD_OVERFLOW 1
#elif defined __has_builtin
# define _GL_HAS_BUILTIN_ADD_OVERFLOW __has_builtin (__builtin_add_overflow)
@@ -244,7 +246,17 @@
/* True if __builtin_add_overflow_p (A, B, C) works, and similarly for
__builtin_sub_overflow_p and __builtin_mul_overflow_p. */
-#define _GL_HAS_BUILTIN_OVERFLOW_P (7 <= __GNUC__)
+#if defined __clang__ || defined __ICC
+/* Clang 11 lacks __builtin_mul_overflow_p, and even if it did it
+ would presumably run afoul of Clang bug 16404. ICC 2021.1's
+ __builtin_add_overflow_p etc. are not treated as integral constant
+ expressions even when all arguments are. */
+# define _GL_HAS_BUILTIN_OVERFLOW_P 0
+#elif defined __has_builtin
+# define _GL_HAS_BUILTIN_OVERFLOW_P __has_builtin (__builtin_mul_overflow_p)
+#else
+# define _GL_HAS_BUILTIN_OVERFLOW_P (7 <= __GNUC__)
+#endif
/* The _GL*_OVERFLOW macros have the same restrictions as the
*_RANGE_OVERFLOW macros, except that they do not assume that operands
@@ -377,8 +389,9 @@
_GL_INT_OP_WRAPV (a, b, r, -, _GL_INT_SUBTRACT_RANGE_OVERFLOW)
#endif
#if _GL_HAS_BUILTIN_MUL_OVERFLOW
-# if (9 < __GNUC__ + (3 <= __GNUC_MINOR__) \
- || (__GNUC__ == 8 && 4 <= __GNUC_MINOR__))
+# if ((9 < __GNUC__ + (3 <= __GNUC_MINOR__) \
+ || (__GNUC__ == 8 && 4 <= __GNUC_MINOR__)) \
+ && !defined __ICC)
# define INT_MULTIPLY_WRAPV(a, b, r) __builtin_mul_overflow (a, b, r)
# else
/* Work around GCC bug 91450. */
@@ -585,4 +598,33 @@
: (tmin) / (a) < (b)) \
: (tmax) / (b) < (a)))
+/* The following macros compute A + B, A - B, and A * B, respectively.
+ If no overflow occurs, they set *R to the result and return 1;
+ otherwise, they return 0 and may modify *R.
+
+ Example usage:
+
+ long int result;
+ if (INT_ADD_OK (a, b, &result))
+ printf ("result is %ld\n", result);
+ else
+ printf ("overflow\n");
+
+ A, B, and *R should be integers; they need not be the same type,
+ and they need not be all signed or all unsigned.
+
+ These macros work correctly on all known practical hosts, and do not rely
+ on undefined behavior due to signed arithmetic overflow.
+
+ These macros are not constant expressions.
+
+ These macros may evaluate their arguments zero or multiple times, so the
+ arguments should not have side effects.
+
+ These macros are tuned for B being a constant. */
+
+#define INT_ADD_OK(a, b, r) ! INT_ADD_WRAPV (a, b, r)
+#define INT_SUBTRACT_OK(a, b, r) ! INT_SUBTRACT_WRAPV (a, b, r)
+#define INT_MULTIPLY_OK(a, b, r) ! INT_MULTIPLY_WRAPV (a, b, r)
+
#endif /* _GL_INTPROPS_H */
diff --git a/lib/inttypes.in.h b/lib/inttypes.in.h
index 596a050458b..e9ee500e3e6 100644
--- a/lib/inttypes.in.h
+++ b/lib/inttypes.in.h
@@ -1,4 +1,4 @@
-/* Copyright (C) 2006-2020 Free Software Foundation, Inc.
+/* Copyright (C) 2006-2021 Free Software Foundation, Inc.
Written by Paul Eggert, Bruno Haible, Derek Price.
This file is part of gnulib.
diff --git a/lib/lchmod.c b/lib/lchmod.c
index 77a00609552..195304f5115 100644
--- a/lib/lchmod.c
+++ b/lib/lchmod.c
@@ -1,6 +1,6 @@
/* Implement lchmod on platforms where it does not work correctly.
- Copyright 2020 Free Software Foundation, Inc.
+ Copyright 2020-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
diff --git a/lib/libc-config.h b/lib/libc-config.h
index 1300c3a2ac8..d4e29951f35 100644
--- a/lib/libc-config.h
+++ b/lib/libc-config.h
@@ -1,6 +1,6 @@
/* System definitions for code taken from the GNU C Library
- Copyright 2017-2020 Free Software Foundation, Inc.
+ Copyright 2017-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
diff --git a/lib/limits.in.h b/lib/limits.in.h
index d25c5237060..076ab9ef548 100644
--- a/lib/limits.in.h
+++ b/lib/limits.in.h
@@ -1,6 +1,6 @@
/* A GNU-like <limits.h>.
- Copyright 2016-2020 Free Software Foundation, Inc.
+ Copyright 2016-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
diff --git a/lib/lstat.c b/lib/lstat.c
index f74392b7319..a584c6aa069 100644
--- a/lib/lstat.c
+++ b/lib/lstat.c
@@ -1,6 +1,6 @@
/* Work around a bug of lstat on some systems
- Copyright (C) 1997-2006, 2008-2020 Free Software Foundation, Inc.
+ Copyright (C) 1997-2006, 2008-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
diff --git a/lib/malloc/scratch_buffer.h b/lib/malloc/scratch_buffer.h
new file mode 100644
index 00000000000..26e306212d1
--- /dev/null
+++ b/lib/malloc/scratch_buffer.h
@@ -0,0 +1,151 @@
+/* Variable-sized buffer with on-stack default allocation.
+ 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
+ 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/>. */
+
+#ifndef _SCRATCH_BUFFER_H
+#define _SCRATCH_BUFFER_H
+
+/* Scratch buffers with a default stack allocation and fallback to
+ heap allocation. It is expected that this function is used in this
+ way:
+
+ struct scratch_buffer tmpbuf;
+ scratch_buffer_init (&tmpbuf);
+
+ while (!function_that_uses_buffer (tmpbuf.data, tmpbuf.length))
+ if (!scratch_buffer_grow (&tmpbuf))
+ return -1;
+
+ scratch_buffer_free (&tmpbuf);
+ return 0;
+
+ The allocation functions (scratch_buffer_grow,
+ scratch_buffer_grow_preserve, scratch_buffer_set_array_size) make
+ sure that the heap allocation, if any, is freed, so that the code
+ above does not have a memory leak. The buffer still remains in a
+ state that can be deallocated using scratch_buffer_free, so a loop
+ like this is valid as well:
+
+ struct scratch_buffer tmpbuf;
+ scratch_buffer_init (&tmpbuf);
+
+ while (!function_that_uses_buffer (tmpbuf.data, tmpbuf.length))
+ if (!scratch_buffer_grow (&tmpbuf))
+ break;
+
+ scratch_buffer_free (&tmpbuf);
+
+ scratch_buffer_grow and scratch_buffer_grow_preserve are guaranteed
+ to grow the buffer by at least 512 bytes. This means that when
+ using the scratch buffer as a backing store for a non-character
+ array whose element size, in bytes, is 512 or smaller, the scratch
+ buffer only has to grow once to make room for at least one more
+ element.
+*/
+
+#include <stdbool.h>
+#include <stddef.h>
+#include <stdlib.h>
+
+/* Scratch buffer. Must be initialized with scratch_buffer_init
+ before its use. */
+struct scratch_buffer {
+ void *data; /* Pointer to the beginning of the scratch area. */
+ size_t length; /* Allocated space at the data pointer, in bytes. */
+ union { max_align_t __align; char __c[1024]; } __space;
+};
+
+/* Initializes *BUFFER so that BUFFER->data points to BUFFER->__space
+ and BUFFER->length reflects the available space. */
+static inline void
+scratch_buffer_init (struct scratch_buffer *buffer)
+{
+ buffer->data = buffer->__space.__c;
+ buffer->length = sizeof (buffer->__space);
+}
+
+/* Deallocates *BUFFER (if it was heap-allocated). */
+static inline void
+scratch_buffer_free (struct scratch_buffer *buffer)
+{
+ if (buffer->data != buffer->__space.__c)
+ free (buffer->data);
+}
+
+/* Grow *BUFFER by some arbitrary amount. The buffer contents is NOT
+ preserved. Return true on success, false on allocation failure (in
+ which case the old buffer is freed). On success, the new buffer is
+ larger than the previous size. On failure, *BUFFER is deallocated,
+ but remains in a free-able state, and errno is set. */
+bool __libc_scratch_buffer_grow (struct scratch_buffer *buffer);
+libc_hidden_proto (__libc_scratch_buffer_grow)
+
+/* Alias for __libc_scratch_buffer_grow. */
+static __always_inline bool
+scratch_buffer_grow (struct scratch_buffer *buffer)
+{
+ return __glibc_likely (__libc_scratch_buffer_grow (buffer));
+}
+
+/* Like __libc_scratch_buffer_grow, but preserve the old buffer
+ contents on success, as a prefix of the new buffer. */
+bool __libc_scratch_buffer_grow_preserve (struct scratch_buffer *buffer);
+libc_hidden_proto (__libc_scratch_buffer_grow_preserve)
+
+/* Alias for __libc_scratch_buffer_grow_preserve. */
+static __always_inline bool
+scratch_buffer_grow_preserve (struct scratch_buffer *buffer)
+{
+ return __glibc_likely (__libc_scratch_buffer_grow_preserve (buffer));
+}
+
+/* Grow *BUFFER so that it can store at least NELEM elements of SIZE
+ bytes. The buffer contents are NOT preserved. Both NELEM and SIZE
+ can be zero. Return true on success, false on allocation failure
+ (in which case the old buffer is freed, but *BUFFER remains in a
+ free-able state, and errno is set). It is unspecified whether this
+ function can reduce the array size. */
+bool __libc_scratch_buffer_set_array_size (struct scratch_buffer *buffer,
+ size_t nelem, size_t size);
+libc_hidden_proto (__libc_scratch_buffer_set_array_size)
+
+/* Alias for __libc_scratch_set_array_size. */
+static __always_inline bool
+scratch_buffer_set_array_size (struct scratch_buffer *buffer,
+ size_t nelem, size_t size)
+{
+ return __glibc_likely (__libc_scratch_buffer_set_array_size
+ (buffer, nelem, size));
+}
+
+/* Return a copy of *BUFFER's first SIZE bytes as a heap-allocated block,
+ deallocating *BUFFER if it was heap-allocated. SIZE must be at
+ most *BUFFER's size. Return NULL (setting errno) on memory
+ exhaustion. */
+void *__libc_scratch_buffer_dupfree (struct scratch_buffer *buffer,
+ size_t size);
+libc_hidden_proto (__libc_scratch_buffer_dupfree)
+
+/* Alias for __libc_scratch_dupfree. */
+static __always_inline void *
+scratch_buffer_dupfree (struct scratch_buffer *buffer, size_t size)
+{
+ void *r = __libc_scratch_buffer_dupfree (buffer, size);
+ return __glibc_likely (r != NULL) ? r : NULL;
+}
+
+#endif /* _SCRATCH_BUFFER_H */
diff --git a/lib/malloc/scratch_buffer_dupfree.c b/lib/malloc/scratch_buffer_dupfree.c
new file mode 100644
index 00000000000..775bff5609f
--- /dev/null
+++ b/lib/malloc/scratch_buffer_dupfree.c
@@ -0,0 +1,41 @@
+/* Variable-sized buffer with on-stack default allocation.
+ Copyright (C) 2020-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/>. */
+
+#ifndef _LIBC
+# include <libc-config.h>
+#endif
+
+#include <scratch_buffer.h>
+#include <string.h>
+
+void *
+__libc_scratch_buffer_dupfree (struct scratch_buffer *buffer, size_t size)
+{
+ void *data = buffer->data;
+ if (data == buffer->__space.__c)
+ {
+ void *copy = malloc (size);
+ return copy != NULL ? memcpy (copy, data, size) : NULL;
+ }
+ else
+ {
+ void *copy = realloc (data, size);
+ return copy != NULL ? copy : data;
+ }
+}
+libc_hidden_def (__libc_scratch_buffer_dupfree)
diff --git a/lib/malloc/scratch_buffer_grow.c b/lib/malloc/scratch_buffer_grow.c
new file mode 100644
index 00000000000..41befe3d65f
--- /dev/null
+++ b/lib/malloc/scratch_buffer_grow.c
@@ -0,0 +1,56 @@
+/* Variable-sized buffer with on-stack default allocation.
+ Copyright (C) 2015-2020 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/>. */
+
+#ifndef _LIBC
+# include <libc-config.h>
+#endif
+
+#include <scratch_buffer.h>
+#include <errno.h>
+
+bool
+__libc_scratch_buffer_grow (struct scratch_buffer *buffer)
+{
+ void *new_ptr;
+ size_t new_length = buffer->length * 2;
+
+ /* Discard old buffer. */
+ scratch_buffer_free (buffer);
+
+ /* Check for overflow. */
+ if (__glibc_likely (new_length >= buffer->length))
+ new_ptr = malloc (new_length);
+ else
+ {
+ __set_errno (ENOMEM);
+ new_ptr = NULL;
+ }
+
+ if (__glibc_unlikely (new_ptr == NULL))
+ {
+ /* Buffer must remain valid to free. */
+ scratch_buffer_init (buffer);
+ return false;
+ }
+
+ /* Install new heap-based buffer. */
+ buffer->data = new_ptr;
+ buffer->length = new_length;
+ return true;
+}
+libc_hidden_def (__libc_scratch_buffer_grow)
diff --git a/lib/malloc/scratch_buffer_grow_preserve.c b/lib/malloc/scratch_buffer_grow_preserve.c
new file mode 100644
index 00000000000..aef232938d5
--- /dev/null
+++ b/lib/malloc/scratch_buffer_grow_preserve.c
@@ -0,0 +1,67 @@
+/* Variable-sized buffer with on-stack default allocation.
+ Copyright (C) 2015-2020 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/>. */
+
+#ifndef _LIBC
+# include <libc-config.h>
+#endif
+
+#include <scratch_buffer.h>
+#include <errno.h>
+#include <string.h>
+
+bool
+__libc_scratch_buffer_grow_preserve (struct scratch_buffer *buffer)
+{
+ size_t new_length = 2 * buffer->length;
+ void *new_ptr;
+
+ if (buffer->data == buffer->__space.__c)
+ {
+ /* Move buffer to the heap. No overflow is possible because
+ buffer->length describes a small buffer on the stack. */
+ new_ptr = malloc (new_length);
+ if (new_ptr == NULL)
+ return false;
+ memcpy (new_ptr, buffer->__space.__c, buffer->length);
+ }
+ else
+ {
+ /* Buffer was already on the heap. Check for overflow. */
+ if (__glibc_likely (new_length >= buffer->length))
+ new_ptr = realloc (buffer->data, new_length);
+ else
+ {
+ __set_errno (ENOMEM);
+ new_ptr = NULL;
+ }
+
+ if (__glibc_unlikely (new_ptr == NULL))
+ {
+ /* Deallocate, but buffer must remain valid to free. */
+ free (buffer->data);
+ scratch_buffer_init (buffer);
+ return false;
+ }
+ }
+
+ /* Install new heap-based buffer. */
+ buffer->data = new_ptr;
+ buffer->length = new_length;
+ return true;
+}
+libc_hidden_def (__libc_scratch_buffer_grow_preserve)
diff --git a/lib/malloc/scratch_buffer_set_array_size.c b/lib/malloc/scratch_buffer_set_array_size.c
new file mode 100644
index 00000000000..5f5e4c24f5a
--- /dev/null
+++ b/lib/malloc/scratch_buffer_set_array_size.c
@@ -0,0 +1,64 @@
+/* Variable-sized buffer with on-stack default allocation.
+ Copyright (C) 2015-2020 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/>. */
+
+#ifndef _LIBC
+# include <libc-config.h>
+#endif
+
+#include <scratch_buffer.h>
+#include <errno.h>
+#include <limits.h>
+
+bool
+__libc_scratch_buffer_set_array_size (struct scratch_buffer *buffer,
+ size_t nelem, size_t size)
+{
+ size_t new_length = nelem * size;
+
+ /* Avoid overflow check if both values are small. */
+ if ((nelem | size) >> (sizeof (size_t) * CHAR_BIT / 2) != 0
+ && nelem != 0 && size != new_length / nelem)
+ {
+ /* Overflow. Discard the old buffer, but it must remain valid
+ to free. */
+ scratch_buffer_free (buffer);
+ scratch_buffer_init (buffer);
+ __set_errno (ENOMEM);
+ return false;
+ }
+
+ if (new_length <= buffer->length)
+ return true;
+
+ /* Discard old buffer. */
+ scratch_buffer_free (buffer);
+
+ char *new_ptr = malloc (new_length);
+ if (new_ptr == NULL)
+ {
+ /* Buffer must remain valid to free. */
+ scratch_buffer_init (buffer);
+ return false;
+ }
+
+ /* Install new heap-based buffer. */
+ buffer->data = new_ptr;
+ buffer->length = new_length;
+ return true;
+}
+libc_hidden_def (__libc_scratch_buffer_set_array_size)
diff --git a/lib/malloca.c b/lib/malloca.c
index 975b166daed..d68d233dcb3 100644
--- a/lib/malloca.c
+++ b/lib/malloca.c
@@ -1,5 +1,6 @@
/* Safe automatic memory allocation.
- Copyright (C) 2003, 2006-2007, 2009-2020 Free Software Foundation, Inc.
+ Copyright (C) 2003, 2006-2007, 2009-2021 Free Software Foundation,
+ Inc.
Written by Bruno Haible <bruno@clisp.org>, 2003, 2018.
This program is free software; you can redistribute it and/or modify
diff --git a/lib/malloca.h b/lib/malloca.h
index ccc485a6a4d..a04e54593fa 100644
--- a/lib/malloca.h
+++ b/lib/malloca.h
@@ -1,5 +1,5 @@
/* Safe automatic memory allocation.
- Copyright (C) 2003-2007, 2009-2020 Free Software Foundation, Inc.
+ Copyright (C) 2003-2007, 2009-2021 Free Software Foundation, Inc.
Written by Bruno Haible <bruno@clisp.org>, 2003.
This program is free software; you can redistribute it and/or modify
diff --git a/lib/md5.c b/lib/md5.c
index 74cf2c3a0f7..e7eeeaab03f 100644
--- a/lib/md5.c
+++ b/lib/md5.c
@@ -1,6 +1,6 @@
/* Functions to compute MD5 message digest of files or memory blocks.
according to the definition of MD5 in RFC 1321 from April 1992.
- Copyright (C) 1995-1997, 1999-2001, 2005-2006, 2008-2020 Free Software
+ Copyright (C) 1995-1997, 1999-2001, 2005-2006, 2008-2021 Free Software
Foundation, Inc.
This file is part of the GNU C Library.
diff --git a/lib/md5.h b/lib/md5.h
index c728ba1b6f2..aa4b0805d58 100644
--- a/lib/md5.h
+++ b/lib/md5.h
@@ -1,6 +1,6 @@
/* Declaration of functions and data types used for MD5 sum computing
library functions.
- Copyright (C) 1995-1997, 1999-2001, 2004-2006, 2008-2020 Free Software
+ Copyright (C) 1995-1997, 1999-2001, 2004-2006, 2008-2021 Free Software
Foundation, Inc.
This file is part of the GNU C Library.
diff --git a/lib/memmem.c b/lib/memmem.c
index 6f6574211f8..87266fa87af 100644
--- a/lib/memmem.c
+++ b/lib/memmem.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1991-1994, 1996-1998, 2000, 2004, 2007-2020 Free Software
+/* Copyright (C) 1991-1994, 1996-1998, 2000, 2004, 2007-2021 Free Software
Foundation, Inc.
This file is part of the GNU C Library.
diff --git a/lib/mempcpy.c b/lib/mempcpy.c
index fe832d7bcfb..fea618a9e59 100644
--- a/lib/mempcpy.c
+++ b/lib/mempcpy.c
@@ -1,5 +1,5 @@
/* Copy memory area and return pointer after last written byte.
- Copyright (C) 2003, 2007, 2009-2020 Free Software Foundation, Inc.
+ Copyright (C) 2003, 2007, 2009-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
diff --git a/lib/memrchr.c b/lib/memrchr.c
index 7ff32e11338..dcd24fafc6e 100644
--- a/lib/memrchr.c
+++ b/lib/memrchr.c
@@ -1,6 +1,6 @@
/* memrchr -- find the last occurrence of a byte in a memory block
- Copyright (C) 1991, 1993, 1996-1997, 1999-2000, 2003-2020 Free Software
+ Copyright (C) 1991, 1993, 1996-1997, 1999-2000, 2003-2021 Free Software
Foundation, Inc.
Based on strlen implementation by Torbjorn Granlund (tege@sics.se),
diff --git a/lib/mini-gmp-gnulib.c b/lib/mini-gmp-gnulib.c
index e9e8a174c03..d46c2b993bc 100644
--- a/lib/mini-gmp-gnulib.c
+++ b/lib/mini-gmp-gnulib.c
@@ -1,6 +1,6 @@
/* Tailor mini-gmp.c for Gnulib-using applications.
- Copyright 2018-2020 Free Software Foundation, Inc.
+ Copyright 2018-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
diff --git a/lib/mini-gmp.c b/lib/mini-gmp.c
index 2e0301b0081..d34fe525e4c 100644
--- a/lib/mini-gmp.c
+++ b/lib/mini-gmp.c
@@ -32,7 +32,7 @@ see https://www.gnu.org/licenses/. */
/* NOTE: All functions in this file which are not declared in
mini-gmp.h are internal, and are not intended to be compatible
- neither with GMP nor with future versions of mini-gmp. */
+ with GMP or with future versions of mini-gmp. */
/* Much of the material copied from GMP files, including: gmp-impl.h,
longlong.h, mpn/generic/add_n.c, mpn/generic/addmul_1.c,
@@ -1331,29 +1331,26 @@ mpn_set_str_bits (mp_ptr rp, const unsigned char *sp, size_t sn,
unsigned bits)
{
mp_size_t rn;
- size_t j;
+ mp_limb_t limb;
unsigned shift;
- for (j = sn, rn = 0, shift = 0; j-- > 0; )
+ for (limb = 0, rn = 0, shift = 0; sn-- > 0; )
{
- if (shift == 0)
- {
- rp[rn++] = sp[j];
- shift += bits;
- }
- else
+ limb |= (mp_limb_t) sp[sn] << shift;
+ shift += bits;
+ if (shift >= GMP_LIMB_BITS)
{
- rp[rn-1] |= (mp_limb_t) sp[j] << shift;
- shift += bits;
- if (shift >= GMP_LIMB_BITS)
- {
- shift -= GMP_LIMB_BITS;
- if (shift > 0)
- rp[rn++] = (mp_limb_t) sp[j] >> (bits - shift);
- }
+ shift -= GMP_LIMB_BITS;
+ rp[rn++] = limb;
+ /* Next line is correct also if shift == 0,
+ bits == 8, and mp_limb_t == unsigned char. */
+ limb = (unsigned int) sp[sn] >> (bits - shift);
}
}
- rn = mpn_normalized_size (rp, rn);
+ if (limb != 0)
+ rp[rn++] = limb;
+ else
+ rn = mpn_normalized_size (rp, rn);
return rn;
}
@@ -2723,7 +2720,7 @@ mpz_make_odd (mpz_t r)
assert (r->_mp_size > 0);
/* Count trailing zeros, equivalent to mpn_scan1, because we know that there is a 1 */
- shift = mpn_common_scan (r->_mp_d[0], 0, r->_mp_d, 0, 0);
+ shift = mpn_scan1 (r->_mp_d, 0);
mpz_tdiv_q_2exp (r, r, shift);
return shift;
@@ -2780,9 +2777,13 @@ mpz_gcd (mpz_t g, const mpz_t u, const mpz_t v)
if (tv->_mp_size == 1)
{
- mp_limb_t vl = tv->_mp_d[0];
- mp_limb_t ul = mpz_tdiv_ui (tu, vl);
- mpz_set_ui (g, mpn_gcd_11 (ul, vl));
+ mp_limb_t *gp;
+
+ mpz_tdiv_r (tu, tu, tv);
+ gp = MPZ_REALLOC (g, 1); /* gp = mpz_limbs_modify (g, 1); */
+ *gp = mpn_gcd_11 (tu->_mp_d[0], tv->_mp_d[0]);
+
+ g->_mp_size = *gp != 0; /* mpz_limbs_finish (g, 1); */
break;
}
mpz_sub (tu, tu, tv);
@@ -2871,7 +2872,6 @@ mpz_gcdext (mpz_t g, mpz_t s, mpz_t t, const mpz_t u, const mpz_t v)
* s0 = 0, s1 = 2^vz
*/
- mpz_setbit (t0, uz);
mpz_tdiv_qr (t1, tu, tu, tv);
mpz_mul_2exp (t1, t1, uz);
@@ -2882,8 +2882,7 @@ mpz_gcdext (mpz_t g, mpz_t s, mpz_t t, const mpz_t u, const mpz_t v)
{
mp_bitcnt_t shift;
shift = mpz_make_odd (tu);
- mpz_mul_2exp (t0, t0, shift);
- mpz_mul_2exp (s0, s0, shift);
+ mpz_setbit (t0, uz + shift);
power += shift;
for (;;)
@@ -2921,6 +2920,8 @@ mpz_gcdext (mpz_t g, mpz_t s, mpz_t t, const mpz_t u, const mpz_t v)
power += shift;
}
}
+ else
+ mpz_setbit (t0, uz);
/* Now tv = odd part of gcd, and -s0 and t0 are corresponding
cofactors. */
@@ -3604,7 +3605,8 @@ mpz_probab_prime_p (const mpz_t n, int reps)
/* Find q and k, where q is odd and n = 1 + 2**k * q. */
mpz_abs (nm1, n);
nm1->_mp_d[0] -= 1;
- k = mpz_scan1 (nm1, 0);
+ /* Count trailing zeros, equivalent to mpn_scan1, because we know that there is a 1 */
+ k = mpn_scan1 (nm1->_mp_d, 0);
mpz_tdiv_q_2exp (q, nm1, k);
/* BPSW test */
@@ -4301,7 +4303,7 @@ mpz_get_str (char *sp, int base, const mpz_t u)
ret:
sp[sn] = '\0';
if (osn && osn != sn + 1)
- sp = gmp_realloc(sp, osn, sn + 1);
+ sp = (char*) gmp_realloc (sp, osn, sn + 1);
return sp;
}
@@ -4425,6 +4427,8 @@ mpz_out_str (FILE *stream, int base, const mpz_t x)
size_t len, n;
str = mpz_get_str (NULL, base, x);
+ if (!str)
+ return 0;
len = strlen (str);
n = fwrite (str, 1, len, stream);
gmp_free (str, len + 1);
diff --git a/lib/mini-gmp.h b/lib/mini-gmp.h
index c00568c2568..59a37e64947 100644
--- a/lib/mini-gmp.h
+++ b/lib/mini-gmp.h
@@ -1,6 +1,6 @@
/* mini-gmp, a minimalistic implementation of a GNU GMP subset.
-Copyright 2011-2015, 2017, 2019 Free Software Foundation, Inc.
+Copyright 2011-2015, 2017, 2019-2020 Free Software Foundation, Inc.
This file is part of the GNU MP Library.
@@ -295,7 +295,8 @@ int mpz_init_set_str (mpz_t, const char *, int);
|| defined (_MSL_STDIO_H) /* Metrowerks */ \
|| defined (_STDIO_H_INCLUDED) /* QNX4 */ \
|| defined (_ISO_STDIO_ISO_H) /* Sun C++ */ \
- || defined (__STDIO_LOADED) /* VMS */
+ || defined (__STDIO_LOADED) /* VMS */ \
+ || defined (__DEFINED_FILE) /* musl */
size_t mpz_out_str (FILE *, int, const mpz_t);
#endif
diff --git a/lib/minmax.h b/lib/minmax.h
index b9477767b0d..eb9fb09a540 100644
--- a/lib/minmax.h
+++ b/lib/minmax.h
@@ -1,5 +1,5 @@
/* MIN, MAX macros.
- Copyright (C) 1995, 1998, 2001, 2003, 2005, 2009-2020 Free Software
+ Copyright (C) 1995, 1998, 2001, 2003, 2005, 2009-2021 Free Software
Foundation, Inc.
This program is free software; you can redistribute it and/or modify
diff --git a/lib/mkostemp.c b/lib/mkostemp.c
index 46b58e1bcac..9d733ddd10d 100644
--- a/lib/mkostemp.c
+++ b/lib/mkostemp.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1998-1999, 2001, 2005-2007, 2009-2020 Free Software
+/* Copyright (C) 1998-1999, 2001, 2005-2007, 2009-2021 Free Software
Foundation, Inc.
This file is derived from the one in the GNU C Library.
diff --git a/lib/mktime.c b/lib/mktime.c
index 5b4c144ecad..2c7cd7ba832 100644
--- a/lib/mktime.c
+++ b/lib/mktime.c
@@ -1,5 +1,5 @@
/* Convert a 'struct tm' to a time_t value.
- Copyright (C) 1993-2020 Free Software Foundation, Inc.
+ Copyright (C) 1993-2021 Free Software Foundation, Inc.
This file is part of the GNU C Library.
Contributed by Paul Eggert <eggert@twinsun.com>.
diff --git a/lib/nstrftime.c b/lib/nstrftime.c
index 7d5a97f7635..8ba6975552b 100644
--- a/lib/nstrftime.c
+++ b/lib/nstrftime.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1991-2020 Free Software Foundation, Inc.
+/* Copyright (C) 1991-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/open.c b/lib/open.c
index 0f7c6e9b9d3..85991853318 100644
--- a/lib/open.c
+++ b/lib/open.c
@@ -1,5 +1,5 @@
/* Open a descriptor to a file.
- Copyright (C) 2007-2020 Free Software Foundation, Inc.
+ Copyright (C) 2007-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
diff --git a/lib/openat-priv.h b/lib/openat-priv.h
index 5b824f7a976..5c42d034998 100644
--- a/lib/openat-priv.h
+++ b/lib/openat-priv.h
@@ -1,6 +1,6 @@
/* Internals for openat-like functions.
- Copyright (C) 2005-2006, 2009-2020 Free Software Foundation, Inc.
+ Copyright (C) 2005-2006, 2009-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
diff --git a/lib/openat-proc.c b/lib/openat-proc.c
index b5aaee8b1d3..4f8be90f146 100644
--- a/lib/openat-proc.c
+++ b/lib/openat-proc.c
@@ -1,6 +1,6 @@
/* Create /proc/self/fd-related names for subfiles of open directories.
- Copyright (C) 2006, 2009-2020 Free Software Foundation, Inc.
+ Copyright (C) 2006, 2009-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
diff --git a/lib/openat.h b/lib/openat.h
index 824ce560e34..70981241b24 100644
--- a/lib/openat.h
+++ b/lib/openat.h
@@ -1,5 +1,5 @@
/* provide a replacement openat function
- Copyright (C) 2004-2006, 2008-2020 Free Software Foundation, Inc.
+ Copyright (C) 2004-2006, 2008-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
diff --git a/lib/pathmax.h b/lib/pathmax.h
index 15a236fae8c..49cf4629c7c 100644
--- a/lib/pathmax.h
+++ b/lib/pathmax.h
@@ -1,5 +1,5 @@
/* Define PATH_MAX somehow. Requires sys/types.h.
- Copyright (C) 1992, 1999, 2001, 2003, 2005, 2009-2020 Free Software
+ Copyright (C) 1992, 1999, 2001, 2003, 2005, 2009-2021 Free Software
Foundation, Inc.
This program is free software; you can redistribute it and/or modify
diff --git a/lib/pipe2.c b/lib/pipe2.c
index 591e94db4ce..41493aa4307 100644
--- a/lib/pipe2.c
+++ b/lib/pipe2.c
@@ -1,5 +1,5 @@
/* Create a pipe, with specific opening flags.
- Copyright (C) 2009-2020 Free Software Foundation, Inc.
+ Copyright (C) 2009-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
diff --git a/lib/pselect.c b/lib/pselect.c
index d6205240981..0fda4eef6ec 100644
--- a/lib/pselect.c
+++ b/lib/pselect.c
@@ -1,6 +1,6 @@
/* pselect - synchronous I/O multiplexing
- Copyright 2011-2020 Free Software Foundation, Inc.
+ Copyright 2011-2021 Free Software Foundation, Inc.
This file is part of gnulib.
diff --git a/lib/pthread_sigmask.c b/lib/pthread_sigmask.c
index 3eb74f2b5ec..8a692048a02 100644
--- a/lib/pthread_sigmask.c
+++ b/lib/pthread_sigmask.c
@@ -1,5 +1,5 @@
/* POSIX compatible signal blocking for threads.
- Copyright (C) 2011-2020 Free Software Foundation, Inc.
+ Copyright (C) 2011-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
diff --git a/lib/qcopy-acl.c b/lib/qcopy-acl.c
index 5408b0fe6be..f274ca8d568 100644
--- a/lib/qcopy-acl.c
+++ b/lib/qcopy-acl.c
@@ -1,6 +1,6 @@
/* Copy access control list from one file to another. -*- coding: utf-8 -*-
- Copyright (C) 2002-2003, 2005-2020 Free Software Foundation, Inc.
+ Copyright (C) 2002-2003, 2005-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
diff --git a/lib/rawmemchr.c b/lib/rawmemchr.c
new file mode 100644
index 00000000000..bbb250feb8c
--- /dev/null
+++ b/lib/rawmemchr.c
@@ -0,0 +1,136 @@
+/* Searching in a string.
+ Copyright (C) 2008-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/>. */
+
+#include <config.h>
+
+/* Specification. */
+#include <string.h>
+
+/* Find the first occurrence of C in S. */
+void *
+rawmemchr (const void *s, int c_in)
+{
+ /* On 32-bit hardware, choosing longword to be a 32-bit unsigned
+ long instead of a 64-bit uintmax_t tends to give better
+ performance. On 64-bit hardware, unsigned long is generally 64
+ bits already. Change this typedef to experiment with
+ performance. */
+ typedef unsigned long int longword;
+
+ const unsigned char *char_ptr;
+ const longword *longword_ptr;
+ longword repeated_one;
+ longword repeated_c;
+ unsigned char c;
+
+ c = (unsigned char) c_in;
+
+ /* Handle the first few bytes by reading one byte at a time.
+ Do this until CHAR_PTR is aligned on a longword boundary. */
+ for (char_ptr = (const unsigned char *) s;
+ (size_t) char_ptr % sizeof (longword) != 0;
+ ++char_ptr)
+ if (*char_ptr == c)
+ return (void *) char_ptr;
+
+ longword_ptr = (const longword *) char_ptr;
+
+ /* All these elucidatory comments refer to 4-byte longwords,
+ but the theory applies equally well to any size longwords. */
+
+ /* Compute auxiliary longword values:
+ repeated_one is a value which has a 1 in every byte.
+ repeated_c has c in every byte. */
+ repeated_one = 0x01010101;
+ repeated_c = c | (c << 8);
+ repeated_c |= repeated_c << 16;
+ if (0xffffffffU < (longword) -1)
+ {
+ repeated_one |= repeated_one << 31 << 1;
+ repeated_c |= repeated_c << 31 << 1;
+ if (8 < sizeof (longword))
+ {
+ size_t i;
+
+ for (i = 64; i < sizeof (longword) * 8; i *= 2)
+ {
+ repeated_one |= repeated_one << i;
+ repeated_c |= repeated_c << i;
+ }
+ }
+ }
+
+ /* Instead of the traditional loop which tests each byte, we will
+ test a longword at a time. The tricky part is testing if *any of
+ the four* bytes in the longword in question are equal to NUL or
+ c. We first use an xor with repeated_c. This reduces the task
+ to testing whether *any of the four* bytes in longword1 is zero.
+
+ We compute tmp =
+ ((longword1 - repeated_one) & ~longword1) & (repeated_one << 7).
+ That is, we perform the following operations:
+ 1. Subtract repeated_one.
+ 2. & ~longword1.
+ 3. & a mask consisting of 0x80 in every byte.
+ Consider what happens in each byte:
+ - If a byte of longword1 is zero, step 1 and 2 transform it into 0xff,
+ and step 3 transforms it into 0x80. A carry can also be propagated
+ to more significant bytes.
+ - If a byte of longword1 is nonzero, let its lowest 1 bit be at
+ position k (0 <= k <= 7); so the lowest k bits are 0. After step 1,
+ the byte ends in a single bit of value 0 and k bits of value 1.
+ After step 2, the result is just k bits of value 1: 2^k - 1. After
+ step 3, the result is 0. And no carry is produced.
+ So, if longword1 has only non-zero bytes, tmp is zero.
+ Whereas if longword1 has a zero byte, call j the position of the least
+ significant zero byte. Then the result has a zero at positions 0, ...,
+ j-1 and a 0x80 at position j. We cannot predict the result at the more
+ significant bytes (positions j+1..3), but it does not matter since we
+ already have a non-zero bit at position 8*j+7.
+
+ The test whether any byte in longword1 is zero is equivalent
+ to testing whether tmp is nonzero.
+
+ This test can read beyond the end of a string, depending on where
+ C_IN is encountered. However, this is considered safe since the
+ initialization phase ensured that the read will be aligned,
+ therefore, the read will not cross page boundaries and will not
+ cause a fault. */
+
+ while (1)
+ {
+ longword longword1 = *longword_ptr ^ repeated_c;
+
+ if ((((longword1 - repeated_one) & ~longword1)
+ & (repeated_one << 7)) != 0)
+ break;
+ longword_ptr++;
+ }
+
+ char_ptr = (const unsigned char *) longword_ptr;
+
+ /* At this point, we know that one of the sizeof (longword) bytes
+ starting at char_ptr is == c. On little-endian machines, we
+ could determine the first such byte without any further memory
+ accesses, just by looking at the tmp result from the last loop
+ iteration. But this does not work on big-endian machines.
+ Choose code that works in both cases. */
+
+ char_ptr = (unsigned char *) longword_ptr;
+ while (*char_ptr != c)
+ char_ptr++;
+ return (void *) char_ptr;
+}
diff --git a/lib/rawmemchr.valgrind b/lib/rawmemchr.valgrind
new file mode 100644
index 00000000000..087d5e4178d
--- /dev/null
+++ b/lib/rawmemchr.valgrind
@@ -0,0 +1,28 @@
+# Suppress a valgrind message about use of uninitialized memory in rawmemchr().
+
+# Copyright (C) 2008-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/>.
+
+# This use is OK because it provides only a speedup.
+{
+ rawmemchr-value4
+ Memcheck:Value4
+ fun:rawmemchr
+}
+{
+ rawmemchr-value8
+ Memcheck:Value8
+ fun:rawmemchr
+}
diff --git a/lib/readlink.c b/lib/readlink.c
index 4d392ef6995..c4b635ce712 100644
--- a/lib/readlink.c
+++ b/lib/readlink.c
@@ -1,5 +1,5 @@
-/* Stub for readlink().
- Copyright (C) 2003-2007, 2009-2020 Free Software Foundation, Inc.
+/* Read the contents of a symbolic link.
+ Copyright (C) 2003-2007, 2009-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
@@ -29,7 +29,7 @@
such as DJGPP 2.03 and mingw32. */
ssize_t
-readlink (const char *name, char *buf _GL_UNUSED,
+readlink (char const *file, char *buf _GL_UNUSED,
size_t bufsize _GL_UNUSED)
{
struct stat statbuf;
@@ -37,7 +37,7 @@ readlink (const char *name, char *buf _GL_UNUSED,
/* In general we should use lstat() here, not stat(). But on platforms
without symbolic links, lstat() - if it exists - would be equivalent to
stat(), therefore we can use stat(). This saves us a configure check. */
- if (stat (name, &statbuf) >= 0)
+ if (stat (file, &statbuf) >= 0)
errno = EINVAL;
return -1;
}
@@ -51,24 +51,54 @@ readlink (const char *name, char *buf _GL_UNUSED,
for Solaris 9. */
ssize_t
-rpl_readlink (const char *name, char *buf, size_t bufsize)
+rpl_readlink (char const *file, char *buf, size_t bufsize)
{
# if READLINK_TRAILING_SLASH_BUG
- size_t len = strlen (name);
- if (len && name[len - 1] == '/')
+ size_t file_len = strlen (file);
+ if (file_len && file[file_len - 1] == '/')
{
- /* Even if name without the slash is a symlink to a directory,
+ /* Even if FILE without the slash is a symlink to a directory,
both lstat() and stat() must resolve the trailing slash to
the directory rather than the symlink. We can therefore
safely use stat() to distinguish between EINVAL and
ENOTDIR/ENOENT, avoiding extra overhead of rpl_lstat(). */
struct stat st;
- if (stat (name, &st) == 0)
+ if (stat (file, &st) == 0 || errno == EOVERFLOW)
errno = EINVAL;
return -1;
}
# endif /* READLINK_TRAILING_SLASH_BUG */
- return readlink (name, buf, bufsize);
+
+ ssize_t r = readlink (file, buf, bufsize);
+
+# if READLINK_TRUNCATE_BUG
+ if (r < 0 && errno == ERANGE)
+ {
+ /* Try again with a bigger buffer. This is just for test cases;
+ real code invariably discards short reads. */
+ char stackbuf[4032];
+ r = readlink (file, stackbuf, sizeof stackbuf);
+ if (r < 0)
+ {
+ if (errno == ERANGE)
+ {
+ /* Clear the buffer, which is good enough for real code.
+ Thankfully, no test cases try short reads of enormous
+ symlinks and what would be the point anyway? */
+ r = bufsize;
+ memset (buf, 0, r);
+ }
+ }
+ else
+ {
+ if (bufsize < r)
+ r = bufsize;
+ memcpy (buf, stackbuf, r);
+ }
+ }
+# endif
+
+ return r;
}
#endif /* HAVE_READLINK */
diff --git a/lib/readlinkat.c b/lib/readlinkat.c
index 68ec65ebfc5..4a29f7a8bff 100644
--- a/lib/readlinkat.c
+++ b/lib/readlinkat.c
@@ -1,5 +1,5 @@
/* Read a symlink relative to an open directory.
- Copyright (C) 2009-2020 Free Software Foundation, Inc.
+ Copyright (C) 2009-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
@@ -28,10 +28,11 @@
#if HAVE_READLINKAT
+# undef fstatat
# undef readlinkat
ssize_t
-rpl_readlinkat (int fd, char const *file, char *buf, size_t len)
+rpl_readlinkat (int fd, char const *file, char *buf, size_t bufsize)
{
# if READLINK_TRAILING_SLASH_BUG
size_t file_len = strlen (file);
@@ -40,15 +41,45 @@ rpl_readlinkat (int fd, char const *file, char *buf, size_t len)
/* Even if FILE without the slash is a symlink to a directory,
both lstat() and stat() must resolve the trailing slash to
the directory rather than the symlink. We can therefore
- safely use stat() to distinguish between EINVAL and
- ENOTDIR/ENOENT, avoiding extra overhead of rpl_lstat(). */
+ safely use fstatat(..., 0) to distinguish between EINVAL and
+ ENOTDIR/ENOENT, avoiding extra overhead of rpl_fstatat(). */
struct stat st;
- if (stat (file, &st) == 0)
+ if (fstatat (fd, file, &st, 0) == 0 || errno == EOVERFLOW)
errno = EINVAL;
return -1;
}
# endif /* READLINK_TRAILING_SLASH_BUG */
- return readlinkat (fd, file, buf, len);
+
+ ssize_t r = readlinkat (fd, file, buf, bufsize);
+
+# if READLINK_TRUNCATE_BUG
+ if (r < 0 && errno == ERANGE)
+ {
+ /* Try again with a bigger buffer. This is just for test cases;
+ real code invariably discards short reads. */
+ char stackbuf[4032];
+ r = readlinkat (fd, file, stackbuf, sizeof stackbuf);
+ if (r < 0)
+ {
+ if (errno == ERANGE)
+ {
+ /* Clear the buffer, which is good enough for real code.
+ Thankfully, no test cases try short reads of enormous
+ symlinks and what would be the point anyway? */
+ r = bufsize;
+ memset (buf, 0, r);
+ }
+ }
+ else
+ {
+ if (bufsize < r)
+ r = bufsize;
+ memcpy (buf, stackbuf, r);
+ }
+ }
+# endif
+
+ return r;
}
#else
@@ -61,7 +92,7 @@ rpl_readlinkat (int fd, char const *file, char *buf, size_t len)
readlinkat worthless since readlink does not guarantee a
NUL-terminated buffer. Assume this was a bug in POSIX. */
-/* Read the contents of symlink FILE into buffer BUF of size LEN, in the
+/* Read the contents of symlink FILE into buffer BUF of size BUFSIZE, in the
directory open on descriptor FD. If possible, do it without changing
the working directory. Otherwise, resort to using save_cwd/fchdir,
then readlink/restore_cwd. If either the save_cwd or the restore_cwd
@@ -69,8 +100,8 @@ rpl_readlinkat (int fd, char const *file, char *buf, size_t len)
# define AT_FUNC_NAME readlinkat
# define AT_FUNC_F1 readlink
-# define AT_FUNC_POST_FILE_PARAM_DECLS , char *buf, size_t len
-# define AT_FUNC_POST_FILE_ARGS , buf, len
+# define AT_FUNC_POST_FILE_PARAM_DECLS , char *buf, size_t bufsize
+# define AT_FUNC_POST_FILE_ARGS , buf, bufsize
# define AT_FUNC_RESULT ssize_t
# include "at-func.c"
# undef AT_FUNC_NAME
diff --git a/lib/regcomp.c b/lib/regcomp.c
index a4b95b0b2ff..0c31b0e14cb 100644
--- a/lib/regcomp.c
+++ b/lib/regcomp.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.h b/lib/regex.h
index 306521a3e8a..d291e38793e 100644
--- a/lib/regex.h
+++ b/lib/regex.h
@@ -1,6 +1,6 @@
/* Definitions for data structures and routines for the regular
expression library.
- Copyright (C) 1985, 1989-2020 Free Software Foundation, Inc.
+ Copyright (C) 1985, 1989-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/regex_internal.c b/lib/regex_internal.c
index 2e217291468..73087c8610e 100644
--- a/lib/regex_internal.c
+++ b/lib/regex_internal.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>.
@@ -300,18 +300,20 @@ build_wcs_upper_buffer (re_string_t *pstr)
while (byte_idx < end_idx)
{
wchar_t wc;
+ unsigned char ch = pstr->raw_mbs[pstr->raw_mbs_idx + byte_idx];
- if (isascii (pstr->raw_mbs[pstr->raw_mbs_idx + byte_idx])
- && mbsinit (&pstr->cur_state))
+ if (isascii (ch) && mbsinit (&pstr->cur_state))
{
- /* In case of a singlebyte character. */
- pstr->mbs[byte_idx]
- = toupper (pstr->raw_mbs[pstr->raw_mbs_idx + byte_idx]);
/* The next step uses the assumption that wchar_t is encoded
ASCII-safe: all ASCII values can be converted like this. */
- pstr->wcs[byte_idx] = (wchar_t) pstr->mbs[byte_idx];
- ++byte_idx;
- continue;
+ wchar_t wcu = __towupper (ch);
+ if (isascii (wcu))
+ {
+ pstr->mbs[byte_idx] = wcu;
+ pstr->wcs[byte_idx] = wcu;
+ byte_idx++;
+ continue;
+ }
}
remain_len = end_idx - byte_idx;
@@ -348,7 +350,6 @@ build_wcs_upper_buffer (re_string_t *pstr)
{
/* It is an invalid character, an incomplete character
at the end of the string, or '\0'. Just use the byte. */
- int ch = pstr->raw_mbs[pstr->raw_mbs_idx + byte_idx];
pstr->mbs[byte_idx] = ch;
/* And also cast it to wide char. */
pstr->wcs[byte_idx++] = (wchar_t) ch;
diff --git a/lib/regex_internal.h b/lib/regex_internal.h
index 0c72e3f7b01..be2fa4fe78e 100644
--- a/lib/regex_internal.h
+++ b/lib/regex_internal.h
@@ -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>.
@@ -77,6 +77,14 @@
# define isblank(ch) ((ch) == ' ' || (ch) == '\t')
#endif
+/* regex code assumes isascii has its usual numeric meaning,
+ even if the portable character set uses EBCDIC encoding,
+ and even if wint_t is wider than int. */
+#ifndef _LIBC
+# undef isascii
+# define isascii(c) (((c) & ~0x7f) == 0)
+#endif
+
#ifdef _LIBC
# ifndef _RE_DEFINE_LOCALE_FUNCTIONS
# define _RE_DEFINE_LOCALE_FUNCTIONS 1
diff --git a/lib/root-uid.h b/lib/root-uid.h
index f0f77c23f15..cb74a49c1bb 100644
--- a/lib/root-uid.h
+++ b/lib/root-uid.h
@@ -1,6 +1,6 @@
/* The user ID that always has appropriate privileges in the POSIX sense.
- Copyright 2012-2020 Free Software Foundation, Inc.
+ Copyright 2012-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
diff --git a/lib/save-cwd.c b/lib/save-cwd.c
index fc37d4a3087..9b625c739d1 100644
--- a/lib/save-cwd.c
+++ b/lib/save-cwd.c
@@ -1,6 +1,6 @@
/* save-cwd.c -- Save and restore current working directory.
- Copyright (C) 1995, 1997-1998, 2003-2006, 2009-2020 Free Software
+ Copyright (C) 1995, 1997-1998, 2003-2006, 2009-2021 Free Software
Foundation, Inc.
This program is free software: you can redistribute it and/or modify
diff --git a/lib/save-cwd.h b/lib/save-cwd.h
index ec6f74cb8fc..e1e69eceaf5 100644
--- a/lib/save-cwd.h
+++ b/lib/save-cwd.h
@@ -1,6 +1,6 @@
/* Save and restore current working directory.
- Copyright (C) 1995, 1997-1998, 2003, 2009-2020 Free Software
+ Copyright (C) 1995, 1997-1998, 2003, 2009-2021 Free Software
Foundation, Inc.
This program is free software: you can redistribute it and/or modify
diff --git a/lib/scratch_buffer.h b/lib/scratch_buffer.h
new file mode 100644
index 00000000000..3e2b5ef27db
--- /dev/null
+++ b/lib/scratch_buffer.h
@@ -0,0 +1,29 @@
+/* Variable-sized buffer with on-stack default allocation.
+ Copyright (C) 2017-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, 2017. */
+
+#ifndef _GL_SCRATCH_BUFFER_H
+#define _GL_SCRATCH_BUFFER_H
+
+#include <libc-config.h>
+
+#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
+#include <malloc/scratch_buffer.h>
+
+#endif /* _GL_SCRATCH_BUFFER_H */
diff --git a/lib/set-permissions.c b/lib/set-permissions.c
index b22ccfdd8fb..607983cb93d 100644
--- a/lib/set-permissions.c
+++ b/lib/set-permissions.c
@@ -1,6 +1,6 @@
/* Set permissions of a file. -*- coding: utf-8 -*-
- Copyright (C) 2002-2003, 2005-2020 Free Software Foundation, Inc.
+ Copyright (C) 2002-2003, 2005-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
diff --git a/lib/sha1.c b/lib/sha1.c
index bacf29c4051..612d46de827 100644
--- a/lib/sha1.c
+++ b/lib/sha1.c
@@ -1,7 +1,7 @@
/* sha1.c - Functions to compute SHA1 message digest of files or
memory blocks according to the NIST specification FIPS-180-1.
- Copyright (C) 2000-2001, 2003-2006, 2008-2020 Free Software Foundation, Inc.
+ Copyright (C) 2000-2001, 2003-2006, 2008-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
diff --git a/lib/sha1.h b/lib/sha1.h
index b76788487c3..94ccd18fda5 100644
--- a/lib/sha1.h
+++ b/lib/sha1.h
@@ -1,6 +1,6 @@
/* Declarations of functions and data types used for SHA1 sum
library functions.
- Copyright (C) 2000-2001, 2003, 2005-2006, 2008-2020 Free Software
+ Copyright (C) 2000-2001, 2003, 2005-2006, 2008-2021 Free Software
Foundation, Inc.
This program is free software; you can redistribute it and/or modify it
diff --git a/lib/sha256.c b/lib/sha256.c
index c80dea27f57..129d64b174b 100644
--- a/lib/sha256.c
+++ b/lib/sha256.c
@@ -1,7 +1,7 @@
/* sha256.c - Functions to compute SHA256 and SHA224 message digest of files or
memory blocks according to the NIST specification FIPS-180-2.
- Copyright (C) 2005-2006, 2008-2020 Free Software Foundation, Inc.
+ Copyright (C) 2005-2006, 2008-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
diff --git a/lib/sha256.h b/lib/sha256.h
index 750d78a2696..b4bc082267a 100644
--- a/lib/sha256.h
+++ b/lib/sha256.h
@@ -1,6 +1,6 @@
/* Declarations of functions and data types used for SHA256 and SHA224 sum
library functions.
- Copyright (C) 2005-2006, 2008-2020 Free Software Foundation, Inc.
+ Copyright (C) 2005-2006, 2008-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
diff --git a/lib/sha512.c b/lib/sha512.c
index 518e336b5ec..4ac3fa3e42d 100644
--- a/lib/sha512.c
+++ b/lib/sha512.c
@@ -1,7 +1,7 @@
/* sha512.c - Functions to compute SHA512 and SHA384 message digest of files or
memory blocks according to the NIST specification FIPS-180-2.
- Copyright (C) 2005-2006, 2008-2020 Free Software Foundation, Inc.
+ Copyright (C) 2005-2006, 2008-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
diff --git a/lib/sha512.h b/lib/sha512.h
index 21c2f580147..81b53034c7e 100644
--- a/lib/sha512.h
+++ b/lib/sha512.h
@@ -1,6 +1,6 @@
/* Declarations of functions and data types used for SHA512 and SHA384 sum
library functions.
- Copyright (C) 2005-2006, 2008-2020 Free Software Foundation, Inc.
+ Copyright (C) 2005-2006, 2008-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
diff --git a/lib/sig2str.c b/lib/sig2str.c
index cf7c3bb5c38..c2cc35d830c 100644
--- a/lib/sig2str.c
+++ b/lib/sig2str.c
@@ -1,6 +1,6 @@
/* sig2str.c -- convert between signal names and numbers
- Copyright (C) 2002, 2004, 2006, 2009-2020 Free Software Foundation, Inc.
+ Copyright (C) 2002, 2004, 2006, 2009-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
diff --git a/lib/sig2str.h b/lib/sig2str.h
index a0b45da7c31..f736aa1b0dd 100644
--- a/lib/sig2str.h
+++ b/lib/sig2str.h
@@ -1,6 +1,6 @@
/* sig2str.h -- convert between signal names and numbers
- Copyright (C) 2002, 2005, 2009-2020 Free Software Foundation, Inc.
+ Copyright (C) 2002, 2005, 2009-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
diff --git a/lib/sigdescr_np.c b/lib/sigdescr_np.c
index fc9cd3c2369..6c9bf283a8d 100644
--- a/lib/sigdescr_np.c
+++ b/lib/sigdescr_np.c
@@ -1,5 +1,5 @@
/* English descriptions of signals.
- Copyright (C) 2020 Free Software Foundation, Inc.
+ Copyright (C) 2020-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
diff --git a/lib/signal.in.h b/lib/signal.in.h
index c94b053d6af..ed01d672c9d 100644
--- a/lib/signal.in.h
+++ b/lib/signal.in.h
@@ -1,6 +1,6 @@
/* A GNU-like <signal.h>.
- Copyright (C) 2006-2020 Free Software Foundation, Inc.
+ Copyright (C) 2006-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
@@ -55,13 +55,13 @@
#ifndef _@GUARD_PREFIX@_SIGNAL_H
#define _@GUARD_PREFIX@_SIGNAL_H
-/* Mac OS X 10.3, FreeBSD 6.4, OpenBSD 3.8, OSF/1 4.0, Solaris 2.6, Android
- declare pthread_sigmask in <pthread.h>, not in <signal.h>.
+/* Mac OS X 10.3, FreeBSD 6.4, OpenBSD 3.8, OSF/1 4.0, Solaris 2.6, Android,
+ OS/2 kLIBC declare pthread_sigmask in <pthread.h>, not in <signal.h>.
But avoid namespace pollution on glibc systems.*/
#if (@GNULIB_PTHREAD_SIGMASK@ || defined GNULIB_POSIXCHECK) \
&& ((defined __APPLE__ && defined __MACH__) \
|| defined __FreeBSD__ || defined __OpenBSD__ || defined __osf__ \
- || defined __sun || defined __ANDROID__) \
+ || defined __sun || defined __ANDROID__ || defined __KLIBC__) \
&& ! defined __GLIBC__
# include <pthread.h>
#endif
diff --git a/lib/stat-time.h b/lib/stat-time.h
index 884ffd829a2..523ed21b080 100644
--- a/lib/stat-time.h
+++ b/lib/stat-time.h
@@ -1,6 +1,6 @@
/* stat-related time functions.
- Copyright (C) 2005, 2007, 2009-2020 Free Software Foundation, Inc.
+ Copyright (C) 2005, 2007, 2009-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
diff --git a/lib/stdalign.in.h b/lib/stdalign.in.h
index b5b63e53f12..eae9d132215 100644
--- a/lib/stdalign.in.h
+++ b/lib/stdalign.in.h
@@ -1,6 +1,6 @@
/* A substitute for ISO C11 <stdalign.h>.
- Copyright 2011-2020 Free Software Foundation, Inc.
+ Copyright 2011-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
diff --git a/lib/stddef.in.h b/lib/stddef.in.h
index 87b46d53204..ba7195a9102 100644
--- a/lib/stddef.in.h
+++ b/lib/stddef.in.h
@@ -1,6 +1,6 @@
/* A substitute for POSIX 2008 <stddef.h>, for platforms that have issues.
- Copyright (C) 2009-2020 Free Software Foundation, Inc.
+ Copyright (C) 2009-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
diff --git a/lib/stdint.in.h b/lib/stdint.in.h
index 63fa1aa628f..7a8f27cef7e 100644
--- a/lib/stdint.in.h
+++ b/lib/stdint.in.h
@@ -1,4 +1,4 @@
-/* Copyright (C) 2001-2002, 2004-2020 Free Software Foundation, Inc.
+/* Copyright (C) 2001-2002, 2004-2021 Free Software Foundation, Inc.
Written by Paul Eggert, Bruno Haible, Sam Steingold, Peter Burwood.
This file is part of gnulib.
@@ -579,11 +579,6 @@ typedef int _verify_intmax_size[sizeof (intmax_t) == sizeof (uintmax_t)
<wchar.h> -> <stdio.h> -> <getopt.h> -> <stdlib.h>, and the latter includes
<stdint.h> and assumes its types are already defined. */
# if @HAVE_WCHAR_H@ && ! (defined WCHAR_MIN && defined WCHAR_MAX)
- /* BSD/OS 4.0.1 has a bug: <stddef.h>, <stdio.h> and <time.h> must be
- included before <wchar.h>. */
-# include <stddef.h>
-# include <stdio.h>
-# include <time.h>
# define _GL_JUST_INCLUDE_SYSTEM_WCHAR_H
# include <wchar.h>
# undef _GL_JUST_INCLUDE_SYSTEM_WCHAR_H
diff --git a/lib/stdio-impl.h b/lib/stdio-impl.h
index 067b95ebd64..2a5db74f283 100644
--- a/lib/stdio-impl.h
+++ b/lib/stdio-impl.h
@@ -1,5 +1,5 @@
/* Implementation details of FILE streams.
- Copyright (C) 2007-2008, 2010-2020 Free Software Foundation, Inc.
+ Copyright (C) 2007-2008, 2010-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
@@ -175,7 +175,7 @@
# define fp_ fp
# endif
-# if defined _SCO_DS /* OpenServer */
+# if defined _SCO_DS || (defined __SCO_VERSION__ || defined __sysv5__) /* OpenServer 5, OpenServer 6, UnixWare 7 */
# define _cnt __cnt
# define _ptr __ptr
# define _base __base
diff --git a/lib/stdio.in.h b/lib/stdio.in.h
index 6d12cd826de..a9308405052 100644
--- a/lib/stdio.in.h
+++ b/lib/stdio.in.h
@@ -1,6 +1,6 @@
/* A GNU-like <stdio.h>.
- Copyright (C) 2004, 2007-2020 Free Software Foundation, Inc.
+ Copyright (C) 2004, 2007-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
@@ -70,30 +70,44 @@
# endif
#endif
-/* _GL_ATTRIBUTE_FORMAT_PRINTF
- indicates to GCC that the function takes a format string and arguments,
- where the format string directives are the ones standardized by ISO C99
- and POSIX. */
+/* An __attribute__ __format__ specifier for a function that takes a format
+ string and arguments, where the format string directives are the ones
+ standardized by ISO C99 and POSIX.
+ _GL_ATTRIBUTE_SPEC_PRINTF_STANDARD */
+/* __gnu_printf__ is supported in GCC >= 4.4. */
#if __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 4)
-# define _GL_ATTRIBUTE_FORMAT_PRINTF(formatstring_parameter, first_argument) \
- _GL_ATTRIBUTE_FORMAT ((__gnu_printf__, formatstring_parameter, first_argument))
+# define _GL_ATTRIBUTE_SPEC_PRINTF_STANDARD __gnu_printf__
#else
-# define _GL_ATTRIBUTE_FORMAT_PRINTF(formatstring_parameter, first_argument) \
- _GL_ATTRIBUTE_FORMAT ((__printf__, formatstring_parameter, first_argument))
+# define _GL_ATTRIBUTE_SPEC_PRINTF_STANDARD __printf__
#endif
-/* _GL_ATTRIBUTE_FORMAT_PRINTF_SYSTEM is like _GL_ATTRIBUTE_FORMAT_PRINTF,
- except that it indicates to GCC that the supported format string directives
- are the ones of the system printf(), rather than the ones standardized by
- ISO C99 and POSIX. */
+/* An __attribute__ __format__ specifier for a function that takes a format
+ string and arguments, where the format string directives are the ones of the
+ system printf(), rather than the ones standardized by ISO C99 and POSIX.
+ _GL_ATTRIBUTE_SPEC_PRINTF_SYSTEM */
+/* On mingw, Gnulib sets __USE_MINGW_ANSI_STDIO in order to get closer to
+ the standards. The macro GNULIB_PRINTF_ATTRIBUTE_FLAVOR_GNU indicates
+ whether this change is effective. On older mingw, it is not. */
#if GNULIB_PRINTF_ATTRIBUTE_FLAVOR_GNU
-# define _GL_ATTRIBUTE_FORMAT_PRINTF_SYSTEM(formatstring_parameter, first_argument) \
- _GL_ATTRIBUTE_FORMAT_PRINTF (formatstring_parameter, first_argument)
+# define _GL_ATTRIBUTE_SPEC_PRINTF_SYSTEM _GL_ATTRIBUTE_SPEC_PRINTF_STANDARD
#else
-# define _GL_ATTRIBUTE_FORMAT_PRINTF_SYSTEM(formatstring_parameter, first_argument) \
- _GL_ATTRIBUTE_FORMAT ((__printf__, formatstring_parameter, first_argument))
+# define _GL_ATTRIBUTE_SPEC_PRINTF_SYSTEM __printf__
#endif
+/* _GL_ATTRIBUTE_FORMAT_PRINTF_STANDARD
+ indicates to GCC that the function takes a format string and arguments,
+ where the format string directives are the ones standardized by ISO C99
+ and POSIX. */
+#define _GL_ATTRIBUTE_FORMAT_PRINTF_STANDARD(formatstring_parameter, first_argument) \
+ _GL_ATTRIBUTE_FORMAT ((_GL_ATTRIBUTE_SPEC_PRINTF_STANDARD, formatstring_parameter, first_argument))
+
+/* _GL_ATTRIBUTE_FORMAT_PRINTF_SYSTEM is like _GL_ATTRIBUTE_FORMAT_PRINTF_STANDARD,
+ except that it indicates to GCC that the supported format string directives
+ are the ones of the system printf(), rather than the ones standardized by
+ ISO C99 and POSIX. */
+#define _GL_ATTRIBUTE_FORMAT_PRINTF_SYSTEM(formatstring_parameter, first_argument) \
+ _GL_ATTRIBUTE_FORMAT ((_GL_ATTRIBUTE_SPEC_PRINTF_SYSTEM, formatstring_parameter, first_argument))
+
/* _GL_ATTRIBUTE_FORMAT_SCANF
indicates to GCC that the function takes a format string and arguments,
where the format string directives are the ones standardized by ISO C99
@@ -174,13 +188,13 @@
# define dprintf rpl_dprintf
# endif
_GL_FUNCDECL_RPL (dprintf, int, (int fd, const char *restrict format, ...)
- _GL_ATTRIBUTE_FORMAT_PRINTF (2, 3)
+ _GL_ATTRIBUTE_FORMAT_PRINTF_STANDARD (2, 3)
_GL_ARG_NONNULL ((2)));
_GL_CXXALIAS_RPL (dprintf, int, (int fd, const char *restrict format, ...));
# else
# if !@HAVE_DPRINTF@
_GL_FUNCDECL_SYS (dprintf, int, (int fd, const char *restrict format, ...)
- _GL_ATTRIBUTE_FORMAT_PRINTF (2, 3)
+ _GL_ATTRIBUTE_FORMAT_PRINTF_STANDARD (2, 3)
_GL_ARG_NONNULL ((2)));
# endif
_GL_CXXALIAS_SYS (dprintf, int, (int fd, const char *restrict format, ...));
@@ -215,9 +229,29 @@ _GL_WARN_ON_USE (fclose, "fclose is not always POSIX compliant - "
"use gnulib module fclose for portable POSIX compliance");
#endif
-#if defined _WIN32 && !defined __CYGWIN__
-# undef fcloseall
-# define fcloseall _fcloseall
+#if @GNULIB_MDA_FCLOSEALL@
+/* On native Windows, map 'fcloseall' to '_fcloseall', so that -loldnames is
+ not required. In C++ with GNULIB_NAMESPACE, avoid differences between
+ platforms by defining GNULIB_NAMESPACE::fcloseall on all platforms that have
+ it. */
+# if defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef fcloseall
+# define fcloseall _fcloseall
+# endif
+_GL_CXXALIAS_MDA (fcloseall, int, (void));
+# else
+# if @HAVE_DECL_FCLOSEALL@
+# if defined __FreeBSD__
+_GL_CXXALIAS_SYS (fcloseall, void, (void));
+# else
+_GL_CXXALIAS_SYS (fcloseall, int, (void));
+# endif
+# endif
+# endif
+# if (defined _WIN32 && !defined __CYGWIN__) || @HAVE_DECL_FCLOSEALL@
+_GL_CXXALIASWARN (fcloseall);
+# endif
#endif
#if @GNULIB_FDOPEN@
@@ -244,9 +278,20 @@ _GL_CXXALIASWARN (fdopen);
/* Assume fdopen is always declared. */
_GL_WARN_ON_USE (fdopen, "fdopen on native Windows platforms is not POSIX compliant - "
"use gnulib module fdopen for portability");
-#elif defined _WIN32 && !defined __CYGWIN__
-# undef fdopen
-# define fdopen _fdopen
+#elif @GNULIB_MDA_FDOPEN@
+/* On native Windows, map 'fdopen' to '_fdopen', so that -loldnames is not
+ required. In C++ with GNULIB_NAMESPACE, avoid differences between
+ platforms by defining GNULIB_NAMESPACE::fdopen always. */
+# if defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef fdopen
+# define fdopen _fdopen
+# endif
+_GL_CXXALIAS_MDA (fdopen, FILE *, (int fd, const char *mode));
+# else
+_GL_CXXALIAS_SYS (fdopen, FILE *, (int fd, const char *mode));
+# endif
+_GL_CXXALIASWARN (fdopen);
#endif
#if @GNULIB_FFLUSH@
@@ -311,9 +356,20 @@ _GL_CXXALIASWARN (fgets);
# endif
#endif
-#if defined _WIN32 && !defined __CYGWIN__
-# undef fileno
-# define fileno _fileno
+#if @GNULIB_MDA_FILENO@
+/* On native Windows, map 'fileno' to '_fileno', so that -loldnames is not
+ required. In C++ with GNULIB_NAMESPACE, avoid differences between
+ platforms by defining GNULIB_NAMESPACE::fileno always. */
+# if defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef fileno
+# define fileno _fileno
+# endif
+_GL_CXXALIAS_MDA (fileno, int, (FILE *restrict stream));
+# else
+_GL_CXXALIAS_SYS (fileno, int, (FILE *restrict stream));
+# endif
+_GL_CXXALIASWARN (fileno);
#endif
#if @GNULIB_FOPEN@
@@ -351,7 +407,7 @@ _GL_WARN_ON_USE (fopen, "fopen on native Windows platforms is not POSIX complian
# if @GNULIB_FPRINTF_POSIX@ || @GNULIB_VFPRINTF_POSIX@
_GL_FUNCDECL_RPL (fprintf, int,
(FILE *restrict fp, const char *restrict format, ...)
- _GL_ATTRIBUTE_FORMAT_PRINTF (2, 3)
+ _GL_ATTRIBUTE_FORMAT_PRINTF_STANDARD (2, 3)
_GL_ARG_NONNULL ((1, 2)));
# else
_GL_FUNCDECL_RPL (fprintf, int,
@@ -843,9 +899,20 @@ _GL_WARN_ON_USE (getline, "getline is unportable - "
_GL_WARN_ON_USE (gets, "gets is a security hole - use fgets instead");
#endif
-#if defined _WIN32 && !defined __CYGWIN__
-# undef getw
-# define getw _getw
+#if @GNULIB_MDA_GETW@
+/* On native Windows, map 'getw' to '_getw', so that -loldnames is not
+ required. In C++ with GNULIB_NAMESPACE, avoid differences between
+ platforms by defining GNULIB_NAMESPACE::getw always. */
+# if defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef getw
+# define getw _getw
+# endif
+_GL_CXXALIAS_MDA (getw, int, (FILE *restrict stream));
+# else
+_GL_CXXALIAS_SYS (getw, int, (FILE *restrict stream));
+# endif
+_GL_CXXALIASWARN (getw);
#endif
#if @GNULIB_OBSTACK_PRINTF@ || @GNULIB_OBSTACK_PRINTF_POSIX@
@@ -861,7 +928,7 @@ struct obstack;
# endif
_GL_FUNCDECL_RPL (obstack_printf, int,
(struct obstack *obs, const char *format, ...)
- _GL_ATTRIBUTE_FORMAT_PRINTF (2, 3)
+ _GL_ATTRIBUTE_FORMAT_PRINTF_STANDARD (2, 3)
_GL_ARG_NONNULL ((1, 2)));
_GL_CXXALIAS_RPL (obstack_printf, int,
(struct obstack *obs, const char *format, ...));
@@ -869,7 +936,7 @@ _GL_CXXALIAS_RPL (obstack_printf, int,
# if !@HAVE_DECL_OBSTACK_PRINTF@
_GL_FUNCDECL_SYS (obstack_printf, int,
(struct obstack *obs, const char *format, ...)
- _GL_ATTRIBUTE_FORMAT_PRINTF (2, 3)
+ _GL_ATTRIBUTE_FORMAT_PRINTF_STANDARD (2, 3)
_GL_ARG_NONNULL ((1, 2)));
# endif
_GL_CXXALIAS_SYS (obstack_printf, int,
@@ -882,7 +949,7 @@ _GL_CXXALIASWARN (obstack_printf);
# endif
_GL_FUNCDECL_RPL (obstack_vprintf, int,
(struct obstack *obs, const char *format, va_list args)
- _GL_ATTRIBUTE_FORMAT_PRINTF (2, 0)
+ _GL_ATTRIBUTE_FORMAT_PRINTF_STANDARD (2, 0)
_GL_ARG_NONNULL ((1, 2)));
_GL_CXXALIAS_RPL (obstack_vprintf, int,
(struct obstack *obs, const char *format, va_list args));
@@ -890,7 +957,7 @@ _GL_CXXALIAS_RPL (obstack_vprintf, int,
# if !@HAVE_DECL_OBSTACK_PRINTF@
_GL_FUNCDECL_SYS (obstack_vprintf, int,
(struct obstack *obs, const char *format, va_list args)
- _GL_ATTRIBUTE_FORMAT_PRINTF (2, 0)
+ _GL_ATTRIBUTE_FORMAT_PRINTF_STANDARD (2, 0)
_GL_ARG_NONNULL ((1, 2)));
# endif
_GL_CXXALIAS_SYS (obstack_vprintf, int,
@@ -974,7 +1041,7 @@ _GL_FUNCDECL_RPL_1 (__printf__, int,
(const char *restrict format, ...)
__asm__ (@ASM_SYMBOL_PREFIX@
_GL_STDIO_MACROEXPAND_AND_STRINGIZE(rpl_printf))
- _GL_ATTRIBUTE_FORMAT_PRINTF (1, 2)
+ _GL_ATTRIBUTE_FORMAT_PRINTF_STANDARD (1, 2)
_GL_ARG_NONNULL ((1)));
# else
_GL_FUNCDECL_RPL_1 (__printf__, int,
@@ -991,7 +1058,7 @@ _GL_CXXALIAS_RPL_1 (printf, __printf__, int, (const char *format, ...));
# endif
_GL_FUNCDECL_RPL (printf, int,
(const char *restrict format, ...)
- _GL_ATTRIBUTE_FORMAT_PRINTF (1, 2)
+ _GL_ATTRIBUTE_FORMAT_PRINTF_STANDARD (1, 2)
_GL_ARG_NONNULL ((1)));
_GL_CXXALIAS_RPL (printf, int, (const char *restrict format, ...));
# endif
@@ -1061,9 +1128,20 @@ _GL_CXXALIASWARN (puts);
# endif
#endif
-#if defined _WIN32 && !defined __CYGWIN__
-# undef putw
-# define putw _putw
+#if @GNULIB_MDA_PUTW@
+/* On native Windows, map 'putw' to '_putw', so that -loldnames is not
+ required. In C++ with GNULIB_NAMESPACE, avoid differences between
+ platforms by defining GNULIB_NAMESPACE::putw always. */
+# if defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef putw
+# define putw _putw
+# endif
+_GL_CXXALIAS_MDA (putw, int, (int w, FILE *restrict stream));
+# else
+_GL_CXXALIAS_SYS (putw, int, (int w, FILE *restrict stream));
+# endif
+_GL_CXXALIASWARN (putw);
#endif
#if @GNULIB_REMOVE@
@@ -1182,7 +1260,7 @@ _GL_CXXALIASWARN (scanf);
_GL_FUNCDECL_RPL (snprintf, int,
(char *restrict str, size_t size,
const char *restrict format, ...)
- _GL_ATTRIBUTE_FORMAT_PRINTF (3, 4)
+ _GL_ATTRIBUTE_FORMAT_PRINTF_STANDARD (3, 4)
_GL_ARG_NONNULL ((3)));
_GL_CXXALIAS_RPL (snprintf, int,
(char *restrict str, size_t size,
@@ -1192,7 +1270,7 @@ _GL_CXXALIAS_RPL (snprintf, int,
_GL_FUNCDECL_SYS (snprintf, int,
(char *restrict str, size_t size,
const char *restrict format, ...)
- _GL_ATTRIBUTE_FORMAT_PRINTF (3, 4)
+ _GL_ATTRIBUTE_FORMAT_PRINTF_STANDARD (3, 4)
_GL_ARG_NONNULL ((3)));
# endif
_GL_CXXALIAS_SYS (snprintf, int,
@@ -1226,7 +1304,7 @@ _GL_WARN_ON_USE (snprintf, "snprintf is unportable - "
# endif
_GL_FUNCDECL_RPL (sprintf, int,
(char *restrict str, const char *restrict format, ...)
- _GL_ATTRIBUTE_FORMAT_PRINTF (2, 3)
+ _GL_ATTRIBUTE_FORMAT_PRINTF_STANDARD (2, 3)
_GL_ARG_NONNULL ((1, 2)));
_GL_CXXALIAS_RPL (sprintf, int,
(char *restrict str, const char *restrict format, ...));
@@ -1245,9 +1323,20 @@ _GL_WARN_ON_USE (sprintf, "sprintf is not always POSIX compliant - "
"POSIX compliance");
#endif
-#if defined _WIN32 && !defined __CYGWIN__
-# undef tempnam
-# define tempnam _tempnam
+#if @GNULIB_MDA_TEMPNAM@
+/* On native Windows, map 'tempnam' to '_tempnam', so that -loldnames is not
+ required. In C++ with GNULIB_NAMESPACE, avoid differences between
+ platforms by defining GNULIB_NAMESPACE::tempnam always. */
+# if defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef tempnam
+# define tempnam _tempnam
+# endif
+_GL_CXXALIAS_MDA (tempnam, char *, (const char *dir, const char *prefix));
+# else
+_GL_CXXALIAS_SYS (tempnam, char *, (const char *dir, const char *prefix));
+# endif
+_GL_CXXALIASWARN (tempnam);
#endif
#if @GNULIB_TMPFILE@
@@ -1282,7 +1371,7 @@ _GL_WARN_ON_USE (tmpfile, "tmpfile is not usable on mingw - "
# endif
_GL_FUNCDECL_RPL (asprintf, int,
(char **result, const char *format, ...)
- _GL_ATTRIBUTE_FORMAT_PRINTF (2, 3)
+ _GL_ATTRIBUTE_FORMAT_PRINTF_STANDARD (2, 3)
_GL_ARG_NONNULL ((1, 2)));
_GL_CXXALIAS_RPL (asprintf, int,
(char **result, const char *format, ...));
@@ -1290,7 +1379,7 @@ _GL_CXXALIAS_RPL (asprintf, int,
# if !@HAVE_VASPRINTF@
_GL_FUNCDECL_SYS (asprintf, int,
(char **result, const char *format, ...)
- _GL_ATTRIBUTE_FORMAT_PRINTF (2, 3)
+ _GL_ATTRIBUTE_FORMAT_PRINTF_STANDARD (2, 3)
_GL_ARG_NONNULL ((1, 2)));
# endif
_GL_CXXALIAS_SYS (asprintf, int,
@@ -1303,7 +1392,7 @@ _GL_CXXALIASWARN (asprintf);
# endif
_GL_FUNCDECL_RPL (vasprintf, int,
(char **result, const char *format, va_list args)
- _GL_ATTRIBUTE_FORMAT_PRINTF (2, 0)
+ _GL_ATTRIBUTE_FORMAT_PRINTF_STANDARD (2, 0)
_GL_ARG_NONNULL ((1, 2)));
_GL_CXXALIAS_RPL (vasprintf, int,
(char **result, const char *format, va_list args));
@@ -1311,7 +1400,7 @@ _GL_CXXALIAS_RPL (vasprintf, int,
# if !@HAVE_VASPRINTF@
_GL_FUNCDECL_SYS (vasprintf, int,
(char **result, const char *format, va_list args)
- _GL_ATTRIBUTE_FORMAT_PRINTF (2, 0)
+ _GL_ATTRIBUTE_FORMAT_PRINTF_STANDARD (2, 0)
_GL_ARG_NONNULL ((1, 2)));
# endif
_GL_CXXALIAS_SYS (vasprintf, int,
@@ -1327,7 +1416,7 @@ _GL_CXXALIASWARN (vasprintf);
# endif
_GL_FUNCDECL_RPL (vdprintf, int,
(int fd, const char *restrict format, va_list args)
- _GL_ATTRIBUTE_FORMAT_PRINTF (2, 0)
+ _GL_ATTRIBUTE_FORMAT_PRINTF_STANDARD (2, 0)
_GL_ARG_NONNULL ((2)));
_GL_CXXALIAS_RPL (vdprintf, int,
(int fd, const char *restrict format, va_list args));
@@ -1335,7 +1424,7 @@ _GL_CXXALIAS_RPL (vdprintf, int,
# if !@HAVE_VDPRINTF@
_GL_FUNCDECL_SYS (vdprintf, int,
(int fd, const char *restrict format, va_list args)
- _GL_ATTRIBUTE_FORMAT_PRINTF (2, 0)
+ _GL_ATTRIBUTE_FORMAT_PRINTF_STANDARD (2, 0)
_GL_ARG_NONNULL ((2)));
# endif
/* Need to cast, because on Solaris, the third parameter will likely be
@@ -1365,7 +1454,7 @@ _GL_WARN_ON_USE (vdprintf, "vdprintf is unportable - "
_GL_FUNCDECL_RPL (vfprintf, int,
(FILE *restrict fp,
const char *restrict format, va_list args)
- _GL_ATTRIBUTE_FORMAT_PRINTF (2, 0)
+ _GL_ATTRIBUTE_FORMAT_PRINTF_STANDARD (2, 0)
_GL_ARG_NONNULL ((1, 2)));
# else
_GL_FUNCDECL_RPL (vfprintf, int,
@@ -1432,7 +1521,7 @@ _GL_CXXALIASWARN (vfscanf);
# define GNULIB_overrides_vprintf 1
# if @GNULIB_VPRINTF_POSIX@ || @GNULIB_VFPRINTF_POSIX@
_GL_FUNCDECL_RPL (vprintf, int, (const char *restrict format, va_list args)
- _GL_ATTRIBUTE_FORMAT_PRINTF (1, 0)
+ _GL_ATTRIBUTE_FORMAT_PRINTF_STANDARD (1, 0)
_GL_ARG_NONNULL ((1)));
# else
_GL_FUNCDECL_RPL (vprintf, int, (const char *restrict format, va_list args)
@@ -1487,7 +1576,7 @@ _GL_CXXALIASWARN (vscanf);
_GL_FUNCDECL_RPL (vsnprintf, int,
(char *restrict str, size_t size,
const char *restrict format, va_list args)
- _GL_ATTRIBUTE_FORMAT_PRINTF (3, 0)
+ _GL_ATTRIBUTE_FORMAT_PRINTF_STANDARD (3, 0)
_GL_ARG_NONNULL ((3)));
_GL_CXXALIAS_RPL (vsnprintf, int,
(char *restrict str, size_t size,
@@ -1497,7 +1586,7 @@ _GL_CXXALIAS_RPL (vsnprintf, int,
_GL_FUNCDECL_SYS (vsnprintf, int,
(char *restrict str, size_t size,
const char *restrict format, va_list args)
- _GL_ATTRIBUTE_FORMAT_PRINTF (3, 0)
+ _GL_ATTRIBUTE_FORMAT_PRINTF_STANDARD (3, 0)
_GL_ARG_NONNULL ((3)));
# endif
_GL_CXXALIAS_SYS (vsnprintf, int,
@@ -1523,7 +1612,7 @@ _GL_WARN_ON_USE (vsnprintf, "vsnprintf is unportable - "
_GL_FUNCDECL_RPL (vsprintf, int,
(char *restrict str,
const char *restrict format, va_list args)
- _GL_ATTRIBUTE_FORMAT_PRINTF (2, 0)
+ _GL_ATTRIBUTE_FORMAT_PRINTF_STANDARD (2, 0)
_GL_ARG_NONNULL ((1, 2)));
_GL_CXXALIAS_RPL (vsprintf, int,
(char *restrict str,
diff --git a/lib/stdlib.in.h b/lib/stdlib.in.h
index 47a1309e633..49fc44e14a1 100644
--- a/lib/stdlib.in.h
+++ b/lib/stdlib.in.h
@@ -1,6 +1,6 @@
/* A GNU-like <stdlib.h>.
- Copyright (C) 1995, 2001-2004, 2006-2020 Free Software Foundation, Inc.
+ Copyright (C) 1995, 2001-2004, 2006-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
@@ -53,8 +53,8 @@
# include <sys/loadavg.h>
#endif
-/* Native Windows platforms declare mktemp() in <io.h>. */
-#if 0 && (defined _WIN32 && ! defined __CYGWIN__)
+/* Native Windows platforms declare _mktemp() in <io.h>. */
+#if defined _WIN32 && !defined __CYGWIN__
# include <io.h>
#endif
@@ -149,6 +149,31 @@ _GL_WARN_ON_USE (_Exit, "_Exit is unportable - "
#endif
+/* Allocate memory with indefinite extent and specified alignment. */
+#if @GNULIB_ALIGNED_ALLOC@
+# if @REPLACE_ALIGNED_ALLOC@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef aligned_alloc
+# define aligned_alloc rpl_aligned_alloc
+# endif
+_GL_FUNCDECL_RPL (aligned_alloc, void *, (size_t alignment, size_t size));
+_GL_CXXALIAS_RPL (aligned_alloc, void *, (size_t alignment, size_t size));
+# else
+# if @HAVE_ALIGNED_ALLOC@
+_GL_CXXALIAS_SYS (aligned_alloc, void *, (size_t alignment, size_t size));
+# endif
+# endif
+# if @HAVE_ALIGNED_ALLOC@
+_GL_CXXALIASWARN (aligned_alloc);
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef aligned_alloc
+# if HAVE_RAW_DECL_ALIGNED_ALLOC
+_GL_WARN_ON_USE (aligned_alloc, "aligned_alloc is not portable - "
+ "use gnulib module aligned_alloc for portability");
+# endif
+#endif
+
#if @GNULIB_ATOLL@
/* Parse a signed decimal integer.
Returns the value of the integer. Errors are not detected. */
@@ -217,19 +242,92 @@ _GL_WARN_ON_USE (canonicalize_file_name,
# endif
#endif
-#if defined _WIN32 && !defined __CYGWIN__
-# undef ecvt
-# define ecvt _ecvt
+#if @GNULIB_MDA_ECVT@
+/* On native Windows, map 'ecvt' to '_ecvt', so that -loldnames is not
+ required. In C++ with GNULIB_NAMESPACE, avoid differences between
+ platforms by defining GNULIB_NAMESPACE::ecvt on all platforms that have
+ it. */
+# if defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef ecvt
+# define ecvt _ecvt
+# endif
+_GL_CXXALIAS_MDA (ecvt, char *,
+ (double number, int ndigits, int *decptp, int *signp));
+# else
+# if @HAVE_DECL_ECVT@
+_GL_CXXALIAS_SYS (ecvt, char *,
+ (double number, int ndigits, int *decptp, int *signp));
+# endif
+# endif
+# if (defined _WIN32 && !defined __CYGWIN__) || @HAVE_DECL_ECVT@
+_GL_CXXALIASWARN (ecvt);
+# endif
#endif
-#if defined _WIN32 && !defined __CYGWIN__
-# undef fcvt
-# define fcvt _fcvt
+#if @GNULIB_MDA_FCVT@
+/* On native Windows, map 'fcvt' to '_fcvt', so that -loldnames is not
+ required. In C++ with GNULIB_NAMESPACE, avoid differences between
+ platforms by defining GNULIB_NAMESPACE::fcvt on all platforms that have
+ it. */
+# if defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef fcvt
+# define fcvt _fcvt
+# endif
+_GL_CXXALIAS_MDA (fcvt, char *,
+ (double number, int ndigits, int *decptp, int *signp));
+# else
+# if @HAVE_DECL_FCVT@
+_GL_CXXALIAS_SYS (fcvt, char *,
+ (double number, int ndigits, int *decptp, int *signp));
+# endif
+# endif
+# if (defined _WIN32 && !defined __CYGWIN__) || @HAVE_DECL_FCVT@
+_GL_CXXALIASWARN (fcvt);
+# endif
#endif
-#if defined _WIN32 && !defined __CYGWIN__
-# undef gcvt
-# define gcvt _gcvt
+#if @GNULIB_FREE_POSIX@
+# if @REPLACE_FREE@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef free
+# define free rpl_free
+# endif
+_GL_FUNCDECL_RPL (free, void, (void *ptr));
+_GL_CXXALIAS_RPL (free, void, (void *ptr));
+# else
+_GL_CXXALIAS_SYS (free, void, (void *ptr));
+# endif
+# if __GLIBC__ >= 2
+_GL_CXXALIASWARN (free);
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef free
+/* Assume free is always declared. */
+_GL_WARN_ON_USE (free, "free is not future POSIX compliant everywhere - "
+ "use gnulib module free for portability");
+#endif
+
+#if @GNULIB_MDA_GCVT@
+/* On native Windows, map 'gcvt' to '_gcvt', so that -loldnames is not
+ required. In C++ with GNULIB_NAMESPACE, avoid differences between
+ platforms by defining GNULIB_NAMESPACE::gcvt on all platforms that have
+ it. */
+# if defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef gcvt
+# define gcvt _gcvt
+# endif
+_GL_CXXALIAS_MDA (gcvt, char *, (double number, int ndigits, char *buf));
+# else
+# if @HAVE_DECL_GCVT@
+_GL_CXXALIAS_SYS (gcvt, char *, (double number, int ndigits, char *buf));
+# endif
+# endif
+# if (defined _WIN32 && !defined __CYGWIN__) || @HAVE_DECL_GCVT@
+_GL_CXXALIASWARN (gcvt);
+# endif
#endif
#if @GNULIB_GETLOADAVG@
@@ -483,9 +581,49 @@ _GL_WARN_ON_USE (mkstemps, "mkstemps is unportable - "
# endif
#endif
-#if defined _WIN32 && !defined __CYGWIN__
-# undef mktemp
-# define mktemp _mktemp
+#if @GNULIB_MDA_MKTEMP@
+/* On native Windows, map 'mktemp' to '_mktemp', so that -loldnames is not
+ required. In C++ with GNULIB_NAMESPACE, avoid differences between
+ platforms by defining GNULIB_NAMESPACE::mktemp always. */
+# if defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef mktemp
+# define mktemp _mktemp
+# endif
+_GL_CXXALIAS_MDA (mktemp, char *, (char * /*template*/));
+# else
+_GL_CXXALIAS_SYS (mktemp, char *, (char * /*template*/));
+# endif
+_GL_CXXALIASWARN (mktemp);
+#endif
+
+/* Allocate memory with indefinite extent and specified alignment. */
+#if @GNULIB_POSIX_MEMALIGN@
+# if @REPLACE_POSIX_MEMALIGN@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef posix_memalign
+# define posix_memalign rpl_posix_memalign
+# endif
+_GL_FUNCDECL_RPL (posix_memalign, int,
+ (void **memptr, size_t alignment, size_t size)
+ _GL_ARG_NONNULL ((1)));
+_GL_CXXALIAS_RPL (posix_memalign, int,
+ (void **memptr, size_t alignment, size_t size));
+# else
+# if @HAVE_POSIX_MEMALIGN@
+_GL_CXXALIAS_SYS (posix_memalign, int,
+ (void **memptr, size_t alignment, size_t size));
+# endif
+# endif
+# if @HAVE_POSIX_MEMALIGN@
+_GL_CXXALIASWARN (posix_memalign);
+# endif
+#elif defined GNULIB_POSIXCHECK
+# undef posix_memalign
+# if HAVE_RAW_DECL_POSIX_MEMALIGN
+_GL_WARN_ON_USE (posix_memalign, "posix_memalign is not portable - "
+ "use gnulib module posix_memalign for portability");
+# endif
#endif
#if @GNULIB_POSIX_OPENPT@
@@ -576,9 +714,22 @@ _GL_CXXALIAS_MDA (putenv, int, (char *string));
_GL_CXXALIAS_SYS (putenv, int, (char *string));
# endif
_GL_CXXALIASWARN (putenv);
-#elif defined _WIN32 && !defined __CYGWIN__
-# undef putenv
-# define putenv _putenv
+#elif @GNULIB_MDA_PUTENV@
+/* On native Windows, map 'putenv' to '_putenv', so that -loldnames is not
+ required. In C++ with GNULIB_NAMESPACE, avoid differences between
+ platforms by defining GNULIB_NAMESPACE::putenv always. */
+# if defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef putenv
+# define putenv _putenv
+# endif
+/* Need to cast, because on mingw, the parameter is either
+ 'const char *string' or 'char *string'. */
+_GL_CXXALIAS_MDA_CAST (putenv, int, (char *string));
+# else
+_GL_CXXALIAS_SYS (putenv, int, (char *string));
+# endif
+_GL_CXXALIASWARN (putenv);
#endif
#if @GNULIB_QSORT_R@
diff --git a/lib/stpcpy.c b/lib/stpcpy.c
index 58265f0b797..a4165ba4bf9 100644
--- a/lib/stpcpy.c
+++ b/lib/stpcpy.c
@@ -1,5 +1,5 @@
/* stpcpy.c -- copy a string and return pointer to end of new string
- Copyright (C) 1992, 1995, 1997-1998, 2006, 2009-2020 Free Software
+ Copyright (C) 1992, 1995, 1997-1998, 2006, 2009-2021 Free Software
Foundation, Inc.
NOTE: The canonical source of this file is maintained with the GNU C Library.
diff --git a/lib/str-two-way.h b/lib/str-two-way.h
index 6ad0130fad0..005a19fb513 100644
--- a/lib/str-two-way.h
+++ b/lib/str-two-way.h
@@ -1,5 +1,5 @@
/* Byte-wise substring search, using the Two-Way algorithm.
- Copyright (C) 2008-2020 Free Software Foundation, Inc.
+ Copyright (C) 2008-2021 Free Software Foundation, Inc.
This file is part of the GNU C Library.
Written by Eric Blake <ebb9@byu.net>, 2008.
diff --git a/lib/strftime.h b/lib/strftime.h
index fe0c4195a59..7284f67133c 100644
--- a/lib/strftime.h
+++ b/lib/strftime.h
@@ -1,6 +1,6 @@
/* declarations for strftime.c
- Copyright (C) 2002, 2004, 2008-2020 Free Software Foundation, Inc.
+ Copyright (C) 2002, 2004, 2008-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
diff --git a/lib/string.in.h b/lib/string.in.h
index 9724addef43..9f68e77c767 100644
--- a/lib/string.in.h
+++ b/lib/string.in.h
@@ -1,6 +1,6 @@
/* A GNU-like <string.h>.
- Copyright (C) 1995-1996, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1995-1996, 2001-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
@@ -123,9 +123,22 @@ _GL_WARN_ON_USE (ffsll, "ffsll is not portable - use the ffsll module");
#endif
-#if defined _WIN32 && !defined __CYGWIN__
-# undef memccpy
-# define memccpy _memccpy
+#if @GNULIB_MDA_MEMCCPY@
+/* On native Windows, map 'memccpy' to '_memccpy', so that -loldnames is not
+ required. In C++ with GNULIB_NAMESPACE, avoid differences between
+ platforms by defining GNULIB_NAMESPACE::memccpy always. */
+# if defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef memccpy
+# define memccpy _memccpy
+# endif
+_GL_CXXALIAS_MDA (memccpy, void *,
+ (void *dest, const void *src, int c, size_t n));
+# else
+_GL_CXXALIAS_SYS (memccpy, void *,
+ (void *dest, const void *src, int c, size_t n));
+# endif
+_GL_CXXALIASWARN (memccpy);
#endif
@@ -133,6 +146,7 @@ _GL_WARN_ON_USE (ffsll, "ffsll is not portable - use the ffsll module");
#if @GNULIB_MEMCHR@
# if @REPLACE_MEMCHR@
# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef memchr
# define memchr rpl_memchr
# endif
_GL_FUNCDECL_RPL (memchr, void *, (void const *__s, int __c, size_t __n)
@@ -413,9 +427,23 @@ _GL_CXXALIASWARN (strdup);
_GL_WARN_ON_USE (strdup, "strdup is unportable - "
"use gnulib module strdup for portability");
# endif
-#elif defined _WIN32 && !defined __CYGWIN__
-# undef strdup
-# define strdup _strdup
+#elif @GNULIB_MDA_STRDUP@
+/* On native Windows, map 'creat' to '_creat', so that -loldnames is not
+ required. In C++ with GNULIB_NAMESPACE, avoid differences between
+ platforms by defining GNULIB_NAMESPACE::creat always. */
+# if defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef strdup
+# define strdup _strdup
+# endif
+_GL_CXXALIAS_MDA (strdup, char *, (char const *__s));
+# else
+# if defined __cplusplus && defined GNULIB_NAMESPACE && defined strdup
+# undef strdup
+# endif
+_GL_CXXALIAS_SYS (strdup, char *, (char const *__s));
+# endif
+_GL_CXXALIASWARN (strdup);
#endif
/* Append no more than N characters from SRC onto DEST. */
diff --git a/lib/strnlen.c b/lib/strnlen.c
index dcecf0820df..c27a0392c2b 100644
--- a/lib/strnlen.c
+++ b/lib/strnlen.c
@@ -1,5 +1,5 @@
/* Find the length of STRING, but scan at most MAXLEN characters.
- Copyright (C) 2005-2007, 2009-2020 Free Software Foundation, Inc.
+ Copyright (C) 2005-2007, 2009-2021 Free Software Foundation, Inc.
Written by Simon Josefsson.
This program is free software; you can redistribute it and/or modify
diff --git a/lib/strtoimax.c b/lib/strtoimax.c
index a17b2f0a9d7..37a25c31d44 100644
--- a/lib/strtoimax.c
+++ b/lib/strtoimax.c
@@ -1,6 +1,6 @@
/* Convert string representation of a number into an intmax_t value.
- Copyright (C) 1999, 2001-2004, 2006, 2009-2020 Free Software Foundation,
+ Copyright (C) 1999, 2001-2004, 2006, 2009-2021 Free Software Foundation,
Inc.
This program is free software: you can redistribute it and/or modify
diff --git a/lib/strtol.c b/lib/strtol.c
index 02aafca44ea..2f2159b6231 100644
--- a/lib/strtol.c
+++ b/lib/strtol.c
@@ -1,6 +1,6 @@
/* Convert string representation of a number into an integer value.
- Copyright (C) 1991-1992, 1994-1999, 2003, 2005-2007, 2009-2020 Free Software
+ Copyright (C) 1991-1992, 1994-1999, 2003, 2005-2007, 2009-2021 Free Software
Foundation, Inc.
NOTE: The canonical source of this file is maintained with the GNU C
diff --git a/lib/strtoll.c b/lib/strtoll.c
index 3c7e8c002f0..30daefc50f6 100644
--- a/lib/strtoll.c
+++ b/lib/strtoll.c
@@ -1,5 +1,5 @@
/* Function to parse a 'long long int' from text.
- Copyright (C) 1995-1997, 1999, 2001, 2009-2020 Free Software Foundation,
+ Copyright (C) 1995-1997, 1999, 2001, 2009-2021 Free Software Foundation,
Inc.
This file is part of the GNU C Library.
diff --git a/lib/symlink.c b/lib/symlink.c
index e7dbd184a99..2f6c0d484b8 100644
--- a/lib/symlink.c
+++ b/lib/symlink.c
@@ -1,5 +1,5 @@
/* Stub for symlink().
- Copyright (C) 2009-2020 Free Software Foundation, Inc.
+ Copyright (C) 2009-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
@@ -36,7 +36,7 @@ rpl_symlink (char const *contents, char const *name)
if (len && name[len - 1] == '/')
{
struct stat st;
- if (lstat (name, &st) == 0)
+ if (lstat (name, &st) == 0 || errno == EOVERFLOW)
errno = EEXIST;
return -1;
}
diff --git a/lib/sys_random.in.h b/lib/sys_random.in.h
index a82d716de2e..5b9280dda36 100644
--- a/lib/sys_random.in.h
+++ b/lib/sys_random.in.h
@@ -1,5 +1,5 @@
/* Substitute for <sys/random.h>.
- Copyright (C) 2020 Free Software Foundation, Inc.
+ Copyright (C) 2020-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
diff --git a/lib/sys_select.in.h b/lib/sys_select.in.h
index 72cb9ba7b0f..1dacb21087d 100644
--- a/lib/sys_select.in.h
+++ b/lib/sys_select.in.h
@@ -1,5 +1,5 @@
/* Substitute for <sys/select.h>.
- Copyright (C) 2007-2020 Free Software Foundation, Inc.
+ Copyright (C) 2007-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
@@ -103,9 +103,16 @@
/* Get definition of 'sigset_t'.
But avoid namespace pollution on glibc systems and "unknown type
name" problems on Cygwin.
+ On OS/2 kLIBC, sigset_t is defined in <sys/select.h>, too. In addition,
+ if <sys/param.h> is included, <types.h> -> <sys/types.h> -> <sys/select.h>
+ are included. Then <signal.h> -> <pthread.h> are included by GNULIB. By the
+ way, <pthread.h> requires PAGE_SIZE defined in <sys/param.h>. However,
+ <sys/param.h> has not been processed, yet. As a result, 'PAGE_SIZE'
+ undeclared error occurs in <pthread.h>.
Do this after the include_next (for the sake of OpenBSD 5.0) but before
the split double-inclusion guard (for the sake of Solaris). */
-#if !((defined __GLIBC__ || defined __CYGWIN__) && !defined __UCLIBC__)
+#if !((defined __GLIBC__ || defined __CYGWIN__ || defined __KLIBC__) \
+ && !defined __UCLIBC__)
# include <signal.h>
#endif
diff --git a/lib/sys_stat.in.h b/lib/sys_stat.in.h
index 3e0e4b27b7e..ccdb5cbd143 100644
--- a/lib/sys_stat.in.h
+++ b/lib/sys_stat.in.h
@@ -1,5 +1,5 @@
/* Provide a more complete sys/stat.h header file.
- Copyright (C) 2005-2020 Free Software Foundation, Inc.
+ Copyright (C) 2005-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
@@ -375,11 +375,11 @@ struct stat
# define S_IRWXO (S_IROTH | S_IWOTH | S_IXOTH)
#endif
-/* S_IXUGO is a common extension to POSIX. */
+/* Although S_IXUGO and S_IRWXUGO are not specified by POSIX and are
+ not implemented in GNU/Linux, some Gnulib-using apps use the macros. */
#if !S_IXUGO
# define S_IXUGO (S_IXUSR | S_IXGRP | S_IXOTH)
#endif
-
#ifndef S_IRWXUGO
# define S_IRWXUGO (S_IRWXU | S_IRWXG | S_IRWXO)
#endif
@@ -391,9 +391,21 @@ struct stat
#endif
-#if defined _WIN32 && !defined __CYGWIN__
-# undef chmod
-# define chmod _chmod
+#if @GNULIB_MDA_CHMOD@
+/* On native Windows, map 'chmod' to '_chmod', so that -loldnames is not
+ required. In C++ with GNULIB_NAMESPACE, avoid differences between
+ platforms by defining GNULIB_NAMESPACE::chmod always. */
+# if defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef chmod
+# define chmod _chmod
+# endif
+/* Need to cast, because in mingw the last argument is 'int mode'. */
+_GL_CXXALIAS_MDA_CAST (chmod, int, (const char *filename, mode_t mode));
+# else
+_GL_CXXALIAS_SYS (chmod, int, (const char *filename, mode_t mode));
+# endif
+_GL_CXXALIASWARN (chmod);
#endif
@@ -596,21 +608,20 @@ _GL_WARN_ON_USE (lstat, "lstat is unportable - "
#endif
-#if @REPLACE_MKDIR@
-# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
-# undef mkdir
-# define mkdir rpl_mkdir
-# endif
+#if @GNULIB_MKDIR@
+# if @REPLACE_MKDIR@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef mkdir
+# define mkdir rpl_mkdir
+# endif
_GL_FUNCDECL_RPL (mkdir, int, (char const *name, mode_t mode)
- _GL_ARG_NONNULL ((1)));
+ _GL_ARG_NONNULL ((1)));
_GL_CXXALIAS_RPL (mkdir, int, (char const *name, mode_t mode));
-#else
+# elif defined _WIN32 && !defined __CYGWIN__
/* mingw's _mkdir() function has 1 argument, but we pass 2 arguments.
Additionally, it declares _mkdir (and depending on compile flags, an
alias mkdir), only in the nonstandard includes <direct.h> and <io.h>,
which are included above. */
-# if defined _WIN32 && ! defined __CYGWIN__
-
# if !GNULIB_defined_rpl_mkdir
static int
rpl_mkdir (char const *name, mode_t mode)
@@ -619,16 +630,44 @@ rpl_mkdir (char const *name, mode_t mode)
}
# define GNULIB_defined_rpl_mkdir 1
# endif
-
# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef mkdir
# define mkdir rpl_mkdir
# endif
_GL_CXXALIAS_RPL (mkdir, int, (char const *name, mode_t mode));
# else
_GL_CXXALIAS_SYS (mkdir, int, (char const *name, mode_t mode));
# endif
-#endif
_GL_CXXALIASWARN (mkdir);
+#elif defined GNULIB_POSIXCHECK
+# undef mkdir
+# if HAVE_RAW_DECL_MKDIR
+_GL_WARN_ON_USE (mkdir, "mkdir does not always support two parameters - "
+ "use gnulib module mkdir for portability");
+# endif
+#elif @GNULIB_MDA_MKDIR@
+/* On native Windows, map 'mkdir' to '_mkdir', so that -loldnames is not
+ required. In C++ with GNULIB_NAMESPACE, avoid differences between
+ platforms by defining GNULIB_NAMESPACE::mkdir always. */
+# if defined _WIN32 && !defined __CYGWIN__
+# if !GNULIB_defined_rpl_mkdir
+static int
+rpl_mkdir (char const *name, mode_t mode)
+{
+ return _mkdir (name);
+}
+# define GNULIB_defined_rpl_mkdir 1
+# endif
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef mkdir
+# define mkdir rpl_mkdir
+# endif
+_GL_CXXALIAS_RPL (mkdir, int, (char const *name, mode_t mode));
+# else
+_GL_CXXALIAS_SYS (mkdir, int, (char const *name, mode_t mode));
+# endif
+_GL_CXXALIASWARN (mkdir);
+#endif
#if @GNULIB_MKDIRAT@
@@ -808,9 +847,21 @@ _GL_WARN_ON_USE (stat, "stat is unportable - "
#endif
-#if defined _WIN32 && !defined __CYGWIN__
-# undef umask
-# define umask _umask
+#if @GNULIB_MDA_UMASK@
+/* On native Windows, map 'umask' to '_umask', so that -loldnames is not
+ required. In C++ with GNULIB_NAMESPACE, avoid differences between
+ platforms by defining GNULIB_NAMESPACE::umask always. */
+# if defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef umask
+# define umask _umask
+# endif
+/* Need to cast, because in mingw the last argument is 'int mode'. */
+_GL_CXXALIAS_MDA_CAST (umask, mode_t, (mode_t mask));
+# else
+_GL_CXXALIAS_SYS (umask, mode_t, (mode_t mask));
+# endif
+_GL_CXXALIASWARN (umask);
#endif
diff --git a/lib/sys_time.in.h b/lib/sys_time.in.h
index 1c12d5f13d7..90a67d18426 100644
--- a/lib/sys_time.in.h
+++ b/lib/sys_time.in.h
@@ -1,6 +1,6 @@
/* Provide a more complete sys/time.h.
- Copyright (C) 2007-2020 Free Software Foundation, Inc.
+ Copyright (C) 2007-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
diff --git a/lib/sys_types.in.h b/lib/sys_types.in.h
index e7e1a22ee5e..654e80335fa 100644
--- a/lib/sys_types.in.h
+++ b/lib/sys_types.in.h
@@ -1,6 +1,6 @@
/* Provide a more complete sys/types.h.
- Copyright (C) 2011-2020 Free Software Foundation, Inc.
+ Copyright (C) 2011-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
diff --git a/lib/tempname.c b/lib/tempname.c
index cfb0fc42eca..3d91deef1e1 100644
--- a/lib/tempname.c
+++ b/lib/tempname.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1991-2020 Free Software Foundation, Inc.
+/* Copyright (C) 1991-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
@@ -47,9 +47,11 @@
#include <string.h>
#include <fcntl.h>
+#include <stdalign.h>
#include <stdint.h>
#include <sys/random.h>
#include <sys/stat.h>
+#include <time.h>
#if _LIBC
# define struct_stat64 struct stat64
@@ -60,27 +62,33 @@
# define __mkdir mkdir
# define __open open
# define __lxstat64(version, file, buf) lstat (file, buf)
+# define __getrandom getrandom
+# define __clock_gettime64 clock_gettime
+# define __timespec64 timespec
#endif
-#ifdef _LIBC
-# include <random-bits.h>
-# define RANDOM_BITS(Var) ((Var) = random_bits ())
-typedef uint32_t random_value;
-# define RANDOM_VALUE_MAX UINT32_MAX
-# define BASE_62_DIGITS 5 /* 62**5 < UINT32_MAX */
-# define BASE_62_POWER (62 * 62 * 62 * 62 * 62) /* 2**BASE_62_DIGITS */
-#else
/* Use getrandom if it works, falling back on a 64-bit linear
- congruential generator that starts with whatever Var's value
- happens to be. */
-# define RANDOM_BITS(Var) \
- ((void) (getrandom (&(Var), sizeof (Var), 0) == sizeof (Var) \
- || ((Var) = 2862933555777941757 * (Var) + 3037000493)))
+ congruential generator that starts with Var's value
+ mixed in with a clock's low-order bits if available. */
typedef uint_fast64_t random_value;
-# define RANDOM_VALUE_MAX UINT_FAST64_MAX
-# define BASE_62_DIGITS 10 /* 62**10 < UINT_FAST64_MAX */
-# define BASE_62_POWER (62LL * 62 * 62 * 62 * 62 * 62 * 62 * 62 * 62 * 62)
+#define RANDOM_VALUE_MAX UINT_FAST64_MAX
+#define BASE_62_DIGITS 10 /* 62**10 < UINT_FAST64_MAX */
+#define BASE_62_POWER (62LL * 62 * 62 * 62 * 62 * 62 * 62 * 62 * 62 * 62)
+
+static random_value
+random_bits (random_value var)
+{
+ random_value r;
+ if (__getrandom (&r, sizeof r, 0) == sizeof r)
+ return r;
+#if _LIBC || (defined CLOCK_MONOTONIC && HAVE_CLOCK_GETTIME)
+ /* Add entropy if getrandom is not supported. */
+ struct __timespec64 tv;
+ __clock_gettime64 (CLOCK_MONOTONIC, &tv);
+ var ^= tv.tv_nsec;
#endif
+ return 2862933555777941757 * var + 3037000493;
+}
#if _LIBC
/* Return nonzero if DIR is an existent directory. */
@@ -250,8 +258,11 @@ try_tempname_len (char *tmpl, int suffixlen, void *args,
unsigned int attempts = ATTEMPTS_MIN;
#endif
- /* A random variable. */
- random_value v;
+ /* A random variable. The initial value is used only the for fallback path
+ on 'random_bits' on 'getrandom' failure. Its initial value tries to use
+ some entropy from the ASLR and ignore possible bits from the stack
+ alignment. */
+ random_value v = ((uintptr_t) &v) / alignof (max_align_t);
/* How many random base-62 digits can currently be extracted from V. */
int vdigits = 0;
@@ -279,7 +290,7 @@ try_tempname_len (char *tmpl, int suffixlen, void *args,
if (vdigits == 0)
{
do
- RANDOM_BITS (v);
+ v = random_bits (v);
while (unfair_min <= v);
vdigits = BASE_62_DIGITS;
diff --git a/lib/tempname.h b/lib/tempname.h
index 00dcbe4c93b..a8681fc998e 100644
--- a/lib/tempname.h
+++ b/lib/tempname.h
@@ -1,6 +1,6 @@
/* Create a temporary file or directory.
- Copyright (C) 2006, 2009-2020 Free Software Foundation, Inc.
+ Copyright (C) 2006, 2009-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
diff --git a/lib/time-internal.h b/lib/time-internal.h
index 8af3c2cbf8f..63a3f9e3db1 100644
--- a/lib/time-internal.h
+++ b/lib/time-internal.h
@@ -1,6 +1,6 @@
/* Time internal interface
- Copyright 2015-2020 Free Software Foundation, Inc.
+ Copyright 2015-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
diff --git a/lib/time.in.h b/lib/time.in.h
index 32e6ec03ef4..958dc0bd292 100644
--- a/lib/time.in.h
+++ b/lib/time.in.h
@@ -1,6 +1,6 @@
/* A more-standard <time.h>.
- Copyright (C) 2007-2020 Free Software Foundation, Inc.
+ Copyright (C) 2007-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
@@ -145,9 +145,20 @@ _GL_CXXALIAS_MDA (tzset, void, (void));
_GL_CXXALIAS_SYS (tzset, void, (void));
# endif
_GL_CXXALIASWARN (tzset);
-# elif defined _WIN32 && !defined __CYGWIN__
-# undef tzset
-# define tzset _tzset
+# elif @GNULIB_MDA_TZSET@
+/* On native Windows, map 'tzset' to '_tzset', so that -loldnames is not
+ required. In C++ with GNULIB_NAMESPACE, avoid differences between
+ platforms by defining GNULIB_NAMESPACE::tzset always. */
+# if defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef tzset
+# define tzset _tzset
+# endif
+_GL_CXXALIAS_MDA (tzset, void, (void));
+# else
+_GL_CXXALIAS_SYS (tzset, void, (void));
+# endif
+_GL_CXXALIASWARN (tzset);
# endif
/* Return the 'time_t' representation of TP and normalize TP. */
@@ -356,17 +367,17 @@ _GL_WARN_ON_USE (asctime, "asctime can overrun buffers in some cases - "
# endif
# if defined GNULIB_POSIXCHECK
# undef asctime_r
-_GL_WARN_ON_USE (asctime, "asctime_r can overrun buffers in some cases - "
+_GL_WARN_ON_USE (asctime_r, "asctime_r can overrun buffers in some cases - "
"better use strftime (or even sprintf) instead");
# endif
# if defined GNULIB_POSIXCHECK
# undef ctime
-_GL_WARN_ON_USE (asctime, "ctime can overrun buffers in some cases - "
+_GL_WARN_ON_USE (ctime, "ctime can overrun buffers in some cases - "
"better use strftime (or even sprintf) instead");
# endif
# if defined GNULIB_POSIXCHECK
# undef ctime_r
-_GL_WARN_ON_USE (asctime, "ctime_r can overrun buffers in some cases - "
+_GL_WARN_ON_USE (ctime_r, "ctime_r can overrun buffers in some cases - "
"better use strftime (or even sprintf) instead");
# endif
diff --git a/lib/time_r.c b/lib/time_r.c
index e8fca2d5c44..d9089868704 100644
--- a/lib/time_r.c
+++ b/lib/time_r.c
@@ -1,6 +1,6 @@
/* Reentrant time functions like localtime_r.
- Copyright (C) 2003, 2006-2007, 2010-2020 Free Software Foundation, Inc.
+ Copyright (C) 2003, 2006-2007, 2010-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
diff --git a/lib/time_rz.c b/lib/time_rz.c
index 95438cf876e..65e20cc5661 100644
--- a/lib/time_rz.c
+++ b/lib/time_rz.c
@@ -1,6 +1,6 @@
/* Time zone functions such as tzalloc and localtime_rz
- Copyright 2015-2020 Free Software Foundation, Inc.
+ Copyright 2015-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
@@ -27,19 +27,15 @@
#include <time.h>
#include <errno.h>
-#include <limits.h>
#include <stdbool.h>
#include <stddef.h>
#include <stdlib.h>
#include <string.h>
#include "flexmember.h"
+#include "idx.h"
#include "time-internal.h"
-#ifndef SIZE_MAX
-# define SIZE_MAX ((size_t) -1)
-#endif
-
/* The approximate size to use for small allocation requests. This is
the largest "small" request for the GNU C library malloc. */
enum { DEFAULT_MXFAST = 64 * sizeof (size_t) / 4 };
@@ -125,14 +121,8 @@ save_abbr (timezone_t tz, struct tm *tm)
{
if (! (*zone_copy || (zone_copy == tz->abbrs && tz->tz_is_set)))
{
- size_t zone_size = strlen (zone) + 1;
- size_t zone_used = zone_copy - tz->abbrs;
- if (SIZE_MAX - zone_used < zone_size)
- {
- errno = ENOMEM;
- return false;
- }
- if (zone_used + zone_size < ABBR_SIZE_MIN)
+ idx_t zone_size = strlen (zone) + 1;
+ if (zone_size < tz->abbrs + ABBR_SIZE_MIN - zone_copy)
extend_abbrs (zone_copy, zone, zone_size);
else
{
diff --git a/lib/timespec-add.c b/lib/timespec-add.c
index 259c2e99ba2..5460a042cc7 100644
--- a/lib/timespec-add.c
+++ b/lib/timespec-add.c
@@ -1,6 +1,6 @@
/* Add two struct timespec values.
- Copyright (C) 2011-2020 Free Software Foundation, Inc.
+ Copyright (C) 2011-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
diff --git a/lib/timespec-sub.c b/lib/timespec-sub.c
index ee827a741ad..88ef69a8175 100644
--- a/lib/timespec-sub.c
+++ b/lib/timespec-sub.c
@@ -1,6 +1,6 @@
/* Subtract two struct timespec values.
- Copyright (C) 2011-2020 Free Software Foundation, Inc.
+ Copyright (C) 2011-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
diff --git a/lib/timespec.h b/lib/timespec.h
index dc999f944b2..9a71e9ea893 100644
--- a/lib/timespec.h
+++ b/lib/timespec.h
@@ -1,6 +1,6 @@
/* timespec -- System time interface
- Copyright (C) 2000, 2002, 2004-2005, 2007, 2009-2020 Free Software
+ Copyright (C) 2000, 2002, 2004-2005, 2007, 2009-2021 Free Software
Foundation, Inc.
This program is free software: you can redistribute it and/or modify
diff --git a/lib/u64.h b/lib/u64.h
index a8d4d96fc2e..ad719c84f88 100644
--- a/lib/u64.h
+++ b/lib/u64.h
@@ -1,6 +1,6 @@
/* uint64_t-like operations that work even on hosts lacking uint64_t
- Copyright (C) 2006, 2009-2020 Free Software Foundation, Inc.
+ Copyright (C) 2006, 2009-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
diff --git a/lib/unistd.in.h b/lib/unistd.in.h
index 357a35e3881..5e9b47d981e 100644
--- a/lib/unistd.in.h
+++ b/lib/unistd.in.h
@@ -1,5 +1,5 @@
/* Substitute for and wrapper around <unistd.h>.
- Copyright (C) 2003-2020 Free Software Foundation, Inc.
+ Copyright (C) 2003-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
@@ -93,20 +93,18 @@
# undef __need_system_stdlib_h
#endif
-/* Native Windows platforms declare chdir, getcwd, rmdir in
+/* Native Windows platforms declare _chdir, _getcwd, _rmdir in
<io.h> and/or <direct.h>, not in <unistd.h>.
- They also declare access(), chmod(), close(), dup(), dup2(), isatty(),
- lseek(), read(), unlink(), write() in <io.h>. */
-#if ((@GNULIB_CHDIR@ || @GNULIB_GETCWD@ || @GNULIB_RMDIR@ \
- || defined GNULIB_POSIXCHECK) \
- && (defined _WIN32 && ! defined __CYGWIN__))
-# include <io.h> /* mingw32, mingw64 */
-# include <direct.h> /* mingw64, MSVC 9 */
-#elif (@GNULIB_CLOSE@ || @GNULIB_DUP@ || @GNULIB_DUP2@ || @GNULIB_ISATTY@ \
- || @GNULIB_LSEEK@ || @GNULIB_READ@ || @GNULIB_UNLINK@ || @GNULIB_WRITE@ \
- || defined GNULIB_POSIXCHECK) \
- && (defined _WIN32 && ! defined __CYGWIN__)
+ They also declare _access(), _chmod(), _close(), _dup(), _dup2(), _isatty(),
+ _lseek(), _read(), _unlink(), _write() in <io.h>. */
+#if defined _WIN32 && !defined __CYGWIN__
# include <io.h>
+# include <direct.h>
+#endif
+
+/* Native Windows platforms declare _execl*, _execv* in <process.h>. */
+#if defined _WIN32 && !defined __CYGWIN__
+# include <process.h>
#endif
/* AIX and OSF/1 5.1 declare getdomainname in <netdb.h>, not in <unistd.h>.
@@ -138,11 +136,8 @@
/* MSVC defines off_t in <sys/types.h>.
May also define off_t to a 64-bit type on native Windows. */
-/* But avoid namespace pollution on glibc systems. */
-#ifndef __GLIBC__
-/* Get off_t, ssize_t. */
-# include <sys/types.h>
-#endif
+/* Get off_t, ssize_t, mode_t. */
+#include <sys/types.h>
/* The definitions of _GL_FUNCDECL_RPL etc. are copied here. */
@@ -292,9 +287,20 @@ _GL_WARN_ON_USE (access, "access does not always support X_OK - "
"also, this function is a security risk - "
"use the gnulib module faccessat instead");
# endif
-#elif defined _WIN32 && !defined __CYGWIN__
-# undef access
-# define access _access
+#elif @GNULIB_MDA_ACCESS@
+/* On native Windows, map 'access' to '_access', so that -loldnames is not
+ required. In C++ with GNULIB_NAMESPACE, avoid differences between
+ platforms by defining GNULIB_NAMESPACE::access always. */
+# if defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef access
+# define access _access
+# endif
+_GL_CXXALIAS_MDA (access, int, (const char *file, int mode));
+# else
+_GL_CXXALIAS_SYS (access, int, (const char *file, int mode));
+# endif
+_GL_CXXALIASWARN (access);
#endif
@@ -315,9 +321,20 @@ _GL_CXXALIASWARN (chdir);
_GL_WARN_ON_USE (chown, "chdir is not always in <unistd.h> - "
"use gnulib module chdir for portability");
# endif
-#elif defined _WIN32 && !defined __CYGWIN__
-# undef chdir
-# define chdir _chdir
+#elif @GNULIB_MDA_CHDIR@
+/* On native Windows, map 'chdir' to '_chdir', so that -loldnames is not
+ required. In C++ with GNULIB_NAMESPACE, avoid differences between
+ platforms by defining GNULIB_NAMESPACE::chdir always. */
+# if defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef chdir
+# define chdir _chdir
+# endif
+_GL_CXXALIAS_MDA (chdir, int, (const char *file));
+# else
+_GL_CXXALIAS_SYS (chdir, int, (const char *file) _GL_ARG_NONNULL ((1)));
+# endif
+_GL_CXXALIASWARN (chdir);
#endif
@@ -380,9 +397,20 @@ _GL_CXXALIASWARN (close);
/* Assume close is always declared. */
_GL_WARN_ON_USE (close, "close does not portably work on sockets - "
"use gnulib module close for portability");
-#elif defined _WIN32 && !defined __CYGWIN__
-# undef close
-# define close _close
+#elif @GNULIB_MDA_CLOSE@
+/* On native Windows, map 'close' to '_close', so that -loldnames is not
+ required. In C++ with GNULIB_NAMESPACE, avoid differences between
+ platforms by defining GNULIB_NAMESPACE::close always. */
+# if defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef close
+# define close _close
+# endif
+_GL_CXXALIAS_MDA (close, int, (int fd));
+# else
+_GL_CXXALIAS_SYS (close, int, (int fd));
+# endif
+_GL_CXXALIASWARN (close);
#endif
@@ -397,10 +425,11 @@ _GL_CXXALIAS_SYS (copy_file_range, ssize_t, (int ifd, off_t *ipos,
# endif
_GL_CXXALIASWARN (copy_file_range);
#elif defined GNULIB_POSIXCHECK
-/* Assume copy_file_range is always declared. */
+# if HAVE_RAW_DECL_COPY_FILE_RANGE
_GL_WARN_ON_USE (copy_file_range,
"copy_file_range is unportable - "
"use gnulib module copy_file_range for portability");
+# endif
#endif
@@ -427,9 +456,20 @@ _GL_CXXALIASWARN (dup);
_GL_WARN_ON_USE (dup, "dup is unportable - "
"use gnulib module dup for portability");
# endif
-#elif defined _WIN32 && !defined __CYGWIN__
-# undef dup
-# define dup _dup
+#elif @GNULIB_MDA_DUP@
+/* On native Windows, map 'dup' to '_dup', so that -loldnames is not
+ required. In C++ with GNULIB_NAMESPACE, avoid differences between
+ platforms by defining GNULIB_NAMESPACE::dup always. */
+# if defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef dup
+# define dup _dup
+# endif
+_GL_CXXALIAS_MDA (dup, int, (int oldfd));
+# else
+_GL_CXXALIAS_SYS (dup, int, (int oldfd));
+# endif
+_GL_CXXALIASWARN (dup);
#endif
@@ -461,9 +501,20 @@ _GL_CXXALIASWARN (dup2);
_GL_WARN_ON_USE (dup2, "dup2 is unportable - "
"use gnulib module dup2 for portability");
# endif
-#elif defined _WIN32 && !defined __CYGWIN__
-# undef dup2
-# define dup2 _dup2
+#elif @GNULIB_MDA_DUP2@
+/* On native Windows, map 'dup2' to '_dup2', so that -loldnames is not
+ required. In C++ with GNULIB_NAMESPACE, avoid differences between
+ platforms by defining GNULIB_NAMESPACE::dup2 always. */
+# if defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef dup2
+# define dup2 _dup2
+# endif
+_GL_CXXALIAS_MDA (dup2, int, (int oldfd, int newfd));
+# else
+_GL_CXXALIAS_SYS (dup2, int, (int oldfd, int newfd));
+# endif
+_GL_CXXALIASWARN (dup2);
#endif
@@ -564,40 +615,279 @@ _GL_WARN_ON_USE (euidaccess, "euidaccess is unportable - "
#endif
-#if defined _WIN32 && !defined __CYGWIN__
+#if @GNULIB_EXECL@
+# if @REPLACE_EXECL@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef execl
+# define execl rpl_execl
+# endif
+_GL_FUNCDECL_RPL (execl, int, (const char *program, const char *arg, ...)
+ _GL_ARG_NONNULL ((1)));
+_GL_CXXALIAS_RPL (execl, int, (const char *program, const char *arg, ...));
+# else
+_GL_CXXALIAS_SYS (execl, int, (const char *program, const char *arg, ...));
+# endif
+_GL_CXXALIASWARN (execl);
+#elif defined GNULIB_POSIXCHECK
# undef execl
-# define execl _execl
+# if HAVE_RAW_DECL_EXECL
+_GL_WARN_ON_USE (execl, "execl behaves very differently on mingw - "
+ "use gnulib module execl for portability");
+# endif
+#elif @GNULIB_MDA_EXECL@
+/* On native Windows, map 'execl' to '_execl', so that -loldnames is not
+ required. In C++ with GNULIB_NAMESPACE, avoid differences between
+ platforms by defining GNULIB_NAMESPACE::execl always. */
+# if defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef execl
+# define execl _execl
+# endif
+_GL_CXXALIAS_MDA (execl, intptr_t, (const char *program, const char *arg, ...));
+# else
+_GL_CXXALIAS_SYS (execl, int, (const char *program, const char *arg, ...));
+# endif
+_GL_CXXALIASWARN (execl);
#endif
-#if defined _WIN32 && !defined __CYGWIN__
+#if @GNULIB_EXECLE@
+# if @REPLACE_EXECLE@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef execle
+# define execle rpl_execle
+# endif
+_GL_FUNCDECL_RPL (execle, int, (const char *program, const char *arg, ...)
+ _GL_ARG_NONNULL ((1)));
+_GL_CXXALIAS_RPL (execle, int, (const char *program, const char *arg, ...));
+# else
+_GL_CXXALIAS_SYS (execle, int, (const char *program, const char *arg, ...));
+# endif
+_GL_CXXALIASWARN (execle);
+#elif defined GNULIB_POSIXCHECK
# undef execle
-# define execle _execle
+# if HAVE_RAW_DECL_EXECLE
+_GL_WARN_ON_USE (execle, "execle behaves very differently on mingw - "
+ "use gnulib module execle for portability");
+# endif
+#elif @GNULIB_MDA_EXECLE@
+/* On native Windows, map 'execle' to '_execle', so that -loldnames is not
+ required. In C++ with GNULIB_NAMESPACE, avoid differences between
+ platforms by defining GNULIB_NAMESPACE::execle always. */
+# if defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef execle
+# define execle _execle
+# endif
+_GL_CXXALIAS_MDA (execle, intptr_t,
+ (const char *program, const char *arg, ...));
+# else
+_GL_CXXALIAS_SYS (execle, int, (const char *program, const char *arg, ...));
+# endif
+_GL_CXXALIASWARN (execle);
#endif
-#if defined _WIN32 && !defined __CYGWIN__
+#if @GNULIB_EXECLP@
+# if @REPLACE_EXECLP@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef execlp
+# define execlp rpl_execlp
+# endif
+_GL_FUNCDECL_RPL (execlp, int, (const char *program, const char *arg, ...)
+ _GL_ARG_NONNULL ((1)));
+_GL_CXXALIAS_RPL (execlp, int, (const char *program, const char *arg, ...));
+# else
+_GL_CXXALIAS_SYS (execlp, int, (const char *program, const char *arg, ...));
+# endif
+_GL_CXXALIASWARN (execlp);
+#elif defined GNULIB_POSIXCHECK
# undef execlp
-# define execlp _execlp
+# if HAVE_RAW_DECL_EXECLP
+_GL_WARN_ON_USE (execlp, "execlp behaves very differently on mingw - "
+ "use gnulib module execlp for portability");
+# endif
+#elif @GNULIB_MDA_EXECLP@
+/* On native Windows, map 'execlp' to '_execlp', so that -loldnames is not
+ required. In C++ with GNULIB_NAMESPACE, avoid differences between
+ platforms by defining GNULIB_NAMESPACE::execlp always. */
+# if defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef execlp
+# define execlp _execlp
+# endif
+_GL_CXXALIAS_MDA (execlp, intptr_t,
+ (const char *program, const char *arg, ...));
+# else
+_GL_CXXALIAS_SYS (execlp, int, (const char *program, const char *arg, ...));
+# endif
+_GL_CXXALIASWARN (execlp);
#endif
-#if defined _WIN32 && !defined __CYGWIN__
+#if @GNULIB_EXECV@
+# if @REPLACE_EXECV@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef execv
+# define execv rpl_execv
+# endif
+_GL_FUNCDECL_RPL (execv, int, (const char *program, char * const *argv)
+ _GL_ARG_NONNULL ((1, 2)));
+_GL_CXXALIAS_RPL (execv, int, (const char *program, char * const *argv));
+# else
+_GL_CXXALIAS_SYS (execv, int, (const char *program, char * const *argv));
+# endif
+_GL_CXXALIASWARN (execv);
+#elif defined GNULIB_POSIXCHECK
# undef execv
-# define execv _execv
+# if HAVE_RAW_DECL_EXECV
+_GL_WARN_ON_USE (execv, "execv behaves very differently on mingw - "
+ "use gnulib module execv for portability");
+# endif
+#elif @GNULIB_MDA_EXECV@
+/* On native Windows, map 'execv' to '_execv', so that -loldnames is not
+ required. In C++ with GNULIB_NAMESPACE, avoid differences between
+ platforms by defining GNULIB_NAMESPACE::execv always. */
+# if defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef execv
+# define execv _execv
+# endif
+_GL_CXXALIAS_MDA_CAST (execv, intptr_t,
+ (const char *program, char * const *argv));
+# else
+_GL_CXXALIAS_SYS (execv, int, (const char *program, char * const *argv));
+# endif
+_GL_CXXALIASWARN (execv);
#endif
-#if defined _WIN32 && !defined __CYGWIN__
+#if @GNULIB_EXECVE@
+# if @REPLACE_EXECVE@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef execve
+# define execve rpl_execve
+# endif
+_GL_FUNCDECL_RPL (execve, int,
+ (const char *program, char * const *argv, char * const *env)
+ _GL_ARG_NONNULL ((1, 2)));
+_GL_CXXALIAS_RPL (execve, int,
+ (const char *program, char * const *argv, char * const *env));
+# else
+_GL_CXXALIAS_SYS (execve, int,
+ (const char *program, char * const *argv, char * const *env));
+# endif
+_GL_CXXALIASWARN (execve);
+#elif defined GNULIB_POSIXCHECK
# undef execve
-# define execve _execve
+# if HAVE_RAW_DECL_EXECVE
+_GL_WARN_ON_USE (execve, "execve behaves very differently on mingw - "
+ "use gnulib module execve for portability");
+# endif
+#elif @GNULIB_MDA_EXECVE@
+/* On native Windows, map 'execve' to '_execve', so that -loldnames is not
+ required. In C++ with GNULIB_NAMESPACE, avoid differences between
+ platforms by defining GNULIB_NAMESPACE::execve always. */
+# if defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef execve
+# define execve _execve
+# endif
+_GL_CXXALIAS_MDA_CAST (execve, intptr_t,
+ (const char *program, char * const *argv,
+ char * const *env));
+# else
+_GL_CXXALIAS_SYS (execve, int,
+ (const char *program, char * const *argv, char * const *env));
+# endif
+_GL_CXXALIASWARN (execve);
#endif
-#if defined _WIN32 && !defined __CYGWIN__
+#if @GNULIB_EXECVP@
+# if @REPLACE_EXECVP@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef execvp
+# define execvp rpl_execvp
+# endif
+_GL_FUNCDECL_RPL (execvp, int, (const char *program, char * const *argv)
+ _GL_ARG_NONNULL ((1, 2)));
+_GL_CXXALIAS_RPL (execvp, int, (const char *program, char * const *argv));
+# else
+_GL_CXXALIAS_SYS (execvp, int, (const char *program, char * const *argv));
+# endif
+_GL_CXXALIASWARN (execvp);
+#elif defined GNULIB_POSIXCHECK
# undef execvp
-# define execvp _execvp
+# if HAVE_RAW_DECL_EXECVP
+_GL_WARN_ON_USE (execvp, "execvp behaves very differently on mingw - "
+ "use gnulib module execvp for portability");
+# endif
+#elif @GNULIB_MDA_EXECVP@
+/* On native Windows, map 'execvp' to '_execvp', so that -loldnames is not
+ required. In C++ with GNULIB_NAMESPACE, avoid differences between
+ platforms by defining GNULIB_NAMESPACE::execvp always. */
+# if defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef execvp
+# define execvp _execvp
+# endif
+_GL_CXXALIAS_MDA_CAST (execvp, intptr_t,
+ (const char *program, char * const *argv));
+# else
+_GL_CXXALIAS_SYS (execvp, int, (const char *program, char * const *argv));
+# endif
+_GL_CXXALIASWARN (execvp);
#endif
-#if defined _WIN32 && !defined __CYGWIN__
+#if @GNULIB_EXECVPE@
+# if @REPLACE_EXECVPE@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef execvpe
+# define execvpe rpl_execvpe
+# endif
+_GL_FUNCDECL_RPL (execvpe, int,
+ (const char *program, char * const *argv, char * const *env)
+ _GL_ARG_NONNULL ((1, 2)));
+_GL_CXXALIAS_RPL (execvpe, int,
+ (const char *program, char * const *argv, char * const *env));
+# else
+# if !@HAVE_DECL_EXECVPE@
+_GL_FUNCDECL_SYS (execvpe, int,
+ (const char *program, char * const *argv, char * const *env)
+ _GL_ARG_NONNULL ((1, 2)));
+# endif
+_GL_CXXALIAS_SYS (execvpe, int,
+ (const char *program, char * const *argv, char * const *env));
+# endif
+_GL_CXXALIASWARN (execvpe);
+#elif defined GNULIB_POSIXCHECK
# undef execvpe
-# define execvpe _execvpe
+# if HAVE_RAW_DECL_EXECVPE
+_GL_WARN_ON_USE (execvpe, "execvpe behaves very differently on mingw - "
+ "use gnulib module execvpe for portability");
+# endif
+#elif @GNULIB_MDA_EXECVPE@
+/* On native Windows, map 'execvpe' to '_execvpe', so that -loldnames is not
+ required. In C++ with GNULIB_NAMESPACE, avoid differences between
+ platforms by defining GNULIB_NAMESPACE::execvpe on all platforms that have
+ it. */
+# if defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef execvpe
+# define execvpe _execvpe
+# endif
+_GL_CXXALIAS_MDA_CAST (execvpe, intptr_t,
+ (const char *program, char * const *argv,
+ char * const *env));
+# elif @HAVE_EXECVPE@
+# if !@HAVE_DECL_EXECVPE@
+_GL_FUNCDECL_SYS (execvpe, int,
+ (const char *program, char * const *argv, char * const *env)
+ _GL_ARG_NONNULL ((1, 2)));
+# endif
+_GL_CXXALIAS_SYS (execvpe, int,
+ (const char *program, char * const *argv, char * const *env));
+# endif
+# if (defined _WIN32 && !defined __CYGWIN__) || @HAVE_EXECVPE@
+_GL_CXXALIASWARN (execvpe);
+# endif
#endif
@@ -688,7 +978,7 @@ _GL_CXXALIASWARN (fchownat);
# undef fchownat
# if HAVE_RAW_DECL_FCHOWNAT
_GL_WARN_ON_USE (fchownat, "fchownat is not portable - "
- "use gnulib module openat for portability");
+ "use gnulib module fchownat for portability");
# endif
#endif
@@ -794,9 +1084,22 @@ _GL_CXXALIASWARN (getcwd);
_GL_WARN_ON_USE (getcwd, "getcwd is unportable - "
"use gnulib module getcwd for portability");
# endif
-#elif defined _WIN32 && !defined __CYGWIN__
-# undef getcwd
-# define getcwd _getcwd
+#elif @GNULIB_MDA_GETCWD@
+/* On native Windows, map 'getcwd' to '_getcwd', so that -loldnames is not
+ required. In C++ with GNULIB_NAMESPACE, avoid differences between
+ platforms by defining GNULIB_NAMESPACE::getcwd always. */
+# if defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef getcwd
+# define getcwd _getcwd
+# endif
+/* Need to cast, because on mingw, the second parameter is either
+ 'int size' or 'size_t size'. */
+_GL_CXXALIAS_MDA_CAST (getcwd, char *, (char *buf, size_t size));
+# else
+_GL_CXXALIAS_SYS_CAST (getcwd, char *, (char *buf, size_t size));
+# endif
+_GL_CXXALIASWARN (getcwd);
#endif
@@ -1131,9 +1434,20 @@ _GL_WARN_ON_USE (getpass, "getpass is unportable - "
#endif
-#if defined _WIN32 && !defined __CYGWIN__
-# undef getpid
-# define getpid _getpid
+#if @GNULIB_MDA_GETPID@
+/* On native Windows, map 'getpid' to '_getpid', so that -loldnames is not
+ required. In C++ with GNULIB_NAMESPACE, avoid differences between
+ platforms by defining GNULIB_NAMESPACE::getpid always. */
+# if defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef getpid
+# define getpid _getpid
+# endif
+_GL_CXXALIAS_MDA (getpid, int, (void));
+# else
+_GL_CXXALIAS_SYS (getpid, pid_t, (void));
+# endif
+_GL_CXXALIASWARN (getpid);
#endif
@@ -1225,9 +1539,20 @@ _GL_CXXALIASWARN (isatty);
_GL_WARN_ON_USE (isatty, "isatty has portability problems on native Windows - "
"use gnulib module isatty for portability");
# endif
-#elif defined _WIN32 && !defined __CYGWIN__
-# undef isatty
-# define isatty _isatty
+#elif @GNULIB_MDA_ISATTY@
+/* On native Windows, map 'isatty' to '_isatty', so that -loldnames is not
+ required. In C++ with GNULIB_NAMESPACE, avoid differences between
+ platforms by defining GNULIB_NAMESPACE::isatty always. */
+# if defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef isatty
+# define isatty _isatty
+# endif
+_GL_CXXALIAS_MDA (isatty, int, (int fd));
+# else
+_GL_CXXALIAS_SYS (isatty, int, (int fd));
+# endif
+_GL_CXXALIASWARN (isatty);
#endif
@@ -1355,9 +1680,20 @@ _GL_CXXALIASWARN (lseek);
_GL_WARN_ON_USE (lseek, "lseek does not fail with ESPIPE on pipes on some "
"systems - use gnulib module lseek for portability");
# endif
-#elif defined _WIN32 && !defined __CYGWIN__
-# undef lseek
-# define lseek _lseek
+#elif @GNULIB_MDA_LSEEK@
+/* On native Windows, map 'lseek' to '_lseek', so that -loldnames is not
+ required. In C++ with GNULIB_NAMESPACE, avoid differences between
+ platforms by defining GNULIB_NAMESPACE::lseek always. */
+# if defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef lseek
+# define lseek _lseek
+# endif
+_GL_CXXALIAS_MDA (lseek, long, (int fd, long offset, int whence));
+# else
+_GL_CXXALIAS_SYS (lseek, off_t, (int fd, off_t offset, int whence));
+# endif
+_GL_CXXALIASWARN (lseek);
#endif
@@ -1497,15 +1833,27 @@ _GL_CXXALIAS_RPL (read, ssize_t, (int fd, void *buf, size_t count));
# endif
_GL_CXXALIAS_MDA (read, ssize_t, (int fd, void *buf, size_t count));
# else
-/* Need to cast, because on mingw, the third parameter is
- unsigned int count
- and the return type is 'int'. */
-_GL_CXXALIAS_SYS_CAST (read, ssize_t, (int fd, void *buf, size_t count));
+_GL_CXXALIAS_SYS (read, ssize_t, (int fd, void *buf, size_t count));
+# endif
+_GL_CXXALIASWARN (read);
+#elif @GNULIB_MDA_READ@
+/* On native Windows, map 'read' to '_read', so that -loldnames is not
+ required. In C++ with GNULIB_NAMESPACE, avoid differences between
+ platforms by defining GNULIB_NAMESPACE::read always. */
+# if defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef read
+# define read _read
+# endif
+# ifdef __MINGW32__
+_GL_CXXALIAS_MDA (read, int, (int fd, void *buf, unsigned int count));
+# else
+_GL_CXXALIAS_MDA (read, ssize_t, (int fd, void *buf, unsigned int count));
+# endif
+# else
+_GL_CXXALIAS_SYS (read, ssize_t, (int fd, void *buf, size_t count));
# endif
_GL_CXXALIASWARN (read);
-#elif defined _WIN32 && !defined __CYGWIN__
-# undef read
-# define read _read
#endif
@@ -1604,9 +1952,20 @@ _GL_CXXALIASWARN (rmdir);
_GL_WARN_ON_USE (rmdir, "rmdir is unportable - "
"use gnulib module rmdir for portability");
# endif
-#elif defined _WIN32 && !defined __CYGWIN__
-# undef rmdir
-# define rmdir _rmdir
+#elif @GNULIB_MDA_RMDIR@
+/* On native Windows, map 'rmdir' to '_rmdir', so that -loldnames is not
+ required. In C++ with GNULIB_NAMESPACE, avoid differences between
+ platforms by defining GNULIB_NAMESPACE::rmdir always. */
+# if defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef rmdir
+# define rmdir _rmdir
+# endif
+_GL_CXXALIAS_MDA (rmdir, int, (char const *name));
+# else
+_GL_CXXALIAS_SYS (rmdir, int, (char const *name));
+# endif
+_GL_CXXALIASWARN (rmdir);
#endif
@@ -1665,9 +2024,20 @@ _GL_WARN_ON_USE (sleep, "sleep is unportable - "
#endif
-#if defined _WIN32 && !defined __CYGWIN__
-# undef swab
-# define swab _swab
+#if @GNULIB_MDA_SWAB@
+/* On native Windows, map 'swab' to '_swab', so that -loldnames is not
+ required. In C++ with GNULIB_NAMESPACE, avoid differences between
+ platforms by defining GNULIB_NAMESPACE::creat always. */
+# if defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef swab
+# define swab _swab
+# endif
+_GL_CXXALIAS_MDA (swab, void, (char *from, char *to, int n));
+# else
+_GL_CXXALIAS_SYS (swab, void, (const void *from, void *to, ssize_t n));
+# endif
+_GL_CXXALIASWARN (swab);
#endif
@@ -1811,9 +2181,20 @@ _GL_CXXALIASWARN (unlink);
_GL_WARN_ON_USE (unlink, "unlink is not portable - "
"use gnulib module unlink for portability");
# endif
-#elif defined _WIN32 && !defined __CYGWIN__
-# undef unlink
-# define unlink _unlink
+#elif @GNULIB_MDA_UNLINK@
+/* On native Windows, map 'unlink' to '_unlink', so that -loldnames is not
+ required. In C++ with GNULIB_NAMESPACE, avoid differences between
+ platforms by defining GNULIB_NAMESPACE::unlink always. */
+# if defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef unlink
+# define unlink _unlink
+# endif
+_GL_CXXALIAS_MDA (unlink, int, (char const *file));
+# else
+_GL_CXXALIAS_SYS (unlink, int, (char const *file));
+# endif
+_GL_CXXALIASWARN (unlink);
#endif
@@ -1838,7 +2219,7 @@ _GL_CXXALIASWARN (unlinkat);
# undef unlinkat
# if HAVE_RAW_DECL_UNLINKAT
_GL_WARN_ON_USE (unlinkat, "unlinkat is not portable - "
- "use gnulib module openat for portability");
+ "use gnulib module unlinkat for portability");
# endif
#endif
@@ -1892,15 +2273,27 @@ _GL_CXXALIAS_RPL (write, ssize_t, (int fd, const void *buf, size_t count));
# endif
_GL_CXXALIAS_MDA (write, ssize_t, (int fd, const void *buf, size_t count));
# else
-/* Need to cast, because on mingw, the third parameter is
- unsigned int count
- and the return type is 'int'. */
-_GL_CXXALIAS_SYS_CAST (write, ssize_t, (int fd, const void *buf, size_t count));
+_GL_CXXALIAS_SYS (write, ssize_t, (int fd, const void *buf, size_t count));
+# endif
+_GL_CXXALIASWARN (write);
+#elif @GNULIB_MDA_WRITE@
+/* On native Windows, map 'write' to '_write', so that -loldnames is not
+ required. In C++ with GNULIB_NAMESPACE, avoid differences between
+ platforms by defining GNULIB_NAMESPACE::write always. */
+# if defined _WIN32 && !defined __CYGWIN__
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef write
+# define write _write
+# endif
+# ifdef __MINGW32__
+_GL_CXXALIAS_MDA (write, int, (int fd, const void *buf, unsigned int count));
+# else
+_GL_CXXALIAS_MDA (write, ssize_t, (int fd, const void *buf, unsigned int count));
+# endif
+# else
+_GL_CXXALIAS_SYS (write, ssize_t, (int fd, const void *buf, size_t count));
# endif
_GL_CXXALIASWARN (write);
-#elif defined _WIN32 && !defined __CYGWIN__
-# undef write
-# define write _write
#endif
_GL_INLINE_HEADER_END
diff --git a/lib/unlocked-io.h b/lib/unlocked-io.h
index e7f7199edae..86b91c19dd2 100644
--- a/lib/unlocked-io.h
+++ b/lib/unlocked-io.h
@@ -1,6 +1,6 @@
/* Prefer faster, non-thread-safe stdio functions if available.
- Copyright (C) 2001-2004, 2009-2020 Free Software Foundation, Inc.
+ Copyright (C) 2001-2004, 2009-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
diff --git a/lib/utimens.c b/lib/utimens.c
index 3f53942081d..5bbae058132 100644
--- a/lib/utimens.c
+++ b/lib/utimens.c
@@ -1,6 +1,6 @@
/* Set file access and modification times.
- Copyright (C) 2003-2020 Free Software Foundation, Inc.
+ Copyright (C) 2003-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
diff --git a/lib/utimens.h b/lib/utimens.h
index fc22c8ad53f..295d3d71cca 100644
--- a/lib/utimens.h
+++ b/lib/utimens.h
@@ -1,6 +1,6 @@
/* Set file access and modification times.
- Copyright 2012-2020 Free Software Foundation, Inc.
+ Copyright 2012-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
diff --git a/lib/utimensat.c b/lib/utimensat.c
index 63788d56480..2cea64f6982 100644
--- a/lib/utimensat.c
+++ b/lib/utimensat.c
@@ -1,5 +1,5 @@
/* Set the access and modification time of a file relative to directory fd.
- Copyright (C) 2009-2020 Free Software Foundation, Inc.
+ Copyright (C) 2009-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
diff --git a/lib/verify.h b/lib/verify.h
index fa1ed717d0e..3cdcdca5671 100644
--- a/lib/verify.h
+++ b/lib/verify.h
@@ -1,6 +1,6 @@
/* Compile-time assert-like macros.
- Copyright (C) 2005-2006, 2009-2020 Free Software Foundation, Inc.
+ Copyright (C) 2005-2006, 2009-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
diff --git a/lib/vla.h b/lib/vla.h
index 4af7567ed36..333b6264200 100644
--- a/lib/vla.h
+++ b/lib/vla.h
@@ -1,6 +1,6 @@
/* vla.h - variable length arrays
- Copyright 2014-2020 Free Software Foundation, Inc.
+ Copyright 2014-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
diff --git a/lib/warn-on-use.h b/lib/warn-on-use.h
index 3f728d1a9dc..5d5b17f05be 100644
--- a/lib/warn-on-use.h
+++ b/lib/warn-on-use.h
@@ -1,5 +1,5 @@
/* A C macro for emitting warnings if a function is used.
- Copyright (C) 2010-2020 Free Software Foundation, Inc.
+ Copyright (C) 2010-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
diff --git a/lib/xalloc-oversized.h b/lib/xalloc-oversized.h
index 13ee23031a0..53daf59663e 100644
--- a/lib/xalloc-oversized.h
+++ b/lib/xalloc-oversized.h
@@ -1,6 +1,6 @@
/* xalloc-oversized.h -- memory allocation size checking
- Copyright (C) 1990-2000, 2003-2004, 2006-2020 Free Software Foundation, Inc.
+ Copyright (C) 1990-2000, 2003-2004, 2006-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
@@ -41,7 +41,7 @@ typedef size_t __xalloc_count_type;
positive and N must be nonnegative. This is a macro, not a
function, so that it works correctly even when SIZE_MAX < N. */
-#if 7 <= __GNUC__
+#if 7 <= __GNUC__ && !defined __clang__
# define xalloc_oversized(n, s) \
__builtin_mul_overflow_p (n, s, (__xalloc_count_type) 1)
#elif 5 <= __GNUC__ && !defined __ICC && !__STRICT_ANSI__
diff --git a/lisp/ChangeLog.1 b/lisp/ChangeLog.1
index 5ef36f4b810..9fda59b63b1 100644
--- a/lisp/ChangeLog.1
+++ b/lisp/ChangeLog.1
@@ -3244,7 +3244,7 @@
Set current buffer variables from defaults
in case user's init file has changed them.
- Copyright (C) 1985-1986, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1985-1986, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/ChangeLog.10 b/lisp/ChangeLog.10
index 177ca08ef3b..c8b0bdabc50 100644
--- a/lisp/ChangeLog.10
+++ b/lisp/ChangeLog.10
@@ -23541,7 +23541,7 @@ See ChangeLog.9 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/ChangeLog.11 b/lisp/ChangeLog.11
index 374a5668932..0c72cb4c124 100644
--- a/lisp/ChangeLog.11
+++ b/lisp/ChangeLog.11
@@ -14321,7 +14321,7 @@ See ChangeLog.10 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 2003-2011, 2013-2020 Free Software Foundation, Inc.
+ Copyright (C) 2003-2011, 2013-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/ChangeLog.12 b/lisp/ChangeLog.12
index 40aa8c4dc83..5d424570d83 100644
--- a/lisp/ChangeLog.12
+++ b/lisp/ChangeLog.12
@@ -33334,7 +33334,7 @@ See ChangeLog.11 for earlier changes.
;; add-log-time-zone-rule: t
;; End:
- Copyright (C) 2005-2020 Free Software Foundation, Inc.
+ Copyright (C) 2005-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/ChangeLog.13 b/lisp/ChangeLog.13
index 1a2863afa97..d849bd88fcc 100644
--- a/lisp/ChangeLog.13
+++ b/lisp/ChangeLog.13
@@ -16697,7 +16697,7 @@ See ChangeLog.12 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 2007-2020 Free Software Foundation, Inc.
+ Copyright (C) 2007-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/ChangeLog.14 b/lisp/ChangeLog.14
index e9c8a8ff8be..edd5bdb7f9c 100644
--- a/lisp/ChangeLog.14
+++ b/lisp/ChangeLog.14
@@ -20547,7 +20547,7 @@ See ChangeLog.13 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 2008-2020 Free Software Foundation, Inc.
+ Copyright (C) 2008-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/ChangeLog.15 b/lisp/ChangeLog.15
index 3a578da4bc7..bd1fbe61ad1 100644
--- a/lisp/ChangeLog.15
+++ b/lisp/ChangeLog.15
@@ -22802,7 +22802,7 @@ See ChangeLog.14 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 2009-2020 Free Software Foundation, Inc.
+ Copyright (C) 2009-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/ChangeLog.16 b/lisp/ChangeLog.16
index bb7389c5b71..67b62767ed4 100644
--- a/lisp/ChangeLog.16
+++ b/lisp/ChangeLog.16
@@ -25223,7 +25223,7 @@ See ChangeLog.15 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 2011-2020 Free Software Foundation, Inc.
+ Copyright (C) 2011-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/ChangeLog.17 b/lisp/ChangeLog.17
index 5789445fcd6..14a6c5d06e4 100644
--- a/lisp/ChangeLog.17
+++ b/lisp/ChangeLog.17
@@ -26294,7 +26294,7 @@ See ChangeLog.16 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 2011-2020 Free Software Foundation, Inc.
+ Copyright (C) 2011-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/ChangeLog.2 b/lisp/ChangeLog.2
index 274ee991911..ea6ddbb70a9 100644
--- a/lisp/ChangeLog.2
+++ b/lisp/ChangeLog.2
@@ -3992,7 +3992,7 @@
See ChangeLog.1 for earlier changes.
- Copyright (C) 1986-1988, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1986-1988, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/ChangeLog.3 b/lisp/ChangeLog.3
index ef0e423d145..a4470b9cfda 100644
--- a/lisp/ChangeLog.3
+++ b/lisp/ChangeLog.3
@@ -12433,7 +12433,7 @@ See ChangeLog.2 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 1989, 1993, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1989, 1993, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/ChangeLog.4 b/lisp/ChangeLog.4
index 1f64650bfd3..47a8bfdff72 100644
--- a/lisp/ChangeLog.4
+++ b/lisp/ChangeLog.4
@@ -8934,7 +8934,7 @@ See ChangeLog.3 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 1993-1994, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1993-1994, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/ChangeLog.5 b/lisp/ChangeLog.5
index cd092bde9e1..1a3a13c6bb0 100644
--- a/lisp/ChangeLog.5
+++ b/lisp/ChangeLog.5
@@ -9268,7 +9268,7 @@ See ChangeLog.4 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 1994-1995, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1994-1995, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/ChangeLog.6 b/lisp/ChangeLog.6
index 87ae38b27e6..492dae18e01 100644
--- a/lisp/ChangeLog.6
+++ b/lisp/ChangeLog.6
@@ -8021,7 +8021,7 @@ See ChangeLog.5 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 1995-1996, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1995-1996, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/ChangeLog.7 b/lisp/ChangeLog.7
index 58a7fa402ba..3de3f2f1571 100644
--- a/lisp/ChangeLog.7
+++ b/lisp/ChangeLog.7
@@ -23110,7 +23110,7 @@ See ChangeLog.6 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 1997-1998, 2001-2020 Free Software Foundation,
+ Copyright (C) 1997-1998, 2001-2021 Free Software Foundation,
Inc.
This file is part of GNU Emacs.
diff --git a/lisp/ChangeLog.8 b/lisp/ChangeLog.8
index e9b2138e4ba..3027463e539 100644
--- a/lisp/ChangeLog.8
+++ b/lisp/ChangeLog.8
@@ -9992,7 +9992,7 @@ See ChangeLog.7 for earlier changes.
;; add-log-time-zone-rule: t
;; End:
- Copyright (C) 1999, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1999, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/ChangeLog.9 b/lisp/ChangeLog.9
index 5372b242f5f..a8ef2ffa447 100644
--- a/lisp/ChangeLog.9
+++ b/lisp/ChangeLog.9
@@ -20685,7 +20685,7 @@ See ChangeLog.8 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 2000-2011, 2013-2020 Free Software Foundation, Inc.
+ Copyright (C) 2000-2011, 2013-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/Makefile.in b/lisp/Makefile.in
index 7c86e89ca99..72f7f1676b7 100644
--- a/lisp/Makefile.in
+++ b/lisp/Makefile.in
@@ -1,6 +1,6 @@
### @configure_input@
-# Copyright (C) 2000-2020 Free Software Foundation, Inc.
+# Copyright (C) 2000-2021 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
diff --git a/lisp/abbrev.el b/lisp/abbrev.el
index f35c637eed5..65f71183856 100644
--- a/lisp/abbrev.el
+++ b/lisp/abbrev.el
@@ -1,6 +1,6 @@
;;; abbrev.el --- abbrev mode commands for Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1987, 1992, 2001-2020 Free Software Foundation,
+;; Copyright (C) 1985-1987, 1992, 2001-2021 Free Software Foundation,
;; Inc.
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/align.el b/lisp/align.el
index e3bdf77002e..1318b735c05 100644
--- a/lisp/align.el
+++ b/lisp/align.el
@@ -1,6 +1,6 @@
;;; align.el --- align text to a specific column, by regexp -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
;; Maintainer: emacs-devel@gnu.org
@@ -397,13 +397,12 @@ The possible settings for `align-region-separate' are:
(modes . align-lisp-modes))
(open-comment
- (regexp . ,(function
- (lambda (end reverse)
- (funcall (if reverse 're-search-backward
- 're-search-forward)
- (concat "[^ \t\n\\]"
- (regexp-quote comment-start)
- "\\(.+\\)$") end t))))
+ (regexp . ,(lambda (end reverse)
+ (funcall (if reverse 're-search-backward
+ 're-search-forward)
+ (concat "[^ \t\n\\]"
+ (regexp-quote comment-start)
+ "\\(.+\\)$") end t)))
(modes . align-open-comment-modes))
(c-macro-definition
@@ -411,25 +410,24 @@ The possible settings for `align-region-separate' are:
(modes . align-c++-modes))
(c-variable-declaration
- (regexp . ,(concat "[*&0-9A-Za-z_]>?[&*]*\\(\\s-+[*&]*\\)"
- "[A-Za-z_][0-9A-Za-z:_]*\\s-*\\(\\()\\|"
+ (regexp . ,(concat "[*&0-9A-Za-z_]>?[][&*]*\\(\\s-+[*&]*\\)"
+ "[A-Za-z_][][0-9A-Za-z:_]*\\s-*\\(\\()\\|"
"=[^=\n].*\\|(.*)\\|\\(\\[.*\\]\\)*\\)"
"\\s-*[;,]\\|)\\s-*$\\)"))
(group . 1)
(modes . align-c++-modes)
(justify . t)
(valid
- . ,(function
- (lambda ()
- (not (or (save-excursion
- (goto-char (match-beginning 1))
- (backward-word 1)
- (looking-at
- "\\(goto\\|return\\|new\\|delete\\|throw\\)"))
- (if (and (boundp 'font-lock-mode) font-lock-mode)
- (eq (get-text-property (point) 'face)
- 'font-lock-comment-face)
- (eq (caar (c-guess-basic-syntax)) 'c))))))))
+ . ,(lambda ()
+ (not (or (save-excursion
+ (goto-char (match-beginning 1))
+ (backward-word 1)
+ (looking-at
+ "\\(goto\\|return\\|new\\|delete\\|throw\\)"))
+ (if (and (boundp 'font-lock-mode) font-lock-mode)
+ (eq (get-text-property (point) 'face)
+ 'font-lock-comment-face)
+ (eq (caar (c-guess-basic-syntax)) 'c)))))))
(c-assignment
(regexp . ,(concat "[^-=!^&*+<>/| \t\n]\\(\\s-*[-=!^&*+<>/|]*\\)"
@@ -465,12 +463,11 @@ The possible settings for `align-region-separate' are:
(modes . align-c++-modes)
(run-if . ,(lambda () current-prefix-arg)))
; (valid
- ; . ,(function
- ; (lambda ()
+ ; . ,(lambda ()
; (memq (caar (c-guess-basic-syntax))
; '(brace-list-intro
; brace-list-entry
- ; brace-entry-open))))))
+ ; brace-entry-open)))))
;; With a prefix argument, comma delimiter will be aligned. Since
;; perl-mode doesn't give us enough syntactic information (and we
@@ -486,71 +483,63 @@ The possible settings for `align-region-separate' are:
(regexp . "\\(\\s-*\\)\\(//.*\\|/\\*.*\\*/\\s-*\\)$")
(modes . align-c++-modes)
(column . comment-column)
- (valid . ,(function
- (lambda ()
- (save-excursion
- (goto-char (match-beginning 1))
- (not (bolp)))))))
+ (valid . ,(lambda ()
+ (save-excursion
+ (goto-char (match-beginning 1))
+ (not (bolp))))))
(c-chain-logic
(regexp . "\\(\\s-*\\)\\(&&\\|||\\|\\<and\\>\\|\\<or\\>\\)")
(modes . align-c++-modes)
- (valid . ,(function
- (lambda ()
- (save-excursion
- (goto-char (match-end 2))
- (looking-at "\\s-*\\(/[*/]\\|$\\)"))))))
+ (valid . ,(lambda ()
+ (save-excursion
+ (goto-char (match-end 2))
+ (looking-at "\\s-*\\(/[*/]\\|$\\)")))))
(perl-chain-logic
(regexp . "\\(\\s-*\\)\\(&&\\|||\\|\\<and\\>\\|\\<or\\>\\)")
(modes . align-perl-modes)
- (valid . ,(function
- (lambda ()
- (save-excursion
- (goto-char (match-end 2))
- (looking-at "\\s-*\\(#\\|$\\)"))))))
+ (valid . ,(lambda ()
+ (save-excursion
+ (goto-char (match-end 2))
+ (looking-at "\\s-*\\(#\\|$\\)")))))
(python-chain-logic
(regexp . "\\(\\s-*\\)\\(\\<and\\>\\|\\<or\\>\\)")
(modes . '(python-mode))
- (valid . ,(function
- (lambda ()
- (save-excursion
- (goto-char (match-end 2))
- (looking-at "\\s-*\\(#\\|$\\|\\\\\\)"))))))
+ (valid . ,(lambda ()
+ (save-excursion
+ (goto-char (match-end 2))
+ (looking-at "\\s-*\\(#\\|$\\|\\\\\\)")))))
(c-macro-line-continuation
(regexp . "\\(\\s-*\\)\\\\$")
(modes . align-c++-modes)
(column . c-backslash-column))
; (valid
- ; . ,(function
- ; (lambda ()
+ ; . ,(lambda ()
; (memq (caar (c-guess-basic-syntax))
- ; '(cpp-macro cpp-macro-cont))))))
+ ; '(cpp-macro cpp-macro-cont)))))
(basic-line-continuation
(regexp . "\\(\\s-*\\)\\\\$")
(modes . '(python-mode makefile-mode)))
(tex-record-separator
- (regexp . ,(function
- (lambda (end reverse)
- (align-match-tex-pattern "&" end reverse))))
+ (regexp . ,(lambda (end reverse)
+ (align-match-tex-pattern "&" end reverse)))
(group . (1 2))
(modes . align-tex-modes)
(repeat . t))
(tex-tabbing-separator
- (regexp . ,(function
- (lambda (end reverse)
- (align-match-tex-pattern "\\\\[=>]" end reverse))))
+ (regexp . ,(lambda (end reverse)
+ (align-match-tex-pattern "\\\\[=>]" end reverse)))
(group . (1 2))
(modes . align-tex-modes)
(repeat . t)
- (run-if . ,(function
- (lambda ()
- (eq major-mode 'latex-mode)))))
+ (run-if . ,(lambda ()
+ (eq major-mode 'latex-mode))))
(tex-record-break
(regexp . "\\(\\s-*\\)\\\\\\\\")
@@ -563,10 +552,9 @@ The possible settings for `align-region-separate' are:
(group . 2)
(modes . align-text-modes)
(repeat . t)
- (run-if . ,(function
- (lambda ()
- (and current-prefix-arg
- (not (eq '- current-prefix-arg)))))))
+ (run-if . ,(lambda ()
+ (and current-prefix-arg
+ (not (eq '- current-prefix-arg))))))
;; With a negative prefix argument, lists of dollar figures will
;; be aligned.
@@ -574,9 +562,8 @@ The possible settings for `align-region-separate' are:
(regexp . "\\$?\\(\\s-+[0-9]+\\)\\.")
(modes . align-text-modes)
(justify . t)
- (run-if . ,(function
- (lambda ()
- (eq '- current-prefix-arg)))))
+ (run-if . ,(lambda ()
+ (eq '- current-prefix-arg))))
(css-declaration
(regexp . "^\\s-*\\(?:\\w-?\\)+:\\(\\s-*\\).*;")
@@ -757,13 +744,12 @@ The following attributes are meaningful:
(exc-open-comment
(regexp
- . ,(function
- (lambda (end reverse)
- (funcall (if reverse 're-search-backward
- 're-search-forward)
- (concat "[^ \t\n\\]"
- (regexp-quote comment-start)
- "\\(.+\\)$") end t))))
+ . ,(lambda (end reverse)
+ (funcall (if reverse 're-search-backward
+ 're-search-forward)
+ (concat "[^ \t\n\\]"
+ (regexp-quote comment-start)
+ "\\(.+\\)$") end t)))
(modes . align-open-comment-modes))
(exc-c-comment
@@ -817,10 +803,9 @@ See the variable `align-exclude-rules-list' for more details.")
(regexp . "\\(others\\|[^ \t\n=<]\\)\\(\\s-*\\)=>\\(\\s-*\\)\\S-")
(group . (2 3))
(valid
- . ,(function
- (lambda ()
- (not (string= (downcase (match-string 1))
- "others"))))))
+ . ,(lambda ()
+ (not (string= (downcase (match-string 1))
+ "others")))))
(vhdl-colon
(regexp . "[^ \t\n:]\\(\\s-*\\):\\(\\s-*\\)[^=\n]")
@@ -1004,9 +989,8 @@ to be colored."
(completing-read
"Title of rule to highlight: "
(mapcar
- (function
- (lambda (rule)
- (list (symbol-name (car rule)))))
+ (lambda (rule)
+ (list (symbol-name (car rule))))
(append (or align-mode-rules-list align-rules-list)
(or align-mode-exclude-rules-list
align-exclude-rules-list))) nil t)))
@@ -1023,21 +1007,20 @@ to be colored."
(or align-mode-rules-list align-rules-list)))
(unless ex-rule (or exclude-rules align-mode-exclude-rules-list
align-exclude-rules-list))
- (function
- (lambda (b e mode)
- (if (and mode (listp mode))
- (if (equal (symbol-name (car mode)) title)
- (setq face (cons align-highlight-change-face
- align-highlight-nochange-face))
- (setq face nil))
- (when face
- (let ((overlay (make-overlay b e)))
- (setq align-highlight-overlays
- (cons overlay align-highlight-overlays))
- (overlay-put overlay 'face
- (if mode
- (car face)
- (cdr face)))))))))))
+ (lambda (b e mode)
+ (if (and mode (listp mode))
+ (if (equal (symbol-name (car mode)) title)
+ (setq face (cons align-highlight-change-face
+ align-highlight-nochange-face))
+ (setq face nil))
+ (when face
+ (let ((overlay (make-overlay b e)))
+ (setq align-highlight-overlays
+ (cons overlay align-highlight-overlays))
+ (overlay-put overlay 'face
+ (if mode
+ (car face)
+ (cdr face))))))))))
;;;###autoload
(defun align-unhighlight-rule ()
diff --git a/lisp/allout-widgets.el b/lisp/allout-widgets.el
index ac49d3bf068..d31083e4271 100644
--- a/lisp/allout-widgets.el
+++ b/lisp/allout-widgets.el
@@ -1,6 +1,6 @@
;; allout-widgets.el --- Visually highlight allout outline structure.
-;; Copyright (C) 2005-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2005-2021 Free Software Foundation, Inc.
;; Author: Ken Manheimer <ken dot manheimer at gmail...>
;; Version: 1.0
@@ -254,7 +254,7 @@ or deleted while this variable is nil.")
(defvar allout-widgets-mode-inhibit) ; defined below
;;;_ > allout-widgets-tally-string
(defun allout-widgets-tally-string ()
- "Return a string giving the number of tracked widgets, or empty string if not tracking.
+ "Return a string with number of tracked widgets, or empty string if not tracking.
The string is formed for appending to the allout-mode mode-line lighter.
@@ -916,15 +916,15 @@ posting threshold criteria."
(let ((min (point-max))
(max 0)
first second)
- (mapc (function (lambda (entry)
- (if (eq :undone-exposure (car entry))
- nil
- (setq first (cadr entry)
- second (caddr entry))
- (if (< (min first second) min)
- (setq min (min first second)))
- (if (> (max first second) max)
- (setq max (max first second))))))
+ (mapc (lambda (entry)
+ (if (eq :undone-exposure (car entry))
+ nil
+ (setq first (cadr entry)
+ second (caddr entry))
+ (if (< (min first second) min)
+ (setq min (min first second)))
+ (if (> (max first second) max)
+ (setq max (max first second)))))
allout-widgets-changes-record)
(> (- max min) allout-widgets-adjust-message-size-threshold)))
(let ((prior (current-message)))
@@ -975,8 +975,8 @@ Records changes in `allout-widgets-changes-record'."
Generally invoked via `allout-exposure-change-functions'."
- (let ((changes (sort changes (function (lambda (this next)
- (< (cadr this) (cadr next))))))
+ (let ((changes (sort changes (lambda (this next)
+ (< (cadr this) (cadr next)))))
;; have to distinguish between concealing and exposing so that, eg,
;; `allout-expose-topic's mix is handled properly.
handled-expose
@@ -2301,9 +2301,9 @@ The elements of LIST are not copied, just the list structure itself."
end (or end (point-max)))
(if (> start end) (let ((interim start)) (setq start end end interim)))
(let ((button-overlays (delq nil
- (mapcar (function (lambda (o)
- (if (overlay-get o 'button)
- o)))
+ (mapcar (lambda (o)
+ (if (overlay-get o 'button)
+ o))
(overlays-in start end)))))
(length button-overlays)))
diff --git a/lisp/allout.el b/lisp/allout.el
index b56071de59e..39aa29b664a 100644
--- a/lisp/allout.el
+++ b/lisp/allout.el
@@ -1,6 +1,6 @@
;;; allout.el --- extensive outline mode for use alone and with other modes
-;; Copyright (C) 1992-1994, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1992-1994, 2001-2021 Free Software Foundation, Inc.
;; Author: Ken Manheimer <ken dot manheimer at gmail...>
;; Created: Dec 1991 -- first release to usenet
@@ -1621,8 +1621,7 @@ So `allout-post-command-business' should not reactivate it...")
cur)
(while menus
(setq cur (car menus)
- menus (cdr menus))
- (easy-menu-add cur))))
+ menus (cdr menus)))))
;;;_ > allout-overlay-preparations
(defun allout-overlay-preparations ()
"Set the properties of the allout invisible-text overlay and others."
@@ -5583,12 +5582,11 @@ used verbatim."
"Return copy of STRING for literal reproduction across LaTeX processing.
Expresses the original characters (including carriage returns) of the
string across LaTeX processing."
- (mapconcat (function
- (lambda (char)
- (cond ((memq char '(?\\ ?$ ?% ?# ?& ?{ ?} ?_ ?^ ?- ?*))
- (concat "\\char" (number-to-string char) "{}"))
- ((= char ?\n) "\\\\")
- (t (char-to-string char)))))
+ (mapconcat (lambda (char)
+ (cond ((memq char '(?\\ ?$ ?% ?# ?& ?{ ?} ?_ ?^ ?- ?*))
+ (concat "\\char" (number-to-string char) "{}"))
+ ((= char ?\n) "\\\\")
+ (t (char-to-string char))))
string
""))
;;;_ > allout-latex-verbatim-quote-curr-line ()
diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el
index d20260b185c..e5bfccdb8ba 100644
--- a/lisp/ansi-color.el
+++ b/lisp/ansi-color.el
@@ -1,6 +1,6 @@
;;; ansi-color.el --- translate ANSI escape sequences into faces -*- lexical-binding: t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Alex Schroeder <alex@gnu.org>
;; Version: 3.4.2
@@ -363,7 +363,7 @@ it will override BEGIN, the start of the region. Set
(setq ansi-color-context-region (list nil (match-beginning 0)))
(setq ansi-color-context-region nil)))))
-(defun ansi-color-apply-on-region (begin end)
+(defun ansi-color-apply-on-region (begin end &optional preserve-sequences)
"Translates SGR control sequences into overlays or extents.
Delete all other control sequences without processing them.
@@ -380,18 +380,28 @@ ansi codes. This information will be used for the next call to
`ansi-color-apply-on-region'. Specifically, it will override
BEGIN, the start of the region and set the face with which to
start. Set `ansi-color-context-region' to nil if you don't want
-this."
+this.
+
+If PRESERVE-SEQUENCES is t, the sequences are hidden instead of
+being deleted."
(let ((codes (car ansi-color-context-region))
- (start-marker (or (cadr ansi-color-context-region)
- (copy-marker begin)))
- (end-marker (copy-marker end)))
+ (start-marker (or (cadr ansi-color-context-region)
+ (copy-marker begin)))
+ (end-marker (copy-marker end)))
(save-excursion
(goto-char start-marker)
;; Find the next escape sequence.
(while (re-search-forward ansi-color-control-seq-regexp end-marker t)
- ;; Remove escape sequence.
- (let ((esc-seq (delete-and-extract-region
+ ;; Extract escape sequence.
+ (let ((esc-seq (buffer-substring
(match-beginning 0) (point))))
+ (if preserve-sequences
+ ;; Make the escape sequence transparent.
+ (overlay-put (make-overlay (match-beginning 0) (point))
+ 'invisible t)
+ ;; Otherwise, strip.
+ (delete-region (match-beginning 0) (point)))
+
;; Colorize the old block from start to end using old face.
(funcall ansi-color-apply-face-function
(prog1 (marker-position start-marker)
@@ -572,27 +582,27 @@ The face definitions are based upon the variables
(index 0))
;; miscellaneous attributes
(mapc
- (function (lambda (e)
- (aset map index e)
- (setq index (1+ index)) ))
+ (lambda (e)
+ (aset map index e)
+ (setq index (1+ index)) )
ansi-color-faces-vector)
;; foreground attributes
(setq index 30)
(mapc
- (function (lambda (e)
- (aset map index
- (ansi-color-make-face 'foreground
- (if (consp e) (car e) e)))
- (setq index (1+ index)) ))
+ (lambda (e)
+ (aset map index
+ (ansi-color-make-face 'foreground
+ (if (consp e) (car e) e)))
+ (setq index (1+ index)) )
ansi-color-names-vector)
;; background attributes
(setq index 40)
(mapc
- (function (lambda (e)
- (aset map index
- (ansi-color-make-face 'background
- (if (consp e) (cdr e) e)))
- (setq index (1+ index)) ))
+ (lambda (e)
+ (aset map index
+ (ansi-color-make-face 'background
+ (if (consp e) (cdr e) e)))
+ (setq index (1+ index)) )
ansi-color-names-vector)
map))
diff --git a/lisp/apropos.el b/lisp/apropos.el
index e7e8955afe8..86cdf233be6 100644
--- a/lisp/apropos.el
+++ b/lisp/apropos.el
@@ -1,6 +1,6 @@
;;; apropos.el --- apropos commands for users and programmers -*- lexical-binding: t -*-
-;; Copyright (C) 1989, 1994-1995, 2001-2020 Free Software Foundation,
+;; Copyright (C) 1989, 1994-1995, 2001-2021 Free Software Foundation,
;; Inc.
;; Author: Joe Wells <jbw@bigbird.bu.edu>
@@ -27,8 +27,7 @@
;; The ideas for this package were derived from the C code in
;; src/keymap.c and elsewhere. The functions in this file should
-;; always be byte-compiled for speed. Someone should rewrite this in
-;; C (as part of src/keymap.c) for speed.
+;; always be byte-compiled for speed.
;; The idea for super-apropos is based on the original implementation
;; by Lynn Slater <lrs@esl.com>.
@@ -57,8 +56,6 @@
;;; Code:
-(require 'button)
-
(defgroup apropos nil
"Apropos commands for users and programmers."
:group 'help
@@ -1228,8 +1225,8 @@ as a heading."
(apropos-print-doc 6 'apropos-face t)
(apropos-print-doc 5 'apropos-widget t)
(apropos-print-doc 4 'apropos-plist nil))
- (set (make-local-variable 'truncate-partial-width-windows) t)
- (set (make-local-variable 'truncate-lines) t))))
+ (setq-local truncate-partial-width-windows t)
+ (setq-local truncate-lines t))))
(prog1 apropos-accumulator
(setq apropos-accumulator ()))) ; permit gc
diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index ce0c061fc09..6c9ceb0b5a8 100644
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -1,6 +1,6 @@
;;; arc-mode.el --- simple editing of archives -*- lexical-binding: t; -*-
-;; Copyright (C) 1995, 1997-1998, 2001-2020 Free Software Foundation,
+;; Copyright (C) 1995, 1997-1998, 2001-2021 Free Software Foundation,
;; Inc.
;; Author: Morten Welinder <terra@gnu.org>
@@ -646,7 +646,7 @@ Does not signal an error if optional argument NOERROR is non-nil."
(< no (length archive-files)))
(let ((item (aref archive-files no)))
(if (and (archive--file-desc-p item)
- (let ((mode (archive--file-desc-mode item)))
+ (let ((mode (or (archive--file-desc-mode item) 0)))
(zerop (logand 16384 mode))))
item
(if (not noerror)
@@ -1058,27 +1058,43 @@ return nil. Otherwise point is returned."
(archive-goto-file short))
next))
-(defun archive-copy-file (file new-name)
- "Copy FILE to a location specified by NEW-NAME.
-Interactively, FILE is the file at point, and the function prompts
-for NEW-NAME."
+(defun archive-copy-file (files new-name)
+ "Copy FILES to a location specified by NEW-NAME.
+FILES can be a single file or a list of files.
+
+Interactively, FILES is the list of marked files, or the file at
+point if nothing is marked, and the function prompts for
+NEW-NAME."
(interactive
- (let ((name (archive--file-desc-ext-file-name (archive-get-descr))))
- (list name
- (read-file-name (format "Copy %s to: " name)))))
- (when (file-directory-p new-name)
- (setq new-name (expand-file-name file new-name)))
- (when (and (file-exists-p new-name)
- (not (yes-or-no-p (format "%s already exists; overwrite? "
- new-name))))
- (user-error "Not overwriting %s" new-name))
- (let* ((descr (archive-get-descr))
- (archive (buffer-file-name))
- (extractor (archive-name "extract"))
- (ename (archive--file-desc-ext-file-name descr)))
- (with-temp-buffer
- (archive--extract-file extractor archive ename)
- (write-region (point-min) (point-max) new-name))))
+ (let ((names
+ (mapcar
+ #'archive--file-desc-ext-file-name
+ (or (archive-get-marked ?*) (list (archive-get-descr))))))
+ (list names
+ (read-file-name (format "Copy %s to: " (string-join names ", "))))))
+ (unless (consp files)
+ (setq files (list files)))
+ (when (and (> (length files) 1)
+ (not (file-directory-p new-name)))
+ (user-error "Can't copy a list of files to a single file"))
+ (save-excursion
+ (dolist (file files)
+ (let ((write-to (if (file-directory-p new-name)
+ (expand-file-name file new-name)
+ new-name)))
+ (when (and (file-exists-p write-to)
+ (not (yes-or-no-p (format "%s already exists; overwrite? "
+ write-to))))
+ (user-error "Not overwriting %s" write-to))
+ (archive-goto-file file)
+ (let* ((descr (archive-get-descr))
+ (archive (buffer-file-name))
+ (extractor (archive-name "extract"))
+ (ename (archive--file-desc-ext-file-name descr)))
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (archive--extract-file extractor archive ename)
+ (write-region (point-min) (point-max) write-to)))))))
(defun archive-extract (&optional other-window-p event)
"In archive mode, extract this entry of the archive into its own buffer."
@@ -2221,8 +2237,6 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
;; not the GNU nor the BSD extensions. As it turns out, this is sufficient
;; for .deb packages.
-(autoload 'tar-grind-file-mode "tar-mode")
-
(defconst archive-ar-file-header-re
"\\(.\\{16\\}\\)\\([ 0-9]\\{12\\}\\)\\([ 0-9]\\{6\\}\\)\\([ 0-9]\\{6\\}\\)\\([ 0-7]\\{8\\}\\)\\([ 0-9]\\{10\\}\\)`\n")
diff --git a/lisp/array.el b/lisp/array.el
index 0d1ac74432b..cd8971bd266 100644
--- a/lisp/array.el
+++ b/lisp/array.el
@@ -1,6 +1,6 @@
;;; array.el --- array editing commands for GNU Emacs
-;; Copyright (C) 1987, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1987, 2000-2021 Free Software Foundation, Inc.
;; Author: David M. Brown
;; Maintainer: emacs-devel@gnu.org
@@ -817,14 +817,16 @@ The variables are:
Variables you assign:
array-max-row: The number of rows in the array.
array-max-column: The number of columns in the array.
- array-columns-per-line: The number of columns in the array per line of buffer.
+ array-columns-per-line: The number of columns in the array
+ per line of buffer.
array-field-width: The width of each field, in characters.
array-rows-numbered: A logical variable describing whether to ignore
- row numbers in the buffer.
+ row numbers in the buffer.
Variables which are calculated:
array-line-length: The number of characters in a buffer line.
- array-lines-per-row: The number of buffer lines used to display each row.
+ array-lines-per-row: The number of buffer lines used to
+ display each row.
The following commands are available (an asterisk indicates it may
take a numeric prefix argument):
@@ -834,17 +836,17 @@ take a numeric prefix argument):
* \\[array-next-row] Move down one row.
* \\[array-previous-row] Move up one row.
- * \\[array-copy-forward] Copy the current field into the column to the right.
- * \\[array-copy-backward] Copy the current field into the column to the left.
- * \\[array-copy-down] Copy the current field into the row below.
- * \\[array-copy-up] Copy the current field into the row above.
+ * \\[array-copy-forward] Copy current field into the column to the right.
+ * \\[array-copy-backward] Copy current field into the column to the left.
+ * \\[array-copy-down] Copy current field into the row below.
+ * \\[array-copy-up] Copy current field into the row above.
- * \\[array-copy-column-forward] Copy the current column into the column to the right.
- * \\[array-copy-column-backward] Copy the current column into the column to the left.
+ * \\[array-copy-column-forward] Copy current column into the column to the right.
+ * \\[array-copy-column-backward] Copy current column into the column to the left.
* \\[array-copy-row-down] Copy the current row into the row below.
* \\[array-copy-row-up] Copy the current row into the row above.
- \\[array-fill-rectangle] Copy the field at mark into every cell with row and column
+ \\[array-fill-rectangle] Copy field at mark into every cell with row and column
between that of point and mark.
\\[array-what-position] Display the current array row and column.
@@ -855,7 +857,7 @@ take a numeric prefix argument):
\\[array-expand-rows] Expand the array (remove row numbers and
newlines inside rows)
- \\[array-display-local-variables] Display the current values of local variables.
+ \\[array-display-local-variables] Display current values of local variables.
Entering array mode calls the function `array-mode-hook'."
(make-local-variable 'array-buffer-line)
@@ -863,25 +865,25 @@ Entering array mode calls the function `array-mode-hook'."
(make-local-variable 'array-row)
(make-local-variable 'array-column)
(make-local-variable 'array-copy-string)
- (set (make-local-variable 'array-respect-tabs) nil)
- (set (make-local-variable 'array-max-row)
- (read-number "Number of array rows: "))
- (set (make-local-variable 'array-max-column)
- (read-number "Number of array columns: "))
- (set (make-local-variable 'array-columns-per-line)
- (read-number "Array columns per line: "))
- (set (make-local-variable 'array-field-width)
- (read-number "Field width: "))
- (set (make-local-variable 'array-rows-numbered)
- (y-or-n-p "Rows numbered? "))
- (set (make-local-variable 'array-line-length)
- (* array-field-width array-columns-per-line))
- (set (make-local-variable 'array-lines-per-row)
- (+ (floor (1- array-max-column) array-columns-per-line)
- (if array-rows-numbered 2 1)))
+ (setq-local array-respect-tabs nil)
+ (setq-local array-max-row
+ (read-number "Number of array rows: "))
+ (setq-local array-max-column
+ (read-number "Number of array columns: "))
+ (setq-local array-columns-per-line
+ (read-number "Array columns per line: "))
+ (setq-local array-field-width
+ (read-number "Field width: "))
+ (setq-local array-rows-numbered
+ (y-or-n-p "Rows numbered? "))
+ (setq-local array-line-length
+ (* array-field-width array-columns-per-line))
+ (setq-local array-lines-per-row
+ (+ (floor (1- array-max-column) array-columns-per-line)
+ (if array-rows-numbered 2 1)))
(message "")
(force-mode-line-update)
- (set (make-local-variable 'truncate-lines) t)
+ (setq-local truncate-lines t)
(setq overwrite-mode 'overwrite-mode-textual))
diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el
index ba66d0bb5df..39db1a710bd 100644
--- a/lisp/auth-source-pass.el
+++ b/lisp/auth-source-pass.el
@@ -1,6 +1,6 @@
;;; auth-source-pass.el --- Integrate auth-source with password-store -*- lexical-binding: t -*-
-;; Copyright (C) 2015, 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015, 2017-2021 Free Software Foundation, Inc.
;; Author: Damien Cassou <damien@cassou.me>,
;; Nicolas Petton <nicolas@petton.fr>
diff --git a/lisp/auth-source.el b/lisp/auth-source.el
index 50795ce7946..ad3b690dfa6 100644
--- a/lisp/auth-source.el
+++ b/lisp/auth-source.el
@@ -1,6 +1,6 @@
;;; auth-source.el --- authentication sources for Gnus and Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Ted Zlatanov <tzz@lifelogs.com>
;; Keywords: news
@@ -2408,23 +2408,51 @@ MODE can be \"login\" or \"password\"."
(list user password auth-info)))
;;; Tiny mode for editing .netrc/.authinfo modes (that basically just
-;;; hides passwords).
+;;; hides passwords and adds basic syntax highlighting).
(defcustom authinfo-hidden "password"
"Regexp matching elements in .authinfo/.netrc files that should be hidden."
:type 'regexp
:version "27.1")
+(defcustom authinfo-hide-elements t
+ "Whether to use `authinfo-hidden' to hide elements in authinfo files."
+ :type 'boolean
+ :version "28.1")
+
+(defvar authinfo--keywords
+ '(("^#.*" . font-lock-comment-face)
+ ("^\\(machine\\)[ \t]+\\([^ \t\n]+\\)"
+ (1 font-lock-variable-name-face)
+ (2 font-lock-builtin-face))
+ ("\\(login\\)[ \t]+\\([^ \t\n]+\\)"
+ (1 font-lock-comment-delimiter-face)
+ (2 font-lock-keyword-face))
+ ("\\(password\\)[ \t]+\\([^ \t\n]+\\)"
+ (1 font-lock-comment-delimiter-face)
+ (2 font-lock-doc-face))
+ ("\\(port\\)[ \t]+\\([^ \t\n]+\\)"
+ (1 font-lock-comment-delimiter-face)
+ (2 font-lock-type-face))
+ ("\\([^ \t\n]+\\)[, \t]+\\([^ \t\n]+\\)"
+ (1 font-lock-constant-face)
+ (2 nil))))
+
;;;###autoload
(define-derived-mode authinfo-mode fundamental-mode "Authinfo"
"Mode for editing .authinfo/.netrc files.
-This is just like `fundamental-mode', but hides passwords. The
-passwords are revealed when point moved into the password.
+This is just like `fundamental-mode', but has basic syntax
+highlighting and hides passwords. Passwords are revealed when
+point is moved into the passwords (see `authinfo-hide-elements').
\\{authinfo-mode-map}"
- (authinfo--hide-passwords (point-min) (point-max))
- (reveal-mode))
+ (font-lock-add-keywords nil authinfo--keywords)
+ (setq-local comment-start "#")
+ (setq-local comment-end "")
+ (when authinfo-hide-elements
+ (authinfo--hide-passwords (point-min) (point-max))
+ (reveal-mode)))
(defun authinfo--hide-passwords (start end)
(save-excursion
@@ -2436,14 +2464,15 @@ passwords are revealed when point moved into the password.
nil t)
(when (auth-source-netrc-looking-at-token)
(let ((overlay (make-overlay (match-beginning 0) (match-end 0))))
- (overlay-put overlay 'display (propertize "****"
- 'face 'warning))
+ (overlay-put overlay 'display
+ (propertize "****" 'face 'font-lock-doc-face))
(overlay-put overlay 'reveal-toggle-invisible
#'authinfo--toggle-display)))))))
(defun authinfo--toggle-display (overlay hide)
(if hide
- (overlay-put overlay 'display (propertize "****" 'face 'warning))
+ (overlay-put overlay 'display
+ (propertize "****" 'face 'font-lock-doc-face))
(overlay-put overlay 'display nil)))
(provide 'auth-source)
diff --git a/lisp/autoarg.el b/lisp/autoarg.el
index d41527775f4..c2cb0c7051c 100644
--- a/lisp/autoarg.el
+++ b/lisp/autoarg.el
@@ -1,6 +1,6 @@
;;; autoarg.el --- make digit keys supply prefix args -*- lexical-binding: t -*-
-;; Copyright (C) 1998, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2000-2021 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Created: 1998-09-04
diff --git a/lisp/autoinsert.el b/lisp/autoinsert.el
index 97986683256..0392903c332 100644
--- a/lisp/autoinsert.el
+++ b/lisp/autoinsert.el
@@ -1,6 +1,6 @@
;;; autoinsert.el --- automatic mode-dependent insertion of text into new files -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1987, 1994-1995, 1998, 2000-2020 Free Software
+;; Copyright (C) 1985-1987, 1994-1995, 1998, 2000-2021 Free Software
;; Foundation, Inc.
;; Author: Charlie Martin <crm@cs.duke.edu>
@@ -264,7 +264,7 @@ Foundation Web site at @url{https://www.gnu.org/licenses/fdl.html}.
@end quotation
The document was typeset with
-@uref{http://www.texinfo.org/, GNU Texinfo}.
+@uref{https://www.gnu.org/software/texinfo/, GNU Texinfo}.
@end copying
diff --git a/lisp/autorevert.el b/lisp/autorevert.el
index 046ea2b5d6a..1b2d68939ad 100644
--- a/lisp/autorevert.el
+++ b/lisp/autorevert.el
@@ -1,6 +1,6 @@
;;; autorevert.el --- revert buffers when files on disk change -*- lexical-binding:t -*-
-;; Copyright (C) 1997-1999, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1999, 2001-2021 Free Software Foundation, Inc.
;; Author: Anders Lindgren
;; Keywords: convenience
@@ -650,30 +650,15 @@ will use an up-to-date value of `auto-revert-interval'."
(string-match auto-revert-notify-exclude-dir-regexp
(expand-file-name default-directory))
(file-symlink-p (or buffer-file-name default-directory)))
- ;; Check, whether this has been activated already.
(let ((file (if buffer-file-name
(expand-file-name buffer-file-name default-directory)
(expand-file-name default-directory))))
- (maphash
- (lambda (key _value)
- (when (and
- (file-notify-valid-p key)
- (equal (file-notify--watch-absolute-filename
- (gethash key file-notify-descriptors))
- (directory-file-name file))
- (equal (file-notify--watch-callback
- (gethash key file-notify-descriptors))
- 'auto-revert-notify-handler))
- (setq auto-revert-notify-watch-descriptor key)))
- auto-revert--buffers-by-watch-descriptor)
- ;; Create a new watch if needed.
- (unless auto-revert-notify-watch-descriptor
- (setq auto-revert-notify-watch-descriptor
- (ignore-errors
- (file-notify-add-watch
- file
- (if buffer-file-name '(change attribute-change) '(change))
- 'auto-revert-notify-handler))))
+ (setq auto-revert-notify-watch-descriptor
+ (ignore-errors
+ (file-notify-add-watch
+ file
+ (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
@@ -682,7 +667,7 @@ will use an up-to-date value of `auto-revert-interval'."
(gethash auto-revert-notify-watch-descriptor
auto-revert--buffers-by-watch-descriptor))
auto-revert--buffers-by-watch-descriptor)
- (add-hook 'kill-buffer-hook #'auto-revert-notify-rm-watch nil t)))))
+ (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
;; immediately when a notification occurs. Since file updates can happen very
diff --git a/lisp/avoid.el b/lisp/avoid.el
index e94d5084021..b53584ba9c5 100644
--- a/lisp/avoid.el
+++ b/lisp/avoid.el
@@ -1,6 +1,6 @@
;;; avoid.el --- make mouse pointer stay out of the way of editing
-;; Copyright (C) 1993-1994, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2000-2021 Free Software Foundation, Inc.
;; Author: Boris Goldowsky <boris@gnu.org>
;; Keywords: mouse
diff --git a/lisp/battery.el b/lisp/battery.el
index e568ab52460..77ad73d15d7 100644
--- a/lisp/battery.el
+++ b/lisp/battery.el
@@ -1,6 +1,6 @@
;;; battery.el --- display battery status information -*- lexical-binding:t -*-
-;; Copyright (C) 1997-1998, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2000-2021 Free Software Foundation, Inc.
;; Author: Ralph Schleicher <rs@ralph-schleicher.de>
;; Maintainer: emacs-devel@gnu.org
@@ -661,10 +661,12 @@ Intended as a UPower PropertiesChanged signal handler."
(cond ((stringp battery-upower-device)
(list battery-upower-device))
(battery-upower-device)
- ((dbus-call-method :system battery-upower-service
- battery-upower-path
- battery-upower-interface
- "EnumerateDevices"))))
+ ((dbus-ignore-errors
+ (dbus-call-method :system battery-upower-service
+ battery-upower-path
+ battery-upower-interface
+ "EnumerateDevices"
+ :timeout 1000)))))
(defun battery--upower-state (props state)
"Merge the UPower battery state in PROPS with STATE.
diff --git a/lisp/bindings.el b/lisp/bindings.el
index 250234e94c1..187444af664 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -1,6 +1,6 @@
-;;; bindings.el --- define standard key bindings and some variables
+;;; bindings.el --- define standard key bindings and some variables -*- lexical-binding: t; -*-
-;; Copyright (C) 1985-1987, 1992-1996, 1999-2020 Free Software
+;; Copyright (C) 1985-1987, 1992-1996, 1999-2021 Free Software
;; Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
@@ -856,7 +856,7 @@ in contrast with \\[forward-char] and \\[backward-char], which
see."
(interactive "^p")
(if visual-order-cursor-movement
- (dotimes (i (if (numberp n) (abs n) 1))
+ (dotimes (_ (if (numberp n) (abs n) 1))
(move-point-visually (if (and (numberp n) (< n 0)) -1 1)))
(if (eq (current-bidi-paragraph-direction) 'left-to-right)
(forward-char n)
@@ -874,7 +874,7 @@ in contrast with \\[forward-char] and \\[backward-char], which
see."
(interactive "^p")
(if visual-order-cursor-movement
- (dotimes (i (if (numberp n) (abs n) 1))
+ (dotimes (_ (if (numberp n) (abs n) 1))
(move-point-visually (if (and (numberp n) (< n 0)) 1 -1)))
(if (eq (current-bidi-paragraph-direction) 'left-to-right)
(backward-char n)
diff --git a/lisp/bookmark.el b/lisp/bookmark.el
index ab7b04ddfee..c857c9ba7f0 100644
--- a/lisp/bookmark.el
+++ b/lisp/bookmark.el
@@ -1,6 +1,6 @@
;;; bookmark.el --- set bookmarks, maybe annotate them, jump to them later -*- lexical-binding: t -*-
-;; Copyright (C) 1993-1997, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1997, 2001-2021 Free Software Foundation, Inc.
;; Author: Karl Fogel <kfogel@red-bean.com>
;; Created: July, 1993
@@ -26,7 +26,8 @@
;; This package is for setting "bookmarks" in files. A bookmark
;; associates a string with a location in a certain file. Thus, you
;; can navigate your way to that location by providing the string.
-;; See the "User Variables" section for customizations.
+;;
+;; Type `M-x customize-group RET boomark RET' for user options.
;;; Code:
@@ -1065,8 +1066,7 @@ it to the name of the bookmark currently being set, advancing
If `bookmark-sort-flag' is non-nil, then return a sorted copy of the alist."
(if bookmark-sort-flag
(sort (copy-alist bookmark-alist)
- (function
- (lambda (x y) (string-lessp (car x) (car y)))))
+ (lambda (x y) (string-lessp (car x) (car y))))
bookmark-alist))
@@ -1484,7 +1484,32 @@ for a file, defaulting to the file defined by variable
((eq 'nospecial bookmark-version-control) version-control)
(t t))))
(condition-case nil
- (write-region (point-min) (point-max) file)
+ ;; There was a stretch of time (about 15 years) when we
+ ;; used `write-region' below instead of `write-file',
+ ;; before going back to `write-file' again. So if you're
+ ;; considering changing it to `write-region', please see
+ ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=12507.
+ ;; That bug tells the story of how we first started using
+ ;; `write-region' in 2005...
+ ;;
+ ;; commit a506054af7cd86a63fda996056c09310966f32ef
+ ;; Author: Karl Fogel <kfogel@red-bean.com>
+ ;; AuthorDate: Sat Nov 12 20:30:22 2005 +0000
+ ;;
+ ;; (bookmark-write-file): Don't visit the
+ ;; destination file, just write the data to it
+ ;; using write-region. This is similar to
+ ;; 2005-05-29T08:36:26Z!rms@gnu.org of saveplace.el,
+ ;; but with an additional change to avoid visiting
+ ;; the file in the first place.
+ ;;
+ ;; ...and of how further inquiry led us to investigate (in
+ ;; 2012 and then again in 2020) and eventually decide that
+ ;; matching the saveplace.el change doesn't make sense for
+ ;; bookmark.el. Therefore we reverted to `write-file',
+ ;; which means numbered backups may now be created,
+ ;; depending on `bookmark-version-control' as per above.
+ (write-file file)
(file-error (message "Can't write %s" file)))
(setq bookmark-file-coding-system coding-system-for-write)
(kill-buffer (current-buffer))
diff --git a/lisp/bs.el b/lisp/bs.el
index 337d22ecf83..9ed0ee5f0ae 100644
--- a/lisp/bs.el
+++ b/lisp/bs.el
@@ -1,6 +1,6 @@
;;; bs.el --- menu for selecting and displaying buffers -*- lexical-binding: t -*-
-;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: Olaf Sylvester <Olaf.Sylvester@netsurf.de>
;; Maintainer: emacs-devel@gnu.org
;; Keywords: convenience
diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el
index d06ba287879..49f8604f52e 100644
--- a/lisp/buff-menu.el
+++ b/lisp/buff-menu.el
@@ -1,6 +1,6 @@
;;; buff-menu.el --- Interface for viewing and manipulating buffers -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1987, 1993-1995, 2000-2020 Free Software
+;; Copyright (C) 1985-1987, 1993-1995, 2000-2021 Free Software
;; Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
@@ -269,8 +269,8 @@ In Buffer Menu mode, the following commands are defined:
\\[revert-buffer] Update the list of buffers.
\\[Buffer-menu-toggle-files-only] Toggle whether the menu displays only file buffers.
\\[Buffer-menu-bury] Bury the buffer listed on this line."
- (set (make-local-variable 'buffer-stale-function)
- (lambda (&optional _noconfirm) 'fast))
+ (setq-local buffer-stale-function
+ (lambda (&optional _noconfirm) 'fast))
(add-hook 'tabulated-list-revert-hook 'list-buffers--refresh nil t))
(defun buffer-menu (&optional arg)
diff --git a/lisp/button.el b/lisp/button.el
index ba0682348df..043de8eeb7b 100644
--- a/lisp/button.el
+++ b/lisp/button.el
@@ -1,6 +1,6 @@
;;; button.el --- clickable buttons -*- lexical-binding: t -*-
;;
-;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;;
;; Author: Miles Bader <miles@gnu.org>
;; Keywords: extensions, hypermedia
@@ -613,6 +613,20 @@ button at point is the button to describe."
(button--describe props)
t)))
+(defun button-buttonize (string callback &optional data)
+ "Make STRING into a button and return it.
+When clicked, CALLBACK will be called with the DATA as the
+function argument. If DATA isn't present (or is nil), the button
+itself will be used instead as the function argument."
+ (propertize string
+ 'face 'button
+ 'button t
+ 'follow-link t
+ 'category t
+ 'button-data data
+ 'keymap button-map
+ 'action callback))
+
(provide 'button)
;;; button.el ends here
diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el
index 6c162b55f7b..1e31c3cadc0 100644
--- a/lisp/calc/calc-aent.el
+++ b/lisp/calc/calc-aent.el
@@ -1,6 +1,6 @@
;;; calc-aent.el --- algebraic entry functions for Calc -*- lexical-binding:t -*-
-;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2021 Free Software Foundation, Inc.
;; Author: Dave Gillespie <daveg@synaptics.com>
@@ -76,8 +76,8 @@
(calc-refresh-evaltos (nth 2 (nth 1 (car alg-exp))))
(setq alg-exp (list (nth 2 (car alg-exp)))))
(setq calc-quick-prev-results alg-exp
- buf (mapconcat (function (lambda (x)
- (math-format-value x 1000)))
+ buf (mapconcat (lambda (x)
+ (math-format-value x 1000))
alg-exp
" ")
shortbuf buf)
@@ -197,18 +197,17 @@
(calc-language (if (memq calc-language '(nil big))
'flat calc-language))
(calc-dollar-values (mapcar
- (function
- (lambda (x)
- (if (stringp x)
- (progn
- (setq x (math-read-exprs x))
- (if (eq (car-safe x)
- 'error)
- (throw 'calc-error
- (calc-eval-error
- (cdr x)))
- (car x)))
- x)))
+ (lambda (x)
+ (if (stringp x)
+ (progn
+ (setq x (math-read-exprs x))
+ (if (eq (car-safe x)
+ 'error)
+ (throw 'calc-error
+ (calc-eval-error
+ (cdr x)))
+ (car x)))
+ x))
args))
(calc-dollar-used 0)
(res (if (stringp str)
@@ -640,10 +639,10 @@ in Calc algebraic input.")
(math-find-user-tokens (car (car p)))
(setq p (cdr p)))
(setq calc-user-tokens (mapconcat 'identity
- (sort (mapcar 'car math-toks)
- (function (lambda (x y)
- (> (length x)
- (length y)))))
+ (sort (mapcar #'car math-toks)
+ (lambda (x y)
+ (> (length x)
+ (length y))))
"\\|")
calc-last-main-parse-table mtab
calc-last-user-lang-parse-table ltab
diff --git a/lisp/calc/calc-alg.el b/lisp/calc/calc-alg.el
index efb68395f7e..1327cf0a39b 100644
--- a/lisp/calc/calc-alg.el
+++ b/lisp/calc/calc-alg.el
@@ -1,6 +1,6 @@
;;; calc-alg.el --- algebraic functions for Calc -*- lexical-binding:t -*-
-;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2021 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
@@ -1785,7 +1785,7 @@ and should return the simplified expression to use (or nil)."
(cons (nth 2 expr) math-poly-neg-powers))))
(not (Math-zerop (nth 2 expr)))
(let ((p1 (math-is-poly-rec (nth 1 expr) negpow)))
- (mapcar (function (lambda (x) (math-div x (nth 2 expr))))
+ (mapcar (lambda (x) (math-div x (nth 2 expr)))
p1))))
((and (eq (car expr) 'calcFunc-exp)
(equal math-var '(var e var-e)))
@@ -1838,8 +1838,9 @@ and should return the simplified expression to use (or nil)."
(defun math-polynomial-base (top-expr &optional pred)
"Find the variable (or sub-expression) which is the base of polynomial expr."
(let ((math-poly-base-pred
- (or pred (function (lambda (base) (math-polynomial-p
- top-expr base))))))
+ (or pred (lambda (base)
+ (math-polynomial-p
+ top-expr base)))))
(or (let ((math-poly-base-const-ok nil))
(math-polynomial-base-rec top-expr))
(let ((math-poly-base-const-ok t))
diff --git a/lisp/calc/calc-arith.el b/lisp/calc/calc-arith.el
index ae397c4f2c4..9787fe0d609 100644
--- a/lisp/calc/calc-arith.el
+++ b/lisp/calc/calc-arith.el
@@ -1,6 +1,6 @@
;;; calc-arith.el --- arithmetic functions for Calc -*- lexical-binding:t -*-
-;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2021 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
@@ -2390,7 +2390,7 @@
(math-trunc (nth 3 a)))))
((math-provably-integerp a) a)
((Math-vectorp a)
- (math-map-vec (function (lambda (x) (math-trunc x math-trunc-prec))) a))
+ (math-map-vec (lambda (x) (math-trunc x math-trunc-prec)) a))
((math-infinitep a)
(if (or (math-posp a) (math-negp a))
a
@@ -2453,7 +2453,7 @@
(math-add (math-floor (nth 3 a)) -1)
(math-floor (nth 3 a)))))
((Math-vectorp a)
- (math-map-vec (function (lambda (x) (math-floor x math-floor-prec))) a))
+ (math-map-vec (lambda (x) (math-floor x math-floor-prec)) a))
((math-infinitep a)
(if (or (math-posp a) (math-negp a))
a
@@ -2520,7 +2520,7 @@
(math-ceiling (nth 2 a)))
(math-ceiling (nth 3 a))))
((Math-vectorp a)
- (math-map-vec (function (lambda (x) (math-ceiling x prec))) a))
+ (math-map-vec (lambda (x) (math-ceiling x prec)) a))
((math-infinitep a)
(if (or (math-posp a) (math-negp a))
a
@@ -2573,7 +2573,7 @@
((eq (car a) 'intv)
(math-floor (math-add a '(frac 1 2))))
((Math-vectorp a)
- (math-map-vec (function (lambda (x) (math-round x prec))) a))
+ (math-map-vec (lambda (x) (math-round x prec)) a))
((math-infinitep a)
(if (or (math-posp a) (math-negp a))
a
@@ -2656,7 +2656,7 @@
(calcFunc-scf (nth 2 x) n)
(calcFunc-scf (nth 3 x) n))))
((eq (car x) 'vec)
- (math-map-vec (function (lambda (x) (calcFunc-scf x n))) x))
+ (math-map-vec (lambda (x) (calcFunc-scf x n)) x))
((math-infinitep x)
x)
(t
diff --git a/lisp/calc/calc-bin.el b/lisp/calc/calc-bin.el
index 60dd17e5ed2..503ed777029 100644
--- a/lisp/calc/calc-bin.el
+++ b/lisp/calc/calc-bin.el
@@ -1,6 +1,6 @@
;;; calc-bin.el --- binary functions for Calc -*- lexical-binding:t -*-
-;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2021 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
@@ -199,48 +199,16 @@
(message "Omitting leading zeros on integers"))))
-(defvar math-power-of-2-cache (list 1 2 4 8 16 32 64 128 256 512 1024))
-(defvar math-big-power-of-2-cache nil)
(defun math-power-of-2 (n) ; [I I] [Public]
- (if (and (natnump n) (<= n 100))
- (or (nth n math-power-of-2-cache)
- (let* ((i (length math-power-of-2-cache))
- (val (nth (1- i) math-power-of-2-cache)))
- (while (<= i n)
- (setq val (math-mul val 2)
- math-power-of-2-cache (nconc math-power-of-2-cache
- (list val))
- i (1+ i)))
- val))
- (let ((found (assq n math-big-power-of-2-cache)))
- (if found
- (cdr found)
- (let ((po2 (math-ipow 2 n)))
- (setq math-big-power-of-2-cache
- (cons (cons n po2) math-big-power-of-2-cache))
- po2)))))
+ (if (natnump n)
+ (ash 1 n)
+ (error "argument must be a natural number")))
(defun math-integer-log2 (n) ; [I I] [Public]
- (let ((i 0)
- (p math-power-of-2-cache)
- val)
- (while (and p (Math-natnum-lessp (setq val (car p)) n))
- (setq p (cdr p)
- i (1+ i)))
- (if p
- (and (equal val n)
- i)
- (while (Math-natnum-lessp
- (prog1
- (setq val (math-mul val 2))
- (setq math-power-of-2-cache (nconc math-power-of-2-cache
- (list val))))
- n)
- (setq i (1+ i)))
- (and (equal val n)
- i))))
-
-
+ (and (natnump n)
+ (not (zerop n))
+ (zerop (logand n (1- n)))
+ (logb n)))
;;; Bitwise operations.
@@ -404,7 +372,7 @@
(math-clip (calcFunc-ash a n (- w)) w)
(if (Math-integer-negp a)
(setq a (math-clip a w)))
- (let ((two-to-sizem1 (math-power-of-2 (1- w)))
+ (let ((two-to-sizem1 (and (not (zerop w)) (math-power-of-2 (1- w))))
(sh (calcFunc-lsh a n w)))
(cond ((or (zerop w)
(zerop (logand a two-to-sizem1)))
@@ -438,7 +406,7 @@
(if (Math-integer-negp a)
(setq a (math-clip a w)))
(cond ((or (Math-integer-negp n)
- (not (Math-natnum-lessp n w)))
+ (>= n w))
(calcFunc-rot a (math-mod n w) w))
(t
(math-add (calcFunc-lsh a (- n w) w)
@@ -455,7 +423,7 @@
(math-reject-arg a 'integerp))
((< (or w (setq w calc-word-size)) 0)
(setq a (math-clip a (- w)))
- (if (Math-natnum-lessp a (math-power-of-2 (- -1 w)))
+ (if (< a (math-power-of-2 (- -1 w)))
a
(math-sub a (math-power-of-2 (- w)))))
((math-zerop w)
diff --git a/lisp/calc/calc-comb.el b/lisp/calc/calc-comb.el
index 5aeb8cba0df..dc952213507 100644
--- a/lisp/calc/calc-comb.el
+++ b/lisp/calc/calc-comb.el
@@ -1,6 +1,6 @@
;;; calc-comb.el --- combinatoric functions for Calc -*- lexical-binding:t -*-
-;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2021 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
@@ -815,7 +815,7 @@
(error "Argument must be an integer"))
((Math-integer-negp n)
'(nil))
- ((Math-natnum-lessp n 8000000)
+ ((< n 8000000)
(let ((i -1) v)
(while (and (> (% n (setq v (aref math-primes-table
(setq i (1+ i)))))
@@ -913,7 +913,7 @@
(if (Math-messy-integerp n)
(setq n (math-trunc n)))
(if (Math-natnump n)
- (if (Math-natnum-lessp 2 n)
+ (if (< 2 n)
(let (factors res p (i 0))
(while (and (not (eq n 1))
(< i (length math-primes-table)))
@@ -927,7 +927,7 @@
(setq factors (nconc factors (list p))
n (car res)))
(or (eq n 1)
- (Math-natnum-lessp p (car res))
+ (< p (car res))
(setq factors (nconc factors (list n))
n 1))
(setq i (1+ i)))
@@ -946,7 +946,7 @@
(if (Math-messy-integerp n)
(setq n (math-trunc n)))
(if (Math-natnump n)
- (if (Math-natnum-lessp n 2)
+ (if (< n 2)
(if (Math-negp n)
(calcFunc-totient (math-abs n))
n)
@@ -969,7 +969,7 @@
(if (Math-messy-integerp n)
(setq n (math-trunc n)))
(if (and (Math-natnump n) (not (eq n 0)))
- (if (Math-natnum-lessp n 2)
+ (if (< n 2)
(if (Math-negp n)
(calcFunc-moebius (math-abs n))
1)
diff --git a/lisp/calc/calc-cplx.el b/lisp/calc/calc-cplx.el
index 7438f63a90d..03462020ea2 100644
--- a/lisp/calc/calc-cplx.el
+++ b/lisp/calc/calc-cplx.el
@@ -1,6 +1,6 @@
;;; calc-cplx.el --- Complex number functions for Calc -*- lexical-binding:t -*-
-;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2021 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
diff --git a/lisp/calc/calc-embed.el b/lisp/calc/calc-embed.el
index f9c5281c263..fda0b4bbedb 100644
--- a/lisp/calc/calc-embed.el
+++ b/lisp/calc/calc-embed.el
@@ -1,6 +1,6 @@
;;; calc-embed.el --- embed Calc in a buffer -*- lexical-binding:t -*-
-;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2021 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
@@ -396,7 +396,7 @@
(calc-wrapper
(setq str (math-showing-full-precision
(math-format-nice-expr (aref info 8) (frame-width))))
- (calc-edit-mode (list 'calc-embedded-finish-edit info))
+ (calc--edit-mode (lambda () (calc-embedded-finish-edit info)))
(insert str "\n")))
(calc-show-edit-buffer)))
@@ -651,6 +651,8 @@ The command \\[yank] can retrieve it from there."
(defvar calc-embed-prev-modes)
(defun calc-embedded-set-modes (gmodes modes local-modes &optional temp)
+ (defvar the-language)
+ (defvar the-display-just)
(let ((the-language (calc-embedded-language))
(the-display-just (calc-embedded-justify))
(v gmodes)
diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el
index 23248ce1bd5..f4ddb840b50 100644
--- a/lisp/calc/calc-ext.el
+++ b/lisp/calc/calc-ext.el
@@ -1,6 +1,6 @@
;;; calc-ext.el --- various extension functions for Calc -*- lexical-binding:t -*-
-;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2021 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
@@ -678,14 +678,13 @@
(calc-init-prefixes)
- (mapc (function
- (lambda (x)
+ (mapc (lambda (x)
(define-key calc-mode-map (format "c%c" x) 'calc-clean-num)
(define-key calc-mode-map (format "j%c" x) 'calc-select-part)
(define-key calc-mode-map (format "r%c" x) 'calc-recall-quick)
(define-key calc-mode-map (format "s%c" x) 'calc-store-quick)
(define-key calc-mode-map (format "t%c" x) 'calc-store-into-quick)
- (define-key calc-mode-map (format "u%c" x) 'calc-quick-units)))
+ (define-key calc-mode-map (format "u%c" x) 'calc-quick-units))
"0123456789")
(let ((i ?A))
@@ -711,9 +710,9 @@
(define-key calc-alg-map "\e\177" 'calc-pop-above)
;;;; (Autoloads here)
- (mapc (function (lambda (x)
- (mapcar (function (lambda (func) (autoload func (car x))))
- (cdr x))))
+ (mapc (lambda (x)
+ (mapcar (lambda (func) (autoload func (car x)))
+ (cdr x)))
'(
("calc-alg" calc-has-rules math-defsimplify
@@ -980,9 +979,9 @@ calc-force-refresh calc-locate-cursor-element calc-show-edit-buffer)
))
- (mapcar (function (lambda (x)
- (mapcar (function (lambda (cmd) (autoload cmd (car x) nil t)))
- (cdr x))))
+ (mapcar (lambda (x)
+ (mapcar (lambda (cmd) (autoload cmd (car x) nil t))
+ (cdr x)))
'(
("calc-alg" calc-alg-evaluate calc-apart calc-collect calc-expand
@@ -1196,7 +1195,7 @@ calc-set-xor calc-sort calc-subvector calc-tail calc-transpose
calc-unpack calc-unpack-bits calc-vector-find calc-vlength)
("calc-yank" calc-copy-as-kill calc-copy-region-as-kill
-calc-copy-to-buffer calc-edit calc-edit-cancel calc-edit-mode
+calc-copy-to-buffer calc-edit calc-edit-cancel calc--edit-mode
calc-kill calc-kill-region calc-yank))))
(defun calc-init-prefixes ()
@@ -1358,7 +1357,7 @@ calc-kill calc-kill-region calc-yank))))
calc-redo-list nil)
(let (calc-stack calc-user-parse-tables calc-standard-date-formats
calc-invocation-macro)
- (mapc (function (lambda (v) (set v nil))) calc-local-var-list)
+ (mapc (lambda (v) (set v nil)) calc-local-var-list)
(if (and arg (<= arg 0))
(calc-mode-var-list-restore-default-values)
(calc-mode-var-list-restore-saved-values)))
@@ -1658,7 +1657,7 @@ calc-kill calc-kill-region calc-yank))))
(calc-pop-stack n 1 t)
(calc-push-list (mapcar #'car entries)
1
- (mapcar (function (lambda (x) (nth 2 x)))
+ (mapcar (lambda (x) (nth 2 x))
entries)))))))
(defvar calc-refreshing-evaltos nil)
@@ -1924,11 +1923,10 @@ calc-kill calc-kill-region calc-yank))))
(let* ((calc-z-prefix-msgs nil)
(calc-z-prefix-buf "")
(kmap (sort (copy-sequence (calc-user-key-map))
- (function (lambda (x y) (< (car x) (car y))))))
+ (lambda (x y) (< (car x) (car y)))))
(flags (apply #'logior
- (mapcar (function
- (lambda (k)
- (calc-user-function-classify (car k))))
+ (mapcar (lambda (k)
+ (calc-user-function-classify (car k)))
kmap))))
(if (= (logand flags 8) 0)
(calc-user-function-list kmap 7)
@@ -2419,17 +2417,6 @@ If X is not an error form, return 1."
(mapcar #'math-normalize (cdr a))))))
-;;; Normalize a bignum digit list by trimming high-end zeros. [L l]
-(defun math-norm-bignum (a)
- (let ((digs a) (last nil))
- (while digs
- (or (eq (car digs) 0) (setq last digs))
- (setq digs (cdr digs)))
- (and last
- (progn
- (setcdr last nil)
- a))))
-
;;; Return 0 for zero, -1 for negative, 1 for positive. [S n] [Public]
(defun calcFunc-sign (a &optional x)
(let ((signs (math-possible-signs a)))
@@ -2544,23 +2531,6 @@ If X is not an error form, return 1."
0
2))))
-;;; Compare two bignum digit lists, return -1 for A<B, 0 for A=B, 1 for A>B.
-(defun math-compare-bignum (a b) ; [S l l]
- (let ((res 0))
- (while (and a b)
- (if (< (car a) (car b))
- (setq res -1)
- (if (> (car a) (car b))
- (setq res 1)))
- (setq a (cdr a)
- b (cdr b)))
- (if a
- (progn
- (while (eq (car a) 0) (setq a (cdr a)))
- (if a 1 res))
- (while (eq (car b) 0) (setq b (cdr b)))
- (if b -1 res))))
-
(defun math-compare-lists (a b)
(cond ((null a) (null b))
((null b) nil)
@@ -2633,9 +2603,8 @@ If X is not an error form, return 1."
(let ((rhs (calc-top-n 1)))
(calc-enter-result (- 1 n)
name
- (mapcar (function
- (lambda (x)
- (list func x rhs)))
+ (mapcar (lambda (x)
+ (list func x rhs))
(calc-top-list-n (- n) 2))))))))
(defun calc-unary-op-fancy (name func arg)
@@ -2644,9 +2613,8 @@ If X is not an error form, return 1."
(cond ((> n 0)
(calc-enter-result n
name
- (mapcar (function
- (lambda (x)
- (list func x)))
+ (mapcar (lambda (x)
+ (list func x))
(calc-top-list-n n))))
((< n 0)
(calc-enter-result 1
@@ -2689,7 +2657,7 @@ If X is not an error form, return 1."
(if (Math-integer-negp a) (setq a (math-neg a)))
(if (Math-integer-negp b) (setq b (math-neg b)))
(let (c)
- (if (Math-natnum-lessp a b)
+ (if (< a b)
(setq c b b a a c))
(while (and (consp a) (not (eq b 0)))
(setq c b
diff --git a/lisp/calc/calc-fin.el b/lisp/calc/calc-fin.el
index ea1ef24bb19..76bb53e7b10 100644
--- a/lisp/calc/calc-fin.el
+++ b/lisp/calc/calc-fin.el
@@ -1,6 +1,6 @@
;;; calc-fin.el --- financial functions for Calc -*- lexical-binding:t -*-
-;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2021 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
diff --git a/lisp/calc/calc-forms.el b/lisp/calc/calc-forms.el
index 465d4520b05..ee53b94cd64 100644
--- a/lisp/calc/calc-forms.el
+++ b/lisp/calc/calc-forms.el
@@ -1,6 +1,6 @@
;;; calc-forms.el --- data format conversion functions for Calc -*- lexical-binding:t -*-
-;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2021 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
@@ -2129,7 +2129,7 @@ and ends on the last Sunday of October at 2 a.m."
((memq (car n) '(+ - / vec neg))
(math-normalize
(cons (car n)
- (mapcar (function (lambda (x) (math-make-mod x m)))
+ (mapcar (lambda (x) (math-make-mod x m))
(cdr n)))))
((and (eq (car n) '*) (Math-anglep (nth 1 n)))
(math-mul (math-make-mod (nth 1 n) m) (nth 2 n)))
diff --git a/lisp/calc/calc-frac.el b/lisp/calc/calc-frac.el
index 86a4808c5ad..bf3c16816db 100644
--- a/lisp/calc/calc-frac.el
+++ b/lisp/calc/calc-frac.el
@@ -1,6 +1,6 @@
;;; calc-frac.el --- fraction functions for Calc -*- lexical-binding:t -*-
-;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2021 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
@@ -132,9 +132,8 @@
(cond ((Math-ratp a)
a)
((memq (car a) '(cplx polar vec hms date sdev intv mod))
- (cons (car a) (mapcar (function
- (lambda (x)
- (calcFunc-frac x tol)))
+ (cons (car a) (mapcar (lambda (x)
+ (calcFunc-frac x tol))
(cdr a))))
((Math-messy-integerp a)
(math-trunc a))
diff --git a/lisp/calc/calc-funcs.el b/lisp/calc/calc-funcs.el
index 5c179ff05d4..053fa2e5851 100644
--- a/lisp/calc/calc-funcs.el
+++ b/lisp/calc/calc-funcs.el
@@ -1,6 +1,6 @@
;;; calc-funcs.el --- well-known functions for Calc -*- lexical-binding:t -*-
-;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2021 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
@@ -410,7 +410,7 @@
((and (math-num-integerp b)
(if (math-negp b)
(math-reject-arg b 'range)
- (Math-natnum-lessp (setq b (math-trunc b)) 20)))
+ (< (setq b (math-trunc b)) 20)))
(and calc-symbolic-mode (or (math-floatp a) (math-floatp b))
(math-inexact-result))
(math-mul
@@ -427,7 +427,7 @@
((and (math-num-integerp a)
(if (math-negp a)
(math-reject-arg a 'range)
- (Math-natnum-lessp (setq a (math-trunc a)) 20)))
+ (< (setq a (math-trunc a)) 20)))
(math-sub (or math-current-beta-value (calcFunc-beta a b))
(calcFunc-betaB (math-sub 1 x) b a)))
(t
@@ -797,12 +797,11 @@
(math-reduce-vec
'math-add
(cons 'vec
- (mapcar (function
- (lambda (c)
- (setq k (1+ k))
- (math-mul (math-mul fac c)
- (math-sub (math-pow x1 k)
- (math-pow x2 k)))))
+ (mapcar (lambda (c)
+ (setq k (1+ k))
+ (math-mul (math-mul fac c)
+ (math-sub (math-pow x1 k)
+ (math-pow x2 k))))
coefs)))
x)))
(math-mul (math-pow 2 n)
diff --git a/lisp/calc/calc-graph.el b/lisp/calc/calc-graph.el
index 829fa44ca4f..4785fb7fba2 100644
--- a/lisp/calc/calc-graph.el
+++ b/lisp/calc/calc-graph.el
@@ -1,6 +1,6 @@
;;; calc-graph.el --- graph output functions for Calc -*- lexical-binding:t -*-
-;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2021 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
@@ -351,7 +351,7 @@
(if (>= ver 3)
(insert "set surface\nset nocontour\n"
"set " (if calc-graph-is-splot "" "no") "parametric\n"
- "set notime\nset border\nset ztics\nset zeroaxis\n"
+ "set notimestamp\nset border\nset ztics\nset zeroaxis\n"
"set view 60,30,1,1\nset offsets 0,0,0,0\n"))
(setq samples-pos (point))
(insert "\n\n" str))
diff --git a/lisp/calc/calc-help.el b/lisp/calc/calc-help.el
index 0b327e8d0f6..dd5063f27d5 100644
--- a/lisp/calc/calc-help.el
+++ b/lisp/calc/calc-help.el
@@ -1,6 +1,6 @@
;;; calc-help.el --- help display functions for Calc -*- lexical-binding:t -*-
-;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2021 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
@@ -402,32 +402,32 @@ C-w Describe how there is no warranty for Calc."
"Or type `h i' to read the full Calc manual on-line.\n\n"))
(princ "Basic keys:\n")
(let* ((calc-full-help-flag t))
- (mapc (function (lambda (x) (princ (format
- " %s\n"
- (substitute-command-keys x)))))
+ (mapc (lambda (x)
+ (princ (format
+ " %s\n"
+ (substitute-command-keys x))))
(nreverse (cdr (reverse (cdr (calc-help))))))
- (mapc (function (lambda (prefix)
- (let ((msgs (ignore-errors (funcall prefix))))
- (if (car msgs)
- (princ
- (if (eq (nth 2 msgs) ?v)
- (format-message
- "\n`v' or `V' prefix (vector/matrix) keys: \n")
- (if (nth 2 msgs)
- (format-message
- "\n`%c' prefix (%s) keys:\n"
- (nth 2 msgs)
- (or (cdr (assq (nth 2 msgs)
- calc-help-long-names))
- (nth 1 msgs)))
- (format "\n%s-modified keys:\n"
- (capitalize (nth 1 msgs)))))))
- (mapcar (function
- (lambda (x)
- (princ (format
- " %s\n"
- (substitute-command-keys x)))))
- (car msgs)))))
+ (mapc (lambda (prefix)
+ (let ((msgs (ignore-errors (funcall prefix))))
+ (if (car msgs)
+ (princ
+ (if (eq (nth 2 msgs) ?v)
+ (format-message
+ "\n`v' or `V' prefix (vector/matrix) keys: \n")
+ (if (nth 2 msgs)
+ (format-message
+ "\n`%c' prefix (%s) keys:\n"
+ (nth 2 msgs)
+ (or (cdr (assq (nth 2 msgs)
+ calc-help-long-names))
+ (nth 1 msgs)))
+ (format "\n%s-modified keys:\n"
+ (capitalize (nth 1 msgs)))))))
+ (mapcar (lambda (x)
+ (princ (format
+ " %s\n"
+ (substitute-command-keys x))))
+ (car msgs))))
'(calc-inverse-prefix-help
calc-hyperbolic-prefix-help
calc-inv-hyp-prefix-help
diff --git a/lisp/calc/calc-incom.el b/lisp/calc/calc-incom.el
index 2c7a4f0561e..e27d65092eb 100644
--- a/lisp/calc/calc-incom.el
+++ b/lisp/calc/calc-incom.el
@@ -1,6 +1,6 @@
;;; calc-incom.el --- complex data type input functions for Calc -*- lexical-binding:t -*-
-;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2021 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
diff --git a/lisp/calc/calc-keypd.el b/lisp/calc/calc-keypd.el
index 47917dcac7e..1902a4f3f29 100644
--- a/lisp/calc/calc-keypd.el
+++ b/lisp/calc/calc-keypd.el
@@ -1,6 +1,6 @@
;;; calc-keypd.el --- mouse-capable keypad input for Calc -*- lexical-binding:t -*-
-;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2021 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
diff --git a/lisp/calc/calc-lang.el b/lisp/calc/calc-lang.el
index bde5abe649f..0117f449dd5 100644
--- a/lisp/calc/calc-lang.el
+++ b/lisp/calc/calc-lang.el
@@ -1,6 +1,6 @@
;;; calc-lang.el --- calc language functions -*- lexical-binding:t -*-
-;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2021 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
@@ -175,20 +175,19 @@
(put 'c 'math-vector-brackets "{}")
(put 'c 'math-radix-formatter
- (function (lambda (r s)
- (if (= r 16) (format "0x%s" s)
- (if (= r 8) (format "0%s" s)
- (format "%d#%s" r s))))))
+ (lambda (r s)
+ (if (= r 16) (format "0x%s" s)
+ (if (= r 8) (format "0%s" s)
+ (format "%d#%s" r s)))))
(put 'c 'math-compose-subscr
- (function
- (lambda (a)
- (let ((args (cdr (cdr a))))
- (list 'horiz
- (math-compose-expr (nth 1 a) 1000)
- "["
- (math-compose-vector args ", " 0)
- "]")))))
+ (lambda (a)
+ (let ((args (cdr (cdr a))))
+ (list 'horiz
+ (math-compose-expr (nth 1 a) 1000)
+ "["
+ (math-compose-vector args ", " 0)
+ "]"))))
(add-to-list 'calc-lang-slash-idiv 'c)
(add-to-list 'calc-lang-allow-underscores 'c)
@@ -238,9 +237,9 @@
(put 'pascal 'math-output-filter 'calc-output-case-filter)
(put 'pascal 'math-radix-formatter
- (function (lambda (r s)
- (if (= r 16) (format "$%s" s)
- (format "%d#%s" r s)))))
+ (lambda (r s)
+ (if (= r 16) (format "$%s" s)
+ (format "%d#%s" r s))))
(put 'pascal 'math-lang-read-symbol
'((?\$
@@ -253,17 +252,16 @@
math-exp-pos (match-end 1)))))
(put 'pascal 'math-compose-subscr
- (function
- (lambda (a)
- (let ((args (cdr (cdr a))))
- (while (eq (car-safe (nth 1 a)) 'calcFunc-subscr)
- (setq args (append (cdr (cdr (nth 1 a))) args)
- a (nth 1 a)))
- (list 'horiz
- (math-compose-expr (nth 1 a) 1000)
- "["
- (math-compose-vector args ", " 0)
- "]")))))
+ (lambda (a)
+ (let ((args (cdr (cdr a))))
+ (while (eq (car-safe (nth 1 a)) 'calcFunc-subscr)
+ (setq args (append (cdr (cdr (nth 1 a))) args)
+ a (nth 1 a)))
+ (list 'horiz
+ (math-compose-expr (nth 1 a) 1000)
+ "["
+ (math-compose-vector args ", " 0)
+ "]"))))
(add-to-list 'calc-lang-allow-underscores 'pascal)
(add-to-list 'calc-lang-brackets-are-subscripts 'pascal)
@@ -350,17 +348,16 @@
math-exp-pos (match-end 0)))))
(put 'fortran 'math-compose-subscr
- (function
- (lambda (a)
- (let ((args (cdr (cdr a))))
- (while (eq (car-safe (nth 1 a)) 'calcFunc-subscr)
- (setq args (append (cdr (cdr (nth 1 a))) args)
- a (nth 1 a)))
- (list 'horiz
- (math-compose-expr (nth 1 a) 1000)
- "("
- (math-compose-vector args ", " 0)
- ")")))))
+ (lambda (a)
+ (let ((args (cdr (cdr a))))
+ (while (eq (car-safe (nth 1 a)) 'calcFunc-subscr)
+ (setq args (append (cdr (cdr (nth 1 a))) args)
+ a (nth 1 a)))
+ (list 'horiz
+ (math-compose-expr (nth 1 a) 1000)
+ "("
+ (math-compose-vector args ", " 0)
+ ")"))))
(add-to-list 'calc-lang-slash-idiv 'fortran)
(add-to-list 'calc-lang-allow-underscores 'fortran)
@@ -598,18 +595,17 @@
(put 'tex 'math-input-filter 'math-tex-input-filter)
(put 'tex 'math-matrix-formatter
- (function
- (lambda (a)
- (if (and (integerp calc-language-option)
- (or (= calc-language-option 0)
- (> calc-language-option 1)
- (< calc-language-option -1)))
- (append '(vleft 0 "\\matrix{")
- (math-compose-tex-matrix (cdr a))
- '("}"))
- (append '(horiz "\\matrix{ ")
- (math-compose-tex-matrix (cdr a))
- '(" }"))))))
+ (lambda (a)
+ (if (and (integerp calc-language-option)
+ (or (= calc-language-option 0)
+ (> calc-language-option 1)
+ (< calc-language-option -1)))
+ (append '(vleft 0 "\\matrix{")
+ (math-compose-tex-matrix (cdr a))
+ '("}"))
+ (append '(horiz "\\matrix{ ")
+ (math-compose-tex-matrix (cdr a))
+ '(" }")))))
(put 'tex 'math-var-formatter 'math-compose-tex-var)
@@ -839,18 +835,17 @@
(put 'latex 'math-complex-format 'i)
(put 'latex 'math-matrix-formatter
- (function
- (lambda (a)
- (if (and (integerp calc-language-option)
- (or (= calc-language-option 0)
- (> calc-language-option 1)
- (< calc-language-option -1)))
- (append '(vleft 0 "\\begin{pmatrix}")
- (math-compose-tex-matrix (cdr a) t)
- '("\\end{pmatrix}"))
- (append '(horiz "\\begin{pmatrix} ")
- (math-compose-tex-matrix (cdr a) t)
- '(" \\end{pmatrix}"))))))
+ (lambda (a)
+ (if (and (integerp calc-language-option)
+ (or (= calc-language-option 0)
+ (> calc-language-option 1)
+ (< calc-language-option -1)))
+ (append '(vleft 0 "\\begin{pmatrix}")
+ (math-compose-tex-matrix (cdr a) t)
+ '("\\end{pmatrix}"))
+ (append '(horiz "\\begin{pmatrix} ")
+ (math-compose-tex-matrix (cdr a) t)
+ '(" \\end{pmatrix}")))))
(put 'latex 'math-var-formatter 'math-compose-tex-var)
@@ -1023,36 +1018,34 @@
(put 'eqn 'math-evalto '("evalto " . " -> "))
(put 'eqn 'math-matrix-formatter
- (function
- (lambda (a)
- (append '(horiz "matrix { ")
- (math-compose-eqn-matrix
- (cdr (math-transpose a)))
- '("}")))))
+ (lambda (a)
+ (append '(horiz "matrix { ")
+ (math-compose-eqn-matrix
+ (cdr (math-transpose a)))
+ '("}"))))
(put 'eqn 'math-var-formatter
- (function
- (lambda (a prec)
- (let (v)
- (if (and math-compose-hash-args
- (let ((p calc-arg-values))
- (setq v 1)
- (while (and p (not (equal (car p) a)))
- (setq p (and (eq math-compose-hash-args t) (cdr p))
- v (1+ v)))
- p))
- (if (eq math-compose-hash-args 1)
- "#"
- (format "#%d" v))
- (if (string-match ".'\\'" (symbol-name (nth 2 a)))
- (math-compose-expr
- (list 'calcFunc-Prime
- (list
- 'var
- (intern (substring (symbol-name (nth 1 a)) 0 -1))
- (intern (substring (symbol-name (nth 2 a)) 0 -1))))
- prec)
- (symbol-name (nth 1 a))))))))
+ (lambda (a prec)
+ (let (v)
+ (if (and math-compose-hash-args
+ (let ((p calc-arg-values))
+ (setq v 1)
+ (while (and p (not (equal (car p) a)))
+ (setq p (and (eq math-compose-hash-args t) (cdr p))
+ v (1+ v)))
+ p))
+ (if (eq math-compose-hash-args 1)
+ "#"
+ (format "#%d" v))
+ (if (string-match ".'\\'" (symbol-name (nth 2 a)))
+ (math-compose-expr
+ (list 'calcFunc-Prime
+ (list
+ 'var
+ (intern (substring (symbol-name (nth 1 a)) 0 -1))
+ (intern (substring (symbol-name (nth 2 a)) 0 -1))))
+ prec)
+ (symbol-name (nth 1 a)))))))
(defconst math-eqn-special-funcs
'( calcFunc-log
@@ -1065,31 +1058,30 @@
calcFunc-arcsinh calcFunc-arccosh calcFunc-arctanh))
(put 'eqn 'math-func-formatter
- (function
- (lambda (func a)
- (let (left right)
- (if (string-match "[^']'+\\'" func)
- (let ((n (- (length func) (match-beginning 0) 1)))
- (setq func (substring func 0 (- n)))
- (while (>= (setq n (1- n)) 0)
- (setq func (concat func " prime")))))
- (cond ((or (> (length a) 2)
- (not (math-tex-expr-is-flat (nth 1 a))))
- (setq left "{left ( "
- right " right )}"))
-
- ((and
- (memq (car a) math-eqn-special-funcs)
- (= (length a) 2)
- (or (Math-realp (nth 1 a))
- (memq (car (nth 1 a)) '(var *))))
- (setq left "~{" right "}"))
- (t
- (setq left " ( "
- right " )")))
- (list 'horiz func left
- (math-compose-vector (cdr a) " , " 0)
- right)))))
+ (lambda (func a)
+ (let (left right)
+ (if (string-match "[^']'+\\'" func)
+ (let ((n (- (length func) (match-beginning 0) 1)))
+ (setq func (substring func 0 (- n)))
+ (while (>= (setq n (1- n)) 0)
+ (setq func (concat func " prime")))))
+ (cond ((or (> (length a) 2)
+ (not (math-tex-expr-is-flat (nth 1 a))))
+ (setq left "{left ( "
+ right " right )}"))
+
+ ((and
+ (memq (car a) math-eqn-special-funcs)
+ (= (length a) 2)
+ (or (Math-realp (nth 1 a))
+ (memq (car (nth 1 a)) '(var *))))
+ (setq left "~{" right "}"))
+ (t
+ (setq left " ( "
+ right " )")))
+ (list 'horiz func left
+ (math-compose-vector (cdr a) " , " 0)
+ right))))
(put 'eqn 'math-lang-read-symbol
'((?\"
@@ -1111,23 +1103,22 @@
("above" punc ",")))
(put 'eqn 'math-lang-adjust-words
- (function
- (lambda ()
- (let ((code (assoc math-expr-data math-eqn-ignore-words)))
- (cond ((null code))
- ((null (cdr code))
- (math-read-token))
- ((consp (nth 1 code))
- (math-read-token)
- (if (assoc math-expr-data (cdr code))
- (setq math-expr-data (format "%s %s"
- (car code) math-expr-data))))
- ((eq (nth 1 code) 'punc)
- (setq math-exp-token 'punc
- math-expr-data (nth 2 code)))
- (t
- (math-read-token)
- (math-read-token)))))))
+ (lambda ()
+ (let ((code (assoc math-expr-data math-eqn-ignore-words)))
+ (cond ((null code))
+ ((null (cdr code))
+ (math-read-token))
+ ((consp (nth 1 code))
+ (math-read-token)
+ (if (assoc math-expr-data (cdr code))
+ (setq math-expr-data (format "%s %s"
+ (car code) math-expr-data))))
+ ((eq (nth 1 code) 'punc)
+ (setq math-exp-token 'punc
+ math-expr-data (nth 2 code)))
+ (t
+ (math-read-token)
+ (math-read-token))))))
(put 'eqn 'math-lang-read
'((eq (string-match "->\\|<-\\|\\+-\\|\\\\dots\\|~\\|\\^"
@@ -1357,14 +1348,13 @@
( calcFunc-in . (math-lang-compose-switch-args "Contains"))))
(put 'yacas 'math-compose-subscr
- (function
- (lambda (a)
- (let ((args (cdr (cdr a))))
- (list 'horiz
- (math-compose-expr (nth 1 a) 1000)
- "["
- (math-compose-vector args ", " 0)
- "]")))))
+ (lambda (a)
+ (let ((args (cdr (cdr a))))
+ (list 'horiz
+ (math-compose-expr (nth 1 a) 1000)
+ "["
+ (math-compose-vector args ", " 0)
+ "]"))))
(defun math-yacas-parse-Sum (f _val)
"Read in the arguments to \"Sum\" in Calc's Yacas mode."
@@ -1600,24 +1590,22 @@
(add-to-list 'calc-lang-brackets-are-subscripts 'maxima)
(put 'maxima 'math-compose-subscr
- (function
- (lambda (a)
- (let ((args (cdr (cdr a))))
- (list 'horiz
- (math-compose-expr (nth 1 a) 1000)
- "["
- (math-compose-vector args ", " 0)
- "]")))))
+ (lambda (a)
+ (let ((args (cdr (cdr a))))
+ (list 'horiz
+ (math-compose-expr (nth 1 a) 1000)
+ "["
+ (math-compose-vector args ", " 0)
+ "]"))))
(put 'maxima 'math-matrix-formatter
- (function
- (lambda (a)
- (list 'horiz
- "matrix("
- (math-compose-vector (cdr a)
- (concat math-comp-comma " ")
- math-comp-vector-prec)
- ")"))))
+ (lambda (a)
+ (list 'horiz
+ "matrix("
+ (math-compose-vector (cdr a)
+ (concat math-comp-comma " ")
+ math-comp-vector-prec)
+ ")")))
;;; Giac
@@ -1806,15 +1794,14 @@ order to Calc's."
(add-to-list 'calc-lang-allow-underscores 'giac)
(put 'giac 'math-compose-subscr
- (function
- (lambda (a)
- ;; (let ((args (cdr (cdr a))))
- (list 'horiz
- (math-compose-expr (nth 1 a) 1000)
- "["
- (math-compose-expr
- (calc-normalize (list '- (nth 2 a) 1)) 0)
- "]")))) ;;)
+ (lambda (a)
+ ;; (let ((args (cdr (cdr a))))
+ (list 'horiz
+ (math-compose-expr (nth 1 a) 1000)
+ "["
+ (math-compose-expr
+ (calc-normalize (list '- (nth 2 a) 1)) 0)
+ "]"))) ;;)
(defun math-read-giac-subscr (x _op)
(let ((idx (math-read-expr-level 0)))
@@ -1932,7 +1919,7 @@ order to Calc's."
(put 'math 'math-function-close "]")
(put 'math 'math-radix-formatter
- (function (lambda (r s) (format "%d^^%s" r s))))
+ (lambda (r s) (format "%d^^%s" r s)))
(put 'math 'math-lang-read
'((eq (string-match "\\[\\[\\|->\\|:>" math-exp-str math-exp-pos)
@@ -1942,13 +1929,12 @@ order to Calc's."
math-exp-pos (match-end 0))))
(put 'math 'math-compose-subscr
- (function
- (lambda (a)
- (list 'horiz
- (math-compose-expr (nth 1 a) 1000)
- "[["
- (math-compose-expr (nth 2 a) 0)
- "]]"))))
+ (lambda (a)
+ (list 'horiz
+ (math-compose-expr (nth 1 a) 1000)
+ "[["
+ (math-compose-expr (nth 2 a) 0)
+ "]]")))
(defun math-read-math-subscr (x _op)
(let ((idx (math-read-expr-level 0)))
@@ -2038,26 +2024,24 @@ order to Calc's."
(put 'maple 'math-complex-format 'I)
(put 'maple 'math-matrix-formatter
- (function
- (lambda (a)
- (list 'horiz
- "matrix("
- math-comp-left-bracket
- (math-compose-vector (cdr a)
- (concat math-comp-comma " ")
- math-comp-vector-prec)
- math-comp-right-bracket
- ")"))))
+ (lambda (a)
+ (list 'horiz
+ "matrix("
+ math-comp-left-bracket
+ (math-compose-vector (cdr a)
+ (concat math-comp-comma " ")
+ math-comp-vector-prec)
+ math-comp-right-bracket
+ ")")))
(put 'maple 'math-compose-subscr
- (function
- (lambda (a)
- (let ((args (cdr (cdr a))))
- (list 'horiz
- (math-compose-expr (nth 1 a) 1000)
- "["
- (math-compose-vector args ", " 0)
- "]")))))
+ (lambda (a)
+ (let ((args (cdr (cdr a))))
+ (list 'horiz
+ (math-compose-expr (nth 1 a) 1000)
+ "["
+ (math-compose-vector args ", " 0)
+ "]"))))
(add-to-list 'calc-lang-allow-underscores 'maple)
(add-to-list 'calc-lang-brackets-are-subscripts 'maple)
@@ -2197,7 +2181,7 @@ order to Calc's."
v math-read-big-baseline))
;; Small radical sign.
- ((and (= other-char ?V)
+ ((and (memq other-char '(?V ?√))
(= (math-read-big-char (1+ math-rb-h1) (1- v)) ?\_))
(setq h (1+ math-rb-h1))
(math-read-big-emptyp math-rb-h1 math-rb-v1 h (1- v) nil t)
diff --git a/lisp/calc/calc-macs.el b/lisp/calc/calc-macs.el
index 5aaa5f48d6c..63258cde507 100644
--- a/lisp/calc/calc-macs.el
+++ b/lisp/calc/calc-macs.el
@@ -1,6 +1,6 @@
;;; calc-macs.el --- important macros for Calc -*- lexical-binding:t -*-
-;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2021 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
@@ -29,16 +29,15 @@
(declare-function math-looks-negp "calc-misc" (a))
(declare-function math-posp "calc-misc" (a))
(declare-function math-compare "calc-ext" (a b))
-(declare-function math-compare-bignum "calc-ext" (a b))
(defmacro calc-wrapper (&rest body)
- `(calc-do (function (lambda ()
- ,@body))))
+ `(calc-do (lambda ()
+ ,@body)))
(defmacro calc-slow-wrapper (&rest body)
`(calc-do
- (function (lambda () ,@body)) (point)))
+ (lambda () ,@body) (point)))
(defmacro math-showing-full-precision (form)
`(let ((calc-float-format calc-full-float-format))
@@ -174,13 +173,6 @@
(eq (nth 1 a) b)
(= (nth 2 a) 0))))
-(defsubst Math-natnum-lessp (a b)
- (if (consp a)
- (and (consp b)
- (= (math-compare-bignum (cdr a) (cdr b)) -1))
- (or (consp b)
- (< a b))))
-
(provide 'calc-macs)
;;; calc-macs.el ends here
diff --git a/lisp/calc/calc-map.el b/lisp/calc/calc-map.el
index 0ee82826927..16a2bd89cac 100644
--- a/lisp/calc/calc-map.el
+++ b/lisp/calc/calc-map.el
@@ -1,6 +1,6 @@
;;; calc-map.el --- higher-order functions for Calc -*- lexical-binding:t -*-
-;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2021 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
@@ -612,14 +612,13 @@
"()")
minibuffer-local-map
t)))
- (setq math-arglist (mapcar (function
- (lambda (x)
- (list 'var
- x
- (intern
- (concat
- "var-"
- (symbol-name x))))))
+ (setq math-arglist (mapcar (lambda (x)
+ (list 'var
+ x
+ (intern
+ (concat
+ "var-"
+ (symbol-name x)))))
math-arglist))))
(setq oper (list "$"
(length math-arglist)
@@ -962,12 +961,12 @@
(apply 'calcFunc-mapeqp func args)))
(defun calcFunc-mapeqr (func &rest args)
- (setq args (mapcar (function (lambda (x)
- (let ((func (assq (car-safe x)
- calc-tweak-eqn-table)))
- (if func
- (cons (nth 1 func) (cdr x))
- x))))
+ (setq args (mapcar (lambda (x)
+ (let ((func (assq (car-safe x)
+ calc-tweak-eqn-table)))
+ (if func
+ (cons (nth 1 func) (cdr x))
+ x)))
args))
(apply 'calcFunc-mapeqp func args))
@@ -1092,28 +1091,28 @@
(defun calcFunc-reducea (func vec)
(if (math-matrixp vec)
(cons 'vec
- (mapcar (function (lambda (x) (calcFunc-reducer func x)))
+ (mapcar (lambda (x) (calcFunc-reducer func x))
(cdr vec)))
(calcFunc-reducer func vec)))
(defun calcFunc-rreducea (func vec)
(if (math-matrixp vec)
(cons 'vec
- (mapcar (function (lambda (x) (calcFunc-rreducer func x)))
+ (mapcar (lambda (x) (calcFunc-rreducer func x))
(cdr vec)))
(calcFunc-rreducer func vec)))
(defun calcFunc-reduced (func vec)
(if (math-matrixp vec)
(cons 'vec
- (mapcar (function (lambda (x) (calcFunc-reducer func x)))
+ (mapcar (lambda (x) (calcFunc-reducer func x))
(cdr (math-transpose vec))))
(calcFunc-reducer func vec)))
(defun calcFunc-rreduced (func vec)
(if (math-matrixp vec)
(cons 'vec
- (mapcar (function (lambda (x) (calcFunc-rreducer func x)))
+ (mapcar (lambda (x) (calcFunc-rreducer func x))
(cdr (math-transpose vec))))
(calcFunc-rreducer func vec)))
@@ -1216,10 +1215,10 @@
(let ((mat nil))
(while (setq a (cdr a))
(setq mat (cons (cons 'vec
- (mapcar (function (lambda (x)
- (math-build-call func
- (list (car a)
- x))))
+ (mapcar (lambda (x)
+ (math-build-call func
+ (list (car a)
+ x)))
(cdr b)))
mat)))
(math-normalize (cons 'vec (nreverse mat)))))
diff --git a/lisp/calc/calc-math.el b/lisp/calc/calc-math.el
index 46172d1b7f6..1c2e7bcf2bc 100644
--- a/lisp/calc/calc-math.el
+++ b/lisp/calc/calc-math.el
@@ -1,6 +1,6 @@
;;; calc-math.el --- mathematical functions for Calc -*- lexical-binding:t -*-
-;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2021 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
@@ -370,18 +370,6 @@ If this can't be done, return NIL."
(math-isqrt (math-floor a))
(math-floor (math-sqrt a))))
-(defun math-zerop-bignum (a)
- (and (eq (car a) 0)
- (progn
- (while (eq (car (setq a (cdr a))) 0))
- (null a))))
-
-(defun math-scale-bignum-digit-size (a n) ; [L L S]
- (while (> n 0)
- (setq a (cons 0 a)
- n (1- n)))
- a)
-
;;; Compute the square root of a number.
;;; [T N] if possible, else [F N] if possible, else [C N]. [Public]
(defun math-sqrt (a)
@@ -666,7 +654,7 @@ If this can't be done, return NIL."
(let* ((q (math-idivmod a (math-ipow guess (1- math-nri-n))))
(s (math-add (car q) (math-mul (1- math-nri-n) guess)))
(g2 (math-idivmod s math-nri-n)))
- (if (Math-natnum-lessp (car g2) guess)
+ (if (< (car g2) guess)
(math-nth-root-int-iter a (car g2))
(cons (and (equal (car g2) guess)
(eq (cdr q) 0)
@@ -1615,7 +1603,7 @@ If this can't be done, return NIL."
(math-natnump b) (not (eq b 0)))
(if (eq b 1)
(math-reject-arg x "*Logarithm base one")
- (if (Math-natnum-lessp x b)
+ (if (< x b)
0
(cdr (math-integer-log x b))))
(math-floor (calcFunc-log x b))))
diff --git a/lisp/calc/calc-menu.el b/lisp/calc/calc-menu.el
index d593eddb315..16cca055330 100644
--- a/lisp/calc/calc-menu.el
+++ b/lisp/calc/calc-menu.el
@@ -1,6 +1,6 @@
;;; calc-menu.el --- a menu for Calc -*- lexical-binding:t -*-
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/lisp/calc/calc-misc.el b/lisp/calc/calc-misc.el
index 2db09e2b677..b573c53f418 100644
--- a/lisp/calc/calc-misc.el
+++ b/lisp/calc/calc-misc.el
@@ -1,6 +1,6 @@
;;; calc-misc.el --- miscellaneous functions for Calc -*- lexical-binding:t -*-
-;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2021 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
@@ -176,9 +176,9 @@ Calc user interface as before (either C-x * C or C-x * K; initially C-x * C).
"Create another, independent Calculator buffer."
(interactive)
(if (eq major-mode 'calc-mode)
- (mapc (function
- (lambda (v)
- (set-default v (symbol-value v)))) calc-local-var-list))
+ (mapc (lambda (v)
+ (set-default v (symbol-value v)))
+ calc-local-var-list))
(set-buffer (generate-new-buffer "*Calculator*"))
(pop-to-buffer (current-buffer))
(calc-mode))
@@ -274,9 +274,8 @@ Calc user interface as before (either C-x * C or C-x * K; initially C-x * C).
;;;###autoload
(defun calc-do-handle-whys ()
(setq calc-why (sort calc-next-why
- (function
- (lambda (x y)
- (and (eq (car x) '*) (not (eq (car y) '*))))))
+ (lambda (x y)
+ (and (eq (car x) '*) (not (eq (car y) '*)))))
calc-next-why nil)
(if (and calc-why (or (eq calc-auto-why t)
(and (eq (car (car calc-why)) '*)
diff --git a/lisp/calc/calc-mode.el b/lisp/calc/calc-mode.el
index e109233a825..68c8b90ac3b 100644
--- a/lisp/calc/calc-mode.el
+++ b/lisp/calc/calc-mode.el
@@ -1,6 +1,6 @@
;;; calc-mode.el --- calculator modes for Calc -*- lexical-binding:t -*-
-;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2021 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
@@ -268,7 +268,7 @@
(interactive)
(calc-wrapper
(let (pos
- (vals (mapcar (function (lambda (v) (symbol-value (car v))))
+ (vals (mapcar (lambda (v) (symbol-value (car v)))
calc-mode-var-list)))
(unless calc-settings-file
(error "No `calc-settings-file' specified"))
diff --git a/lisp/calc/calc-mtx.el b/lisp/calc/calc-mtx.el
index 8deef7dc4fd..9a08b8cb76a 100644
--- a/lisp/calc/calc-mtx.el
+++ b/lisp/calc/calc-mtx.el
@@ -1,6 +1,6 @@
;;; calc-mtx.el --- matrix functions for Calc -*- lexical-binding:t -*-
-;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2021 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
@@ -55,7 +55,7 @@
(defun math-col-matrix (a)
(if (and (Math-vectorp a)
(not (math-matrixp a)))
- (cons 'vec (mapcar (function (lambda (x) (list 'vec x))) (cdr a)))
+ (cons 'vec (mapcar (lambda (x) (list 'vec x)) (cdr a)))
a))
@@ -79,8 +79,8 @@
(cons 'vec (nreverse mat))))
(defun math-mul-mat-vec (a b)
- (cons 'vec (mapcar (function (lambda (row)
- (math-dot-product row b)))
+ (cons 'vec (mapcar (lambda (row)
+ (math-dot-product row b))
(cdr a))))
diff --git a/lisp/calc/calc-nlfit.el b/lisp/calc/calc-nlfit.el
index 5ed85fe7cae..11867f15e5b 100644
--- a/lisp/calc/calc-nlfit.el
+++ b/lisp/calc/calc-nlfit.el
@@ -1,6 +1,6 @@
;;; calc-nlfit.el --- nonlinear curve fitting for Calc -*- lexical-binding:t -*-
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/lisp/calc/calc-poly.el b/lisp/calc/calc-poly.el
index b3f2c96b0ca..77587cc4b86 100644
--- a/lisp/calc/calc-poly.el
+++ b/lisp/calc/calc-poly.el
@@ -1,6 +1,6 @@
;;; calc-poly.el --- polynomial functions for Calc -*- lexical-binding:t -*-
-;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2021 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
@@ -202,7 +202,7 @@
(if (memq (car-safe expr) '(+ -))
(math-list-to-sum
(sort (math-sum-to-list expr)
- (function (lambda (a b) (math-beforep (car a) (car b))))))
+ (lambda (a b) (math-beforep (car a) (car b)))))
expr))
(defun math-list-to-sum (lst)
@@ -387,7 +387,7 @@ This returns only the remainder from the pseudo-division."
lst
(if (eq a -1)
(math-mul-list lst a)
- (mapcar (function (lambda (x) (math-poly-div-exact x a))) lst))))
+ (mapcar (lambda (x) (math-poly-div-exact x a)) lst))))
(defun math-mul-list (lst a)
(if (eq a 1)
@@ -395,7 +395,7 @@ This returns only the remainder from the pseudo-division."
(if (eq a -1)
(mapcar 'math-neg lst)
(and (not (eq a 0))
- (mapcar (function (lambda (x) (math-mul x a))) lst)))))
+ (mapcar (lambda (x) (math-mul x a)) lst)))))
;;; Run GCD on all elements in a list.
(defun math-poly-gcd-list (lst)
@@ -502,10 +502,10 @@ Take the base that has the highest degree considering both a and b.
(defun math-sort-poly-base-list (lst)
"Sort a list of polynomial bases."
- (sort lst (function (lambda (a b)
- (or (> (nth 1 a) (nth 1 b))
- (and (= (nth 1 a) (nth 1 b))
- (math-beforep (car a) (car b))))))))
+ (sort lst (lambda (a b)
+ (or (> (nth 1 a) (nth 1 b))
+ (and (= (nth 1 a) (nth 1 b))
+ (math-beforep (car a) (car b)))))))
;;; Given an expression find all variables that are polynomial bases.
;;; Return list in the form '( (var1 degree1) (var2 degree2) ... ).
@@ -1033,10 +1033,9 @@ If no partial fraction representation can be found, return nil."
(math-transpose
(cons 'vec
(mapcar
- (function
- (lambda (x)
- (cons 'vec (math-padded-polynomial
- x var tdeg))))
+ (lambda (x)
+ (cons 'vec (math-padded-polynomial
+ x var tdeg)))
(cdr eqns))))))
(and (math-vectorp eqns)
(let ((res 0)
diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el
index ea9c49748e2..3097b09b013 100644
--- a/lisp/calc/calc-prog.el
+++ b/lisp/calc/calc-prog.el
@@ -1,6 +1,6 @@
;;; calc-prog.el --- user programmability functions for Calc -*- lexical-binding:t -*-
-;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2021 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
@@ -182,7 +182,7 @@
odef key keyname cmd cmd-base cmd-base-default
func calc-user-formula-alist is-symb)
(if is-lambda
- (setq math-arglist (mapcar (function (lambda (x) (nth 1 x)))
+ (setq math-arglist (mapcar (lambda (x) (nth 1 x))
(nreverse (cdr (reverse (cdr form)))))
form (nth (1- (length form)) form))
(calc-default-formula-arglist form)
@@ -290,10 +290,10 @@
(y-or-n-p
"Leave it symbolic for non-constant arguments? ")))
(setq calc-user-formula-alist
- (mapcar (function (lambda (x)
- (or (cdr (assq x '((nil . arg-nil)
- (t . arg-t))))
- x))) calc-user-formula-alist))
+ (mapcar (lambda (x)
+ (or (cdr (assq x '((nil . arg-nil)
+ (t . arg-t))))
+ x)) calc-user-formula-alist))
(if cmd
(progn
(require 'calc-macs)
@@ -319,8 +319,8 @@
(append
(list 'lambda calc-user-formula-alist)
(and is-symb
- (mapcar (function (lambda (v)
- (list 'math-check-const v t)))
+ (mapcar (lambda (v)
+ (list 'math-check-const v t))
calc-user-formula-alist))
(list body))))
(put func 'calc-user-defn form)
@@ -483,13 +483,13 @@
(interactive)
(calc-wrapper
(let ((lang calc-language))
- (calc-edit-mode (list 'calc-finish-user-syntax-edit (list 'quote lang))
- t
- (format "Editing %s-Mode Syntax Table. "
- (cond ((null lang) "Normal")
- ((eq lang 'tex) "TeX")
- ((eq lang 'latex) "LaTeX")
- (t (capitalize (symbol-name lang))))))
+ (calc--edit-mode (lambda () (calc-finish-user-syntax-edit lang))
+ t
+ (format "Editing %s-Mode Syntax Table. "
+ (cond ((null lang) "Normal")
+ ((eq lang 'tex) "TeX")
+ ((eq lang 'latex) "LaTeX")
+ (t (capitalize (symbol-name lang))))))
(calc-write-parse-table (cdr (assq lang calc-user-parse-tables))
lang)))
(calc-show-edit-buffer))
@@ -696,12 +696,13 @@
(setq cmd (symbol-function cmd)))
(cond ((or (stringp cmd)
(and (consp cmd)
- (eq (car-safe (nth 3 cmd)) 'calc-execute-kbd-macro)))
+ (eq (car-safe (nth 3 cmd)) #'calc-execute-kbd-macro)))
+ ;; FIXME: Won't (nth 3 cmd) fail when (stringp cmd)?
(let* ((mac (elt (nth 1 (nth 3 cmd)) 1))
(str (edmacro-format-keys mac t))
(kys (nth 3 (nth 3 cmd))))
- (calc-edit-mode
- (list 'calc-edit-macro-finish-edit cmdname kys)
+ (calc--edit-mode
+ (lambda () (calc-edit-macro-finish-edit cmdname kys))
t (format (concat
"Editing keyboard macro (%s, bound to %s).\n"
"Original keys: %s \n")
@@ -719,8 +720,8 @@
(if (and defn (calc-valid-formula-func func))
(let ((niceexpr (math-format-nice-expr defn (frame-width))))
(calc-wrapper
- (calc-edit-mode
- (list 'calc-finish-formula-edit (list 'quote func))
+ (calc--edit-mode
+ (lambda () (calc-finish-formula-edit func))
nil
(format (concat
"Editing formula (%s, %s, bound to %s).\n"
diff --git a/lisp/calc/calc-rewr.el b/lisp/calc/calc-rewr.el
index 2cc7b6beef0..e3d4852a721 100644
--- a/lisp/calc/calc-rewr.el
+++ b/lisp/calc/calc-rewr.el
@@ -1,6 +1,6 @@
;;; calc-rewr.el --- rewriting functions for Calc -*- lexical-binding:t -*-
-;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2021 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
@@ -181,19 +181,18 @@
(calc-line-numbering nil)
(calc-show-selections t)
(calc-why nil)
- (math-mt-func (function
- (lambda (x)
- (let ((result (math-apply-rewrites x (cdr crules)
- heads crules)))
- (if result
- (progn
- (if trace-buffer
- (let ((fmt (math-format-stack-value
- (list result nil nil))))
- (with-current-buffer trace-buffer
- (insert "\nrewrite to\n" fmt "\n"))))
- (setq heads (math-rewrite-heads result heads t))))
- result)))))
+ (math-mt-func (lambda (x)
+ (let ((result (math-apply-rewrites x (cdr crules)
+ heads crules)))
+ (if result
+ (progn
+ (if trace-buffer
+ (let ((fmt (math-format-stack-value
+ (list result nil nil))))
+ (with-current-buffer trace-buffer
+ (insert "\nrewrite to\n" fmt "\n"))))
+ (setq heads (math-rewrite-heads result heads t))))
+ result))))
(if trace-buffer
(let ((fmt (math-format-stack-value (list math-rewrite-whole-expr nil nil))))
(with-current-buffer trace-buffer
@@ -485,8 +484,8 @@
(let ((math-rewrite-whole t))
(cdr (math-compile-rewrites (cons
'vec
- (mapcar (function (lambda (x)
- (list 'vec x t)))
+ (mapcar (lambda (x)
+ (list 'vec x t))
(if (eq (car-safe pats) 'vec)
(cdr pats)
(list pats)))))))))
@@ -656,15 +655,14 @@
nil
(nreverse
(mapcar
- (function
- (lambda (v)
- (and (car v)
- (list
- 'calcFunc-assign
- (math-build-var-name
- (car v))
- (math-rwcomp-register-expr
- (nth 1 v))))))
+ (lambda (v)
+ (and (car v)
+ (list
+ 'calcFunc-assign
+ (math-build-var-name
+ (car v))
+ (math-rwcomp-register-expr
+ (nth 1 v)))))
math-regs))))
(math-rwcomp-match-vars math-rhs))
math-remembering)
@@ -672,7 +670,7 @@
(let* ((heads (math-rewrite-heads math-pattern))
(rule (list (vconcat
(nreverse
- (mapcar (function (lambda (x) (nth 3 x)))
+ (mapcar (lambda (x) (nth 3 x))
math-regs)))
math-prog
heads
@@ -724,10 +722,9 @@
(setq rules (cdr rules)))
(if nil-rules
(setq rule-set (cons (cons nil nil-rules) rule-set)))
- (setq all-heads (mapcar 'car
- (sort all-heads (function
- (lambda (x y)
- (< (cdr x) (cdr y)))))))
+ (setq all-heads (mapcar #'car
+ (sort all-heads (lambda (x y)
+ (< (cdr x) (cdr y))))))
(let ((set rule-set)
rule heads ptr)
(while set
@@ -790,15 +787,14 @@
(math-rewrite-heads-rec (car expr)))))))
(defun math-parse-schedule (sched)
- (mapcar (function
- (lambda (s)
- (if (integerp s)
- s
- (if (math-vectorp s)
- (math-parse-schedule (cdr s))
- (if (eq (car-safe s) 'var)
- (math-var-to-calcFunc s)
- (error "Improper component in rewrite schedule"))))))
+ (mapcar (lambda (s)
+ (if (integerp s)
+ s
+ (if (math-vectorp s)
+ (math-parse-schedule (cdr s))
+ (if (eq (car-safe s) 'var)
+ (math-var-to-calcFunc s)
+ (error "Improper component in rewrite schedule")))))
sched))
(defun math-rwcomp-match-vars (expr)
@@ -1180,9 +1176,8 @@
(list 'calcFunc-register
reg2))))
(math-rwcomp-pattern (car arg2) (cdr arg2))))
- (let* ((args (mapcar (function
- (lambda (x)
- (cons x (math-rwcomp-best-reg x))))
+ (let* ((args (mapcar (lambda (x)
+ (cons x (math-rwcomp-best-reg x)))
(cdr expr)))
(args2 (copy-sequence args))
(argp (reverse args2))
diff --git a/lisp/calc/calc-rules.el b/lisp/calc/calc-rules.el
index fe0e8a1e479..00080b69891 100644
--- a/lisp/calc/calc-rules.el
+++ b/lisp/calc/calc-rules.el
@@ -1,6 +1,6 @@
;;; calc-rules.el --- rules for simplifying algebraic expressions in Calc -*- lexical-binding:t -*-
-;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2021 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
diff --git a/lisp/calc/calc-sel.el b/lisp/calc/calc-sel.el
index 23c0e01b527..2b317ac3696 100644
--- a/lisp/calc/calc-sel.el
+++ b/lisp/calc/calc-sel.el
@@ -1,6 +1,6 @@
;;; calc-sel.el --- data selection functions for Calc -*- lexical-binding:t -*-
-;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2021 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
@@ -675,12 +675,12 @@
(entry (calc-top num 'entry))
(expr (car entry))
(sel (or (calc-auto-selection entry) expr))
- ) ;; alg
- (let ((str (math-showing-full-precision
- (math-format-nice-expr sel (frame-width)))))
- (calc-edit-mode (list 'calc-finish-selection-edit
- num (list 'quote sel) calc-sel-reselect))
- (insert str "\n"))))
+ ;; alg
+ (str (math-showing-full-precision
+ (math-format-nice-expr sel (frame-width))))
+ (csr calc-sel-reselect))
+ (calc--edit-mode (lambda () (calc-finish-selection-edit num sel csr)))
+ (insert str "\n")))
(calc-show-edit-buffer))
(defvar calc-original-buffer)
diff --git a/lisp/calc/calc-stat.el b/lisp/calc/calc-stat.el
index 196f743fc1a..3cf9bec8346 100644
--- a/lisp/calc/calc-stat.el
+++ b/lisp/calc/calc-stat.el
@@ -1,6 +1,6 @@
;;; calc-stat.el --- statistical functions for Calc -*- lexical-binding:t -*-
-;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2021 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
diff --git a/lisp/calc/calc-store.el b/lisp/calc/calc-store.el
index a1e385cb406..ee29c440fe4 100644
--- a/lisp/calc/calc-store.el
+++ b/lisp/calc/calc-store.el
@@ -1,6 +1,6 @@
;;; calc-store.el --- value storage functions for Calc -*- lexical-binding:t -*-
-;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2021 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
@@ -168,15 +168,13 @@
()
(setq calc-var-name-map (copy-keymap minibuffer-local-completion-map))
(define-key calc-var-name-map " " 'self-insert-command)
- (mapc (function
- (lambda (x)
+ (mapc (lambda (x)
(define-key calc-var-name-map (char-to-string x)
- 'calcVar-digit)))
+ 'calcVar-digit))
"0123456789")
- (mapc (function
- (lambda (x)
+ (mapc (lambda (x)
(define-key calc-var-name-map (char-to-string x)
- 'calcVar-oper)))
+ 'calcVar-oper))
"+-*/^|"))
(defvar calc-store-opers)
@@ -324,10 +322,9 @@
(calc-pop-push-record
(1+ calc-given-value-flag)
(concat "=" (calc-var-name (car (car var))))
- (let ((saved-val (mapcar (function
- (lambda (v)
- (and (boundp (car v))
- (symbol-value (car v)))))
+ (let ((saved-val (mapcar (lambda (v)
+ (and (boundp (car v))
+ (symbol-value (car v))))
var)))
(unwind-protect
(let ((vv var))
@@ -440,10 +437,10 @@
(if (eq (car-safe value) 'special-const)
(error "%s is a special constant" var))
(setq calc-last-edited-variable var)
- (calc-edit-mode (list 'calc-finish-stack-edit (list 'quote var))
- t
- (format-message
- "Editing variable `%s'" (calc-var-name var)))
+ (calc--edit-mode (lambda () (calc-finish-stack-edit var))
+ t
+ (format-message
+ "Editing variable `%s'" (calc-var-name var)))
(and value
(insert (math-format-nice-expr value (frame-width)) "\n")))))
(calc-show-edit-buffer))
@@ -597,13 +594,12 @@
calc-settings-file)))
(if var
(calc-insert-permanent-variable var)
- (mapatoms (function
- (lambda (x)
- (and (string-match "\\`var-" (symbol-name x))
- (not (memq x calc-dont-insert-variables))
- (calc-var-value x)
- (not (eq (car-safe (symbol-value x)) 'special-const))
- (calc-insert-permanent-variable x))))))
+ (mapatoms (lambda (x)
+ (and (string-match "\\`var-" (symbol-name x))
+ (not (memq x calc-dont-insert-variables))
+ (calc-var-value x)
+ (not (eq (car-safe (symbol-value x)) 'special-const))
+ (calc-insert-permanent-variable x)))))
(save-buffer))))
@@ -638,27 +634,26 @@
(defun calc-insert-variables (buf)
(interactive "bBuffer in which to save variable values: ")
(with-current-buffer buf
- (mapatoms (function
- (lambda (x)
- (and (string-match "\\`var-" (symbol-name x))
- (not (memq x calc-dont-insert-variables))
- (calc-var-value x)
- (not (eq (car-safe (symbol-value x)) 'special-const))
- (or (not (eq x 'var-Decls))
- (not (equal var-Decls '(vec))))
- (or (not (eq x 'var-Holidays))
- (not (equal var-Holidays '(vec (var sat var-sat)
- (var sun var-sun)))))
- (insert "(setq "
- (symbol-name x)
- " "
- (prin1-to-string
- (let ((calc-language
- (if (memq calc-language '(nil big))
- 'flat
- calc-language)))
- (math-format-value (symbol-value x) 100000)))
- ")\n")))))))
+ (mapatoms (lambda (x)
+ (and (string-match "\\`var-" (symbol-name x))
+ (not (memq x calc-dont-insert-variables))
+ (calc-var-value x)
+ (not (eq (car-safe (symbol-value x)) 'special-const))
+ (or (not (eq x 'var-Decls))
+ (not (equal var-Decls '(vec))))
+ (or (not (eq x 'var-Holidays))
+ (not (equal var-Holidays '(vec (var sat var-sat)
+ (var sun var-sun)))))
+ (insert "(setq "
+ (symbol-name x)
+ " "
+ (prin1-to-string
+ (let ((calc-language
+ (if (memq calc-language '(nil big))
+ 'flat
+ calc-language)))
+ (math-format-value (symbol-value x) 100000)))
+ ")\n"))))))
(defun calc-assign (arg)
(interactive "P")
diff --git a/lisp/calc/calc-stuff.el b/lisp/calc/calc-stuff.el
index 58b81faee50..9281666c3b6 100644
--- a/lisp/calc/calc-stuff.el
+++ b/lisp/calc/calc-stuff.el
@@ -1,6 +1,6 @@
;;; calc-stuff.el --- miscellaneous functions for Calc -*- lexical-binding:t -*-
-;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2021 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
@@ -182,7 +182,7 @@ With a prefix, push that prefix as a number onto the stack."
math-eval-rules-cache-tag t
math-format-date-cache nil
math-holidays-cache-tag t)
- (mapc (function (lambda (x) (set x -100))) math-cache-list)
+ (mapc (lambda (x) (set x -100)) math-cache-list)
(unless inhibit-msg
(message "All internal calculator caches have been reset"))))
@@ -258,14 +258,14 @@ With a prefix, push that prefix as a number onto the stack."
(t (list 'calcFunc-clean a)))))
(defun calcFunc-pclean (a &optional prec)
- (math-map-over-constants (function (lambda (x) (calcFunc-clean x prec)))
+ (math-map-over-constants (lambda (x) (calcFunc-clean x prec))
a))
(defun calcFunc-pfloat (a)
(math-map-over-constants 'math-float a))
(defun calcFunc-pfrac (a &optional tol)
- (math-map-over-constants (function (lambda (x) (calcFunc-frac x tol)))
+ (math-map-over-constants (lambda (x) (calcFunc-frac x tol))
a))
;; The variable math-moc-func is local to math-map-over-constants,
diff --git a/lisp/calc/calc-trail.el b/lisp/calc/calc-trail.el
index de7205ee3ca..2cf5160d5d3 100644
--- a/lisp/calc/calc-trail.el
+++ b/lisp/calc/calc-trail.el
@@ -1,6 +1,6 @@
;;; calc-trail.el --- functions for manipulating the Calc "trail" -*- lexical-binding:t -*-
-;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2021 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
diff --git a/lisp/calc/calc-undo.el b/lisp/calc/calc-undo.el
index 47971e8ab0d..4add99a250f 100644
--- a/lisp/calc/calc-undo.el
+++ b/lisp/calc/calc-undo.el
@@ -1,6 +1,6 @@
;;; calc-undo.el --- undo functions for Calc -*- lexical-binding:t -*-
-;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2021 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el
index 709c09ea099..c3adc3db02a 100644
--- a/lisp/calc/calc-units.el
+++ b/lisp/calc/calc-units.el
@@ -1,6 +1,6 @@
;;; calc-units.el --- unit conversion functions for Calc -*- lexical-binding:t -*-
-;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2021 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
@@ -860,23 +860,22 @@ If COMP or STD is non-nil, put that in the units table instead."
tab)
(message "Building units table...")
(setq math-units-table-buffer-valid nil)
- (setq tab (mapcar (function
- (lambda (x)
- (list (car x)
- (and (nth 1 x)
- (if (stringp (nth 1 x))
- (let ((exp (math-read-plain-expr
- (nth 1 x))))
- (if (eq (car-safe exp) 'error)
- (error "Format error in definition of %s in units table: %s"
- (car x) (nth 2 exp))
- exp))
- (nth 1 x)))
- (nth 2 x)
- (nth 3 x)
- (and (not (nth 1 x))
- (list (cons (car x) 1)))
- (nth 4 x))))
+ (setq tab (mapcar (lambda (x)
+ (list (car x)
+ (and (nth 1 x)
+ (if (stringp (nth 1 x))
+ (let ((exp (math-read-plain-expr
+ (nth 1 x))))
+ (if (eq (car-safe exp) 'error)
+ (error "Format error in definition of %s in units table: %s"
+ (car x) (nth 2 exp))
+ exp))
+ (nth 1 x)))
+ (nth 2 x)
+ (nth 3 x)
+ (and (not (nth 1 x))
+ (list (cons (car x) 1)))
+ (nth 4 x)))
combined-units))
(let ((math-units-table tab))
(mapc #'math-find-base-units tab))
@@ -1100,10 +1099,9 @@ If COMP or STD is non-nil, put that in the units table instead."
(setq math-decompose-units-cache
(cons entry
(sort ulist
- (function
- (lambda (x y)
- (not (Math-lessp (nth 1 x)
- (nth 1 y))))))))))
+ (lambda (x y)
+ (not (Math-lessp (nth 1 x)
+ (nth 1 y)))))))))
(cdr math-decompose-units-cache))))
(defun math-decompose-unit-part (unit)
@@ -2159,7 +2157,7 @@ If non-nil, return a list consisting of the note and the cents coefficient."
(calc-unary-op "midi" 'calcFunc-midi arg)))
(defun calc-spn (arg)
- "Return the scientific pitch notation corresponding to the expression on the stack."
+ "Return scientific pitch notation corresponding to the expression on the stack."
(interactive "P")
(calc-slow-wrapper
(calc-unary-op "spn" 'calcFunc-spn arg)))
diff --git a/lisp/calc/calc-vec.el b/lisp/calc/calc-vec.el
index 875414595cf..73783dd2c2c 100644
--- a/lisp/calc/calc-vec.el
+++ b/lisp/calc/calc-vec.el
@@ -1,6 +1,6 @@
;;; calc-vec.el --- vector functions for Calc -*- lexical-binding:t -*-
-;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2021 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
@@ -744,7 +744,7 @@
;;; Get the Nth row of a matrix.
(defun calcFunc-mrow (mat n) ; [Public]
(if (Math-vectorp n)
- (math-map-vec (function (lambda (x) (calcFunc-mrow mat x))) n)
+ (math-map-vec (lambda (x) (calcFunc-mrow mat x)) n)
(if (and (eq (car-safe n) 'intv) (math-constp n))
(calcFunc-subvec mat
(math-add (nth 2 n) (if (memq (nth 1 n) '(2 3)) 0 1))
@@ -768,15 +768,15 @@
;;; Get the Nth column of a matrix.
(defun math-mat-col (mat n)
- (cons 'vec (mapcar (function (lambda (x) (elt x n))) (cdr mat))))
+ (cons 'vec (mapcar (lambda (x) (elt x n)) (cdr mat))))
(defun calcFunc-mcol (mat n) ; [Public]
(if (Math-vectorp n)
(calcFunc-trn
- (math-map-vec (function (lambda (x) (calcFunc-mcol mat x))) n))
+ (math-map-vec (lambda (x) (calcFunc-mcol mat x)) n))
(if (and (eq (car-safe n) 'intv) (math-constp n))
(if (math-matrixp mat)
- (math-map-vec (function (lambda (x) (calcFunc-mrow x n))) mat)
+ (math-map-vec (lambda (x) (calcFunc-mrow x n)) mat)
(calcFunc-mrow mat n))
(or (and (integerp (setq n (math-check-integer n)))
(> n 0))
@@ -804,7 +804,7 @@
;;; Remove the Nth column from a matrix.
(defun math-mat-less-col (mat n)
- (cons 'vec (mapcar (function (lambda (x) (math-mat-less-row x n)))
+ (cons 'vec (mapcar (lambda (x) (math-mat-less-row x n))
(cdr mat))))
(defun calcFunc-mrcol (mat n) ; [Public]
@@ -939,10 +939,10 @@
(calcFunc-idn a (1- (length m)))
(if (math-vectorp m)
(if (math-zerop a)
- (cons 'vec (mapcar (function (lambda (x)
- (if (math-vectorp x)
- (math-mimic-ident a x)
- a)))
+ (cons 'vec (mapcar (lambda (x)
+ (if (math-vectorp x)
+ (math-mimic-ident a x)
+ a))
(cdr m)))
(math-dimension-error))
(calcFunc-idn a))))
diff --git a/lisp/calc/calc-yank.el b/lisp/calc/calc-yank.el
index e03c00243c4..e5f05236f3a 100644
--- a/lisp/calc/calc-yank.el
+++ b/lisp/calc/calc-yank.el
@@ -1,6 +1,6 @@
;;; calc-yank.el --- kill-ring functionality for Calc -*- lexical-binding:t -*-
-;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2021 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
@@ -643,23 +643,22 @@ Interactively, reads the register using `register-read-with-preview'."
(allow-ret (> n 1))
(list (math-showing-full-precision
(mapcar (if (> n 1)
- (function (lambda (x)
- (math-format-flat-expr x 0)))
- (function
- (lambda (x)
- (if (math-vectorp x) (setq allow-ret t))
- (math-format-nice-expr x (frame-width)))))
+ (lambda (x)
+ (math-format-flat-expr x 0))
+ (lambda (x)
+ (if (math-vectorp x) (setq allow-ret t))
+ (math-format-nice-expr x (frame-width))))
(if (> n 0)
(calc-top-list n)
(calc-top-list 1 (- n)))))))
- (calc-edit-mode (list 'calc-finish-stack-edit (or flag n)) allow-ret)
+ (calc--edit-mode (lambda () (calc-finish-stack-edit (or flag n))) allow-ret)
(while list
(insert (car list) "\n")
(setq list (cdr list)))))
(calc-show-edit-buffer))
(defun calc-alg-edit (str)
- (calc-edit-mode '(calc-finish-stack-edit 0))
+ (calc--edit-mode (lambda () (calc-finish-stack-edit 0)))
(calc-show-edit-buffer)
(insert str "\n")
(backward-char 1)
@@ -667,54 +666,47 @@ Interactively, reads the register using `register-read-with-preview'."
(defvar calc-edit-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "\n" 'calc-edit-finish)
- (define-key map "\r" 'calc-edit-return)
- (define-key map "\C-c\C-c" 'calc-edit-finish)
+ (define-key map "\n" #'calc-edit-finish)
+ (define-key map "\r" #'calc-edit-return)
+ (define-key map "\C-c\C-c" #'calc-edit-finish)
map)
- "Keymap for use by the calc-edit command.")
+ "Keymap for use by the `calc-edit' command.")
-(defvar calc-original-buffer)
-(defvar calc-return-buffer)
-(defvar calc-one-window)
-(defvar calc-edit-handler)
-(defvar calc-restore-trail)
-(defvar calc-allow-ret)
-(defvar calc-edit-top)
+(defvar calc-original-buffer nil)
+(defvar calc-return-buffer nil)
+(defvar calc-one-window nil)
+(defvar calc-edit-handler nil)
+(defvar calc-restore-trail nil)
+(defvar calc-allow-ret nil)
+(defvar calc-edit-top nil)
-(defun calc-edit-mode (&optional handler allow-ret title)
+(put 'calc-edit-mode 'mode-class 'special)
+(define-derived-mode calc-edit-mode nil "Calc Edit"
"Calculator editing mode. Press RET, LFD, or C-c C-c to finish.
To cancel the edit, simply kill the *Calc Edit* buffer."
- (interactive)
+ (setq-local buffer-read-only nil)
+ (setq-local truncate-lines nil))
+
+(defun calc--edit-mode (handler &optional allow-ret title)
(unless handler
(error "This command can be used only indirectly through calc-edit"))
(let ((oldbuf (current-buffer))
(buf (get-buffer-create "*Calc Edit*")))
(set-buffer buf)
- (kill-all-local-variables)
- (use-local-map calc-edit-mode-map)
- (setq buffer-read-only nil)
- (setq truncate-lines nil)
- (setq major-mode 'calc-edit-mode)
- (setq mode-name "Calc Edit")
- (run-mode-hooks 'calc-edit-mode-hook)
- (make-local-variable 'calc-original-buffer)
- (setq calc-original-buffer oldbuf)
- (make-local-variable 'calc-return-buffer)
- (setq calc-return-buffer oldbuf)
- (make-local-variable 'calc-one-window)
- (setq calc-one-window (and (one-window-p t) pop-up-windows))
- (make-local-variable 'calc-edit-handler)
- (setq calc-edit-handler handler)
- (make-local-variable 'calc-restore-trail)
- (setq calc-restore-trail (get-buffer-window (calc-trail-buffer)))
- (make-local-variable 'calc-allow-ret)
- (setq calc-allow-ret allow-ret)
+ (calc-edit-mode)
+ (setq-local calc-original-buffer oldbuf)
+ (setq-local calc-return-buffer oldbuf)
+ (setq-local calc-one-window (and (one-window-p t) pop-up-windows))
+ (setq-local calc-edit-handler handler)
+ (setq-local calc-restore-trail (get-buffer-window (calc-trail-buffer)))
+ (setq-local calc-allow-ret allow-ret)
(let ((inhibit-read-only t))
(erase-buffer))
(add-hook 'kill-buffer-hook (lambda ()
(let ((calc-edit-handler nil))
(calc-edit-finish t))
- (message "(Canceled)")) t t)
+ (message "(Canceled)"))
+ t t)
(insert (propertize
(concat
(or title title "Calc Edit Mode. ")
@@ -722,9 +714,7 @@ To cancel the edit, simply kill the *Calc Edit* buffer."
(if allow-ret "" " or RET")
(format-message " to finish, `C-x k RET' to cancel.\n\n"))
'font-lock-face 'italic 'read-only t 'rear-nonsticky t 'front-sticky t))
- (make-local-variable 'calc-edit-top)
- (setq calc-edit-top (point))))
-(put 'calc-edit-mode 'mode-class 'special)
+ (setq-local calc-edit-top (point))))
(defun calc-show-edit-buffer ()
(let ((buf (current-buffer)))
@@ -744,24 +734,19 @@ To cancel the edit, simply kill the *Calc Edit* buffer."
(defun calc-edit-return ()
(interactive)
- (if (and (boundp 'calc-allow-ret) calc-allow-ret)
+ (if calc-allow-ret
(newline)
(calc-edit-finish)))
-;; The variable calc-edit-disp-trail is local to calc-edit finish, but
-;; is used by calc-finish-selection-edit and calc-finish-stack-edit.
+;; The variable `calc-edit-disp-trail' is local to `calc-edit-finish', but
+;; is used by `calc-finish-selection-edit' and `calc-finish-stack-edit'.
(defvar calc-edit-disp-trail)
(defun calc-edit-finish (&optional keep)
- "Finish calc-edit mode. Parse buffer contents and push them on the stack."
+ "Finish `calc-edit' mode. Parse buffer contents and push them on the stack."
(interactive "P")
(message "Working...")
- (or (and (boundp 'calc-original-buffer)
- (boundp 'calc-return-buffer)
- (boundp 'calc-one-window)
- (boundp 'calc-edit-handler)
- (boundp 'calc-restore-trail)
- (eq major-mode 'calc-edit-mode))
+ (or (derived-mode-p 'calc-edit-mode)
(error "This command is valid only in buffers created by calc-edit"))
(let ((buf (current-buffer))
(original calc-original-buffer)
@@ -776,7 +761,11 @@ To cancel the edit, simply kill the *Calc Edit* buffer."
(error "Original calculator buffer has been corrupted")))
(goto-char calc-edit-top)
(if (buffer-modified-p)
- (eval calc-edit-handler t))
+ (if (functionp calc-edit-handler)
+ (funcall calc-edit-handler)
+ (message "Deprecated handler expression in calc-edit-handler: %S"
+ calc-edit-handler)
+ (eval calc-edit-handler t)))
(if (and one-window (not (one-window-p t)))
(delete-window))
(if (get-buffer-window return)
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el
index bde7bd4e2bd..ec09abb34c4 100644
--- a/lisp/calc/calc.el
+++ b/lisp/calc/calc.el
@@ -1,6 +1,6 @@
;;; calc.el --- the GNU Emacs calculator -*- lexical-binding:t -*-
-;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2021 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Keywords: convenience, extensions
@@ -266,18 +266,18 @@
(sgml-mode . "<!-- Embed -->\n\\(<!-- .* -->\n\\)*")
(xml-mode . "<!-- Embed -->\n\\(<!-- .* -->\n\\)*")
(texinfo-mode . "@c Embed\n\\(@c .*\n\\)*"))
- "Alist of major modes with appropriate values for `calc-embedded-announce-formula'."
+ "Alist of major modes for `calc-embedded-announce-formula'."
:type '(alist :key-type (symbol :tag "Major mode")
:value-type (regexp :tag "Regexp to announce formula")))
(defcustom calc-embedded-open-formula
"\\`\\|^\n\\|\\$\\$?\\|\\\\\\[\\|^\\\\begin[^{].*\n\\|^\\\\begin{.*[^x]}.*\n\\|^@.*\n\\|^\\.EQ.*\n\\|\\\\(\\|^%\n\\|^\\.\\\\\"\n"
- "A regular expression for the opening delimiter of a formula used by calc-embedded."
+ "Regexp for the opening delimiter of a formula used by `calc-embedded'."
:type '(regexp))
(defcustom calc-embedded-close-formula
"\\'\\|\n$\\|\\$\\$?\\|\\\\]\\|^\\\\end[^{].*\n\\|^\\\\end{.*[^x]}.*\n\\|^@.*\n\\|^\\.EN.*\n\\|\\\\)\\|\n%\n\\|^\\.\\\\\"\n"
- "A regular expression for the closing delimiter of a formula used by calc-embedded."
+ "Regexp for the closing delimiter of a formula used by calc-embedded."
:type '(regexp))
(defcustom calc-embedded-open-close-formula-alist
@@ -506,7 +506,7 @@ The variable VAR will be added to `calc-mode-var-list'."
(defun calc-mode-var-list-restore-default-values ()
"Restore the default values of the variables in `calc-mode-var-list'."
- (mapcar (function (lambda (v) (set (car v) (nth 1 v))))
+ (mapcar (lambda (v) (set (car v) (nth 1 v)))
calc-mode-var-list))
(defun calc-mode-var-list-restore-saved-values ()
@@ -535,7 +535,7 @@ The variable VAR will be added to `calc-mode-var-list'."
newvarlist)))
(setq varlist (cdr varlist)))))))
(if newvarlist
- (mapcar (function (lambda (v) (set (car v) (nth 1 v))))
+ (mapcar (lambda (v) (set (car v) (nth 1 v)))
newvarlist)
(calc-mode-var-list-restore-default-values))))
@@ -721,7 +721,8 @@ If nil, computations on numbers always yield numbers where possible.")
(defcalcmodevar calc-matrix-mode nil
"If `matrix', variables are assumed to be matrix-valued.
If a number, variables are assumed to be NxN matrices.
-If `sqmatrix', variables are assumed to be square matrices of an unspecified size.
+If `sqmatrix', variables are assumed to be square matrices of an
+ unspecified size.
If `scalar', variables are assumed to be scalar-valued.
If nil, symbolic math routines make no assumptions about variables.")
@@ -1094,15 +1095,7 @@ Used by `calc-user-invocation'.")
(ignore-errors
(define-key calc-digit-map x 'calcDigit-delchar)
(define-key calc-mode-map x 'calc-pop)
- (define-key calc-mode-map
- (if (and (vectorp x) (featurep 'xemacs))
- (if (= (length x) 1)
- (vector (if (consp (aref x 0))
- (cons 'meta (aref x 0))
- (list 'meta (aref x 0))))
- "\e\C-d")
- (vconcat "\e" x))
- 'calc-pop-above)))
+ (define-key calc-mode-map (vconcat "\e" x) 'calc-pop-above)))
(if calc-scan-for-dels
(append (where-is-internal 'delete-forward-char global-map)
'("\C-d"))
@@ -1315,8 +1308,9 @@ Notations: 3.14e6 3.14 * 10^6
\\{calc-mode-map}
"
(interactive)
- (mapc (function ;FIXME: Why (set-default v (symbol-value v)) ?!?!?
- (lambda (v) (set-default v (symbol-value v))))
+ (mapc (lambda (v)
+ ;; FIXME: Why (set-default v (symbol-value v)) ?!?!?
+ (set-default v (symbol-value v)))
calc-local-var-list)
(kill-all-local-variables)
(use-local-map (if (eq calc-algebraic-mode 'total)
@@ -1435,6 +1429,12 @@ commands given here will actually operate on the *Calculator* stack."
(require 'calc-ext)
(calc-set-language calc-language calc-language-option t)))
+(defcustom calc-make-windows-dedicated t
+ "If non-nil, windows displaying Calc buffers will be marked dedicated.
+See `window-dedicated-p' for what that means."
+ :version "28.1"
+ :type 'boolean)
+
;;;###autoload
(defun calc (&optional arg full-display interactive)
"The Emacs Calculator. Full documentation is listed under `calc-mode'."
@@ -1480,6 +1480,8 @@ commands given here will actually operate on the *Calculator* stack."
(and (windowp full-display)
(window-point full-display)
(select-window full-display))
+ (and calc-make-windows-dedicated
+ (set-window-dedicated-p nil t))
(calc-check-defines)
(when (and calc-said-hello interactive)
(sit-for 2)
@@ -1529,7 +1531,7 @@ commands given here will actually operate on the *Calculator* stack."
(let ((tail (nthcdr (1- calc-undo-length) calc-undo-list)))
(if tail (setcdr tail nil)))
(setq calc-redo-list nil))))
- (mapc (function (lambda (v) (set-default v (symbol-value v))))
+ (mapc (lambda (v) (set-default v (symbol-value v)))
calc-local-var-list)
(let ((buf (current-buffer))
(win (get-buffer-window (current-buffer)))
@@ -2091,7 +2093,7 @@ the United States."
(set-buffer calc-trail-buffer)
(unless (derived-mode-p 'calc-trail-mode)
(calc-trail-mode)
- (set (make-local-variable 'calc-main-buffer) buf)))))
+ (setq-local calc-main-buffer buf)))))
(or (and calc-trail-pointer
(eq (marker-buffer calc-trail-pointer) calc-trail-buffer))
(with-current-buffer calc-trail-buffer
@@ -2140,7 +2142,9 @@ the United States."
(if calc-trail-window-hook
(run-hooks 'calc-trail-window-hook)
(let ((w (split-window nil (/ (* (window-width) 2) 3) t)))
- (set-window-buffer w calc-trail-buffer)))
+ (set-window-buffer w calc-trail-buffer)
+ (and calc-make-windows-dedicated
+ (set-window-dedicated-p w t))))
(calc-wrapper
(setq overlay-arrow-string calc-trail-overlay
overlay-arrow-position calc-trail-pointer)
diff --git a/lisp/calc/calcalg2.el b/lisp/calc/calcalg2.el
index 7894bd93015..fc6eb74e9f1 100644
--- a/lisp/calc/calcalg2.el
+++ b/lisp/calc/calcalg2.el
@@ -1,6 +1,6 @@
;;; calcalg2.el --- more algebraic functions for Calc -*- lexical-binding:t -*-
-;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2021 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
@@ -361,175 +361,175 @@
res))))
(put 'calcFunc-inv\' 'math-derivative-1
- (function (lambda (u) (math-neg (math-div 1 (math-sqr u))))))
+ (lambda (u) (math-neg (math-div 1 (math-sqr u)))))
(put 'calcFunc-sqrt\' 'math-derivative-1
- (function (lambda (u) (math-div 1 (math-mul 2 (list 'calcFunc-sqrt u))))))
+ (lambda (u) (math-div 1 (math-mul 2 (list 'calcFunc-sqrt u)))))
(put 'calcFunc-deg\' 'math-derivative-1
- (function (lambda (_) (math-div-float '(float 18 1) (math-pi)))))
+ (lambda (_) (math-div-float '(float 18 1) (math-pi))))
(put 'calcFunc-rad\' 'math-derivative-1
- (function (lambda (_) (math-pi-over-180))))
+ (lambda (_) (math-pi-over-180)))
(put 'calcFunc-ln\' 'math-derivative-1
- (function (lambda (u) (math-div 1 u))))
+ (lambda (u) (math-div 1 u)))
(put 'calcFunc-log10\' 'math-derivative-1
- (function (lambda (u)
- (math-div (math-div 1 (math-normalize '(calcFunc-ln 10)))
- u))))
+ (lambda (u)
+ (math-div (math-div 1 (math-normalize '(calcFunc-ln 10)))
+ u)))
(put 'calcFunc-lnp1\' 'math-derivative-1
- (function (lambda (u) (math-div 1 (math-add u 1)))))
+ (lambda (u) (math-div 1 (math-add u 1))))
(put 'calcFunc-log\' 'math-derivative-2
- (function (lambda (x b)
- (and (not (Math-zerop b))
- (let ((lnv (math-normalize
- (list 'calcFunc-ln b))))
- (math-div 1 (math-mul lnv x)))))))
+ (lambda (x b)
+ (and (not (Math-zerop b))
+ (let ((lnv (math-normalize
+ (list 'calcFunc-ln b))))
+ (math-div 1 (math-mul lnv x))))))
(put 'calcFunc-log\'2 'math-derivative-2
- (function (lambda (x b)
- (let ((lnv (list 'calcFunc-ln b)))
- (math-neg (math-div (list 'calcFunc-log x b)
- (math-mul lnv b)))))))
+ (lambda (x b)
+ (let ((lnv (list 'calcFunc-ln b)))
+ (math-neg (math-div (list 'calcFunc-log x b)
+ (math-mul lnv b))))))
(put 'calcFunc-exp\' 'math-derivative-1
- (function (lambda (u) (math-normalize (list 'calcFunc-exp u)))))
+ (lambda (u) (math-normalize (list 'calcFunc-exp u))))
(put 'calcFunc-expm1\' 'math-derivative-1
- (function (lambda (u) (math-normalize (list 'calcFunc-expm1 u)))))
+ (lambda (u) (math-normalize (list 'calcFunc-expm1 u))))
(put 'calcFunc-sin\' 'math-derivative-1
- (function (lambda (u) (math-to-radians-2 (math-normalize
- (list 'calcFunc-cos u)) t))))
+ (lambda (u) (math-to-radians-2 (math-normalize
+ (list 'calcFunc-cos u)) t)))
(put 'calcFunc-cos\' 'math-derivative-1
- (function (lambda (u) (math-neg (math-to-radians-2
- (math-normalize
- (list 'calcFunc-sin u)) t)))))
+ (lambda (u) (math-neg (math-to-radians-2
+ (math-normalize
+ (list 'calcFunc-sin u)) t))))
(put 'calcFunc-tan\' 'math-derivative-1
- (function (lambda (u) (math-to-radians-2
- (math-sqr
- (math-normalize
- (list 'calcFunc-sec u))) t))))
+ (lambda (u) (math-to-radians-2
+ (math-sqr
+ (math-normalize
+ (list 'calcFunc-sec u))) t)))
(put 'calcFunc-sec\' 'math-derivative-1
- (function (lambda (u) (math-to-radians-2
- (math-mul
- (math-normalize
- (list 'calcFunc-sec u))
- (math-normalize
- (list 'calcFunc-tan u))) t))))
+ (lambda (u) (math-to-radians-2
+ (math-mul
+ (math-normalize
+ (list 'calcFunc-sec u))
+ (math-normalize
+ (list 'calcFunc-tan u))) t)))
(put 'calcFunc-csc\' 'math-derivative-1
- (function (lambda (u) (math-neg
- (math-to-radians-2
- (math-mul
- (math-normalize
- (list 'calcFunc-csc u))
- (math-normalize
- (list 'calcFunc-cot u))) t)))))
+ (lambda (u) (math-neg
+ (math-to-radians-2
+ (math-mul
+ (math-normalize
+ (list 'calcFunc-csc u))
+ (math-normalize
+ (list 'calcFunc-cot u))) t))))
(put 'calcFunc-cot\' 'math-derivative-1
- (function (lambda (u) (math-neg
- (math-to-radians-2
- (math-sqr
- (math-normalize
- (list 'calcFunc-csc u))) t)))))
+ (lambda (u) (math-neg
+ (math-to-radians-2
+ (math-sqr
+ (math-normalize
+ (list 'calcFunc-csc u))) t))))
(put 'calcFunc-arcsin\' 'math-derivative-1
- (function (lambda (u)
- (math-from-radians-2
- (math-div 1 (math-normalize
- (list 'calcFunc-sqrt
- (math-sub 1 (math-sqr u))))) t))))
+ (lambda (u)
+ (math-from-radians-2
+ (math-div 1 (math-normalize
+ (list 'calcFunc-sqrt
+ (math-sub 1 (math-sqr u))))) t)))
(put 'calcFunc-arccos\' 'math-derivative-1
- (function (lambda (u)
- (math-from-radians-2
- (math-div -1 (math-normalize
- (list 'calcFunc-sqrt
- (math-sub 1 (math-sqr u))))) t))))
+ (lambda (u)
+ (math-from-radians-2
+ (math-div -1 (math-normalize
+ (list 'calcFunc-sqrt
+ (math-sub 1 (math-sqr u))))) t)))
(put 'calcFunc-arctan\' 'math-derivative-1
- (function (lambda (u) (math-from-radians-2
- (math-div 1 (math-add 1 (math-sqr u))) t))))
+ (lambda (u) (math-from-radians-2
+ (math-div 1 (math-add 1 (math-sqr u))) t)))
(put 'calcFunc-sinh\' 'math-derivative-1
- (function (lambda (u) (math-normalize (list 'calcFunc-cosh u)))))
+ (lambda (u) (math-normalize (list 'calcFunc-cosh u))))
(put 'calcFunc-cosh\' 'math-derivative-1
- (function (lambda (u) (math-normalize (list 'calcFunc-sinh u)))))
+ (lambda (u) (math-normalize (list 'calcFunc-sinh u))))
(put 'calcFunc-tanh\' 'math-derivative-1
- (function (lambda (u) (math-sqr
- (math-normalize
- (list 'calcFunc-sech u))))))
+ (lambda (u) (math-sqr
+ (math-normalize
+ (list 'calcFunc-sech u)))))
(put 'calcFunc-sech\' 'math-derivative-1
- (function (lambda (u) (math-neg
- (math-mul
- (math-normalize (list 'calcFunc-sech u))
- (math-normalize (list 'calcFunc-tanh u)))))))
+ (lambda (u) (math-neg
+ (math-mul
+ (math-normalize (list 'calcFunc-sech u))
+ (math-normalize (list 'calcFunc-tanh u))))))
(put 'calcFunc-csch\' 'math-derivative-1
- (function (lambda (u) (math-neg
- (math-mul
- (math-normalize (list 'calcFunc-csch u))
- (math-normalize (list 'calcFunc-coth u)))))))
+ (lambda (u) (math-neg
+ (math-mul
+ (math-normalize (list 'calcFunc-csch u))
+ (math-normalize (list 'calcFunc-coth u))))))
(put 'calcFunc-coth\' 'math-derivative-1
- (function (lambda (u) (math-neg
- (math-sqr
- (math-normalize
- (list 'calcFunc-csch u)))))))
+ (lambda (u) (math-neg
+ (math-sqr
+ (math-normalize
+ (list 'calcFunc-csch u))))))
(put 'calcFunc-arcsinh\' 'math-derivative-1
- (function (lambda (u)
- (math-div 1 (math-normalize
- (list 'calcFunc-sqrt
- (math-add (math-sqr u) 1)))))))
+ (lambda (u)
+ (math-div 1 (math-normalize
+ (list 'calcFunc-sqrt
+ (math-add (math-sqr u) 1))))))
(put 'calcFunc-arccosh\' 'math-derivative-1
- (function (lambda (u)
- (math-div 1 (math-normalize
- (list 'calcFunc-sqrt
- (math-add (math-sqr u) -1)))))))
+ (lambda (u)
+ (math-div 1 (math-normalize
+ (list 'calcFunc-sqrt
+ (math-add (math-sqr u) -1))))))
(put 'calcFunc-arctanh\' 'math-derivative-1
- (function (lambda (u) (math-div 1 (math-sub 1 (math-sqr u))))))
+ (lambda (u) (math-div 1 (math-sub 1 (math-sqr u)))))
(put 'calcFunc-bern\'2 'math-derivative-2
- (function (lambda (n x)
- (math-mul n (list 'calcFunc-bern (math-add n -1) x)))))
+ (lambda (n x)
+ (math-mul n (list 'calcFunc-bern (math-add n -1) x))))
(put 'calcFunc-euler\'2 'math-derivative-2
- (function (lambda (n x)
- (math-mul n (list 'calcFunc-euler (math-add n -1) x)))))
+ (lambda (n x)
+ (math-mul n (list 'calcFunc-euler (math-add n -1) x))))
(put 'calcFunc-gammag\'2 'math-derivative-2
- (function (lambda (a x) (math-deriv-gamma a x 1))))
+ (lambda (a x) (math-deriv-gamma a x 1)))
(put 'calcFunc-gammaG\'2 'math-derivative-2
- (function (lambda (a x) (math-deriv-gamma a x -1))))
+ (lambda (a x) (math-deriv-gamma a x -1)))
(put 'calcFunc-gammaP\'2 'math-derivative-2
- (function (lambda (a x) (math-deriv-gamma a x
- (math-div
- 1 (math-normalize
- (list 'calcFunc-gamma
- a)))))))
+ (lambda (a x) (math-deriv-gamma a x
+ (math-div
+ 1 (math-normalize
+ (list 'calcFunc-gamma
+ a))))))
(put 'calcFunc-gammaQ\'2 'math-derivative-2
- (function (lambda (a x) (math-deriv-gamma a x
- (math-div
- -1 (math-normalize
- (list 'calcFunc-gamma
- a)))))))
+ (lambda (a x) (math-deriv-gamma a x
+ (math-div
+ -1 (math-normalize
+ (list 'calcFunc-gamma
+ a))))))
(defun math-deriv-gamma (a x scale)
(math-mul scale
@@ -537,13 +537,13 @@
(list 'calcFunc-exp (math-neg x)))))
(put 'calcFunc-betaB\' 'math-derivative-3
- (function (lambda (x a b) (math-deriv-beta x a b 1))))
+ (lambda (x a b) (math-deriv-beta x a b 1)))
(put 'calcFunc-betaI\' 'math-derivative-3
- (function (lambda (x a b) (math-deriv-beta x a b
- (math-div
- 1 (list 'calcFunc-beta
- a b))))))
+ (lambda (x a b) (math-deriv-beta x a b
+ (math-div
+ 1 (list 'calcFunc-beta
+ a b)))))
(defun math-deriv-beta (x a b scale)
(math-mul (math-mul (math-pow x (math-add a -1))
@@ -551,101 +551,96 @@
scale))
(put 'calcFunc-erf\' 'math-derivative-1
- (function (lambda (x) (math-div 2
- (math-mul (list 'calcFunc-exp
- (math-sqr x))
- (if calc-symbolic-mode
- '(calcFunc-sqrt
- (var pi var-pi))
- (math-sqrt-pi)))))))
+ (lambda (x) (math-div 2
+ (math-mul (list 'calcFunc-exp
+ (math-sqr x))
+ (if calc-symbolic-mode
+ '(calcFunc-sqrt
+ (var pi var-pi))
+ (math-sqrt-pi))))))
(put 'calcFunc-erfc\' 'math-derivative-1
- (function (lambda (x) (math-div -2
- (math-mul (list 'calcFunc-exp
- (math-sqr x))
- (if calc-symbolic-mode
- '(calcFunc-sqrt
- (var pi var-pi))
- (math-sqrt-pi)))))))
+ (lambda (x) (math-div -2
+ (math-mul (list 'calcFunc-exp
+ (math-sqr x))
+ (if calc-symbolic-mode
+ '(calcFunc-sqrt
+ (var pi var-pi))
+ (math-sqrt-pi))))))
(put 'calcFunc-besJ\'2 'math-derivative-2
- (function (lambda (v z) (math-div (math-sub (list 'calcFunc-besJ
- (math-add v -1)
- z)
- (list 'calcFunc-besJ
- (math-add v 1)
- z))
- 2))))
+ (lambda (v z) (math-div (math-sub (list 'calcFunc-besJ
+ (math-add v -1)
+ z)
+ (list 'calcFunc-besJ
+ (math-add v 1)
+ z))
+ 2)))
(put 'calcFunc-besY\'2 'math-derivative-2
- (function (lambda (v z) (math-div (math-sub (list 'calcFunc-besY
- (math-add v -1)
- z)
- (list 'calcFunc-besY
- (math-add v 1)
- z))
- 2))))
+ (lambda (v z) (math-div (math-sub (list 'calcFunc-besY
+ (math-add v -1)
+ z)
+ (list 'calcFunc-besY
+ (math-add v 1)
+ z))
+ 2)))
(put 'calcFunc-sum 'math-derivative-n
- (function
- (lambda (expr)
- (if (math-expr-contains (cons 'vec (cdr (cdr expr))) math-deriv-var)
- (throw 'math-deriv nil)
- (cons 'calcFunc-sum
- (cons (math-derivative (nth 1 expr))
- (cdr (cdr expr))))))))
+ (lambda (expr)
+ (if (math-expr-contains (cons 'vec (cdr (cdr expr))) math-deriv-var)
+ (throw 'math-deriv nil)
+ (cons 'calcFunc-sum
+ (cons (math-derivative (nth 1 expr))
+ (cdr (cdr expr)))))))
(put 'calcFunc-prod 'math-derivative-n
- (function
- (lambda (expr)
- (if (math-expr-contains (cons 'vec (cdr (cdr expr))) math-deriv-var)
- (throw 'math-deriv nil)
- (math-mul expr
- (cons 'calcFunc-sum
- (cons (math-div (math-derivative (nth 1 expr))
- (nth 1 expr))
- (cdr (cdr expr)))))))))
+ (lambda (expr)
+ (if (math-expr-contains (cons 'vec (cdr (cdr expr))) math-deriv-var)
+ (throw 'math-deriv nil)
+ (math-mul expr
+ (cons 'calcFunc-sum
+ (cons (math-div (math-derivative (nth 1 expr))
+ (nth 1 expr))
+ (cdr (cdr expr))))))))
(put 'calcFunc-integ 'math-derivative-n
- (function
- (lambda (expr)
- (if (= (length expr) 3)
- (if (equal (nth 2 expr) math-deriv-var)
- (nth 1 expr)
- (math-normalize
- (list 'calcFunc-integ
- (math-derivative (nth 1 expr))
- (nth 2 expr))))
- (if (= (length expr) 5)
- (let ((lower (math-expr-subst (nth 1 expr) (nth 2 expr)
- (nth 3 expr)))
- (upper (math-expr-subst (nth 1 expr) (nth 2 expr)
- (nth 4 expr))))
- (math-add (math-sub (math-mul upper
- (math-derivative (nth 4 expr)))
- (math-mul lower
- (math-derivative (nth 3 expr))))
- (if (equal (nth 2 expr) math-deriv-var)
- 0
- (math-normalize
- (list 'calcFunc-integ
- (math-derivative (nth 1 expr)) (nth 2 expr)
- (nth 3 expr) (nth 4 expr)))))))))))
+ (lambda (expr)
+ (if (= (length expr) 3)
+ (if (equal (nth 2 expr) math-deriv-var)
+ (nth 1 expr)
+ (math-normalize
+ (list 'calcFunc-integ
+ (math-derivative (nth 1 expr))
+ (nth 2 expr))))
+ (if (= (length expr) 5)
+ (let ((lower (math-expr-subst (nth 1 expr) (nth 2 expr)
+ (nth 3 expr)))
+ (upper (math-expr-subst (nth 1 expr) (nth 2 expr)
+ (nth 4 expr))))
+ (math-add (math-sub (math-mul upper
+ (math-derivative (nth 4 expr)))
+ (math-mul lower
+ (math-derivative (nth 3 expr))))
+ (if (equal (nth 2 expr) math-deriv-var)
+ 0
+ (math-normalize
+ (list 'calcFunc-integ
+ (math-derivative (nth 1 expr)) (nth 2 expr)
+ (nth 3 expr) (nth 4 expr))))))))))
(put 'calcFunc-if 'math-derivative-n
- (function
- (lambda (expr)
- (and (= (length expr) 4)
- (list 'calcFunc-if (nth 1 expr)
- (math-derivative (nth 2 expr))
- (math-derivative (nth 3 expr)))))))
+ (lambda (expr)
+ (and (= (length expr) 4)
+ (list 'calcFunc-if (nth 1 expr)
+ (math-derivative (nth 2 expr))
+ (math-derivative (nth 3 expr))))))
(put 'calcFunc-subscr 'math-derivative-n
- (function
- (lambda (expr)
- (and (= (length expr) 3)
- (list 'calcFunc-subscr (nth 1 expr)
- (math-derivative (nth 2 expr)))))))
+ (lambda (expr)
+ (and (= (length expr) 3)
+ (list 'calcFunc-subscr (nth 1 expr)
+ (math-derivative (nth 2 expr))))))
(defvar math-integ-var '(var X ---))
@@ -1015,11 +1010,10 @@
res '(calcFunc-integsubst)))
(and (memq (length part) '(3 4 5))
(let ((parts (mapcar
- (function
- (lambda (x)
- (math-expr-subst
- x (nth 2 part)
- math-integ-var)))
+ (lambda (x)
+ (math-expr-subst
+ x (nth 2 part)
+ math-integ-var))
(cdr part))))
(math-integrate-by-substitution
expr (car parts) t
@@ -1516,7 +1510,7 @@
var low high)
(nth 2 (nth 2 expr))))
((eq (car-safe expr) 'vec)
- (cons 'vec (mapcar (function (lambda (x) (calcFunc-integ x var low high)))
+ (cons 'vec (mapcar (lambda (x) (calcFunc-integ x var low high))
(cdr expr))))
(t
(let ((state (list calc-angle-mode
@@ -2742,28 +2736,27 @@
math-t1 math-t2 math-t3)
(setq math-t2 (math-polynomial-base
math-solve-lhs
- (function
- (lambda (solve-b)
- (let ((math-solve-b solve-b)
- (math-poly-neg-powers '(1))
- (math-poly-mult-powers nil)
- (math-poly-frac-powers 1)
- (math-poly-exp-base t))
- (and (not (equal math-solve-b math-solve-lhs))
- (or (not (memq (car-safe math-solve-b) '(+ -))) sub-rhs)
- (setq math-t3 '(1 0) math-t2 1
- math-t1 (math-is-polynomial math-solve-lhs
- math-solve-b 50))
- (if (and (equal math-poly-neg-powers '(1))
- (memq math-poly-mult-powers '(nil 1))
- (eq math-poly-frac-powers 1)
- sub-rhs)
- (setq math-t1 (cons (math-sub (car math-t1) math-solve-rhs)
- (cdr math-t1)))
- (math-solve-poly-funny-powers sub-rhs))
- (math-solve-crunch-poly degree)
- (or (math-expr-contains math-solve-b math-solve-var)
- (math-expr-contains (car math-t3) math-solve-var))))))))
+ (lambda (solve-b)
+ (let ((math-solve-b solve-b)
+ (math-poly-neg-powers '(1))
+ (math-poly-mult-powers nil)
+ (math-poly-frac-powers 1)
+ (math-poly-exp-base t))
+ (and (not (equal math-solve-b math-solve-lhs))
+ (or (not (memq (car-safe math-solve-b) '(+ -))) sub-rhs)
+ (setq math-t3 '(1 0) math-t2 1
+ math-t1 (math-is-polynomial math-solve-lhs
+ math-solve-b 50))
+ (if (and (equal math-poly-neg-powers '(1))
+ (memq math-poly-mult-powers '(nil 1))
+ (eq math-poly-frac-powers 1)
+ sub-rhs)
+ (setq math-t1 (cons (math-sub (car math-t1) math-solve-rhs)
+ (cdr math-t1)))
+ (math-solve-poly-funny-powers sub-rhs))
+ (math-solve-crunch-poly degree)
+ (or (math-expr-contains math-solve-b math-solve-var)
+ (math-expr-contains (car math-t3) math-solve-var)))))))
(if math-t2
(list (math-pow math-t2 (car math-t3))
(cons 'vec math-t1)
@@ -3326,12 +3319,11 @@
(delq (car v) (copy-sequence var-list))
(let ((math-solve-simplifying nil)
(s (mapcar
- (function
- (lambda (x)
- (cons
- (car x)
- (math-solve-system-subst
- (cdr x)))))
+ (lambda (x)
+ (cons
+ (car x)
+ (math-solve-system-subst
+ (cdr x))))
solns)))
(if elim
s
@@ -3347,35 +3339,33 @@
;; Eliminated all variables, so now put solution into the proper format.
(setq solns (sort solns
- (function
- (lambda (x y)
- (not (memq (car x) (memq (car y) math-solve-vars)))))))
+ (lambda (x y)
+ (not (memq (car x) (memq (car y) math-solve-vars))))))
(if (eq math-solve-full 'all)
(math-transpose
(math-normalize
(cons 'vec
(if solns
- (mapcar (function (lambda (x) (cons 'vec (cdr x)))) solns)
- (mapcar (function (lambda (x) (cons 'vec x))) eqn-list)))))
+ (mapcar (lambda (x) (cons 'vec (cdr x))) solns)
+ (mapcar (lambda (x) (cons 'vec x)) eqn-list)))))
(math-normalize
(cons 'vec
(if solns
- (mapcar (function (lambda (x) (cons 'calcFunc-eq x))) solns)
- (mapcar 'car eqn-list)))))))
+ (mapcar (lambda (x) (cons 'calcFunc-eq x)) solns)
+ (mapcar #'car eqn-list)))))))
(defun math-solve-system-subst (x) ; uses "res" and "v"
(let ((accum nil)
(res2 math-solve-system-res))
(while x
(setq accum (nconc accum
- (mapcar (function
- (lambda (r)
- (if math-solve-simplifying
- (math-simplify
- (math-expr-subst
- (car x) math-solve-system-vv r))
- (math-expr-subst
- (car x) math-solve-system-vv r))))
+ (mapcar (lambda (r)
+ (if math-solve-simplifying
+ (math-simplify
+ (math-expr-subst
+ (car x) math-solve-system-vv r))
+ (math-expr-subst
+ (car x) math-solve-system-vv r)))
(car res2)))
x (cdr x)
res2 (cdr res2)))
@@ -3471,11 +3461,10 @@
(let ((old-len (length res))
new-len)
(setq res (delq nil
- (mapcar (function
- (lambda (x)
- (and (not (memq (car-safe x)
- '(cplx polar)))
- x)))
+ (mapcar (lambda (x)
+ (and (not (memq (car-safe x)
+ '(cplx polar)))
+ x))
res))
new-len (length res))
(if (< new-len old-len)
@@ -3545,119 +3534,119 @@
(put 'calcFunc-inv 'math-inverse
- (function (lambda (x) (math-div 1 x))))
+ (lambda (x) (math-div 1 x)))
(put 'calcFunc-inv 'math-inverse-sign -1)
(put 'calcFunc-sqrt 'math-inverse
- (function (lambda (x) (math-sqr x))))
+ (lambda (x) (math-sqr x)))
(put 'calcFunc-conj 'math-inverse
- (function (lambda (x) (list 'calcFunc-conj x))))
+ (lambda (x) (list 'calcFunc-conj x)))
(put 'calcFunc-abs 'math-inverse
- (function (lambda (x) (math-solve-get-sign x))))
+ (lambda (x) (math-solve-get-sign x)))
(put 'calcFunc-deg 'math-inverse
- (function (lambda (x) (list 'calcFunc-rad x))))
+ (lambda (x) (list 'calcFunc-rad x)))
(put 'calcFunc-deg 'math-inverse-sign 1)
(put 'calcFunc-rad 'math-inverse
- (function (lambda (x) (list 'calcFunc-deg x))))
+ (lambda (x) (list 'calcFunc-deg x)))
(put 'calcFunc-rad 'math-inverse-sign 1)
(put 'calcFunc-ln 'math-inverse
- (function (lambda (x) (list 'calcFunc-exp x))))
+ (lambda (x) (list 'calcFunc-exp x)))
(put 'calcFunc-ln 'math-inverse-sign 1)
(put 'calcFunc-log10 'math-inverse
- (function (lambda (x) (list 'calcFunc-exp10 x))))
+ (lambda (x) (list 'calcFunc-exp10 x)))
(put 'calcFunc-log10 'math-inverse-sign 1)
(put 'calcFunc-lnp1 'math-inverse
- (function (lambda (x) (list 'calcFunc-expm1 x))))
+ (lambda (x) (list 'calcFunc-expm1 x)))
(put 'calcFunc-lnp1 'math-inverse-sign 1)
(put 'calcFunc-exp 'math-inverse
- (function (lambda (x) (math-add (math-normalize (list 'calcFunc-ln x))
- (math-mul 2
- (math-mul '(var pi var-pi)
- (math-solve-get-int
- '(var i var-i))))))))
+ (lambda (x) (math-add (math-normalize (list 'calcFunc-ln x))
+ (math-mul 2
+ (math-mul '(var pi var-pi)
+ (math-solve-get-int
+ '(var i var-i)))))))
(put 'calcFunc-exp 'math-inverse-sign 1)
(put 'calcFunc-expm1 'math-inverse
- (function (lambda (x) (math-add (math-normalize (list 'calcFunc-lnp1 x))
- (math-mul 2
- (math-mul '(var pi var-pi)
- (math-solve-get-int
- '(var i var-i))))))))
+ (lambda (x) (math-add (math-normalize (list 'calcFunc-lnp1 x))
+ (math-mul 2
+ (math-mul '(var pi var-pi)
+ (math-solve-get-int
+ '(var i var-i)))))))
(put 'calcFunc-expm1 'math-inverse-sign 1)
(put 'calcFunc-sin 'math-inverse
- (function (lambda (x) (let ((n (math-solve-get-int 1)))
- (math-add (math-mul (math-normalize
- (list 'calcFunc-arcsin x))
- (math-pow -1 n))
- (math-mul (math-half-circle t)
- n))))))
+ (lambda (x) (let ((n (math-solve-get-int 1)))
+ (math-add (math-mul (math-normalize
+ (list 'calcFunc-arcsin x))
+ (math-pow -1 n))
+ (math-mul (math-half-circle t)
+ n)))))
(put 'calcFunc-cos 'math-inverse
- (function (lambda (x) (math-add (math-solve-get-sign
- (math-normalize
- (list 'calcFunc-arccos x)))
- (math-solve-get-int
- (math-full-circle t))))))
+ (lambda (x) (math-add (math-solve-get-sign
+ (math-normalize
+ (list 'calcFunc-arccos x)))
+ (math-solve-get-int
+ (math-full-circle t)))))
(put 'calcFunc-tan 'math-inverse
- (function (lambda (x) (math-add (math-normalize (list 'calcFunc-arctan x))
- (math-solve-get-int
- (math-half-circle t))))))
+ (lambda (x) (math-add (math-normalize (list 'calcFunc-arctan x))
+ (math-solve-get-int
+ (math-half-circle t)))))
(put 'calcFunc-arcsin 'math-inverse
- (function (lambda (x) (math-normalize (list 'calcFunc-sin x)))))
+ (lambda (x) (math-normalize (list 'calcFunc-sin x))))
(put 'calcFunc-arccos 'math-inverse
- (function (lambda (x) (math-normalize (list 'calcFunc-cos x)))))
+ (lambda (x) (math-normalize (list 'calcFunc-cos x))))
(put 'calcFunc-arctan 'math-inverse
- (function (lambda (x) (math-normalize (list 'calcFunc-tan x)))))
+ (lambda (x) (math-normalize (list 'calcFunc-tan x))))
(put 'calcFunc-sinh 'math-inverse
- (function (lambda (x) (let ((n (math-solve-get-int 1)))
- (math-add (math-mul (math-normalize
- (list 'calcFunc-arcsinh x))
- (math-pow -1 n))
- (math-mul (math-half-circle t)
- (math-mul
- '(var i var-i)
- n)))))))
+ (lambda (x) (let ((n (math-solve-get-int 1)))
+ (math-add (math-mul (math-normalize
+ (list 'calcFunc-arcsinh x))
+ (math-pow -1 n))
+ (math-mul (math-half-circle t)
+ (math-mul
+ '(var i var-i)
+ n))))))
(put 'calcFunc-sinh 'math-inverse-sign 1)
(put 'calcFunc-cosh 'math-inverse
- (function (lambda (x) (math-add (math-solve-get-sign
- (math-normalize
- (list 'calcFunc-arccosh x)))
- (math-mul (math-full-circle t)
- (math-solve-get-int
- '(var i var-i)))))))
+ (lambda (x) (math-add (math-solve-get-sign
+ (math-normalize
+ (list 'calcFunc-arccosh x)))
+ (math-mul (math-full-circle t)
+ (math-solve-get-int
+ '(var i var-i))))))
(put 'calcFunc-tanh 'math-inverse
- (function (lambda (x) (math-add (math-normalize
- (list 'calcFunc-arctanh x))
- (math-mul (math-half-circle t)
- (math-solve-get-int
- '(var i var-i)))))))
+ (lambda (x) (math-add (math-normalize
+ (list 'calcFunc-arctanh x))
+ (math-mul (math-half-circle t)
+ (math-solve-get-int
+ '(var i var-i))))))
(put 'calcFunc-tanh 'math-inverse-sign 1)
(put 'calcFunc-arcsinh 'math-inverse
- (function (lambda (x) (math-normalize (list 'calcFunc-sinh x)))))
+ (lambda (x) (math-normalize (list 'calcFunc-sinh x))))
(put 'calcFunc-arcsinh 'math-inverse-sign 1)
(put 'calcFunc-arccosh 'math-inverse
- (function (lambda (x) (math-normalize (list 'calcFunc-cosh x)))))
+ (lambda (x) (math-normalize (list 'calcFunc-cosh x))))
(put 'calcFunc-arctanh 'math-inverse
- (function (lambda (x) (math-normalize (list 'calcFunc-tanh x)))))
+ (lambda (x) (math-normalize (list 'calcFunc-tanh x))))
(put 'calcFunc-arctanh 'math-inverse-sign 1)
diff --git a/lisp/calc/calcalg3.el b/lisp/calc/calcalg3.el
index f1f67211b84..ee3ae0a4c1f 100644
--- a/lisp/calc/calcalg3.el
+++ b/lisp/calc/calcalg3.el
@@ -1,6 +1,6 @@
;;; calcalg3.el --- more algebraic functions for Calc -*- lexical-binding:t -*-
-;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2021 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
@@ -480,13 +480,13 @@
"Fitting variables"
(format "%s; %s"
(mapconcat 'symbol-name
- (mapcar (function (lambda (v)
- (nth 1 v)))
+ (mapcar (lambda (v)
+ (nth 1 v))
defv)
",")
(mapconcat 'symbol-name
- (mapcar (function (lambda (v)
- (nth 1 v)))
+ (mapcar (lambda (v)
+ (nth 1 v))
defc)
",")))))
(coefs nil))
@@ -1336,7 +1336,7 @@
(or (> (length (nth 1 data)) 2)
(math-reject-arg data "*Too few data points"))
(if (and (math-vectorp x) (or (math-constp x) math-expand-formulas))
- (cons 'vec (mapcar (function (lambda (x) (calcFunc-polint data x)))
+ (cons 'vec (mapcar (lambda (x) (calcFunc-polint data x))
(cdr x)))
(or (math-objectp x) math-expand-formulas (math-reject-arg x 'objectp))
(math-with-extra-prec 2
@@ -1352,7 +1352,7 @@
(or (> (length (nth 1 data)) 2)
(math-reject-arg data "*Too few data points"))
(if (and (math-vectorp x) (or (math-constp x) math-expand-formulas))
- (cons 'vec (mapcar (function (lambda (x) (calcFunc-ratint data x)))
+ (cons 'vec (mapcar (lambda (x) (calcFunc-ratint data x))
(cdr x)))
(or (math-objectp x) math-expand-formulas (math-reject-arg x 'objectp))
(math-with-extra-prec 2
@@ -1910,8 +1910,8 @@
(while p
(setq vars (delq (assoc (car-safe p) vars) vars)
p (cdr p)))
- (sort (mapcar 'car vars)
- (function (lambda (x y) (string< (nth 1 x) (nth 1 y)))))))
+ (sort (mapcar #'car vars)
+ (lambda (x y) (string< (nth 1 x) (nth 1 y))))))
;; The variables math-all-vars-vars (the vars for math-all-vars) and
;; math-all-vars-found are local to math-all-vars-in, but are used by
diff --git a/lisp/calc/calccomp.el b/lisp/calc/calccomp.el
index 1f3ae842638..5f38ee71c78 100644
--- a/lisp/calc/calccomp.el
+++ b/lisp/calc/calccomp.el
@@ -1,6 +1,6 @@
;;; calccomp.el --- composition functions for Calc -*- lexical-binding:t -*-
-;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2021 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
@@ -138,19 +138,19 @@
(math-format-number (nth 2 aa))))))
(if (= calc-number-radix 10)
c
- (list 'horiz "(" c
- (list 'subscr ")"
- (int-to-string calc-number-radix)))))
+ (list 'subscr (math--comp-round-bracket c)
+ (int-to-string calc-number-radix))))
(math-format-number a)))
(if (not (eq calc-language 'big))
(math-format-number a prec)
(if (memq (car-safe a) '(cplx polar))
(if (math-zerop (nth 2 a))
(math-compose-expr (nth 1 a) prec)
- (list 'horiz "("
- (math-compose-expr (nth 1 a) 0)
- (if (eq (car a) 'cplx) ", " "; ")
- (math-compose-expr (nth 2 a) 0) ")"))
+ (math--comp-round-bracket
+ (list 'horiz
+ (math-compose-expr (nth 1 a) 0)
+ (if (eq (car a) 'cplx) ", " "; ")
+ (math-compose-expr (nth 2 a) 0))))
(if (or (= calc-number-radix 10)
(not (Math-realp a))
(and calc-group-digits
@@ -340,12 +340,13 @@
(funcall spfn a prec)
(math-compose-var a)))))
((eq (car a) 'intv)
- (list 'horiz
- (if (memq (nth 1 a) '(0 1)) "(" "[")
- (math-compose-expr (nth 2 a) 0)
- " .. "
- (math-compose-expr (nth 3 a) 0)
- (if (memq (nth 1 a) '(0 2)) ")" "]")))
+ (math--comp-bracket
+ (if (memq (nth 1 a) '(0 1)) ?\( ?\[)
+ (if (memq (nth 1 a) '(0 2)) ?\) ?\])
+ (list 'horiz
+ (math-compose-expr (nth 2 a) 0)
+ " .. "
+ (math-compose-expr (nth 3 a) 0))))
((eq (car a) 'date)
(if (eq (car calc-date-format) 'X)
(math-format-date a)
@@ -377,7 +378,7 @@
(and (eq (car-safe (nth 1 a)) 'cplx)
(math-negp (nth 1 (nth 1 a)))
(eq (nth 2 (nth 1 a)) 0)))
- (list 'horiz "(" (math-compose-expr (nth 1 a) 0) ")")
+ (math--comp-round-bracket (math-compose-expr (nth 1 a) 0))
(math-compose-expr (nth 1 a) 201))
(let ((calc-language 'flat)
(calc-number-radix 10)
@@ -444,7 +445,7 @@
(if (> prec (nth 2 a))
(if (setq spfn (get calc-language 'math-big-parens))
(list 'horiz (car spfn) c (cdr spfn))
- (list 'horiz "(" c ")"))
+ (math--comp-round-bracket c))
c)))
((and (eq (car a) 'calcFunc-choriz)
(not (eq calc-language 'unform))
@@ -464,14 +465,13 @@
(math-compose-vector (cdr (nth 1 a))
(math-vector-to-string sep nil)
(or cprec prec))
- (cons 'horiz (mapcar (function
- (lambda (x)
- (if (eq (car-safe x) 'calcFunc-bstring)
- (prog1
- (math-compose-expr
- x (or bprec cprec prec))
- (setq bprec -123))
- (math-compose-expr x (or cprec prec)))))
+ (cons 'horiz (mapcar (lambda (x)
+ (if (eq (car-safe x) 'calcFunc-bstring)
+ (prog1
+ (math-compose-expr
+ x (or bprec cprec prec))
+ (setq bprec -123))
+ (math-compose-expr x (or cprec prec))))
(cdr (nth 1 a)))))))
((and (memq (car a) '(calcFunc-cvert calcFunc-clvert calcFunc-crvert))
(not (eq calc-language 'unform))
@@ -482,47 +482,46 @@
(let* ((base 0)
(v 0)
(prec (or (nth 2 a) prec))
- (c (mapcar (function
- (lambda (x)
- (let ((b nil) (cc nil) a d)
- (if (and (memq (car-safe x) '(calcFunc-cbase
- calcFunc-ctbase
- calcFunc-cbbase))
- (memq (length x) '(1 2)))
- (setq b (car x)
- x (nth 1 x)))
- (if (and (eq (car-safe x) 'calcFunc-crule)
- (memq (length x) '(1 2))
- (or (null (nth 1 x))
- (and (math-vectorp (nth 1 x))
- (= (length (nth 1 x)) 2)
- (math-vector-is-string
- (nth 1 x)))
- (and (natnump (nth 1 x))
- (<= (nth 1 x) 255))))
- (setq cc (list
- 'rule
- (if (math-vectorp (nth 1 x))
- (aref (math-vector-to-string
- (nth 1 x) nil) 0)
- (or (nth 1 x) ?-))))
- (or (and (memq (car-safe x) '(calcFunc-cvspace
- calcFunc-ctspace
- calcFunc-cbspace))
- (memq (length x) '(2 3))
- (eq (nth 1 x) 0))
- (null x)
- (setq cc (math-compose-expr x prec))))
- (setq a (if cc (math-comp-ascent cc) 0)
- d (if cc (math-comp-descent cc) 0))
- (if (eq b 'calcFunc-cbase)
- (setq base (+ v a -1))
- (if (eq b 'calcFunc-ctbase)
- (setq base v)
- (if (eq b 'calcFunc-cbbase)
- (setq base (+ v a d -1)))))
- (setq v (+ v a d))
- cc)))
+ (c (mapcar (lambda (x)
+ (let ((b nil) (cc nil) a d)
+ (if (and (memq (car-safe x) '(calcFunc-cbase
+ calcFunc-ctbase
+ calcFunc-cbbase))
+ (memq (length x) '(1 2)))
+ (setq b (car x)
+ x (nth 1 x)))
+ (if (and (eq (car-safe x) 'calcFunc-crule)
+ (memq (length x) '(1 2))
+ (or (null (nth 1 x))
+ (and (math-vectorp (nth 1 x))
+ (= (length (nth 1 x)) 2)
+ (math-vector-is-string
+ (nth 1 x)))
+ (and (natnump (nth 1 x))
+ (<= (nth 1 x) 255))))
+ (setq cc (list
+ 'rule
+ (if (math-vectorp (nth 1 x))
+ (aref (math-vector-to-string
+ (nth 1 x) nil) 0)
+ (or (nth 1 x) ?-))))
+ (or (and (memq (car-safe x) '(calcFunc-cvspace
+ calcFunc-ctspace
+ calcFunc-cbspace))
+ (memq (length x) '(2 3))
+ (eq (nth 1 x) 0))
+ (null x)
+ (setq cc (math-compose-expr x prec))))
+ (setq a (if cc (math-comp-ascent cc) 0)
+ d (if cc (math-comp-descent cc) 0))
+ (if (eq b 'calcFunc-cbase)
+ (setq base (+ v a -1))
+ (if (eq b 'calcFunc-ctbase)
+ (setq base v)
+ (if (eq b 'calcFunc-cbbase)
+ (setq base (+ v a d -1)))))
+ (setq v (+ v a d))
+ cc))
(cdr (nth 1 a)))))
(setq c (delq nil c))
(if c
@@ -614,7 +613,7 @@
(list 'horiz "{left ( "
(math-compose-expr a -1)
" right )}")))
- (list 'horiz "(" (math-compose-expr a 0) ")"))))
+ (math--comp-round-bracket (math-compose-expr a 0)))))
((and (memq calc-language '(tex latex))
(memq (car a) '(/ calcFunc-choose calcFunc-evalto))
(>= prec 0))
@@ -640,7 +639,7 @@
(rhs (math-compose-expr (nth 2 a) (nth 3 op) (eq (nth 1 op) '/))))
(and (equal (car op) "^")
(eq (math-comp-first-char lhs) ?-)
- (setq lhs (list 'horiz "(" lhs ")")))
+ (setq lhs (math--comp-round-bracket lhs)))
(and (memq calc-language '(tex latex))
(or (equal (car op) "^") (equal (car op) "_"))
(not (and (stringp rhs) (= (length rhs) 1)))
@@ -723,7 +722,7 @@
(list 'horiz "{left ( "
(math-compose-expr a -1)
" right )}")))
- (list 'horiz "(" (math-compose-expr a 0) ")"))))
+ (math--comp-round-bracket (math-compose-expr a 0)))))
(t
(let ((lhs (math-compose-expr (nth 1 a) (nth 2 op))))
(list 'horiz
@@ -761,7 +760,7 @@
(list 'horiz "{left ( "
(math-compose-expr a -1)
" right )}")))
- (list 'horiz "(" (math-compose-expr a 0) ")"))))
+ (math--comp-round-bracket (math-compose-expr a 0)))))
(t
(let ((rhs (math-compose-expr (nth 1 a) (nth 3 op))))
(list 'horiz
@@ -865,16 +864,15 @@
(while (<= (setq col (1+ col)) cols)
(setq res (cons (cons math-comp-just
(cons base
- (mapcar (function
- (lambda (r)
- (list 'horiz
- (math-compose-expr
- (nth col r)
- math-comp-vector-prec)
- (if (= col cols)
- ""
- (concat
- math-comp-comma-spc " ")))))
+ (mapcar (lambda (r)
+ (list 'horiz
+ (math-compose-expr
+ (nth col r)
+ math-comp-vector-prec)
+ (if (= col cols)
+ ""
+ (concat
+ math-comp-comma-spc " "))))
a)))
res)))
(nreverse res)))
@@ -923,7 +921,7 @@
( ?\^? . "\\^?" )))
(defun math-vector-to-string (a &optional quoted)
- (setq a (concat (mapcar (function (lambda (x) (if (consp x) (nth 1 x) x)))
+ (setq a (concat (mapcar (lambda (x) (if (consp x) (nth 1 x) x))
(cdr a))))
(if (string-match "[\000-\037\177\\\"]" a)
(let ((p 0)
@@ -969,6 +967,69 @@
(and (memq (car a) '(^ calcFunc-subscr))
(math-tex-expr-is-flat (nth 1 a)))))
+;; FIXME: maybe try box drawing chars if big bracket chars are unavailable,
+;; like ┌ ┐n
+;; │a + b│ ┌ a + b ┐n
+;; │-----│ or │ ----- │ ?
+;; │ c │ └ c ┘
+;; └ ┘
+;; They are more common than the chars below, but look a bit square.
+;; Rounded corners exist but are less commonly available.
+
+(defconst math--big-bracket-alist
+ '((?\( . (?⎛ ?⎝ ?⎜))
+ (?\) . (?⎞ ?⎠ ?⎟))
+ (?\[ . (?⎡ ?⎣ ?⎢))
+ (?\] . (?⎤ ?⎦ ?⎥))
+ (?\{ . (?⎧ ?⎩ ?⎪ ?⎨))
+ (?\} . (?⎫ ?⎭ ?⎪ ?⎬)))
+ "Alist mapping bracket chars to (UPPER LOWER EXTENSION MIDPIECE).
+Not all brackets have midpieces.")
+
+(defun math--big-bracket (bracket-char height baseline)
+ "Composition for BRACKET-CHAR of HEIGHT with BASELINE."
+ (if (<= height 1)
+ (char-to-string bracket-char)
+ (let ((pieces (cdr (assq bracket-char math--big-bracket-alist))))
+ (if (memq nil (mapcar #'char-displayable-p pieces))
+ (char-to-string bracket-char)
+ (let* ((upper (nth 0 pieces))
+ (lower (nth 1 pieces))
+ (extension (nth 2 pieces))
+ (midpiece (nth 3 pieces)))
+ (cons 'vleft ; alignment doesn't matter; width is 1 char
+ (cons baseline
+ (mapcar
+ #'char-to-string
+ (append
+ (list upper)
+ (if midpiece
+ (let ((lower-ext (/ (- height 3) 2)))
+ (append
+ (make-list (- height 3 lower-ext) extension)
+ (list midpiece)
+ (make-list lower-ext extension)))
+ (make-list (- height 2) extension))
+ (list lower))))))))))
+
+(defun math--comp-bracket (left-bracket right-bracket comp)
+ "Put the composition COMP inside LEFT-BRACKET and RIGHT-BRACKET."
+ (if (eq calc-language 'big)
+ (let ((height (math-comp-height comp))
+ (baseline (1- (math-comp-ascent comp))))
+ (list 'horiz
+ (math--big-bracket left-bracket height baseline)
+ comp
+ (math--big-bracket right-bracket height baseline)))
+ (list 'horiz
+ (char-to-string left-bracket)
+ comp
+ (char-to-string right-bracket))))
+
+(defun math--comp-round-bracket (comp)
+ "Put the composition COMP inside plain brackets."
+ (math--comp-bracket ?\( ?\) comp))
+
(put 'calcFunc-log 'math-compose-big #'math-compose-log)
(defun math-compose-log (a _prec)
(and (= (length a) 3)
@@ -976,18 +1037,14 @@
(list 'subscr "log"
(let ((calc-language 'flat))
(math-compose-expr (nth 2 a) 1000)))
- "("
- (math-compose-expr (nth 1 a) 1000)
- ")")))
+ (math--comp-round-bracket (math-compose-expr (nth 1 a) 1000)))))
(put 'calcFunc-log10 'math-compose-big #'math-compose-log10)
(defun math-compose-log10 (a _prec)
(and (= (length a) 2)
(list 'horiz
- (list 'subscr "log" "10")
- "("
- (math-compose-expr (nth 1 a) 1000)
- ")")))
+ (list 'subscr "log" "10")
+ (math--comp-round-bracket (math-compose-expr (nth 1 a) 1000)))))
(put 'calcFunc-deriv 'math-compose-big #'math-compose-deriv)
(put 'calcFunc-tderiv 'math-compose-big #'math-compose-deriv)
@@ -1030,12 +1087,9 @@
(defun math-compose-choose (a _prec)
(let ((a1 (math-compose-expr (nth 1 a) 0))
(a2 (math-compose-expr (nth 2 a) 0)))
- (list 'horiz
- "("
- (list 'vcent
- (math-comp-height a1)
- a1 " " a2)
- ")")))
+ (math--comp-round-bracket (list 'vcent
+ (+ (math-comp-height a1))
+ a1 " " a2))))
(put 'calcFunc-integ 'math-compose-big #'math-compose-integ)
(defun math-compose-integ (a prec)
@@ -1055,35 +1109,64 @@
"d%s"
(nth 1 (nth 2 a)))))
(nth 1 a)) 185))
- (calc-language 'flat)
- (low (and (nth 3 a) (math-compose-expr (nth 3 a) 0)))
- (high (and (nth 4 a) (math-compose-expr (nth 4 a) 0))))
- (list 'horiz
- (if parens "(" "")
- (append (list 'vcent (if high 3 2))
- (and high (list (list 'horiz " " high)))
- '(" /"
- " | "
- " | "
- " | "
- "/ ")
- (and low (list (list 'horiz low " "))))
- expr
- (if over
- ""
- (list 'horiz " d" var))
- (if parens ")" "")))))
+ (low (and (nth 3 a)
+ (let ((calc-language 'flat))
+ (math-compose-expr (nth 3 a) 0))))
+ (high (and (nth 4 a)
+ (let ((calc-language 'flat))
+ (math-compose-expr (nth 4 a) 0))))
+ ;; Check if we have Unicode integral top/bottom parts.
+ (fancy (and (char-displayable-p ?⌠)
+ (char-displayable-p ?⌡)))
+ ;; If we do, find the most suitable middle part.
+ (fancy-stem (cond ((not fancy))
+ ;; U+23AE INTEGRAL EXTENSION
+ ((char-displayable-p ?⎮) "⎮ ")
+ ;; U+2502 BOX DRAWINGS LIGHT VERTICAL
+ ((char-displayable-p ?│) "│ ")
+ ;; U+007C VERTICAL LINE
+ (t "| "))))
+ (let ((comp
+ (list 'horiz
+ (append (list 'vcent (if fancy
+ (if high 2 1)
+ (if high 3 2)))
+ (and high (list (if fancy
+ (list 'horiz high " ")
+ (list 'horiz " " high))))
+ (if fancy
+ (list "⌠ " fancy-stem "⌡ ")
+ '(" /"
+ " | "
+ " | "
+ " | "
+ "/ "))
+ (and low (list (if fancy
+ (list 'horiz low " ")
+ (list 'horiz low " ")))))
+ expr
+ (if over
+ ""
+ (list 'horiz " d" var)))))
+ (if parens
+ (math--comp-round-bracket comp)
+ comp)))))
(put 'calcFunc-sum 'math-compose-big #'math-compose-sum)
(defun math-compose-sum (a prec)
(and (memq (length a) '(3 5 6))
(let* ((expr (math-compose-expr (nth 1 a) 185))
- (calc-language 'flat)
- (var (math-compose-expr (nth 2 a) 0))
- (low (and (nth 3 a) (math-compose-expr (nth 3 a) 0)))
- (high (and (nth 4 a) (math-compose-vector (nthcdr 4 a) ", " 0))))
- (list 'horiz
- (if (memq prec '(180 201)) "(" "")
+ (var
+ (let ((calc-language 'flat))
+ (math-compose-expr (nth 2 a) 0)))
+ (low (and (nth 3 a)
+ (let ((calc-language 'flat))
+ (math-compose-expr (nth 3 a) 0))))
+ (high (and (nth 4 a)
+ (let ((calc-language 'flat))
+ (math-compose-vector (nthcdr 4 a) ", " 0))))
+ (comp
+ (list 'horiz
(append (list 'vcent (if high 3 2))
(and high (list high))
'("---- "
@@ -1096,32 +1179,42 @@
(list var)))
(if (memq (car-safe (nth 1 a)) '(calcFunc-sum calcFunc-prod))
" " "")
- expr
- (if (memq prec '(180 201)) ")" "")))))
+ expr)))
+ (if (memq prec '(180 201))
+ (math--comp-round-bracket comp)
+ comp))))
(put 'calcFunc-prod 'math-compose-big #'math-compose-prod)
(defun math-compose-prod (a prec)
(and (memq (length a) '(3 5 6))
(let* ((expr (math-compose-expr (nth 1 a) 198))
- (calc-language 'flat)
- (var (math-compose-expr (nth 2 a) 0))
- (low (and (nth 3 a) (math-compose-expr (nth 3 a) 0)))
- (high (and (nth 4 a) (math-compose-vector (nthcdr 4 a) ", " 0))))
- (list 'horiz
- (if (memq prec '(196 201)) "(" "")
- (append (list 'vcent (if high 3 2))
- (and high (list high))
- '("----- "
- " | | "
- " | | "
- " | | ")
- (if low
- (list (list 'horiz var " = " low))
- (list var)))
- (if (memq (car-safe (nth 1 a)) '(calcFunc-sum calcFunc-prod))
- " " "")
- expr
- (if (memq prec '(196 201)) ")" "")))))
+ (var
+ (let ((calc-language 'flat))
+ (math-compose-expr (nth 2 a) 0)))
+ (low (and (nth 3 a)
+ (let ((calc-language 'flat))
+ (math-compose-expr (nth 3 a) 0))))
+ (high (and (nth 4 a)
+ (let ((calc-language 'flat))
+ (math-compose-vector (nthcdr 4 a) ", " 0))))
+ (comp
+ (list 'horiz
+ (append (list 'vcent (if high 3 2))
+ (and high (list high))
+ '("----- "
+ " | | "
+ " | | "
+ " | | ")
+ (if low
+ (list (list 'horiz var " = " low))
+ (list var)))
+ (if (memq (car-safe (nth 1 a))
+ '(calcFunc-sum calcFunc-prod))
+ " " "")
+ expr)))
+ (if (memq prec '(196 201))
+ (math--comp-round-bracket comp)
+ comp))))
;; The variables math-svo-c, math-svo-wid and math-svo-off are local
;; to math-stack-value-offset in calc.el, but are used by
diff --git a/lisp/calc/calcsel2.el b/lisp/calc/calcsel2.el
index d6842aa7eee..9c2ac975f0b 100644
--- a/lisp/calc/calcsel2.el
+++ b/lisp/calc/calcsel2.el
@@ -1,6 +1,6 @@
;;; calcsel2.el --- selection functions for Calc -*- lexical-binding:t -*-
-;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2021 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
diff --git a/lisp/calculator.el b/lisp/calculator.el
index cd92f992689..b4c00753e91 100644
--- a/lisp/calculator.el
+++ b/lisp/calculator.el
@@ -1,6 +1,6 @@
;;; calculator.el --- a calculator for Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1998, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2000-2021 Free Software Foundation, Inc.
;; Author: Eli Barzilay <eli@barzilay.org>
;; Keywords: tools, convenience
diff --git a/lisp/calendar/appt.el b/lisp/calendar/appt.el
index d7bcbb02750..281b89e088f 100644
--- a/lisp/calendar/appt.el
+++ b/lisp/calendar/appt.el
@@ -1,6 +1,6 @@
;;; appt.el --- appointment notification functions -*- lexical-binding:t -*-
-;; Copyright (C) 1989-1990, 1994, 1998, 2001-2020 Free Software
+;; Copyright (C) 1989-1990, 1994, 1998, 2001-2021 Free Software
;; Foundation, Inc.
;; Author: Neil Mager <neilm@juliet.ll.mit.edu>
@@ -700,7 +700,7 @@ ARG is positive, otherwise off."
(let ((appt-active appt-timer))
(setq appt-active (if arg (> (prefix-numeric-value arg) 0)
(not appt-active)))
- (remove-hook 'write-file-functions #'appt-update-list)
+ (remove-hook 'write-file-functions #'appt-update-list 'local)
(or global-mode-string (setq global-mode-string '("")))
(delq 'appt-mode-string global-mode-string)
(when appt-timer
@@ -708,7 +708,7 @@ ARG is positive, otherwise off."
(setq appt-timer nil))
(if appt-active
(progn
- (add-hook 'write-file-functions #'appt-update-list)
+ (add-hook 'write-file-functions #'appt-update-list nil t)
(setq appt-timer (run-at-time t 60 #'appt-check)
global-mode-string
(append global-mode-string '(appt-mode-string)))
diff --git a/lisp/calendar/cal-bahai.el b/lisp/calendar/cal-bahai.el
index 4bfdf3a6cf6..22e4cdbcd52 100644
--- a/lisp/calendar/cal-bahai.el
+++ b/lisp/calendar/cal-bahai.el
@@ -1,6 +1,6 @@
;;; cal-bahai.el --- calendar functions for the Bahá’í calendar.
-;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
;; Keywords: calendar
diff --git a/lisp/calendar/cal-china.el b/lisp/calendar/cal-china.el
index 664d05e1e81..7e5d0c46e11 100644
--- a/lisp/calendar/cal-china.el
+++ b/lisp/calendar/cal-china.el
@@ -1,6 +1,6 @@
;;; cal-china.el --- calendar functions for the Chinese calendar
-;; Copyright (C) 1995, 1997, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1997, 2001-2021 Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/calendar/cal-coptic.el b/lisp/calendar/cal-coptic.el
index 9bd9b1d14ca..3461f3259b9 100644
--- a/lisp/calendar/cal-coptic.el
+++ b/lisp/calendar/cal-coptic.el
@@ -1,6 +1,6 @@
;;; cal-coptic.el --- calendar functions for the Coptic/Ethiopic calendars
-;; Copyright (C) 1995, 1997, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1997, 2001-2021 Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/calendar/cal-dst.el b/lisp/calendar/cal-dst.el
index 05768e10c01..9e6c2959286 100644
--- a/lisp/calendar/cal-dst.el
+++ b/lisp/calendar/cal-dst.el
@@ -1,6 +1,6 @@
;;; cal-dst.el --- calendar functions for daylight saving rules -*- lexical-binding:t -*-
-;; Copyright (C) 1993-1996, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1996, 2001-2021 Free Software Foundation, Inc.
;; Author: Paul Eggert <eggert@cs.ucla.edu>
;; Edward M. Reingold <reingold@cs.uiuc.edu>
diff --git a/lisp/calendar/cal-french.el b/lisp/calendar/cal-french.el
index 4758a95a0ff..e759b5dad95 100644
--- a/lisp/calendar/cal-french.el
+++ b/lisp/calendar/cal-french.el
@@ -1,6 +1,6 @@
;;; cal-french.el --- calendar functions for the French Revolutionary calendar
-;; Copyright (C) 1988-1989, 1992, 1994-1995, 1997, 2001-2020 Free
+;; Copyright (C) 1988-1989, 1992, 1994-1995, 1997, 2001-2021 Free
;; Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
diff --git a/lisp/calendar/cal-hebrew.el b/lisp/calendar/cal-hebrew.el
index b8fbf65870f..bcc80f0877b 100644
--- a/lisp/calendar/cal-hebrew.el
+++ b/lisp/calendar/cal-hebrew.el
@@ -1,6 +1,6 @@
;;; cal-hebrew.el --- calendar functions for the Hebrew calendar
-;; Copyright (C) 1995, 1997, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1997, 2001-2021 Free Software Foundation, Inc.
;; Author: Nachum Dershowitz <nachum@cs.uiuc.edu>
;; Edward M. Reingold <reingold@cs.uiuc.edu>
diff --git a/lisp/calendar/cal-html.el b/lisp/calendar/cal-html.el
index a857cd710b6..3d7cc938437 100644
--- a/lisp/calendar/cal-html.el
+++ b/lisp/calendar/cal-html.el
@@ -1,6 +1,6 @@
;;; cal-html.el --- functions for printing HTML calendars
-;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Author: Anna M. Bigatti <bigatti@dima.unige.it>
;; Keywords: calendar
diff --git a/lisp/calendar/cal-islam.el b/lisp/calendar/cal-islam.el
index f1c76fa0f21..d256310ba6c 100644
--- a/lisp/calendar/cal-islam.el
+++ b/lisp/calendar/cal-islam.el
@@ -1,6 +1,6 @@
;;; cal-islam.el --- calendar functions for the Islamic calendar
-;; Copyright (C) 1995, 1997, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1997, 2001-2021 Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/calendar/cal-iso.el b/lisp/calendar/cal-iso.el
index 4b4fee21a36..956433e4a20 100644
--- a/lisp/calendar/cal-iso.el
+++ b/lisp/calendar/cal-iso.el
@@ -1,6 +1,6 @@
;;; cal-iso.el --- calendar functions for the ISO calendar
-;; Copyright (C) 1995, 1997, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1997, 2001-2021 Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/calendar/cal-julian.el b/lisp/calendar/cal-julian.el
index 918995d0f9b..235b4d00900 100644
--- a/lisp/calendar/cal-julian.el
+++ b/lisp/calendar/cal-julian.el
@@ -1,6 +1,6 @@
;;; cal-julian.el --- calendar functions for the Julian calendar -*- lexical-binding:t -*-
-;; Copyright (C) 1995, 1997, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1997, 2001-2021 Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/calendar/cal-mayan.el b/lisp/calendar/cal-mayan.el
index 721f76076fc..8d894ebd986 100644
--- a/lisp/calendar/cal-mayan.el
+++ b/lisp/calendar/cal-mayan.el
@@ -1,6 +1,6 @@
;;; cal-mayan.el --- calendar functions for the Mayan calendars
-;; Copyright (C) 1992-1993, 1995, 1997, 2001-2020 Free Software
+;; Copyright (C) 1992-1993, 1995, 1997, 2001-2021 Free Software
;; Foundation, Inc.
;; Author: Stewart M. Clamen <clamen@cs.cmu.edu>
diff --git a/lisp/calendar/cal-menu.el b/lisp/calendar/cal-menu.el
index f4d46e6cdde..a30c681a897 100644
--- a/lisp/calendar/cal-menu.el
+++ b/lisp/calendar/cal-menu.el
@@ -1,6 +1,6 @@
;;; cal-menu.el --- calendar functions for menu bar and popup menu support
-;; Copyright (C) 1994-1995, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1995, 2001-2021 Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; Lara Rios <lrios@coewl.cen.uiuc.edu>
diff --git a/lisp/calendar/cal-move.el b/lisp/calendar/cal-move.el
index 6345a02846b..710ce37ccbf 100644
--- a/lisp/calendar/cal-move.el
+++ b/lisp/calendar/cal-move.el
@@ -1,6 +1,6 @@
;;; cal-move.el --- calendar functions for movement in the calendar
-;; Copyright (C) 1995, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 2001-2021 Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/calendar/cal-persia.el b/lisp/calendar/cal-persia.el
index 9d1432f076d..a9c99fedbdb 100644
--- a/lisp/calendar/cal-persia.el
+++ b/lisp/calendar/cal-persia.el
@@ -1,6 +1,6 @@
;;; cal-persia.el --- calendar functions for the Persian calendar
-;; Copyright (C) 1996-1997, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1997, 2001-2021 Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/calendar/cal-tex.el b/lisp/calendar/cal-tex.el
index ded065789f8..9df9f4cbedf 100644
--- a/lisp/calendar/cal-tex.el
+++ b/lisp/calendar/cal-tex.el
@@ -1,6 +1,6 @@
;;; cal-tex.el --- calendar functions for printing calendars with LaTeX
-;; Copyright (C) 1995, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 2001-2021 Free Software Foundation, Inc.
;; Author: Steve Fisk <fisk@bowdoin.edu>
;; Edward M. Reingold <reingold@cs.uiuc.edu>
diff --git a/lisp/calendar/cal-x.el b/lisp/calendar/cal-x.el
index 8cefd4fd4c3..1c19a60db10 100644
--- a/lisp/calendar/cal-x.el
+++ b/lisp/calendar/cal-x.el
@@ -1,6 +1,6 @@
;;; cal-x.el --- calendar windows in dedicated frames
-;; Copyright (C) 1994-1995, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1995, 2001-2021 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Edward M. Reingold <reingold@cs.uiuc.edu>
diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el
index de9b1f3ff53..21cea212e18 100644
--- a/lisp/calendar/calendar.el
+++ b/lisp/calendar/calendar.el
@@ -1,6 +1,6 @@
;;; calendar.el --- calendar functions -*- lexical-binding:t -*-
-;; Copyright (C) 1988-1995, 1997, 2000-2020 Free Software Foundation,
+;; Copyright (C) 1988-1995, 1997, 2000-2021 Free Software Foundation,
;; Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
@@ -1788,7 +1788,7 @@ For a complete description, see the info node `Calendar/Diary'.
(setq buffer-read-only t
buffer-undo-list t
indent-tabs-mode nil)
- (set (make-local-variable 'scroll-margin) 0) ; bug#10379
+ (setq-local scroll-margin 0) ; bug#10379
(calendar-update-mode-line)
(make-local-variable 'calendar-mark-ring)
(make-local-variable 'displayed-month) ; month in middle of window
diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el
index fbc13f59b2a..aad70161f9f 100644
--- a/lisp/calendar/diary-lib.el
+++ b/lisp/calendar/diary-lib.el
@@ -1,6 +1,6 @@
;;; diary-lib.el --- diary functions -*- lexical-binding:t -*-
-;; Copyright (C) 1989-1990, 1992-1995, 2001-2020 Free Software
+;; Copyright (C) 1989-1990, 1992-1995, 2001-2021 Free Software
;; Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
@@ -73,18 +73,18 @@ are holidays."
;; follows: the first line matching "^# [tag:value]" defines the value
;; for that particular tag.
(defcustom diary-face-attrs
- '((" *\\[foreground:\\([-a-z]+\\)\\]$" 1 :foreground string)
- (" *\\[background:\\([-a-z]+\\)\\]$" 1 :background string)
- (" *\\[width:\\([-a-z]+\\)\\]$" 1 :width symbol)
- (" *\\[height:\\([.0-9]+\\)\\]$" 1 :height int)
- (" *\\[weight:\\([-a-z]+\\)\\]$" 1 :weight symbol)
- (" *\\[slant:\\([-a-z]+\\)\\]$" 1 :slant symbol)
- (" *\\[underline:\\([-a-z]+\\)\\]$" 1 :underline stringtnil)
- (" *\\[overline:\\([-a-z]+\\)\\]$" 1 :overline stringtnil)
- (" *\\[strike-through:\\([-a-z]+\\)\\]$" 1 :strike-through stringtnil)
- (" *\\[inverse-video:\\([-a-z]+\\)\\]$" 1 :inverse-video tnil)
- (" *\\[face:\\([-0-9a-z]+\\)\\]$" 1 :face string)
- (" *\\[font:\\([-a-z0-9]+\\)\\]$" 1 :font string)
+ '((" *\\[foreground:\\([-a-z]+\\)\\] *" 1 :foreground string)
+ (" *\\[background:\\([-a-z]+\\)\\] *" 1 :background string)
+ (" *\\[width:\\([-a-z]+\\)\\] *" 1 :width symbol)
+ (" *\\[height:\\([.0-9]+\\)\\] *" 1 :height int)
+ (" *\\[weight:\\([-a-z]+\\)\\] *" 1 :weight symbol)
+ (" *\\[slant:\\([-a-z]+\\)\\] *" 1 :slant symbol)
+ (" *\\[underline:\\([-a-z]+\\)\\] *" 1 :underline stringtnil)
+ (" *\\[overline:\\([-a-z]+\\)\\] *" 1 :overline stringtnil)
+ (" *\\[strike-through:\\([-a-z]+\\)\\] *" 1 :strike-through stringtnil)
+ (" *\\[inverse-video:\\([-a-z]+\\)\\] *" 1 :inverse-video tnil)
+ (" *\\[face:\\([-0-9a-z]+\\)\\] *" 1 :face string)
+ (" *\\[font:\\([-a-z0-9]+\\)\\] *" 1 :font string)
;; Unsupported.
;;; (" *\\[box:\\([-a-z]+\\)\\]$" 1 :box)
;;; (" *\\[stipple:\\([-a-z]+\\)\\]$" 1 :stipple)
@@ -839,7 +839,7 @@ LIST-ONLY is non-nil, in which case it just returns the list."
(goto-char (point-min))
(unless list-only
(let ((ol (make-overlay (point-min) (point-max) nil t nil)))
- (set (make-local-variable 'diary-selective-display) t)
+ (setq-local diary-selective-display t)
(overlay-put ol 'invisible 'diary)
(overlay-put ol 'evaporate t)))
(dotimes (_ number)
@@ -2381,10 +2381,9 @@ return a font-lock pattern matching array of MONTHS and marking SYMBOL."
;;;###autoload
(define-derived-mode diary-mode fundamental-mode "Diary"
"Major mode for editing the diary file."
- (set (make-local-variable 'font-lock-defaults)
- '(diary-font-lock-keywords t))
- (set (make-local-variable 'comment-start) diary-comment-start)
- (set (make-local-variable 'comment-end) diary-comment-end)
+ (setq-local font-lock-defaults '(diary-font-lock-keywords t))
+ (setq-local comment-start diary-comment-start)
+ (setq-local comment-end diary-comment-end)
(add-to-invisibility-spec '(diary . nil))
(add-hook 'after-save-hook #'diary-redraw-calendar nil t)
;; In case the file was modified externally, refresh the calendar
@@ -2465,13 +2464,13 @@ Fontify the region between BEG and END, quietly unless VERBOSE is non-nil."
(define-derived-mode diary-fancy-display-mode special-mode
"Diary"
"Major mode used while displaying diary entries using Fancy Display."
- (set (make-local-variable 'font-lock-defaults)
- '(diary-fancy-font-lock-keywords
- t nil nil nil
- (font-lock-fontify-region-function
- . diary-fancy-font-lock-fontify-region-function)))
- (set (make-local-variable 'minor-mode-overriding-map-alist)
- (list (cons t diary-fancy-overriding-map)))
+ (setq-local font-lock-defaults
+ '(diary-fancy-font-lock-keywords
+ t nil nil nil
+ (font-lock-fontify-region-function
+ . diary-fancy-font-lock-fontify-region-function)))
+ (setq-local minor-mode-overriding-map-alist
+ (list (cons t diary-fancy-overriding-map)))
(view-mode 1))
;; Following code from Dave Love <fx@gnu.org>.
diff --git a/lisp/calendar/holidays.el b/lisp/calendar/holidays.el
index 444a0e53b95..932993beba0 100644
--- a/lisp/calendar/holidays.el
+++ b/lisp/calendar/holidays.el
@@ -1,6 +1,6 @@
;;; holidays.el --- holiday functions for the calendar package -*- lexical-binding:t -*-
-;; Copyright (C) 1989-1990, 1992-1994, 1997, 2001-2020 Free Software
+;; Copyright (C) 1989-1990, 1992-1994, 1997, 2001-2021 Free Software
;; Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el
index dab277487e2..1d7de4a0c5d 100644
--- a/lisp/calendar/icalendar.el
+++ b/lisp/calendar/icalendar.el
@@ -1,6 +1,6 @@
;;; icalendar.el --- iCalendar implementation -*- lexical-binding: t -*-
-;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Author: Ulf Jasper <ulf.jasper@web.de>
;; Created: August 2002
diff --git a/lisp/calendar/iso8601.el b/lisp/calendar/iso8601.el
index 906c29b15f4..5a109a73cd9 100644
--- a/lisp/calendar/iso8601.el
+++ b/lisp/calendar/iso8601.el
@@ -1,6 +1,6 @@
;;; iso8601.el --- parse ISO 8601 date/time strings -*- lexical-binding:t -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; Keywords: dates
diff --git a/lisp/calendar/lunar.el b/lisp/calendar/lunar.el
index 1c0f4da0f4b..dd1d923f423 100644
--- a/lisp/calendar/lunar.el
+++ b/lisp/calendar/lunar.el
@@ -1,6 +1,6 @@
;;; lunar.el --- calendar functions for phases of the moon -*- lexical-binding:t -*-
-;; Copyright (C) 1992-1993, 1995, 1997, 2001-2020 Free Software
+;; Copyright (C) 1992-1993, 1995, 1997, 2001-2021 Free Software
;; Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
diff --git a/lisp/calendar/parse-time.el b/lisp/calendar/parse-time.el
index b199fca2db5..ba7418faf78 100644
--- a/lisp/calendar/parse-time.el
+++ b/lisp/calendar/parse-time.el
@@ -1,6 +1,6 @@
;;; parse-time.el --- parsing time strings -*- lexical-binding: t -*-
-;; Copyright (C) 1996, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 2000-2021 Free Software Foundation, Inc.
;; Author: Erik Naggum <erik@naggum.no>
;; Keywords: util
diff --git a/lisp/calendar/solar.el b/lisp/calendar/solar.el
index 07562f62240..372490db9ec 100644
--- a/lisp/calendar/solar.el
+++ b/lisp/calendar/solar.el
@@ -1,6 +1,6 @@
;;; solar.el --- calendar functions for solar events -*- lexical-binding:t -*-
-;; Copyright (C) 1992-1993, 1995, 1997, 2001-2020 Free Software
+;; Copyright (C) 1992-1993, 1995, 1997, 2001-2021 Free Software
;; Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el
index cf6c20afbd2..2df57a3c33d 100644
--- a/lisp/calendar/time-date.el
+++ b/lisp/calendar/time-date.el
@@ -1,6 +1,6 @@
;;; time-date.el --- Date and time handling functions -*- lexical-binding: t -*-
-;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Masanobu Umeda <umerin@mse.kyutech.ac.jp>
diff --git a/lisp/calendar/timeclock.el b/lisp/calendar/timeclock.el
index a26da265fe8..0bbaa1e1ed6 100644
--- a/lisp/calendar/timeclock.el
+++ b/lisp/calendar/timeclock.el
@@ -1,6 +1,6 @@
;;; timeclock.el --- mode for keeping track of how much you work -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
;; Created: 25 Mar 1999
@@ -37,8 +37,6 @@
;; You'll probably want to bind the timeclock commands to some handy
;; keystrokes. At the moment, C-x t is unused:
;;
-;; (require 'timeclock)
-;;
;; (define-key ctl-x-map "ti" 'timeclock-in)
;; (define-key ctl-x-map "to" 'timeclock-out)
;; (define-key ctl-x-map "tc" 'timeclock-change)
diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el
index 3975a9ba6a9..0daa1530109 100644
--- a/lisp/calendar/todo-mode.el
+++ b/lisp/calendar/todo-mode.el
@@ -1,6 +1,6 @@
;;; todo-mode.el --- facilities for making and maintaining todo lists -*- lexical-binding:t -*-
-;; Copyright (C) 1997, 1999, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1999, 2001-2021 Free Software Foundation, Inc.
;; Author: Oliver Seidel <privat@os10000.net>
;; Stephen Berman <stephen.berman@gmx.net>
@@ -2745,9 +2745,10 @@ section in the category moved to."
(setq ov (make-overlay (save-excursion (todo-item-start))
(save-excursion (todo-item-end))))
(overlay-put ov 'face 'todo-search))
- (let* ((pl (if (and marked (> (cdr marked) 1)) "s" ""))
- (cat+file (todo-read-category (concat "Move item" pl
- " to category: ")
+ (let* ((num (if (not marked) 1 (cdr marked)))
+ (cat+file (todo-read-category
+ (ngettext "Move item to category: "
+ "Move items to category: " num)
nil file)))
(while (and (equal (car cat+file) cat1)
(equal (cdr cat+file) file1))
@@ -2974,7 +2975,7 @@ comments without asking."
(interactive)
(let* ((cat (todo-current-category))
(marked (assoc cat todo-categories-with-marks))
- (pl (if (and marked (> (cdr marked) 1)) "s" "")))
+ (num (if (not marked) 1 (cdr marked))))
(when (or marked (todo-done-item-p))
(let ((buffer-read-only)
(opoint (point))
@@ -2982,6 +2983,9 @@ comments without asking."
(first 'first)
(item-count 0)
(diary-count 0)
+ (omit-prompt (ngettext "Omit comment from restored item? "
+ "Omit comments from restored items? "
+ num))
start end item ov npoint undone)
(and marked (goto-char (point-min)))
(catch 'done
@@ -3013,10 +3017,7 @@ comments without asking."
(if (eq first 'first)
(setq first
(if (eq todo-undo-item-omit-comment 'ask)
- (when (todo-y-or-n-p
- (concat "Omit comment" pl
- " from restored item"
- pl "? "))
+ (when (todo-y-or-n-p omit-prompt)
'omit)
(when todo-undo-item-omit-comment 'omit)))
t)
@@ -5782,11 +5783,13 @@ have been removed."
(delete f todo-category-completions-files))
(push f deleted)))
(when deleted
- (let ((pl (> (length deleted) 1))
+ (let ((ndeleted (length deleted))
(names (mapconcat (lambda (f) (concat "\"" f "\"")) deleted ", ")))
- (message (concat "File" (if pl "s" "") " %s ha" (if pl "ve" "s")
- " been deleted and removed from\n"
- "the list of category completion files")
+ (message (concat
+ (ngettext "File %s has been deleted and removed from\n"
+ "Files %s have been deleted and removed from\n"
+ ndeleted)
+ "the list of category completion files")
names))
(put 'todo-category-completions-files 'custom-type
`(set ,@(todo--files-type-list)))
diff --git a/lisp/case-table.el b/lisp/case-table.el
index 7379f379615..457e026f912 100644
--- a/lisp/case-table.el
+++ b/lisp/case-table.el
@@ -1,6 +1,6 @@
;;; case-table.el --- code to extend the character set and support case tables -*- lexical-binding: t -*-
-;; Copyright (C) 1988, 1994, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 1994, 2001-2021 Free Software Foundation, Inc.
;; Author: Howard Gayle
;; Maintainer: emacs-devel@gnu.org
@@ -38,26 +38,26 @@
(interactive)
(let ((description (make-char-table 'case-table)))
(map-char-table
- (function (lambda (key value)
- (if (not (natnump value))
- (if (consp key)
- (set-char-table-range description key "case-invariant")
- (aset description key "case-invariant"))
- (let (from to)
- (if (consp key)
- (setq from (car key) to (cdr key))
- (setq from (setq to key)))
- (while (<= from to)
- (aset
- description from
- (cond ((/= from (downcase from))
- (concat "uppercase, matches "
- (char-to-string (downcase from))))
- ((/= from (upcase from))
- (concat "lowercase, matches "
- (char-to-string (upcase from))))
- (t "case-invariant")))
- (setq from (1+ from)))))))
+ (lambda (key value)
+ (if (not (natnump value))
+ (if (consp key)
+ (set-char-table-range description key "case-invariant")
+ (aset description key "case-invariant"))
+ (let (from to)
+ (if (consp key)
+ (setq from (car key) to (cdr key))
+ (setq from (setq to key)))
+ (while (<= from to)
+ (aset
+ description from
+ (cond ((/= from (downcase from))
+ (concat "uppercase, matches "
+ (char-to-string (downcase from))))
+ ((/= from (upcase from))
+ (concat "lowercase, matches "
+ (char-to-string (upcase from))))
+ (t "case-invariant")))
+ (setq from (1+ from))))))
(current-case-table))
(save-excursion
(with-output-to-temp-buffer "*Help*"
diff --git a/lisp/cdl.el b/lisp/cdl.el
index c8025a9f530..0f181ac6d4e 100644
--- a/lisp/cdl.el
+++ b/lisp/cdl.el
@@ -1,6 +1,6 @@
;;; cdl.el --- Common Data Language (CDL) utility functions for GNU Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 2001-2021 Free Software Foundation, Inc.
;; Author: Ata Etemadi <ATAE@spva.physics.imperial.ac.uk>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/cedet/ChangeLog.1 b/lisp/cedet/ChangeLog.1
index a1c0e41b8da..fb3dcd23965 100644
--- a/lisp/cedet/ChangeLog.1
+++ b/lisp/cedet/ChangeLog.1
@@ -3460,7 +3460,7 @@
;; coding: utf-8
;; End:
- Copyright (C) 2009-2020 Free Software Foundation, Inc.
+ Copyright (C) 2009-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/cedet/cedet-cscope.el b/lisp/cedet/cedet-cscope.el
index 68eb446f645..75a69db0a8c 100644
--- a/lisp/cedet/cedet-cscope.el
+++ b/lisp/cedet/cedet-cscope.el
@@ -1,6 +1,6 @@
;;; cedet-cscope.el --- CScope support for CEDET
-;;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Package: cedet
diff --git a/lisp/cedet/cedet-files.el b/lisp/cedet/cedet-files.el
index 212a24f1613..31608159cc1 100644
--- a/lisp/cedet/cedet-files.el
+++ b/lisp/cedet/cedet-files.el
@@ -1,6 +1,6 @@
;;; cedet-files.el --- Common routines dealing with file names.
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Package: cedet
diff --git a/lisp/cedet/cedet-global.el b/lisp/cedet/cedet-global.el
index 82751ec2d6c..5878ec1f485 100644
--- a/lisp/cedet/cedet-global.el
+++ b/lisp/cedet/cedet-global.el
@@ -1,6 +1,6 @@
;;; cedet-global.el --- GNU Global support for CEDET.
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Package: cedet
diff --git a/lisp/cedet/cedet-idutils.el b/lisp/cedet/cedet-idutils.el
index 0efd7ee3053..fc5e05af88e 100644
--- a/lisp/cedet/cedet-idutils.el
+++ b/lisp/cedet/cedet-idutils.el
@@ -1,6 +1,6 @@
;;; cedet-idutils.el --- ID Utils support for CEDET.
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Old-Version: 0.2
diff --git a/lisp/cedet/cedet.el b/lisp/cedet/cedet.el
index cb520684fdd..caaec473a2c 100644
--- a/lisp/cedet/cedet.el
+++ b/lisp/cedet/cedet.el
@@ -1,6 +1,6 @@
;;; cedet.el --- Setup CEDET environment
-;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
;; Maintainer: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/data-debug.el b/lisp/cedet/data-debug.el
index 44cce389cb3..a062a5a5853 100644
--- a/lisp/cedet/data-debug.el
+++ b/lisp/cedet/data-debug.el
@@ -1,6 +1,6 @@
;;; data-debug.el --- Data structure debugger
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Old-Version: 0.2
@@ -42,7 +42,6 @@
;; (data-debug-show-stuff stuff "myStuff"))
;; stuff))
-(require 'font-lock)
(require 'ring)
;;; Code:
@@ -882,9 +881,8 @@ If PARENT is non-nil, it is somehow related as a parent to thing."
(setq-local comment-start-skip
"\\(\\(^\\|[^\\\n]\\)\\(\\\\\\\\\\)*\\);+ *")
(buffer-disable-undo)
- (set (make-local-variable 'font-lock-global-modes) nil)
- (font-lock-mode -1)
- )
+ (setq-local font-lock-global-modes nil)
+ (font-lock-mode -1))
;;;###autoload
(defun data-debug-new-buffer (name)
diff --git a/lisp/cedet/ede.el b/lisp/cedet/ede.el
index 41252815734..14289153e81 100644
--- a/lisp/cedet/ede.el
+++ b/lisp/cedet/ede.el
@@ -1,6 +1,6 @@
;;; ede.el --- Emacs Development Environment gloss
-;; Copyright (C) 1998-2005, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2005, 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
diff --git a/lisp/cedet/ede/auto.el b/lisp/cedet/ede/auto.el
index 50ed4625bab..e1417d7806c 100644
--- a/lisp/cedet/ede/auto.el
+++ b/lisp/cedet/ede/auto.el
@@ -1,6 +1,6 @@
;;; ede/auto.el --- Autoload features for EDE
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -64,24 +64,22 @@ location is varied dependent on other complex criteria, this class
can be used to define that match without loading the specific project
into memory.")
+(cl-defmethod ede-calc-fromconfig ((dirmatch ede-project-autoload-dirmatch))
+ "Calculate the value of :fromconfig from DIRMATCH."
+ (let* ((fc (oref dirmatch fromconfig))
+ (found (cond ((stringp fc) fc)
+ ((functionp fc) (funcall fc))
+ (t (error "Unknown dirmatch object match style.")))))
+ (expand-file-name found)
+ ))
+
(cl-defmethod ede-dirmatch-installed ((dirmatch ede-project-autoload-dirmatch))
"Return non-nil if the tool DIRMATCH might match is installed on the system."
- (let ((fc (oref dirmatch fromconfig)))
-
- (cond
- ;; If the thing to match is stored in a config file.
- ((stringp fc)
- (file-exists-p fc))
-
- ;; Add new types of dirmatches here.
-
- ;; Error for weird stuff
- (t (error "Unknown dirmatch type.")))))
-
+ (file-exists-p (ede-calc-fromconfig dirmatch)))
(cl-defmethod ede-do-dirmatch ((dirmatch ede-project-autoload-dirmatch) file)
"Does DIRMATCH match the filename FILE."
- (let ((fc (oref dirmatch fromconfig)))
+ (let ((fc (ede-calc-fromconfig dirmatch)))
(cond
;; If the thing to match is stored in a config file.
diff --git a/lisp/cedet/ede/autoconf-edit.el b/lisp/cedet/ede/autoconf-edit.el
index 409e35ef900..ca8535fdf23 100644
--- a/lisp/cedet/ede/autoconf-edit.el
+++ b/lisp/cedet/ede/autoconf-edit.el
@@ -1,6 +1,6 @@
;;; ede/autoconf-edit.el --- Keymap for autoconf
-;; Copyright (C) 1998-2000, 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2000, 2009-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project
diff --git a/lisp/cedet/ede/base.el b/lisp/cedet/ede/base.el
index d371ad799a7..810d6ef3bd4 100644
--- a/lisp/cedet/ede/base.el
+++ b/lisp/cedet/ede/base.el
@@ -1,6 +1,6 @@
;;; ede/base.el --- Baseclasses for EDE.
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -160,16 +160,13 @@ and querying them will cause the actual project to get loaded.")
;; Projects can also affect how EDE works, by changing what appears in
;; the EDE menu, or how some keys are bound.
;;
-(unless (fboundp 'ede-target-list-p)
- (cl-deftype ede-target-list () '(list-of ede-target)))
-
(defclass ede-project (ede-project-placeholder)
((subproj :initform nil
:type list
:documentation "Sub projects controlled by this project.
For Automake based projects, each directory is treated as a project.")
(targets :initarg :targets
- :type ede-target-list
+ :type (list-of ede-target)
:custom (repeat (object :objectcreatefcn ede-new-target-custom))
:label "Local Targets"
:group (targets)
diff --git a/lisp/cedet/ede/config.el b/lisp/cedet/ede/config.el
index 07260f0b076..19686216cd5 100644
--- a/lisp/cedet/ede/config.el
+++ b/lisp/cedet/ede/config.el
@@ -1,6 +1,6 @@
;;; ede/config.el --- Configuration Handler baseclass
-;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/ede/cpp-root.el b/lisp/cedet/ede/cpp-root.el
index f0dbccb7fc1..41f0c682892 100644
--- a/lisp/cedet/ede/cpp-root.el
+++ b/lisp/cedet/ede/cpp-root.el
@@ -1,6 +1,6 @@
;;; ede/cpp-root.el --- A simple way to wrap a C++ project with a single root
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/ede/custom.el b/lisp/cedet/ede/custom.el
index 18621ad5f12..aada872cd0a 100644
--- a/lisp/cedet/ede/custom.el
+++ b/lisp/cedet/ede/custom.el
@@ -1,6 +1,6 @@
;;; ede/custom.el --- customization of EDE projects.
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -50,8 +50,7 @@
(let* ((ov (oref (ede-current-project) local-variables))
(cp (ede-current-project)))
(ede-customize cp)
- (make-local-variable 'eieio-ede-old-variables)
- (setq eieio-ede-old-variables ov)))
+ (setq-local eieio-ede-old-variables ov)))
;;;###autoload
(defalias 'customize-project 'ede-customize-project)
diff --git a/lisp/cedet/ede/detect.el b/lisp/cedet/ede/detect.el
index fe23501807a..027d008ea38 100644
--- a/lisp/cedet/ede/detect.el
+++ b/lisp/cedet/ede/detect.el
@@ -1,6 +1,6 @@
;;; ede/detect.el --- EDE project detection and file associations
-;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/ede/dired.el b/lisp/cedet/ede/dired.el
index e8c80275444..c85d4ee7924 100644
--- a/lisp/cedet/ede/dired.el
+++ b/lisp/cedet/ede/dired.el
@@ -1,6 +1,6 @@
;;; ede/dired.el --- EDE extensions to dired.
-;; Copyright (C) 1998-2000, 2003, 2009-2020 Free Software Foundation,
+;; Copyright (C) 1998-2000, 2003, 2009-2021 Free Software Foundation,
;; Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/ede/emacs.el b/lisp/cedet/ede/emacs.el
index a052c5c61e7..1eb4c6395a4 100644
--- a/lisp/cedet/ede/emacs.el
+++ b/lisp/cedet/ede/emacs.el
@@ -1,6 +1,6 @@
;;; ede/emacs.el --- Special project for Emacs
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/ede/files.el b/lisp/cedet/ede/files.el
index 1d6a082c5d3..cf5396ad00e 100644
--- a/lisp/cedet/ede/files.el
+++ b/lisp/cedet/ede/files.el
@@ -1,6 +1,6 @@
;;; ede/files.el --- Associate projects with files and directories.
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/ede/generic.el b/lisp/cedet/ede/generic.el
index b9805f6fac9..3d1e1c5818e 100644
--- a/lisp/cedet/ede/generic.el
+++ b/lisp/cedet/ede/generic.el
@@ -1,6 +1,6 @@
;;; ede/generic.el --- Base Support for generic build systems
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -258,8 +258,8 @@ If one doesn't exist, create a new one for this directory."
INTERNAL-NAME is obsolete and ignored.
EXTERNAL-NAME is a human readable name to describe the project; it
must be unique among all autoloaded projects.
-PROJECTFILE is a file name that identifies a project of this type to EDE, such as
-a Makefile, or SConstruct file.
+PROJECTFILE is a file name that identifies a project of this type to EDE, such
+as a Makefile, or SConstruct file.
CLASS is the EIEIO class that is used to track this project. It should subclass
`ede-generic-project'."
(ede-add-project-autoload
diff --git a/lisp/cedet/ede/linux.el b/lisp/cedet/ede/linux.el
index 8ce6b5c2a4f..7a1c4c9e262 100644
--- a/lisp/cedet/ede/linux.el
+++ b/lisp/cedet/ede/linux.el
@@ -1,6 +1,6 @@
;;; ede/linux.el --- Special project for Linux
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/ede/locate.el b/lisp/cedet/ede/locate.el
index 160309ffce4..e6a89533cca 100644
--- a/lisp/cedet/ede/locate.el
+++ b/lisp/cedet/ede/locate.el
@@ -1,6 +1,6 @@
;;; ede/locate.el --- Locate support
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/ede/make.el b/lisp/cedet/ede/make.el
index 140e7387a68..863d715e4f1 100644
--- a/lisp/cedet/ede/make.el
+++ b/lisp/cedet/ede/make.el
@@ -1,6 +1,6 @@
;;; ede/make.el --- General information about "make"
-;;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/ede/makefile-edit.el b/lisp/cedet/ede/makefile-edit.el
index 218e75c0a8a..43655a5d1e3 100644
--- a/lisp/cedet/ede/makefile-edit.el
+++ b/lisp/cedet/ede/makefile-edit.el
@@ -1,6 +1,6 @@
;;; makefile-edit.el --- Makefile editing/scanning commands.
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/ede/pconf.el b/lisp/cedet/ede/pconf.el
index b85b397af2d..5bed32ff058 100644
--- a/lisp/cedet/ede/pconf.el
+++ b/lisp/cedet/ede/pconf.el
@@ -1,6 +1,6 @@
;;; ede/pconf.el --- configure.ac maintenance for EDE
-;;; Copyright (C) 1998-2000, 2005, 2008-2020 Free Software Foundation,
+;;; Copyright (C) 1998-2000, 2005, 2008-2021 Free Software Foundation,
;;; Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/ede/pmake.el b/lisp/cedet/ede/pmake.el
index 9d9a95fd763..4c948df4102 100644
--- a/lisp/cedet/ede/pmake.el
+++ b/lisp/cedet/ede/pmake.el
@@ -1,6 +1,6 @@
;;; ede-pmake.el --- EDE Generic Project Makefile code generator.
-;; Copyright (C) 1998-2005, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2005, 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
@@ -180,7 +180,7 @@ MFILENAME is the makefile to generate."
;;
;; NOTE: This is GNU Make specific.
(if (and (oref this automatic-dependencies) df)
- (insert "DEPS_MAGIC := $(shell mkdir .deps > /dev/null "
+ (insert "DEPS_MAGIC := $(shell mkdir .deps > " null-device " "
"2>&1 || :)\n"
"-include $(DEP_FILES)\n\n"))
;;
diff --git a/lisp/cedet/ede/proj-archive.el b/lisp/cedet/ede/proj-archive.el
index 78764e3d499..2b1e50dcea3 100644
--- a/lisp/cedet/ede/proj-archive.el
+++ b/lisp/cedet/ede/proj-archive.el
@@ -1,6 +1,6 @@
;;; ede/proj-archive.el --- EDE Generic Project archive support
-;; Copyright (C) 1998-2001, 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2001, 2009-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
diff --git a/lisp/cedet/ede/proj-aux.el b/lisp/cedet/ede/proj-aux.el
index 0c35647fe9a..f5bcebdd4cf 100644
--- a/lisp/cedet/ede/proj-aux.el
+++ b/lisp/cedet/ede/proj-aux.el
@@ -1,6 +1,6 @@
;;; ede/proj-aux.el --- EDE Generic Project auxiliary file support
-;; Copyright (C) 1998-2000, 2007, 2009-2020 Free Software Foundation,
+;; Copyright (C) 1998-2000, 2007, 2009-2021 Free Software Foundation,
;; Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/ede/proj-comp.el b/lisp/cedet/ede/proj-comp.el
index 5e9cf49b7ed..26aa66873a3 100644
--- a/lisp/cedet/ede/proj-comp.el
+++ b/lisp/cedet/ede/proj-comp.el
@@ -1,6 +1,6 @@
;;; ede/proj-comp.el --- EDE Generic Project compiler/rule driver
-;; Copyright (C) 1999-2001, 2004-2005, 2007, 2009-2020 Free Software
+;; Copyright (C) 1999-2001, 2004-2005, 2007, 2009-2021 Free Software
;; Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/ede/proj-elisp.el b/lisp/cedet/ede/proj-elisp.el
index bcd672133db..9ec96945c10 100644
--- a/lisp/cedet/ede/proj-elisp.el
+++ b/lisp/cedet/ede/proj-elisp.el
@@ -1,6 +1,6 @@
;;; ede-proj-elisp.el --- EDE Generic Project Emacs Lisp support
-;; Copyright (C) 1998-2005, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2005, 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
@@ -36,7 +36,7 @@
(keybindings :initform nil)
(phony :initform t)
(sourcetype :initform '(ede-source-emacs))
- (availablecompilers :initform '(ede-emacs-compiler ede-xemacs-compiler))
+ (availablecompilers :initform '(ede-emacs-compiler))
(aux-packages :initarg :aux-packages
:initform nil
:type list
@@ -104,6 +104,7 @@ For Emacs Lisp, return addsuffix command on source files."
:name "xemacs"
:variables '(("EMACS" . "xemacs")))
"Compile Emacs Lisp programs with XEmacs.")
+(make-obsolete-variable 'ede-xemacs-compiler 'ede-emacs-compiler "28.1")
;;; Claiming files
(cl-defmethod ede-buffer-mine ((this ede-proj-target-elisp) buffer)
diff --git a/lisp/cedet/ede/proj-info.el b/lisp/cedet/ede/proj-info.el
index ee41d0cc01d..3d437016e93 100644
--- a/lisp/cedet/ede/proj-info.el
+++ b/lisp/cedet/ede/proj-info.el
@@ -1,6 +1,6 @@
;;; ede-proj-info.el --- EDE Generic Project texinfo support
-;;; Copyright (C) 1998-2001, 2004, 2007-2020 Free Software Foundation,
+;;; Copyright (C) 1998-2001, 2004, 2007-2021 Free Software Foundation,
;;; Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/ede/proj-misc.el b/lisp/cedet/ede/proj-misc.el
index a73d03f1b80..70132aff6c3 100644
--- a/lisp/cedet/ede/proj-misc.el
+++ b/lisp/cedet/ede/proj-misc.el
@@ -1,6 +1,6 @@
;;; ede-proj-misc.el --- EDE Generic Project Emacs Lisp support
-;; Copyright (C) 1998-2001, 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2001, 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
diff --git a/lisp/cedet/ede/proj-obj.el b/lisp/cedet/ede/proj-obj.el
index 22a6cdfad47..3aa4497f932 100644
--- a/lisp/cedet/ede/proj-obj.el
+++ b/lisp/cedet/ede/proj-obj.el
@@ -1,6 +1,6 @@
;;; ede/proj-obj.el --- EDE Generic Project Object code generation support
-;;; Copyright (C) 1998-2000, 2005, 2008-2020 Free Software Foundation,
+;;; Copyright (C) 1998-2000, 2005, 2008-2021 Free Software Foundation,
;;; Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/ede/proj-prog.el b/lisp/cedet/ede/proj-prog.el
index 5a12256048f..3817cd7d40e 100644
--- a/lisp/cedet/ede/proj-prog.el
+++ b/lisp/cedet/ede/proj-prog.el
@@ -1,6 +1,6 @@
;;; ede-proj-prog.el --- EDE Generic Project program support
-;; Copyright (C) 1998-2001, 2005, 2008-2020 Free Software Foundation,
+;; Copyright (C) 1998-2001, 2005, 2008-2021 Free Software Foundation,
;; Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/ede/proj-scheme.el b/lisp/cedet/ede/proj-scheme.el
index 9afbeb17ac4..51844af5361 100644
--- a/lisp/cedet/ede/proj-scheme.el
+++ b/lisp/cedet/ede/proj-scheme.el
@@ -1,6 +1,6 @@
;;; ede/proj-scheme.el --- EDE Generic Project scheme (guile) support
-;; Copyright (C) 1998-2000, 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2000, 2009-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make, scheme
diff --git a/lisp/cedet/ede/proj-shared.el b/lisp/cedet/ede/proj-shared.el
index 2c875394b1b..130d7b897aa 100644
--- a/lisp/cedet/ede/proj-shared.el
+++ b/lisp/cedet/ede/proj-shared.el
@@ -1,6 +1,6 @@
;;; ede-proj-shared.el --- EDE Generic Project shared library support
-;;; Copyright (C) 1998-2000, 2009-2020 Free Software Foundation, Inc.
+;;; Copyright (C) 1998-2000, 2009-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
diff --git a/lisp/cedet/ede/proj.el b/lisp/cedet/ede/proj.el
index a6d47e373f2..4af8b4104f5 100644
--- a/lisp/cedet/ede/proj.el
+++ b/lisp/cedet/ede/proj.el
@@ -1,6 +1,6 @@
;;; ede/proj.el --- EDE Generic Project file driver
-;; Copyright (C) 1998-2003, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2003, 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
@@ -184,7 +184,7 @@ Target variables are always renamed such as foo_CFLAGS, then included into
commands where the variable would usually appear.")
(rules :initarg :rules
:initform nil
- :type list
+ :type (list-of ede-makefile-rule)
:custom (repeat (object :objecttype ede-makefile-rule))
:label "Additional Rules"
:group (make)
diff --git a/lisp/cedet/ede/project-am.el b/lisp/cedet/ede/project-am.el
index 61dc8a1fc60..061d1b540b0 100644
--- a/lisp/cedet/ede/project-am.el
+++ b/lisp/cedet/ede/project-am.el
@@ -1,6 +1,6 @@
;;; project-am.el --- A project management scheme based on automake files.
-;; Copyright (C) 1998-2000, 2003, 2005, 2007-2020 Free Software
+;; Copyright (C) 1998-2000, 2003, 2005, 2007-2021 Free Software
;; Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -493,8 +493,7 @@ This is used when subprojects are made in named subdirectories."
:file fn)))
(oset ampf directory (file-name-directory fn))
(oset ampf configureoutputfiles cof)
- (make-local-variable 'ede-object)
- (setq ede-object ampf)
+ (setq-local ede-object ampf)
;; Move the rescan after we set ede-object to prevent recursion
(project-rescan ampf)
ampf))))
diff --git a/lisp/cedet/ede/shell.el b/lisp/cedet/ede/shell.el
index a99365005c8..ba36fccd0ba 100644
--- a/lisp/cedet/ede/shell.el
+++ b/lisp/cedet/ede/shell.el
@@ -1,6 +1,6 @@
;;; ede/shell.el --- A shell controlled by EDE.
;;
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/ede/simple.el b/lisp/cedet/ede/simple.el
index b1cfd6523f9..ea6162ef94f 100644
--- a/lisp/cedet/ede/simple.el
+++ b/lisp/cedet/ede/simple.el
@@ -1,6 +1,6 @@
;;; ede/simple.el --- Overlay an EDE structure on an existing project
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/ede/source.el b/lisp/cedet/ede/source.el
index eed82f7cf3b..abdb07f2d73 100644
--- a/lisp/cedet/ede/source.el
+++ b/lisp/cedet/ede/source.el
@@ -1,6 +1,6 @@
;; ede/source.el --- EDE source code object
-;; Copyright (C) 2000, 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
diff --git a/lisp/cedet/ede/speedbar.el b/lisp/cedet/ede/speedbar.el
index ed3348750f7..48c4a89c440 100644
--- a/lisp/cedet/ede/speedbar.el
+++ b/lisp/cedet/ede/speedbar.el
@@ -1,6 +1,6 @@
;;; ede/speedbar.el --- Speedbar viewing of EDE projects
-;; Copyright (C) 1998-2001, 2003, 2005, 2007-2020 Free Software
+;; Copyright (C) 1998-2001, 2003, 2005, 2007-2021 Free Software
;; Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/ede/srecode.el b/lisp/cedet/ede/srecode.el
index ed85ea97475..5dd0a7ec614 100644
--- a/lisp/cedet/ede/srecode.el
+++ b/lisp/cedet/ede/srecode.el
@@ -1,6 +1,6 @@
;;; ede/srecode.el --- EDE utilities on top of SRecoder
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/ede/system.el b/lisp/cedet/ede/system.el
index 5a78dd10c82..d83d6d1cc69 100644
--- a/lisp/cedet/ede/system.el
+++ b/lisp/cedet/ede/system.el
@@ -1,6 +1,6 @@
;;; ede-system.el --- EDE working with the system (VC, FTP, ETC)
-;; Copyright (C) 2001-2003, 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2003, 2009-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make, vc
diff --git a/lisp/cedet/ede/util.el b/lisp/cedet/ede/util.el
index c6da1862ff1..80cbc211fc2 100644
--- a/lisp/cedet/ede/util.el
+++ b/lisp/cedet/ede/util.el
@@ -1,6 +1,6 @@
;;; ede/util.el --- EDE utilities
-;; Copyright (C) 2000, 2005, 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2005, 2009-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
diff --git a/lisp/cedet/inversion.el b/lisp/cedet/inversion.el
index d47701d5a8b..2ef7e0df961 100644
--- a/lisp/cedet/inversion.el
+++ b/lisp/cedet/inversion.el
@@ -1,6 +1,6 @@
;;; inversion.el --- When you need something in version XX.XX
-;;; Copyright (C) 2002-2003, 2005-2020 Free Software Foundation, Inc.
+;;; Copyright (C) 2002-2003, 2005-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Version: 1.3
@@ -349,7 +349,11 @@ Optional argument RESERVED is saved for later use."
;;;###autoload
(defun inversion-require-emacs (emacs-ver xemacs-ver sxemacs-ver)
"Declare that you need either EMACS-VER, XEMACS-VER or SXEMACS-ver.
-Only checks one based on which kind of Emacs is being run."
+Only checks one based on which kind of Emacs is being run.
+
+This function is obsolete; do this instead:
+ (when (version<= \"28.1\" emacs-version) ...)"
+ (declare (obsolete nil "28.1"))
(let ((err (inversion-test 'emacs
(cond ((featurep 'sxemacs)
sxemacs-ver)
diff --git a/lisp/cedet/mode-local.el b/lisp/cedet/mode-local.el
index a1aea30c20d..d1e528c4a02 100644
--- a/lisp/cedet/mode-local.el
+++ b/lisp/cedet/mode-local.el
@@ -1,6 +1,6 @@
;;; mode-local.el --- Support for mode local facilities -*- lexical-binding:t -*-
;;
-;; Copyright (C) 2004-2005, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2005, 2007-2021 Free Software Foundation, Inc.
;;
;; Author: David Ponce <david@dponce.com>
;; Created: 27 Apr 2004
@@ -314,7 +314,7 @@ Elements are (SYMBOL . PREVIOUS-VALUE), describing one variable."
;; Do the normal thing.
(let (modes table old-locals)
(unless mode
- (set (make-local-variable 'mode-local--init-mode) major-mode)
+ (setq-local mode-local--init-mode major-mode)
(setq mode major-mode))
;; Get MODE's parents & MODE in the right order.
(while mode
diff --git a/lisp/cedet/pulse.el b/lisp/cedet/pulse.el
index 8649254aedd..aef4fc89057 100644
--- a/lisp/cedet/pulse.el
+++ b/lisp/cedet/pulse.el
@@ -1,6 +1,6 @@
;;; pulse.el --- Pulsing Overlays
-;;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Version: 1.0
diff --git a/lisp/cedet/semantic.el b/lisp/cedet/semantic.el
index 71321e12da3..c64a9822c6b 100644
--- a/lisp/cedet/semantic.el
+++ b/lisp/cedet/semantic.el
@@ -1,6 +1,6 @@
;;; semantic.el --- Semantic buffer evaluator.
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax tools
@@ -495,8 +495,7 @@ is requested."
(setq semantic--buffer-cache tagtable
semantic-unmatched-syntax-cache-check nil)
;; This is specific to the bovine parser.
- (set (make-local-variable 'semantic-bovinate-nonterminal-check-obarray)
- nil)
+ (setq-local semantic-bovinate-nonterminal-check-obarray nil)
(semantic-parse-tree-set-up-to-date)
(add-hook 'after-change-functions 'semantic-change-function nil t)
(run-hook-with-args 'semantic-after-toplevel-cache-change-hook
@@ -978,7 +977,6 @@ Prevent this load system from loading files in twice.")
global-semanticdb-minor-mode
global-semantic-idle-summary-mode
global-semantic-mru-bookmark-mode
- global-cedet-m3-minor-mode
global-semantic-idle-local-symbol-highlight-mode
global-semantic-highlight-edits-mode
global-semantic-show-unmatched-syntax-mode
@@ -1000,7 +998,6 @@ The possible elements of this list include the following:
`global-semantic-stickyfunc-mode' - Show current fun in header line.
`global-semantic-mru-bookmark-mode' - Provide `switch-to-buffer'-like
keybinding for tag names.
- `global-cedet-m3-minor-mode' - A mouse 3 context menu.
`global-semantic-idle-local-symbol-highlight-mode' - Highlight references
of the symbol under point.
The following modes are more targeted at people who want to see
diff --git a/lisp/cedet/semantic/analyze.el b/lisp/cedet/semantic/analyze.el
index cafdc3bee14..c0a054dafc3 100644
--- a/lisp/cedet/semantic/analyze.el
+++ b/lisp/cedet/semantic/analyze.el
@@ -1,6 +1,6 @@
;;; semantic/analyze.el --- Analyze semantic tags against local context
-;; Copyright (C) 2000-2005, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2005, 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -235,7 +235,8 @@ scoped. These are not local variables, but symbols available in a structure
which doesn't need to be dereferenced.
Optional argument TYPERETURN is a symbol in which the types of all found
will be stored. If nil, that data is thrown away.
-Optional argument THROWSYM specifies a symbol the throw on non-recoverable error.
+Optional argument THROWSYM specifies a symbol the throw on non-recoverable
+error.
Remaining arguments FLAGS are additional flags to apply when searching.")
(defun semantic-analyze-find-tag-sequence-default
@@ -246,7 +247,8 @@ Remaining arguments FLAGS are additional flags to apply when searching.")
SCOPE are extra tags which are in scope.
TYPERETURN is a symbol in which to place a list of tag classes that
are found in SEQUENCE.
-Optional argument THROWSYM specifies a symbol the throw on non-recoverable error.
+Optional argument THROWSYM specifies a symbol the throw on non-recoverable
+error.
Remaining arguments FLAGS are additional flags to apply when searching.
This function knows of flags:
`mustbeclassvariable'"
diff --git a/lisp/cedet/semantic/analyze/complete.el b/lisp/cedet/semantic/analyze/complete.el
index 8d07958b93f..e8139ab1aea 100644
--- a/lisp/cedet/semantic/analyze/complete.el
+++ b/lisp/cedet/semantic/analyze/complete.el
@@ -1,6 +1,6 @@
;;; semantic/analyze/complete.el --- Smart Completions
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/semantic/analyze/debug.el b/lisp/cedet/semantic/analyze/debug.el
index 6ea54a200c5..4947368757e 100644
--- a/lisp/cedet/semantic/analyze/debug.el
+++ b/lisp/cedet/semantic/analyze/debug.el
@@ -1,6 +1,6 @@
;;; semantic/analyze/debug.el --- Debug the analyzer
-;;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -590,7 +590,7 @@ Look for key expressions, and add push-buttons near them."
(with-current-buffer "*Help*"
(let ((inhibit-read-only t))
(goto-char (point-min))
- (set (make-local-variable 'semantic-analyzer-debug-orig) orig-buffer)
+ (setq-local semantic-analyzer-debug-orig orig-buffer)
;; First, add do-in buttons to recommendations.
(while (re-search-forward "^\\s-*M-x \\(\\(\\w\\|\\s_\\)+\\) " nil t)
(let ((fcn (match-string 1)))
diff --git a/lisp/cedet/semantic/analyze/fcn.el b/lisp/cedet/semantic/analyze/fcn.el
index 44394f674b0..10d11c33ebb 100644
--- a/lisp/cedet/semantic/analyze/fcn.el
+++ b/lisp/cedet/semantic/analyze/fcn.el
@@ -1,6 +1,6 @@
;;; semantic/analyze/fcn.el --- Analyzer support functions.
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/semantic/analyze/refs.el b/lisp/cedet/semantic/analyze/refs.el
index 585f1a7c754..a39ff6f6736 100644
--- a/lisp/cedet/semantic/analyze/refs.el
+++ b/lisp/cedet/semantic/analyze/refs.el
@@ -1,6 +1,6 @@
;;; semantic/analyze/refs.el --- Analysis of the references between tags.
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -102,7 +102,8 @@ Use `semantic-analyze-current-tag' to debug this fcn."
;; into the context.
(cl-defmethod semantic-analyze-refs-impl ((refs semantic-analyze-references) &optional in-buffer)
"Return the implementations derived in the reference analyzer REFS.
-Optional argument IN-BUFFER indicates that the returned tag should be in an active buffer."
+Optional argument IN-BUFFER indicates that the returned tag
+should be in an active buffer."
(let ((allhits (oref refs rawsearchdata))
(tag (oref refs tag))
(impl nil)
@@ -127,7 +128,8 @@ Optional argument IN-BUFFER indicates that the returned tag should be in an acti
(cl-defmethod semantic-analyze-refs-proto ((refs semantic-analyze-references) &optional in-buffer)
"Return the prototypes derived in the reference analyzer REFS.
-Optional argument IN-BUFFER indicates that the returned tag should be in an active buffer."
+Optional argument IN-BUFFER indicates that the returned tag
+should be in an active buffer."
(let ((allhits (oref refs rawsearchdata))
(tag (oref refs tag))
(proto nil))
diff --git a/lisp/cedet/semantic/bovine.el b/lisp/cedet/semantic/bovine.el
index f999a01f1e9..034ecb5ea1c 100644
--- a/lisp/cedet/semantic/bovine.el
+++ b/lisp/cedet/semantic/bovine.el
@@ -1,6 +1,6 @@
;;; semantic/bovine.el --- LL Parser/Analyzer core.
-;; Copyright (C) 1999-2004, 2006-2007, 2009-2020 Free Software
+;; Copyright (C) 1999-2004, 2006-2007, 2009-2021 Free Software
;; Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/semantic/bovine/c.el b/lisp/cedet/semantic/bovine/c.el
index 3649d1c2f1f..fb551397381 100644
--- a/lisp/cedet/semantic/bovine/c.el
+++ b/lisp/cedet/semantic/bovine/c.el
@@ -1,6 +1,6 @@
;;; semantic/bovine/c.el --- Semantic details for C
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -368,7 +368,8 @@ Take the first interesting thing and convert it."
(defun semantic-c-evaluate-symbol-for-hideif (spp-symbol)
"Lookup the symbol SPP-SYMBOL (a string) to something hideif can use.
-Pulls out the symbol list, and call `semantic-c-convert-spp-value-to-hideif-value'."
+Pull out the symbol list, and call
+`semantic-c-convert-spp-value-to-hideif-value'."
(interactive "sSymbol name: ")
(when (symbolp spp-symbol) (setq spp-symbol (symbol-name spp-symbol)))
diff --git a/lisp/cedet/semantic/bovine/debug.el b/lisp/cedet/semantic/bovine/debug.el
index 0f5bc86ea30..8ea9ac24423 100644
--- a/lisp/cedet/semantic/bovine/debug.el
+++ b/lisp/cedet/semantic/bovine/debug.el
@@ -1,6 +1,6 @@
;;; semantic/bovine/debug.el --- Debugger support for bovinator
-;; Copyright (C) 2003, 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2009-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/semantic/bovine/el.el b/lisp/cedet/semantic/bovine/el.el
index bbed1d94f20..dc617349021 100644
--- a/lisp/cedet/semantic/bovine/el.el
+++ b/lisp/cedet/semantic/bovine/el.el
@@ -1,6 +1,6 @@
;;; semantic/bovine/el.el --- Semantic details for Emacs Lisp
-;; Copyright (C) 1999-2005, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2005, 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -464,27 +464,11 @@ Return a bovination list to use."
(define-mode-local-override semantic-dependency-tag-file
emacs-lisp-mode (tag)
"Find the file BUFFER depends on described by TAG."
- (if (fboundp 'find-library-name)
- (condition-case nil
- ;; Try an Emacs 22 fcn. This throws errors.
- (find-library-name (semantic-tag-name tag))
- (error
- (message "semantic: cannot find source file %s"
- (semantic-tag-name tag))))
- ;; No handy function available. (Older Emacsen)
- (let* ((lib (locate-library (semantic-tag-name tag)))
- (name (if lib (file-name-sans-extension lib) nil))
- (nameel (concat name ".el")))
- (cond
- ((and name (file-exists-p nameel)) nameel)
- ((and name (file-exists-p (concat name ".el.gz")))
- ;; This is the linux distro case.
- (concat name ".el.gz"))
- ;; Source file does not exist.
- (name
- (message "semantic: cannot find source file %s" (concat name ".el")))
- (t
- nil)))))
+ (condition-case nil
+ (find-library-name (semantic-tag-name tag))
+ (error
+ (message "semantic: cannot find source file %s"
+ (semantic-tag-name tag)))))
;;; DOC Strings
;;
diff --git a/lisp/cedet/semantic/bovine/gcc.el b/lisp/cedet/semantic/bovine/gcc.el
index 64f391d2325..1cfe5a3bac1 100644
--- a/lisp/cedet/semantic/bovine/gcc.el
+++ b/lisp/cedet/semantic/bovine/gcc.el
@@ -1,6 +1,6 @@
;;; semantic/bovine/gcc.el --- gcc querying special code for the C parser
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/semantic/bovine/grammar.el b/lisp/cedet/semantic/bovine/grammar.el
index 10afb065320..4914ec9b124 100644
--- a/lisp/cedet/semantic/bovine/grammar.el
+++ b/lisp/cedet/semantic/bovine/grammar.el
@@ -1,6 +1,6 @@
;;; semantic/bovine/grammar.el --- Bovine's input grammar mode
;;
-;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;;
;; Author: David Ponce <david@dponce.com>
;; Created: 26 Aug 2002
diff --git a/lisp/cedet/semantic/bovine/make.el b/lisp/cedet/semantic/bovine/make.el
index 07c55b46e26..80895565274 100644
--- a/lisp/cedet/semantic/bovine/make.el
+++ b/lisp/cedet/semantic/bovine/make.el
@@ -1,6 +1,6 @@
;;; semantic/bovine/make.el --- Makefile parsing rules.
-;; Copyright (C) 2000-2004, 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2004, 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -50,7 +50,8 @@
nil)
(define-lex-regex-analyzer semantic-lex-make-command
- "A command in a Makefile consists of a line starting with TAB, and ending at the newline."
+ "Regexp for a command in a Makefile.
+It consists of a line starting with TAB, and ending at the newline."
"^\\(\t\\)"
(let ((start (match-end 0)))
(while (progn (end-of-line)
diff --git a/lisp/cedet/semantic/bovine/scm.el b/lisp/cedet/semantic/bovine/scm.el
index b2a25bf8eef..aaa86a1e36c 100644
--- a/lisp/cedet/semantic/bovine/scm.el
+++ b/lisp/cedet/semantic/bovine/scm.el
@@ -1,6 +1,6 @@
;;; semantic/bovine/scm.el --- Semantic details for Scheme (guile)
-;;; Copyright (C) 2001-2004, 2008-2020 Free Software Foundation, Inc.
+;;; Copyright (C) 2001-2004, 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/semantic/chart.el b/lisp/cedet/semantic/chart.el
index a5f3699ae6d..e7848faf741 100644
--- a/lisp/cedet/semantic/chart.el
+++ b/lisp/cedet/semantic/chart.el
@@ -1,6 +1,6 @@
;;; semantic/chart.el --- Utilities for use with semantic tag tables
-;; Copyright (C) 1999-2001, 2003, 2005, 2008-2020 Free Software
+;; Copyright (C) 1999-2001, 2003, 2005, 2008-2021 Free Software
;; Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/semantic/complete.el b/lisp/cedet/semantic/complete.el
index b262ab710f6..0a80b428e8e 100644
--- a/lisp/cedet/semantic/complete.el
+++ b/lisp/cedet/semantic/complete.el
@@ -1,6 +1,6 @@
;;; semantic/complete.el --- Routines for performing tag completion
-;; Copyright (C) 2003-2005, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2005, 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
diff --git a/lisp/cedet/semantic/ctxt.el b/lisp/cedet/semantic/ctxt.el
index f2387302b14..4d2defde35b 100644
--- a/lisp/cedet/semantic/ctxt.el
+++ b/lisp/cedet/semantic/ctxt.el
@@ -1,6 +1,6 @@
;;; semantic/ctxt.el --- Context calculations for Semantic tools.
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
diff --git a/lisp/cedet/semantic/db-debug.el b/lisp/cedet/semantic/db-debug.el
index 65210ed9336..c553ab499ae 100644
--- a/lisp/cedet/semantic/db-debug.el
+++ b/lisp/cedet/semantic/db-debug.el
@@ -1,6 +1,6 @@
;;; semantic/db-debug.el --- Extra level debugging routines for Semantic
-;;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/semantic/db-ebrowse.el b/lisp/cedet/semantic/db-ebrowse.el
index d63e5bc4869..946f9ef6326 100644
--- a/lisp/cedet/semantic/db-ebrowse.el
+++ b/lisp/cedet/semantic/db-ebrowse.el
@@ -1,6 +1,6 @@
;;; semantic/db-ebrowse.el --- Semanticdb backend using ebrowse.
-;; Copyright (C) 2005-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2005-2021 Free Software Foundation, Inc.
;; Authors: Eric M. Ludlam <zappo@gnu.org>
;; Joakim Verona
diff --git a/lisp/cedet/semantic/db-el.el b/lisp/cedet/semantic/db-el.el
index 1706988c238..4699e722c1a 100644
--- a/lisp/cedet/semantic/db-el.el
+++ b/lisp/cedet/semantic/db-el.el
@@ -1,6 +1,6 @@
;;; semantic/db-el.el --- Semantic database extensions for Emacs Lisp
-;;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
+;;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: tags
diff --git a/lisp/cedet/semantic/db-file.el b/lisp/cedet/semantic/db-file.el
index 96287487106..59e9db9cc0a 100644
--- a/lisp/cedet/semantic/db-file.el
+++ b/lisp/cedet/semantic/db-file.el
@@ -1,6 +1,6 @@
;;; semantic/db-file.el --- Save a semanticdb to a cache file.
-;;; Copyright (C) 2000-2005, 2007-2020 Free Software Foundation, Inc.
+;;; Copyright (C) 2000-2005, 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: tags
diff --git a/lisp/cedet/semantic/db-find.el b/lisp/cedet/semantic/db-find.el
index 86ccf28ad02..14726e503d5 100644
--- a/lisp/cedet/semantic/db-find.el
+++ b/lisp/cedet/semantic/db-find.el
@@ -1,6 +1,6 @@
;;; semantic/db-find.el --- Searching through semantic databases.
-;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: tags
diff --git a/lisp/cedet/semantic/db-global.el b/lisp/cedet/semantic/db-global.el
index b6f7c2f379e..2f40082d53c 100644
--- a/lisp/cedet/semantic/db-global.el
+++ b/lisp/cedet/semantic/db-global.el
@@ -1,6 +1,6 @@
;;; semantic/db-global.el --- Semantic database extensions for GLOBAL
-;; Copyright (C) 2002-2006, 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2006, 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: tags
diff --git a/lisp/cedet/semantic/db-javascript.el b/lisp/cedet/semantic/db-javascript.el
index 098ee0676bd..2b138866215 100644
--- a/lisp/cedet/semantic/db-javascript.el
+++ b/lisp/cedet/semantic/db-javascript.el
@@ -1,6 +1,6 @@
;;; semantic/db-javascript.el --- Semantic database extensions for javascript
-;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Author: Joakim Verona
diff --git a/lisp/cedet/semantic/db-mode.el b/lisp/cedet/semantic/db-mode.el
index 16a30b6cfbc..aa4634faa98 100644
--- a/lisp/cedet/semantic/db-mode.el
+++ b/lisp/cedet/semantic/db-mode.el
@@ -1,6 +1,6 @@
;;; semantic/db-mode.el --- Semanticdb Minor Mode
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/semantic/db-ref.el b/lisp/cedet/semantic/db-ref.el
index 611275bb271..da09f9830a7 100644
--- a/lisp/cedet/semantic/db-ref.el
+++ b/lisp/cedet/semantic/db-ref.el
@@ -1,6 +1,6 @@
;;; semantic/db-ref.el --- Handle cross-db file references
-;;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/semantic/db-typecache.el b/lisp/cedet/semantic/db-typecache.el
index 09f0e52e44d..8c394cd7fa9 100644
--- a/lisp/cedet/semantic/db-typecache.el
+++ b/lisp/cedet/semantic/db-typecache.el
@@ -1,6 +1,6 @@
;;; semantic/db-typecache.el --- Manage Datatypes
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -343,7 +343,7 @@ all included files."
nil)
(cl-defmethod semanticdb-typecache-include-tags ((table semanticdb-table))
- "Update the typecache for TABLE, and return the merged types from the include tags.
+ "Update typecache for TABLE, and return the merged types from the include tags.
Include-tags are the tags brought in via includes, all merged together into
a master list."
(let* ((cache (semanticdb-get-typecache table))
diff --git a/lisp/cedet/semantic/db.el b/lisp/cedet/semantic/db.el
index 60a65b195bc..b9b10917dc6 100644
--- a/lisp/cedet/semantic/db.el
+++ b/lisp/cedet/semantic/db.el
@@ -1,6 +1,6 @@
;;; semantic/db.el --- Semantic tag database manager -*- lexical-binding:t -*-
-;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: tags
diff --git a/lisp/cedet/semantic/debug.el b/lisp/cedet/semantic/debug.el
index eebdd013aae..b3e8f076d07 100644
--- a/lisp/cedet/semantic/debug.el
+++ b/lisp/cedet/semantic/debug.el
@@ -1,6 +1,6 @@
;;; semantic/debug.el --- Language Debugger framework
-;; Copyright (C) 2003-2005, 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2005, 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/semantic/decorate.el b/lisp/cedet/semantic/decorate.el
index da472808ce9..53c54ab4cc8 100644
--- a/lisp/cedet/semantic/decorate.el
+++ b/lisp/cedet/semantic/decorate.el
@@ -1,6 +1,6 @@
;;; semantic/decorate.el --- Utilities for decorating/highlighting tokens.
-;;; Copyright (C) 1999-2003, 2005-2007, 2009-2020 Free Software
+;;; Copyright (C) 1999-2003, 2005-2007, 2009-2021 Free Software
;;; Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/semantic/decorate/include.el b/lisp/cedet/semantic/decorate/include.el
index 63e72a5fb6d..ee7fad1fc5f 100644
--- a/lisp/cedet/semantic/decorate/include.el
+++ b/lisp/cedet/semantic/decorate/include.el
@@ -1,6 +1,6 @@
;;; semantic/decorate/include.el --- Decoration modes for include statements
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/semantic/decorate/mode.el b/lisp/cedet/semantic/decorate/mode.el
index 293692000df..884b066d77f 100644
--- a/lisp/cedet/semantic/decorate/mode.el
+++ b/lisp/cedet/semantic/decorate/mode.el
@@ -1,6 +1,6 @@
;;; semantic/decorate/mode.el --- Minor mode for decorating tags
-;; Copyright (C) 2000-2005, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2005, 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
diff --git a/lisp/cedet/semantic/dep.el b/lisp/cedet/semantic/dep.el
index 60ab6033aec..0fba2a2f091 100644
--- a/lisp/cedet/semantic/dep.el
+++ b/lisp/cedet/semantic/dep.el
@@ -1,6 +1,6 @@
;;; semantic/dep.el --- Methods for tracking dependencies (include files)
-;; Copyright (C) 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
diff --git a/lisp/cedet/semantic/doc.el b/lisp/cedet/semantic/doc.el
index 896bc3bb42e..d4dd9286421 100644
--- a/lisp/cedet/semantic/doc.el
+++ b/lisp/cedet/semantic/doc.el
@@ -1,6 +1,6 @@
;;; semantic/doc.el --- Routines for documentation strings
-;; Copyright (C) 1999-2003, 2005, 2008-2020 Free Software Foundation,
+;; Copyright (C) 1999-2003, 2005, 2008-2021 Free Software Foundation,
;; Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -40,7 +40,7 @@ TAG might have DOCUMENTATION set in it already. If not, there may be
some documentation in a comment preceding TAG's definition which we
can look for. When appropriate, this can be overridden by a language specific
enhancement.
-Optional argument NOSNARF means to only return the lexical analyzer token for it.
+Optional argument NOSNARF means return only the lexical analyzer token for it.
If NOSNARF is `lex', then only return the lex token."
(if (not tag) (setq tag (semantic-current-tag)))
(save-excursion
diff --git a/lisp/cedet/semantic/ede-grammar.el b/lisp/cedet/semantic/ede-grammar.el
index d435ff6b6e9..bd0795acbd6 100644
--- a/lisp/cedet/semantic/ede-grammar.el
+++ b/lisp/cedet/semantic/ede-grammar.el
@@ -1,6 +1,6 @@
;;; semantic/ede-grammar.el --- EDE support for Semantic Grammar Files
-;; Copyright (C) 2003-2004, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2004, 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
diff --git a/lisp/cedet/semantic/edit.el b/lisp/cedet/semantic/edit.el
index e4319c7d1b3..f39cc093cc9 100644
--- a/lisp/cedet/semantic/edit.el
+++ b/lisp/cedet/semantic/edit.el
@@ -1,6 +1,6 @@
;;; semantic/edit.el --- Edit Management for Semantic
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/semantic/find.el b/lisp/cedet/semantic/find.el
index 02c68e7484e..706892b4861 100644
--- a/lisp/cedet/semantic/find.el
+++ b/lisp/cedet/semantic/find.el
@@ -1,6 +1,6 @@
;;; semantic/find.el --- Search routines for Semantic
-;; Copyright (C) 1999-2005, 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2005, 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
diff --git a/lisp/cedet/semantic/format.el b/lisp/cedet/semantic/format.el
index bb2954be561..f9c5365a29f 100644
--- a/lisp/cedet/semantic/format.el
+++ b/lisp/cedet/semantic/format.el
@@ -1,6 +1,6 @@
;;; semantic/format.el --- Routines for formatting tags
-;; Copyright (C) 1999-2005, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2005, 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
@@ -32,7 +32,6 @@
;;
;;; Code:
-(eval-when-compile (require 'font-lock))
(require 'semantic)
(require 'semantic/tag-ls)
(require 'ezimage)
@@ -119,12 +118,10 @@ be used unless font lock is a feature.")
"Apply onto TEXT a color associated with FACE-CLASS.
FACE-CLASS is a tag type found in `semantic-format-face-alist'.
See that variable for details on adding new types."
- (if (featurep 'font-lock)
- (let ((face (cdr-safe (assoc face-class semantic-format-face-alist)))
- (newtext (concat text)))
- (put-text-property 0 (length text) 'face face newtext)
- newtext)
- text))
+ (let ((face (cdr-safe (assoc face-class semantic-format-face-alist)))
+ (newtext (concat text)))
+ (put-text-property 0 (length text) 'face face newtext)
+ newtext))
(defun semantic--format-colorize-merge-text (precoloredtext face-class)
"Apply onto PRECOLOREDTEXT a color associated with FACE-CLASS.
diff --git a/lisp/cedet/semantic/fw.el b/lisp/cedet/semantic/fw.el
index c86cd3abf3d..f034ba01a4f 100644
--- a/lisp/cedet/semantic/fw.el
+++ b/lisp/cedet/semantic/fw.el
@@ -1,6 +1,6 @@
;;; semantic/fw.el --- Framework for Semantic
-;;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/semantic/grammar-wy.el b/lisp/cedet/semantic/grammar-wy.el
index 93fbedeff0a..12c9c047fc5 100644
--- a/lisp/cedet/semantic/grammar-wy.el
+++ b/lisp/cedet/semantic/grammar-wy.el
@@ -1,6 +1,6 @@
;;; semantic/grammar-wy.el --- Generated parser support file
-;; Copyright (C) 2002-2004, 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2004, 2009-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el
index f71ac6c413e..7721a834ea4 100644
--- a/lisp/cedet/semantic/grammar.el
+++ b/lisp/cedet/semantic/grammar.el
@@ -1,6 +1,6 @@
;;; semantic/grammar.el --- Major mode framework for Semantic grammars
-;; Copyright (C) 2002-2005, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2005, 2007-2021 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
@@ -1258,7 +1258,8 @@ common grammar menu."
(unless (boundp ',symbol)
(easy-menu-define ,symbol nil
"Grammar Menu" (copy-sequence semantic-grammar-menu)))
- (easy-menu-add ,symbol)
+ (when (featurep 'xemacs)
+ (easy-menu-add ,symbol))
(let ((,items (cdr ,mode-menu))
(,path (list (car ,symbol))))
(when ,items
@@ -1302,28 +1303,25 @@ the change bounds to encompass the whole nonterminal tag."
"Initialize a buffer for editing Semantic grammars.
\\{semantic-grammar-mode-map}"
- (set (make-local-variable 'parse-sexp-ignore-comments) t)
- (set (make-local-variable 'comment-start) ";;")
+ (setq-local parse-sexp-ignore-comments t)
+ (setq-local comment-start ";;")
;; Look within the line for a ; following an even number of backslashes
;; after either a non-backslash or the line beginning.
- (set (make-local-variable 'comment-start-skip)
- "\\(\\(^\\|[^\\\n]\\)\\(\\\\\\\\\\)*\\);+ *")
- (set (make-local-variable 'indent-line-function)
- 'semantic-grammar-indent)
- (set (make-local-variable 'fill-paragraph-function)
- 'lisp-fill-paragraph)
- (set (make-local-variable 'font-lock-multiline)
- 'undecided)
- (set (make-local-variable 'font-lock-defaults)
- '((semantic-grammar-mode-keywords
- semantic-grammar-mode-keywords-1
- semantic-grammar-mode-keywords-2
- semantic-grammar-mode-keywords-3)
- nil ;; perform string/comment fontification
- nil ;; keywords are case sensitive.
- ;; This puts _ & - as a word constituent,
- ;; simplifying our keywords significantly
- ((?_ . "w") (?- . "w"))))
+ (setq-local comment-start-skip
+ "\\(\\(^\\|[^\\\n]\\)\\(\\\\\\\\\\)*\\);+ *")
+ (setq-local indent-line-function #'semantic-grammar-indent)
+ (setq-local fill-paragraph-function #'lisp-fill-paragraph)
+ (setq-local font-lock-multiline 'undecided)
+ (setq-local font-lock-defaults
+ '((semantic-grammar-mode-keywords
+ semantic-grammar-mode-keywords-1
+ semantic-grammar-mode-keywords-2
+ semantic-grammar-mode-keywords-3)
+ nil ;; perform string/comment fontification
+ nil ;; keywords are case sensitive.
+ ;; This puts _ & - as a word constituent,
+ ;; simplifying our keywords significantly
+ ((?_ . "w") (?- . "w"))))
;; Setup Semantic to parse grammar
(semantic-grammar-wy--install-parser)
(setq semantic-lex-comment-regex ";;"
@@ -1337,16 +1335,14 @@ the change bounds to encompass the whole nonterminal tag."
(nonterminal . "Nonterminal")
(rule . "Rule")
))
- (set (make-local-variable 'semantic-format-face-alist)
- '(
- (code . default)
- (keyword . font-lock-keyword-face)
- (token . font-lock-type-face)
- (nonterminal . font-lock-function-name-face)
- (rule . default)
- ))
- (set (make-local-variable 'semantic-stickyfunc-sticky-classes)
- '(nonterminal))
+ (setq-local semantic-format-face-alist
+ '((code . default)
+ (keyword . font-lock-keyword-face)
+ (token . font-lock-type-face)
+ (nonterminal . font-lock-function-name-face)
+ (rule . default)))
+ (setq-local semantic-stickyfunc-sticky-classes
+ '(nonterminal))
;; Before each change, clear the cached regexp used to highlight
;; macros local in this grammar.
(add-hook 'before-change-functions
diff --git a/lisp/cedet/semantic/html.el b/lisp/cedet/semantic/html.el
index 537bc39a5fe..658d218a4a3 100644
--- a/lisp/cedet/semantic/html.el
+++ b/lisp/cedet/semantic/html.el
@@ -1,6 +1,6 @@
;;; semantic/html.el --- Semantic details for html files
-;; Copyright (C) 2004-2005, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2005, 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/semantic/ia-sb.el b/lisp/cedet/semantic/ia-sb.el
index baa6ade8785..b132d41cd4a 100644
--- a/lisp/cedet/semantic/ia-sb.el
+++ b/lisp/cedet/semantic/ia-sb.el
@@ -1,6 +1,6 @@
;;; semantic/ia-sb.el --- Speedbar analysis display interactor
-;;; Copyright (C) 2002-2004, 2006, 2008-2020 Free Software Foundation,
+;;; Copyright (C) 2002-2004, 2006, 2008-2021 Free Software Foundation,
;;; Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/semantic/ia.el b/lisp/cedet/semantic/ia.el
index 4a129aae74e..6d3ec7570b5 100644
--- a/lisp/cedet/semantic/ia.el
+++ b/lisp/cedet/semantic/ia.el
@@ -1,6 +1,6 @@
;;; semantic/ia.el --- Interactive Analysis functions
-;;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
+;;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
@@ -79,15 +79,14 @@
(insert "("))
(t nil))))
-(defalias 'semantic-ia-get-completions 'semantic-ia-get-completions-deprecated
- "`Semantic-ia-get-completions' is obsolete.
-Use `semantic-analyze-possible-completions' instead.")
+(defalias 'semantic-ia-get-completions 'semantic-ia-get-completions-deprecated)
+(make-obsolete 'semantic-ia-get-completions
+ #'semantic-analyze-possible-completions "28.1")
(defun semantic-ia-get-completions-deprecated (context point)
"A function to help transition away from `semantic-ia-get-completions'.
-Return completions based on CONTEXT at POINT.
-You should not use this, nor the aliased version.
-Use `semantic-analyze-possible-completions' instead."
+Return completions based on CONTEXT at POINT."
+ (declare (obsolete semantic-analyze-possible-completions "28.1"))
(semantic-analyze-possible-completions context))
;;;###autoload
diff --git a/lisp/cedet/semantic/idle.el b/lisp/cedet/semantic/idle.el
index 8301b195309..4898c85b216 100644
--- a/lisp/cedet/semantic/idle.el
+++ b/lisp/cedet/semantic/idle.el
@@ -1,6 +1,6 @@
;;; idle.el --- Schedule parsing tasks in idle time
-;; Copyright (C) 2003-2006, 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2006, 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
diff --git a/lisp/cedet/semantic/imenu.el b/lisp/cedet/semantic/imenu.el
index 25f7fdb8426..2898f3711a0 100644
--- a/lisp/cedet/semantic/imenu.el
+++ b/lisp/cedet/semantic/imenu.el
@@ -1,6 +1,6 @@
;;; semantic/imenu.el --- Use Semantic as an imenu tag generator
-;; Copyright (C) 2000-2005, 2007-2008, 2010-2020 Free Software
+;; Copyright (C) 2000-2005, 2007-2008, 2010-2021 Free Software
;; Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -99,7 +99,8 @@ Overridden to nil if `semantic-imenu-bucketize-file' is nil."
(defcustom semantic-imenu-sort-bucket-function nil
"Function to use when sorting tags in the buckets of functions.
-See `semantic-bucketize' and the FILTER argument for more details on this function."
+See `semantic-bucketize' and the FILTER argument for more details
+on this function."
:group 'semantic-imenu
:type '(radio (const :tag "No Sorting" nil)
(const semantic-sort-tags-by-name-increasing)
diff --git a/lisp/cedet/semantic/java.el b/lisp/cedet/semantic/java.el
index cc53f69691b..f60f6e87ab7 100644
--- a/lisp/cedet/semantic/java.el
+++ b/lisp/cedet/semantic/java.el
@@ -1,6 +1,6 @@
;;; semantic/java.el --- Semantic functions for Java
-;;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el
index e6e124eb812..8b83c09eb16 100644
--- a/lisp/cedet/semantic/lex-spp.el
+++ b/lisp/cedet/semantic/lex-spp.el
@@ -1,6 +1,6 @@
;;; semantic/lex-spp.el --- Semantic Lexical Pre-processor
-;; Copyright (C) 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el
index 809271ddccd..993c1dc14b6 100644
--- a/lisp/cedet/semantic/lex.el
+++ b/lisp/cedet/semantic/lex.el
@@ -1,6 +1,6 @@
;;; semantic/lex.el --- Lexical Analyzer builder -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/semantic/mru-bookmark.el b/lisp/cedet/semantic/mru-bookmark.el
index bd32f98233f..956eb681f2c 100644
--- a/lisp/cedet/semantic/mru-bookmark.el
+++ b/lisp/cedet/semantic/mru-bookmark.el
@@ -1,6 +1,6 @@
;;; semantic/mru-bookmark.el --- Automatic bookmark tracking
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/semantic/sb.el b/lisp/cedet/semantic/sb.el
index b038d4066a2..d7cd8e1940c 100644
--- a/lisp/cedet/semantic/sb.el
+++ b/lisp/cedet/semantic/sb.el
@@ -1,6 +1,6 @@
;;; semantic/sb.el --- Semantic tag display for speedbar
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
diff --git a/lisp/cedet/semantic/scope.el b/lisp/cedet/semantic/scope.el
index 7939438b1b0..31576d29bc6 100644
--- a/lisp/cedet/semantic/scope.el
+++ b/lisp/cedet/semantic/scope.el
@@ -1,6 +1,6 @@
;;; semantic/scope.el --- Analyzer Scope Calculations
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/semantic/senator.el b/lisp/cedet/semantic/senator.el
index e594232353a..6768b432f69 100644
--- a/lisp/cedet/semantic/senator.el
+++ b/lisp/cedet/semantic/senator.el
@@ -1,6 +1,6 @@
;;; semantic/senator.el --- SEmantic NAvigaTOR
-;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
;; Maintainer: emacs-devel@gnu.org
@@ -472,9 +472,9 @@ filters in `senator-search-tag-filter-functions' remain active."
(if classes
(let ((tag (make-symbol "tag"))
(names (mapconcat 'symbol-name classes "', `")))
- (set (make-local-variable 'senator--search-filter)
- `(lambda (,tag)
- (memq (semantic-tag-class ,tag) ',classes)))
+ (setq-local senator--search-filter
+ `(lambda (,tag)
+ (memq (semantic-tag-class ,tag) ',classes)))
(add-hook 'senator-search-tag-filter-functions
senator--search-filter nil t)
(message "Limit search to `%s' tags" names))
@@ -810,7 +810,7 @@ if available."
(defun senator-lazy-highlight-update ()
"Force lazy highlight update."
(lazy-highlight-cleanup t)
- (set 'isearch-lazy-highlight-last-string nil)
+ (setq isearch-lazy-highlight-last-string nil)
(setq isearch-adjusted t)
(isearch-update))
@@ -857,17 +857,17 @@ Use a senator search function when semantic isearch mode is enabled."
;; senator one.
(when (and (local-variable-p 'isearch-search-fun-function)
(not (local-variable-p 'senator-old-isearch-search-fun)))
- (set (make-local-variable 'senator-old-isearch-search-fun)
- isearch-search-fun-function))
- (set (make-local-variable 'isearch-search-fun-function)
- 'senator-isearch-search-fun))
+ (setq-local senator-old-isearch-search-fun
+ isearch-search-fun-function))
+ (setq-local isearch-search-fun-function
+ 'senator-isearch-search-fun))
;; When `senator-isearch-semantic-mode' is off restore the
;; previous `isearch-search-fun-function'.
(when (eq isearch-search-fun-function 'senator-isearch-search-fun)
(if (local-variable-p 'senator-old-isearch-search-fun)
(progn
- (set (make-local-variable 'isearch-search-fun-function)
- senator-old-isearch-search-fun)
+ (setq-local isearch-search-fun-function
+ senator-old-isearch-search-fun)
(kill-local-variable 'senator-old-isearch-search-fun))
(kill-local-variable 'isearch-search-fun-function)))))
diff --git a/lisp/cedet/semantic/sort.el b/lisp/cedet/semantic/sort.el
index 89fc917e0c7..154a56a27aa 100644
--- a/lisp/cedet/semantic/sort.el
+++ b/lisp/cedet/semantic/sort.el
@@ -1,6 +1,6 @@
;;; semantic/sort.el --- Utilities for sorting and re-arranging tag tables.
-;;; Copyright (C) 1999-2005, 2007-2020 Free Software Foundation, Inc.
+;;; Copyright (C) 1999-2005, 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
@@ -46,11 +46,7 @@
(defun semantic-string-lessp-ci (s1 s2)
"Case insensitive version of `string-lessp'.
Argument S1 and S2 are the strings to compare."
- ;; Use downcase instead of upcase because an average name
- ;; has more lower case characters.
- (if (fboundp 'compare-strings)
- (eq (compare-strings s1 0 nil s2 0 nil t) -1)
- (string-lessp (downcase s1) (downcase s2))))
+ (eq (compare-strings s1 0 nil s2 0 nil t) -1))
(defun semantic-sort-tag-type (tag)
"Return a type string for TAG guaranteed to be a string."
diff --git a/lisp/cedet/semantic/symref.el b/lisp/cedet/semantic/symref.el
index 6bdec717457..d7f91573d3d 100644
--- a/lisp/cedet/semantic/symref.el
+++ b/lisp/cedet/semantic/symref.el
@@ -1,6 +1,6 @@
;;; semantic/symref.el --- Symbol Reference API
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -511,9 +511,10 @@ Optional OPEN-BUFFERS, when nil will use a faster version of
`find-file' when a file needs to be opened. If non-nil, then
normal buffer initialization will be used.
This function will leave buffers loaded from a file open, but
-will add buffers that must be opened to `semantic-symref-recently-opened-buffers'.
-Any caller MUST deal with that variable, either clearing it, or deleting the
-buffers that were opened."
+will add buffers that must be opened to
+`semantic-symref-recently-opened-buffers'.
+Any caller MUST deal with that variable, either clearing it, or
+deleting the buffers that were opened."
(let* ((line (car hit))
(file (cdr hit))
(buff (find-buffer-visiting file))
diff --git a/lisp/cedet/semantic/symref/cscope.el b/lisp/cedet/semantic/symref/cscope.el
index 502d59d745a..3686e519460 100644
--- a/lisp/cedet/semantic/symref/cscope.el
+++ b/lisp/cedet/semantic/symref/cscope.el
@@ -1,6 +1,6 @@
;;; semantic/symref/cscope.el --- Semantic-symref support via cscope.
-;;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/semantic/symref/filter.el b/lisp/cedet/semantic/symref/filter.el
index 19ce37463af..a40ce13f3d6 100644
--- a/lisp/cedet/semantic/symref/filter.el
+++ b/lisp/cedet/semantic/symref/filter.el
@@ -1,6 +1,6 @@
;;; semantic/symref/filter.el --- Filter symbol reference hits for accuracy.
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/semantic/symref/global.el b/lisp/cedet/semantic/symref/global.el
index 6bb0929601d..7f63e4ddbc0 100644
--- a/lisp/cedet/semantic/symref/global.el
+++ b/lisp/cedet/semantic/symref/global.el
@@ -1,6 +1,6 @@
;;; semantic/symref/global.el --- Use GNU Global for symbol references
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/semantic/symref/grep.el b/lisp/cedet/semantic/symref/grep.el
index d8de8ead4e9..9f0ac38ec75 100644
--- a/lisp/cedet/semantic/symref/grep.el
+++ b/lisp/cedet/semantic/symref/grep.el
@@ -1,6 +1,6 @@
;;; semantic/symref/grep.el --- Symref implementation using find/grep
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -167,24 +167,11 @@ This shell should support pipe redirect syntax."
(with-current-buffer b
(erase-buffer)
(setq default-directory rootdir)
-
- (if (not (fboundp 'grep-compute-defaults))
-
- ;; find . -type f -print0 | xargs -0 -e grep -nH -e
- ;; Note : I removed -e as it is not posix, nor necessary it seems.
-
- (let ((cmd (concat "find " (file-local-name rootdir)
- " -type f " filepattern " -print0 "
- "| xargs -0 grep -H " grepflags "-e " greppat)))
- ;;(message "Old command: %s" cmd)
- (process-file semantic-symref-grep-shell nil b nil
- shell-command-switch cmd)
- )
- (let ((cmd (semantic-symref-grep-use-template
- (file-local-name rootdir) filepattern grepflags greppat)))
- (process-file semantic-symref-grep-shell nil b nil
- shell-command-switch cmd))
- ))
+ (let ((cmd (semantic-symref-grep-use-template
+ (file-name-as-directory (file-local-name rootdir))
+ filepattern grepflags greppat)))
+ (process-file semantic-symref-grep-shell nil b nil
+ shell-command-switch cmd)))
(setq ans (semantic-symref-parse-tool-output tool b))
;; Return the answer
ans))
diff --git a/lisp/cedet/semantic/symref/idutils.el b/lisp/cedet/semantic/symref/idutils.el
index 006cc508165..4a41355dd69 100644
--- a/lisp/cedet/semantic/symref/idutils.el
+++ b/lisp/cedet/semantic/symref/idutils.el
@@ -1,6 +1,6 @@
;;; semantic/symref/idutils.el --- Symref implementation for idutils
-;;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/semantic/symref/list.el b/lisp/cedet/semantic/symref/list.el
index fc7f9dbcb64..7d3a5ddc2dc 100644
--- a/lisp/cedet/semantic/symref/list.el
+++ b/lisp/cedet/semantic/symref/list.el
@@ -1,6 +1,6 @@
;;; semantic/symref/list.el --- Symref Output List UI.
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -176,7 +176,7 @@ Display the references in `semantic-symref-results-mode'."
(switch-to-buffer-other-window buff)
(set-buffer buff)
(semantic-symref-results-mode)
- (set (make-local-variable 'semantic-symref-current-results) res)
+ (setq-local semantic-symref-current-results res)
(semantic-symref-results-dump res)
(goto-char (point-min))))
@@ -184,7 +184,7 @@ Display the references in `semantic-symref-results-mode'."
"Major-mode for displaying Semantic Symbol Reference results."
(buffer-disable-undo)
;; FIXME: Why bother turning off font-lock?
- (set (make-local-variable 'font-lock-global-modes) nil)
+ (setq-local font-lock-global-modes nil)
(font-lock-mode -1))
(defcustom semantic-symref-results-summary-function 'semantic-format-tag-prototype
diff --git a/lisp/cedet/semantic/tag-file.el b/lisp/cedet/semantic/tag-file.el
index 23f4b29cbd6..fc5c27752a0 100644
--- a/lisp/cedet/semantic/tag-file.el
+++ b/lisp/cedet/semantic/tag-file.el
@@ -1,6 +1,6 @@
;;; semantic/tag-file.el --- Routines that find files based on tags.
-;; Copyright (C) 1999-2005, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2005, 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
diff --git a/lisp/cedet/semantic/tag-ls.el b/lisp/cedet/semantic/tag-ls.el
index 3ee11df7d8e..6cef603af35 100644
--- a/lisp/cedet/semantic/tag-ls.el
+++ b/lisp/cedet/semantic/tag-ls.el
@@ -1,6 +1,6 @@
;;; semantic/tag-ls.el --- Language Specific override functions for tags
-;; Copyright (C) 1999-2004, 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2004, 2006-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -93,8 +93,9 @@ for a given mode at a more granular level.
Note that :type, :name, and anything in IGNORABLE-ATTRIBUTES will
not be passed to this function.
-Modes that override this function can call `semantic--tag-attribute-similar-p-default'
-to do the default equality tests if ATTR is not special for that mode.")
+Modes that override this function can call
+`semantic--tag-attribute-similar-p-default' to do the default equality tests if
+ATTR is not special for that mode.")
(defun semantic--tag-attribute-similar-p-default (attr value1 value2 ignorable-attributes)
"For ATTR, VALUE1, VALUE2 and IGNORABLE-ATTRIBUTES, test for similarity."
diff --git a/lisp/cedet/semantic/tag-write.el b/lisp/cedet/semantic/tag-write.el
index cd77caaa208..f705c89c904 100644
--- a/lisp/cedet/semantic/tag-write.el
+++ b/lisp/cedet/semantic/tag-write.el
@@ -1,6 +1,6 @@
;;; semantic/tag-write.el --- Write tags to a text stream
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/semantic/tag.el b/lisp/cedet/semantic/tag.el
index e677264c5a9..d68ffa55d6e 100644
--- a/lisp/cedet/semantic/tag.el
+++ b/lisp/cedet/semantic/tag.el
@@ -1,6 +1,6 @@
;;; semantic/tag.el --- tag creation and access
-;; Copyright (C) 1999-2005, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2005, 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -53,6 +53,11 @@
(declare-function semantic-clear-toplevel-cache "semantic")
(declare-function semantic-tag-similar-p "semantic/tag-ls")
+(define-obsolete-variable-alias 'semantic-token-version
+ 'semantic-tag-version "28.1")
+(define-obsolete-variable-alias 'semantic-token-incompatible-version
+ 'semantic-tag-incompatible-version "28.1")
+
(defconst semantic-tag-version "2.0"
"Version string of semantic tags made with this code.")
@@ -1321,12 +1326,6 @@ This function is overridable with the symbol `insert-foreign-tag'."
"Insert foreign tags into log-edit mode."
(insert (concat "(" (semantic-format-tag-name foreign-tag) "): ")))
-;;; Compatibility
-;;
-(defconst semantic-token-version
- semantic-tag-version)
-(defconst semantic-token-incompatible-version
- semantic-tag-incompatible-version)
(provide 'semantic/tag)
diff --git a/lisp/cedet/semantic/texi.el b/lisp/cedet/semantic/texi.el
index 8e8d362ceb5..377cec5455d 100644
--- a/lisp/cedet/semantic/texi.el
+++ b/lisp/cedet/semantic/texi.el
@@ -1,6 +1,6 @@
;;; semantic/texi.el --- Semantic details for Texinfo files
-;; Copyright (C) 2001-2005, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2005, 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/semantic/util-modes.el b/lisp/cedet/semantic/util-modes.el
index 24df0098562..45eef10f005 100644
--- a/lisp/cedet/semantic/util-modes.el
+++ b/lisp/cedet/semantic/util-modes.el
@@ -1,6 +1,6 @@
;;; semantic/util-modes.el --- Semantic minor modes
-;; Copyright (C) 2000-2005, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2005, 2007-2021 Free Software Foundation, Inc.
;; Authors: Eric M. Ludlam <zappo@gnu.org>
;; David Ponce <david@dponce.com>
@@ -701,8 +701,8 @@ non-nil if the minor mode is enabled."
(when (and (local-variable-p 'header-line-format (current-buffer))
(not (eq header-line-format
semantic-stickyfunc-header-line-format)))
- (set (make-local-variable 'semantic-stickyfunc-old-hlf)
- header-line-format))
+ (setq-local semantic-stickyfunc-old-hlf
+ header-line-format))
(setq header-line-format semantic-stickyfunc-header-line-format))
;; Disable sticky func mode
;; Restore previous buffer local value of header line format if
@@ -837,7 +837,8 @@ Argument EVENT describes the event that caused this function to be called."
"Keymap for highlight-func minor mode.")
(defvar semantic-highlight-func-popup-menu nil
- "Menu used if the user clicks on the header line used by `semantic-highlight-func-mode'.")
+ "Menu used if the user clicks on the header line.
+Used by `semantic-highlight-func-mode'.")
(easy-menu-define
semantic-highlight-func-popup-menu
diff --git a/lisp/cedet/semantic/util.el b/lisp/cedet/semantic/util.el
index 7df7dfcb75f..7d33d0e0886 100644
--- a/lisp/cedet/semantic/util.el
+++ b/lisp/cedet/semantic/util.el
@@ -1,6 +1,6 @@
;;; semantic/util.el --- Utilities for use with semantic tag tables
-;;; Copyright (C) 1999-2005, 2007-2020 Free Software Foundation, Inc.
+;;; Copyright (C) 1999-2005, 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
diff --git a/lisp/cedet/semantic/wisent.el b/lisp/cedet/semantic/wisent.el
index 15d1313dfa4..fb4d0b074ad 100644
--- a/lisp/cedet/semantic/wisent.el
+++ b/lisp/cedet/semantic/wisent.el
@@ -1,6 +1,6 @@
;;; semantic/wisent.el --- Wisent - Semantic gateway
-;; Copyright (C) 2001-2007, 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2007, 2009-2021 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
;; Created: 30 Aug 2001
diff --git a/lisp/cedet/semantic/wisent/comp.el b/lisp/cedet/semantic/wisent/comp.el
index 42c5756b987..755d30a371b 100644
--- a/lisp/cedet/semantic/wisent/comp.el
+++ b/lisp/cedet/semantic/wisent/comp.el
@@ -1,6 +1,6 @@
;;; semantic/wisent/comp.el --- GNU Bison for Emacs - Grammar compiler
-;; Copyright (C) 1984, 1986, 1989, 1992, 1995, 2000-2007, 2009-2020 Free
+;; Copyright (C) 1984, 1986, 1989, 1992, 1995, 2000-2007, 2009-2021 Free
;; Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
diff --git a/lisp/cedet/semantic/wisent/grammar.el b/lisp/cedet/semantic/wisent/grammar.el
index 0ff9cde80ef..cfd4899186b 100644
--- a/lisp/cedet/semantic/wisent/grammar.el
+++ b/lisp/cedet/semantic/wisent/grammar.el
@@ -1,6 +1,6 @@
;;; semantic/wisent/grammar.el --- Wisent's input grammar mode
-;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;;
;; Author: David Ponce <david@dponce.com>
;; Created: 26 Aug 2002
diff --git a/lisp/cedet/semantic/wisent/java-tags.el b/lisp/cedet/semantic/wisent/java-tags.el
index 0eed98cc43c..d455c02d1b5 100644
--- a/lisp/cedet/semantic/wisent/java-tags.el
+++ b/lisp/cedet/semantic/wisent/java-tags.el
@@ -1,6 +1,6 @@
;;; semantic/wisent/java-tags.el --- Java LALR parser for Emacs
-;; Copyright (C) 2001-2006, 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2006, 2009-2021 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
;; Created: 15 Dec 2001
diff --git a/lisp/cedet/semantic/wisent/javascript.el b/lisp/cedet/semantic/wisent/javascript.el
index 90bf7fab5c1..684eea1d93d 100644
--- a/lisp/cedet/semantic/wisent/javascript.el
+++ b/lisp/cedet/semantic/wisent/javascript.el
@@ -1,6 +1,6 @@
;;; semantic/wisent/javascript.el --- javascript parser support
-;; Copyright (C) 2005, 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2005, 2009-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
diff --git a/lisp/cedet/semantic/wisent/python.el b/lisp/cedet/semantic/wisent/python.el
index 4e3519260a8..7769ad1961b 100644
--- a/lisp/cedet/semantic/wisent/python.el
+++ b/lisp/cedet/semantic/wisent/python.el
@@ -1,6 +1,6 @@
;;; wisent-python.el --- Semantic support for Python
-;; Copyright (C) 2002, 2004, 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002, 2004, 2006-2021 Free Software Foundation, Inc.
;; Author: Richard Kim <emacs18@gmail.com>
;; Created: June 2002
@@ -503,10 +503,10 @@ Shortens `code' tags, but passes through for others."
(defun wisent-python-default-setup ()
"Setup buffer for parse."
(wisent-python-wy--install-parser)
- (set (make-local-variable 'parse-sexp-ignore-comments) t)
+ (setq-local parse-sexp-ignore-comments t)
;; Give python modes the possibility to overwrite this:
(if (not comment-start-skip)
- (set (make-local-variable 'comment-start-skip) "#+\\s-*"))
+ (setq-local comment-start-skip "#+\\s-*"))
(setq
;; Character used to separation a parent/child relationship
semantic-type-relation-separator-character '(".")
diff --git a/lisp/cedet/semantic/wisent/wisent.el b/lisp/cedet/semantic/wisent/wisent.el
index a0a8bed1eaf..26cf87f8425 100644
--- a/lisp/cedet/semantic/wisent/wisent.el
+++ b/lisp/cedet/semantic/wisent/wisent.el
@@ -1,6 +1,6 @@
;;; semantic/wisent/wisent.el --- GNU Bison for Emacs - Runtime
-;;; Copyright (C) 2002-2007, 2009-2020 Free Software Foundation, Inc.
+;;; Copyright (C) 2002-2007, 2009-2021 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
;; Created: 30 January 2002
diff --git a/lisp/cedet/srecode.el b/lisp/cedet/srecode.el
index eb7af1c2727..aa4aa812e02 100644
--- a/lisp/cedet/srecode.el
+++ b/lisp/cedet/srecode.el
@@ -1,6 +1,6 @@
-;;; srecode.el --- Semantic buffer evaluator.
+;;; srecode.el --- Semantic buffer evaluator. -*- lexical-binding: t -*-
-;;; Copyright (C) 2005, 2007-2020 Free Software Foundation, Inc.
+;;; Copyright (C) 2005, 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: codegeneration
diff --git a/lisp/cedet/srecode/args.el b/lisp/cedet/srecode/args.el
index 4ac5047ae08..24c5f22f2e7 100644
--- a/lisp/cedet/srecode/args.el
+++ b/lisp/cedet/srecode/args.el
@@ -1,6 +1,6 @@
;;; srecode/args.el --- Provide some simple template arguments
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/srecode/compile.el b/lisp/cedet/srecode/compile.el
index 9f81b2bccc2..7146b643836 100644
--- a/lisp/cedet/srecode/compile.el
+++ b/lisp/cedet/srecode/compile.el
@@ -1,6 +1,6 @@
;;; srecode/compile --- Compilation of srecode template files.
-;; Copyright (C) 2005, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2005, 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: codegeneration
diff --git a/lisp/cedet/srecode/cpp.el b/lisp/cedet/srecode/cpp.el
index 3e40472654e..1b9610f3f1b 100644
--- a/lisp/cedet/srecode/cpp.el
+++ b/lisp/cedet/srecode/cpp.el
@@ -1,6 +1,6 @@
;;; srecode/cpp.el --- C++ specific handlers for Semantic Recoder
-;; Copyright (C) 2007, 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007, 2009-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Jan Moringen <scymtym@users.sourceforge.net>
diff --git a/lisp/cedet/srecode/ctxt.el b/lisp/cedet/srecode/ctxt.el
index 3d990219b82..20334f95838 100644
--- a/lisp/cedet/srecode/ctxt.el
+++ b/lisp/cedet/srecode/ctxt.el
@@ -1,6 +1,6 @@
;;; srecode/ctxt.el --- Derive a context from the source buffer.
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/srecode/dictionary.el b/lisp/cedet/srecode/dictionary.el
index 4322b09137d..c1fe4b2c34e 100644
--- a/lisp/cedet/srecode/dictionary.el
+++ b/lisp/cedet/srecode/dictionary.el
@@ -1,6 +1,6 @@
;;; srecode/dictionary.el --- Dictionary code for the semantic recoder.
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/srecode/document.el b/lisp/cedet/srecode/document.el
index fdb44695918..0d1a4c01d3c 100644
--- a/lisp/cedet/srecode/document.el
+++ b/lisp/cedet/srecode/document.el
@@ -1,6 +1,6 @@
;;; srecode/document.el --- Documentation (comment) generation
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/srecode/el.el b/lisp/cedet/srecode/el.el
index 4095b1c119c..7e9dd10fd42 100644
--- a/lisp/cedet/srecode/el.el
+++ b/lisp/cedet/srecode/el.el
@@ -1,6 +1,6 @@
;;; srecode/el.el --- Emacs Lisp specific arguments
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/srecode/expandproto.el b/lisp/cedet/srecode/expandproto.el
index e7601f5dd2b..cdb29d16b71 100644
--- a/lisp/cedet/srecode/expandproto.el
+++ b/lisp/cedet/srecode/expandproto.el
@@ -1,6 +1,6 @@
;;; srecode/expandproto.el --- Expanding prototypes.
-;; Copyright (C) 2007, 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007, 2009-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/srecode/extract.el b/lisp/cedet/srecode/extract.el
index 51c5fe4d184..625b854b776 100644
--- a/lisp/cedet/srecode/extract.el
+++ b/lisp/cedet/srecode/extract.el
@@ -1,6 +1,6 @@
;;; srecode/extract.el --- Extract content from previously inserted macro.
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/srecode/fields.el b/lisp/cedet/srecode/fields.el
index 87c7c684dab..71613bcc2a3 100644
--- a/lisp/cedet/srecode/fields.el
+++ b/lisp/cedet/srecode/fields.el
@@ -1,6 +1,6 @@
;;; srecode/fields.el --- Handling type-in fields in a buffer.
;;
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/srecode/filters.el b/lisp/cedet/srecode/filters.el
index ee672a5116f..4a996cf6f12 100644
--- a/lisp/cedet/srecode/filters.el
+++ b/lisp/cedet/srecode/filters.el
@@ -1,6 +1,6 @@
;;; srecode/filters.el --- Filters for use in template variables.
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/srecode/find.el b/lisp/cedet/srecode/find.el
index c6bb62b7aa4..aec73dce5a5 100644
--- a/lisp/cedet/srecode/find.el
+++ b/lisp/cedet/srecode/find.el
@@ -1,6 +1,6 @@
;;;; srecode/find.el --- Tools for finding templates in the database.
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/srecode/getset.el b/lisp/cedet/srecode/getset.el
index 2e063812ca1..1e4888655f9 100644
--- a/lisp/cedet/srecode/getset.el
+++ b/lisp/cedet/srecode/getset.el
@@ -1,6 +1,6 @@
;;; srecode/getset.el --- Package for inserting new get/set methods.
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/srecode/insert.el b/lisp/cedet/srecode/insert.el
index c28f7be03a1..ab0503c8d36 100644
--- a/lisp/cedet/srecode/insert.el
+++ b/lisp/cedet/srecode/insert.el
@@ -1,6 +1,6 @@
;;; srecode/insert.el --- Insert srecode templates to an output stream -*- lexical-binding:t -*-
-;; Copyright (C) 2005, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2005, 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/srecode/java.el b/lisp/cedet/srecode/java.el
index fa508df0549..768d48a7c5b 100644
--- a/lisp/cedet/srecode/java.el
+++ b/lisp/cedet/srecode/java.el
@@ -1,6 +1,6 @@
;;; srecode/java.el --- Srecode Java support
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/srecode/map.el b/lisp/cedet/srecode/map.el
index dc949200968..a94db0bb8d9 100644
--- a/lisp/cedet/srecode/map.el
+++ b/lisp/cedet/srecode/map.el
@@ -1,6 +1,6 @@
;;; srecode/map.el --- Manage a template file map
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/srecode/mode.el b/lisp/cedet/srecode/mode.el
index c94c0fc034d..159dc7a999b 100644
--- a/lisp/cedet/srecode/mode.el
+++ b/lisp/cedet/srecode/mode.el
@@ -1,6 +1,6 @@
;;; srecode/mode.el --- Minor mode for managing and using SRecode templates
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/srecode/semantic.el b/lisp/cedet/srecode/semantic.el
index 5b2dd034743..101246cae6f 100644
--- a/lisp/cedet/srecode/semantic.el
+++ b/lisp/cedet/srecode/semantic.el
@@ -1,6 +1,6 @@
-;;; srecode/semantic.el --- Semantic specific extensions to SRecode.
+;;; srecode/semantic.el --- Semantic specific extensions to SRecode -*- lexical-binding:t -*-
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -57,7 +57,7 @@ This class will be used to derive dictionary values.")
(cl-defmethod srecode-compound-toString((cp srecode-semantic-tag)
function
- dictionary)
+ _dictionary)
"Convert the compound dictionary value CP to a string.
If FUNCTION is non-nil, then FUNCTION is somehow applied to an
aspect of the compound value."
@@ -410,7 +410,9 @@ as `function' will leave point where code might be inserted."
;; Insert the template.
(let ((endpt (srecode-insert-fcn temp dict nil t)))
- (run-hook-with-args 'point-insert-fcn tag)
+ (if (functionp point-insert-fcn)
+ (funcall point-insert-fcn tag)
+ (dolist (f point-insert-fcn) (funcall f tag)))
;;(sit-for 1)
(cond
diff --git a/lisp/cedet/srecode/srt-mode.el b/lisp/cedet/srecode/srt-mode.el
index 4c1e030fceb..bbe1e5e469c 100644
--- a/lisp/cedet/srecode/srt-mode.el
+++ b/lisp/cedet/srecode/srt-mode.el
@@ -1,6 +1,6 @@
;;; srecode/srt-mode.el --- Major mode for writing screcode macros
-;; Copyright (C) 2005, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2005, 2007-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -191,18 +191,18 @@ we can tell font lock about them.")
(define-derived-mode srecode-template-mode fundamental-mode "SRecode"
;; FIXME: Shouldn't it derive from prog-mode?
"Major-mode for writing SRecode macros."
- (set (make-local-variable 'comment-start) ";;")
- (set (make-local-variable 'comment-end) "")
- (set (make-local-variable 'parse-sexp-ignore-comments) t)
- (set (make-local-variable 'comment-start-skip)
- "\\(\\(^\\|[^\\\n]\\)\\(\\\\\\\\\\)*\\);+ *")
- (set (make-local-variable 'font-lock-defaults)
- '(srecode-font-lock-keywords
- nil ;; perform string/comment fontification
- nil ;; keywords are case sensitive.
- ;; This puts _ & - as a word constituent,
- ;; simplifying our keywords significantly
- ((?_ . "w") (?- . "w")))))
+ (setq-local comment-start ";;")
+ (setq-local comment-end "")
+ (setq-local parse-sexp-ignore-comments t)
+ (setq-local comment-start-skip
+ "\\(\\(^\\|[^\\\n]\\)\\(\\\\\\\\\\)*\\);+ *")
+ (setq-local font-lock-defaults
+ '(srecode-font-lock-keywords
+ nil ;; perform string/comment fontification
+ nil ;; keywords are case sensitive.
+ ;; This puts _ & - as a word constituent,
+ ;; simplifying our keywords significantly
+ ((?_ . "w") (?- . "w")))))
;;;###autoload
(defalias 'srt-mode 'srecode-template-mode)
diff --git a/lisp/cedet/srecode/srt.el b/lisp/cedet/srecode/srt.el
index ef0ef0d0fd5..e222997708b 100644
--- a/lisp/cedet/srecode/srt.el
+++ b/lisp/cedet/srecode/srt.el
@@ -1,6 +1,6 @@
;;; srecode/srt.el --- argument handlers for SRT files
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/srecode/table.el b/lisp/cedet/srecode/table.el
index 55093d655cf..60a466f89d9 100644
--- a/lisp/cedet/srecode/table.el
+++ b/lisp/cedet/srecode/table.el
@@ -1,6 +1,6 @@
;;; srecode/table.el --- Tables of Semantic Recoders
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/srecode/template.el b/lisp/cedet/srecode/template.el
index 68c2ee7b75d..e9e5115128f 100644
--- a/lisp/cedet/srecode/template.el
+++ b/lisp/cedet/srecode/template.el
@@ -1,6 +1,6 @@
;;; srecode/template.el --- SRecoder template language parser support.
-;; Copyright (C) 2005, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2005, 2007-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/lisp/cedet/srecode/texi.el b/lisp/cedet/srecode/texi.el
index 3aefcfd30e9..892ae4e2e31 100644
--- a/lisp/cedet/srecode/texi.el
+++ b/lisp/cedet/srecode/texi.el
@@ -1,6 +1,6 @@
;;; srecode/texi.el --- Srecode texinfo support.
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/char-fold.el b/lisp/char-fold.el
index 34561a2efe6..46a3f93d0af 100644
--- a/lisp/char-fold.el
+++ b/lisp/char-fold.el
@@ -1,6 +1,6 @@
;;; char-fold.el --- match unicode to similar ASCII -*- lexical-binding: t; -*-
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: matching
diff --git a/lisp/chistory.el b/lisp/chistory.el
index c9aa927b94f..589b5b5feb9 100644
--- a/lisp/chistory.el
+++ b/lisp/chistory.el
@@ -1,6 +1,6 @@
;;; chistory.el --- list command history
-;; Copyright (C) 1985, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 2001-2021 Free Software Foundation, Inc.
;; Author: K. Shane Hartman
;; Maintainer: emacs-devel@gnu.org
@@ -140,7 +140,7 @@ The buffer is left in Command History mode."
Keybindings:
\\{command-history-mode-map}"
(lisp-mode-variables nil)
- (set (make-local-variable 'revert-buffer-function) 'command-history-revert)
+ (setq-local revert-buffer-function 'command-history-revert)
(set-syntax-table emacs-lisp-mode-syntax-table))
(defcustom command-history-hook nil
diff --git a/lisp/cmuscheme.el b/lisp/cmuscheme.el
index 7191b933e41..772891d5d31 100644
--- a/lisp/cmuscheme.el
+++ b/lisp/cmuscheme.el
@@ -1,6 +1,6 @@
;;; cmuscheme.el --- Scheme process in a buffer. Adapted from tea.el
-;; Copyright (C) 1988, 1994, 1997, 2001-2020 Free Software Foundation,
+;; Copyright (C) 1988, 1994, 1997, 2001-2021 Free Software Foundation,
;; Inc.
;; Author: Olin Shivers <olin.shivers@cs.cmu.edu>
diff --git a/lisp/color.el b/lisp/color.el
index 48f150de70c..258acbe4053 100644
--- a/lisp/color.el
+++ b/lisp/color.el
@@ -1,6 +1,6 @@
;;; color.el --- Color manipulation library -*- lexical-binding:t -*-
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Authors: Julien Danjou <julien@danjou.info>
;; Drew Adams <drew.adams@oracle.com>
diff --git a/lisp/comint.el b/lisp/comint.el
index 2873416c5f4..e52d67d0e50 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -1,6 +1,6 @@
;;; comint.el --- general command interpreter in a window stuff -*- lexical-binding: t -*-
-;; Copyright (C) 1988, 1990, 1992-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 1990, 1992-2021 Free Software Foundation, Inc.
;; Author: Olin Shivers <shivers@cs.cmu.edu>
;; Simon Marshall <simon@gnu.org>
@@ -979,6 +979,7 @@ See also `comint-input-ignoredups' and `comint-write-input-ring'."
(ring (make-ring ring-size))
;; Use possibly buffer-local values of these variables.
(ring-separator comint-input-ring-separator)
+ (ring-file-prefix comint-input-ring-file-prefix)
(history-ignore comint-input-history-ignore)
(ignoredups comint-input-ignoredups))
(with-temp-buffer
@@ -990,24 +991,15 @@ See also `comint-input-ignoredups' and `comint-write-input-ring'."
(while (and (< count comint-input-ring-size)
(re-search-backward ring-separator nil t)
(setq end (match-beginning 0)))
- (setq start
- (if (re-search-backward ring-separator nil t)
- (progn
- (when (and comint-input-ring-file-prefix
- (looking-at
- comint-input-ring-file-prefix))
- ;; Skip zsh extended_history stamps
- (goto-char (match-end 0)))
- (match-end 0))
- (progn
- (goto-char (point-min))
- (when (and comint-input-ring-file-prefix
- (looking-at
- comint-input-ring-file-prefix))
- (goto-char (match-end 0)))
- (point))))
+ (goto-char (if (re-search-backward ring-separator nil t)
+ (match-end 0)
+ (point-min)))
+ (when (and ring-file-prefix
+ (looking-at ring-file-prefix))
+ ;; Skip zsh extended_history stamps
+ (goto-char (match-end 0)))
+ (setq start (point))
(setq history (buffer-substring start end))
- (goto-char start)
(when (and (not (string-match history-ignore history))
(or (null ignoredups)
(ring-empty-p ring)
@@ -1224,7 +1216,7 @@ Moves relative to START, or `comint-input-ring-index'."
(process-mark (get-buffer-process (current-buffer))))
(point-max)))
-(defun comint-previous-matching-input (regexp n)
+(defun comint-previous-matching-input (regexp n &optional restore)
"Search backwards through input history for match for REGEXP.
\(Previous history elements are earlier commands.)
With prefix argument N, search for Nth previous match.
@@ -1235,16 +1227,24 @@ If N is negative, find the next or Nth next match."
;; Has a match been found?
(if (null pos)
(user-error "Not found")
- ;; If leaving the edit line, save partial input
- (if (null comint-input-ring-index) ;not yet on ring
- (setq comint-stored-incomplete-input
- (funcall comint-get-old-input)))
- (setq comint-input-ring-index pos)
- (unless isearch-mode
- (let ((message-log-max nil)) ; Do not write to *Messages*.
- (message "History item: %d" (1+ pos))))
- (comint-delete-input)
- (insert (ring-ref comint-input-ring pos)))))
+ (if (and comint-input-ring-index
+ restore
+ (or (and (< n 0)
+ (< comint-input-ring-index pos))
+ (and (> n 0)
+ (> comint-input-ring-index pos))))
+ ;; We have a wrap; restore contents.
+ (comint-restore-input)
+ ;; If leaving the edit line, save partial input
+ (if (null comint-input-ring-index) ;not yet on ring
+ (setq comint-stored-incomplete-input
+ (funcall comint-get-old-input)))
+ (setq comint-input-ring-index pos)
+ (unless isearch-mode
+ (let ((message-log-max nil)) ; Do not write to *Messages*.
+ (message "History item: %d" (1+ pos))))
+ (comint-delete-input)
+ (insert (ring-ref comint-input-ring pos))))))
(defun comint-next-matching-input (regexp n)
"Search forwards through input history for match for REGEXP.
@@ -1272,7 +1272,7 @@ If N is negative, search forwards for the -Nth following match."
comint-input-ring-index nil))
(comint-previous-matching-input
(concat "^" (regexp-quote comint-matching-input-from-input-string))
- n)
+ n t)
(when (eq comint-move-point-for-matching-input 'after-input)
(goto-char opoint))))
@@ -3863,7 +3863,11 @@ REGEXP-GROUP is the regular expression group in REGEXP to use."
(push (buffer-substring-no-properties
(match-beginning regexp-group)
(match-end regexp-group))
- results))
+ results)
+ (when (zerop (length (match-string 0)))
+ ;; If the regexp can be empty (for instance, "^.*$"), we
+ ;; don't advance, so ensure forward progress.
+ (forward-line 1)))
(nreverse results))))
;; Converting process modes to use comint mode
diff --git a/lisp/completion.el b/lisp/completion.el
index 8a4c1676145..8810a22d262 100644
--- a/lisp/completion.el
+++ b/lisp/completion.el
@@ -1,6 +1,6 @@
;;; completion.el --- dynamic word-completion code
-;; Copyright (C) 1990, 1993, 1995, 1997, 2001-2020 Free Software
+;; Copyright (C) 1990, 1993, 1995, 1997, 2001-2021 Free Software
;; Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/composite.el b/lisp/composite.el
index 0a8dcb875c9..6f654df15aa 100644
--- a/lisp/composite.el
+++ b/lisp/composite.el
@@ -1,6 +1,6 @@
-;;; composite.el --- support character composition
+;;; composite.el --- support character composition -*- lexical-binding: t; -*-
-;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
;; 2008, 2009, 2010, 2011
@@ -593,7 +593,6 @@ All non-spacing characters have this function in
(as (lglyph-ascent glyph))
(de (lglyph-descent glyph))
(ce (/ (+ lb rb) 2))
- (w (lglyph-width glyph))
xoff yoff)
(cond
((and class (>= class 200) (<= class 240))
@@ -653,7 +652,8 @@ All non-spacing characters have this function in
((and (= class 0)
(eq (get-char-code-property (lglyph-char glyph)
;; Me = enclosing mark
- 'general-category) 'Me))
+ 'general-category)
+ 'Me))
;; Artificially laying out glyphs in an enclosing
;; mark is difficult. All we can do is to adjust
;; the x-offset and width of the base glyph to
@@ -695,9 +695,7 @@ All non-spacing characters have this function in
(defun compose-gstring-for-dotted-circle (gstring direction)
(let* ((dc (lgstring-glyph gstring 0)) ; glyph of dotted-circle
- (dc-id (lglyph-code dc))
(fc (lgstring-glyph gstring 1)) ; glyph of the following char
- (fc-id (lglyph-code fc))
(gstr (and nil (font-shape-gstring gstring direction))))
(if (and gstr
(or (= (lgstring-glyph-len gstr) 1)
diff --git a/lisp/cus-dep.el b/lisp/cus-dep.el
index 9003b7fc1b5..a52d08266c1 100644
--- a/lisp/cus-dep.el
+++ b/lisp/cus-dep.el
@@ -1,6 +1,6 @@
;;; cus-dep.el --- find customization dependencies
;;
-;; Copyright (C) 1997, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: internal
@@ -204,7 +204,7 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS"
(setq where (get symbol 'custom-where))
(when where
(if (or (custom-variable-p symbol)
- (custom-facep symbol))
+ (facep symbol))
;; This means it's a variable or a face.
(progn
(if (assoc version version-alist)
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index 3eef4468394..e52df4e6a2c 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -1,6 +1,6 @@
;;; cus-edit.el --- tools for customizing Emacs and Lisp packages -*- lexical-binding:t -*-
;;
-;; Copyright (C) 1996-1997, 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1997, 1999-2021 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Maintainer: emacs-devel@gnu.org
@@ -730,48 +730,86 @@ groups after non-groups, if nil do not order groups at all."
;; `custom-buffer-create-internal' if `custom-buffer-verbose-help' is non-nil.
(defvar custom-commands
- '((" Apply " Custom-set t
- "Apply settings (for the current session only)."
- "index"
- "Apply")
- (" Apply and Save " Custom-save
- (or custom-file user-init-file)
- "Apply settings and save for future sessions."
- "save"
- "Save")
+ '((" Apply " Custom-set t "Apply settings (for the current session only)."
+ "index" "Apply" (modified))
+ (" Apply and Save " Custom-save (or custom-file user-init-file)
+ "Apply settings and save for future sessions." "save" "Save"
+ (modified set changed rogue))
(" Undo Edits " Custom-reset-current t
"Restore customization buffer to reflect existing settings."
- "refresh"
- "Undo")
+ "refresh" "Undo" (modified))
(" Reset Customizations " Custom-reset-saved t
- "Undo any settings applied only for the current session."
- "undo"
- "Reset")
+ "Undo any settings applied only for the current session." "undo" "Reset"
+ (modified set changed rogue))
(" Erase Customizations " Custom-reset-standard
(or custom-file user-init-file)
- "Un-customize settings in this and future sessions."
- "delete"
- "Uncustomize")
- (" Help for Customize " Custom-help t
- "Get help for using Customize."
- "help"
- "Help")
- (" Exit " Custom-buffer-done t "Exit Customize." "exit" "Exit")))
+ "Un-customize settings in this and future sessions." "delete" "Uncustomize"
+ (modified set changed rogue saved))
+ (" Help for Customize " Custom-help t "Get help for using Customize."
+ "help" "Help" t)
+ (" Exit " Custom-buffer-done t "Exit Customize." "exit" "Exit" t))
+ "Alist of specifications for Customize menu items, tool bar icons and buttons.
+Each member has the format (TAG COMMAND VISIBLE HELP ICON LABEL ENABLE).
+TAG is a string, used as the :tag property of a widget.
+COMMAND is the command that the item or button runs.
+VISIBLE should be a form, suitable to pass as the :visible property for menu
+or tool bar items.
+HELP should be a string that can be used as the help echo property for tooltips
+and the like.
+ICON is a string that names the image to use for the tool bar item, like in the
+first argument of `tool-bar-local-item'.
+LABEL should be a string, used as the name of the menu items.
+ENABLE should be a list of custom states or t. When ENABLE is t, the item is
+always enabled. Otherwise, it is enabled only if at least one option displayed
+in the Custom buffer is in a state present in ENABLE.")
+
+(defvar-local custom-command-buttons nil
+ "A list that holds the buttons that act on all settings in a Custom buffer.
+`custom-buffer-create-internal' adds the buttons to this list.
+Changes in the state of the custom options should notify the buttons via the
+:notify property, so buttons can be enabled/disabled correctly at all times.")
(defun Custom-help ()
"Read the node on Easy Customization in the Emacs manual."
(interactive)
(info "(emacs)Easy Customization"))
-(defvar custom-reset-menu
- '(("Undo Edits in Customization Buffer" . Custom-reset-current)
- ("Revert This Session's Customizations" . Custom-reset-saved)
- ("Erase Customizations" . Custom-reset-standard))
- "Alist of actions for the `Reset' button.
+(defvar custom-reset-menu nil
+ "If non-nil, an alist of actions for the `Reset' button.
+
+This variable is kept for backward compatibility reasons, please use
+`custom-reset-extended-menu' instead.
+
The key is a string containing the name of the action, the value is a
Lisp function taking the widget as an element which will be called
when the action is chosen.")
+(defvar custom-reset-extended-menu
+ (let ((map (make-sparse-keymap)))
+ (define-key-after map [Custom-reset-current]
+ '(menu-item "Undo Edits in Customization Buffer" Custom-reset-current
+ :enable (seq-some (lambda (option)
+ (eq (widget-get option :custom-state)
+ 'modified))
+ custom-options)))
+ (define-key-after map [Custom-reset-saved]
+ '(menu-item "Revert This Session's Customizations" Custom-reset-saved
+ :enable (seq-some (lambda (option)
+ (memq (widget-get option :custom-state)
+ '(modified set changed rogue)))
+ custom-options)))
+ (when (or custom-file user-init-file)
+ (define-key-after map [Custom-reset-standard]
+ '(menu-item "Erase Customizations" Custom-reset-standard
+ :enable (seq-some
+ (lambda (option)
+ (memq (widget-get option :custom-state)
+ '(modified set changed rogue saved)))
+ custom-options))))
+ map)
+ "A menu for the \"Revert...\" button.
+Used in `custom-reset' to show a menu to the user.")
+
(defvar custom-options nil
"Customization widgets in the current buffer.")
@@ -821,7 +859,8 @@ setting was merely edited before, this sets it then saves it."
"Select item from reset menu."
(let* ((completion-ignore-case t)
(answer (widget-choose "Reset settings"
- custom-reset-menu
+ (or custom-reset-menu
+ custom-reset-extended-menu)
event)))
(if answer
(funcall answer))))
@@ -1256,10 +1295,11 @@ that were added or redefined since that version."
(push (list symbol 'custom-group) found))
(if (custom-variable-p symbol)
(push (list symbol 'custom-variable) found))
- (if (custom-facep symbol)
+ (if (facep symbol)
(push (list symbol 'custom-face) found)))))))
(if found
- (custom-buffer-create (custom-sort-items found t 'first)
+ (custom-buffer-create (custom--filter-obsolete-variables
+ (custom-sort-items found t 'first))
"*Customize Changed Options*")
(user-error "No user option defaults have been changed since Emacs %s"
since-version))))
@@ -1366,7 +1406,7 @@ symbols `custom-face' or `custom-variable'."
(mapatoms (lambda (symbol)
(and (or (get symbol 'customized-face)
(get symbol 'customized-face-comment))
- (custom-facep symbol)
+ (facep symbol)
(push (list symbol 'custom-face) found))
(and (or (get symbol 'customized-value)
(get symbol 'customized-variable-comment))
@@ -1413,7 +1453,7 @@ symbols `custom-face' or `custom-variable'."
(mapatoms (lambda (symbol)
(and (or (get symbol 'saved-face)
(get symbol 'saved-face-comment))
- (custom-facep symbol)
+ (facep symbol)
(push (list symbol 'custom-face) found))
(and (or (get symbol 'saved-value)
(get symbol 'saved-variable-comment))
@@ -1451,7 +1491,7 @@ If TYPE is `groups', include only groups."
(if (get symbol 'custom-group)
(push (list symbol 'custom-group) found)))
(if (memq type '(nil faces))
- (if (custom-facep symbol)
+ (if (facep symbol)
(push (list symbol 'custom-face) found)))
(if (memq type '(nil options))
(if (and (boundp symbol)
@@ -1465,7 +1505,8 @@ If TYPE is `groups', include only groups."
(symbol-name type))
pattern))
(custom-buffer-create
- (custom-sort-items found t custom-buffer-order-groups)
+ (custom--filter-obsolete-variables
+ (custom-sort-items found t custom-buffer-order-groups))
"*Customize Apropos*")))
;;;###autoload
@@ -1555,7 +1596,10 @@ that option.
DESCRIPTION is unused."
(pop-to-buffer-same-window
(custom-get-fresh-buffer (or name "*Customization*")))
- (custom-buffer-create-internal options))
+ (custom-buffer-create-internal options)
+ ;; Notify the command buttons, to correctly enable/disable them.
+ (dolist (btn custom-command-buttons)
+ (widget-apply btn :notify)))
;;;###autoload
(defun custom-buffer-create-other-window (options &optional name _description)
@@ -1672,11 +1716,24 @@ or a regular expression.")
(if custom-buffer-verbose-help
(widget-insert "
Operate on all settings in this buffer:\n"))
- (let ((button (lambda (tag action active help _icon _label)
+ (let ((button (lambda (tag action visible help _icon _label active)
(widget-insert " ")
- (if (eval active)
- (widget-create 'push-button :tag tag
- :help-echo help :action action))))
+ (if (eval visible)
+ (push (widget-create
+ 'push-button :tag tag
+ :help-echo help :action action
+ :notify
+ (lambda (widget)
+ (when (listp active)
+ (if (seq-some
+ (lambda (widget)
+ (memq
+ (widget-get widget :custom-state)
+ active))
+ custom-options)
+ (widget-apply widget :activate)
+ (widget-apply widget :deactivate)))))
+ custom-command-buttons))))
(commands custom-commands))
(if custom-reset-button-menu
(progn
@@ -2215,7 +2272,11 @@ and `face'."
(let ((state (widget-get widget :custom-state)))
(unless (eq state 'modified)
(unless (memq state '(nil unknown hidden))
- (widget-put widget :custom-state 'modified))
+ (widget-put widget :custom-state 'modified)
+ ;; Tell our buttons and the tool bar that we changed the widget's state.
+ (force-mode-line-update)
+ (dolist (btn custom-command-buttons)
+ (widget-apply btn :notify)))
;; Update the status text (usually from "STANDARD" to "EDITED
;; bla bla" in the buffer after the command has run. Otherwise
;; commands like `M-u' (that work on a region in the buffer)
@@ -2254,7 +2315,10 @@ and `face'."
(custom-group-state-update widget)))
(t
(setq widget nil)))))
- (widget-setup))
+ (widget-setup)
+ (force-mode-line-update)
+ (dolist (btn custom-command-buttons)
+ (widget-apply btn :notify)))
(defun custom-show (widget value)
"Non-nil if WIDGET should be shown with VALUE by default."
@@ -2670,11 +2734,15 @@ try matching its doc string against `custom-guess-doc-alist'."
buttons)
(insert " ")
(let* ((format (widget-get type :format))
- tag-format value-format)
- (unless (string-match ":" format)
+ tag-format)
+ ;; We used to drop the widget tag when creating TYPE, passing
+ ;; everything after the colon (including whitespace characters
+ ;; after it) as the :format for TYPE. We don't drop the tag
+ ;; anymore, but we should keep an immediate whitespace character,
+ ;; if present, and it's easier to do it here.
+ (unless (string-match ":\\s-?" format)
(error "Bad format"))
(setq tag-format (substring format 0 (match-end 0)))
- (setq value-format (substring format (match-end 0)))
(push (widget-create-child-and-convert
widget 'item
:format tag-format
@@ -2689,7 +2757,6 @@ try matching its doc string against `custom-guess-doc-alist'."
buttons)
(push (widget-create-child-and-convert
widget type
- :format value-format
:value value)
children))))
(unless (eq custom-buffer-style 'tree)
@@ -2836,14 +2903,20 @@ Modified means that the widget that holds the value has been edited by the user
in a customize buffer.
To check for other states, call `custom-variable-state'."
(catch 'get-error
- (let* ((symbol (widget-get widget :value))
+ (let* ((form (widget-get widget :custom-form))
+ (symbol (widget-get widget :value))
(get (or (get symbol 'custom-get) 'default-value))
(value (if (default-boundp symbol)
(condition-case nil
(funcall get symbol)
(error (throw 'get-error t)))
- (symbol-value symbol))))
- (not (equal value (widget-value (car (widget-get widget :children))))))))
+ (symbol-value symbol)))
+ (orig-value (widget-value (car (widget-get widget :children)))))
+ (not (equal (if (memq form '(lisp mismatch))
+ ;; Mimic `custom-variable-value-create'.
+ (custom-quote value)
+ value)
+ orig-value)))))
(defun custom-variable-state-set (widget &optional state)
"Set the state of WIDGET to STATE.
@@ -4021,7 +4094,7 @@ restoring it to the state of a face that has never been customized."
(define-widget 'face 'symbol
"A Lisp face name (with sample)."
- :format "%f %{%t%}: (%{sample%}) %v"
+ :format "%{%t%}: %f (%{sample%}) %v"
:tag "Face"
:value 'default
:sample-face-get 'widget-face-sample-face-get
@@ -4170,6 +4243,13 @@ and so forth. The remaining group tags are shown with `custom-group-tag'."
(insert "--------")))
(widget-default-create widget))
+(defun custom--filter-obsolete-variables (items)
+ "Filter obsolete variables from ITEMS."
+ (seq-remove (lambda (item)
+ (and (eq (nth 1 item) 'custom-variable)
+ (get (nth 0 item) 'byte-obsolete-variable)))
+ items))
+
(defun custom-group-members (symbol groups-only)
"Return SYMBOL's custom group members.
If GROUPS-ONLY is non-nil, return only those members that are groups."
@@ -4375,12 +4455,13 @@ This works for both graphical and text displays."
?\s))
;; Members.
(message "Creating group...")
- (let* ((members (custom-sort-items
- members
- ;; Never sort the top-level custom group.
- (unless (eq symbol 'emacs)
- custom-buffer-sort-alphabetically)
- custom-buffer-order-groups))
+ (let* ((members (custom--filter-obsolete-variables
+ (custom-sort-items
+ members
+ ;; Never sort the top-level custom group.
+ (unless (eq symbol 'emacs)
+ custom-buffer-sort-alphabetically)
+ custom-buffer-order-groups)))
(prefixes (widget-get widget :custom-prefixes))
(custom-prefix-list (custom-prefix-add symbol prefixes))
(have-subtitle (and (not (eq symbol 'emacs))
@@ -4639,8 +4720,9 @@ if only the first line of the docstring is shown."))
(let ((inhibit-read-only t)
(print-length nil)
(print-level nil))
- (custom-save-variables)
- (custom-save-faces))
+ (atomic-change-group
+ (custom-save-variables)
+ (custom-save-faces)))
(let ((file-precious-flag t))
(save-buffer))
(if old-buffer
@@ -4826,7 +4908,7 @@ This function does not save the buffer."
(let ((spec (car-safe (get symbol 'theme-face)))
(value (get symbol 'saved-face))
(now (not (or (get symbol 'face-defface-spec)
- (and (not (custom-facep symbol))
+ (and (not (facep symbol))
(not (get symbol 'force-face))))))
(comment (get symbol 'saved-face-comment)))
(when (or (and spec (eq (nth 0 spec) 'user))
@@ -4945,9 +5027,19 @@ The format is suitable for use with `easy-menu-define'."
(mapcar (lambda (arg)
(let ((tag (nth 0 arg))
(command (nth 1 arg))
- (active (nth 2 arg))
- (help (nth 3 arg)))
- (vector tag command :active (eval active) :help help)))
+ (visible (nth 2 arg))
+ (help (nth 3 arg))
+ (active (nth 6 arg)))
+ (vector tag command :visible (eval visible)
+ :active
+ `(or (eq t ',active)
+ (seq-some ,(lambda (widget)
+ (memq
+ (widget-get widget
+ :custom-state)
+ active))
+ custom-options))
+ :help help)))
custom-commands)))
(defvar tool-bar-map)
@@ -5044,7 +5136,6 @@ Erase customizations; set options
Entry to this mode calls the value of `Custom-mode-hook'
if that value is non-nil."
(use-local-map custom-mode-map)
- (easy-menu-add Custom-mode-menu)
(setq-local tool-bar-map
(or custom-tool-bar-map
;; Set up `custom-tool-bar-map'.
diff --git a/lisp/cus-face.el b/lisp/cus-face.el
index cc766aa4509..21fe89c6214 100644
--- a/lisp/cus-face.el
+++ b/lisp/cus-face.el
@@ -1,6 +1,6 @@
-;;; cus-face.el --- customization support for faces
+;;; cus-face.el --- customization support for faces -*- lexical-binding: t; -*-
;;
-;; Copyright (C) 1996-1997, 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1997, 1999-2021 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: help, faces
@@ -27,8 +27,6 @@
;;; Code:
-(defalias 'custom-facep 'facep)
-
;;; Declaring a face.
(defun custom-declare-face (face spec doc &rest args)
@@ -177,6 +175,7 @@
(choice :tag "Style"
(const :tag "Raised" released-button)
(const :tag "Sunken" pressed-button)
+ (const :tag "Flat" flat-button)
(const :tag "None" nil))))
;; filter to make value suitable for customize
(lambda (real-value)
@@ -394,6 +393,8 @@ Each of the arguments ARGS has this form:
This means reset FACE to its value in FROM-THEME."
(apply 'custom-theme-reset-faces 'user args))
+(define-obsolete-function-alias 'custom-facep #'facep "28.1")
+
;;; The End.
(provide 'cus-face)
diff --git a/lisp/cus-start.el b/lisp/cus-start.el
index 6927b6df6b8..27fdb723441 100644
--- a/lisp/cus-start.el
+++ b/lisp/cus-start.el
@@ -1,6 +1,6 @@
;;; cus-start.el --- define customization properties of builtins -*- lexical-binding:t -*-
-;; Copyright (C) 1997, 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1999-2021 Free Software Foundation, Inc.
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: internal
@@ -394,6 +394,11 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
;; (directory :format "%v"))))
(load-prefer-newer lisp boolean "24.4")
;; minibuf.c
+ (minibuffer-follows-selected-frame
+ minibuffer (choice (const :tag "Always" t)
+ (const :tag "When used" hybrid)
+ (const :tag "Never" nil))
+ "28.1")
(enable-recursive-minibuffers minibuffer boolean)
(history-length minibuffer
(choice (const :tag "Infinite" t) integer)
@@ -875,7 +880,7 @@ since it could result in memory overflow and make Emacs crash."
;; Don't re-add to custom-delayed-init-variables post-startup.
(unless after-init-time
;; Note this is the _only_ initialize property we handle.
- (if (eq (cadr (memq :initialize rest)) 'custom-initialize-delay)
+ (if (eq (cadr (memq :initialize rest)) #'custom-initialize-delay)
;; These vars are defined early and should hence be initialized
;; early, even if this file happens to be loaded late. so add them
;; to the end of custom-delayed-init-variables. Otherwise,
diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el
index dc463e05f92..a702fedd245 100644
--- a/lisp/cus-theme.el
+++ b/lisp/cus-theme.el
@@ -1,6 +1,6 @@
;;; cus-theme.el -- custom theme creation user interface -*- lexical-binding: t -*-
;;
-;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;;
;; Author: Alex Schroeder <alex@gnu.org>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/custom.el b/lisp/custom.el
index cee4589543e..5e354c4c595 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -1,6 +1,6 @@
;;; custom.el --- tools for declaring and initializing options -*- lexical-binding: t -*-
;;
-;; Copyright (C) 1996-1997, 1999, 2001-2020 Free Software Foundation,
+;; Copyright (C) 1996-1997, 1999, 2001-2021 Free Software Foundation,
;; Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
@@ -125,16 +125,9 @@ This is used in files that are preloaded (or for autoloaded
variables), so that the initialization is done in the run-time
context rather than the build-time context. This also has the
side-effect that the (delayed) initialization is performed with
-the :set function.
-
-For variables in preloaded files, you can simply use this
-function for the :initialize property. For autoloaded variables,
-you will also need to add an autoload stanza calling this
-function, and another one setting the standard-value property.
-Or you can wrap the defcustom in a progn, to force the autoloader
-to include all of it." ; see eg vc-sccs-search-project-dir
- ;; No longer true:
- ;; "See `send-mail-function' in sendmail.el for an example."
+the :set function."
+ ;; Defvar it so as to mark it special, etc (bug#25770).
+ (internal--define-uninitialized-variable symbol)
;; Until the var is actually initialized, it is kept unbound.
;; This seemed to be at least as good as setting it to an arbitrary
@@ -157,9 +150,13 @@ set to nil, as the value is no longer rogue."
(if (keywordp doc)
(error "Doc string is missing"))
(let ((initialize #'custom-initialize-reset)
- (requests nil))
+ (requests nil)
+ ;; Whether automatically buffer-local.
+ buffer-local)
(unless (memq :group args)
- (custom-add-to-group (custom-current-group) symbol 'custom-variable))
+ (let ((cg (custom-current-group)))
+ (when cg
+ (custom-add-to-group cg symbol 'custom-variable))))
(while args
(let ((keyword (pop args)))
(unless (symbolp keyword)
@@ -183,7 +180,7 @@ set to nil, as the value is no longer rogue."
(put symbol 'safe-local-variable value))
((eq keyword :local)
(when (memq value '(t permanent))
- (make-variable-buffer-local symbol))
+ (setq buffer-local t))
(when (eq value 'permanent)
(put symbol 'permanent-local t)))
((eq keyword :type)
@@ -205,7 +202,9 @@ set to nil, as the value is no longer rogue."
(put symbol 'custom-requests requests)
;; Do the actual initialization.
(unless custom-dont-initialize
- (funcall initialize symbol default)))
+ (funcall initialize symbol default))
+ (when buffer-local
+ (make-variable-buffer-local symbol)))
(run-hooks 'custom-define-hook)
symbol)
@@ -231,6 +230,8 @@ The following keywords are meaningful:
:type VALUE should be a widget type for editing the symbol's value.
Every `defcustom' should specify a value for this keyword.
+ See Info node `(elisp) Customization Types' for a list of
+ base types and useful composite types.
:options VALUE should be a list of valid members of the widget type.
:initialize
VALUE should be a function used to initialize the
@@ -521,7 +522,9 @@ If no such group is found, return nil."
"For customization option SYMBOL, handle keyword arguments ARGS.
Third argument TYPE is the custom option type."
(unless (memq :group args)
- (custom-add-to-group (custom-current-group) symbol type))
+ (let ((cg (custom-current-group)))
+ (when cg
+ (custom-add-to-group cg symbol type))))
(while args
(let ((arg (car args)))
(setq args (cdr args))
@@ -770,8 +773,7 @@ Return non-nil if the `customized-value' property actually changed."
Use the :set function to do so. This is useful for customizable options
that are defined before their standard value can really be computed.
E.g. dumped variables whose default depends on run-time information."
- ;; If it has never been set at all, defvar it so as to mark it
- ;; special, etc (bug#25770). This means we are initializing
+ ;; We are initializing
;; the variable, and normally any :set function would not apply.
;; For custom-initialize-delay, however, it is documented that "the
;; (delayed) initialization is performed with the :set function".
@@ -779,11 +781,10 @@ E.g. dumped variables whose default depends on run-time information."
;; custom-initialize-delay but needs the :set function custom-set-minor-mode
;; to also run during initialization. So, long story short, we
;; always do the funcall step, even if symbol was not bound before.
- (or (default-boundp symbol)
- (eval `(defvar ,symbol nil))) ; reset below, so any value is fine
(funcall (or (get symbol 'custom-set) #'set-default)
symbol
- (eval (car (or (get symbol 'saved-value) (get symbol 'standard-value))))))
+ (eval (car (or (get symbol 'saved-value)
+ (get symbol 'standard-value))))))
;;; Custom Themes
@@ -1385,8 +1386,30 @@ function runs. To disable other themes, use `disable-theme'."
;; Loop through theme settings, recalculating vars/faces.
(dolist (s settings)
(let* ((prop (car s))
- (symbol (cadr s)))
- (custom-push-theme prop symbol theme 'set (nth 3 s))
+ (symbol (cadr s))
+ (spec-list (get symbol prop))
+ (sv (get symbol 'standard-value))
+ (val (and (boundp symbol) (symbol-value symbol))))
+ ;; We can't call `custom-push-theme' when enabling the theme: it's not
+ ;; that the theme settings have changed, it's just that we want to
+ ;; enable those settings. But we might need to save a user setting
+ ;; outside of Customize, in order to get back to it when disabling
+ ;; the theme, just like in `custom-push-theme'.
+ (when (and (custom--should-apply-setting theme)
+ ;; Only do it for variables; for faces, using
+ ;; `face-new-frame-defaults' is enough.
+ (eq prop 'theme-value)
+ (boundp symbol)
+ (not (or spec-list
+ ;; Only if the current value is different from
+ ;; the standard value.
+ (and sv (equal (eval (car sv)) val))
+ ;; And only if the changed value is different
+ ;; from the new value under the user theme.
+ (and (eq theme 'user)
+ (equal (custom-quote val) (nth 3 s))))))
+ (setq spec-list `((changed ,(custom-quote val)))))
+ (put symbol prop (cons (cddr s) (assq-delete-all theme spec-list)))
(cond
((eq prop 'theme-face)
(custom-theme-recalc-face symbol))
diff --git a/lisp/dabbrev.el b/lisp/dabbrev.el
index a9df0314215..e113cc94c33 100644
--- a/lisp/dabbrev.el
+++ b/lisp/dabbrev.el
@@ -1,6 +1,6 @@
;;; dabbrev.el --- dynamic abbreviation package -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1986, 1992, 1994, 1996-1997, 2000-2020 Free
+;; Copyright (C) 1985-1986, 1992, 1994, 1996-1997, 2000-2021 Free
;; Software Foundation, Inc.
;; Author: Don Morrison
@@ -45,7 +45,7 @@
;; dabbrev-case-replace nil t
;;
;; Set the variables you want special for your mode like this:
-;; (set (make-local-variable 'dabbrev-case-replace) nil)
+;; (setq-local dabbrev-case-replace nil)
;; Then you don't interfere with other modes.
;;
;; If your mode handles buffers that refers to other buffers
@@ -59,10 +59,10 @@
;; Example for GNUS (when we write a reply, we want dabbrev to look in
;; the article for expansion):
-;; (set (make-local-variable 'dabbrev-friend-buffer-function)
-;; (lambda (buffer)
-;; (with-current-buffer buffer
-;; (memq major-mode '(news-reply-mode gnus-article-mode)))))
+;; (setq-local dabbrev-friend-buffer-function
+;; (lambda (buffer)
+;; (with-current-buffer buffer
+;; (memq major-mode '(news-reply-mode gnus-article-mode)))))
;; Known bugs and limitations.
diff --git a/lisp/delim-col.el b/lisp/delim-col.el
index 1d4358d7385..cd945d8de45 100644
--- a/lisp/delim-col.el
+++ b/lisp/delim-col.el
@@ -1,6 +1,6 @@
;;; delim-col.el --- prettify all columns in a region or rectangle -*- lexical-binding: t; -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Old-Version: 2.1
diff --git a/lisp/delsel.el b/lisp/delsel.el
index df2adc7aeba..982320340d8 100644
--- a/lisp/delsel.el
+++ b/lisp/delsel.el
@@ -1,6 +1,6 @@
;;; delsel.el --- delete selection if you insert -*- lexical-binding:t -*-
-;; Copyright (C) 1992, 1997-1998, 2001-2020 Free Software Foundation,
+;; Copyright (C) 1992, 1997-1998, 2001-2021 Free Software Foundation,
;; Inc.
;; Author: Matthieu Devin <devin@lucid.com>
@@ -274,6 +274,8 @@ to `delete-selection-mode'."
(put 'quoted-insert 'delete-selection t)
(put 'yank 'delete-selection 'yank)
+(put 'yank-pop 'delete-selection 'yank)
+(put 'yank-from-kill-ring 'delete-selection 'yank)
(put 'clipboard-yank 'delete-selection 'yank)
(put 'insert-register 'delete-selection t)
;; delete-backward-char and delete-forward-char already delete the selection by
diff --git a/lisp/descr-text.el b/lisp/descr-text.el
index ec9a9680137..85017de5d5e 100644
--- a/lisp/descr-text.el
+++ b/lisp/descr-text.el
@@ -1,6 +1,6 @@
;;; descr-text.el --- describe text mode -*- lexical-binding:t -*-
-;; Copyright (C) 1994-1996, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1996, 2001-2021 Free Software Foundation, Inc.
;; Author: Boris Goldowsky <boris@gnu.org>
;; Maintainer: emacs-devel@gnu.org
@@ -54,10 +54,12 @@
(<= (length pp) (- (window-width) (current-column))))
(insert pp)
(insert-text-button
- "[Show]" 'action (lambda (&rest _ignore)
- (with-output-to-temp-buffer
- "*Pp Eval Output*"
- (princ pp)))
+ "[Show]"
+ 'follow-link t
+ 'action (lambda (&rest _ignore)
+ (with-output-to-temp-buffer
+ "*Pp Eval Output*"
+ (princ pp)))
'help-echo "mouse-2, RET: pretty print value in another buffer"))))
(defun describe-property-list (properties)
@@ -687,7 +689,8 @@ The character information includes:
(save-excursion (goto-char pos)
(looking-at-p "[ \t]+$")))
'trailing-whitespace)
- ((and nobreak-char-display char (eq char '#xa0))
+ ((and nobreak-char-display char
+ (eq (get-char-code-property char 'general-category) 'Zs))
'nobreak-space)
((and nobreak-char-display char
(memq char '(#xad #x2010 #x2011)))
diff --git a/lisp/desktop.el b/lisp/desktop.el
index 7a7f1d07c93..fb7c6c79a1a 100644
--- a/lisp/desktop.el
+++ b/lisp/desktop.el
@@ -1,6 +1,6 @@
;;; desktop.el --- save partial status of Emacs when killed -*- lexical-binding: t -*-
-;; Copyright (C) 1993-1995, 1997, 2000-2020 Free Software Foundation,
+;; Copyright (C) 1993-1995, 1997, 2000-2021 Free Software Foundation,
;; Inc.
;; Author: Morten Welinder <terra@diku.dk>
@@ -1222,7 +1222,13 @@ This function is a no-op when Emacs is running in batch mode.
It returns t if a desktop file was loaded, nil otherwise.
\n(fn DIRNAME)"
(interactive "i\nP")
- (unless noninteractive
+ (if (or noninteractive
+ (and (desktop-owner)
+ (= (desktop-owner) (emacs-pid))))
+ (message "Not reloading the desktop%s"
+ (if noninteractive
+ ""
+ "; already loaded"))
(setq desktop-dirname
(file-name-as-directory
(expand-file-name
diff --git a/lisp/dframe.el b/lisp/dframe.el
index efe2bc57d93..09d2fe40794 100644
--- a/lisp/dframe.el
+++ b/lisp/dframe.el
@@ -1,6 +1,6 @@
;;; dframe --- dedicate frame support modes -*- lexical-binding:t -*-
-;; Copyright (C) 1996-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: file, tags, tools
@@ -280,17 +280,18 @@ CREATE-HOOK is a hook to run after creating a frame."
;; Enable mouse tracking in emacs
(if dframe-track-mouse-function
- (set (make-local-variable 'track-mouse) t)) ;this could be messy.
+ (setq-local track-mouse t)) ;this could be messy.
;; Override `temp-buffer-show-hook' so that help and such
;; put their stuff into a frame other than our own.
;; Correct use of `temp-buffer-show-function': Bob Weiner
(if (and (boundp 'temp-buffer-show-hook)
(boundp 'temp-buffer-show-function))
- (progn (make-local-variable 'temp-buffer-show-hook)
- (setq temp-buffer-show-hook temp-buffer-show-function)))
- (make-local-variable 'temp-buffer-show-function)
- (setq temp-buffer-show-function 'dframe-temp-buffer-show-function)
+ ;; FIXME: Doesn't this get us into an inf-loop when the
+ ;; `temp-buffer-show-function' runs `temp-buffer-show-hook'
+ ;; (as is normally the case)?
+ (setq-local temp-buffer-show-hook temp-buffer-show-function))
+ (setq-local temp-buffer-show-function 'dframe-temp-buffer-show-function)
;; If this buffer is killed, we must make sure that we destroy
;; the frame the dedicated window is in.
(add-hook 'kill-buffer-hook (lambda ()
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 6034d12f323..5a96742fda9 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -1,6 +1,6 @@
;;; dired-aux.el --- less commonly used parts of dired -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1986, 1992, 1994, 1998, 2000-2020 Free Software
+;; Copyright (C) 1985-1986, 1992, 1994, 1998, 2000-2021 Free Software
;; Foundation, Inc.
;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>.
@@ -145,7 +145,7 @@ substituted, and will be passed through normally to the shell.
(defun dired--no-subst-ask (char nb-occur details)
(let ((hilit-char (propertize (string char) 'face 'warning))
(choices `(?y ?n ?? ,@(when details '(?^)))))
- (read-char-from-minibuffer
+ (read-char-choice
(format-message
(ngettext
"%d occurrence of `%s' will not be substituted. Proceed? (%s) "
@@ -259,7 +259,7 @@ the string of command switches used as the third argument of `diff'."
(list
(minibuffer-with-setup-hook
(lambda ()
- (set (make-local-variable 'minibuffer-default-add-function) nil)
+ (setq-local minibuffer-default-add-function nil)
(setq minibuffer-default defaults))
(read-file-name (format-prompt "Diff %s with" default current)
target-dir default t))
@@ -334,7 +334,7 @@ only in the active region if `dired-mark-region' is non-nil."
(defaults (dired-dwim-target-defaults nil target-dir)))
(minibuffer-with-setup-hook
(lambda ()
- (set (make-local-variable 'minibuffer-default-add-function) nil)
+ (setq-local minibuffer-default-add-function nil)
(setq minibuffer-default defaults))
(read-directory-name (format "Compare %s with: "
(dired-current-directory))
@@ -2049,7 +2049,7 @@ Optional arg HOW-TO determines how to treat the target.
(target (expand-file-name ; fluid variable inside dired-create-files
(minibuffer-with-setup-hook
(lambda ()
- (set (make-local-variable 'minibuffer-default-add-function) nil)
+ (setq-local minibuffer-default-add-function nil)
(setq minibuffer-default defaults))
(dired-mark-read-file-name
(format "%s %%s %s: "
@@ -3013,14 +3013,14 @@ is part of a file name (i.e., has the text property `dired-filename')."
(defun dired-isearch-filenames ()
"Search for a string using Isearch only in file names in the Dired buffer."
(interactive)
- (set (make-local-variable 'dired-isearch-filenames) t)
+ (setq-local dired-isearch-filenames t)
(isearch-forward nil t))
;;;###autoload
(defun dired-isearch-filenames-regexp ()
"Search for a regexp using Isearch only in file names in the Dired buffer."
(interactive)
- (set (make-local-variable 'dired-isearch-filenames) t)
+ (setq-local dired-isearch-filenames t)
(isearch-forward-regexp nil t))
@@ -3140,7 +3140,13 @@ REGEXP should use constructs supported by your local `grep' command."
(query-replace-read-args
"Query replace regexp in marked files" t t)))
(list (nth 0 common) (nth 1 common))))
- (with-current-buffer (dired-do-find-regexp from)
+ (require 'xref)
+ (defvar xref-show-xrefs-function)
+ (with-current-buffer
+ (let ((xref-show-xrefs-function
+ ;; Some future-proofing (bug#44905).
+ (eval (car (get 'xref-show-xrefs-function 'standard-value)))))
+ (dired-do-find-regexp from))
(xref-query-replace-in-results from to)))
(defun dired-nondirectory-p (file)
diff --git a/lisp/dired-x.el b/lisp/dired-x.el
index 55077e71882..5a52eccbbe3 100644
--- a/lisp/dired-x.el
+++ b/lisp/dired-x.el
@@ -1,6 +1,6 @@
;;; dired-x.el --- extra Dired functionality -*- lexical-binding:t -*-
-;; Copyright (C) 1993-1994, 1997, 2001-2020 Free Software Foundation,
+;; Copyright (C) 1993-1994, 1997, 2001-2021 Free Software Foundation,
;; Inc.
;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>
@@ -636,7 +636,7 @@ you can relist single subdirs using \\[dired-do-redisplay]."
(dired-mode dirname (or switches dired-listing-switches))
(setq mode-name "Virtual Dired"
revert-buffer-function 'dired-virtual-revert)
- (set (make-local-variable 'dired-subdir-alist) nil)
+ (setq-local dired-subdir-alist nil)
(dired-build-subdir-alist)
(goto-char (point-min))
(dired-initial-position dirname))
@@ -1226,7 +1226,7 @@ Otherwise obeys the value of `dired-vm-read-only-folders'."
(and dired-vm-read-only-folders
(not (file-writable-p fil)))))
;; So that pressing `v' inside VM does prompt within current directory:
- (set (make-local-variable 'vm-folder-directory) dir)))
+ (setq-local vm-folder-directory dir)))
(defun dired-rmail ()
"Run RMAIL on this file."
diff --git a/lisp/dired.el b/lisp/dired.el
index 08b19a02250..3f119363314 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -1,6 +1,6 @@
;;; dired.el --- directory-browsing commands -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1986, 1992-1997, 2000-2020 Free Software
+;; Copyright (C) 1985-1986, 1992-1997, 2000-2021 Free Software
;; Foundation, Inc.
;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>
@@ -1509,8 +1509,7 @@ see `dired-use-ls-dired' for more details.")
(script (format "ls %s %s" switches (cdr dir-wildcard)))
(remotep (file-remote-p dir))
(sh (or (and remotep "/bin/sh")
- (and (bound-and-true-p explicit-shell-file-name)
- (executable-find explicit-shell-file-name))
+ (executable-find shell-file-name)
(executable-find "sh")))
(switch (if remotep "-c" shell-command-switch)))
;; Enable globstar
@@ -2420,6 +2419,10 @@ If the current buffer can be edited with Wdired, (i.e. the major
mode is `dired-mode'), call `wdired-change-to-wdired-mode'.
Otherwise, toggle `read-only-mode'."
(interactive)
+ (when (and (not (file-writable-p default-directory))
+ (not (y-or-n-p
+ "Directory isn't writable; edit anyway? ")))
+ (user-error "Directory %s isn't writable" default-directory))
(if (derived-mode-p 'dired-mode)
(wdired-change-to-wdired-mode)
(read-only-mode 'toggle)))
@@ -2500,6 +2503,10 @@ directory in another window."
(defun dired-find-file ()
"In Dired, visit the file or directory named on this line."
(interactive)
+ (dired--find-file #'find-file (dired-get-file-for-visit)))
+
+(defun dired--find-file (find-file-function file)
+ "Call FIND-FILE-FUNCTION on FILE, but bind some relevant variables."
;; Bind `find-file-run-dired' so that the command works on directories
;; too, independent of the user's setting.
(let ((find-file-run-dired t)
@@ -2512,7 +2519,7 @@ directory in another window."
(if dired-auto-revert-buffer
nil
switch-to-buffer-preserve-window-point)))
- (find-file (dired-get-file-for-visit))))
+ (funcall find-file-function file)))
(defun dired-find-alternate-file ()
"In Dired, visit file or directory on current line via `find-alternate-file'.
@@ -2548,7 +2555,7 @@ respectively."
(select-window window)
(funcall find-dir-func file)))
(select-window window)
- (funcall find-file-func (file-name-sans-versions file t)))))
+ (dired--find-file find-file-func (file-name-sans-versions file t)))))
(defun dired-mouse-find-file-other-window (event)
"In Dired, visit the file or directory name you click on in another window."
@@ -2575,7 +2582,7 @@ Otherwise, display it in another buffer."
(defun dired-find-file-other-window ()
"In Dired, visit this file or directory in another window."
(interactive)
- (find-file-other-window (dired-get-file-for-visit)))
+ (dired--find-file #'find-file-other-window (dired-get-file-for-visit)))
(defun dired-display-file ()
"In Dired, display this file or directory in another window."
diff --git a/lisp/dirtrack.el b/lisp/dirtrack.el
index ad0c18d1b38..795f1dd6602 100644
--- a/lisp/dirtrack.el
+++ b/lisp/dirtrack.el
@@ -1,6 +1,6 @@
;;; dirtrack.el --- Directory Tracking by watching the prompt
-;; Copyright (C) 1996, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 2001-2021 Free Software Foundation, Inc.
;; Author: Peter Breton <pbreton@cs.umb.edu>
;; Created: Sun Nov 17 1996
diff --git a/lisp/disp-table.el b/lisp/disp-table.el
index 2e88d350245..a7fc8f0a76e 100644
--- a/lisp/disp-table.el
+++ b/lisp/disp-table.el
@@ -1,6 +1,6 @@
-;;; disp-table.el --- functions for dealing with char tables
+;;; disp-table.el --- functions for dealing with char tables -*- lexical-binding: t; -*-
-;; Copyright (C) 1987, 1994-1995, 1999, 2001-2020 Free Software
+;; Copyright (C) 1987, 1994-1995, 1999, 2001-2021 Free Software
;; Foundation, Inc.
;; Author: Erik Naggum <erik@naggum.no>
@@ -220,8 +220,6 @@ for a graphical frame."
;;;###autoload
(defun make-glyph-code (char &optional face)
"Return a glyph code representing char CHAR with face FACE."
- ;; Due to limitations on Emacs integer values, faces with
- ;; face id greater than 512 are silently ignored.
(if (not face)
char
(let ((fid (face-id face)))
diff --git a/lisp/display-fill-column-indicator.el b/lisp/display-fill-column-indicator.el
index 5fd9f07cd46..50252af4533 100644
--- a/lisp/display-fill-column-indicator.el
+++ b/lisp/display-fill-column-indicator.el
@@ -1,6 +1,6 @@
;;; display-fill-column-indicator.el --- interface for display-fill-column-indicator -*- lexical-binding: t -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: convenience
diff --git a/lisp/display-line-numbers.el b/lisp/display-line-numbers.el
index 022ed12046c..a6fa813afe7 100644
--- a/lisp/display-line-numbers.el
+++ b/lisp/display-line-numbers.el
@@ -1,6 +1,6 @@
;;; display-line-numbers.el --- interface for display-line-numbers -*- lexical-binding: t -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: convenience
diff --git a/lisp/dnd.el b/lisp/dnd.el
index 815a4afbecd..7319a27d190 100644
--- a/lisp/dnd.el
+++ b/lisp/dnd.el
@@ -1,6 +1,6 @@
;;; dnd.el --- drag and drop support -*- lexical-binding: t; -*-
-;; Copyright (C) 2005-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2005-2021 Free Software Foundation, Inc.
;; Author: Jan Djärv <jan.h.d@swipnet.se>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/doc-view.el b/lisp/doc-view.el
index 02d89650b8b..f6fcfae453e 100644
--- a/lisp/doc-view.el
+++ b/lisp/doc-view.el
@@ -1,6 +1,6 @@
-;;; doc-view.el --- View PDF/PostScript/DVI files in Emacs -*- lexical-binding: t -*-
+;;; doc-view.el --- Document viewer for Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;;
;; Author: Tassilo Horn <tsdh@gnu.org>
;; Keywords: files, pdf, ps, dvi
@@ -22,17 +22,20 @@
;;; Requirements:
-;; doc-view.el requires GNU Emacs 22.1 or newer. You also need Ghostscript,
-;; `dvipdf' (comes with Ghostscript) or `dvipdfm' (comes with teTeX or TeXLive)
-;; and `pdftotext', which comes with xpdf (https://www.foolabs.com/xpdf/) or
-;; poppler (https://poppler.freedesktop.org/).
+;; Viewing PS/PDF/DVI files requires Ghostscript, `dvipdf' (comes with
+;; Ghostscript) or `dvipdfm' (comes with teTeX or TeXLive) and
+;; `pdftotext', which comes with xpdf (https://www.foolabs.com/xpdf/)
+;; or poppler (https://poppler.freedesktop.org/).
+;; Djvu documents require `ddjvu' (from DjVuLibre).
+;; ODF files require `soffice' (from LibreOffice).
;;; Commentary:
-;; DocView is a document viewer for Emacs. It converts PDF, PS and DVI files
-;; to a set of PNG files, one PNG for each page, and displays the PNG images
-;; inside an Emacs buffer. This buffer uses `doc-view-mode' which provides
-;; convenient key bindings for browsing the document.
+;; DocView is a document viewer for Emacs. It converts a number of
+;; document formats (including PDF, PS, DVI, Djvu and ODF files) to a
+;; set of PNG files, one PNG for each page, and displays the PNG
+;; images inside an Emacs buffer. This buffer uses `doc-view-mode'
+;; which provides convenient key bindings for browsing the document.
;;
;; To use it simply open a document file with
;;
@@ -429,6 +432,7 @@ Typically \"page-%s.png\".")
(define-key map "P" 'doc-view-fit-page-to-window)
(define-key map "F" 'doc-view-fit-window-to-page) ;F = frame
;; Killing the buffer (and the process)
+ (define-key map (kbd "k") 'image-kill-buffer)
(define-key map (kbd "K") 'doc-view-kill-proc)
;; Slicing the image
(define-key map (kbd "c s") 'doc-view-set-slice)
@@ -2052,7 +2056,7 @@ See the command `doc-view-mode' for more information on this mode."
:init-value nil :keymap doc-view-presentation-mode-map
(if doc-view-presentation-mode
(progn
- (set (make-local-variable 'mode-line-format) nil)
+ (setq-local mode-line-format nil)
(doc-view-fit-page-to-window)
;; (doc-view-convert-all-pages)
)
diff --git a/lisp/dom.el b/lisp/dom.el
index bf4a56ab9f5..71793c0d673 100644
--- a/lisp/dom.el
+++ b/lisp/dom.el
@@ -1,6 +1,6 @@
;;; dom.el --- XML/HTML (etc.) DOM manipulation and searching functions -*- lexical-binding: t -*-
-;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: xml, html
diff --git a/lisp/dos-fns.el b/lisp/dos-fns.el
index d96599d3f76..255edd0f371 100644
--- a/lisp/dos-fns.el
+++ b/lisp/dos-fns.el
@@ -1,6 +1,6 @@
-;;; dos-fns.el --- MS-Dos specific functions
+;;; dos-fns.el --- MS-Dos specific functions -*- lexical-binding: t; -*-
-;; Copyright (C) 1991, 1993, 1995-1996, 2001-2020 Free Software
+;; Copyright (C) 1991, 1993, 1995-1996, 2001-2021 Free Software
;; Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/dos-vars.el b/lisp/dos-vars.el
index 47d1f83de9e..2f7b3760e3f 100644
--- a/lisp/dos-vars.el
+++ b/lisp/dos-vars.el
@@ -1,6 +1,6 @@
;;; dos-vars.el --- MS-Dos specific user options -*- lexical-binding:t -*-
-;; Copyright (C) 1998, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2001-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
diff --git a/lisp/dos-w32.el b/lisp/dos-w32.el
index 8c2cad696b1..cf753214624 100644
--- a/lisp/dos-w32.el
+++ b/lisp/dos-w32.el
@@ -1,6 +1,6 @@
-;; dos-w32.el --- Functions shared among MS-DOS and W32 (NT/95) platforms
+;; dos-w32.el --- Functions shared among MS-DOS and W32 (NT/95) platforms -*- lexical-binding: t; -*-
-;; Copyright (C) 1996, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 2001-2021 Free Software Foundation, Inc.
;; Maintainer: Geoff Voelker <voelker@cs.washington.edu>
;; Keywords: internal
@@ -154,13 +154,15 @@ when writing the file."
;; FIXME: Can't we use find-file-literally for the same purposes?
(interactive "FFind file binary: ")
(let ((coding-system-for-read 'no-conversion)) ;; FIXME: undecided-unix?
- (find-file filename)))
+ (with-suppressed-warnings ((interactive-only find-file))
+ (find-file filename))))
(defun find-file-text (filename)
"Visit file FILENAME and treat it as a text file."
(interactive "FFind file text: ")
(let ((coding-system-for-read 'undecided-dos))
- (find-file filename)))
+ (with-suppressed-warnings ((interactive-only find-file))
+ (find-file filename))))
(defun w32-find-file-not-found-set-buffer-file-coding-system ()
(with-current-buffer (current-buffer)
@@ -261,6 +263,8 @@ filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"."
:group 'dos-fns
:group 'w32)
+(defvar w32-quote-process-args)
+
;; Function to actually send data to the printer port.
;; Supports writing directly, and using various programs.
(defun w32-direct-print-region-helper (printer
diff --git a/lisp/double.el b/lisp/double.el
index 8e5090034cf..8bbbaa58189 100644
--- a/lisp/double.el
+++ b/lisp/double.el
@@ -1,6 +1,6 @@
;;; double.el --- support for keyboard remapping with double clicking
-;; Copyright (C) 1994, 1997-1998, 2001-2020 Free Software Foundation,
+;; Copyright (C) 1994, 1997-1998, 2001-2021 Free Software Foundation,
;; Inc.
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
diff --git a/lisp/dynamic-setting.el b/lisp/dynamic-setting.el
index ce7e9fc7b1d..d6952ed59f3 100644
--- a/lisp/dynamic-setting.el
+++ b/lisp/dynamic-setting.el
@@ -1,6 +1,6 @@
;;; dynamic-setting.el --- Support dynamic changes
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Jan Djärv <jan.h.d@swipnet.se>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/ebuff-menu.el b/lisp/ebuff-menu.el
index 079fce88def..fb73b2d1786 100644
--- a/lisp/ebuff-menu.el
+++ b/lisp/ebuff-menu.el
@@ -1,6 +1,6 @@
;;; ebuff-menu.el --- electric-buffer-list mode
-;; Copyright (C) 1985-1986, 1994, 2001-2020 Free Software Foundation,
+;; Copyright (C) 1985-1986, 1994, 2001-2021 Free Software Foundation,
;; Inc.
;; Author: Richard Mlynarik <mly@ai.mit.edu>
@@ -202,8 +202,7 @@ Electric Buffer Menu mode is a minor mode which is automatically
enabled and disabled by the \\[electric-buffer-list] command.
See the documentation of `electric-buffer-list' for details."
(setq mode-line-buffer-identification "Electric Buffer List")
- (set (make-local-variable 'Helper-return-blurb)
- "return to buffer editing"))
+ (setq-local Helper-return-blurb "return to buffer editing"))
(define-obsolete-function-alias 'Electric-buffer-menu-mode
'electric-buffer-menu-mode "24.3")
@@ -270,8 +269,8 @@ Return to Electric Buffer Menu when done."
(when (derived-mode-p 'electric-buffer-menu-mode)
;; Make sure we have an overlay to use.
(or electric-buffer-overlay
- (set (make-local-variable 'electric-buffer-overlay)
- (make-overlay (point) (point))))
+ (setq-local electric-buffer-overlay
+ (make-overlay (point) (point))))
(move-overlay electric-buffer-overlay
(line-beginning-position)
(line-end-position))
diff --git a/lisp/echistory.el b/lisp/echistory.el
index e311ee101b4..8f787e7fa1c 100644
--- a/lisp/echistory.el
+++ b/lisp/echistory.el
@@ -1,6 +1,6 @@
;;; echistory.el --- Electric Command History Mode
-;; Copyright (C) 1985, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 2001-2021 Free Software Foundation, Inc.
;; Author: K. Shane Hartman
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/ecomplete.el b/lisp/ecomplete.el
index 831491cba2e..105edc48a07 100644
--- a/lisp/ecomplete.el
+++ b/lisp/ecomplete.el
@@ -1,6 +1,6 @@
;;; ecomplete.el --- electric completion of addresses and the like -*- lexical-binding:t -*-
-;; Copyright (C) 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: mail
diff --git a/lisp/edmacro.el b/lisp/edmacro.el
index 1d9b4726b04..3d7db44a86d 100644
--- a/lisp/edmacro.el
+++ b/lisp/edmacro.el
@@ -1,6 +1,6 @@
;;; edmacro.el --- keyboard macro editor
-;; Copyright (C) 1993-1994, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2001-2021 Free Software Foundation, Inc.
;; Author: Dave Gillespie <daveg@synaptics.com>
;; Keywords: abbrev
@@ -151,9 +151,9 @@ With a prefix argument, format the macro in a more concise way."
(setq buffer-read-only nil)
(setq major-mode 'edmacro-mode)
(setq mode-name "Edit Macro")
- (set (make-local-variable 'edmacro-original-buffer) oldbuf)
- (set (make-local-variable 'edmacro-finish-hook) finish-hook)
- (set (make-local-variable 'edmacro-store-hook) store-hook)
+ (setq-local edmacro-original-buffer oldbuf)
+ (setq-local edmacro-finish-hook finish-hook)
+ (setq-local edmacro-store-hook store-hook)
(erase-buffer)
(insert ";; Keyboard Macro Editor. Press C-c C-c to finish; "
"press C-x k RET to cancel.\n")
@@ -535,32 +535,31 @@ doubt, use whitespace."
(setq bind-len (1+ text)))
(t
(setq desc (mapconcat
- (function
- (lambda (ch)
- (cond
- ((integerp ch)
- (concat
- (cl-loop for pf across "ACHMsS"
- for bit in '(?\A-\^@ ?\C-\^@ ?\H-\^@
- ?\M-\^@ ?\s-\^@ ?\S-\^@)
- when (/= (logand ch bit) 0)
- concat (format "%c-" pf))
- (let ((ch2 (logand ch (1- (ash 1 18)))))
- (cond ((<= ch2 32)
- (pcase ch2
- (0 "NUL") (9 "TAB") (10 "LFD")
- (13 "RET") (27 "ESC") (32 "SPC")
- (_
- (format "C-%c"
- (+ (if (<= ch2 26) 96 64)
- ch2)))))
- ((= ch2 127) "DEL")
- ((<= ch2 maxkey) (char-to-string ch2))
- (t (format "\\%o" ch2))))))
- ((symbolp ch)
- (format "<%s>" ch))
- (t
- (error "Unrecognized item in macro: %s" ch)))))
+ (lambda (ch)
+ (cond
+ ((integerp ch)
+ (concat
+ (cl-loop for pf across "ACHMsS"
+ for bit in '(?\A-\^@ ?\C-\^@ ?\H-\^@
+ ?\M-\^@ ?\s-\^@ ?\S-\^@)
+ when (/= (logand ch bit) 0)
+ concat (format "%c-" pf))
+ (let ((ch2 (logand ch (1- (ash 1 18)))))
+ (cond ((<= ch2 32)
+ (pcase ch2
+ (0 "NUL") (9 "TAB") (10 "LFD")
+ (13 "RET") (27 "ESC") (32 "SPC")
+ (_
+ (format "C-%c"
+ (+ (if (<= ch2 26) 96 64)
+ ch2)))))
+ ((= ch2 127) "DEL")
+ ((<= ch2 maxkey) (char-to-string ch2))
+ (t (format "\\%o" ch2))))))
+ ((symbolp ch)
+ (format "<%s>" ch))
+ (t
+ (error "Unrecognized item in macro: %s" ch))))
(or fkey key) " "))))
(if prefix
(setq desc (concat (edmacro-sanitize-for-string prefix) desc)))
diff --git a/lisp/ehelp.el b/lisp/ehelp.el
index 81373202c51..996b7db48f5 100644
--- a/lisp/ehelp.el
+++ b/lisp/ehelp.el
@@ -1,6 +1,6 @@
;;; ehelp.el --- bindings for electric-help mode -*- lexical-binding: t -*-
-;; Copyright (C) 1986, 1995, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1986, 1995, 2000-2021 Free Software Foundation, Inc.
;; Author: Richard Mlynarik
;; (according to ack.texi and authors.el)
@@ -31,7 +31,6 @@
;; buffer.
;; To make this the default, you must do
-;; (require 'ehelp)
;; (define-key global-map "\C-h" 'ehelp-command)
;; (define-key global-map [help] 'ehelp-command)
;; (define-key global-map [f1] 'ehelp-command)
diff --git a/lisp/elec-pair.el b/lisp/elec-pair.el
index 6c47bea4a7a..d8c377a2ef5 100644
--- a/lisp/elec-pair.el
+++ b/lisp/elec-pair.el
@@ -1,6 +1,6 @@
;;; elec-pair.el --- Automatic parenthesis pairing -*- lexical-binding:t -*-
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; Author: João Távora <joaotavora@gmail.com>
diff --git a/lisp/electric.el b/lisp/electric.el
index 50ddf525ca4..6701a36d8bb 100644
--- a/lisp/electric.el
+++ b/lisp/electric.el
@@ -1,6 +1,6 @@
-;;; electric.el --- window maker and Command loop for `electric' modes
+;;; electric.el --- window maker and Command loop for `electric' modes -*- lexical-binding: t; -*-
-;; Copyright (C) 1985-1986, 1995, 2001-2020 Free Software Foundation,
+;; Copyright (C) 1985-1986, 1995, 2001-2021 Free Software Foundation,
;; Inc.
;; Author: K. Shane Hartman
@@ -385,6 +385,8 @@ If multiple rules match, only first one is executed.")
(when electric-layout-mode
(electric-layout-post-self-insert-function-1)))
+(defvar electric-pair-open-newline-between-pairs)
+
;; for edebug's sake, a separate function
(defun electric-layout-post-self-insert-function-1 ()
(let* ((pos (electric--after-char-pos))
diff --git a/lisp/elide-head.el b/lisp/elide-head.el
index a892754d723..c0857e3938a 100644
--- a/lisp/elide-head.el
+++ b/lisp/elide-head.el
@@ -1,6 +1,6 @@
;;; elide-head.el --- hide headers in files -*- lexical-binding: t; -*-
-;; Copyright (C) 1999, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2001-2021 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: outlines tools
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
index 0ebd2741d2e..b9a3a32a9b6 100644
--- a/lisp/emacs-lisp/advice.el
+++ b/lisp/emacs-lisp/advice.el
@@ -1,6 +1,6 @@
;;; advice.el --- An overloading mechanism for Emacs Lisp functions -*- lexical-binding: t -*-
-;; Copyright (C) 1993-1994, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2000-2021 Free Software Foundation, Inc.
;; Author: Hans Chalupsky <hans@cs.buffalo.edu>
;; Maintainer: emacs-devel@gnu.org
@@ -1840,8 +1840,7 @@ function at point for which PREDICATE returns non-nil)."
(or default
;; Prefer func name at point, if it's an advised function etc.
(let ((function (progn
- (require 'help)
- (function-called-at-point))))
+ (function-called-at-point))))
(and function
(member (symbol-name function) ad-advised-functions)
(or (null predicate)
@@ -1894,8 +1893,8 @@ class of FUNCTION)."
"Read name of existing advice of CLASS for FUNCTION with completion.
An optional PROMPT is used to prompt for the name."
(let* ((name-completion-table
- (mapcar (function (lambda (advice)
- (list (symbol-name (ad-advice-name advice)))))
+ (mapcar (lambda (advice)
+ (list (symbol-name (ad-advice-name advice))))
(ad-get-advice-info-field function class)))
(default
(if (null name-completion-table)
@@ -2224,8 +2223,6 @@ For that it has to be fbound with a non-autoload definition."
(let ((byte-compile-warnings byte-compile-warnings)
;; Don't pop up windows showing byte-compiler warnings.
(warning-suppress-types '((bytecomp))))
- (if (featurep 'cl)
- (byte-compile-disable-warning 'cl-functions))
(byte-compile (ad-get-advice-info-field function 'advicefunname))))
;; @@@ Accessing argument lists:
@@ -2255,13 +2252,11 @@ element is its actual current value, and the third element is either
(let* ((parsed-arglist (ad-parse-arglist arglist))
(rest (nth 2 parsed-arglist)))
`(list
- ,@(mapcar (function
- (lambda (req)
- `(list ',req ,req 'required)))
+ ,@(mapcar (lambda (req)
+ `(list ',req ,req 'required))
(nth 0 parsed-arglist))
- ,@(mapcar (function
- (lambda (opt)
- `(list ',opt ,opt 'optional)))
+ ,@(mapcar (lambda (opt)
+ `(list ',opt ,opt 'optional))
(nth 1 parsed-arglist))
,@(if rest (list `(list ',rest ,rest 'rest))))))
@@ -2372,28 +2367,26 @@ The assignment starts at position INDEX."
(defun ad-insert-argument-access-forms (definition arglist)
"Expands arg-access text macros in DEFINITION according to ARGLIST."
(ad-substitute-tree
- (function
- (lambda (form)
- (or (eq form 'ad-arg-bindings)
- (and (memq (car-safe form)
- '(ad-get-arg ad-get-args ad-set-arg ad-set-args))
- (integerp (car-safe (cdr form)))))))
- (function
- (lambda (form)
- (if (eq form 'ad-arg-bindings)
- (ad-retrieve-args-form arglist)
- (let ((accessor (car form))
- (index (car (cdr form)))
- (val (car (cdr (ad-insert-argument-access-forms
- (cdr form) arglist)))))
- (cond ((eq accessor 'ad-get-arg)
- (ad-get-argument arglist index))
- ((eq accessor 'ad-set-arg)
- (ad-set-argument arglist index val))
- ((eq accessor 'ad-get-args)
- (ad-get-arguments arglist index))
- ((eq accessor 'ad-set-args)
- (ad-set-arguments arglist index val)))))))
+ (lambda (form)
+ (or (eq form 'ad-arg-bindings)
+ (and (memq (car-safe form)
+ '(ad-get-arg ad-get-args ad-set-arg ad-set-args))
+ (integerp (car-safe (cdr form))))))
+ (lambda (form)
+ (if (eq form 'ad-arg-bindings)
+ (ad-retrieve-args-form arglist)
+ (let ((accessor (car form))
+ (index (car (cdr form)))
+ (val (car (cdr (ad-insert-argument-access-forms
+ (cdr form) arglist)))))
+ (cond ((eq accessor 'ad-get-arg)
+ (ad-get-argument arglist index))
+ ((eq accessor 'ad-set-arg)
+ (ad-set-argument arglist index val))
+ ((eq accessor 'ad-get-args)
+ (ad-get-arguments arglist index))
+ ((eq accessor 'ad-set-args)
+ (ad-set-arguments arglist index val))))))
definition))
;; @@@ Mapping argument lists:
@@ -2412,8 +2405,9 @@ as if they had been supplied to a function with TARGET-ARGLIST directly.
Excess source arguments will be neglected, missing source arguments will be
supplied as nil. Returns a `funcall' or `apply' form with the second element
being `function' which has to be replaced by an actual function argument.
-Example: (ad-map-arglists \\='(a &rest args) \\='(w x y z)) will return
- (funcall ad--addoit-function a (car args) (car (cdr args)) (nth 2 args))."
+Example:
+ (ad-map-arglists \\='(a &rest args) \\='(w x y z)) will return
+ (funcall ad--addoit-function a (car args) (car (cdr args)) (nth 2 args))."
(let* ((parsed-source-arglist (ad-parse-arglist source-arglist))
(source-reqopt-args (append (nth 0 parsed-source-arglist)
(nth 1 parsed-source-arglist)))
@@ -2623,8 +2617,8 @@ should be modified. The assembled function will be returned."
(defun ad-make-hook-form (function hook-name)
"Make hook-form from FUNCTION's advice bodies in class HOOK-NAME."
(let ((hook-forms
- (mapcar (function (lambda (advice)
- (ad-body-forms (ad-advice-definition advice))))
+ (mapcar (lambda (advice)
+ (ad-body-forms (ad-advice-definition advice)))
(ad-get-enabled-advices function hook-name))))
(if hook-forms
(macroexp-progn (apply 'append hook-forms)))))
@@ -3167,15 +3161,14 @@ usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...)
(setq args (cdr args)))))
(flags
(mapcar
- (function
- (lambda (flag)
+ (lambda (flag)
(let ((completion
(try-completion (symbol-name flag) ad-defadvice-flags)))
(cond ((eq completion t) flag)
((member completion ad-defadvice-flags)
(intern completion))
(t (error "defadvice: Invalid or ambiguous flag: %s"
- flag))))))
+ flag)))))
args))
(advice (ad-make-advice
name (memq 'protect flags)
@@ -3217,11 +3210,10 @@ undone on exit of this macro."
(let* ((index -1)
;; Make let-variables to store current definitions:
(current-bindings
- (mapcar (function
- (lambda (function)
+ (mapcar (lambda (function)
(setq index (1+ index))
(list (intern (format "ad-oRiGdEf-%d" index))
- `(symbol-function ',function))))
+ `(symbol-function ',function)))
functions)))
`(let ,current-bindings
(unwind-protect
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index 07bda537b39..ec7492dd4b1 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -1,6 +1,6 @@
;;; autoload.el --- maintain autoloads in loaddefs.el -*- lexical-binding: t -*-
-;; Copyright (C) 1991-1997, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1991-1997, 2001-2021 Free Software Foundation, Inc.
;; Author: Roland McGrath <roland@gnu.org>
;; Keywords: maint
@@ -220,16 +220,27 @@ expression, in which case we want to handle forms differently."
;; Convert defcustom to less space-consuming data.
((eq car 'defcustom)
- (let ((varname (car-safe (cdr-safe form)))
- (init (car-safe (cdr-safe (cdr-safe form))))
- (doc (car-safe (cdr-safe (cdr-safe (cdr-safe form)))))
- ;; (rest (cdr-safe (cdr-safe (cdr-safe (cdr-safe form)))))
- )
+ (let* ((varname (car-safe (cdr-safe form)))
+ (props (nthcdr 4 form))
+ (initializer (plist-get props :initialize))
+ (init (car-safe (cdr-safe (cdr-safe form))))
+ (doc (car-safe (cdr-safe (cdr-safe (cdr-safe form)))))
+ ;; (rest (cdr-safe (cdr-safe (cdr-safe (cdr-safe form)))))
+ )
`(progn
- (defvar ,varname ,init ,doc)
+ ,(if (not (member initializer '(nil 'custom-initialize-default
+ #'custom-initialize-default
+ 'custom-initialize-reset
+ #'custom-initialize-reset)))
+ form
+ `(defvar ,varname ,init ,doc))
+ ;; When we include the complete `form', this `custom-autoload'
+ ;; is not indispensable, but it still helps in case the `defcustom'
+ ;; doesn't specify its group explicitly, and probably in a few other
+ ;; corner cases.
(custom-autoload ',varname ,file
,(condition-case nil
- (null (cadr (memq :set form)))
+ (null (plist-get props :set))
(error nil))))))
((eq car 'defgroup)
@@ -368,7 +379,8 @@ FILE's name."
(let ((basename (file-name-nondirectory file))
(lp (if (equal type "package") (setq type "autoloads"))))
(concat ";;; " basename
- " --- automatically extracted " (or type "autoloads") "\n"
+ " --- automatically extracted " (or type "autoloads")
+ " -*- lexical-binding: t -*-\n"
";;\n"
";;; Code:\n\n"
(if lp
diff --git a/lisp/emacs-lisp/avl-tree.el b/lisp/emacs-lisp/avl-tree.el
index 3657c4236eb..75c732269e2 100644
--- a/lisp/emacs-lisp/avl-tree.el
+++ b/lisp/emacs-lisp/avl-tree.el
@@ -1,6 +1,6 @@
;;; avl-tree.el --- balanced binary trees, AVL-trees -*- lexical-binding:t -*-
-;; Copyright (C) 1995, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 2007-2021 Free Software Foundation, Inc.
;; Author: Per Cederqvist <ceder@lysator.liu.se>
;; Inge Wallin <inge@lysator.liu.se>
diff --git a/lisp/emacs-lisp/backquote.el b/lisp/emacs-lisp/backquote.el
index 5413022e341..173c11644d5 100644
--- a/lisp/emacs-lisp/backquote.el
+++ b/lisp/emacs-lisp/backquote.el
@@ -1,6 +1,6 @@
;;; backquote.el --- implement the ` Lisp construct -*- lexical-binding: t -*-
-;; Copyright (C) 1990, 1992, 1994, 2001-2020 Free Software Foundation,
+;; Copyright (C) 1990, 1992, 1994, 2001-2021 Free Software Foundation,
;; Inc.
;; Author: Rick Sladkey <jrs@world.std.com>
diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el
index 5874ba72fcd..3e1c3292650 100644
--- a/lisp/emacs-lisp/backtrace.el
+++ b/lisp/emacs-lisp/backtrace.el
@@ -1,6 +1,6 @@
;;; backtrace.el --- generic major mode for Elisp backtraces -*- lexical-binding: t -*-
-;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2018-2021 Free Software Foundation, Inc.
;; Author: Gemini Lasswell
;; Keywords: lisp, tools, maint
diff --git a/lisp/emacs-lisp/benchmark.el b/lisp/emacs-lisp/benchmark.el
index 2fa5a878801..14bc2817390 100644
--- a/lisp/emacs-lisp/benchmark.el
+++ b/lisp/emacs-lisp/benchmark.el
@@ -1,6 +1,6 @@
;;; benchmark.el --- support for benchmarking code -*- lexical-binding: t -*-
-;; Copyright (C) 2003-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: lisp, extensions
@@ -43,7 +43,7 @@
;;;###autoload
(defmacro benchmark-run (&optional repetitions &rest forms)
"Time execution of FORMS.
-If REPETITIONS is supplied as a number, run forms that many times,
+If REPETITIONS is supplied as a number, run FORMS that many times,
accounting for the overhead of the resulting loop. Otherwise run
FORMS once.
Return a list of the total elapsed time for execution, the number of
diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index 0fd273aa3e3..5f432b80bc2 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -1,6 +1,6 @@
;;; bindat.el --- binary data structure packing and unpacking.
-;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Author: Kim F. Storm <storm@cua.dk>
;; Assignment name: struct.el
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 530a086b14b..f29f85b9650 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -1,6 +1,6 @@
;;; byte-opt.el --- the optimization passes of the emacs-lisp byte compiler -*- lexical-binding: t -*-
-;; Copyright (C) 1991, 1994, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1991, 1994, 2000-2021 Free Software Foundation, Inc.
;; Author: Jamie Zawinski <jwz@lucid.com>
;; Hallvard Furuseth <hbf@ulrik.uio.no>
@@ -374,185 +374,184 @@
;; the important aspect is that they are subrs that don't evaluate all of
;; their args.)
;;
- (let ((fn (car-safe form))
- tmp)
- (cond ((not (consp form))
- (if (not (and for-effect
- (or byte-compile-delete-errors
- (not (symbolp form))
- (eq form t))))
- form))
- ((eq fn 'quote)
- (if (cdr (cdr form))
- (byte-compile-warn "malformed quote form: `%s'"
- (prin1-to-string form)))
- ;; map (quote nil) to nil to simplify optimizer logic.
- ;; map quoted constants to nil if for-effect (just because).
- (and (nth 1 form)
- (not for-effect)
- form))
- ((memq fn '(let let*))
- ;; recursively enter the optimizer for the bindings and body
- ;; of a let or let*. This for depth-firstness: forms that
- ;; are more deeply nested are optimized first.
- (cons fn
+ ;; FIXME: There are a bunch of `byte-compile-warn' here which arguably
+ ;; have no place in an optimizer: the corresponding tests should be
+ ;; performed in `macroexpand-all', or in `cconv', or in `bytecomp'.
+ (let ((fn (car-safe form)))
+ (pcase form
+ ((pred (not consp))
+ (if (not (and for-effect
+ (or byte-compile-delete-errors
+ (not (symbolp form))
+ (eq form t))))
+ form))
+ (`(quote . ,v)
+ (if (cdr v)
+ (byte-compile-warn "malformed quote form: `%s'"
+ (prin1-to-string form)))
+ ;; Map (quote nil) to nil to simplify optimizer logic.
+ ;; Map quoted constants to nil if for-effect (just because).
+ (and (car v)
+ (not for-effect)
+ form))
+ (`(,(or 'let 'let*) . ,(or `(,bindings . ,exps) pcase--dontcare))
+ ;; Recursively enter the optimizer for the bindings and body
+ ;; of a let or let*. This for depth-firstness: forms that
+ ;; are more deeply nested are optimized first.
+ (cons fn
(cons
(mapcar (lambda (binding)
- (if (symbolp binding)
- binding
- (if (cdr (cdr binding))
- (byte-compile-warn "malformed let binding: `%s'"
- (prin1-to-string binding)))
- (list (car binding)
- (byte-optimize-form (nth 1 binding) nil))))
- (nth 1 form))
- (byte-optimize-body (cdr (cdr form)) for-effect))))
- ((eq fn 'cond)
- (cons fn
- (mapcar (lambda (clause)
- (if (consp clause)
- (cons
- (byte-optimize-form (car clause) nil)
- (byte-optimize-body (cdr clause) for-effect))
- (byte-compile-warn "malformed cond form: `%s'"
- (prin1-to-string clause))
- clause))
- (cdr form))))
- ((eq fn 'progn)
- ;; As an extra added bonus, this simplifies (progn <x>) --> <x>.
- (if (cdr (cdr form))
- (macroexp-progn (byte-optimize-body (cdr form) for-effect))
- (byte-optimize-form (nth 1 form) for-effect)))
- ((eq fn 'prog1)
- (if (cdr (cdr form))
- (cons 'prog1
- (cons (byte-optimize-form (nth 1 form) for-effect)
- (byte-optimize-body (cdr (cdr form)) t)))
- (byte-optimize-form (nth 1 form) for-effect)))
-
- ((memq fn '(save-excursion save-restriction save-current-buffer))
- ;; those subrs which have an implicit progn; it's not quite good
- ;; enough to treat these like normal function calls.
- ;; This can turn (save-excursion ...) into (save-excursion) which
- ;; will be optimized away in the lap-optimize pass.
- (cons fn (byte-optimize-body (cdr form) for-effect)))
-
- ((eq fn 'if)
- (when (< (length form) 3)
- (byte-compile-warn "too few arguments for `if'"))
- (cons fn
- (cons (byte-optimize-form (nth 1 form) nil)
- (cons
- (byte-optimize-form (nth 2 form) for-effect)
- (byte-optimize-body (nthcdr 3 form) for-effect)))))
-
- ((memq fn '(and or)) ; Remember, and/or are control structures.
- ;; Take forms off the back until we can't any more.
- ;; In the future it could conceivably be a problem that the
- ;; subexpressions of these forms are optimized in the reverse
- ;; order, but it's ok for now.
- (if for-effect
- (let ((backwards (reverse (cdr form))))
- (while (and backwards
- (null (setcar backwards
- (byte-optimize-form (car backwards)
- for-effect))))
- (setq backwards (cdr backwards)))
- (if (and (cdr form) (null backwards))
- (byte-compile-log
- " all subforms of %s called for effect; deleted" form))
- (and backwards
- (cons fn (nreverse (mapcar 'byte-optimize-form
- backwards)))))
- (cons fn (mapcar 'byte-optimize-form (cdr form)))))
-
- ((eq fn 'while)
- (unless (consp (cdr form))
- (byte-compile-warn "too few arguments for `while'"))
- (cons fn
- (cons (byte-optimize-form (cadr form) nil)
- (byte-optimize-body (cddr form) t))))
-
- ((eq fn 'interactive)
- (byte-compile-warn "misplaced interactive spec: `%s'"
- (prin1-to-string form))
- nil)
-
- ((eq fn 'function)
- ;; This forms is compiled as constant or by breaking out
- ;; all the subexpressions and compiling them separately.
- form)
-
- ((eq fn 'condition-case)
- `(condition-case ,(nth 1 form) ;Not evaluated.
- ,(byte-optimize-form (nth 2 form) for-effect)
- ,@(mapcar (lambda (clause)
- `(,(car clause)
- ,@(byte-optimize-body (cdr clause) for-effect)))
- (nthcdr 3 form))))
-
- ((eq fn 'unwind-protect)
- ;; the "protected" part of an unwind-protect is compiled (and thus
- ;; optimized) as a top-level form, so don't do it here. But the
- ;; non-protected part has the same for-effect status as the
- ;; unwind-protect itself. (The protected part is always for effect,
- ;; but that isn't handled properly yet.)
- (cons fn
- (cons (byte-optimize-form (nth 1 form) for-effect)
- (cdr (cdr form)))))
-
- ((eq fn 'catch)
- (cons fn
- (cons (byte-optimize-form (nth 1 form) nil)
- (byte-optimize-body (cdr form) for-effect))))
-
- ((eq fn 'ignore)
- ;; Don't treat the args to `ignore' as being
- ;; computed for effect. We want to avoid the warnings
- ;; that might occur if they were treated that way.
- ;; However, don't actually bother calling `ignore'.
- `(prog1 nil . ,(mapcar 'byte-optimize-form (cdr form))))
-
- ;; Needed as long as we run byte-optimize-form after cconv.
- ((eq fn 'internal-make-closure) form)
-
- ((eq (car-safe fn) 'lambda)
- (let ((newform (byte-compile-unfold-lambda form)))
- (if (eq newform form)
- ;; Some error occurred, avoid infinite recursion
- form
- (byte-optimize-form newform for-effect))))
-
- ((eq (car-safe fn) 'closure) form)
-
- ((byte-code-function-p fn)
- (cons fn (mapcar #'byte-optimize-form (cdr form))))
-
- ((not (symbolp fn))
- (byte-compile-warn "`%s' is a malformed function"
- (prin1-to-string fn))
- form)
-
- ((and for-effect (setq tmp (get fn 'side-effect-free))
- (or byte-compile-delete-errors
- (eq tmp 'error-free)
- (progn
- (byte-compile-warn "value returned from %s is unused"
- (prin1-to-string form))
- nil)))
- (byte-compile-log " %s called for effect; deleted" fn)
- ;; appending a nil here might not be necessary, but it can't hurt.
- (byte-optimize-form
- (cons 'progn (append (cdr form) '(nil))) t))
+ (if (symbolp binding)
+ binding
+ (if (cdr (cdr binding))
+ (byte-compile-warn "malformed let binding: `%s'"
+ (prin1-to-string binding)))
+ (list (car binding)
+ (byte-optimize-form (nth 1 binding) nil))))
+ bindings)
+ (byte-optimize-body exps for-effect))))
+ (`(cond . ,clauses)
+ (cons fn
+ (mapcar (lambda (clause)
+ (if (consp clause)
+ (cons
+ (byte-optimize-form (car clause) nil)
+ (byte-optimize-body (cdr clause) for-effect))
+ (byte-compile-warn "malformed cond form: `%s'"
+ (prin1-to-string clause))
+ clause))
+ clauses)))
+ (`(progn . ,exps)
+ ;; As an extra added bonus, this simplifies (progn <x>) --> <x>.
+ (if (cdr exps)
+ (macroexp-progn (byte-optimize-body exps for-effect))
+ (byte-optimize-form (car exps) for-effect)))
+ (`(prog1 . ,(or `(,exp . ,exps) pcase--dontcare))
+ (if exps
+ `(prog1 ,(byte-optimize-form exp for-effect)
+ . ,(byte-optimize-body exps t))
+ (byte-optimize-form exp for-effect)))
+
+ (`(,(or `save-excursion `save-restriction `save-current-buffer) . ,exps)
+ ;; Those subrs which have an implicit progn; it's not quite good
+ ;; enough to treat these like normal function calls.
+ ;; This can turn (save-excursion ...) into (save-excursion) which
+ ;; will be optimized away in the lap-optimize pass.
+ (cons fn (byte-optimize-body exps for-effect)))
+
+ (`(if ,test ,then . ,else)
+ `(if ,(byte-optimize-form test nil)
+ ,(byte-optimize-form then for-effect)
+ . ,(byte-optimize-body else for-effect)))
+ (`(if . ,_)
+ (byte-compile-warn "too few arguments for `if'"))
+
+ (`(,(or 'and 'or) . ,exps) ; Remember, and/or are control structures.
+ ;; Take forms off the back until we can't any more.
+ ;; In the future it could conceivably be a problem that the
+ ;; subexpressions of these forms are optimized in the reverse
+ ;; order, but it's ok for now.
+ (if for-effect
+ (let ((backwards (reverse exps)))
+ (while (and backwards
+ (null (setcar backwards
+ (byte-optimize-form (car backwards)
+ for-effect))))
+ (setq backwards (cdr backwards)))
+ (if (and exps (null backwards))
+ (byte-compile-log
+ " all subforms of %s called for effect; deleted" form))
+ (and backwards
+ (cons fn (nreverse (mapcar #'byte-optimize-form
+ backwards)))))
+ (cons fn (mapcar #'byte-optimize-form exps))))
+
+ (`(while ,exp . ,exps)
+ `(while ,(byte-optimize-form exp nil)
+ . ,(byte-optimize-body exps t)))
+ (`(while . ,_)
+ (byte-compile-warn "too few arguments for `while'"))
+
+ (`(interactive . ,_)
+ (byte-compile-warn "misplaced interactive spec: `%s'"
+ (prin1-to-string form))
+ nil)
+
+ (`(function . ,_)
+ ;; This forms is compiled as constant or by breaking out
+ ;; all the subexpressions and compiling them separately.
+ form)
- (t
- ;; Otherwise, no args can be considered to be for-effect,
- ;; even if the called function is for-effect, because we
- ;; don't know anything about that function.
- (let ((form (cons fn (mapcar #'byte-optimize-form (cdr form)))))
- (if (get fn 'pure)
- (byte-optimize-constant-args form)
- form))))))
+ (`(condition-case . ,(or `(,var ,exp . ,clauses) pcase--dontcare))
+ `(condition-case ,var ;Not evaluated.
+ ,(byte-optimize-form exp for-effect)
+ ,@(mapcar (lambda (clause)
+ `(,(car clause)
+ ,@(byte-optimize-body (cdr clause) for-effect)))
+ clauses)))
+
+ (`(unwind-protect . ,(or `(,exp . ,exps) pcase--dontcare))
+ ;; The "protected" part of an unwind-protect is compiled (and thus
+ ;; optimized) as a top-level form, so don't do it here. But the
+ ;; non-protected part has the same for-effect status as the
+ ;; unwind-protect itself. (The protected part is always for effect,
+ ;; but that isn't handled properly yet.)
+ `(unwind-protect ,(byte-optimize-form exp for-effect) . ,exps))
+
+ (`(catch . ,(or `(,tag . ,exps) pcase--dontcare))
+ `(catch ,(byte-optimize-form tag nil)
+ . ,(byte-optimize-body exps for-effect)))
+
+ (`(ignore . ,exps)
+ ;; Don't treat the args to `ignore' as being
+ ;; computed for effect. We want to avoid the warnings
+ ;; that might occur if they were treated that way.
+ ;; However, don't actually bother calling `ignore'.
+ `(prog1 nil . ,(mapcar #'byte-optimize-form exps)))
+
+ ;; Needed as long as we run byte-optimize-form after cconv.
+ (`(internal-make-closure . ,_) form)
+
+ (`((lambda . ,_) . ,_)
+ (let ((newform (byte-compile-unfold-lambda form)))
+ (if (eq newform form)
+ ;; Some error occurred, avoid infinite recursion.
+ form
+ (byte-optimize-form newform for-effect))))
+
+ ;; FIXME: Strictly speaking, I think this is a bug: (closure...)
+ ;; is a *value* and shouldn't appear in the car.
+ (`((closure . ,_) . ,_) form)
+
+ (`(,(pred byte-code-function-p) . ,exps)
+ (cons fn (mapcar #'byte-optimize-form exps)))
+
+ (`(,(pred (not symbolp)) . ,_)
+ (byte-compile-warn "`%s' is a malformed function"
+ (prin1-to-string fn))
+ form)
+
+ ((guard (when for-effect
+ (if-let ((tmp (get fn 'side-effect-free)))
+ (or byte-compile-delete-errors
+ (eq tmp 'error-free)
+ (progn
+ (byte-compile-warn "value returned from %s is unused"
+ (prin1-to-string form))
+ nil)))))
+ (byte-compile-log " %s called for effect; deleted" fn)
+ ;; appending a nil here might not be necessary, but it can't hurt.
+ (byte-optimize-form
+ (cons 'progn (append (cdr form) '(nil))) t))
+
+ (_
+ ;; Otherwise, no args can be considered to be for-effect,
+ ;; even if the called function is for-effect, because we
+ ;; don't know anything about that function.
+ (let ((form (cons fn (mapcar #'byte-optimize-form (cdr form)))))
+ (if (get fn 'pure)
+ (byte-optimize-constant-args form)
+ form))))))
(defun byte-optimize-form (form &optional for-effect)
"The source-level pass of the optimizer."
@@ -1169,7 +1168,9 @@
hash-table-count
int-to-string intern-soft isnan
keymap-parent
- lax-plist-get ldexp length line-beginning-position line-end-position
+ lax-plist-get ldexp
+ length length< length> length=
+ line-beginning-position line-end-position
local-variable-if-set-p local-variable-p locale-info
log log10 logand logb logcount logior lognot logxor lsh
make-byte-code make-list make-string make-symbol marker-buffer max
@@ -1459,10 +1460,10 @@
(setq rest (cdr rest))))
(if tags (error "optimizer error: missed tags %s" tags))
;; Remove addrs, lap = ( [ (op . arg) | (TAG tagno) ]* )
- (mapcar (function (lambda (elt)
- (if (numberp elt)
- elt
- (cdr elt))))
+ (mapcar (lambda (elt)
+ (if (numberp elt)
+ elt
+ (cdr elt)))
(nreverse lap))))
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index 27f54d0ca2a..0f8dd5a2842 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -1,6 +1,6 @@
;;; byte-run.el --- byte-compiler support for inlining -*- lexical-binding: t -*-
-;; Copyright (C) 1992, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 2001-2021 Free Software Foundation, Inc.
;; Author: Jamie Zawinski <jwz@lucid.com>
;; Hallvard Furuseth <hbf@ulrik.uio.no>
@@ -372,7 +372,7 @@ convention was modified."
(puthash (indirect-function function) signature
advertised-signature-table))
-(defun make-obsolete (obsolete-name current-name &optional when)
+(defun make-obsolete (obsolete-name current-name when)
"Make the byte-compiler warn that function OBSOLETE-NAME is obsolete.
OBSOLETE-NAME should be a function name or macro name (a symbol).
@@ -381,17 +381,14 @@ If CURRENT-NAME is a string, that is the `use instead' message
\(it should end with a period, and not start with a capital).
WHEN should be a string indicating when the function
was first made obsolete, for example a date or a release number."
- (declare (advertised-calling-convention
- ;; New code should always provide the `when' argument.
- (obsolete-name current-name when) "23.1"))
(put obsolete-name 'byte-obsolete-info
;; The second entry used to hold the `byte-compile' handler, but
;; is not used any more nowadays.
(purecopy (list current-name nil when)))
obsolete-name)
-(defmacro define-obsolete-function-alias (obsolete-name current-name
- &optional when docstring)
+(defmacro define-obsolete-function-alias ( obsolete-name current-name when
+ &optional docstring)
"Set OBSOLETE-NAME's function definition to CURRENT-NAME and mark it obsolete.
\(define-obsolete-function-alias \\='old-fun \\='new-fun \"22.1\" \"old-fun's doc.\")
@@ -405,15 +402,13 @@ WHEN should be a string indicating when the function was first
made obsolete, for example a date or a release number.
See the docstrings of `defalias' and `make-obsolete' for more details."
- (declare (doc-string 4)
- (advertised-calling-convention
- ;; New code should always provide the `when' argument.
- (obsolete-name current-name when &optional docstring) "23.1"))
+ (declare (doc-string 4))
`(progn
(defalias ,obsolete-name ,current-name ,docstring)
(make-obsolete ,obsolete-name ,current-name ,when)))
-(defun make-obsolete-variable (obsolete-name current-name &optional when access-type)
+(defun make-obsolete-variable ( obsolete-name current-name when
+ &optional access-type)
"Make the byte-compiler warn that OBSOLETE-NAME is obsolete.
The warning will say that CURRENT-NAME should be used instead.
If CURRENT-NAME is a string, that is the `use instead' message.
@@ -421,16 +416,13 @@ WHEN should be a string indicating when the variable
was first made obsolete, for example a date or a release number.
ACCESS-TYPE if non-nil should specify the kind of access that will trigger
obsolescence warnings; it can be either `get' or `set'."
- (declare (advertised-calling-convention
- ;; New code should always provide the `when' argument.
- (obsolete-name current-name when &optional access-type) "23.1"))
(put obsolete-name 'byte-obsolete-variable
(purecopy (list current-name access-type when)))
obsolete-name)
-(defmacro define-obsolete-variable-alias (obsolete-name current-name
- &optional when docstring)
+(defmacro define-obsolete-variable-alias ( obsolete-name current-name when
+ &optional docstring)
"Make OBSOLETE-NAME a variable alias for CURRENT-NAME and mark it obsolete.
WHEN should be a string indicating when the variable was first
@@ -459,10 +451,7 @@ For the benefit of Customize, if OBSOLETE-NAME has
any of the following properties, they are copied to
CURRENT-NAME, if it does not already have them:
`saved-value', `saved-variable-comment'."
- (declare (doc-string 4)
- (advertised-calling-convention
- ;; New code should always provide the `when' argument.
- (obsolete-name current-name when &optional docstring) "23.1"))
+ (declare (doc-string 4))
`(progn
(defvaralias ,obsolete-name ,current-name ,docstring)
;; See Bug#4706.
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index cbda16d051b..360da6b6ba6 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -1,6 +1,6 @@
;;; bytecomp.el --- compilation of Lisp code into byte code -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1987, 1992, 1994, 1998, 2000-2020 Free Software
+;; Copyright (C) 1985-1987, 1992, 1994, 1998, 2000-2021 Free Software
;; Foundation, Inc.
;; Author: Jamie Zawinski <jwz@lucid.com>
@@ -144,7 +144,7 @@ is hard-coded in various places in Emacs.)"
;; Eg is_elc in Fload.
:type 'regexp)
-(defcustom byte-compile-dest-file-function nil
+(defcustom byte-compile-dest-file-function #'byte-compile--default-dest-file
"Function for the function `byte-compile-dest-file' to call.
It should take one argument, the name of an Emacs Lisp source
file name, and return the name of the compiled file.
@@ -177,14 +177,16 @@ function to do the work. Otherwise, if FILENAME matches
`emacs-lisp-file-regexp' (by default, files with the extension \".el\"),
replaces the matching part (and anything after it) with \".elc\";
otherwise adds \".elc\"."
- (if byte-compile-dest-file-function
- (funcall byte-compile-dest-file-function filename)
- (setq filename (file-name-sans-versions
- (byte-compiler-base-file-name filename)))
- (cond ((string-match emacs-lisp-file-regexp filename)
- (concat (substring filename 0 (match-beginning 0)) ".elc"))
- (t (concat filename ".elc")))))
-)
+ (funcall (or byte-compile-dest-file-function
+ #'byte-compile--default-dest-file)
+ filename)))
+
+(defun byte-compile--default-dest-file (filename)
+ (setq filename (file-name-sans-versions
+ (byte-compiler-base-file-name filename)))
+ (cond ((string-match emacs-lisp-file-regexp filename)
+ (concat (substring filename 0 (match-beginning 0)) ".elc"))
+ (t (concat filename ".elc"))))
;; This can be the 'byte-compile property of any symbol.
(autoload 'byte-compile-inline-expand "byte-opt")
@@ -296,8 +298,9 @@ The information is logged to `byte-compile-log-buffer'."
(defconst byte-compile-warning-types
'(redefine callargs free-vars unresolved
- obsolete noruntime cl-functions interactive-only
- make-local mapcar constants suspicious lexical lexical-dynamic)
+ obsolete noruntime interactive-only
+ make-local mapcar constants suspicious lexical lexical-dynamic
+ docstrings)
"The list of warning types used when `byte-compile-warnings' is t.")
(defcustom byte-compile-warnings t
"List of warnings that the byte-compiler should issue (t for all).
@@ -312,8 +315,6 @@ Elements of the list may be:
obsolete obsolete variables and functions.
noruntime functions that may not be defined at runtime (typically
defined only under `eval-when-compile').
- cl-functions calls to runtime functions (as distinguished from macros and
- aliases) from the old CL package (not the newer cl-lib).
interactive-only
commands that normally shouldn't be called from Lisp code.
lexical global/dynamic variables lacking a prefix.
@@ -322,6 +323,8 @@ Elements of the list may be:
make-local calls to make-variable-buffer-local that may be incorrect.
mapcar mapcar called for effect.
constants let-binding of, or assignment to, constants/nonvariables.
+ docstrings docstrings that are too wide (longer than 80 characters,
+ or `fill-column', whichever is bigger)
suspicious constructs that usually don't do what the coder wanted.
If the list begins with `not', then the remaining elements specify warnings to
@@ -707,7 +710,8 @@ Each element is (INDEX . VALUE)")
;; These store their argument in the next two bytes
(byte-defop 129 1 byte-constant2
- "for reference to a constant with vector index >= byte-constant-limit")
+ "for reference to a constant with vector
+index >= byte-constant-limit")
(byte-defop 130 0 byte-goto "for unconditional jump")
(byte-defop 131 -1 byte-goto-if-nil "to pop value and jump if it's nil")
(byte-defop 132 -1 byte-goto-if-not-nil "to pop value and jump if it's not nil")
@@ -727,11 +731,14 @@ otherwise pop it")
(byte-defop 139 0 byte-save-window-excursion-OBSOLETE
"to make a binding to record entire window configuration")
(byte-defop 140 0 byte-save-restriction
- "to make a binding to record the current buffer clipping restrictions")
+ "to make a binding to record the current buffer clipping
+restrictions")
(byte-defop 141 -1 byte-catch-OBSOLETE ; Not generated since Emacs 25.
- "for catch. Takes, on stack, the tag and an expression for the body")
+ "for catch. Takes, on stack, the tag and an expression for
+the body")
(byte-defop 142 -1 byte-unwind-protect
- "for unwind-protect. Takes, on stack, an expression for the unwind-action")
+ "for unwind-protect. Takes, on stack, an expression for
+the unwind-action")
;; For condition-case. Takes, on stack, the variable to bind,
;; an expression for the body, and a list of clauses.
@@ -791,8 +798,8 @@ otherwise pop it")
(defconst byte-discardN-preserve-tos byte-discardN)
(byte-defop 183 -2 byte-switch
- "to take a hash table and a value from the stack, and jump to the address
-the value maps to, if any.")
+ "to take a hash table and a value from the stack, and jump to
+the address the value maps to, if any.")
;; unused: 182-191
@@ -968,11 +975,6 @@ CONST2 may be evaluated multiple times."
;;; compile-time evaluation
-(defun byte-compile-cl-file-p (file)
- "Return non-nil if FILE is one of the CL files."
- (and (stringp file)
- (string-match "^cl\\.el" (file-name-nondirectory file))))
-
(defun byte-compile-eval (form)
"Eval FORM and mark the functions defined therein.
Each function's symbol gets added to `byte-compile-noruntime-functions'."
@@ -1003,18 +1005,7 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
(when (and (symbolp s) (not (memq s old-autoloads)))
(push s byte-compile-noruntime-functions))
(when (and (consp s) (eq t (car s)))
- (push (cdr s) old-autoloads)))))))
- (when (byte-compile-warning-enabled-p 'cl-functions)
- (let ((hist-new load-history))
- ;; Go through load-history, looking for the cl files.
- ;; Since new files are added at the start of load-history,
- ;; we scan the new history until the tail matches the old.
- (while (and (not byte-compile-cl-functions)
- hist-new (not (eq hist-new hist-orig)))
- ;; We used to check if the file had already been loaded,
- ;; but it is better to check non-nil byte-compile-cl-functions.
- (and (byte-compile-cl-file-p (car (pop hist-new)))
- (byte-compile-find-cl-functions))))))))
+ (push (cdr s) old-autoloads))))))))))
(defun byte-compile-eval-before-compile (form)
"Evaluate FORM for `eval-and-compile'."
@@ -1025,9 +1016,7 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
;; There are other ways to do this nowadays.
(let ((tem current-load-list))
(while (not (eq tem hist-nil-orig))
- (when (equal (car tem) '(require . cl))
- (byte-compile-disable-warning 'cl-functions))
- (setq tem (cdr tem)))))))
+ (setq tem (cdr tem)))))))
;;; byte compiler messages
@@ -1577,43 +1566,79 @@ extra args."
(if (equal sig1 '(1 . 1)) "argument" "arguments")
(byte-compile-arglist-signature-string sig2)))))))
-(defvar byte-compile-cl-functions nil
- "List of functions defined in CL.")
-
-;; Can't just add this to cl-load-hook, because that runs just before
-;; the forms from cl.el get added to load-history.
-(defun byte-compile-find-cl-functions ()
- (unless byte-compile-cl-functions
- (dolist (elt load-history)
- (and (byte-compile-cl-file-p (car elt))
- (dolist (e (cdr elt))
- ;; Includes the cl-foo functions that cl autoloads.
- (when (memq (car-safe e) '(autoload defun))
- (push (cdr e) byte-compile-cl-functions)))))))
-
-(defun byte-compile-cl-warn (form)
- "Warn if FORM is a call of a function from the CL package."
- (let ((func (car-safe form)))
- (if (and byte-compile-cl-functions
- (memq func byte-compile-cl-functions)
- ;; Aliases which won't have been expanded at this point.
- ;; These aren't all aliases of subrs, so not trivial to
- ;; avoid hardwiring the list.
- (not (memq func
- '(cl--block-wrapper cl--block-throw
- multiple-value-call nth-value
- copy-seq first second rest endp cl-member
- ;; These are included in generated code
- ;; that can't be called except at compile time
- ;; or unless cl is loaded anyway.
- cl--defsubst-expand cl-struct-setf-expander
- ;; These would sometimes be warned about
- ;; but such warnings are never useful,
- ;; so don't warn about them.
- macroexpand
- cl--compiling-file))))
- (byte-compile-warn "function `%s' from cl package called at runtime"
- func)))
+(defvar byte-compile--wide-docstring-substitution-len 3
+ "Substitution width used in `byte-compile--wide-docstring-p'.
+This is a heuristic for guessing the width of a documentation
+string: `byte-compile--wide-docstring-p' assumes that any
+`substitute-command-keys' command substitutions are this long.")
+
+(defun byte-compile--wide-docstring-p (docstring col)
+ "Return t if string DOCSTRING is wider than COL.
+Ignore all `substitute-command-keys' substitutions, except for
+the `\\\\=[command]' ones that are assumed to be of length
+`byte-compile--wide-docstring-substitution-len'. Also ignore
+URLs."
+ (string-match
+ (format "^.\\{%s,\\}$" (int-to-string (1+ col)))
+ (replace-regexp-in-string
+ (rx (or
+ ;; Ignore some URLs.
+ (seq "http" (? "s") "://" (* anychar))
+ ;; Ignore these `substitute-command-keys' substitutions.
+ (seq "\\" (or "="
+ (seq "<" (* (not ">")) ">")
+ (seq "{" (* (not "}")) "}")))))
+ ""
+ ;; Heuristic: assume these substitutions are of some length N.
+ (replace-regexp-in-string
+ (rx "\\" (or (seq "[" (* (not "]")) "]")))
+ (make-string byte-compile--wide-docstring-substitution-len ?x)
+ docstring))))
+
+(defcustom byte-compile-docstring-max-column 80
+ "Recommended maximum width of doc string lines.
+The byte-compiler will emit a warning for documentation strings
+containing lines wider than this. If `fill-column' has a larger
+value, it will override this variable."
+ :group 'bytecomp
+ :type 'integer
+ :safe #'integerp
+ :version "28.1")
+
+(defun byte-compile-docstring-length-warn (form)
+ "Warn if documentation string of FORM is too wide.
+It is too wide if it has any lines longer than the largest of
+`fill-column' and `byte-compile-docstring-max-column'."
+ ;; This has some limitations that it would be nice to fix:
+ ;; 1. We don't try to handle defuns. It is somewhat tricky to get
+ ;; it right since `defun' is a macro. Also, some macros
+ ;; themselves produce defuns (e.g. `define-derived-mode').
+ ;; 2. We assume that any `subsititute-command-keys' command replacement has a
+ ;; given length. We can't reliably do these replacements, since the value
+ ;; of the keymaps in general can't be known at compile time.
+ (when (byte-compile-warning-enabled-p 'docstrings)
+ (let ((col (max byte-compile-docstring-max-column fill-column))
+ kind name docs)
+ (pcase (car form)
+ ((or 'autoload 'custom-declare-variable 'defalias
+ 'defconst 'define-abbrev-table
+ 'defvar 'defvaralias)
+ (setq kind (nth 0 form))
+ (setq name (nth 1 form))
+ (setq docs (nth 3 form)))
+ ;; Here is how one could add lambda's here:
+ ;; ('lambda
+ ;; (setq kind "") ; can't be "function", unfortunately
+ ;; (setq docs (and (stringp (nth 2 form))
+ ;; (nth 2 form))))
+ )
+ (when (and (consp name) (eq (car name) 'quote))
+ (setq name (cadr name)))
+ (setq name (if name (format " `%s'" name) ""))
+ (when (and kind docs (stringp docs)
+ (byte-compile--wide-docstring-p docs col))
+ (byte-compile-warn "%s%s docstring wider than %s characters"
+ kind name col))))
form)
(defun byte-compile-print-syms (str1 strn syms)
@@ -1713,7 +1738,6 @@ extra args."
(and (markerp warning-series)
(eq (marker-buffer warning-series)
(get-buffer byte-compile-log-buffer)))))
- (byte-compile-find-cl-functions)
(if (or (eq warning-series 'byte-compile-warning-series)
warning-series-started)
;; warning-series does come from compilation,
@@ -1746,7 +1770,7 @@ Files in subdirectories of DIRECTORY are processed also."
(byte-recompile-directory directory nil t))
;;;###autoload
-(defun byte-recompile-directory (directory &optional arg force)
+(defun byte-recompile-directory (directory &optional arg force follow-symlinks)
"Recompile every `.el' file in DIRECTORY that needs recompilation.
This happens when a `.elc' file exists but is older than the `.el' file.
Files in subdirectories of DIRECTORY are processed also.
@@ -1759,7 +1783,11 @@ compile it. A nonzero ARG also means ask about each subdirectory
before scanning it.
If the third argument FORCE is non-nil, recompile every `.el' file
-that already has a `.elc' file."
+that already has a `.elc' file.
+
+This command will normally not follow symlinks when compiling
+files. If FOLLOW-SYMLINKS is non-nil, symlinked `.el' files will
+also be compiled."
(interactive "DByte recompile directory: \nP")
(if arg (setq arg (prefix-numeric-value arg)))
(if noninteractive
@@ -1792,7 +1820,8 @@ that already has a `.elc' file."
(if (file-directory-p source)
(and (not (member file '("RCS" "CVS")))
(not (eq ?\. (aref file 0)))
- (not (file-symlink-p source))
+ (or follow-symlinks
+ (not (file-symlink-p source)))
;; This file is a subdirectory. Handle them differently.
(or (null arg) (eq 0 arg)
(y-or-n-p (concat "Check " source "? ")))
@@ -1864,24 +1893,23 @@ If compilation is needed, this functions returns the result of
(let ((dest (byte-compile-dest-file filename))
;; Expand now so we get the current buffer's defaults
(filename (expand-file-name filename)))
- (if (if (file-exists-p dest)
- ;; File was already compiled
- ;; Compile if forced to, or filename newer
- (or force
- (file-newer-than-file-p filename dest))
- (and arg
- (or (eq 0 arg)
- (y-or-n-p (concat "Compile "
- filename "? ")))))
- (progn
- (if (and noninteractive (not byte-compile-verbose))
- (message "Compiling %s..." filename))
- (byte-compile-file filename)
- (when load
- (load (if (file-exists-p dest) dest filename))))
+ (prog1
+ (if (if (and dest (file-exists-p dest))
+ ;; File was already compiled
+ ;; Compile if forced to, or filename newer
+ (or force
+ (file-newer-than-file-p filename dest))
+ (and arg
+ (or (eq 0 arg)
+ (y-or-n-p (concat "Compile "
+ filename "? ")))))
+ (progn
+ (if (and noninteractive (not byte-compile-verbose))
+ (message "Compiling %s..." filename))
+ (byte-compile-file filename))
+ 'no-byte-compile)
(when load
- (load (if (file-exists-p dest) dest filename)))
- 'no-byte-compile)))
+ (load (if (and dest (file-exists-p dest)) dest filename))))))
(defun byte-compile--load-dynvars (file)
(and file (not (equal file ""))
@@ -1991,7 +2019,7 @@ See also `emacs-lisp-byte-compile-and-load'."
;; (message "%s not compiled because of `no-byte-compile: %s'"
;; (byte-compile-abbreviate-file filename)
;; (with-current-buffer input-buffer no-byte-compile))
- (when (file-exists-p target-file)
+ (when (and target-file (file-exists-p target-file))
(message "%s deleted because of `no-byte-compile: %s'"
(byte-compile-abbreviate-file target-file)
(buffer-local-value 'no-byte-compile input-buffer))
@@ -2015,36 +2043,54 @@ See also `emacs-lisp-byte-compile-and-load'."
(with-current-buffer output-buffer
(goto-char (point-max))
(insert "\n") ; aaah, unix.
- (if (file-writable-p target-file)
- ;; We must disable any code conversion here.
- (progn
- (let* ((coding-system-for-write 'no-conversion)
- ;; Write to a tempfile so that if another Emacs
- ;; process is trying to load target-file (eg in a
- ;; parallel bootstrap), it does not risk getting a
- ;; half-finished file. (Bug#4196)
- (tempfile
- (make-temp-file (expand-file-name target-file)))
- (default-modes (default-file-modes))
- (temp-modes (logand default-modes #o600))
- (desired-modes (logand default-modes #o666))
- (kill-emacs-hook
- (cons (lambda () (ignore-errors
- (delete-file tempfile)))
- kill-emacs-hook)))
- (unless (= temp-modes desired-modes)
- (set-file-modes tempfile desired-modes 'nofollow))
- (write-region (point-min) (point-max) tempfile nil 1)
- ;; This has the intentional side effect that any
- ;; hard-links to target-file continue to
- ;; point to the old file (this makes it possible
- ;; for installed files to share disk space with
- ;; the build tree, without causing problems when
- ;; emacs-lisp files in the build tree are
- ;; recompiled). Previously this was accomplished by
- ;; deleting target-file before writing it.
- (rename-file tempfile target-file t))
- (or noninteractive (message "Wrote %s" target-file)))
+ (cond
+ ((null target-file) nil) ;We only wanted the warnings!
+ ((and (file-writable-p target-file)
+ ;; We attempt to create a temporary file in the
+ ;; target directory, so the target directory must be
+ ;; writable.
+ (file-writable-p
+ (file-name-directory
+ ;; Need to expand in case TARGET-FILE doesn't
+ ;; include a directory (Bug#45287).
+ (expand-file-name target-file))))
+ ;; We must disable any code conversion here.
+ (let* ((coding-system-for-write 'no-conversion)
+ ;; Write to a tempfile so that if another Emacs
+ ;; process is trying to load target-file (eg in a
+ ;; parallel bootstrap), it does not risk getting a
+ ;; half-finished file. (Bug#4196)
+ (tempfile
+ (make-temp-file (expand-file-name target-file)))
+ (default-modes (default-file-modes))
+ (temp-modes (logand default-modes #o600))
+ (desired-modes (logand default-modes #o666))
+ (kill-emacs-hook
+ (cons (lambda () (ignore-errors
+ (delete-file tempfile)))
+ kill-emacs-hook)))
+ (unless (= temp-modes desired-modes)
+ (set-file-modes tempfile desired-modes 'nofollow))
+ (write-region (point-min) (point-max) tempfile nil 1)
+ ;; This has the intentional side effect that any
+ ;; hard-links to target-file continue to
+ ;; point to the old file (this makes it possible
+ ;; for installed files to share disk space with
+ ;; the build tree, without causing problems when
+ ;; emacs-lisp files in the build tree are
+ ;; recompiled). Previously this was accomplished by
+ ;; deleting target-file before writing it.
+ (rename-file tempfile target-file t))
+ (or noninteractive (message "Wrote %s" target-file)))
+ ((file-writable-p target-file)
+ ;; In case the target directory isn't writable (see e.g. Bug#44631),
+ ;; try writing to the output file directly. We must disable any
+ ;; code conversion here.
+ (let ((coding-system-for-write 'no-conversion))
+ (with-file-modes (logand (default-file-modes) #o666)
+ (write-region (point-min) (point-max) target-file nil 1)))
+ (or noninteractive (message "Wrote %s" target-file)))
+ (t
;; This is just to give a better error message than write-region
(let ((exists (file-exists-p target-file)))
(signal (if exists 'file-error 'file-missing)
@@ -2052,7 +2098,7 @@ See also `emacs-lisp-byte-compile-and-load'."
(if exists
"Cannot overwrite file"
"Directory not writable or nonexistent")
- target-file))))
+ target-file)))))
(kill-buffer (current-buffer)))
(if (and byte-compile-generate-call-tree
(or (eq t byte-compile-generate-call-tree)
@@ -2442,7 +2488,8 @@ list that represents a doc string reference.
(delq (assq funsym byte-compile-unresolved-functions)
byte-compile-unresolved-functions)))))
(if (stringp (nth 3 form))
- form
+ (prog1 form
+ (byte-compile-docstring-length-warn form))
;; No doc string, so we can compile this as a normal form.
(byte-compile-keep-pending form 'byte-compile-normal-call)))
@@ -2470,6 +2517,7 @@ list that represents a doc string reference.
(if (and (null (cddr form)) ;No `value' provided.
(eq (car form) 'defvar)) ;Just a declaration.
nil
+ (byte-compile-docstring-length-warn form)
(cond ((consp (nth 2 form))
(setq form (copy-sequence form))
(setcar (cdr (cdr form))
@@ -2493,6 +2541,7 @@ list that represents a doc string reference.
(if (byte-compile-warning-enabled-p 'suspicious)
(byte-compile-warn
"Alias for `%S' should be declared before its referent" newname)))))
+ (byte-compile-docstring-length-warn form)
(byte-compile-keep-pending form))
(put 'custom-declare-variable 'byte-hunk-handler
@@ -2505,8 +2554,7 @@ list that represents a doc string reference.
(put 'require 'byte-hunk-handler 'byte-compile-file-form-require)
(defun byte-compile-file-form-require (form)
(let ((args (mapcar 'eval (cdr form)))
- (hist-orig load-history)
- hist-new prov-cons)
+ hist-new prov-cons)
(apply 'require args)
;; Record the functions defined by the require in `byte-compile-new-defuns'.
@@ -2519,21 +2567,7 @@ list that represents a doc string reference.
(dolist (x (car hist-new))
(when (and (consp x)
(memq (car x) '(defun t)))
- (push (cdr x) byte-compile-new-defuns))))
-
- (when (byte-compile-warning-enabled-p 'cl-functions)
- ;; Detect (require 'cl) in a way that works even if cl is already loaded.
- (if (member (car args) '("cl" cl))
- (progn
- (byte-compile-warn "cl package required at runtime")
- (byte-compile-disable-warning 'cl-functions))
- ;; We may have required something that causes cl to be loaded, eg
- ;; the uncompiled version of a file that requires cl when compiling.
- (setq hist-new load-history)
- (while (and (not byte-compile-cl-functions)
- hist-new (not (eq hist-new hist-orig)))
- (and (byte-compile-cl-file-p (car (pop hist-new)))
- (byte-compile-find-cl-functions))))))
+ (push (cdr x) byte-compile-new-defuns)))))
(byte-compile-keep-pending form 'byte-compile-normal-call))
(put 'progn 'byte-hunk-handler 'byte-compile-file-form-progn)
@@ -2570,7 +2604,8 @@ list that represents a doc string reference.
;; and similar macros cleaner.
(put 'eval 'byte-hunk-handler 'byte-compile-file-form-eval)
(defun byte-compile-file-form-eval (form)
- (if (eq (car-safe (nth 1 form)) 'quote)
+ (if (and (eq (car-safe (nth 1 form)) 'quote)
+ (equal (nth 2 form) lexical-binding))
(nth 1 (nth 1 form))
(byte-compile-keep-pending form)))
@@ -2890,6 +2925,7 @@ for symbols generated by the byte compiler itself."
(unless (eq 'lambda (car-safe fun))
(error "Not a lambda list: %S" fun))
(byte-compile-set-symbol-position 'lambda))
+ (byte-compile-docstring-length-warn fun)
(byte-compile-check-lambda-list (nth 1 fun))
(let* ((arglist (nth 1 fun))
(arglistvars (byte-compile-arglist-vars arglist))
@@ -3197,7 +3233,7 @@ for symbols generated by the byte compiler itself."
run-hook-with-args-until-failure))
(pcase (cdr form)
(`(',var . ,_)
- (when (assq var byte-compile-lexical-variables)
+ (when (memq var byte-compile-lexical-variables)
(byte-compile-report-error
(format-message "%s cannot use lexical var `%s'" fn var))))))
;; Warn about using obsolete hooks.
@@ -3233,9 +3269,7 @@ for symbols generated by the byte compiler itself."
;; differently now).
(not (eq handler 'cl-byte-compile-compiler-macro))))
(funcall handler form)
- (byte-compile-normal-call form))
- (if (byte-compile-warning-enabled-p 'cl-functions)
- (byte-compile-cl-warn form))))
+ (byte-compile-normal-call form))))
((and (byte-code-function-p (car form))
(memq byte-optimize '(t lap)))
(byte-compile-unfold-bcf form))
@@ -3407,10 +3441,11 @@ for symbols generated by the byte compiler itself."
(and od
(not (memq var byte-compile-not-obsolete-vars))
(not (memq var byte-compile-global-not-obsolete-vars))
- (or (pcase (nth 1 od)
- ('set (not (eq access-type 'reference)))
- ('get (eq access-type 'reference))
- (_ t)))))
+ (not (memq var byte-compile-lexical-variables))
+ (pcase (nth 1 od)
+ ('set (not (eq access-type 'reference)))
+ ('get (eq access-type 'reference))
+ (_ t))))
(byte-compile-warn-obsolete var))))
(defsubst byte-compile-dynamic-variable-op (base-op var)
@@ -3426,6 +3461,27 @@ for symbols generated by the byte compiler itself."
(push var byte-compile-bound-variables)
(byte-compile-dynamic-variable-op 'byte-varbind var))
+(defun byte-compile-free-vars-warn (var &optional assignment)
+ "Warn if symbol VAR refers to a free variable.
+VAR must not be lexically bound.
+If optional argument ASSIGNMENT is non-nil, this is treated as an
+assignment (i.e. `setq'). "
+ (unless (or (not (byte-compile-warning-enabled-p 'free-vars var))
+ (boundp var)
+ (memq var byte-compile-bound-variables)
+ (memq var (if assignment
+ byte-compile-free-assignments
+ byte-compile-free-references)))
+ (let* ((varname (prin1-to-string var))
+ (desc (if assignment "assignment" "reference"))
+ (suggestions (help-uni-confusable-suggestions varname)))
+ (byte-compile-warn "%s to free variable `%s'%s"
+ desc varname
+ (if suggestions (concat "\n " suggestions) "")))
+ (push var (if assignment
+ byte-compile-free-assignments
+ byte-compile-free-references))))
+
(defun byte-compile-variable-ref (var)
"Generate code to push the value of the variable VAR on the stack."
(byte-compile-check-variable var 'reference)
@@ -3434,15 +3490,7 @@ for symbols generated by the byte compiler itself."
;; VAR is lexically bound
(byte-compile-stack-ref (cdr lex-binding))
;; VAR is dynamically bound
- (unless (or (not (byte-compile-warning-enabled-p 'free-vars var))
- (boundp var)
- (memq var byte-compile-bound-variables)
- (memq var byte-compile-free-references))
- (let* ((varname (prin1-to-string var))
- (suggestions (help-uni-confusable-suggestions varname)))
- (byte-compile-warn "reference to free variable `%s'%s" varname
- (if suggestions (concat "\n " suggestions) "")))
- (push var byte-compile-free-references))
+ (byte-compile-free-vars-warn var)
(byte-compile-dynamic-variable-op 'byte-varref var))))
(defun byte-compile-variable-set (var)
@@ -3453,15 +3501,7 @@ for symbols generated by the byte compiler itself."
;; VAR is lexically bound.
(byte-compile-stack-set (cdr lex-binding))
;; VAR is dynamically bound.
- (unless (or (not (byte-compile-warning-enabled-p 'free-vars var))
- (boundp var)
- (memq var byte-compile-bound-variables)
- (memq var byte-compile-free-assignments))
- (let* ((varname (prin1-to-string var))
- (suggestions (help-uni-confusable-suggestions varname)))
- (byte-compile-warn "assignment to free variable `%s'%s" varname
- (if suggestions (concat "\n " suggestions) "")))
- (push var byte-compile-free-assignments))
+ (byte-compile-free-vars-warn var t)
(byte-compile-dynamic-variable-op 'byte-varset var))))
(defmacro byte-compile-get-constant (const)
@@ -4667,6 +4707,7 @@ binding slots have been popped."
(byte-compile-warning-enabled-p 'lexical (nth 1 form)))
(byte-compile-warn "global/dynamic var `%s' lacks a prefix"
(nth 1 form)))
+ (byte-compile-docstring-length-warn form)
(let ((fun (nth 0 form))
(var (nth 1 form))
(value (nth 2 form))
@@ -4741,6 +4782,7 @@ binding slots have been popped."
;; - `arg' is the expression to which it is defined.
;; - `rest' is the rest of the arguments.
(`(,_ ',name ,arg . ,rest)
+ (byte-compile-docstring-length-warn form)
(pcase-let*
;; `macro' is non-nil if it defines a macro.
;; `fun' is the function part of `arg' (defaults to `arg').
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index 351a097ad19..e79583974a8 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -1,6 +1,6 @@
;;; cconv.el --- Closure conversion for statically scoped Emacs lisp. -*- lexical-binding: t -*-
-;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
;; Author: Igor Kuzmin <kzuminig@iro.umontreal.ca>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/emacs-lisp/chart.el b/lisp/emacs-lisp/chart.el
index 177710038a0..2cd73225ff3 100644
--- a/lisp/emacs-lisp/chart.el
+++ b/lisp/emacs-lisp/chart.el
@@ -1,6 +1,6 @@
;;; chart.el --- Draw charts (bar charts, etc) -*- lexical-binding: t -*-
-;; Copyright (C) 1996, 1998-1999, 2001, 2004-2005, 2007-2020 Free
+;; Copyright (C) 1996, 1998-1999, 2001, 2004-2005, 2007-2021 Free
;; Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -120,7 +120,7 @@ too much in text characters anyways.")
(define-derived-mode chart-mode special-mode "Chart"
"Define a mode in Emacs for displaying a chart."
(buffer-disable-undo)
- (set (make-local-variable 'font-lock-global-modes) nil)
+ (setq-local font-lock-global-modes nil)
(font-lock-mode -1) ;Isn't it off already? --Stef
)
@@ -333,7 +333,8 @@ Automatically compensates for direction."
(cl-defmethod chart-axis-draw ((a chart-axis-names) &optional dir margin zone _start _end)
"Draw axis information based upon A range to be spread along the edge.
Optional argument DIR is the direction of the chart.
-Optional arguments MARGIN, ZONE, START and END specify boundaries of the drawing."
+Optional arguments MARGIN, ZONE, START and END specify boundaries
+of the drawing."
(cl-call-next-method)
;; We prefer about 5 spaces between each value
(let* ((i 0)
diff --git a/lisp/emacs-lisp/check-declare.el b/lisp/emacs-lisp/check-declare.el
index 208214f2e6e..7c2b23b4ec4 100644
--- a/lisp/emacs-lisp/check-declare.el
+++ b/lisp/emacs-lisp/check-declare.el
@@ -1,6 +1,6 @@
;;; check-declare.el --- Check declare-function statements -*- lexical-binding: t; -*-
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Glenn Morris <rgm@gnu.org>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el
index a485378a926..2e204ff7aea 100644
--- a/lisp/emacs-lisp/checkdoc.el
+++ b/lisp/emacs-lisp/checkdoc.el
@@ -1,6 +1,6 @@
;;; checkdoc.el --- check documentation strings for style requirements -*- lexical-binding:t -*-
-;; Copyright (C) 1997-1998, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2001-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Old-Version: 0.6.2
@@ -37,7 +37,6 @@
;; documentation whenever you evaluate Lisp code with C-M-x
;; or [menu-bar emacs-lisp eval-buffer]. Additional key-bindings
;; are also provided under C-c ? KEY
-;; (require 'checkdoc)
;; (add-hook 'emacs-lisp-mode-hook 'checkdoc-minor-mode)
;;
;; Using `checkdoc':
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index d3159a37683..28ce6b115a4 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -1,6 +1,6 @@
;;; cl-extra.el --- Common Lisp features, part 2 -*- lexical-binding: t -*-
-;; Copyright (C) 1993, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 2000-2021 Free Software Foundation, Inc.
;; Author: Dave Gillespie <daveg@synaptics.com>
;; Keywords: extensions
@@ -209,10 +209,10 @@ non-nil value.
\n(fn PREDICATE SEQ...)"
(if (or cl-rest (nlistp cl-seq))
(catch 'cl-some
- (apply 'cl-map nil
- (function (lambda (&rest cl-x)
- (let ((cl-res (apply cl-pred cl-x)))
- (if cl-res (throw 'cl-some cl-res)))))
+ (apply #'cl-map nil
+ (lambda (&rest cl-x)
+ (let ((cl-res (apply cl-pred cl-x)))
+ (if cl-res (throw 'cl-some cl-res))))
cl-seq cl-rest) nil)
(let ((cl-x nil))
(while (and cl-seq (not (setq cl-x (funcall cl-pred (pop cl-seq))))))
@@ -224,9 +224,9 @@ non-nil value.
\n(fn PREDICATE SEQ...)"
(if (or cl-rest (nlistp cl-seq))
(catch 'cl-every
- (apply 'cl-map nil
- (function (lambda (&rest cl-x)
- (or (apply cl-pred cl-x) (throw 'cl-every nil))))
+ (apply #'cl-map nil
+ (lambda (&rest cl-x)
+ (or (apply cl-pred cl-x) (throw 'cl-every nil)))
cl-seq cl-rest) t)
(while (and cl-seq (funcall cl-pred (car cl-seq)))
(setq cl-seq (cdr cl-seq)))
@@ -249,14 +249,13 @@ non-nil value.
(or cl-base
(setq cl-base (copy-sequence [0])))
(map-keymap
- (function
- (lambda (cl-key cl-bind)
- (aset cl-base (1- (length cl-base)) cl-key)
- (if (keymapp cl-bind)
- (cl--map-keymap-recursively
- cl-func-rec cl-bind
- (vconcat cl-base (list 0)))
- (funcall cl-func-rec cl-base cl-bind))))
+ (lambda (cl-key cl-bind)
+ (aset cl-base (1- (length cl-base)) cl-key)
+ (if (keymapp cl-bind)
+ (cl--map-keymap-recursively
+ cl-func-rec cl-bind
+ (vconcat cl-base (list 0)))
+ (funcall cl-func-rec cl-base cl-bind)))
cl-map))
;;;###autoload
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 02da07daaf4..8e36dbe4a36 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -1,6 +1,6 @@
;;; cl-generic.el --- CLOS-style generic functions for Elisp -*- lexical-binding: t; -*-
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Version: 1.0
@@ -304,15 +304,6 @@ the specializer used will be the one returned by BODY."
(lambda ,args ,@body))))
(eval-and-compile ;Needed while compiling the cl-defmethod calls below!
- (defun cl--generic-fgrep (vars sexp) ;Copied from pcase.el.
- "Check which of the symbols VARS appear in SEXP."
- (let ((res '()))
- (while (consp sexp)
- (dolist (var (cl--generic-fgrep vars (pop sexp)))
- (unless (memq var res) (push var res))))
- (and (memq sexp vars) (not (memq sexp res)) (push sexp res))
- res))
-
(defun cl--generic-split-args (args)
"Return (SPEC-ARGS . PLAIN-ARGS)."
(let ((plain-args ())
@@ -375,11 +366,11 @@ the specializer used will be the one returned by BODY."
;; is used.
;; FIXME: Also, optimize the case where call-next-method is
;; only called with explicit arguments.
- (uses-cnm (cl--generic-fgrep (list cnm nmp) nbody)))
+ (uses-cnm (macroexp--fgrep `((,cnm) (,nmp)) nbody)))
(cons (not (not uses-cnm))
`#'(lambda (,@(if uses-cnm (list cnm)) ,@args)
,@(car parsed-body)
- ,(if (not (memq nmp uses-cnm))
+ ,(if (not (assq nmp uses-cnm))
nbody
`(let ((,nmp (lambda ()
(cl--generic-isnot-nnm-p ,cnm))))
@@ -410,8 +401,18 @@ the specializer used will be the one returned by BODY."
;;;###autoload
(defmacro cl-defmethod (name args &rest body)
"Define a new method for generic function NAME.
-I.e. it defines the implementation of NAME to use for invocations where the
-values of the dispatch arguments match the specified TYPEs.
+This it defines an implementation of NAME to use for invocations
+of specific types of arguments.
+
+ARGS is a list of dispatch arguments (see `cl-defun'), but where
+each variable element is either just a single variable name VAR,
+or a list on the form (VAR TYPE).
+
+For instance:
+
+ (cl-defmethod foo (bar (format-string string) &optional zot)
+ (format format-string bar))
+
The dispatch arguments have to be among the mandatory arguments, and
all methods of NAME have to use the same set of arguments for dispatch.
Each dispatch argument and TYPE are specified in ARGS where the corresponding
@@ -607,11 +608,11 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
(lambda (,@fixedargs &rest args)
(let ,bindings
(apply (cl--generic-with-memoization
- (gethash ,tag-exp method-cache)
- (cl--generic-cache-miss
- generic ',dispatch-arg dispatches-left methods
- ,(if (cdr typescodes)
- `(append ,@typescodes) (car typescodes))))
+ (gethash ,tag-exp method-cache)
+ (cl--generic-cache-miss
+ generic ',dispatch-arg dispatches-left methods
+ ,(if (cdr typescodes)
+ `(append ,@typescodes) (car typescodes))))
,@fixedargs args)))))))))
(defun cl--generic-make-function (generic)
@@ -801,8 +802,8 @@ It should return a function that expects the same arguments as the methods, and
GENERIC is the generic function (mostly used for its name).
METHODS is the list of the selected methods.
The METHODS list is sorted from most specific first to most generic last.
-The function can use `cl-generic-call-method' to create functions that call those
-methods.")
+The function can use `cl-generic-call-method' to create functions that call
+those methods.")
(unless (ignore-errors (cl-generic-generalizers t))
;; Temporary definition to let the next defmethod succeed.
@@ -1100,7 +1101,8 @@ These match if the argument is a cons cell whose car is `eql' to VAL."
(if (not (eq (car-safe specializer) 'head))
(cl-call-next-method)
(cl--generic-with-memoization
- (gethash (cadr specializer) cl--generic-head-used) specializer)
+ (gethash (cadr specializer) cl--generic-head-used)
+ specializer)
(list cl--generic-head-generalizer)))
(cl--generic-prefill-dispatchers 0 (head eql))
diff --git a/lisp/emacs-lisp/cl-indent.el b/lisp/emacs-lisp/cl-indent.el
index 66502da668a..7d0bfc88b15 100644
--- a/lisp/emacs-lisp/cl-indent.el
+++ b/lisp/emacs-lisp/cl-indent.el
@@ -1,6 +1,6 @@
;;; cl-indent.el --- Enhanced lisp-indent mode -*- lexical-binding:t -*-
-;; Copyright (C) 1987, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1987, 2000-2021 Free Software Foundation, Inc.
;; Author: Richard Mlynarik <mly@eddie.mit.edu>
;; Created: July 1987
diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
index 86ee94e87e0..3bf3fd21ded 100644
--- a/lisp/emacs-lisp/cl-lib.el
+++ b/lisp/emacs-lisp/cl-lib.el
@@ -1,6 +1,6 @@
;;; cl-lib.el --- Common Lisp extensions for Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 2001-2021 Free Software Foundation, Inc.
;; Author: Dave Gillespie <daveg@synaptics.com>
;; Version: 1.0
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 1501ed43082..c2bf02ccece 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -1,6 +1,6 @@
;;; cl-macs.el --- Common Lisp macros -*- lexical-binding: t -*-
-;; Copyright (C) 1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 2001-2021 Free Software Foundation, Inc.
;; Author: Dave Gillespie <daveg@synaptics.com>
;; Old-Version: 2.02
@@ -819,16 +819,15 @@ final clause, and matches if no other keys match.
(cons
'cond
(mapcar
- (function
- (lambda (c)
- (cons (cond ((eq (car c) 'otherwise) t)
- ((eq (car c) 'cl--ecase-error-flag)
- `(error "cl-etypecase failed: %s, %s"
- ,temp ',(reverse type-list)))
- (t
- (push (car c) type-list)
- `(cl-typep ,temp ',(car c))))
- (or (cdr c) '(nil)))))
+ (lambda (c)
+ (cons (cond ((eq (car c) 'otherwise) t)
+ ((eq (car c) 'cl--ecase-error-flag)
+ `(error "cl-etypecase failed: %s, %s"
+ ,temp ',(reverse type-list)))
+ (t
+ (push (car c) type-list)
+ `(cl-typep ,temp ',(car c))))
+ (or (cdr c) '(nil))))
clauses)))))
;;;###autoload
@@ -901,7 +900,8 @@ This is compatible with Common Lisp, but note that `defun' and
"The Common Lisp `loop' macro.
Valid clauses include:
For clauses:
- for VAR from/upfrom/downfrom EXPR1 to/upto/downto/above/below EXPR2 [by EXPR3]
+ for VAR from/upfrom/downfrom EXPR1 to/upto/downto/above/below EXPR2
+ [by EXPR3]
for VAR = EXPR1 then EXPR2
for VAR in/on/in-ref LIST [by FUNC]
for VAR across/across-ref ARRAY
@@ -2060,10 +2060,99 @@ Like `cl-flet' but the definitions can refer to previous ones.
((null (cdr bindings)) `(cl-flet ,bindings ,@body))
(t `(cl-flet (,(pop bindings)) (cl-flet* ,bindings ,@body)))))
+(defun cl--self-tco (var fargs body)
+ ;; This tries to "optimize" tail calls for the specific case
+ ;; of recursive self-calls by replacing them with a `while' loop.
+ ;; It is quite far from a general tail-call optimization, since it doesn't
+ ;; even handle mutually recursive functions.
+ (letrec
+ ((done nil) ;; Non-nil if some TCO happened.
+ (retvar (make-symbol "retval"))
+ (ofargs (mapcar (lambda (s) (if (memq s cl--lambda-list-keywords) s
+ (make-symbol (symbol-name s))))
+ fargs))
+ (opt-exps (lambda (exps) ;; `exps' is in tail position!
+ (append (butlast exps)
+ (list (funcall opt (car (last exps)))))))
+ (opt
+ (lambda (exp) ;; `exp' is in tail position!
+ (pcase exp
+ ;; FIXME: Optimize `apply'?
+ (`(funcall ,(pred (eq var)) . ,aargs)
+ ;; This is a self-recursive call in tail position.
+ (let ((sets nil)
+ (fargs ofargs))
+ (while fargs
+ (pcase (pop fargs)
+ ('&rest
+ (push (pop fargs) sets)
+ (push `(list . ,aargs) sets)
+ ;; (cl-assert (null fargs))
+ )
+ ('&optional nil)
+ (farg
+ (push farg sets)
+ (push (pop aargs) sets))))
+ (setq done t)
+ `(progn (setq . ,(nreverse sets))
+ :recurse)))
+ (`(progn . ,exps) `(progn . ,(funcall opt-exps exps)))
+ (`(if ,cond ,then . ,else)
+ `(if ,cond ,(funcall opt then) . ,(funcall opt-exps else)))
+ (`(cond . ,conds)
+ (let ((cs '()))
+ (while conds
+ (pcase (pop conds)
+ (`(,exp)
+ (push (if conds
+ ;; This returns the value of `exp' but it's
+ ;; only in tail position if it's the
+ ;; last condition.
+ `((setq ,retvar ,exp) nil)
+ `(,(funcall opt exp)))
+ cs))
+ (exps
+ (push (funcall opt-exps exps) cs))))
+ (if (eq t (caar cs))
+ `(cond . ,(nreverse cs))
+ `(cond ,@(nreverse cs) (t (setq ,retvar nil))))))
+ ((and `(,(or 'let 'let*) ,bindings . ,exps)
+ (guard
+ ;; Note: it's OK for this `let' to shadow any
+ ;; of the formal arguments since we will only
+ ;; setq the fresh new `ofargs' vars instead ;-)
+ (let ((shadowings
+ (mapcar (lambda (b) (if (consp b) (car b) b)) bindings)))
+ ;; If `var' is shadowed, then it clearly can't be
+ ;; tail-called any more.
+ (not (memq var shadowings)))))
+ `(,(car exp) ,bindings . ,(funcall opt-exps exps)))
+ (_
+ `(progn (setq ,retvar ,exp) nil))))))
+
+ (let ((optimized-body (funcall opt-exps body)))
+ (if (not done)
+ (cons fargs body)
+ ;; We use two sets of vars: `ofargs' and `fargs' because we need
+ ;; to be careful that if a closure captures a formal argument
+ ;; in one iteration, it needs to capture a different binding
+ ;; then that of other iterations, e.g.
+ (cons
+ ofargs
+ `((let (,retvar)
+ (while (let ,(delq nil
+ (cl-mapcar
+ (lambda (a oa)
+ (unless (memq a cl--lambda-list-keywords)
+ (list a oa)))
+ fargs ofargs))
+ . ,optimized-body))
+ ,retvar)))))))
+
;;;###autoload
(defmacro cl-labels (bindings &rest body)
- "Make local (recursive) function definitions.
-Each definition can take the form (FUNC ARGLIST BODY...) where
+ "Make local (recursive) function definitions.
++BINDINGS is a list of definitions of the form (FUNC ARGLIST BODY...) where
FUNC is the function name, ARGLIST its arguments, and BODY the
forms of the function body. FUNC is defined in any BODY, as well
as FORM, so you can write recursive and mutually recursive
@@ -2075,17 +2164,33 @@ details.
(let ((binds ()) (newenv macroexpand-all-environment))
(dolist (binding bindings)
(let ((var (make-symbol (format "--cl-%s--" (car binding)))))
- (push (list var `(cl-function (lambda . ,(cdr binding)))) binds)
+ (push (cons var (cdr binding)) binds)
(push (cons (car binding)
(lambda (&rest args)
(if (eq (car args) cl--labels-magic)
(list cl--labels-magic var)
(cl-list* 'funcall var args))))
newenv)))
- (macroexpand-all `(letrec ,(nreverse binds) ,@body)
- ;; Don't override lexical-let's macro-expander.
- (if (assq 'function newenv) newenv
- (cons (cons 'function #'cl--labels-convert) newenv)))))
+ ;; Don't override lexical-let's macro-expander.
+ (unless (assq 'function newenv)
+ (push (cons 'function #'cl--labels-convert) newenv))
+ ;; Perform self-tail call elimination.
+ (setq binds (mapcar
+ (lambda (bind)
+ (pcase-let*
+ ((`(,var ,sargs . ,sbody) bind)
+ (`(function (lambda ,fargs . ,ebody))
+ (macroexpand-all `(cl-function (lambda ,sargs . ,sbody))
+ newenv))
+ (`(,ofargs . ,obody)
+ (cl--self-tco var fargs ebody)))
+ `(,var (function (lambda ,ofargs . ,obody)))))
+ (nreverse binds)))
+ `(letrec ,binds
+ . ,(macroexp-unprogn
+ (macroexpand-all
+ (macroexp-progn body)
+ newenv)))))
;; The following ought to have a better definition for use with newer
;; byte compilers.
@@ -2699,7 +2804,7 @@ Each SLOT may instead take the form (SNAME SDEFAULT SOPTIONS...), where
SDEFAULT is the default value of that slot and SOPTIONS are keyword-value
pairs for that slot.
Supported keywords for slots are:
-- `:read-only': If this has a non-nil value, that slot cannot be set via `setf'.
+- `:read-only': If this has a non-nil value, that slot cannot be set via `setf'.
- `:documentation': this is a docstring describing the slot.
- `:type': the type of the field; currently only used for documentation.
@@ -2763,7 +2868,7 @@ Supported keywords for slots are:
(unless (cl--struct-name-p name)
(signal 'wrong-type-argument (list 'cl-struct-name-p name 'name)))
(setq descs (cons '(cl-tag-slot)
- (mapcar (function (lambda (x) (if (consp x) x (list x))))
+ (mapcar (lambda (x) (if (consp x) x (list x)))
descs)))
(while opts
(let ((opt (if (consp (car opts)) (caar opts) (car opts)))
@@ -2790,9 +2895,8 @@ Supported keywords for slots are:
;; we include EIEIO classes rather than cl-structs!
(when include-name (error "Can't :include more than once"))
(setq include-name (car args))
- (setq include-descs (mapcar (function
- (lambda (x)
- (if (consp x) x (list x))))
+ (setq include-descs (mapcar (lambda (x)
+ (if (consp x) x (list x)))
(cdr args))))
((eq opt :print-function)
(setq print-func (car args)))
@@ -3384,8 +3488,8 @@ macro that returns its `&whole' argument."
(put y 'side-effect-free t))
;;; Things that are inline.
-(cl-proclaim '(inline cl-acons cl-map cl-concatenate cl-notany
- cl-notevery cl-revappend cl-nreconc gethash))
+(cl-proclaim '(inline cl-acons cl-map cl-notany cl-notevery cl-revappend
+ cl-nreconc gethash))
;;; Things that are side-effect-free.
(mapc (lambda (x) (function-put x 'side-effect-free t))
diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el
index eed43c5ed38..7365e23186a 100644
--- a/lisp/emacs-lisp/cl-preloaded.el
+++ b/lisp/emacs-lisp/cl-preloaded.el
@@ -1,6 +1,6 @@
;;; cl-preloaded.el --- Preloaded part of the CL library -*- lexical-binding: t; -*-
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Package: emacs
diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el
index 1043cf7b175..348da59fd97 100644
--- a/lisp/emacs-lisp/cl-print.el
+++ b/lisp/emacs-lisp/cl-print.el
@@ -1,6 +1,6 @@
;;; cl-print.el --- CL-style generic printing -*- lexical-binding: t; -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords:
@@ -33,8 +33,6 @@
;;; Code:
-(require 'button)
-
(defvar cl-print-readably nil
"If non-nil, try and make sure the result can be `read'.")
diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el
index d34d50172df..329bd7c1b3b 100644
--- a/lisp/emacs-lisp/cl-seq.el
+++ b/lisp/emacs-lisp/cl-seq.el
@@ -1,6 +1,6 @@
;;; cl-seq.el --- Common Lisp features, part 3 -*- lexical-binding: t -*-
-;; Copyright (C) 1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 2001-2021 Free Software Foundation, Inc.
;; Author: Dave Gillespie <daveg@synaptics.com>
;; Old-Version: 2.02
@@ -69,10 +69,9 @@
(list 'or (list 'memq '(car cl-keys-temp)
(list 'quote
(mapcar
- (function
- (lambda (x)
- (if (consp x)
- (car x) x)))
+ (lambda (x)
+ (if (consp x)
+ (car x) x))
(append kwords
other-keys))))
'(car (cdr (memq (quote :allow-other-keys)
@@ -668,9 +667,9 @@ This is a destructive function; it reuses the storage of SEQ if possible.
(cl--parsing-keywords (:key) ()
(if (memq cl-key '(nil identity))
(sort cl-seq cl-pred)
- (sort cl-seq (function (lambda (cl-x cl-y)
- (funcall cl-pred (funcall cl-key cl-x)
- (funcall cl-key cl-y)))))))))
+ (sort cl-seq (lambda (cl-x cl-y)
+ (funcall cl-pred (funcall cl-key cl-x)
+ (funcall cl-key cl-y))))))))
;;;###autoload
(defun cl-stable-sort (cl-seq cl-pred &rest cl-keys)
diff --git a/lisp/emacs-lisp/copyright.el b/lisp/emacs-lisp/copyright.el
index 9828ca63ebc..a9baef39a9a 100644
--- a/lisp/emacs-lisp/copyright.el
+++ b/lisp/emacs-lisp/copyright.el
@@ -1,6 +1,6 @@
;;; copyright.el --- update the copyright notice in current buffer -*- lexical-binding: t -*-
-;; Copyright (C) 1991-1995, 1998, 2001-2020 Free Software Foundation,
+;; Copyright (C) 1991-1995, 1998, 2001-2021 Free Software Foundation,
;; Inc.
;; Author: Daniel Pfeiffer <occitan@esperanto.org>
@@ -256,7 +256,7 @@ interactively."
(match-string-no-properties 1)
copyright-current-gpl-version)))))
(replace-match copyright-current-gpl-version t t nil 1))))
- (set (make-local-variable 'copyright-update) nil)))
+ (setq-local copyright-update nil)))
;; If a write-file-hook returns non-nil, the file is presumed to be written.
nil))
diff --git a/lisp/emacs-lisp/crm.el b/lisp/emacs-lisp/crm.el
index 89d106ee489..eb3193c8213 100644
--- a/lisp/emacs-lisp/crm.el
+++ b/lisp/emacs-lisp/crm.el
@@ -1,6 +1,6 @@
;;; crm.el --- read multiple strings with completion
-;; Copyright (C) 1985-1986, 1993-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1986, 1993-2021 Free Software Foundation, Inc.
;; Author: Sen Nagata <sen@eccosys.com>
;; Keywords: completion, minibuffer, multiple elements
diff --git a/lisp/emacs-lisp/cursor-sensor.el b/lisp/emacs-lisp/cursor-sensor.el
index d50f7ad0be5..ffeddadd574 100644
--- a/lisp/emacs-lisp/cursor-sensor.el
+++ b/lisp/emacs-lisp/cursor-sensor.el
@@ -1,6 +1,6 @@
;;; cursor-sensor.el --- React to cursor movement -*- lexical-binding: t; -*-
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords:
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index 0e4135b253e..d9da0db4551 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -1,6 +1,6 @@
;;; debug.el --- debuggers and related commands for Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1986, 1994, 2001-2020 Free Software Foundation,
+;; Copyright (C) 1985-1986, 1994, 2001-2021 Free Software Foundation,
;; Inc.
;; Maintainer: emacs-devel@gnu.org
@@ -29,7 +29,6 @@
(require 'cl-lib)
(require 'backtrace)
-(require 'button)
(defgroup debugger nil
"Debuggers and related commands for Emacs."
diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el
index 6a11f1c3949..42528429aaf 100644
--- a/lisp/emacs-lisp/derived.el
+++ b/lisp/emacs-lisp/derived.el
@@ -1,7 +1,7 @@
;;; derived.el --- allow inheritance of major modes
;; (formerly mode-clone.el)
-;; Copyright (C) 1993-1994, 1999, 2001-2020 Free Software Foundation,
+;; Copyright (C) 1993-1994, 1999, 2001-2021 Free Software Foundation,
;; Inc.
;; Author: David Megginson (dmeggins@aix1.uottawa.ca)
@@ -306,11 +306,13 @@ No problems result if this variable is not bound.
;; Use a default docstring.
(setq docstring
(if (null parent)
- ;; FIXME filling.
- (format "Major-mode.\nUses keymap `%s'%s%s." map
- (if abbrev (format "%s abbrev table `%s'"
- (if syntax "," " and") abbrev) "")
- (if syntax (format " and syntax-table `%s'" syntax) ""))
+ (concat
+ "Major-mode.\n"
+ (internal--format-docstring-line
+ "Uses keymap `%s'%s%s." map
+ (if abbrev (format "%s abbrev table `%s'"
+ (if syntax "," " and") abbrev) "")
+ (if syntax (format " and syntax-table `%s'" syntax) "")))
(format "Major mode derived from `%s' by `define-derived-mode'.
It inherits all of the parent's attributes, but has its own keymap%s:
@@ -336,20 +338,22 @@ which more-or-less shadow%s %s's corresponding table%s."
(unless (string-match (regexp-quote (symbol-name hook)) docstring)
;; Make sure the docstring mentions the mode's hook.
(setq docstring
- (concat docstring
- (if (null parent)
- "\n\nThis mode "
- (concat
- "\n\nIn addition to any hooks its parent mode "
- (if (string-match (format "[`‘]%s['’]"
- (regexp-quote
- (symbol-name parent)))
- docstring)
- nil
- (format "`%s' " parent))
- "might have run,\nthis mode "))
- (format "runs the hook `%s'" hook)
- ", as the final or penultimate step\nduring initialization.")))
+ (concat docstring "\n\n"
+ (internal--format-docstring-line
+ "%s%s%s"
+ (if (null parent)
+ "This mode "
+ (concat
+ "In addition to any hooks its parent mode "
+ (if (string-match (format "[`‘]%s['’]"
+ (regexp-quote
+ (symbol-name parent)))
+ docstring)
+ nil
+ (format "`%s' " parent))
+ "might have run, this mode "))
+ (format "runs the hook `%s'" hook)
+ ", as the final or penultimate step during initialization."))))
(unless (string-match "\\\\[{[]" docstring)
;; And don't forget to put the mode's keymap.
diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el
index c2faac8085b..0d2890999a4 100644
--- a/lisp/emacs-lisp/disass.el
+++ b/lisp/emacs-lisp/disass.el
@@ -1,6 +1,6 @@
;;; disass.el --- disassembler for compiled Emacs Lisp code -*- lexical-binding:t -*-
-;; Copyright (C) 1986, 1991, 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1986, 1991, 2002-2021 Free Software Foundation, Inc.
;; Author: Doug Cutting <doug@csli.stanford.edu>
;; Jamie Zawinski <jwz@lucid.com>
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index 77f10e61c6c..f4dbcee4d69 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -1,6 +1,6 @@
;;; easy-mmode.el --- easy definition for major and minor modes -*- lexical-binding: t; -*-
-;; Copyright (C) 1997, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2000-2021 Free Software Foundation, Inc.
;; Author: Georges Brun-Cottan <Georges.Brun-Cottan@inria.fr>
;; Maintainer: Stefan Monnier <monnier@gnu.org>
@@ -90,7 +90,7 @@ the mode.
If called from Lisp, toggle the mode if ARG is `toggle'.
Enable the mode if ARG is nil, omitted, or is a positive number.
-All other values will disable the mode.
+Disable the mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when
it is disabled.")
@@ -278,8 +278,10 @@ For example, you could write
((not globalp)
`(progn
:autoload-end
- (defvar ,mode ,init-value ,(format "Non-nil if %s is enabled.
-Use the command `%s' to change this variable." pretty-name mode))
+ (defvar ,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)))
(t
(let ((base-doc-string
@@ -312,12 +314,10 @@ or call the function `%s'."))))
(cond ((eq arg 'toggle)
(not ,getter))
((and (numberp arg)
- (> arg 0))
- t)
- ((eq arg nil)
- t)
+ (< arg 1))
+ nil)
(t
- nil)))
+ t)))
,@body
;; The on/off hooks are here for backward compatibility only.
(run-hooks ',hook (if ,getter ',hook-on ',hook-off))
@@ -457,24 +457,23 @@ on if the hook has explicitly disabled it.
(make-variable-buffer-local ',MODE-major-mode))
;; The actual global minor-mode
(define-minor-mode ,global-mode
- ;; Very short lines to avoid too long lines in the generated
- ;; doc string.
- ,(format "Toggle %s in all buffers.
-With prefix ARG, enable %s if ARG is positive;
-otherwise, disable it. If called from Lisp, enable the mode if
-ARG is omitted or nil.
-
-%s is enabled in all buffers where
-`%s' would do it.
-
-See `%s' for more information on
-%s.%s"
- pretty-name pretty-global-name
- pretty-name turn-on mode pretty-name
+ ,(concat (format "Toggle %s in all buffers.\n" pretty-name)
+ (internal--format-docstring-line
+ "With prefix ARG, enable %s if ARG is positive; otherwise, \
+disable it. If called from Lisp, enable the mode if ARG is omitted or nil.\n\n"
+ pretty-global-name)
+ (internal--format-docstring-line
+ "%s is enabled in all buffers where `%s' would do it.\n\n"
+ pretty-name turn-on)
+ (internal--format-docstring-line
+ "See `%s' for more information on %s."
+ mode pretty-name)
(if predicate
- (format "\n\n`%s' is used to control which modes
-this minor mode is used in."
- MODE-predicate)
+ (concat
+ "\n\n"
+ (internal--format-docstring-line
+ "`%s' is used to control which modes this minor mode is used in."
+ MODE-predicate))
""))
:global t ,@group ,@(nreverse extra-keywords)
diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el
index 73dabef3fa5..5303da3746c 100644
--- a/lisp/emacs-lisp/easymenu.el
+++ b/lisp/emacs-lisp/easymenu.el
@@ -1,6 +1,6 @@
;;; easymenu.el --- support the easymenu interface for defining a menu -*- lexical-binding:t -*-
-;; Copyright (C) 1994, 1996, 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 1996, 1998-2021 Free Software Foundation, Inc.
;; Keywords: emulations
;; Author: Richard Stallman <rms@gnu.org>
@@ -488,17 +488,14 @@ To implement dynamic menus, either call this from
`menu-bar-update-hook' or use a menu filter."
(easy-menu-add-item map path (easy-menu-create-menu name items) before))
-;; XEmacs needs the following two functions to add and remove menus.
-;; In Emacs this is done automatically when switching keymaps, so
-;; here easy-menu-remove and easy-menu-add are a noops.
-(defalias 'easy-menu-remove 'ignore
+(define-obsolete-function-alias 'easy-menu-remove #'ignore "28.1"
"Remove MENU from the current menu bar.
Contrary to XEmacs, this is a nop on Emacs since menus are automatically
\(de)activated when the corresponding keymap is (de)activated.
\(fn MENU)")
-(defalias 'easy-menu-add #'ignore
+(define-obsolete-function-alias 'easy-menu-add #'ignore "28.1"
"Add the menu to the menubar.
On Emacs this is a nop, because menus are already automatically
activated when the corresponding keymap is activated. On XEmacs
@@ -514,6 +511,7 @@ completely and menu filter functions can be expected to work.
If BEFORE is non-nil, add before the item named BEFORE.
If IN-MENU is non-nil, follow MENU-PATH in IN-MENU.
This is a compatibility function; use `easy-menu-add-item'."
+ (declare (obsolete easy-menu-add-item "28.1"))
(easy-menu-add-item (or in-menu (current-global-map))
(cons "menu-bar" menu-path)
submenu before))
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index fe733630bad..1ded0e7b097 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -1,6 +1,6 @@
;;; edebug.el --- a source-level debugger for Emacs Lisp -*- lexical-binding: t -*-
-;; Copyright (C) 1988-1995, 1997, 1999-2020 Free Software Foundation,
+;; Copyright (C) 1988-1995, 1997, 1999-2021 Free Software Foundation,
;; Inc.
;; Author: Daniel LaLiberte <liberte@holonexus.org>
@@ -309,9 +309,8 @@ A lambda list keyword is a symbol that starts with `&'."
(defun edebug-sort-alist (alist function)
;; Return the ALIST sorted with comparison function FUNCTION.
;; This uses 'sort so the sorting is destructive.
- (sort alist (function
- (lambda (e1 e2)
- (funcall function (car e1) (car e2))))))
+ (sort alist (lambda (e1 e2)
+ (funcall function (car e1) (car e2)))))
;; Not used.
'(defmacro edebug-save-restriction (&rest body)
@@ -407,14 +406,13 @@ Return the result of the last expression in BODY."
(if (listp window-info)
(mapcar (lambda (one-window-info)
(if one-window-info
- (apply (function
- (lambda (window buffer point start hscroll)
- (if (edebug-window-live-p window)
- (progn
- (set-window-buffer window buffer)
- (set-window-point window point)
- (set-window-start window start)
- (set-window-hscroll window hscroll)))))
+ (apply (lambda (window buffer point start hscroll)
+ (if (edebug-window-live-p window)
+ (progn
+ (set-window-buffer window buffer)
+ (set-window-point window point)
+ (set-window-start window start)
+ (set-window-hscroll window hscroll))))
one-window-info)))
window-info)
(set-window-configuration window-info)))
@@ -594,7 +592,7 @@ already is one.)"
"A list of entries associating symbols with buffer regions.
Each entry is an `edebug--form-data' struct with fields:
SYMBOL, BEGIN-MARKER, and END-MARKER. The markers
-are at the beginning and end of an entry level form and SYMBOL is
+are at the beginning and end of an instrumented form and SYMBOL is
a symbol that holds all edebug related information for the form on its
property list.
@@ -4018,7 +4016,6 @@ Options:
`edebug-print-circle'
`edebug-on-error'
`edebug-on-quit'
-`edebug-on-signal'
`edebug-unwrap-results'
`edebug-global-break-condition'"
:lighter " *Debugging*"
diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el
index a484c2ff382..ec1077d447e 100644
--- a/lisp/emacs-lisp/eieio-base.el
+++ b/lisp/emacs-lisp/eieio-base.el
@@ -1,6 +1,6 @@
;;; eieio-base.el --- Base classes for EIEIO. -*- lexical-binding:t -*-
-;;; Copyright (C) 2000-2002, 2004-2005, 2007-2020 Free Software
+;;; Copyright (C) 2000-2002, 2004-2005, 2007-2021 Free Software
;;; Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -162,6 +162,59 @@ only one object ever exists."
old)))
+;;; Named object
+
+(defclass eieio-named ()
+ ((object-name :initarg :object-name :initform nil))
+ "Object with a name."
+ :abstract t)
+
+(cl-defmethod eieio-object-name-string ((obj eieio-named))
+ "Return a string which is OBJ's name."
+ (or (slot-value obj 'object-name)
+ (cl-call-next-method)))
+
+(cl-defgeneric eieio-object-set-name-string (obj name)
+ "Set the string which is OBJ's NAME."
+ (declare (obsolete "inherit from `eieio-named' and use (setf (slot-value OBJ \\='object-name) NAME) instead" "25.1"))
+ (cl-check-type name string)
+ (setf (gethash obj eieio--object-names) name))
+(define-obsolete-function-alias
+ 'object-set-name-string 'eieio-object-set-name-string "24.4")
+
+(with-suppressed-warnings ((obsolete eieio-object-set-name-string))
+ (cl-defmethod eieio-object-set-name-string ((obj eieio-named) name)
+ "Set the string which is OBJ's NAME."
+ (cl-check-type name string)
+ (eieio-oset obj 'object-name name)))
+
+(cl-defmethod clone ((obj eieio-named) &rest params)
+ "Clone OBJ, initializing `:parent' to OBJ.
+All slots are unbound, except those initialized with PARAMS."
+ (let* ((newname (and (stringp (car params)) (pop params)))
+ (nobj (apply #'cl-call-next-method obj params))
+ (nm (slot-value nobj 'object-name)))
+ (eieio-oset nobj 'object-name
+ (or newname
+ (if (equal nm (slot-value obj 'object-name))
+ (save-match-data
+ (if (and nm (string-match "-\\([0-9]+\\)" nm))
+ (let ((num (1+ (string-to-number
+ (match-string 1 nm)))))
+ (concat (substring nm 0 (match-beginning 0))
+ "-" (int-to-string num)))
+ (concat nm "-1")))
+ nm)))
+ nobj))
+
+(cl-defmethod make-instance ((class (subclass eieio-named)) &rest args)
+ (if (not (stringp (car args)))
+ (cl-call-next-method)
+ (funcall (if eieio-backward-compatibility #'ignore #'message)
+ "Obsolete: name passed without :object-name to %S constructor"
+ class)
+ (apply #'cl-call-next-method class :object-name args)))
+
;;; eieio-persistent
;;
;; For objects which must save themselves to disk. Provides an
@@ -264,12 +317,17 @@ objects found there."
(:method
((objclass (subclass eieio-default-superclass)) inputlist)
- (let ((slots (if (stringp (car inputlist))
- ;; Earlier versions of `object-write' added a
- ;; string name for the object, now obsolete.
- (cdr inputlist)
- inputlist))
- (createslots nil))
+ (let* ((name nil)
+ (slots (if (stringp (car inputlist))
+ (progn
+ ;; Earlier versions of `object-write' added a
+ ;; string name for the object, now obsolete.
+ ;; Save as 'name' in case this object is subclass
+ ;; of eieio-named with no :object-name slot specified.
+ (setq name (car inputlist))
+ (cdr inputlist))
+ inputlist))
+ (createslots nil))
;; If OBJCLASS is an eieio autoload object, then we need to
;; load it (we don't need the return value).
(eieio--full-class-object objclass)
@@ -286,7 +344,17 @@ objects found there."
(setq slots (cdr (cdr slots))))
- (apply #'make-instance objclass (nreverse createslots)))))
+ (let ((newobj (apply #'make-instance objclass (nreverse createslots))))
+
+ ;; Check for special case of subclass of `eieio-named', and do
+ ;; name assignment.
+ (when (and eieio-backward-compatibility
+ (object-of-class-p newobj 'eieio-named)
+ (not (oref newobj object-name))
+ name)
+ (oset newobj object-name name))
+
+ newobj))))
(defun eieio-persistent-fix-value (proposed-value)
"Fix PROPOSED-VALUE.
@@ -408,59 +476,6 @@ instance."
;; It should also set up some hooks to help it keep itself up to date.
-;;; Named object
-
-(defclass eieio-named ()
- ((object-name :initarg :object-name :initform nil))
- "Object with a name."
- :abstract t)
-
-(cl-defmethod eieio-object-name-string ((obj eieio-named))
- "Return a string which is OBJ's name."
- (or (slot-value obj 'object-name)
- (cl-call-next-method)))
-
-(cl-defgeneric eieio-object-set-name-string (obj name)
- "Set the string which is OBJ's NAME."
- (declare (obsolete "inherit from `eieio-named' and use (setf (slot-value OBJ \\='object-name) NAME) instead" "25.1"))
- (cl-check-type name string)
- (setf (gethash obj eieio--object-names) name))
-(define-obsolete-function-alias
- 'object-set-name-string 'eieio-object-set-name-string "24.4")
-
-(with-suppressed-warnings ((obsolete eieio-object-set-name-string))
- (cl-defmethod eieio-object-set-name-string ((obj eieio-named) name)
- "Set the string which is OBJ's NAME."
- (cl-check-type name string)
- (eieio-oset obj 'object-name name)))
-
-(cl-defmethod clone ((obj eieio-named) &rest params)
- "Clone OBJ, initializing `:parent' to OBJ.
-All slots are unbound, except those initialized with PARAMS."
- (let* ((newname (and (stringp (car params)) (pop params)))
- (nobj (apply #'cl-call-next-method obj params))
- (nm (slot-value nobj 'object-name)))
- (eieio-oset nobj 'object-name
- (or newname
- (if (equal nm (slot-value obj 'object-name))
- (save-match-data
- (if (and nm (string-match "-\\([0-9]+\\)" nm))
- (let ((num (1+ (string-to-number
- (match-string 1 nm)))))
- (concat (substring nm 0 (match-beginning 0))
- "-" (int-to-string num)))
- (concat nm "-1")))
- nm)))
- nobj))
-
-(cl-defmethod make-instance ((class (subclass eieio-named)) &rest args)
- (if (not (stringp (car args)))
- (cl-call-next-method)
- (funcall (if eieio-backward-compatibility #'ignore #'message)
- "Obsolete: name passed without :object-name to %S constructor"
- class)
- (apply #'cl-call-next-method class :object-name args)))
-
(provide 'eieio-base)
diff --git a/lisp/emacs-lisp/eieio-compat.el b/lisp/emacs-lisp/eieio-compat.el
index 2a896f06b6b..db97d4ca4e8 100644
--- a/lisp/emacs-lisp/eieio-compat.el
+++ b/lisp/emacs-lisp/eieio-compat.el
@@ -1,6 +1,6 @@
;;; eieio-compat.el --- Compatibility with Older EIEIO versions -*- lexical-binding:t -*-
-;; Copyright (C) 1995-1996, 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995-1996, 1998-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: OO, lisp
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index 3bc65d0d4c5..a8361c0d4b4 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -1,6 +1,6 @@
;;; eieio-core.el --- Core implementation for eieio -*- lexical-binding:t -*-
-;; Copyright (C) 1995-1996, 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995-1996, 1998-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Version: 1.4
@@ -215,7 +215,8 @@ It creates an autoload function for CNAME's constructor."
;; turn this into a usable self-pointing symbol
(when eieio-backward-compatibility
(set cname cname)
- (make-obsolete-variable cname (format "use \\='%s instead" cname)
+ (make-obsolete-variable cname (format "\
+use \\='%s or turn off `eieio-backward-compatibility' instead" cname)
"25.1"))
(setf (cl--find-class cname) newc)
@@ -587,8 +588,8 @@ If SKIPNIL is non-nil, then if default value is nil return t instead."
(defun eieio--add-new-slot (newc slot init alloc
&optional defaultoverride skipnil)
"Add into NEWC attribute SLOT.
-If a slot of that name already exists in NEWC, then do nothing. If it doesn't exist,
-INIT is the initarg, if any.
+If a slot of that name already exists in NEWC, then do nothing.
+If it doesn't exist, INIT is the initarg, if any.
Argument ALLOC specifies if the slot is allocated per instance, or per class.
If optional DEFAULTOVERRIDE is non-nil, then if A exists in NEWC,
we must override its value for a default.
diff --git a/lisp/emacs-lisp/eieio-custom.el b/lisp/emacs-lisp/eieio-custom.el
index e26dc9e9a9c..184b99fdac6 100644
--- a/lisp/emacs-lisp/eieio-custom.el
+++ b/lisp/emacs-lisp/eieio-custom.el
@@ -1,6 +1,6 @@
;;; eieio-custom.el -- eieio object customization -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2001, 2005, 2007-2020 Free Software Foundation,
+;; Copyright (C) 1999-2001, 2005, 2007-2021 Free Software Foundation,
;; Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -33,7 +33,6 @@
(require 'eieio)
(require 'widget)
(require 'wid-edit)
-(require 'custom)
;;; Compatibility
@@ -366,8 +365,7 @@ These groups are specified with the `:group' slot flag."
(widget-insert "\n\n")
(widget-insert "Edit object " (eieio-object-name obj) "\n\n")
;; Create the widget editing the object.
- (make-local-variable 'eieio-wo)
- (setq eieio-wo (eieio-custom-widget-insert obj :eieio-group g))
+ (setq-local eieio-wo (eieio-custom-widget-insert obj :eieio-group g))
;;Now generate the apply buttons
(widget-insert "\n")
(eieio-custom-object-apply-reset obj)
@@ -376,10 +374,8 @@ These groups are specified with the `:group' slot flag."
;;(widget-minor-mode)
(goto-char (point-min))
(widget-forward 3)
- (make-local-variable 'eieio-co)
- (setq eieio-co obj)
- (make-local-variable 'eieio-cog)
- (setq eieio-cog g)))
+ (setq-local eieio-co obj)
+ (setq-local eieio-cog g)))
(cl-defmethod eieio-custom-object-apply-reset ((_obj eieio-default-superclass))
"Insert an Apply and Reset button into the object editor.
diff --git a/lisp/emacs-lisp/eieio-datadebug.el b/lisp/emacs-lisp/eieio-datadebug.el
index 94b289be597..9e89ce89179 100644
--- a/lisp/emacs-lisp/eieio-datadebug.el
+++ b/lisp/emacs-lisp/eieio-datadebug.el
@@ -1,6 +1,6 @@
;;; eieio-datadebug.el --- EIEIO extensions to the data debugger. -*- lexical-binding:t -*-
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: OO, lisp
diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el
index 59af7e12d21..edf4d34b649 100644
--- a/lisp/emacs-lisp/eieio-opt.el
+++ b/lisp/emacs-lisp/eieio-opt.el
@@ -1,6 +1,6 @@
;;; eieio-opt.el -- eieio optional functions (debug, printing, speedbar)
-;; Copyright (C) 1996, 1998-2003, 2005, 2008-2020 Free Software
+;; Copyright (C) 1996, 1998-2003, 2005, 2008-2021 Free Software
;; Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -136,9 +136,9 @@ are not abstract."
(def (symbol-function ctr)))
(goto-char (point-min))
(prin1 ctr)
- (insert (format " is an %s object constructor function"
+ (insert (format " is an %sobject constructor function"
(if (autoloadp def)
- "autoloaded"
+ "autoloaded "
"")))
(when (and (autoloadp def)
(null location))
diff --git a/lisp/emacs-lisp/eieio-speedbar.el b/lisp/emacs-lisp/eieio-speedbar.el
index 5c6e0e516d1..8bf77e20dfa 100644
--- a/lisp/emacs-lisp/eieio-speedbar.el
+++ b/lisp/emacs-lisp/eieio-speedbar.el
@@ -1,6 +1,6 @@
;;; eieio-speedbar.el -- Classes for managing speedbar displays. -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2002, 2005, 2007-2020 Free Software Foundation,
+;; Copyright (C) 1999-2002, 2005, 2007-2021 Free Software Foundation,
;; Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 810affa7227..a095ad0f6db 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -1,7 +1,7 @@
;;; eieio.el --- Enhanced Implementation of Emacs Interpreted Objects -*- lexical-binding:t -*-
;;; or maybe Eric's Implementation of Emacs Interpreted Objects
-;; Copyright (C) 1995-1996, 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995-1996, 1998-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Version: 1.4
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index 78cb8f08c34..90e075b1102 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -1,6 +1,6 @@
;;; eldoc.el --- Show function arglist or variable docstring in echo area -*- lexical-binding:t; -*-
-;; Copyright (C) 1996-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
;; Author: Noah Friedman <friedman@splode.com>
;; Keywords: extensions
@@ -467,7 +467,6 @@ This holds the results of the last documentation request."
(defun eldoc--format-doc-buffer (docs)
"Ensure DOCS are displayed in an *eldoc* buffer."
- (interactive (list t))
(with-current-buffer (if (buffer-live-p eldoc--doc-buffer)
eldoc--doc-buffer
(setq eldoc--doc-buffer
@@ -591,7 +590,8 @@ Honor `eldoc-echo-area-use-multiline-p' and
;; format the *eldoc* buffer, using as most of its
;; contents as we know will fit.
(with-current-buffer (eldoc--format-doc-buffer docs)
- (eldoc--echo-area-substring available)))
+ (save-excursion
+ (eldoc--echo-area-substring available))))
(t ;; this is the "truncate brutally" situation
(let ((string
(with-current-buffer (eldoc--format-doc-buffer docs)
@@ -867,11 +867,7 @@ the docstrings eventually produced, using
eldoc--last-request-state))
(let ((non-essential t))
(setq eldoc--last-request-state token)
- ;; Only keep looking for the info as long as the user hasn't
- ;; requested our attention. This also locally disables
- ;; inhibit-quit.
- (while-no-input
- (eldoc--invoke-strategy nil)))))))
+ (eldoc--invoke-strategy nil))))))
;; This section only affects ElDoc output to the echo area, as in
diff --git a/lisp/emacs-lisp/elint.el b/lisp/emacs-lisp/elint.el
index e2cffedd45f..0fba5938f3d 100644
--- a/lisp/emacs-lisp/elint.el
+++ b/lisp/emacs-lisp/elint.el
@@ -1,6 +1,6 @@
;;; elint.el --- Lint Emacs Lisp -*- lexical-binding: t -*-
-;; Copyright (C) 1997, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
;; Author: Peter Liljenberg <petli@lysator.liu.se>
;; Created: May 1997
@@ -355,15 +355,14 @@ Returns the forms."
;; Env is up to date
elint-buffer-forms
;; Remake env
- (set (make-local-variable 'elint-buffer-forms) (elint-get-top-forms))
- (set (make-local-variable 'elint-features) nil)
- (set (make-local-variable 'elint-buffer-env)
- (elint-init-env elint-buffer-forms))
+ (setq-local elint-buffer-forms (elint-get-top-forms))
+ (setq-local elint-features nil)
+ (setq-local elint-buffer-env (elint-init-env elint-buffer-forms))
(if elint-preloaded-env
;; FIXME: This doesn't do anything! Should we setq the result to
;; elint-buffer-env?
(elint-env-add-env elint-preloaded-env elint-buffer-env))
- (set (make-local-variable 'elint-last-env-time) (buffer-modified-tick))
+ (setq-local elint-last-env-time (buffer-modified-tick))
elint-buffer-forms))
(defun elint-get-top-forms ()
@@ -456,8 +455,8 @@ Return nil if there are no more forms, t otherwise."
(= 4 (length form))
(eq (car-safe (cadr form)) 'quote)
(equal (nth 2 form) '(quote error-conditions)))
- (set (make-local-variable 'elint-extra-errors)
- (cons (cadr (cadr form)) elint-extra-errors)))
+ (setq-local elint-extra-errors
+ (cons (cadr (cadr form)) elint-extra-errors)))
((eq (car form) 'provide)
(add-to-list 'elint-features (eval (cadr form))))
;; Import variable definitions
@@ -522,7 +521,7 @@ Return nil if there are no more forms, t otherwise."
"The currently linted top form, or nil.")
(defvar elint-top-form-logged nil
- "The value t if the currently linted top form has been mentioned in the log buffer.")
+ "Non-nil if the currently linted top form has been mentioned in the log buffer.")
(defun elint-top-form (form)
"Lint a top FORM."
@@ -559,7 +558,8 @@ Return nil if there are no more forms, t otherwise."
(when . elint-check-conditional-form)
(unless . elint-check-conditional-form)
(and . elint-check-conditional-form)
- (or . elint-check-conditional-form))
+ (or . elint-check-conditional-form)
+ (require . elint-require-form))
"Functions to call when some special form should be linted.")
(defun elint-form (form env &optional nohandler)
@@ -954,6 +954,13 @@ Does basic handling of `featurep' tests."
(elint-form form env t))))
env)
+(defun elint-require-form (form _env)
+ "Load `require'd files."
+ (pcase form
+ (`(require ',x)
+ (require x)))
+ nil)
+
;;;
;;; Message functions
;;;
diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el
index a94978ac47b..f551c0c36c3 100644
--- a/lisp/emacs-lisp/elp.el
+++ b/lisp/emacs-lisp/elp.el
@@ -1,6 +1,6 @@
;;; elp.el --- Emacs Lisp Profiler -*- lexical-binding: t -*-
-;; Copyright (C) 1994-1995, 1997-1998, 2001-2020 Free Software
+;; Copyright (C) 1994-1995, 1997-1998, 2001-2021 Free Software
;; Foundation, Inc.
;; Author: Barry A. Warsaw
diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el
index abbff6da625..d058d3dda0b 100644
--- a/lisp/emacs-lisp/ert-x.el
+++ b/lisp/emacs-lisp/ert-x.el
@@ -1,6 +1,6 @@
;;; ert-x.el --- Staging area for experimental extensions to ERT -*- lexical-binding: t -*-
-;; Copyright (C) 2008, 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008, 2010-2021 Free Software Foundation, Inc.
;; Author: Lennart Borgman (lennart O borgman A gmail O com)
;; Christian Ohler <ohler@gnu.org>
@@ -363,18 +363,19 @@ convert it to a string and pass it to COLLECTOR first."
;; Has to be a macro for `load-file-name'.
(defmacro ert-resource-directory ()
- "Return absolute file name of the resource directory for this file.
+ "Return absolute file name of the resource (test data) directory.
The path to the resource directory is the \"resources\" directory
-in the same directory as the test file.
-
-If that directory doesn't exist, use the directory named like the
-test file but formatted by `ert-resource-directory-format' and trimmed
-using `string-trim' with arguments
+in the same directory as the test file this is called from.
+
+If that directory doesn't exist, find a directory based on the
+test file name. If the file is named \"foo-tests.el\", return
+the absolute file name for \"foo-resources\". If you want a
+different resource directory naming scheme, set the variable
+`ert-resource-directory-format'. Before formatting, the file
+name will be trimmed using `string-trim' with arguments
`ert-resource-directory-trim-left-regexp' and
-`ert-resource-directory-trim-right-regexp'. The default values mean
-that if called from a test file named \"foo-tests.el\", return
-the absolute file name for \"foo-resources\"."
+`ert-resource-directory-trim-right-regexp'."
`(let* ((testfile ,(or (bound-and-true-p byte-compile-current-file)
(and load-in-progress load-file-name)
buffer-file-name))
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index baa04f2c6af..fdbf95319ff 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -1,6 +1,6 @@
;;; ert.el --- Emacs Lisp Regression Testing -*- lexical-binding: t -*-
-;; Copyright (C) 2007-2008, 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2008, 2010-2021 Free Software Foundation, Inc.
;; Author: Christian Ohler <ohler@gnu.org>
;; Keywords: lisp, tools
@@ -58,13 +58,11 @@
;;; Code:
(require 'cl-lib)
-(require 'button)
(require 'debug)
(require 'backtrace)
(require 'easymenu)
(require 'ewoc)
(require 'find-func)
-(require 'help)
(require 'pp)
;;; UI customization options.
@@ -276,7 +274,7 @@ DATA is displayed to the user and should state the reason for skipping."
It should only be stopped when ran from inside ert--run-test-internal."
(when (and (not (symbolp debugger)) ; only run on anonymous debugger
(memq error-symbol '(ert-test-failed ert-test-skipped)))
- (funcall debugger 'error data)))
+ (funcall debugger 'error (list error-symbol data))))
(defun ert--special-operator-p (thing)
"Return non-nil if THING is a symbol naming a special operator."
@@ -489,7 +487,7 @@ Errors during evaluation are caught and handled like nil."
Returns nil if they are."
(if (not (eq (type-of a) (type-of b)))
`(different-types ,a ,b)
- (pcase-exhaustive a
+ (pcase a
((pred consp)
(let ((a-length (proper-list-p a))
(b-length (proper-list-p b)))
@@ -540,7 +538,7 @@ Returns nil if they are."
for xi = (ert--explain-equal-rec ai bi)
do (when xi (cl-return `(array-elt ,i ,xi)))
finally (cl-assert (equal a b) t))))
- ((pred atom)
+ (_
(if (not (equal a b))
(if (and (symbolp a) (symbolp b) (string= a b))
`(different-symbols-with-the-same-name ,a ,b)
@@ -1804,8 +1802,8 @@ Also sets `ert--results-progress-bar-button-begin'."
;; `progress-bar-button-begin' will be the right position
;; even in the results buffer.
(with-current-buffer results-buffer
- (set (make-local-variable 'ert--results-progress-bar-button-begin)
- progress-bar-button-begin))))
+ (setq-local ert--results-progress-bar-button-begin
+ progress-bar-button-begin))))
(insert "\n\n")
(buffer-string))
;; footer
@@ -1981,15 +1979,15 @@ BUFFER-NAME, if non-nil, is the buffer name to use."
;; from ert-results-mode to ert-results-mode when
;; font-lock-mode turns itself off in change-major-mode-hook.)
(erase-buffer)
- (set (make-local-variable 'font-lock-function)
- 'ert--results-font-lock-function)
+ (setq-local font-lock-function
+ 'ert--results-font-lock-function)
(let ((ewoc (ewoc-create 'ert--print-test-for-ewoc nil nil t)))
- (set (make-local-variable 'ert--results-ewoc) ewoc)
- (set (make-local-variable 'ert--results-stats) stats)
- (set (make-local-variable 'ert--results-progress-bar-string)
- (make-string (ert-stats-total stats)
- (ert-char-for-test-result nil t)))
- (set (make-local-variable 'ert--results-listener) listener)
+ (setq-local ert--results-ewoc ewoc)
+ (setq-local ert--results-stats stats)
+ (setq-local ert--results-progress-bar-string
+ (make-string (ert-stats-total stats)
+ (ert-char-for-test-result nil t)))
+ (setq-local ert--results-listener listener)
(cl-loop for test across (ert--stats-tests stats) do
(ewoc-enter-last ewoc
(make-ert--ewoc-entry :test test
diff --git a/lisp/emacs-lisp/ewoc.el b/lisp/emacs-lisp/ewoc.el
index 5112322cfd6..d3ace97945f 100644
--- a/lisp/emacs-lisp/ewoc.el
+++ b/lisp/emacs-lisp/ewoc.el
@@ -1,6 +1,6 @@
;;; ewoc.el --- utility to maintain a view of a list of objects in a buffer -*- lexical-binding: t -*-
-;; Copyright (C) 1991-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1991-2021 Free Software Foundation, Inc.
;; Author: Per Cederqvist <ceder@lysator.liu.se>
;; Inge Wallin <inge@lysator.liu.se>
diff --git a/lisp/emacs-lisp/faceup.el b/lisp/emacs-lisp/faceup.el
index 9900136dc1a..6c3931f9829 100644
--- a/lisp/emacs-lisp/faceup.el
+++ b/lisp/emacs-lisp/faceup.el
@@ -1,6 +1,6 @@
;;; faceup.el --- Markup language for faces and font-lock regression testing -*- lexical-binding: t -*-
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; Author: Anders Lindgren
;; Version: 0.0.6
diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el
index ee94e1fbff7..c399a682f70 100644
--- a/lisp/emacs-lisp/find-func.el
+++ b/lisp/emacs-lisp/find-func.el
@@ -1,6 +1,6 @@
;;; find-func.el --- find the definition of the Emacs Lisp function near point -*- lexical-binding:t -*-
-;; Copyright (C) 1997, 1999, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1999, 2001-2021 Free Software Foundation, Inc.
;; Author: Jens Petersen <petersen@kurims.kyoto-u.ac.jp>
;; Keywords: emacs-lisp, functions, variables
@@ -103,7 +103,7 @@ Please send improvements and fixes to the maintainer."
(defcustom find-feature-regexp
(concat ";;; Code:")
- "The regexp used by `xref-find-definitions' when searching for a feature definition.
+ "Regexp used by `xref-find-definitions' when searching for a feature definition.
Note it may contain up to one `%s' at the place where `format'
should insert the feature name."
;; We search for ";;; Code" rather than (feature '%s) because the
@@ -389,7 +389,70 @@ The search is done in the source for library LIBRARY."
(progn
(beginning-of-line)
(cons (current-buffer) (point)))
- (cons (current-buffer) nil)))))))))
+ ;; If the regexp search didn't find the location of
+ ;; the symbol (for example, because it is generated by
+ ;; a macro), try a slightly more expensive search that
+ ;; expands macros until it finds the symbol.
+ (cons (current-buffer)
+ (find-function--search-by-expanding-macros
+ (current-buffer) symbol type))))))))))
+
+(defun find-function--try-macroexpand (form)
+ "Try to macroexpand FORM in full or partially.
+This is a best-effort operation in which if macroexpansion fails,
+this function returns FORM as is."
+ (ignore-errors
+ (or
+ (macroexpand-all form)
+ (macroexpand-1 form)
+ form)))
+
+(defun find-function--any-subform-p (form pred)
+ "Walk FORM and apply PRED to its subexpressions.
+Return t if any PRED returns t."
+ (cond
+ ((not (consp form)) nil)
+ ((funcall pred form) t)
+ (t
+ (cl-destructuring-bind (left-child . right-child) form
+ (or
+ (find-function--any-subform-p left-child pred)
+ (find-function--any-subform-p right-child pred))))))
+
+(defun find-function--search-by-expanding-macros (buf symbol type)
+ "Expand macros in BUF to search for the definition of SYMBOL of TYPE."
+ (catch 'found
+ (with-current-buffer buf
+ (save-excursion
+ (goto-char (point-min))
+ (condition-case nil
+ (while t
+ (let ((form (read (current-buffer)))
+ (expected-symbol-p
+ (lambda (form)
+ (cond
+ ((null type)
+ ;; Check if a given form is a `defalias' to
+ ;; SYM, the function name we are searching
+ ;; for. All functions in Emacs Lisp
+ ;; ultimately expand to a `defalias' form
+ ;; after several steps of macroexpansion.
+ (and (eq (car-safe form) 'defalias)
+ (equal (car-safe (cdr form))
+ `(quote ,symbol))))
+ ((eq type 'defvar)
+ ;; Variables generated by macros ultimately
+ ;; expand to `defvar'.
+ (and (eq (car-safe form) 'defvar)
+ (eq (car-safe (cdr form)) symbol)))
+ (t nil)))))
+ (when (find-function--any-subform-p
+ (find-function--try-macroexpand form)
+ expected-symbol-p)
+ ;; We want to return the location at the beginning
+ ;; of the macro, so move back one sexp.
+ (throw 'found (progn (backward-sexp) (point))))))
+ (end-of-file nil))))))
(defun find-function-library (function &optional lisp-only verbose)
"Return the pair (ORIG-FUNCTION . LIBRARY) for FUNCTION.
diff --git a/lisp/emacs-lisp/float-sup.el b/lisp/emacs-lisp/float-sup.el
index d92ca5b9337..4256bd59584 100644
--- a/lisp/emacs-lisp/float-sup.el
+++ b/lisp/emacs-lisp/float-sup.el
@@ -1,6 +1,6 @@
;;; float-sup.el --- define some constants useful for floating point numbers. -*- lexical-binding:t -*-
-;; Copyright (C) 1985-1987, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1987, 2001-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
diff --git a/lisp/emacs-lisp/generator.el b/lisp/emacs-lisp/generator.el
index c95c758a571..9eb6d959645 100644
--- a/lisp/emacs-lisp/generator.el
+++ b/lisp/emacs-lisp/generator.el
@@ -1,6 +1,6 @@
;;; generator.el --- generators -*- lexical-binding: t -*-
-;;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Author: Daniel Colascione <dancol@dancol.org>
;; Keywords: extensions, elisp
diff --git a/lisp/emacs-lisp/generic.el b/lisp/emacs-lisp/generic.el
index 3bc6d021dc8..93f780eac2f 100644
--- a/lisp/emacs-lisp/generic.el
+++ b/lisp/emacs-lisp/generic.el
@@ -1,6 +1,6 @@
;;; generic.el --- defining simple major modes with comment and font-lock
;;
-;; Copyright (C) 1997, 1999, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1999, 2001-2021 Free Software Foundation, Inc.
;;
;; Author: Peter Breton <pbreton@cs.umb.edu>
;; Created: Fri Sep 27 1996
diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el
index 5470b8532fc..29f8230e6b8 100644
--- a/lisp/emacs-lisp/gv.el
+++ b/lisp/emacs-lisp/gv.el
@@ -1,6 +1,6 @@
;;; gv.el --- generalized variables -*- lexical-binding: t -*-
-;; Copyright (C) 2012-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: extensions
@@ -504,6 +504,11 @@ The return value is the last VAL in the list.
(funcall do `(funcall (car ,gv))
(lambda (v) `(funcall (cdr ,gv) ,v))))))))
+(put 'error 'gv-expander
+ (lambda (do &rest args)
+ (funcall do `(error . ,args)
+ (lambda (v) `(progn ,v (error . ,args))))))
+
(defmacro gv-synthetic-place (getter setter)
"Special place described by its setter and getter.
GETTER and SETTER (typically obtained via `gv-letplace') get and
diff --git a/lisp/emacs-lisp/helper.el b/lisp/emacs-lisp/helper.el
index a2f6fdef6a8..737f3ec2f33 100644
--- a/lisp/emacs-lisp/helper.el
+++ b/lisp/emacs-lisp/helper.el
@@ -1,6 +1,6 @@
;;; helper.el --- utility help package supporting help in electric modes
-;; Copyright (C) 1985, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 2001-2021 Free Software Foundation, Inc.
;; Author: K. Shane Hartman
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/emacs-lisp/hierarchy.el b/lisp/emacs-lisp/hierarchy.el
index 8cef029c4cf..7466fc85df1 100644
--- a/lisp/emacs-lisp/hierarchy.el
+++ b/lisp/emacs-lisp/hierarchy.el
@@ -1,6 +1,6 @@
;;; hierarchy.el --- Library to create and display hierarchy structures -*- lexical-binding: t; -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; Author: Damien Cassou <damien@cassou.me>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/emacs-lisp/inline.el b/lisp/emacs-lisp/inline.el
index 082587111fd..d6106fe35d0 100644
--- a/lisp/emacs-lisp/inline.el
+++ b/lisp/emacs-lisp/inline.el
@@ -1,6 +1,6 @@
;;; inline.el --- Define functions by their inliner -*- lexical-binding:t; -*-
-;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2021 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
diff --git a/lisp/emacs-lisp/let-alist.el b/lisp/emacs-lisp/let-alist.el
index 867ff85a1d9..433b37d7923 100644
--- a/lisp/emacs-lisp/let-alist.el
+++ b/lisp/emacs-lisp/let-alist.el
@@ -1,6 +1,6 @@
;;; let-alist.el --- Easily let-bind values of an assoc-list by their names -*- lexical-binding: t; -*-
-;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2021 Free Software Foundation, Inc.
;; Author: Artur Malabarba <emacs@endlessparentheses.com>
;; Package-Requires: ((emacs "24.1"))
diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el
index 0d57bc16a3a..adb9cb2372c 100644
--- a/lisp/emacs-lisp/lisp-mnt.el
+++ b/lisp/emacs-lisp/lisp-mnt.el
@@ -1,6 +1,6 @@
;;; lisp-mnt.el --- utility functions for Emacs Lisp maintainers -*- lexical-binding:t -*-
-;; Copyright (C) 1992, 1994, 1997, 2000-2020 Free Software Foundation,
+;; Copyright (C) 1992, 1994, 1997, 2000-2021 Free Software Foundation,
;; Inc.
;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
@@ -208,6 +208,7 @@ a section."
(when start
(save-excursion
(goto-char start)
+ (looking-at outline-regexp)
(let ((level (lisp-outline-level))
(case-fold-search t)
next-section-found)
@@ -218,6 +219,7 @@ a section."
nil t))
(> (save-excursion
(beginning-of-line)
+ (looking-at outline-regexp)
(lisp-outline-level))
level)))
(min (if next-section-found
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 352210f859d..8780c5dcd30 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -1,6 +1,6 @@
;;; lisp-mode.el --- Lisp mode, and its idiosyncratic commands -*- lexical-binding:t -*-
-;; Copyright (C) 1985-1986, 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1986, 1999-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: lisp, languages
@@ -38,7 +38,7 @@
(define-abbrev-table 'lisp-mode-abbrev-table ()
"Abbrev table for Lisp mode.")
-(defvar lisp--mode-syntax-table
+(defvar lisp-data-mode-syntax-table
(let ((table (make-syntax-table))
(i 0))
(while (< i ?0)
@@ -77,11 +77,13 @@
(modify-syntax-entry ?\\ "\\ " table)
(modify-syntax-entry ?\( "() " table)
(modify-syntax-entry ?\) ")( " table)
+ (modify-syntax-entry ?\[ "(]" table)
+ (modify-syntax-entry ?\] ")[" table)
table)
"Parent syntax table used in Lisp modes.")
(defvar lisp-mode-syntax-table
- (let ((table (make-syntax-table lisp--mode-syntax-table)))
+ (let ((table (make-syntax-table lisp-data-mode-syntax-table)))
(modify-syntax-entry ?\[ "_ " table)
(modify-syntax-entry ?\] "_ " table)
(modify-syntax-entry ?# "' 14" table)
@@ -178,13 +180,16 @@
(defun lisp--match-hidden-arg (limit)
(let ((res nil))
+ (forward-line 0)
(while
- (let ((ppss (parse-partial-sexp (line-beginning-position)
+ (let ((ppss (parse-partial-sexp (point)
(line-end-position)
-1)))
(skip-syntax-forward " )")
(if (or (>= (car ppss) 0)
- (looking-at ";\\|$"))
+ (eolp)
+ (looking-at ";")
+ (nth 8 (syntax-ppss))) ;Within a string or comment.
(progn
(forward-line 1)
(< (point) limit))
@@ -451,8 +456,7 @@ This will generate compile-time constants from BINDINGS."
("\\(\\\\\\)\\([^\"\\]\\)"
(1 (elisp--font-lock-backslash) prepend))
;; Words inside ‘’ and `' tend to be symbol names.
- (,(concat "[`‘]\\(\\(?:\\sw\\|\\s_\\|\\\\.\\)"
- lisp-mode-symbol-regexp "\\)['’]")
+ (,(concat "[`‘]\\(" lisp-mode-symbol-regexp "\\)['’]")
(1 font-lock-constant-face prepend))
;; Constant values.
(,(concat "\\_<:" lisp-mode-symbol-regexp "\\_>")
@@ -478,7 +482,8 @@ This will generate compile-time constants from BINDINGS."
(3 'font-lock-regexp-grouping-construct prepend))
(lisp--match-hidden-arg
(0 '(face font-lock-warning-face
- help-echo "Hidden behind deeper element; move to another line?")))
+ help-echo "Easy to misread; consider moving the element to the next line")
+ prepend))
(lisp--match-confusable-symbol-character
0 '(face font-lock-warning-face
help-echo "Confusable character"))
@@ -501,8 +506,7 @@ This will generate compile-time constants from BINDINGS."
(,(concat "(" cl-errs-re "\\_>")
(1 font-lock-warning-face))
;; Words inside ‘’ and `' tend to be symbol names.
- (,(concat "[`‘]\\(\\(?:\\sw\\|\\s_\\|\\\\.\\)"
- lisp-mode-symbol-regexp "\\)['’]")
+ (,(concat "[`‘]\\(" lisp-mode-symbol-regexp "\\)['’]")
(1 font-lock-constant-face prepend))
;; Uninterned symbols, e.g., (defpackage #:my-package ...)
;; must come before keywords below to have effect
@@ -522,7 +526,8 @@ This will generate compile-time constants from BINDINGS."
(1 font-lock-keyword-face))
(lisp--match-hidden-arg
(0 '(face font-lock-warning-face
- help-echo "Hidden behind deeper element; move to another line?")))
+ help-echo "Easy to misread; consider moving the element to the next line")
+ prepend))
))
"Gaudy level highlighting for Lisp modes.")))
@@ -629,7 +634,7 @@ font-lock keywords will not be case sensitive."
;; and should make no difference for explicit fill
;; because lisp-fill-paragraph should do the job.
;; I believe that newcomment's auto-fill code properly deals with it -stef
- ;;(set (make-local-variable 'adaptive-fill-mode) nil)
+ ;;(setq-local adaptive-fill-mode nil)
(setq-local indent-line-function 'lisp-indent-line)
(setq-local indent-region-function 'lisp-indent-region)
(setq-local comment-indent-function #'lisp-comment-indent)
@@ -664,7 +669,7 @@ font-lock keywords will not be case sensitive."
(define-derived-mode lisp-data-mode prog-mode "Lisp-Data"
"Major mode for buffers holding data written in Lisp syntax."
:group 'lisp
- (lisp-mode-variables t t nil)
+ (lisp-mode-variables nil t nil)
(setq-local electric-quote-string t)
(setq imenu-case-fold-search nil))
diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el
index 35590123ee6..46ca94869c7 100644
--- a/lisp/emacs-lisp/lisp.el
+++ b/lisp/emacs-lisp/lisp.el
@@ -1,6 +1,6 @@
;;; lisp.el --- Lisp editing commands for Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1985-1986, 1994, 2000-2020 Free Software Foundation,
+;; Copyright (C) 1985-1986, 1994, 2000-2021 Free Software Foundation,
;; Inc.
;; Maintainer: emacs-devel@gnu.org
@@ -784,9 +784,17 @@ This command assumes point is not in a string or comment."
(interactive "P")
(insert-pair arg ?\( ?\)))
+(defcustom delete-pair-blink-delay blink-matching-delay
+ "Time in seconds to delay after showing a paired character to delete.
+It's used by the command `delete-pair'. The value 0 disables blinking."
+ :type 'number
+ :group 'lisp
+ :version "28.1")
+
(defun delete-pair (&optional arg)
"Delete a pair of characters enclosing ARG sexps that follow point.
-A negative ARG deletes a pair around the preceding ARG sexps instead."
+A negative ARG deletes a pair around the preceding ARG sexps instead.
+The option `delete-pair-blink-delay' can disable blinking."
(interactive "P")
(if arg
(setq arg (prefix-numeric-value arg))
@@ -802,6 +810,9 @@ A negative ARG deletes a pair around the preceding ARG sexps instead."
(if (= (length p) 3) (cdr p) p))
insert-pair-alist))
(error "Not after matching pair"))
+ (when (and (numberp delete-pair-blink-delay)
+ (> delete-pair-blink-delay 0))
+ (sit-for delete-pair-blink-delay))
(delete-char 1)))
(delete-char -1))
(save-excursion
@@ -814,6 +825,9 @@ A negative ARG deletes a pair around the preceding ARG sexps instead."
(if (= (length p) 3) (cdr p) p))
insert-pair-alist))
(error "Not before matching pair"))
+ (when (and (numberp delete-pair-blink-delay)
+ (> delete-pair-blink-delay 0))
+ (sit-for delete-pair-blink-delay))
(delete-char -1)))
(delete-char 1))))
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index 88825fcd58f..37844977f8f 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -1,6 +1,6 @@
;;; macroexp.el --- Additional macro-expansion support -*- lexical-binding: t -*-
;;
-;; Copyright (C) 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;;
;; Author: Miles Bader <miles@gnu.org>
;; Keywords: lisp, compiler, macros
@@ -480,6 +480,35 @@ itself or not."
v
(list 'quote v)))
+(defun macroexp--fgrep (bindings sexp)
+ "Return those of the BINDINGS which might be used in SEXP.
+It is used as a poor-man's \"free variables\" test. It differs from a true
+test of free variables in the following ways:
+- It does not distinguish variables from functions, so it can be used
+ both to detect whether a given variable is used by SEXP and to
+ detect whether a given function is used by SEXP.
+- It does not actually know ELisp syntax, so it only looks for the presence
+ of symbols in SEXP and can't distinguish if those symbols are truly
+ references to the given variable (or function). That can make the result
+ include bindings which actually aren't used.
+- For the same reason it may cause the result to fail to include bindings
+ which will be used if SEXP is not yet fully macro-expanded and the
+ use of the binding will only be revealed by macro expansion."
+ (let ((res '()))
+ (while (and (consp sexp) bindings)
+ (dolist (binding (macroexp--fgrep bindings (pop sexp)))
+ (push binding res)
+ (setq bindings (remove binding bindings))))
+ (if (or (vectorp sexp) (byte-code-function-p sexp))
+ ;; With backquote, code can appear within vectors as well.
+ ;; This wouldn't be needed if we `macroexpand-all' before
+ ;; calling macroexp--fgrep, OTOH.
+ (macroexp--fgrep bindings (mapcar #'identity sexp))
+ (let ((tmp (assq sexp bindings)))
+ (if tmp
+ (cons tmp res)
+ res)))))
+
;;; Load-time macro-expansion.
;; Because macro-expansion used to be more lazy, eager macro-expansion
diff --git a/lisp/emacs-lisp/map-ynp.el b/lisp/emacs-lisp/map-ynp.el
index c35db7ae9cb..14112a1c147 100644
--- a/lisp/emacs-lisp/map-ynp.el
+++ b/lisp/emacs-lisp/map-ynp.el
@@ -1,6 +1,6 @@
;;; map-ynp.el --- general-purpose boolean question-asker -*- lexical-binding:t -*-
-;; Copyright (C) 1991-1995, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1991-1995, 2000-2021 Free Software Foundation, Inc.
;; Author: Roland McGrath <roland@gnu.org>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el
index 9c23344baca..46a1bd21a3d 100644
--- a/lisp/emacs-lisp/map.el
+++ b/lisp/emacs-lisp/map.el
@@ -1,6 +1,6 @@
;;; map.el --- Map manipulation functions -*- lexical-binding: t; -*-
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Author: Nicolas Petton <nicolas@petton.fr>
;; Keywords: convenience, map, hash-table, alist, array
diff --git a/lisp/emacs-lisp/memory-report.el b/lisp/emacs-lisp/memory-report.el
new file mode 100644
index 00000000000..3d6ca957e63
--- /dev/null
+++ b/lisp/emacs-lisp/memory-report.el
@@ -0,0 +1,317 @@
+;;; memory-report.el --- Short function summaries -*- lexical-binding: t -*-
+
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
+
+;; Keywords: lisp, help
+
+;; 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:
+
+;; Todo (possibly): Font cache, regexp cache, bidi cache, various
+;; buffer caches (newline cache, free_region_cache, etc), composition
+;; cache, face cache.
+
+;;; Code:
+
+(require 'seq)
+(require 'subr-x)
+(eval-when-compile (require 'cl-lib))
+
+(defvar memory-report--type-size (make-hash-table))
+
+;;;###autoload
+(defun memory-report ()
+ "Generate a report of how Emacs is using memory.
+
+This report is approximate, and will commonly over-count memory
+usage by variables, because shared data structures will usually
+by counted more than once."
+ (interactive)
+ (pop-to-buffer "*Memory Report*")
+ (special-mode)
+ (button-mode 1)
+ (setq truncate-lines t)
+ (message "Gathering data...")
+ (let ((reports (append (memory-report--garbage-collect)
+ (memory-report--image-cache)
+ (memory-report--symbol-plist)
+ (memory-report--buffers)
+ (memory-report--largest-variables)))
+ (inhibit-read-only t)
+ summaries details)
+ (message "Gathering data...done")
+ (erase-buffer)
+ (insert (propertize "Estimated Emacs Memory Usage\n\n" 'face 'bold))
+ (dolist (report reports)
+ (if (listp report)
+ (push report summaries)
+ (push report details)))
+ (dolist (summary (seq-sort (lambda (e1 e2)
+ (> (cdr e1) (cdr e2)))
+ summaries))
+ (insert (format "%s %s\n"
+ (memory-report--format (cdr summary))
+ (car summary))))
+ (insert "\n")
+ (dolist (detail (nreverse details))
+ (insert detail "\n")))
+ (goto-char (point-min)))
+
+(defun memory-report-object-size (object)
+ "Return the size of OBJECT in bytes."
+ (unless memory-report--type-size
+ (memory-report--garbage-collect))
+ (memory-report--object-size (make-hash-table :test #'eq) object))
+
+(defun memory-report--size (type)
+ (or (gethash type memory-report--type-size)
+ (gethash 'object memory-report--type-size)))
+
+(defun memory-report--set-size (elems)
+ (setf (gethash 'string memory-report--type-size)
+ (cadr (assq 'strings elems)))
+ (setf (gethash 'cons memory-report--type-size)
+ (cadr (assq 'conses elems)))
+ (setf (gethash 'symbol memory-report--type-size)
+ (cadr (assq 'symbols elems)))
+ (setf (gethash 'object memory-report--type-size)
+ (cadr (assq 'vectors elems)))
+ (setf (gethash 'float memory-report--type-size)
+ (cadr (assq 'floats elems)))
+ (setf (gethash 'buffer memory-report--type-size)
+ (cadr (assq 'buffers elems))))
+
+(defun memory-report--garbage-collect ()
+ (let ((elems (garbage-collect)))
+ (memory-report--set-size elems)
+ (let ((data (list
+ (list 'strings
+ (+ (memory-report--gc-elem elems 'strings)
+ (memory-report--gc-elem elems 'string-bytes)))
+ (list 'vectors
+ (+ (memory-report--gc-elem elems 'vectors)
+ (memory-report--gc-elem elems 'vector-slots)))
+ (list 'floats (memory-report--gc-elem elems 'floats))
+ (list 'conses (memory-report--gc-elem elems 'conses))
+ (list 'symbols (memory-report--gc-elem elems 'symbols))
+ (list 'intervals (memory-report--gc-elem elems 'intervals))
+ (list 'buffer-objects
+ (memory-report--gc-elem elems 'buffers)))))
+ (list (cons "Overall Object Memory Usage"
+ (seq-reduce #'+ (mapcar (lambda (elem)
+ (* (nth 1 elem) (nth 2 elem)))
+ elems)
+ 0))
+ (cons "Reserved (But Unused) Object Memory"
+ (seq-reduce #'+ (mapcar (lambda (elem)
+ (if (nth 3 elem)
+ (* (nth 1 elem) (nth 3 elem))
+ 0))
+ elems)
+ 0))
+ (with-temp-buffer
+ (insert (propertize "Object Storage\n\n" 'face 'bold))
+ (dolist (object (seq-sort (lambda (e1 e2)
+ (> (cadr e1) (cadr e2)))
+ data))
+ (insert (format "%s %s\n"
+ (memory-report--format (cadr object))
+ (capitalize (symbol-name (car object))))))
+ (buffer-string))))))
+
+(defun memory-report--largest-variables ()
+ (let ((variables nil))
+ (mapatoms
+ (lambda (symbol)
+ (when (boundp symbol)
+ (let ((size (memory-report--object-size
+ (make-hash-table :test #'eq)
+ (symbol-value symbol))))
+ (when (> size 1000)
+ (push (cons symbol size) variables)))))
+ obarray)
+ (list
+ (cons (propertize "Memory Used By Global Variables"
+ 'help-echo "Upper bound; mutually overlapping data from different variables are counted several times")
+ (seq-reduce #'+ (mapcar #'cdr variables) 0))
+ (with-temp-buffer
+ (insert (propertize "Largest Variables\n\n" 'face 'bold))
+ (cl-loop for i from 1 upto 20
+ for (symbol . size) in (seq-sort (lambda (e1 e2)
+ (> (cdr e1) (cdr e2)))
+ variables)
+ do (insert (memory-report--format size)
+ " "
+ (symbol-name symbol)
+ "\n"))
+ (buffer-string)))))
+
+(defun memory-report--symbol-plist ()
+ (let ((counted (make-hash-table :test #'eq))
+ (total 0))
+ (mapatoms
+ (lambda (symbol)
+ (cl-incf total (memory-report--object-size
+ counted (symbol-plist symbol))))
+ obarray)
+ (list
+ (cons "Memory Used By Symbol Plists" total))))
+
+(defun memory-report--object-size (counted value)
+ (if (gethash value counted)
+ 0
+ (setf (gethash value counted) t)
+ (memory-report--object-size-1 counted value)))
+
+(cl-defgeneric memory-report--object-size-1 (_counted _value)
+ 0)
+
+(cl-defmethod memory-report--object-size-1 (_ (value symbol))
+ ;; Don't count global symbols -- makes sizes of lists of symbols too
+ ;; heavey.
+ (if (intern-soft value obarray)
+ 0
+ (memory-report--size 'symbol)))
+
+(cl-defmethod memory-report--object-size-1 (_ (_value buffer))
+ (memory-report--size 'buffer))
+
+(cl-defmethod memory-report--object-size-1 (counted (value string))
+ (+ (memory-report--size 'string)
+ (string-bytes value)
+ (memory-report--interval-size counted (object-intervals value))))
+
+(defun memory-report--interval-size (counted intervals)
+ ;; We get a list back of intervals, but only count the "inner list"
+ ;; (i.e., the actual text properties), and add the size of the
+ ;; intervals themselves.
+ (+ (* (memory-report--size 'interval) (length intervals))
+ (seq-reduce #'+ (mapcar
+ (lambda (interval)
+ (memory-report--object-size counted (nth 2 interval)))
+ intervals)
+ 0)))
+
+(cl-defmethod memory-report--object-size-1 (counted (value list))
+ (let ((total 0)
+ (size (memory-report--size 'cons)))
+ (while value
+ (cl-incf total size)
+ (setf (gethash value counted) t)
+ (when (car value)
+ (cl-incf total (memory-report--object-size counted (car value))))
+ (if (cdr value)
+ (if (consp (cdr value))
+ (if (gethash (cdr value) counted)
+ (setq value nil)
+ (setq value (cdr value)))
+ (cl-incf total (memory-report--object-size counted (cdr value)))
+ (setq value nil))
+ (setq value nil)))
+ total))
+
+(cl-defmethod memory-report--object-size-1 (counted (value vector))
+ (let ((total (+ (memory-report--size 'vector)
+ (* (memory-report--size 'object) (length value)))))
+ (cl-loop for elem across value
+ do (setf (gethash elem counted) t)
+ (cl-incf total (memory-report--object-size counted elem)))
+ total))
+
+(cl-defmethod memory-report--object-size-1 (counted (value hash-table))
+ (let ((total (+ (memory-report--size 'vector)
+ (* (memory-report--size 'object) (hash-table-size value)))))
+ (maphash
+ (lambda (key elem)
+ (setf (gethash key counted) t)
+ (setf (gethash elem counted) t)
+ (cl-incf total (memory-report--object-size counted key))
+ (cl-incf total (memory-report--object-size counted elem)))
+ value)
+ total))
+
+(defun memory-report--format (bytes)
+ (setq bytes (/ bytes 1024.0))
+ (let ((units '("KiB" "MiB" "GiB" "TiB")))
+ (while (>= bytes 1024)
+ (setq bytes (/ bytes 1024.0))
+ (setq units (cdr units)))
+ (format "%6.1f %s" bytes (car units))))
+
+(defun memory-report--gc-elem (elems type)
+ (* (nth 1 (assq type elems))
+ (nth 2 (assq type elems))))
+
+(defun memory-report--buffers ()
+ (let ((buffers (mapcar (lambda (buffer)
+ (cons buffer (memory-report--buffer buffer)))
+ (buffer-list))))
+ (list (cons "Total Buffer Memory Usage"
+ (seq-reduce #'+ (mapcar #'cdr buffers) 0))
+ (with-temp-buffer
+ (insert (propertize "Largest Buffers\n\n" 'face 'bold))
+ (cl-loop for i from 1 upto 20
+ for (buffer . size) in (seq-sort (lambda (e1 e2)
+ (> (cdr e1) (cdr e2)))
+ buffers)
+ do (insert (memory-report--format size)
+ " "
+ (button-buttonize
+ (buffer-name buffer)
+ #'memory-report--buffer-details buffer)
+ "\n"))
+ (buffer-string)))))
+
+(defun memory-report--buffer-details (buffer)
+ (with-current-buffer buffer
+ (apply
+ #'message
+ "Buffer text: %s; variables: %s; text properties: %s; overlays: %s"
+ (mapcar #'string-trim (mapcar #'memory-report--format
+ (memory-report--buffer-data buffer))))))
+
+(defun memory-report--buffer (buffer)
+ (seq-reduce #'+ (memory-report--buffer-data buffer) 0))
+
+(defun memory-report--buffer-data (buffer)
+ (with-current-buffer buffer
+ (list (save-restriction
+ (widen)
+ (+ (position-bytes (point-max))
+ (- (position-bytes (point-min)))
+ (gap-size)))
+ (seq-reduce #'+ (mapcar (lambda (elem)
+ (if (cdr elem)
+ (memory-report--object-size
+ (make-hash-table :test #'eq)
+ (cdr elem))
+ 0))
+ (buffer-local-variables buffer))
+ 0)
+ (memory-report--object-size (make-hash-table :test #'eq)
+ (object-intervals buffer))
+ (memory-report--object-size (make-hash-table :test #'eq)
+ (overlay-lists)))))
+
+(defun memory-report--image-cache ()
+ (list (cons "Total Image Cache Size" (if (fboundp 'image-cache-size)
+ (image-cache-size)
+ 0))))
+
+(provide 'memory-report)
+
+;;; memory-report.el ends here
diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el
index b779aa27888..afdd372d273 100644
--- a/lisp/emacs-lisp/nadvice.el
+++ b/lisp/emacs-lisp/nadvice.el
@@ -1,6 +1,6 @@
;;; nadvice.el --- Light-weight advice primitives for Elisp functions -*- lexical-binding: t -*-
-;; Copyright (C) 2012-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: extensions, lisp, tools
diff --git a/lisp/emacs-lisp/package-x.el b/lisp/emacs-lisp/package-x.el
index c01b6efd4ef..8a0853ce445 100644
--- a/lisp/emacs-lisp/package-x.el
+++ b/lisp/emacs-lisp/package-x.el
@@ -1,6 +1,6 @@
;;; package-x.el --- Package extras
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Tom Tromey <tromey@redhat.com>
;; Created: 10 Mar 2007
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index a87f2e0f25a..ffde396e94a 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -1,6 +1,6 @@
;;; package.el --- Simple package system for Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Tom Tromey <tromey@redhat.com>
;; Daniel Hackney <dan@haxney.org>
@@ -173,12 +173,12 @@ with \"-q\").
Even if the value is nil, you can type \\[package-initialize] to
make installed packages available at any time, or you can
-call (package-initialize) in your init-file."
+call (package-activate-all) in your init-file."
:type 'boolean
:version "24.1")
(defcustom package-load-list '(all)
- "List of packages for `package-initialize' to make available.
+ "List of packages for `package-activate-all' to make available.
Each element in this list should be a list (NAME VERSION), or the
symbol `all'. The symbol `all' says to make available the latest
installed versions of all packages not specified by other
@@ -203,6 +203,9 @@ If VERSION is nil, the package is not made available (it is \"disabled\")."
(defcustom package-archives `(("gnu" .
,(format "http%s://elpa.gnu.org/packages/"
+ (if (gnutls-available-p) "s" "")))
+ ("nongnu" .
+ ,(format "http%s://elpa.nongnu.org/nongnu/"
(if (gnutls-available-p) "s" ""))))
"An alist of archives from which to fetch.
The default value points to the GNU Emacs package repository.
@@ -289,15 +292,18 @@ the package will be unavailable."
:risky t
:version "24.4")
+;;;###autoload
(defcustom package-user-dir (locate-user-emacs-file "elpa")
"Directory containing the user's Emacs Lisp packages.
The directory name should be absolute.
Apart from this directory, Emacs also looks for system-wide
packages in `package-directory-list'."
:type 'directory
+ :initialize #'custom-initialize-delay
:risky t
:version "24.1")
+;;;###autoload
(defcustom package-directory-list
;; Defaults are subdirs named "elpa" in the site-lisp dirs.
(let (result)
@@ -313,6 +319,7 @@ Each directory name should be absolute.
These directories contain packages intended for system-wide; in
contrast, `package-user-dir' contains packages for personal use."
:type '(repeat directory)
+ :initialize #'custom-initialize-delay
:risky t
:version "24.1")
@@ -585,9 +592,8 @@ package."
;;; Installed packages
;; The following variables store information about packages present in
;; the system. The most important of these is `package-alist'. The
-;; command `package-initialize' is also closely related to this
-;; section, but it is left for a later section because it also affects
-;; other stuff.
+;; command `package-activate-all' is also closely related to this
+;; section.
(defvar package--builtins nil
"Alist of built-in packages.
@@ -606,7 +612,7 @@ name (a symbol) and DESCS is a non-empty list of `package-desc'
structures, sorted by decreasing versions.
This variable is set automatically by `package-load-descriptor',
-called via `package-initialize'. To change which packages are
+called via `package-activate-all'. To change which packages are
loaded and/or activated, customize `package-load-list'.")
(put 'package-alist 'risky-local-variable t)
@@ -826,42 +832,61 @@ correspond to previously loaded files (those returned by
(declare-function find-library-name "find-func" (library))
+(defun package--files-load-history ()
+ (delq nil
+ (mapcar (lambda (x)
+ (let ((f (car x)))
+ (and (stringp f)
+ (file-name-sans-extension (file-truename f)))))
+ load-history)))
+
+(defun package--list-of-conflicts (dir history)
+ (delq
+ nil
+ (mapcar
+ (lambda (x) (let* ((file (file-relative-name x dir))
+ ;; Previously loaded file, if any.
+ (previous
+ (ignore-errors
+ (file-name-sans-extension
+ (file-truename (find-library-name file)))))
+ (pos (when previous (member previous history))))
+ ;; Return (RELATIVE-FILENAME . HISTORY-POSITION)
+ (when pos
+ (cons (file-name-sans-extension file) (length pos)))))
+ (directory-files-recursively dir "\\`[^\\.].*\\.el\\'"))))
+
(defun package--list-loaded-files (dir)
"Recursively list all files in DIR which correspond to loaded features.
Returns the `file-name-sans-extension' of each file, relative to
DIR, sorted by most recently loaded last."
- (let* ((history (delq nil
- (mapcar (lambda (x)
- (let ((f (car x)))
- (and (stringp f)
- (file-name-sans-extension f))))
- load-history)))
+ (let* ((history (package--files-load-history))
(dir (file-truename dir))
;; List all files that have already been loaded.
- (list-of-conflicts
- (delq
- nil
- (mapcar
- (lambda (x) (let* ((file (file-relative-name x dir))
- ;; Previously loaded file, if any.
- (previous
- (ignore-errors
- (file-name-sans-extension
- (file-truename (find-library-name file)))))
- (pos (when previous (member previous history))))
- ;; Return (RELATIVE-FILENAME . HISTORY-POSITION)
- (when pos
- (cons (file-name-sans-extension file) (length pos)))))
- (directory-files-recursively dir "\\`[^\\.].*\\.el\\'")))))
+ (list-of-conflicts (package--list-of-conflicts dir history)))
;; Turn the list of (FILENAME . POS) back into a list of features. Files in
;; subdirectories are returned relative to DIR (so not actually features).
(let ((default-directory (file-name-as-directory dir)))
(mapcar (lambda (x) (file-truename (car x)))
- (sort list-of-conflicts
- ;; Sort the files by ascending HISTORY-POSITION.
- (lambda (x y) (< (cdr x) (cdr y))))))))
+ (sort list-of-conflicts
+ ;; Sort the files by ascending HISTORY-POSITION.
+ (lambda (x y) (< (cdr x) (cdr y))))))))
;;;; `package-activate'
+
+(defun package--get-activatable-pkg (pkg-name)
+ ;; Is "activatable" a word?
+ (let ((pkg-descs (cdr (assq pkg-name package-alist))))
+ ;; Check if PACKAGE is available in `package-alist'.
+ (while
+ (when pkg-descs
+ (let ((available-version (package-desc-version (car pkg-descs))))
+ (or (package-disabled-p pkg-name available-version)
+ ;; Prefer a builtin package.
+ (package-built-in-p pkg-name available-version))))
+ (setq pkg-descs (cdr pkg-descs)))
+ (car pkg-descs)))
+
;; This function activates a newer version of a package if an older
;; one was already activated. It also loads a features of this
;; package which were already loaded.
@@ -869,24 +894,16 @@ DIR, sorted by most recently loaded last."
"Activate the package named PACKAGE.
If FORCE is true, (re-)activate it if it's already activated.
Newer versions are always activated, regardless of FORCE."
- (let ((pkg-descs (cdr (assq package package-alist))))
- ;; Check if PACKAGE is available in `package-alist'.
- (while
- (when pkg-descs
- (let ((available-version (package-desc-version (car pkg-descs))))
- (or (package-disabled-p package available-version)
- ;; Prefer a builtin package.
- (package-built-in-p package available-version))))
- (setq pkg-descs (cdr pkg-descs)))
+ (let ((pkg-desc (package--get-activatable-pkg package)))
(cond
;; If no such package is found, maybe it's built-in.
- ((null pkg-descs)
+ ((null pkg-desc)
(package-built-in-p package))
;; If the package is already activated, just return t.
((and (memq package package-activated-list) (not force))
t)
;; Otherwise, proceed with activation.
- (t (package-activate-1 (car pkg-descs) nil 'deps)))))
+ (t (package-activate-1 pkg-desc nil 'deps)))))
;;; Installation -- Local operations
@@ -983,7 +1000,8 @@ untar into a directory named DIR; otherwise, signal an error."
(write-region
(concat
";;; Generated package description from "
- (replace-regexp-in-string "-pkg\\.el\\'" ".el" pkg-file)
+ (replace-regexp-in-string "-pkg\\.el\\'" ".el"
+ (file-name-nondirectory pkg-file))
" -*- no-byte-compile: t -*-\n"
(prin1-to-string
(nconc
@@ -1115,14 +1133,15 @@ boundaries."
;; Use some headers we've invented to drive the process.
(let* (;; Prefer Package-Version; if defined, the package author
;; probably wants us to use it. Otherwise try Version.
- (pkg-version
- (or (package-strip-rcs-id (lm-header "package-version"))
- (package-strip-rcs-id (lm-header "version"))))
+ (version-info
+ (or (lm-header "package-version") (lm-header "version")))
+ (pkg-version (package-strip-rcs-id version-info))
(keywords (lm-keywords-list))
(homepage (lm-homepage)))
(unless pkg-version
- (error
- "Package lacks a \"Version\" or \"Package-Version\" header"))
+ (if version-info
+ (error "Unrecognized package version: %s" version-info)
+ (error "Package lacks a \"Version\" or \"Package-Version\" header")))
(package-desc-from-define
file-name pkg-version desc
(and-let* ((require-lines (lm-header-multiline "package-requires")))
@@ -1607,25 +1626,34 @@ that code in the early init-file."
;; `package--initialized' is t.
(package--build-compatibility-table))
-(defvar package-quickstart-file)
-
;;;###autoload
+(progn ;; Make the function usable without loading `package.el'.
(defun package-activate-all ()
"Activate all installed packages.
The variable `package-load-list' controls which packages to load."
(setq package--activated t)
- (if (file-readable-p package-quickstart-file)
- ;; Skip load-source-file-function which would slow us down by a factor
- ;; 2 (this assumes we were careful to save this file so it doesn't need
- ;; any decoding).
- (let ((load-source-file-function nil))
- (load package-quickstart-file nil 'nomessage))
- (dolist (elt (package--alist))
- (condition-case err
- (package-activate (car elt))
- ;; Don't let failure of activation of a package arbitrarily stop
- ;; activation of further packages.
- (error (message "%s" (error-message-string err)))))))
+ (let* ((elc (concat package-quickstart-file "c"))
+ (qs (if (file-readable-p elc) elc
+ (if (file-readable-p package-quickstart-file)
+ package-quickstart-file))))
+ (if qs
+ ;; Skip load-source-file-function which would slow us down by a factor
+ ;; 2 when loading the .el file (this assumes we were careful to
+ ;; save this file so it doesn't need any decoding).
+ (let ((load-source-file-function nil))
+ (unless (boundp 'package-activated-list)
+ (setq package-activated-list nil))
+ (load qs nil 'nomessage))
+ (require 'package)
+ (package--activate-all)))))
+
+(defun package--activate-all ()
+ (dolist (elt (package--alist))
+ (condition-case err
+ (package-activate (car elt))
+ ;; Don't let failure of activation of a package arbitrarily stop
+ ;; activation of further packages.
+ (error (message "%s" (error-message-string err))))))
;;;; Populating `package-archive-contents' from archives
;; This subsection populates the variables listed above from the
@@ -2053,6 +2081,13 @@ PACKAGES are satisfied, i.e. that PACKAGES is computed
using `package-compute-transaction'."
(mapc #'package-install-from-archive packages))
+(defun package--archives-initialize ()
+ "Make sure the list of installed and remote packages are initialized."
+ (unless package--initialized
+ (package-initialize t))
+ (unless package-archive-contents
+ (package-refresh-contents)))
+
;;;###autoload
(defun package-install (pkg &optional dont-select)
"Install the package PKG.
@@ -2073,10 +2108,7 @@ to install it but still mark it as selected."
(progn
;; Initialize the package system to get the list of package
;; symbols for completion.
- (unless package--initialized
- (package-initialize t))
- (unless package-archive-contents
- (package-refresh-contents))
+ (package--archives-initialize)
(list (intern (completing-read
"Install package: "
(delq nil
@@ -2086,6 +2118,7 @@ to install it but still mark it as selected."
package-archive-contents))
nil t))
nil)))
+ (package--archives-initialize)
(add-hook 'post-command-hook #'package-menu--post-refresh)
(let ((name (if (package-desc-p pkg)
(package-desc-name pkg)
@@ -2112,8 +2145,10 @@ Otherwise return nil."
(when str
(when (string-match "\\`[ \t]*[$]Revision:[ \t]+" str)
(setq str (substring str (match-end 0))))
- (ignore-errors
- (if (version-to-list str) str))))
+ (let ((l (version-to-list str)))
+ ;; Don't return `str' but (package-version-join (version-to-list str))
+ ;; to make sure we use a "canonical name"!
+ (if l (package-version-join l)))))
(declare-function lm-homepage "lisp-mnt" (&optional file))
@@ -2704,7 +2739,9 @@ either a full name or nil, and EMAIL is a valid email address."
(define-key map "(" #'package-menu-toggle-hiding)
(define-key map (kbd "/ /") 'package-menu-clear-filter)
(define-key map (kbd "/ a") 'package-menu-filter-by-archive)
+ (define-key map (kbd "/ d") 'package-menu-filter-by-description)
(define-key map (kbd "/ k") 'package-menu-filter-by-keyword)
+ (define-key map (kbd "/ N") 'package-menu-filter-by-name-or-description)
(define-key map (kbd "/ n") 'package-menu-filter-by-name)
(define-key map (kbd "/ s") 'package-menu-filter-by-status)
(define-key map (kbd "/ v") 'package-menu-filter-by-version)
@@ -2736,8 +2773,11 @@ either a full name or nil, and EMAIL is a valid email address."
"--"
("Filter Packages"
["Filter by Archive" package-menu-filter-by-archive :help "Filter packages by archive"]
+ ["Filter by Description" package-menu-filter-by-description :help "Filter packages by description"]
["Filter by Keyword" package-menu-filter-by-keyword :help "Filter packages by keyword"]
["Filter by Name" package-menu-filter-by-name :help "Filter packages by name"]
+ ["Filter by Name or Description" package-menu-filter-by-name-or-description
+ :help "Filter packages by name or description"]
["Filter by Status" package-menu-filter-by-status :help "Filter packages by status"]
["Filter by Version" package-menu-filter-by-version :help "Filter packages by version"]
["Filter Marked" package-menu-filter-marked :help "Filter packages marked for upgrade"]
@@ -3694,7 +3734,7 @@ short description."
(package-menu--generate nil t)))
;; The package menu buffer has keybindings. If the user types
;; `M-x list-packages', that suggests it should become current.
- (switch-to-buffer buf)))
+ (pop-to-buffer-same-window buf)))
;;;###autoload
(defalias 'package-list-packages 'list-packages)
@@ -3765,6 +3805,23 @@ packages."
(string-join archive ",")
archive)))))
+(defun package-menu-filter-by-description (description)
+ "Filter the \"*Packages*\" buffer by DESCRIPTION regexp.
+Display only packages with a description that matches regexp
+DESCRIPTION.
+
+When called interactively, prompt for DESCRIPTION.
+
+If DESCRIPTION is nil or the empty string, show all packages."
+ (interactive (list (read-regexp "Filter by description (regexp)")))
+ (package--ensure-package-menu-mode)
+ (if (or (not description) (string-empty-p description))
+ (package-menu--generate t t)
+ (package-menu--filter-by (lambda (pkg-desc)
+ (string-match description
+ (package-desc-summary pkg-desc)))
+ (format "desc:%s" description))))
+
(defun package-menu-filter-by-keyword (keyword)
"Filter the \"*Packages*\" buffer by KEYWORD.
Display only packages with specified KEYWORD.
@@ -3790,6 +3847,27 @@ packages."
(define-obsolete-function-alias
'package-menu-filter #'package-menu-filter-by-keyword "27.1")
+(defun package-menu-filter-by-name-or-description (name-or-description)
+ "Filter the \"*Packages*\" buffer by NAME-OR-DESCRIPTION regexp.
+Display only packages with a name-or-description that matches regexp
+NAME-OR-DESCRIPTION.
+
+When called interactively, prompt for NAME-OR-DESCRIPTION.
+
+If NAME-OR-DESCRIPTION is nil or the empty string, show all
+packages."
+ (interactive (list (read-regexp "Filter by name or description (regexp)")))
+ (package--ensure-package-menu-mode)
+ (if (or (not name-or-description) (string-empty-p name-or-description))
+ (package-menu--generate t t)
+ (package-menu--filter-by (lambda (pkg-desc)
+ (or (string-match name-or-description
+ (package-desc-summary pkg-desc))
+ (string-match name-or-description
+ (symbol-name
+ (package-desc-name pkg-desc)))))
+ (format "name-or-desc:%s" name-or-description))))
+
(defun package-menu-filter-by-name (name)
"Filter the \"*Packages*\" buffer by NAME regexp.
Display only packages with name that matches regexp NAME.
@@ -3984,10 +4062,12 @@ activations need to be changed, such as when `package-load-list' is modified."
:type 'boolean
:version "27.1")
+;;;###autoload
(defcustom package-quickstart-file
(locate-user-emacs-file "package-quickstart.el")
"Location of the file used to speed up activation of packages at startup."
:type 'file
+ :initialize #'custom-initialize-delay
:version "27.1")
(defun package--quickstart-maybe-refresh ()
@@ -3995,6 +4075,7 @@ activations need to be changed, such as when `package-load-list' is modified."
;; FIXME: Delay refresh in case we're installing/deleting
;; several packages!
(package-quickstart-refresh)
+ (delete-file (concat package-quickstart-file "c"))
(delete-file package-quickstart-file)))
(defun package-quickstart-refresh ()
@@ -4049,10 +4130,12 @@ activations need to be changed, such as when `package-load-list' is modified."
(insert "
;; Local\sVariables:
;; version-control: never
-;;\sno-byte-compile: t
;; no-update-autoloads: t
;; End:
-"))))
+"))
+ ;; FIXME: Do it asynchronously in an Emacs subprocess, and
+ ;; don't show the byte-compiler warnings.
+ (byte-compile-file package-quickstart-file)))
(defun package--imenu-prev-index-position-function ()
"Move point to previous line in package-menu buffer.
@@ -4072,6 +4155,15 @@ beginning of the line."
(package-version-join (package-desc-version package-desc))
(package-desc-summary package-desc))))
+;;;; Introspection
+
+(defun package-get-descriptor (pkg-name)
+ "Return the `package-desc' of PKG-NAME."
+ (unless package--initialized (package-initialize 'no-activate))
+ (or (package--get-activatable-pkg pkg-name)
+ (cadr (assq pkg-name package-alist))
+ (cadr (assq pkg-name package-archive-contents))))
+
(provide 'package)
;;; package.el ends here
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index e603900b095..bfd577c5d14 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -1,6 +1,6 @@
;;; pcase.el --- ML-style pattern-matching macro for Elisp -*- lexical-binding: t -*-
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: extensions
@@ -39,10 +39,10 @@
;; - along these lines, provide patterns to match CL structs.
;; - provide something like (setq VAR) so a var can be set rather than
;; let-bound.
-;; - provide a way to fallthrough to subsequent cases (not sure what I meant by
-;; this :-()
+;; - provide a way to fallthrough to subsequent cases
+;; (e.g. Like Racket's (=> ID).
;; - try and be more clever to reduce the size of the decision tree, and
-;; to reduce the number of leaves that need to be turned into function:
+;; to reduce the number of leaves that need to be turned into functions:
;; - first, do the tests shared by all remaining branches (it will have
;; to be performed anyway, so better do it first so it's shared).
;; - then choose the test that discriminates more (?).
@@ -97,11 +97,15 @@
(declare-function get-edebug-spec "edebug" (symbol))
(declare-function edebug-match "edebug" (cursor specs))
+(defun pcase--get-macroexpander (s)
+ "Return the macroexpander for pcase pattern head S, or nil"
+ (get s 'pcase-macroexpander))
+
(defun pcase--edebug-match-macro (cursor)
(let (specs)
(mapatoms
(lambda (s)
- (let ((m (get s 'pcase-macroexpander)))
+ (let ((m (pcase--get-macroexpander s)))
(when (and m (get-edebug-spec m))
(push (cons (symbol-name s) (get-edebug-spec m))
specs)))))
@@ -128,6 +132,7 @@ PATTERN matches. PATTERN can take one of the forms:
If a SYMBOL is used twice in the same pattern
the second occurrence becomes an `eq'uality test.
(pred FUN) matches if FUN called on EXPVAL returns non-nil.
+ (pred (not FUN)) matches if FUN called on EXPVAL returns nil.
(app FUN PAT) matches if FUN called on EXPVAL matches PAT.
(guard BOOLEXP) matches if BOOLEXP evaluates to non-nil.
(let PAT EXPR) matches if EXPR matches PAT.
@@ -193,7 +198,7 @@ Emacs Lisp manual for more information and examples."
(let (more)
;; Collect all the extensions.
(mapatoms (lambda (symbol)
- (let ((me (get symbol 'pcase-macroexpander)))
+ (let ((me (pcase--get-macroexpander symbol)))
(when me
(push (cons symbol me)
more)))))
@@ -344,7 +349,7 @@ of the elements of LIST is performed as if by `pcase-let'.
(seen '())
(codegen
(lambda (code vars)
- (let ((vars (pcase--fgrep vars code))
+ (let ((vars (macroexp--fgrep vars code))
(prev (assq code seen)))
(if (not prev)
(let ((res (pcase-codegen code vars)))
@@ -401,7 +406,7 @@ of the elements of LIST is performed as if by `pcase-let'.
;; occurrences of this leaf since it's small.
(lambda (code vars)
(pcase-codegen code
- (pcase--fgrep vars code)))
+ (macroexp--fgrep vars code)))
codegen)
(cdr case)
vars))))
@@ -409,7 +414,8 @@ of the elements of LIST is performed as if by `pcase-let'.
(dolist (case cases)
(unless (or (memq case used-cases)
(memq (car case) pcase--dontwarn-upats))
- (message "Redundant pcase pattern: %S" (car case))))
+ (message "pcase pattern %S shadowed by previous pcase pattern"
+ (car case))))
(macroexp-let* defs main))))
(defun pcase--macroexpand (pat)
@@ -423,7 +429,7 @@ of the elements of LIST is performed as if by `pcase-let'.
((eq head 'let) `(let ,(pcase--macroexpand (cadr pat)) ,@(cddr pat)))
((eq head 'app) `(app ,(nth 1 pat) ,(pcase--macroexpand (nth 2 pat))))
(t
- (let* ((expander (get head 'pcase-macroexpander))
+ (let* ((expander (pcase--get-macroexpander head))
(npat (if expander (apply expander (cdr pat)))))
(if (null npat)
(error (if expander
@@ -657,6 +663,14 @@ MATCH is the pattern that needs to be matched, of the form:
'(:pcase--succeed . nil))))
(defun pcase--split-pred (vars upat pat)
+ "Indicate the overlap or mutual-exclusion between UPAT and PAT.
+More specifically retuns a pair (A . B) where A indicates whether PAT
+can match when UPAT has matched, and B does the same for the case
+where UPAT failed to match.
+A and B can be one of:
+- nil if we don't know
+- `:pcase--fail' if UPAT match's result implies that PAT can't match
+- `:pcase--succeed' if UPAT match's result implies that PAT matches"
(let (test)
(cond
((and (equal upat pat)
@@ -667,8 +681,21 @@ MATCH is the pattern that needs to be matched, of the form:
;; run, but we don't have the environment in which `pat' will
;; run, so we can't do a reliable verification. But let's try
;; and catch at least the easy cases such as (bug#14773).
- (not (pcase--fgrep (mapcar #'car vars) (cadr upat)))))
+ (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)))
+ (res (pcase--split-pred vars upat `(pred ,test)))
+ (reverse (lambda (x) (cond ((eq x :pcase--succeed) :pcase--fail)
+ ((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))
@@ -691,23 +718,6 @@ MATCH is the pattern that needs to be matched, of the form:
'(nil . :pcase--fail)
'(:pcase--fail . nil))))))
-(defun pcase--fgrep (bindings sexp)
- "Return those of the BINDINGS which might be used in SEXP."
- (let ((res '()))
- (while (and (consp sexp) bindings)
- (dolist (binding (pcase--fgrep bindings (pop sexp)))
- (push binding res)
- (setq bindings (remove binding bindings))))
- (if (vectorp sexp)
- ;; With backquote, code can appear within vectors as well.
- ;; This wouldn't be needed if we `macroexpand-all' before
- ;; calling pcase--fgrep, OTOH.
- (pcase--fgrep bindings (mapcar #'identity sexp))
- (let ((tmp (assq sexp bindings)))
- (if tmp
- (cons tmp res)
- res)))))
-
(defun pcase--self-quoting-p (upat)
(or (keywordp upat) (integerp upat) (stringp upat)))
@@ -744,11 +754,13 @@ MATCH is the pattern that needs to be matched, of the form:
(defun pcase--funcall (fun arg vars)
"Build a function call to FUN with arg ARG."
- (if (symbolp fun)
- `(,fun ,arg)
+ (cond
+ ((symbolp fun) `(,fun ,arg))
+ ((eq 'not (car-safe fun)) `(not ,(pcase--funcall (cadr fun) arg vars)))
+ (t
(let* (;; `env' is an upper bound on the bindings we need.
(env (mapcar (lambda (x) (list (car x) (cdr x)))
- (pcase--fgrep vars fun)))
+ (macroexp--fgrep vars fun)))
(call (progn
(when (assq arg env)
;; `arg' is shadowed by `env'.
@@ -763,13 +775,13 @@ MATCH is the pattern that needs to be matched, of the form:
;; Let's not replace `vars' in `fun' since it's
;; too difficult to do it right, instead just
;; let-bind `vars' around `fun'.
- `(let* ,env ,call)))))
+ `(let* ,env ,call))))))
(defun pcase--eval (exp vars)
"Build an expression that will evaluate EXP."
(let* ((found (assq exp vars)))
(if found (cdr found)
- (let* ((env (pcase--fgrep vars exp)))
+ (let* ((env (macroexp--fgrep vars exp)))
(if env
(macroexp-let* (mapcar (lambda (x) (list (car x) (cdr x)))
env)
diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el
index eb2ee94be3b..ef4c9603284 100644
--- a/lisp/emacs-lisp/pp.el
+++ b/lisp/emacs-lisp/pp.el
@@ -1,6 +1,6 @@
;;; pp.el --- pretty printer for Emacs Lisp -*- lexical-binding: t -*-
-;; Copyright (C) 1989, 1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1989, 1993, 2001-2021 Free Software Foundation, Inc.
;; Author: Randal Schwartz <merlyn@stonehenge.com>
;; Keywords: lisp
@@ -94,33 +94,31 @@ after OUT-BUFFER-NAME."
;; This function either decides not to display it at all
;; or displays it in the usual way.
(temp-buffer-show-function
- (function
- (lambda (buf)
- (with-current-buffer buf
- (goto-char (point-min))
- (end-of-line 1)
- (if (or (< (1+ (point)) (point-max))
- (>= (- (point) (point-min)) (frame-width)))
- (let ((temp-buffer-show-function old-show-function)
- (old-selected (selected-window))
- (window (display-buffer buf)))
- (goto-char (point-min)) ; expected by some hooks ...
- (make-frame-visible (window-frame window))
- (unwind-protect
- (progn
- (select-window window)
- (run-hooks 'temp-buffer-show-hook))
- (when (window-live-p old-selected)
- (select-window old-selected))
- (message "See buffer %s." out-buffer-name)))
- (message "%s" (buffer-substring (point-min) (point)))
- ))))))
+ (lambda (buf)
+ (with-current-buffer buf
+ (goto-char (point-min))
+ (end-of-line 1)
+ (if (or (< (1+ (point)) (point-max))
+ (>= (- (point) (point-min)) (frame-width)))
+ (let ((temp-buffer-show-function old-show-function)
+ (old-selected (selected-window))
+ (window (display-buffer buf)))
+ (goto-char (point-min)) ; expected by some hooks ...
+ (make-frame-visible (window-frame window))
+ (unwind-protect
+ (progn
+ (select-window window)
+ (run-hooks 'temp-buffer-show-hook))
+ (when (window-live-p old-selected)
+ (select-window old-selected))
+ (message "See buffer %s." out-buffer-name)))
+ (message "%s" (buffer-substring (point-min) (point))))))))
(with-output-to-temp-buffer out-buffer-name
(pp expression)
(with-current-buffer standard-output
(emacs-lisp-mode)
(setq buffer-read-only nil)
- (set (make-local-variable 'font-lock-verbose) nil)))))
+ (setq-local font-lock-verbose nil)))))
;;;###autoload
(defun pp-eval-expression (expression)
diff --git a/lisp/emacs-lisp/radix-tree.el b/lisp/emacs-lisp/radix-tree.el
index 48aedb2e566..0905ac608bb 100644
--- a/lisp/emacs-lisp/radix-tree.el
+++ b/lisp/emacs-lisp/radix-tree.el
@@ -1,6 +1,6 @@
;;; radix-tree.el --- A simple library of radix trees -*- lexical-binding: t; -*-
-;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2016-2021 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords:
@@ -198,9 +198,10 @@ If not found, return nil."
(pcase-defmacro radix-tree-leaf (vpat)
"Pattern which matches a radix-tree leaf.
The pattern VPAT is matched against the leaf's carried value."
- ;; FIXME: We'd like to use a negative pattern (not consp), but pcase
- ;; doesn't support it. Using `atom' works but generates sub-optimal code.
- `(or `(t . ,,vpat) (and (pred atom) ,vpat))))
+ ;; We used to use `(pred atom)', but `pcase' doesn't understand that
+ ;; `atom' is equivalent to the negation of `consp' and hence generates
+ ;; suboptimal code.
+ `(or `(t . ,,vpat) (and (pred (not consp)) ,vpat))))
(defun radix-tree-iter-subtrees (tree fun)
"Apply FUN to every immediate subtree of radix TREE.
diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el
index 78ae3a8c1e5..23221a2a00d 100644
--- a/lisp/emacs-lisp/re-builder.el
+++ b/lisp/emacs-lisp/re-builder.el
@@ -1,6 +1,6 @@
;;; re-builder.el --- building Regexps with visual feedback -*- lexical-binding: t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Detlev Zundel <dzu@gnu.org>
;; Keywords: matching, lisp, tools
@@ -271,7 +271,7 @@ Except for Lisp syntax this is the same as `reb-regexp'.")
(define-derived-mode reb-mode nil "RE Builder"
"Major mode for interactively building Regular Expressions."
- (set (make-local-variable 'blink-matching-paren) nil)
+ (setq-local blink-matching-paren nil)
(reb-mode-common))
(defvar reb-lisp-mode-map
@@ -832,8 +832,8 @@ If SUBEXP is non-nil mark only the corresponding sub-expressions."
(let ((font-lock-is-on font-lock-mode))
(font-lock-mode -1)
(kill-local-variable 'font-lock-set-defaults)
- ;;(set (make-local-variable 'reb-re-syntax) 'string)
- ;;(set (make-local-variable 'reb-re-syntax) 'rx)
+ ;;(setq-local reb-re-syntax 'string)
+ ;;(setq-local reb-re-syntax 'rx)
(setq font-lock-defaults
(cond
((memq reb-re-syntax '(read string))
diff --git a/lisp/emacs-lisp/regexp-opt.el b/lisp/emacs-lisp/regexp-opt.el
index 35a5fda184f..2a40290249e 100644
--- a/lisp/emacs-lisp/regexp-opt.el
+++ b/lisp/emacs-lisp/regexp-opt.el
@@ -1,6 +1,6 @@
;;; regexp-opt.el --- generate efficient regexps to match strings -*- lexical-binding: t -*-
-;; Copyright (C) 1994-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2021 Free Software Foundation, Inc.
;; Author: Simon Marshall <simon@gnu.org>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/emacs-lisp/regi.el b/lisp/emacs-lisp/regi.el
index 11b28b72cf3..38b202fa101 100644
--- a/lisp/emacs-lisp/regi.el
+++ b/lisp/emacs-lisp/regi.el
@@ -1,6 +1,6 @@
;;; regi.el --- REGular expression Interpreting engine
-;; Copyright (C) 1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 2001-2021 Free Software Foundation, Inc.
;; Author: 1993 Barry A. Warsaw, Century Computing, Inc. <bwarsaw@cen.com>
;; Created: 24-Feb-1993
@@ -163,18 +163,15 @@ useful information:
;; let's find the special tags and remove them from the working
;; frame. note that only the last special tag is used.
(mapc
- (function
- (lambda (entry)
- (let ((pred (car entry))
- (func (car (cdr entry))))
- (cond
- ((eq pred 'begin) (setq begin-tag func))
- ((eq pred 'end) (setq end-tag func))
- ((eq pred 'every) (setq every-tag func))
- (t
- (setq working-frame (append working-frame (list entry))))
- ) ; end-cond
- )))
+ (lambda (entry)
+ (let ((pred (car entry))
+ (func (car (cdr entry))))
+ (cond
+ ((eq pred 'begin) (setq begin-tag func))
+ ((eq pred 'end) (setq end-tag func))
+ ((eq pred 'every) (setq every-tag func))
+ (t
+ (setq working-frame (append working-frame (list entry)))))))
frame) ; end-mapcar
;; execute the begin entry
diff --git a/lisp/emacs-lisp/ring.el b/lisp/emacs-lisp/ring.el
index 624efd6a476..96894655b45 100644
--- a/lisp/emacs-lisp/ring.el
+++ b/lisp/emacs-lisp/ring.el
@@ -1,6 +1,6 @@
;;; ring.el --- handle rings of items -*- lexical-binding: t; -*-
-;; Copyright (C) 1992, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 2001-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: extensions
diff --git a/lisp/emacs-lisp/rmc.el b/lisp/emacs-lisp/rmc.el
index 9b253b88572..bedf598d442 100644
--- a/lisp/emacs-lisp/rmc.el
+++ b/lisp/emacs-lisp/rmc.el
@@ -1,6 +1,6 @@
;;; rmc.el --- read from a multiple choice question -*- lexical-binding: t -*-
-;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2016-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el
index 8d8d071031c..b29b870061d 100644
--- a/lisp/emacs-lisp/rx.el
+++ b/lisp/emacs-lisp/rx.el
@@ -1,6 +1,6 @@
;;; rx.el --- S-exp notation for regexps --*- lexical-binding: t -*-
-;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -1413,11 +1413,12 @@ into a plain rx-expression, collecting names into `rx--pcase-vars'."
(mapconcat #'symbol-name rx--pcase-vars " ")))
`(backref ,index)))
((and `(,head . ,rest)
- (guard (and (symbolp head)
+ (guard (and (or (symbolp head) (memq head '(?\s ??)))
(not (memq head '(literal regexp regex eval))))))
(cons head (mapcar #'rx--pcase-transform rest)))
(_ rx)))
+;;;###autoload
(pcase-defmacro rx (&rest regexps)
"A pattern that matches strings against `rx' REGEXPS in sexp form.
REGEXPS are interpreted as in `rx'. The pattern matches any
diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el
index 4656277ea16..31c15fea90d 100644
--- a/lisp/emacs-lisp/seq.el
+++ b/lisp/emacs-lisp/seq.el
@@ -1,6 +1,6 @@
;;; seq.el --- Sequence manipulation functions -*- lexical-binding: t -*-
-;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2021 Free Software Foundation, Inc.
;; Author: Nicolas Petton <nicolas@petton.fr>
;; Keywords: sequences
@@ -317,7 +317,7 @@ list."
;;;###autoload
(cl-defgeneric seq-filter (pred sequence)
- "Return a list of all the elements for which (PRED element) is non-nil in SEQUENCE."
+ "Return a list of all elements for which (PRED element) is non-nil in SEQUENCE."
(let ((exclude (make-symbol "exclude")))
(delq exclude (seq-map (lambda (elt)
(if (funcall pred elt)
@@ -411,7 +411,8 @@ Equality is defined by TESTFN if non-nil or by `equal' if nil."
nil))
(cl-defgeneric seq-set-equal-p (sequence1 sequence2 &optional testfn)
- "Return non-nil if SEQUENCE1 and SEQUENCE2 contain the same elements, regardless of order.
+ "Return non-nil if SEQUENCE1 and SEQUENCE2 contain the same elements.
+This does not depend on the order of the elements.
Equality is defined by TESTFN if non-nil or by `equal' if nil."
(and (seq-every-p (lambda (item1) (seq-contains-p sequence2 item1 testfn)) sequence1)
(seq-every-p (lambda (item2) (seq-contains-p sequence1 item2 testfn)) sequence2)))
@@ -444,7 +445,7 @@ The result is a sequence of type TYPE, or a list if TYPE is nil."
(seq-map function sequence)))
(cl-defgeneric seq-partition (sequence n)
- "Return a list of the elements of SEQUENCE grouped into sub-sequences of length N.
+ "Return list of elements of SEQUENCE grouped into sub-sequences of length N.
The last sequence may contain less than N elements. If N is a
negative integer or 0, nil is returned."
(unless (< n 1)
diff --git a/lisp/emacs-lisp/shadow.el b/lisp/emacs-lisp/shadow.el
index dd614dd792c..168e5e46f37 100644
--- a/lisp/emacs-lisp/shadow.el
+++ b/lisp/emacs-lisp/shadow.el
@@ -1,6 +1,6 @@
;;; shadow.el --- locate Emacs Lisp file shadowings
-;; Copyright (C) 1995, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 2001-2021 Free Software Foundation, Inc.
;; Author: Terry Jones <terry@santafe.edu>
;; Keywords: lisp
@@ -177,13 +177,12 @@ See the documentation for `list-load-path-shadows' for further information."
(define-derived-mode load-path-shadows-mode fundamental-mode "LP-Shadows"
"Major mode for load-path shadows buffer."
- (set (make-local-variable 'font-lock-defaults)
- '((load-path-shadows-font-lock-keywords)))
+ (setq-local font-lock-defaults
+ '((load-path-shadows-font-lock-keywords)))
(setq buffer-undo-list t
buffer-read-only t))
;; TODO use text-properties instead, a la dired.
-(require 'button)
(define-button-type 'load-path-shadows-find-file
'follow-link t
;; 'face 'default
diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el
index dd9cbd5d55a..39e69f5aab9 100644
--- a/lisp/emacs-lisp/shortdoc.el
+++ b/lisp/emacs-lisp/shortdoc.el
@@ -1,6 +1,6 @@
;;; shortdoc.el --- Short function summaries -*- lexical-binding: t -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; Keywords: lisp, help
;; Package: emacs
@@ -131,6 +131,10 @@ There can be any number of :example/:result elements."
(mapconcat
:eval (mapconcat (lambda (a) (concat "[" a "]"))
'("foo" "bar" "zot") " "))
+ (string-pad
+ :eval (string-pad "foo" 5)
+ :eval (string-pad "foobar" 5)
+ :eval (string-pad "foo" 5 ?- t))
(mapcar
:eval (mapcar #'identity "123"))
(format
@@ -139,10 +143,21 @@ There can be any number of :example/:result elements."
(substring
:eval (substring "foobar" 0 3)
:eval (substring "foobar" 3))
+ (string-limit
+ :eval (string-limit "foobar" 3)
+ :eval (string-limit "foobar" 3 t)
+ :eval (string-limit "foobar" 10)
+ :eval (string-limit "fo好" 3 nil 'utf-8))
+ (truncate-string-to-width
+ :eval (truncate-string-to-width "foobar" 3)
+ :eval (truncate-string-to-width "你好bar" 5))
(split-string
:eval (split-string "foo bar")
:eval (split-string "|foo|bar|" "|")
:eval (split-string "|foo|bar|" "|" t))
+ (string-lines
+ :eval (string-lines "foo\n\nbar")
+ :eval (string-lines "foo\n\nbar" t))
(string-replace
:eval (string-replace "foo" "bar" "foozot"))
(replace-regexp-in-string
@@ -167,10 +182,19 @@ There can be any number of :example/:result elements."
(string-remove-prefix
:no-manual t
:eval (string-remove-prefix "foo" "foobar"))
+ (string-chop-newline
+ :eval (string-chop-newline "foo\n"))
+ (string-clean-whitespace
+ :eval (string-clean-whitespace " foo bar "))
+ (string-fill
+ :eval (string-fill "Three short words" 12)
+ :eval (string-fill "Long-word" 3))
(reverse
:eval (reverse "foo"))
(substring-no-properties
:eval (substring-no-properties (propertize "foobar" 'face 'bold) 0 3))
+ (try-completion
+ :eval (try-completion "foo" '("foobar" "foozot" "gazonk")))
"Predicates for Strings"
(string-equal
:eval (string-equal "foo" "foo"))
@@ -594,6 +618,12 @@ There can be any number of :example/:result elements."
"Data About Lists"
(length
:eval (length '(a b c)))
+ (length<
+ :eval (length< '(a b c) 1))
+ (length>
+ :eval (length> '(a b c) 1))
+ (length=
+ :eval (length> '(a b c) 3))
(safe-length
:eval (safe-length '(a b c))))
@@ -689,8 +719,8 @@ There can be any number of :example/:result elements."
(define-short-documentation-group sequence
"Sequence Predicates"
(seq-contains-p
- :eval (seq-contains '(a b c) 'b)
- :eval (seq-contains '(a b c) 'd))
+ :eval (seq-contains-p '(a b c) 'b)
+ :eval (seq-contains-p '(a b c) 'd))
(seq-every-p
:eval (seq-every-p #'numberp '(1 2 3)))
(seq-empty-p
@@ -1096,12 +1126,21 @@ There can be any number of :example/:result elements."
(insert (propertize "("
'shortdoc-function t))
(if (plist-get data :no-manual)
- (insert (symbol-name function))
+ (insert-text-button
+ (symbol-name function)
+ 'face 'button
+ 'action (lambda (_)
+ (describe-function function))
+ 'follow-link t
+ 'help-echo (purecopy "mouse-1, RET: describe function"))
(insert-text-button
(symbol-name function)
'face 'button
'action (lambda (_)
- (info-lookup-symbol function 'emacs-lisp-mode))))
+ (info-lookup-symbol function 'emacs-lisp-mode))
+ 'follow-link t
+ 'help-echo (purecopy "mouse-1, RET: show \
+function's documentation in the Info manual")))
(setq arglist-start (point))
(insert ")\n")
;; Doc string.
diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el
index 1b700afd12d..44be9afbfae 100644
--- a/lisp/emacs-lisp/smie.el
+++ b/lisp/emacs-lisp/smie.el
@@ -1,6 +1,6 @@
;;; smie.el --- Simple Minded Indentation Engine -*- lexical-binding: t -*-
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: languages, lisp, internal, parsing, indentation
@@ -1891,9 +1891,9 @@ KEYWORDS are additional arguments, which can use the following keywords:
(v (pop keywords)))
(pcase k
(:forward-token
- (set (make-local-variable 'smie-forward-token-function) v))
+ (setq-local smie-forward-token-function v))
(:backward-token
- (set (make-local-variable 'smie-backward-token-function) v))
+ (setq-local smie-backward-token-function v))
(_ (message "smie-setup: ignoring unknown keyword %s" k)))))
(let ((ca (cdr (assq :smie-closer-alist grammar))))
(when ca
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index e6abb39ddc6..b90227da42f 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -1,6 +1,6 @@
;;; subr-x.el --- extra Lisp functions -*- lexical-binding:t -*-
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: convenience
@@ -264,6 +264,102 @@ carriage return."
(substring string 0 (- (length string) (length suffix)))
string))
+(defun string-clean-whitespace (string)
+ "Clean up whitespace in STRING.
+All sequences of whitespaces in STRING are collapsed into a
+single space character, and leading/trailing whitespace is
+removed."
+ (let ((blank "[[:blank:]\r\n]+"))
+ (string-trim (replace-regexp-in-string blank " " string t t)
+ blank blank)))
+
+(defun string-fill (string length)
+ "Try to word-wrap STRING so that no lines are longer than LENGTH.
+Wrapping is done where there is whitespace. If there are
+individual words in STRING that are longer than LENGTH, the
+result will have lines that are longer than LENGTH."
+ (with-temp-buffer
+ (insert string)
+ (goto-char (point-min))
+ (let ((fill-column length)
+ (adaptive-fill-mode nil))
+ (fill-region (point-min) (point-max)))
+ (buffer-string)))
+
+(defun string-limit (string length &optional end coding-system)
+ "Return (up to) a LENGTH substring of STRING.
+If STRING is shorter than or equal to LENGTH, the entire string
+is returned unchanged.
+
+If STRING is longer than LENGTH, return a substring consisting of
+the first LENGTH characters of STRING. If END is non-nil, return
+the last LENGTH characters instead.
+
+If CODING-SYSTEM is non-nil, STRING will be encoded before
+limiting, and LENGTH is interpreted as the number of bytes to
+limit the string to. The result will be a unibyte string that is
+shorter than LENGTH, but will not contain \"partial\" characters,
+even if CODING-SYSTEM encodes characters with several bytes per
+character.
+
+When shortening strings for display purposes,
+`truncate-string-to-width' is almost always a better alternative
+than this function."
+ (unless (natnump length)
+ (signal 'wrong-type-argument (list 'natnump length)))
+ (if coding-system
+ (let ((result nil)
+ (result-length 0)
+ (index (if end (1- (length string)) 0)))
+ (while (let ((encoded (encode-coding-char
+ (aref string index) coding-system)))
+ (and (<= (+ (length encoded) result-length) length)
+ (progn
+ (push encoded result)
+ (cl-incf result-length (length encoded))
+ (setq index (if end (1- index)
+ (1+ index))))
+ (if end (> index -1)
+ (< index (length string)))))
+ ;; No body.
+ )
+ (apply #'concat (if end result (nreverse result))))
+ (cond
+ ((<= (length string) length) string)
+ (end (substring string (- (length string) length)))
+ (t (substring string 0 length)))))
+
+(defun string-lines (string &optional omit-nulls)
+ "Split STRING into a list of lines.
+If OMIT-NULLS, empty lines will be removed from the results."
+ (split-string string "\n" omit-nulls))
+
+(defun string-pad (string length &optional padding start)
+ "Pad STRING to LENGTH using PADDING.
+If PADDING is nil, the space character is used. If not nil, it
+should be a character.
+
+If STRING is longer than the absolute value of LENGTH, no padding
+is done.
+
+If START is nil (or not present), the padding is done to the end
+of the string, and if non-nil, padding is done to the start of
+the string."
+ (unless (natnump length)
+ (signal 'wrong-type-argument (list 'natnump length)))
+ (let ((pad-length (- length (length string))))
+ (if (< pad-length 0)
+ string
+ (concat (and start
+ (make-string pad-length (or padding ?\s)))
+ string
+ (and (not start)
+ (make-string pad-length (or padding ?\s)))))))
+
+(defun string-chop-newline (string)
+ "Remove the final newline (if any) from STRING."
+ (string-remove-suffix "\n" string))
+
(defun replace-region-contents (beg end replace-fn
&optional max-secs max-costs)
"Replace the region between BEG and END using REPLACE-FN.
diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el
index 62f1b16d75c..62f213c57f7 100644
--- a/lisp/emacs-lisp/syntax.el
+++ b/lisp/emacs-lisp/syntax.el
@@ -1,6 +1,6 @@
;;; syntax.el --- helper functions to find syntactic context -*- lexical-binding: t -*-
-;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
@@ -353,7 +353,7 @@ set by `syntax-propertize'")
(setq syntax-propertize--done (max (point-max) pos))
;; (message "Needs to syntax-propertize from %s to %s"
;; syntax-propertize--done pos)
- (set (make-local-variable 'parse-sexp-lookup-properties) t)
+ (setq-local parse-sexp-lookup-properties t)
(when (< syntax-propertize--done (point-min))
;; *Usually* syntax-propertize is called via syntax-ppss which
;; takes care of adding syntax-ppss-flush-cache to b-c-f, but this
diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el
index b13f609f882..0c299b48b90 100644
--- a/lisp/emacs-lisp/tabulated-list.el
+++ b/lisp/emacs-lisp/tabulated-list.el
@@ -1,6 +1,6 @@
;;; tabulated-list.el --- generic major mode for tabulated lists -*- lexical-binding: t -*-
-;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
;; Author: Chong Yidong <cyd@stupidchicken.com>
;; Keywords: extensions, lisp
@@ -269,42 +269,48 @@ Populated by `tabulated-list-init-header'.")
;; FIXME: Should share code with tabulated-list-print-col!
(let ((x (max tabulated-list-padding 0))
(button-props `(help-echo "Click to sort by column"
- mouse-face header-line-highlight
- keymap ,tabulated-list-sort-button-map))
+ mouse-face header-line-highlight
+ keymap ,tabulated-list-sort-button-map))
+ (len (length tabulated-list-format))
(cols nil))
(if display-line-numbers
(setq x (+ x (tabulated-list-line-number-width))))
(push (propertize " " 'display `(space :align-to ,x)) cols)
- (dotimes (n (length tabulated-list-format))
+ (dotimes (n len)
(let* ((col (aref tabulated-list-format n))
+ (not-last-col (< n (1- len)))
(label (nth 0 col))
+ (lablen (length label))
+ (pname label)
(width (nth 1 col))
(props (nthcdr 3 col))
(pad-right (or (plist-get props :pad-right) 1))
(right-align (plist-get props :right-align))
(next-x (+ x pad-right width)))
+ (when (and (>= lablen 3) (> lablen width) not-last-col)
+ (setq label (truncate-string-to-width label (- lablen 1) nil nil t)))
(push
(cond
;; An unsortable column
((not (nth 2 col))
- (propertize label 'tabulated-list-column-name label))
+ (propertize label 'tabulated-list-column-name pname))
;; The selected sort column
((equal (car col) (car tabulated-list-sort-key))
(apply 'propertize
- (concat label
- (cond
- ((> (+ 2 (length label)) width) "")
- ((cdr tabulated-list-sort-key)
+ (concat label
+ (cond
+ ((and (< lablen 3) not-last-col) "")
+ ((cdr tabulated-list-sort-key)
(format " %c"
tabulated-list-gui-sort-indicator-desc))
- (t (format " %c"
+ (t (format " %c"
tabulated-list-gui-sort-indicator-asc))))
- 'face 'bold
- 'tabulated-list-column-name label
- button-props))
+ 'face 'bold
+ 'tabulated-list-column-name pname
+ button-props))
;; Unselected sortable column.
(t (apply 'propertize label
- 'tabulated-list-column-name label
+ 'tabulated-list-column-name pname
button-props)))
cols)
(when right-align
@@ -761,6 +767,7 @@ as the ewoc pretty-printer."
(setq-local revert-buffer-function #'tabulated-list-revert)
(setq-local glyphless-char-display
(tabulated-list-make-glyphless-char-display-table))
+ (setq-local text-scale-remap-header-line t)
;; Avoid messing up the entries' display just because the first
;; column of the first entry happens to begin with a R2L letter.
(setq bidi-paragraph-direction 'left-to-right)
diff --git a/lisp/emacs-lisp/tcover-ses.el b/lisp/emacs-lisp/tcover-ses.el
index cfc00f5006f..7de9d547ce4 100644
--- a/lisp/emacs-lisp/tcover-ses.el
+++ b/lisp/emacs-lisp/tcover-ses.el
@@ -1,6 +1,6 @@
;;;; testcover-ses.el -- Example use of `testcover' to test "SES"
-;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Author: Jonathan Yavner <jyavner@member.fsf.org>
;; Keywords: spreadsheet lisp utility
diff --git a/lisp/emacs-lisp/testcover.el b/lisp/emacs-lisp/testcover.el
index 79801635f2d..312e38769c5 100644
--- a/lisp/emacs-lisp/testcover.el
+++ b/lisp/emacs-lisp/testcover.el
@@ -1,6 +1,6 @@
;;;; testcover.el -- Visual code-coverage tool -*- lexical-binding:t -*-
-;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Author: Jonathan Yavner <jyavner@member.fsf.org>
;; Keywords: lisp utility
diff --git a/lisp/emacs-lisp/text-property-search.el b/lisp/emacs-lisp/text-property-search.el
index d7dc7da7c18..e909e4bf760 100644
--- a/lisp/emacs-lisp/text-property-search.el
+++ b/lisp/emacs-lisp/text-property-search.el
@@ -1,6 +1,6 @@
;;; text-property-search.el --- search for text properties -*- lexical-binding:t -*-
-;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2018-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: convenience
diff --git a/lisp/emacs-lisp/thunk.el b/lisp/emacs-lisp/thunk.el
index c8e483e9a4a..83e0fa75aa7 100644
--- a/lisp/emacs-lisp/thunk.el
+++ b/lisp/emacs-lisp/thunk.el
@@ -1,6 +1,6 @@
;;; thunk.el --- Lazy form evaluation -*- lexical-binding: t -*-
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Author: Nicolas Petton <nicolas@petton.fr>
;; Keywords: sequences
@@ -122,7 +122,7 @@ Using `thunk-let' and `thunk-let*' requires `lexical-binding'."
(declare (indent 1) (debug let))
(cl-reduce
(lambda (expr binding) `(thunk-let (,binding) ,expr))
- (nreverse bindings)
+ (reverse bindings)
:initial-value (macroexp-progn body)))
;; (defalias 'lazy-let #'thunk-let)
diff --git a/lisp/emacs-lisp/timer-list.el b/lisp/emacs-lisp/timer-list.el
index 4bda9acebf7..d5bbe7d72cd 100644
--- a/lisp/emacs-lisp/timer-list.el
+++ b/lisp/emacs-lisp/timer-list.el
@@ -1,6 +1,6 @@
;;; timer-list.el --- list active timers in a buffer -*- lexical-binding:t -*-
-;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2016-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Package: emacs
@@ -95,8 +95,8 @@
(setq-local revert-buffer-function #'list-timers)
(setq tabulated-list-format
'[("Idle" 6 timer-list--idle-predicate)
- (" Next" 12 timer-list--next-predicate)
- (" Repeat" 12 timer-list--repeat-predicate)
+ ("Next" 12 timer-list--next-predicate :right-align t :pad-right 1)
+ ("Repeat" 12 timer-list--repeat-predicate :right-align t :pad-right 1)
("Function" 10 timer-list--function-predicate)]))
(defun timer-list--idle-predicate (A B)
@@ -121,7 +121,7 @@
(string< rA rB)))
(defun timer-list--function-predicate (A B)
- "Predicate to sort Timer-List by the Next column."
+ "Predicate to sort Timer-List by the Function column."
(let ((fA (aref (cadr A) 3))
(fB (aref (cadr B) 3)))
(string< fA fB)))
diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el
index 61fd05cbb80..36de29a73a8 100644
--- a/lisp/emacs-lisp/timer.el
+++ b/lisp/emacs-lisp/timer.el
@@ -1,6 +1,6 @@
;;; timer.el --- run a function with args at some time in future -*- lexical-binding: t -*-
-;; Copyright (C) 1996, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 2001-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Package: emacs
diff --git a/lisp/emacs-lisp/tq.el b/lisp/emacs-lisp/tq.el
index 2780140cee1..e02f4e4f250 100644
--- a/lisp/emacs-lisp/tq.el
+++ b/lisp/emacs-lisp/tq.el
@@ -1,6 +1,6 @@
;;; tq.el --- utility to maintain a transaction queue -*- lexical-binding:t -*-
-;; Copyright (C) 1985-1987, 1992, 2001-2020 Free Software Foundation,
+;; Copyright (C) 1985-1987, 1992, 2001-2021 Free Software Foundation,
;; Inc.
;; Author: Scott Draves <spot@cs.cmu.edu>
diff --git a/lisp/emacs-lisp/trace.el b/lisp/emacs-lisp/trace.el
index 627305689c7..fa07d622484 100644
--- a/lisp/emacs-lisp/trace.el
+++ b/lisp/emacs-lisp/trace.el
@@ -1,6 +1,6 @@
;;; trace.el --- tracing facility for Emacs Lisp functions -*- lexical-binding: t -*-
-;; Copyright (C) 1993, 1998, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1998, 2000-2021 Free Software Foundation, Inc.
;; Author: Hans Chalupsky <hans@cs.buffalo.edu>
;; Maintainer: emacs-devel@gnu.org
@@ -225,7 +225,7 @@ be printed along with the arguments in the trace."
(ctx (funcall context)))
(unless inhibit-trace
(with-current-buffer trace-buffer
- (set (make-local-variable 'window-point-insertion-type) t)
+ (setq-local window-point-insertion-type t)
(unless background (trace--display-buffer trace-buffer))
(goto-char (point-max))
;; Insert a separator from previous trace output:
diff --git a/lisp/emacs-lisp/unsafep.el b/lisp/emacs-lisp/unsafep.el
index c4db86a0db3..f46d9c77eae 100644
--- a/lisp/emacs-lisp/unsafep.el
+++ b/lisp/emacs-lisp/unsafep.el
@@ -1,6 +1,6 @@
;;;; unsafep.el -- Determine whether a Lisp form is safe to evaluate
-;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Author: Jonathan Yavner <jyavner@member.fsf.org>
;; Keywords: safety lisp utility
diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el
index f525ea433ad..67de690e67d 100644
--- a/lisp/emacs-lisp/warnings.el
+++ b/lisp/emacs-lisp/warnings.el
@@ -1,6 +1,6 @@
;;; warnings.el --- log and display warnings -*- lexical-binding:t -*-
-;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
@@ -67,6 +67,7 @@ Level :debug is ignored by default (see `warning-minimum-level').")
Each element looks like (ALIAS . LEVEL) and defines ALIAS as
equivalent to LEVEL. LEVEL must be defined in `warning-levels';
it may not itself be an alias.")
+(make-obsolete-variable 'warning-level-aliases 'warning-levels "28.1")
(define-obsolete-variable-alias 'display-warning-minimum-level
'warning-minimum-level "28.1")
@@ -256,8 +257,10 @@ entirely by setting `warning-suppress-types' or
(setq level :warning))
(unless buffer-name
(setq buffer-name "*Warnings*"))
- (if (assq level warning-level-aliases)
- (setq level (cdr (assq level warning-level-aliases))))
+ (with-suppressed-warnings ((obsolete warning-level-aliases))
+ (when-let ((new (cdr (assq level warning-level-aliases))))
+ (warn "Warning level `%s' is obsolete; use `%s' instead" level new)
+ (setq level new)))
(or (< (warning-numeric-level level)
(warning-numeric-level warning-minimum-log-level))
(warning-suppress-p type warning-suppress-log-types)
diff --git a/lisp/emacs-lock.el b/lisp/emacs-lock.el
index ba75a93035e..5c436f599ef 100644
--- a/lisp/emacs-lock.el
+++ b/lisp/emacs-lock.el
@@ -1,6 +1,6 @@
;;; emacs-lock.el --- protect buffers against killing or exiting -*- lexical-binding: t -*-
-;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
;; Author: Juanma Barranquero <lekktu@gmail.com>
;; Inspired by emacs-lock.el by Tom Wurgler <twurgler@goodyear.com>
diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el
index 926305e6077..881eff7f801 100644
--- a/lisp/emulation/cua-base.el
+++ b/lisp/emulation/cua-base.el
@@ -1,6 +1,6 @@
;;; cua-base.el --- emulate CUA key bindings
-;; Copyright (C) 1997-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
;; Author: Kim F. Storm <storm@cua.dk>
;; Keywords: keyboard emulations convenience cua
@@ -375,11 +375,11 @@ managers, so try setting this to nil, if prefix override doesn't work."
(defcustom cua-paste-pop-rotate-temporarily nil
"If non-nil, \\[cua-paste-pop] only rotates the kill-ring temporarily.
-This means that both \\[yank] and the first \\[yank-pop] in a sequence always insert
-the most recently killed text. Each immediately following \\[cua-paste-pop] replaces
-the previous text with the next older element on the `kill-ring'.
-With prefix arg, \\[universal-argument] \\[yank-pop] inserts the same text as the most
-recent \\[yank-pop] (or \\[yank]) command."
+This means that both \\[yank] and the first \\[yank-pop] in a sequence always
+insert the most recently killed text. Each immediately following \\[cua-paste-pop]
+replaces the previous text with the next older element on the `kill-ring'.
+With prefix arg, \\[universal-argument] \\[yank-pop] inserts the same text as the
+most recent \\[yank-pop] (or \\[yank]) command."
:type 'boolean
:group 'cua)
diff --git a/lisp/emulation/cua-gmrk.el b/lisp/emulation/cua-gmrk.el
index cd360721721..195bba1f317 100644
--- a/lisp/emulation/cua-gmrk.el
+++ b/lisp/emulation/cua-gmrk.el
@@ -1,6 +1,6 @@
;;; cua-gmrk.el --- CUA unified global mark support
-;; Copyright (C) 1997-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
;; Author: Kim F. Storm <storm@cua.dk>
;; Keywords: keyboard emulations convenience cua mark
diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el
index 7ca9dc1af1d..ea5dad2aa0b 100644
--- a/lisp/emulation/cua-rect.el
+++ b/lisp/emulation/cua-rect.el
@@ -1,6 +1,6 @@
;;; cua-rect.el --- CUA unified rectangle support
-;; Copyright (C) 1997-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
;; Author: Kim F. Storm <storm@cua.dk>
;; Keywords: keyboard emulations convenience CUA
diff --git a/lisp/emulation/edt-lk201.el b/lisp/emulation/edt-lk201.el
index c922e00f8f6..b616fdf4298 100644
--- a/lisp/emulation/edt-lk201.el
+++ b/lisp/emulation/edt-lk201.el
@@ -1,6 +1,6 @@
-;;; edt-lk201.el --- enhanced EDT keypad mode emulation for LK-201 keyboards
+;;; edt-lk201.el --- enhanced EDT keypad mode emulation for LK-201 keyboards -*- lexical-binding: t -*-
-;; Copyright (C) 1986, 1992-1993, 1995, 2001-2020 Free Software
+;; Copyright (C) 1986, 1992-1993, 1995, 2001-2021 Free Software
;; Foundation, Inc.
;; Author: Kevin Gallagher <kevin.gal@verizon.net>
diff --git a/lisp/emulation/edt-mapper.el b/lisp/emulation/edt-mapper.el
index 5dd81fab3b6..98085c6214d 100644
--- a/lisp/emulation/edt-mapper.el
+++ b/lisp/emulation/edt-mapper.el
@@ -1,6 +1,6 @@
;;; edt-mapper.el --- create an EDT LK-201 map file for X-Windows Emacs
-;; Copyright (C) 1994-1995, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1995, 2000-2021 Free Software Foundation, Inc.
;; Author: Kevin Gallagher <kevin.gal@verizon.net>
;; Keywords: emulations
diff --git a/lisp/emulation/edt-pc.el b/lisp/emulation/edt-pc.el
index aa31d5bc32a..3131c8f873e 100644
--- a/lisp/emulation/edt-pc.el
+++ b/lisp/emulation/edt-pc.el
@@ -1,6 +1,6 @@
-;;; edt-pc.el --- enhanced EDT keypad mode emulation for PC 101 keyboards
+;;; edt-pc.el --- enhanced EDT keypad mode emulation for PC 101 keyboards -*- lexical-binding: t -*-
-;; Copyright (C) 1986, 1994-1995, 2001-2020 Free Software Foundation,
+;; Copyright (C) 1986, 1994-1995, 2001-2021 Free Software Foundation,
;; Inc.
;; Author: Kevin Gallagher <kevin.gal@verizon.net>
diff --git a/lisp/emulation/edt-vt100.el b/lisp/emulation/edt-vt100.el
index 199212d2227..8174d83eaa1 100644
--- a/lisp/emulation/edt-vt100.el
+++ b/lisp/emulation/edt-vt100.el
@@ -1,6 +1,6 @@
-;;; edt-vt100.el --- enhanced EDT keypad mode emulation for VT series terminals
+;;; edt-vt100.el --- enhanced EDT keypad mode emulation for VT series terminals -*- lexical-binding: t -*-
-;; Copyright (C) 1986, 1992-1993, 1995, 2002-2020 Free Software
+;; Copyright (C) 1986, 1992-1993, 1995, 2002-2021 Free Software
;; Foundation, Inc.
;; Author: Kevin Gallagher <kevin.gal@verizon.net>
diff --git a/lisp/emulation/edt.el b/lisp/emulation/edt.el
index e70b44658d5..7760a7f2b46 100644
--- a/lisp/emulation/edt.el
+++ b/lisp/emulation/edt.el
@@ -1,6 +1,6 @@
;;; edt.el --- enhanced EDT keypad mode emulation for GNU Emacs
-;; Copyright (C) 1986, 1992-1995, 2000-2020 Free Software Foundation,
+;; Copyright (C) 1986, 1992-1995, 2000-2021 Free Software Foundation,
;; Inc.
;; Author: Kevin Gallagher <kevin.gal@verizon.net>
@@ -691,7 +691,7 @@ Optional argument FIND is t if this function is called from `edt-find'."
(defun edt-find ()
"Find first occurrence of string in current direction and save it."
(interactive)
- (set 'edt-find-last-text (read-string "Search: "))
+ (setq edt-find-last-text (read-string "Search: "))
(if (equal edt-direction-string edt-forward-string)
(edt-find-forward t)
(edt-find-backward t)))
@@ -788,7 +788,7 @@ Argument NUM is the number of lines to delete."
In select mode, selected text is highlighted."
(if arg
(progn
- (set (make-local-variable 'edt-select-mode) 'edt-select-mode-current)
+ (setq-local edt-select-mode 'edt-select-mode-current)
(setq rect-start-point (window-point)))
(progn
(kill-local-variable 'edt-select-mode)))
@@ -1321,8 +1321,8 @@ Definition is stored in `edt-last-replaced-key-definition'."
(if edt-last-replaced-key-definition
(progn
(let (edt-key-definition)
- (set 'edt-key-definition
- (read-key-sequence "Press the key to be restored: "))
+ (setq edt-key-definition
+ (read-key-sequence "Press the key to be restored: "))
(if (string-equal "\C-m" edt-key-definition)
(message "Key not restored")
(progn
@@ -1639,12 +1639,12 @@ Argument NUM is the number of times to duplicate the line."
(progn
(end-kbd-macro nil)
(let (edt-key-definition)
- (set 'edt-key-definition
- (read-key-sequence "Enter key for binding: "))
+ (setq edt-key-definition
+ (read-key-sequence "Enter key for binding: "))
(if (string-equal "\C-m" edt-key-definition)
(message "Key sequence not remembered")
(progn
- (set 'edt-learn-macro-count (+ edt-learn-macro-count 1))
+ (setq edt-learn-macro-count (+ edt-learn-macro-count 1))
(setq edt-last-replaced-key-definition
(lookup-key (current-global-map)
edt-key-definition))
@@ -2161,8 +2161,7 @@ Argument KEY is the name of a key. It can be a standard key or a function key.
Argument BINDING is the Emacs function to be bound to <KEY>."
(define-key edt-user-global-map key binding))
-;; For backward compatibility to existing edt-user.el files.
-(fset 'edt-bind-standard-key (symbol-function 'edt-bind-key))
+(define-obsolete-function-alias 'edt-bind-standard-key #'edt-bind-key "28.1")
(defun edt-bind-gold-key (key gold-binding)
"Binds <GOLD> standard key sequences to custom bindings in the EDT Emulator.
diff --git a/lisp/emulation/keypad.el b/lisp/emulation/keypad.el
index f7bebf78e44..e4f3c4d53ec 100644
--- a/lisp/emulation/keypad.el
+++ b/lisp/emulation/keypad.el
@@ -1,6 +1,6 @@
;;; keypad.el --- simplified keypad bindings
-;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Author: Kim F. Storm <storm@cua.dk>
;; Keywords: keyboard convenience
diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el
index dd7648c2b77..1e235831d6f 100644
--- a/lisp/emulation/viper-cmd.el
+++ b/lisp/emulation/viper-cmd.el
@@ -1,6 +1,6 @@
;;; viper-cmd.el --- Vi command support for Viper -*- lexical-binding:t -*-
-;; Copyright (C) 1997-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: viper
@@ -474,7 +474,7 @@
;; Modifies mode-line-buffer-identification.
(defun viper-refresh-mode-line ()
- (set (make-local-variable 'viper-mode-string)
+ (setq-local viper-mode-string
(cond ((eq viper-current-state 'emacs-state) viper-emacs-state-id)
((eq viper-current-state 'vi-state) viper-vi-state-id)
((eq viper-current-state 'replace-state) viper-replace-state-id)
@@ -1865,14 +1865,10 @@ Undo previous insertion and inserts new."
;; minibuffer and vice versa. Otherwise, command arguments will affect
;; minibuffer ops and insertions from the minibuffer will change those in
;; the normal buffers
- (make-local-variable 'viper-d-com)
- (make-local-variable 'viper-last-insertion)
- (make-local-variable 'viper-command-ring)
- (setq viper-d-com nil
- viper-last-insertion nil
- viper-command-ring nil)
- (funcall hook)
- ))
+ (setq-local viper-d-com nil)
+ (setq-local viper-last-insertion nil)
+ (setq-local viper-command-ring nil)
+ (funcall hook)))
;; This is a temp hook that uses free variables viper--init-message and viper-initial.
;; A dirty feature, but it is the simplest way to have it do the right thing.
diff --git a/lisp/emulation/viper-ex.el b/lisp/emulation/viper-ex.el
index 929b7a0bed6..238faed069f 100644
--- a/lisp/emulation/viper-ex.el
+++ b/lisp/emulation/viper-ex.el
@@ -1,6 +1,6 @@
;;; viper-ex.el --- functions implementing the Ex commands for Viper
-;; Copyright (C) 1994-1998, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1998, 2000-2021 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: viper
diff --git a/lisp/emulation/viper-init.el b/lisp/emulation/viper-init.el
index 6c4afe519f2..cede99bff73 100644
--- a/lisp/emulation/viper-init.el
+++ b/lisp/emulation/viper-init.el
@@ -1,6 +1,6 @@
;;; viper-init.el --- some common definitions for Viper
-;; Copyright (C) 1997-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: viper
@@ -475,7 +475,8 @@ text."
;; Fast keyseq and ESC keyseq timeouts
(defcustom viper-fast-keyseq-timeout 200
- "Key sequence separated by no more than this many milliseconds is viewed as a Vi-style macro, if such a macro is defined.
+ "Max milliseconds for a key sequence to be regarded as a Vi-style macro.
+Only regard key sequence as a macro if it is defined.
Setting this too high may slow down your typing. Setting this value too low
will make it hard to use Vi-style timeout macros."
:type 'integer
@@ -705,7 +706,7 @@ If nil, the cursor will move backwards without deleting anything."
(viper-deflocalvar viper-related-files-and-buffers-ring nil "")
(defcustom viper-related-files-and-buffers-ring nil
- "List of file and buffer names that are considered to be related to the current buffer.
+ "List of file and buffer names to consider related to the current buffer.
Related buffers can be cycled through via :R and :P commands."
:type 'boolean
:group 'viper-misc)
diff --git a/lisp/emulation/viper-keym.el b/lisp/emulation/viper-keym.el
index d76cf71b314..7209dc664b5 100644
--- a/lisp/emulation/viper-keym.el
+++ b/lisp/emulation/viper-keym.el
@@ -1,6 +1,6 @@
;;; viper-keym.el --- Viper keymaps -*- lexical-binding:t -*-
-;; Copyright (C) 1994-1997, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1997, 2000-2021 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: viper
@@ -69,7 +69,7 @@ major mode in effect."
:group 'viper)
(defcustom viper-want-ctl-h-help nil
- "If non-nil, C-h gets bound to help-command; otherwise, C-h gets the usual Vi bindings."
+ "If non-nil, bind C-h to help-command; otherwise, C-h gets the usual Vi bindings."
:type 'boolean
:group 'viper)
diff --git a/lisp/emulation/viper-macs.el b/lisp/emulation/viper-macs.el
index ac03cf9bd36..039ddabcdc3 100644
--- a/lisp/emulation/viper-macs.el
+++ b/lisp/emulation/viper-macs.el
@@ -1,6 +1,6 @@
;;; viper-macs.el --- functions implementing keyboard macros for Viper -*- lexical-binding:t -*-
-;; Copyright (C) 1994-1997, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1997, 2000-2021 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: viper
diff --git a/lisp/emulation/viper-mous.el b/lisp/emulation/viper-mous.el
index 928a3ef00ee..eec83dd05b5 100644
--- a/lisp/emulation/viper-mous.el
+++ b/lisp/emulation/viper-mous.el
@@ -1,6 +1,6 @@
;;; viper-mous.el --- mouse support for Viper
-;; Copyright (C) 1994-1997, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1997, 2001-2021 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: viper
diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el
index 83e45e1cd0c..07a234bab9b 100644
--- a/lisp/emulation/viper-util.el
+++ b/lisp/emulation/viper-util.el
@@ -1,6 +1,6 @@
;;; viper-util.el --- Utilities used by viper.el -*- lexical-binding:t -*-
-;; Copyright (C) 1994-1997, 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1997, 1999-2021 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: viper
@@ -249,15 +249,7 @@ Otherwise return the normal value."
(goto-char cur-pos)
result))
-;; Emacs used to count each multibyte character as several positions in the buffer,
-;; so we had to use Emacs's chars-in-region to count characters. Since 20.3,
-;; Emacs counts multibyte characters as 1 position. XEmacs has always been
-;; counting each char as just one pos. So, now we can simply subtract beg from
-;; end to determine the number of characters in a region.
(defun viper-chars-in-region (beg end &optional preserve-sign)
- ;;(let ((count (abs (if (fboundp 'chars-in-region)
- ;; (chars-in-region beg end)
- ;; (- end beg)))))
(let ((count (abs (- end beg))))
(if (and (< end beg) preserve-sign)
(- count)
@@ -604,7 +596,7 @@ Otherwise return the normal value."
(defun viper-save-setting (var message file &optional erase-msg)
(let* ((var-name (symbol-name var))
(var-val (if (boundp var) (eval var)))
- (regexp (format "^[^;]*%s[ \t\n]*[a-zA-Z---_']*[ \t\n)]" var-name))
+ (regexp (format "^[^;]*%s[ \t\n]*[a-zA-Z0-9---_']*[ \t\n)]" var-name))
(buf (find-file-noselect (substitute-in-file-name file)))
)
(message "%s" (or message ""))
diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el
index 59ca6298eb9..6c9428060fc 100644
--- a/lisp/emulation/viper.el
+++ b/lisp/emulation/viper.el
@@ -3,7 +3,7 @@
;; and a venomous VI PERil.
;; Viper Is also a Package for Emacs Rebels.
-;; Copyright (C) 1994-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2021 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Keywords: emulations
@@ -617,7 +617,7 @@ This startup message appears whenever you load Viper, unless you type `y' now."
;; This hook designed to enable Vi-style editing in comint-based modes."
(defun viper-comint-mode-hook ()
- (set (make-local-variable 'require-final-newline) nil)
+ (setq-local require-final-newline nil)
(setq viper-ex-style-editing nil
viper-ex-style-motion nil)
(viper-change-state-to-insert))
diff --git a/lisp/env.el b/lisp/env.el
index 6de90385a35..51247f1ff84 100644
--- a/lisp/env.el
+++ b/lisp/env.el
@@ -1,6 +1,6 @@
;;; env.el --- functions to manipulate environment variables -*- lexical-binding:t -*-
-;; Copyright (C) 1991, 1994, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1991, 1994, 2000-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: processes, unix
diff --git a/lisp/epa-dired.el b/lisp/epa-dired.el
index 4ff1ba33941..8a4f8933bf8 100644
--- a/lisp/epa-dired.el
+++ b/lisp/epa-dired.el
@@ -1,6 +1,6 @@
;;; epa-dired.el --- the EasyPG Assistant, dired extension -*- lexical-binding: t -*-
-;; Copyright (C) 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2021 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Keywords: PGP, GnuPG
diff --git a/lisp/epa-file.el b/lisp/epa-file.el
index 7fd41784746..e46e3684c8a 100644
--- a/lisp/epa-file.el
+++ b/lisp/epa-file.el
@@ -1,6 +1,6 @@
;;; epa-file.el --- the EasyPG Assistant, transparent file encryption -*- lexical-binding: t -*-
-;; Copyright (C) 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2021 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Keywords: PGP, GnuPG
@@ -309,7 +309,8 @@ encryption is used."
If no one is selected, symmetric encryption will be performed. "
recipients)
(if epa-file-encrypt-to
- (epg-list-keys context recipients)))))
+ (epg--filter-revoked-keys
+ (epg-list-keys context recipients))))))
(error
(epa-display-error context)
(if (setq entry (assoc file epa-file-passphrase-alist))
diff --git a/lisp/epa-hook.el b/lisp/epa-hook.el
index 6f12f8a6bfa..9ad952c6813 100644
--- a/lisp/epa-hook.el
+++ b/lisp/epa-hook.el
@@ -1,6 +1,6 @@
;;; epa-hook.el --- preloaded code to enable epa-file.el -*- lexical-binding: t -*-
-;; Copyright (C) 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2021 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Keywords: PGP, GnuPG
diff --git a/lisp/epa-mail.el b/lisp/epa-mail.el
index dd171ab6474..7e100569b0f 100644
--- a/lisp/epa-mail.el
+++ b/lisp/epa-mail.el
@@ -1,6 +1,6 @@
;;; epa-mail.el --- the EasyPG Assistant, minor-mode for mail composer -*- lexical-binding: t -*-
-;; Copyright (C) 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2021 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Keywords: PGP, GnuPG, mail, message
@@ -243,7 +243,7 @@ If no one is selected, symmetric encryption will be performed. "
(setq epa-last-coding-system-specified
(or coding-system-for-write
(select-safe-coding-system (point) (point-max)))))
-
+
;; Insert contents of requested attachments, if any.
(when (and (eq major-mode 'mail-mode) mail-encode-mml)
(mml-to-mime)
diff --git a/lisp/epa.el b/lisp/epa.el
index 25e055c201f..197cd92f977 100644
--- a/lisp/epa.el
+++ b/lisp/epa.el
@@ -1,6 +1,6 @@
;;; epa.el --- the EasyPG Assistant -*- lexical-binding: t -*-
-;; Copyright (C) 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2021 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Keywords: PGP, GnuPG
@@ -24,7 +24,6 @@
;;; Dependencies
(require 'epg)
-(require 'font-lock)
(eval-when-compile (require 'subr-x))
(require 'derived)
@@ -360,8 +359,8 @@ DOC is documentation text to insert at the start."
;; Find the end of the documentation text at the start.
;; Set POINT to where it ends, or nil if ends at eob.
- (unless (get-text-property point 'epa-list-keys)
- (setq point (next-single-property-change point 'epa-list-keys)))
+ (unless (get-text-property point 'epa-key)
+ (setq point (next-single-property-change point 'epa-key)))
;; If caller specified documentation text for that, replace the old
;; documentation text (if any) with what was specified.
@@ -1071,9 +1070,7 @@ If no one is selected, default secret key is used. "
(list 'epa-coding-system-used
epa-last-coding-system-specified
'front-sticky nil
- 'rear-nonsticky t
- 'start-open t
- 'end-open t)))))
+ 'rear-nonsticky t)))))
(define-obsolete-function-alias 'epa--derived-mode-p 'derived-mode-p "28.1")
@@ -1148,9 +1145,7 @@ If no one is selected, symmetric encryption will be performed. ")
(list 'epa-coding-system-used
epa-last-coding-system-specified
'front-sticky nil
- 'rear-nonsticky t
- 'start-open t
- 'end-open t)))))
+ 'rear-nonsticky t)))))
;;;; Key Management
diff --git a/lisp/epg-config.el b/lisp/epg-config.el
index 9f0c7e4c509..59d097c91f0 100644
--- a/lisp/epg-config.el
+++ b/lisp/epg-config.el
@@ -1,6 +1,6 @@
;;; epg-config.el --- configuration of the EasyPG Library
-;; Copyright (C) 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2021 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Keywords: PGP, GnuPG
diff --git a/lisp/epg.el b/lisp/epg.el
index 920b85398f3..b1f37cbbdcf 100644
--- a/lisp/epg.el
+++ b/lisp/epg.el
@@ -1,6 +1,6 @@
;;; epg.el --- the EasyPG Library -*- lexical-binding: t -*-
-;; Copyright (C) 1999-2000, 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2000, 2002-2021 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Keywords: PGP, GnuPG
@@ -1382,6 +1382,13 @@ NAME is either a string or a list of strings."
(setq pointer (cdr pointer)))
keys))
+(defun epg--filter-revoked-keys (keys)
+ (seq-remove (lambda (key)
+ (seq-find (lambda (user)
+ (eq (epg-user-id-validity user) 'revoked))
+ (epg-key-user-id-list key)))
+ keys))
+
(defun epg--args-from-sig-notations (notations)
(apply #'nconc
(mapcar
diff --git a/lisp/erc/ChangeLog.1 b/lisp/erc/ChangeLog.1
index fdf51954684..26c1bd689ef 100644
--- a/lisp/erc/ChangeLog.1
+++ b/lisp/erc/ChangeLog.1
@@ -11702,7 +11702,7 @@
* erc-speak.el, erc.el: New file.
- Copyright (C) 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/erc/ChangeLog.2 b/lisp/erc/ChangeLog.2
index 5ab459dcd81..b54e3b9af24 100644
--- a/lisp/erc/ChangeLog.2
+++ b/lisp/erc/ChangeLog.2
@@ -757,7 +757,7 @@
See ChangeLog.1 for earlier changes.
- Copyright (C) 2009-2020 Free Software Foundation, Inc.
+ Copyright (C) 2009-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-autoaway.el b/lisp/erc/erc-autoaway.el
index 0923ed6e735..a0085662e22 100644
--- a/lisp/erc/erc-autoaway.el
+++ b/lisp/erc/erc-autoaway.el
@@ -1,6 +1,6 @@
;;; erc-autoaway.el --- Provides autoaway for ERC
-;; Copyright (C) 2002-2004, 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2004, 2006-2021 Free Software Foundation, Inc.
;; Author: Jorgen Schaefer <forcer@forcix.cx>
;; Maintainer: Amin Bandali <bandali@gnu.org>
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index f99088d4c78..487dc7692ef 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -1,6 +1,6 @@
;;; erc-backend.el --- Backend network communication for ERC -*- lexical-binding:t -*-
-;; Copyright (C) 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;; Filename: erc-backend.el
;; Author: Lawrence Mitchell <wence@gmx.li>
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index b799b2427c6..71ff40877a8 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -1,6 +1,6 @@
;; erc-button.el --- A way of buttonizing certain things in ERC buffers -*- lexical-binding:t -*-
-;; Copyright (C) 1996-2004, 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2004, 2006-2021 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@delysid.org>
;; Maintainer: Amin Bandali <bandali@gnu.org>
@@ -242,7 +242,6 @@ global-level ERC button keys yet.")
(defun erc-button-setup ()
"Add ERC mode-level button movement keys. This is only done once."
- ;; Make XEmacs use `erc-button-face'.
;; Add keys.
(unless erc-button-keys-added
(define-key erc-mode-map (kbd "<backtab>") 'erc-button-previous)
diff --git a/lisp/erc/erc-capab.el b/lisp/erc/erc-capab.el
index 4afe6a7614b..06d4fbd9f6a 100644
--- a/lisp/erc/erc-capab.el
+++ b/lisp/erc/erc-capab.el
@@ -1,6 +1,6 @@
;;; erc-capab.el --- support for dancer-ircd and hyperion's CAPAB
-;; Copyright (C) 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2021 Free Software Foundation, Inc.
;; Maintainer: Amin Bandali <bandali@gnu.org>
diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el
index 1bce986a806..590785e91c2 100644
--- a/lisp/erc/erc-dcc.el
+++ b/lisp/erc/erc-dcc.el
@@ -1,6 +1,6 @@
;;; erc-dcc.el --- CTCP DCC module for ERC
-;; Copyright (C) 1993-1995, 1998, 2002-2004, 2006-2020 Free Software
+;; Copyright (C) 1993-1995, 1998, 2002-2004, 2006-2021 Free Software
;; Foundation, Inc.
;; Author: Ben A. Mesander <ben@gnu.ai.mit.edu>
@@ -83,7 +83,8 @@ All values of the list must be uppercase strings.")
(defvar erc-dcc-list nil
"List of DCC connections. Looks like:
- ((:nick \"nick!user@host\" :type GET :peer proc :parent proc :size size :file file)
+ ((:nick \"nick!user@host\" :type GET :peer proc
+ :parent proc :size size :file file)
(:nick \"nick!user@host\" :type CHAT :peer proc :parent proc)
(:nick \"nick\" :type SEND :peer server-proc :parent parent-proc :file
file :sent <marker> :confirmed <marker>))
diff --git a/lisp/erc/erc-desktop-notifications.el b/lisp/erc/erc-desktop-notifications.el
index 3a9a4a4bac6..056fb23777f 100644
--- a/lisp/erc/erc-desktop-notifications.el
+++ b/lisp/erc/erc-desktop-notifications.el
@@ -1,6 +1,6 @@
;; erc-desktop-notifications.el -- Send notification on PRIVMSG or mentions -*- lexical-binding:t -*-
-;; Copyright (C) 2012-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
;; Author: Julien Danjou <julien@danjou.info>
;; Maintainer: Amin Bandali <bandali@gnu.org>
diff --git a/lisp/erc/erc-ezbounce.el b/lisp/erc/erc-ezbounce.el
index 5c2faff96de..62238dd4344 100644
--- a/lisp/erc/erc-ezbounce.el
+++ b/lisp/erc/erc-ezbounce.el
@@ -1,6 +1,6 @@
;;; erc-ezbounce.el --- Handle EZBounce bouncer commands
-;; Copyright (C) 2002, 2004, 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002, 2004, 2006-2021 Free Software Foundation, Inc.
;; Author: Andreas Fuchs <asf@void.at>
;; Maintainer: Amin Bandali <bandali@gnu.org>
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index d09caf7aa12..83ef5f93fa7 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -1,6 +1,6 @@
;;; erc-fill.el --- Filling IRC messages in various ways
-;; Copyright (C) 2001-2004, 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2004, 2006-2021 Free Software Foundation, Inc.
;; Author: Andreas Fuchs <asf@void.at>
;; Mario Lang <mlang@delysid.org>
diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el
index a475f0a1770..aef68810dfa 100644
--- a/lisp/erc/erc-goodies.el
+++ b/lisp/erc/erc-goodies.el
@@ -1,6 +1,6 @@
;; erc-goodies.el --- Collection of ERC modules
-;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Author: Jorgen Schaefer <forcer@forcix.cx>
;; Maintainer: Amin Bandali <bandali@gnu.org>
@@ -35,8 +35,7 @@
(defun erc-imenu-setup ()
"Setup Imenu support in an ERC buffer."
- (set (make-local-variable 'imenu-create-index-function)
- 'erc-create-imenu-index))
+ (setq-local imenu-create-index-function #'erc-create-imenu-index))
(add-hook 'erc-mode-hook 'erc-imenu-setup)
(autoload 'erc-create-imenu-index "erc-imenu" "Imenu index creation function")
diff --git a/lisp/erc/erc-ibuffer.el b/lisp/erc/erc-ibuffer.el
index 556a25e3e7b..5a002ccae3e 100644
--- a/lisp/erc/erc-ibuffer.el
+++ b/lisp/erc/erc-ibuffer.el
@@ -1,6 +1,6 @@
;;; erc-ibuffer.el --- ibuffer integration with ERC
-;; Copyright (C) 2002, 2004, 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002, 2004, 2006-2021 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@delysid.org>
;; Maintainer: Amin Bandali <bandali@gnu.org>
diff --git a/lisp/erc/erc-identd.el b/lisp/erc/erc-identd.el
index e2115f5f4bb..5f1aab1784b 100644
--- a/lisp/erc/erc-identd.el
+++ b/lisp/erc/erc-identd.el
@@ -1,6 +1,6 @@
;;; erc-identd.el --- RFC1413 (identd authentication protocol) server
-;; Copyright (C) 2003, 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2006-2021 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
;; Maintainer: Amin Bandali <bandali@gnu.org>
diff --git a/lisp/erc/erc-imenu.el b/lisp/erc/erc-imenu.el
index c05633aaea8..1a2d8e2755f 100644
--- a/lisp/erc/erc-imenu.el
+++ b/lisp/erc/erc-imenu.el
@@ -1,6 +1,6 @@
;;; erc-imenu.el -- Imenu support for ERC
-;; Copyright (C) 2001-2002, 2004, 2006-2020 Free Software Foundation,
+;; Copyright (C) 2001-2002, 2004, 2006-2021 Free Software Foundation,
;; Inc.
;; Author: Mario Lang <mlang@delysid.org>
diff --git a/lisp/erc/erc-join.el b/lisp/erc/erc-join.el
index 79c111082f6..947b2949690 100644
--- a/lisp/erc/erc-join.el
+++ b/lisp/erc/erc-join.el
@@ -1,6 +1,6 @@
;;; erc-join.el --- autojoin channels on connect and reconnects
-;; Copyright (C) 2002-2004, 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2004, 2006-2021 Free Software Foundation, Inc.
;; Author: Alex Schroeder <alex@gnu.org>
;; Maintainer: Amin Bandali <bandali@gnu.org>
diff --git a/lisp/erc/erc-lang.el b/lisp/erc/erc-lang.el
index 95b94f6a072..b86a8d0be2b 100644
--- a/lisp/erc/erc-lang.el
+++ b/lisp/erc/erc-lang.el
@@ -1,6 +1,6 @@
;;; erc-lang.el --- provide the LANG command to ERC
-;; Copyright (C) 2002, 2004, 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002, 2004, 2006-2021 Free Software Foundation, Inc.
;; Author: Alex Schroeder <alex@gnu.org>
;; Maintainer: Amin Bandali <bandali@gnu.org>
diff --git a/lisp/erc/erc-list.el b/lisp/erc/erc-list.el
index 036d7733ed7..cf150e74ab5 100644
--- a/lisp/erc/erc-list.el
+++ b/lisp/erc/erc-list.el
@@ -1,6 +1,6 @@
;;; erc-list.el --- /list support for ERC -*- lexical-binding:t -*-
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Tom Tromey <tromey@redhat.com>
;; Maintainer: Amin Bandali <bandali@gnu.org>
@@ -188,15 +188,15 @@
(lambda (_proc _parsed)
(remove-hook 'erc-server-322-functions 'erc-list-handle-322 t)))
;; Find the list buffer, empty it, and display it.
- (set (make-local-variable 'erc-list-buffer)
- (get-buffer-create (concat "*Channels of "
- erc-server-announced-name
- "*")))
+ (setq-local erc-list-buffer
+ (get-buffer-create (concat "*Channels of "
+ erc-server-announced-name
+ "*")))
(with-current-buffer erc-list-buffer
(erc-list-menu-mode)
(setq buffer-read-only nil)
(erase-buffer)
- (set (make-local-variable 'erc-list-server-buffer) server-buffer)
+ (setq-local erc-list-server-buffer server-buffer)
(setq buffer-read-only t))
(pop-to-buffer erc-list-buffer))
t)
@@ -211,7 +211,7 @@ should usually be one or more channels, separated by commas.
Please note that this function only works with IRC servers which conform
to RFC and send the LIST header (#321) at start of list transmission."
(erc-with-server-buffer
- (set (make-local-variable 'erc-list-last-argument) line)
+ (setq-local erc-list-last-argument line)
(erc-once-with-server-event
321
(let ((buf (current-buffer)))
diff --git a/lisp/erc/erc-log.el b/lisp/erc/erc-log.el
index 2166123e674..4540ec6808f 100644
--- a/lisp/erc/erc-log.el
+++ b/lisp/erc/erc-log.el
@@ -1,6 +1,6 @@
;;; erc-log.el --- Logging facilities for ERC.
-;; Copyright (C) 2003-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
;; Author: Lawrence Mitchell <wence@gmx.li>
;; Maintainer: Amin Bandali <bandali@gnu.org>
@@ -267,7 +267,7 @@ The current buffer is given by BUFFER."
(with-current-buffer buffer
(auto-save-mode -1)
(setq buffer-file-name nil)
- (set (make-local-variable 'write-file-functions) '(erc-save-buffer-in-logs))
+ (add-hook 'write-file-functions #'erc-save-buffer-in-logs nil t)
(when erc-log-insert-log-on-open
(ignore-errors
(save-excursion
@@ -414,8 +414,7 @@ You can save every individual message by putting this function on
(or buffer (setq buffer (current-buffer)))
(when (erc-logging-enabled buffer)
(let ((file (erc-current-logfile buffer))
- (coding-system erc-log-file-coding-system)
- (inhibit-clash-detection t)) ; needed for XEmacs
+ (coding-system erc-log-file-coding-system))
(save-excursion
(with-current-buffer buffer
(save-restriction
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index b3145674f29..153742a6706 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -1,6 +1,6 @@
;;; erc-match.el --- Highlight messages matching certain regexps
-;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Author: Andreas Fuchs <asf@void.at>
;; Maintainer: Amin Bandali <bandali@gnu.org>
diff --git a/lisp/erc/erc-menu.el b/lisp/erc/erc-menu.el
index 9c02899057b..4c092c834bc 100644
--- a/lisp/erc/erc-menu.el
+++ b/lisp/erc/erc-menu.el
@@ -1,6 +1,6 @@
;; erc-menu.el -- Menu-bar definitions for ERC
-;; Copyright (C) 2001-2002, 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2002, 2004-2021 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@delysid.org>
;; Maintainer: Amin Bandali <bandali@gnu.org>
@@ -114,22 +114,19 @@ ERC menu yet.")
;; make sure the menu only gets defined once, since Emacs 22
;; activates it immediately
(easy-menu-define erc-menu erc-mode-map "ERC menu" erc-menu-definition)
- (setq erc-menu-defined t))
- (erc-menu-add))
- ((erc-menu-remove)
- ;; `easy-menu-remove' is a no-op in Emacs 22
+ (setq erc-menu-defined t)))
+ (;; `easy-menu-remove' is a no-op in Emacs 22
(message "You might have to restart Emacs to remove the ERC menu")))
-;; silence byte-compiler warning
-(defvar erc-menu)
-
(defun erc-menu-add ()
"Add the ERC menu to the current buffer."
- (easy-menu-add erc-menu erc-mode-map))
+ (declare (obsolete nil "28.1"))
+ nil)
(defun erc-menu-remove ()
"Remove the ERC menu from the current buffer."
- (easy-menu-remove erc-menu))
+ (declare (obsolete nil "28.1"))
+ nil)
(provide 'erc-menu)
diff --git a/lisp/erc/erc-netsplit.el b/lisp/erc/erc-netsplit.el
index e3dc52bc4ec..9fd3cfe1cc4 100644
--- a/lisp/erc/erc-netsplit.el
+++ b/lisp/erc/erc-netsplit.el
@@ -1,6 +1,6 @@
;;; erc-netsplit.el --- Reduce JOIN/QUIT messages on netsplits
-;; Copyright (C) 2002-2004, 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2004, 2006-2021 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@delysid.org>
;; Maintainer: Amin Bandali <bandali@gnu.org>
diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el
index d957fcee056..9c2bb9dfee3 100644
--- a/lisp/erc/erc-networks.el
+++ b/lisp/erc/erc-networks.el
@@ -1,6 +1,6 @@
;;; erc-networks.el --- IRC networks
-;; Copyright (C) 2002, 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002, 2004-2021 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@lexx.delysid.org>
;; Maintainer: Amin Bandali <bandali@gnu.org>
diff --git a/lisp/erc/erc-notify.el b/lisp/erc/erc-notify.el
index 144a981f832..098049edc68 100644
--- a/lisp/erc/erc-notify.el
+++ b/lisp/erc/erc-notify.el
@@ -1,6 +1,6 @@
;;; erc-notify.el --- Online status change notification -*- lexical-binding:t -*-
-;; Copyright (C) 2002-2004, 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2004, 2006-2021 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@lexx.delysid.org>
;; Maintainer: Amin Bandali <bandali@gnu.org>
diff --git a/lisp/erc/erc-page.el b/lisp/erc/erc-page.el
index 339beb0e85f..0cb60f5efa0 100644
--- a/lisp/erc/erc-page.el
+++ b/lisp/erc/erc-page.el
@@ -1,6 +1,6 @@
;; erc-page.el - CTCP PAGE support for ERC
-;; Copyright (C) 2002, 2004, 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002, 2004, 2006-2021 Free Software Foundation, Inc.
;; Maintainer: Amin Bandali <bandali@gnu.org>
diff --git a/lisp/erc/erc-pcomplete.el b/lisp/erc/erc-pcomplete.el
index f8b7e13be02..ab4c7c580c6 100644
--- a/lisp/erc/erc-pcomplete.el
+++ b/lisp/erc/erc-pcomplete.el
@@ -1,6 +1,6 @@
;;; erc-pcomplete.el --- Provides programmable completion for ERC
-;; Copyright (C) 2002-2004, 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2004, 2006-2021 Free Software Foundation, Inc.
;; Author: Sacha Chua <sacha@free.net.ph>
;; Maintainer: Amin Bandali <bandali@gnu.org>
@@ -89,18 +89,16 @@ for use on `completion-at-point-function'."
(defun pcomplete-erc-setup ()
"Setup `erc-mode' to use pcomplete."
- (set (make-local-variable 'pcomplete-ignore-case)
- t)
- (set (make-local-variable 'pcomplete-use-paring)
- nil)
- (set (make-local-variable 'pcomplete-parse-arguments-function)
- 'pcomplete-erc-parse-arguments)
- (set (make-local-variable 'pcomplete-command-completion-function)
- 'pcomplete/erc-mode/complete-command)
- (set (make-local-variable 'pcomplete-command-name-function)
- 'pcomplete-erc-command-name)
- (set (make-local-variable 'pcomplete-default-completion-function)
- (lambda () (pcomplete-here (pcomplete-erc-nicks)))))
+ (setq-local pcomplete-ignore-case t)
+ (setq-local pcomplete-use-paring nil)
+ (setq-local pcomplete-parse-arguments-function
+ #'pcomplete-erc-parse-arguments)
+ (setq-local pcomplete-command-completion-function
+ #'pcomplete/erc-mode/complete-command)
+ (setq-local pcomplete-command-name-function
+ #'pcomplete-erc-command-name)
+ (setq-local pcomplete-default-completion-function
+ (lambda () (pcomplete-here (pcomplete-erc-nicks)))))
;;; Programmable completion logic
diff --git a/lisp/erc/erc-replace.el b/lisp/erc/erc-replace.el
index 8bd97be9494..91fafbb6308 100644
--- a/lisp/erc/erc-replace.el
+++ b/lisp/erc/erc-replace.el
@@ -1,6 +1,6 @@
;; erc-replace.el -- wash and massage messages inserted into the buffer
-;; Copyright (C) 2001-2002, 2004, 2006-2020 Free Software Foundation,
+;; Copyright (C) 2001-2002, 2004, 2006-2021 Free Software Foundation,
;; Inc.
;; Author: Andreas Fuchs <asf@void.at>
diff --git a/lisp/erc/erc-ring.el b/lisp/erc/erc-ring.el
index bc5f0ed23b3..3813eafe004 100644
--- a/lisp/erc/erc-ring.el
+++ b/lisp/erc/erc-ring.el
@@ -1,6 +1,6 @@
;; erc-ring.el -- Command history handling for erc using ring.el
-;; Copyright (C) 2001-2004, 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2004, 2006-2021 Free Software Foundation, Inc.
;; Author: Alex Schroeder <alex@gnu.org>
;; Maintainer: Amin Bandali <bandali@gnu.org>
diff --git a/lisp/erc/erc-services.el b/lisp/erc/erc-services.el
index c0011f9808c..9ef8b7f46ab 100644
--- a/lisp/erc/erc-services.el
+++ b/lisp/erc/erc-services.el
@@ -1,6 +1,6 @@
;;; erc-services.el --- Identify to NickServ -*- lexical-binding:t -*-
-;; Copyright (C) 2002-2004, 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2004, 2006-2021 Free Software Foundation, Inc.
;; Maintainer: Amin Bandali <bandali@gnu.org>
;; URL: https://www.emacswiki.org/emacs/ErcNickserv
@@ -168,8 +168,19 @@ You can also use \\[erc-nickserv-identify-mode] to change modes."
:group 'erc-services
:type 'boolean)
+(defcustom erc-use-auth-source-for-nickserv-password nil
+ "Query auth-source for a password when identifiying to NickServ.
+This option has an no effect if `erc-prompt-for-nickserv-password'
+is non-nil, and passwords from `erc-nickserv-passwords' take
+precedence."
+ :version "28.1"
+ :group 'erc-services
+ :type 'boolean)
+
(defcustom erc-nickserv-passwords nil
"Passwords used when identifying to NickServ automatically.
+`erc-prompt-for-nickserv-password' must be nil for these
+passwords to be used.
Example of use:
(setq erc-nickserv-passwords
@@ -375,7 +386,8 @@ Make sure it is the real NickServ for this network.
If `erc-prompt-for-nickserv-password' is non-nil, prompt the user for the
password for this nickname, otherwise try to send it automatically."
(unless (and (null erc-nickserv-passwords)
- (null erc-prompt-for-nickserv-password))
+ (null erc-prompt-for-nickserv-password)
+ (null erc-use-auth-source-for-nickserv-password))
(let* ((network (erc-network))
(sender (erc-nickserv-alist-sender network))
(identify-regex (erc-nickserv-alist-regexp network))
@@ -394,30 +406,49 @@ password for this nickname, otherwise try to send it automatically."
(defun erc-nickserv-identify-on-connect (_server nick)
"Identify to Nickserv after the connection to the server is established."
(unless (or (and (null erc-nickserv-passwords)
- (null erc-prompt-for-nickserv-password))
- (and (eq erc-nickserv-identify-mode 'both)
- (erc-nickserv-alist-regexp (erc-network))))
+ (null erc-prompt-for-nickserv-password)
+ (null erc-use-auth-source-for-nickserv-password))
+ (and (eq erc-nickserv-identify-mode 'both)
+ (erc-nickserv-alist-regexp (erc-network))))
(erc-nickserv-call-identify-function nick)))
(defun erc-nickserv-identify-on-nick-change (nick _old-nick)
"Identify to Nickserv whenever your nick changes."
(unless (or (and (null erc-nickserv-passwords)
- (null erc-prompt-for-nickserv-password))
- (and (eq erc-nickserv-identify-mode 'both)
- (erc-nickserv-alist-regexp (erc-network))))
+ (null erc-prompt-for-nickserv-password)
+ (null erc-use-auth-source-for-nickserv-password))
+ (and (eq erc-nickserv-identify-mode 'both)
+ (erc-nickserv-alist-regexp (erc-network))))
(erc-nickserv-call-identify-function nick)))
+(defun erc-nickserv-get-password (nickname)
+ "Return the password for NICKNAME from configured sources.
+
+It uses `erc-nickserv-passwords' and additionally auth-source
+when `erc-use-auth-source-for-nickserv-password' is not nil."
+ (or
+ (when erc-nickserv-passwords
+ (cdr (assoc nickname
+ (nth 1 (assoc (erc-network)
+ erc-nickserv-passwords)))))
+ (when erc-use-auth-source-for-nickserv-password
+ (let* ((secret (nth 0 (auth-source-search
+ :max 1 :require '(:secret)
+ :host (erc-with-server-buffer erc-session-server)
+ :port (format ; ensure we have a string
+ "%s" (erc-with-server-buffer erc-session-port))
+ :user nickname))))
+ (when secret
+ (let ((passwd (plist-get secret :secret)))
+ (if (functionp passwd) (funcall passwd) passwd)))))))
+
(defun erc-nickserv-call-identify-function (nickname)
"Call `erc-nickserv-identify'.
Either call it interactively or run it with NICKNAME's password,
depending on the value of `erc-prompt-for-nickserv-password'."
(if erc-prompt-for-nickserv-password
(call-interactively 'erc-nickserv-identify)
- (when erc-nickserv-passwords
- (erc-nickserv-identify
- (cdr (assoc nickname
- (nth 1 (assoc (erc-network)
- erc-nickserv-passwords))))))))
+ (erc-nickserv-identify (erc-nickserv-get-password nickname))))
(defvar erc-auto-discard-away)
@@ -451,6 +482,7 @@ When called interactively, read the password using `read-passwd'."
(provide 'erc-services)
+
;;; erc-services.el ends here
;;
;; Local Variables:
diff --git a/lisp/erc/erc-sound.el b/lisp/erc/erc-sound.el
index 91ce1c62443..edde9737ff9 100644
--- a/lisp/erc/erc-sound.el
+++ b/lisp/erc/erc-sound.el
@@ -1,6 +1,6 @@
;;; erc-sound.el --- CTCP SOUND support for ERC
-;; Copyright (C) 2002-2003, 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2003, 2006-2021 Free Software Foundation, Inc.
;; Maintainer: Amin Bandali <bandali@gnu.org>
;; URL: https://www.emacswiki.org/emacs/ErcSound
diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el
index b64e42b7ee4..c2be23990f1 100644
--- a/lisp/erc/erc-speedbar.el
+++ b/lisp/erc/erc-speedbar.el
@@ -1,6 +1,6 @@
;;; erc-speedbar.el --- Speedbar support for ERC
-;; Copyright (C) 2001-2004, 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2004, 2006-2021 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@delysid.org>
;; Contributor: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/erc/erc-spelling.el b/lisp/erc/erc-spelling.el
index cedffbc56d9..44a3e358812 100644
--- a/lisp/erc/erc-spelling.el
+++ b/lisp/erc/erc-spelling.el
@@ -1,6 +1,6 @@
;;; erc-spelling.el --- use flyspell in ERC
-;; Copyright (C) 2005-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2005-2021 Free Software Foundation, Inc.
;; Author: Jorgen Schaefer <forcer@forcix.cx>
;; Maintainer: Amin Bandali <bandali@gnu.org>
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 08970f2d70e..c7dfb0807bc 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -1,6 +1,6 @@
;;; erc-stamp.el --- Timestamping for ERC messages -*- lexical-binding:t -*-
-;; Copyright (C) 2002-2004, 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2004, 2006-2021 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@delysid.org>
;; Maintainer: Amin Bandali <bandali@gnu.org>
diff --git a/lisp/erc/erc-status-sidebar.el b/lisp/erc/erc-status-sidebar.el
index 08dc8d6015f..ff51026088a 100644
--- a/lisp/erc/erc-status-sidebar.el
+++ b/lisp/erc/erc-status-sidebar.el
@@ -1,6 +1,6 @@
;;; erc-status-sidebar.el --- HexChat-like activity overview for ERC
-;; Copyright (C) 2017, 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017, 2020-2021 Free Software Foundation, Inc.
;; Author: Andrew Barbarello
;; Maintainer: Amin Bandali <bandali@gnu.org>
diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el
index 60f0cfa942f..d6ad847c5b9 100644
--- a/lisp/erc/erc-track.el
+++ b/lisp/erc/erc-track.el
@@ -1,6 +1,6 @@
;;; erc-track.el --- Track modified channel buffers -*- lexical-binding:t -*-
-;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@delysid.org>
;; Maintainer: Amin Bandali <bandali@gnu.org>
diff --git a/lisp/erc/erc-truncate.el b/lisp/erc/erc-truncate.el
index fff073ad62b..f4514ca1371 100644
--- a/lisp/erc/erc-truncate.el
+++ b/lisp/erc/erc-truncate.el
@@ -1,6 +1,6 @@
;;; erc-truncate.el --- Functions for truncating ERC buffers
-;; Copyright (C) 2003-2004, 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2004, 2006-2021 Free Software Foundation, Inc.
;; Author: Andreas Fuchs <asf@void.at>
;; Maintainer: Amin Bandali <bandali@gnu.org>
diff --git a/lisp/erc/erc-xdcc.el b/lisp/erc/erc-xdcc.el
index 2a236d26039..6808f24911d 100644
--- a/lisp/erc/erc-xdcc.el
+++ b/lisp/erc/erc-xdcc.el
@@ -1,6 +1,6 @@
;;; erc-xdcc.el --- XDCC file-server support for ERC
-;; Copyright (C) 2003-2004, 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2004, 2006-2021 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@delysid.org>
;; Maintainer: Amin Bandali <bandali@gnu.org>
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index e35ae0cfd87..bb68173b6dc 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1,6 +1,6 @@
;; erc.el --- An Emacs Internet Relay Chat client -*- lexical-binding:t -*-
-;; Copyright (C) 1997-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
;; Author: Alexander L. Belikoff (alexander@belikoff.net)
;; Contributors: Sergey Berezin (sergey.berezin@cs.cmu.edu),
@@ -58,7 +58,6 @@
(load "erc-loaddefs" nil t)
(require 'cl-lib)
-(require 'font-lock)
(require 'format-spec)
(require 'pp)
(require 'thingatpt)
@@ -1047,8 +1046,8 @@ anyway."
(make-obsolete-variable 'erc-send-pre-hook 'erc-pre-send-functions "27.1")
(defcustom erc-pre-send-functions nil
- "List of functions called to possibly alter the string that is sent.
-The functions are called with one argument, a `erc-input' struct,
+ "Special hook run to possibly alter the string that is sent.
+The functions are called with one argument, an `erc-input' struct,
and should alter that struct.
The struct has three slots:
@@ -1057,7 +1056,7 @@ The struct has three slots:
`insertp': Whether the string should be inserted into the erc buffer.
`sendp': Whether the string should be sent to the irc server."
:group 'erc
- :type '(repeat function)
+ :type 'hook
:version "27.1")
(defvar erc-insert-this t
@@ -1296,9 +1295,9 @@ Example:
(define-erc-module replace nil
\"This mode replaces incoming text according to `erc-replace-alist'.\"
((add-hook \\='erc-insert-modify-hook
- \\='erc-replace-insert))
+ #\\='erc-replace-insert))
((remove-hook \\='erc-insert-modify-hook
- \\='erc-replace-insert)))"
+ #\\='erc-replace-insert)))"
(declare (doc-string 3))
(let* ((sn (symbol-name name))
(mode (intern (format "erc-%s-mode" (downcase sn))))
@@ -1489,14 +1488,14 @@ Defaults to the server buffer."
(define-derived-mode erc-mode fundamental-mode "ERC"
"Major mode for Emacs IRC."
(setq local-abbrev-table erc-mode-abbrev-table)
- (set (make-local-variable 'next-line-add-newlines) nil)
+ (setq-local next-line-add-newlines nil)
(setq line-move-ignore-invisible t)
- (set (make-local-variable 'paragraph-separate)
- (concat "\C-l\\|\\(^" (regexp-quote (erc-prompt)) "\\)"))
- (set (make-local-variable 'paragraph-start)
- (concat "\\(" (regexp-quote (erc-prompt)) "\\)"))
+ (setq-local paragraph-separate
+ (concat "\C-l\\|\\(^" (regexp-quote (erc-prompt)) "\\)"))
+ (setq-local paragraph-start
+ (concat "\\(" (regexp-quote (erc-prompt)) "\\)"))
(setq-local completion-ignore-case t)
- (add-hook 'completion-at-point-functions 'erc-complete-word-at-point nil t))
+ (add-hook 'completion-at-point-functions #'erc-complete-word-at-point nil t))
;; activation
@@ -2586,7 +2585,7 @@ This function adds `erc-lurker-update-status' to
most recent PRIVMSG as well as initializing the state variable
storing this information."
(setq erc-lurker-state (make-hash-table :test 'equal))
- (add-hook 'erc-insert-pre-hook 'erc-lurker-update-status))
+ (add-hook 'erc-insert-pre-hook #'erc-lurker-update-status))
(defun erc-lurker-cleanup ()
"Remove all last PRIVMSG state older than `erc-lurker-threshold-time'.
@@ -2695,7 +2694,7 @@ otherwise `erc-server-announced-name'. SERVER is matched against
(defun erc-add-targets (scope target-list)
(let ((targets
(mapcar (lambda (targets) (member scope targets)) target-list)))
- (cdr (apply 'append (delete nil targets)))))
+ (cdr (apply #'append (delete nil targets)))))
(defun erc-hide-current-message-p (parsed)
"Predicate indicating whether the parsed ERC response PARSED should be hidden.
@@ -2862,7 +2861,9 @@ need this when pasting multiple lines of text."
(if (string-match "^\\s-*$" line)
nil
(string-match "^ ?\\(.*\\)" line)
- (erc-process-input-line (match-string 1 line) nil t)))
+ (let ((msg (match-string 1 line)))
+ (erc-display-msg msg)
+ (erc-process-input-line msg nil t))))
(put 'erc-cmd-SAY 'do-not-parse-args t)
(defun erc-cmd-SET (line)
@@ -3037,7 +3038,7 @@ If no USER argument is specified, list the contents of `erc-ignore-list'."
(erc-display-message
nil 'notice (current-buffer) 'ops
?i (length ops) ?s (if (> (length ops) 1) "s" "")
- ?o (mapconcat 'identity ops " "))
+ ?o (mapconcat #'identity ops " "))
(erc-display-message nil 'notice (current-buffer) 'ops-none)))
t)
@@ -3208,7 +3209,7 @@ command."
(defun erc-cmd-KICK (target &optional reason-or-nick &rest reasonwords)
"Kick the user indicated in LINE from the current channel.
LINE has the format: \"#CHANNEL NICK REASON\" or \"NICK REASON\"."
- (let ((reasonstring (mapconcat 'identity reasonwords " ")))
+ (let ((reasonstring (mapconcat #'identity reasonwords " ")))
(if (string= "" reasonstring)
(setq reasonstring (format "Kicked by %s" (erc-current-nick))))
(if (erc-channel-p target)
@@ -3743,7 +3744,7 @@ the message given by REASON."
" -"
(make-string (length people) ?o)
" "
- (mapconcat 'identity people " ")))
+ (mapconcat #'identity people " ")))
t))
(defun erc-cmd-OP (&rest people)
@@ -3753,7 +3754,7 @@ the message given by REASON."
" +"
(make-string (length people) ?o)
" "
- (mapconcat 'identity people " ")))
+ (mapconcat #'identity people " ")))
t))
(defun erc-cmd-TIME (&optional line)
@@ -3951,7 +3952,7 @@ Unban all currently banned users in the current channel."
(erc-server-send
(format "MODE %s -%s %s" (erc-default-target)
(make-string (length x) ?b)
- (mapconcat 'identity x " "))))
+ (mapconcat #'identity x " "))))
(erc-group-list bans 3))))
t))))
@@ -4015,8 +4016,7 @@ If FACE is non-nil, it will be used to propertize the prompt. If it is nil,
;; of the prompt, but stuff typed in front of the prompt
;; shall remain part of the prompt.
(setq prompt (propertize prompt
- 'start-open t ; XEmacs
- 'rear-nonsticky t ; Emacs
+ 'rear-nonsticky t
'erc-prompt t
'field t
'front-sticky t
@@ -4183,7 +4183,7 @@ Displays PROC and PARSED appropriately using `erc-display-message'."
(erc-display-message
parsed 'notice proc
(mapconcat
- 'identity
+ #'identity
(let (res)
(mapc #'(lambda (x)
(if (stringp x)
@@ -5553,12 +5553,10 @@ This returns non-nil only if we actually send anything."
;; Instead `erc-pre-send-functions' is used as a filter to do
;; allow both changing and suppressing the string.
(run-hook-with-args 'erc-send-pre-hook input)
- (setq state (make-erc-input :string str
+ (setq state (make-erc-input :string str ;May be != from `input' now!
:insertp erc-insert-this
:sendp erc-send-this))
- (dolist (func erc-pre-send-functions)
- ;; The functions can return nil to inhibit sending.
- (funcall func state))
+ (run-hook-with-args 'erc-pre-send-functions state)
(when (and (erc-input-sendp state)
erc-send-this)
(let ((string (erc-input-string state)))
@@ -5579,26 +5577,26 @@ This returns non-nil only if we actually send anything."
(erc-process-input-line (concat string "\n") t nil))
t))))))
-(defun erc-display-command (line)
- (when erc-insert-this
- (let ((insert-position (point)))
- (unless erc-hide-prompt
- (erc-display-prompt nil nil (erc-command-indicator)
- (and (erc-command-indicator)
- 'erc-command-indicator-face)))
- (let ((beg (point)))
- (insert line)
- (erc-put-text-property beg (point)
- 'font-lock-face 'erc-command-indicator-face)
- (insert "\n"))
- (when (processp erc-server-process)
- (set-marker (process-mark erc-server-process) (point)))
- (set-marker erc-insert-marker (point))
- (save-excursion
- (save-restriction
- (narrow-to-region insert-position (point))
- (run-hooks 'erc-send-modify-hook)
- (run-hooks 'erc-send-post-hook))))))
+;; (defun erc-display-command (line)
+;; (when erc-insert-this
+;; (let ((insert-position (point)))
+;; (unless erc-hide-prompt
+;; (erc-display-prompt nil nil (erc-command-indicator)
+;; (and (erc-command-indicator)
+;; 'erc-command-indicator-face)))
+;; (let ((beg (point)))
+;; (insert line)
+;; (erc-put-text-property beg (point)
+;; 'font-lock-face 'erc-command-indicator-face)
+;; (insert "\n"))
+;; (when (processp erc-server-process)
+;; (set-marker (process-mark erc-server-process) (point)))
+;; (set-marker erc-insert-marker (point))
+;; (save-excursion
+;; (save-restriction
+;; (narrow-to-region insert-position (point))
+;; (run-hooks 'erc-send-modify-hook)
+;; (run-hooks 'erc-send-post-hook))))))
(defun erc-display-msg (line)
"Display LINE as a message of the user to the current target at the
@@ -6495,8 +6493,7 @@ if `erc-away' is non-nil."
(format-spec erc-header-line-format spec)
nil)))
(cond (erc-header-line-uses-tabbar-p
- (set (make-local-variable 'tabbar--local-hlf)
- header-line-format)
+ (setq-local tabbar--local-hlf header-line-format)
(kill-local-variable 'header-line-format))
((null header)
(setq header-line-format nil))
@@ -6564,7 +6561,7 @@ If optional argument HERE is non-nil, insert version number at point."
If optional argument HERE is non-nil, insert version number at point."
(interactive "P")
(let ((string
- (mapconcat 'identity
+ (mapconcat #'identity
(let (modes (case-fold-search nil))
(dolist (var (apropos-internal "^erc-.*mode$"))
(when (and (boundp var)
@@ -6818,7 +6815,8 @@ See also `format-spec'."
;;; Various hook functions
-(add-hook 'kill-buffer-hook 'erc-kill-buffer-function)
+;; FIXME: Don't set the hook globally!
+(add-hook 'kill-buffer-hook #'erc-kill-buffer-function)
(defcustom erc-kill-server-hook '(erc-kill-server)
"Invoked whenever a server buffer is killed via `kill-buffer'."
diff --git a/lisp/eshell/em-alias.el b/lisp/eshell/em-alias.el
index 67e0c3fc08b..ee7f4633e7b 100644
--- a/lisp/eshell/em-alias.el
+++ b/lisp/eshell/em-alias.el
@@ -1,6 +1,6 @@
;;; em-alias.el --- creation and management of command aliases -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
diff --git a/lisp/eshell/em-banner.el b/lisp/eshell/em-banner.el
index 53d5fb2f6ea..034fa059b16 100644
--- a/lisp/eshell/em-banner.el
+++ b/lisp/eshell/em-banner.el
@@ -1,6 +1,6 @@
;;; em-banner.el --- sample module that displays a login banner -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
diff --git a/lisp/eshell/em-basic.el b/lisp/eshell/em-basic.el
index 6cfc89cce62..64fc7e7f03b 100644
--- a/lisp/eshell/em-basic.el
+++ b/lisp/eshell/em-basic.el
@@ -1,6 +1,6 @@
;;; em-basic.el --- basic shell builtin commands -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -90,11 +90,10 @@ or `eshell-printn' for display."
(car args))
(t
(mapcar
- (function
- (lambda (arg)
- (if (stringp arg)
- (set-text-properties 0 (length arg) nil arg))
- arg))
+ (lambda (arg)
+ (if (stringp arg)
+ (set-text-properties 0 (length arg) nil arg))
+ arg)
args)))))
(if output-newline
(cond
diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el
index 8a444c91001..0200631da66 100644
--- a/lisp/eshell/em-cmpl.el
+++ b/lisp/eshell/em-cmpl.el
@@ -1,6 +1,6 @@
;;; em-cmpl.el --- completion using the TAB key -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -210,9 +210,8 @@ to writing a completion function."
:group 'eshell-cmpl)
(defcustom eshell-command-completion-function
- (function
- (lambda ()
- (pcomplete-here (eshell-complete-commands-list))))
+ (lambda ()
+ (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)
@@ -224,12 +223,11 @@ to writing a completion function."
:group 'eshell-cmpl)
(defcustom eshell-default-completion-function
- (function
- (lambda ()
- (while (pcomplete-here
- (pcomplete-dirs-or-entries
- (cdr (assoc (funcall eshell-cmpl-command-name-function)
- eshell-command-completions-alist)))))))
+ (lambda ()
+ (while (pcomplete-here
+ (pcomplete-dirs-or-entries
+ (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)
@@ -269,49 +267,48 @@ to writing a completion function."
(defun eshell-cmpl-initialize () ;Called from `eshell-mode' via intern-soft!
"Initialize the completions module."
- (set (make-local-variable 'pcomplete-command-completion-function)
- eshell-command-completion-function)
- (set (make-local-variable 'pcomplete-command-name-function)
- eshell-cmpl-command-name-function)
- (set (make-local-variable 'pcomplete-default-completion-function)
- eshell-default-completion-function)
- (set (make-local-variable 'pcomplete-parse-arguments-function)
- 'eshell-complete-parse-arguments)
- (set (make-local-variable 'pcomplete-file-ignore)
- eshell-cmpl-file-ignore)
- (set (make-local-variable 'pcomplete-dir-ignore)
- eshell-cmpl-dir-ignore)
- (set (make-local-variable 'pcomplete-ignore-case)
- eshell-cmpl-ignore-case)
- (set (make-local-variable 'pcomplete-autolist)
- eshell-cmpl-autolist)
+ (setq-local pcomplete-command-completion-function
+ eshell-command-completion-function)
+ (setq-local pcomplete-command-name-function
+ eshell-cmpl-command-name-function)
+ (setq-local pcomplete-default-completion-function
+ eshell-default-completion-function)
+ (setq-local pcomplete-parse-arguments-function
+ 'eshell-complete-parse-arguments)
+ (setq-local pcomplete-file-ignore
+ eshell-cmpl-file-ignore)
+ (setq-local pcomplete-dir-ignore
+ eshell-cmpl-dir-ignore)
+ (setq-local pcomplete-ignore-case
+ eshell-cmpl-ignore-case)
+ (setq-local pcomplete-autolist
+ eshell-cmpl-autolist)
(if (boundp 'pcomplete-suffix-list)
- (set (make-local-variable 'pcomplete-suffix-list)
- eshell-cmpl-suffix-list))
- (set (make-local-variable 'pcomplete-recexact)
- eshell-cmpl-recexact)
- (set (make-local-variable 'pcomplete-man-function)
- eshell-cmpl-man-function)
- (set (make-local-variable 'pcomplete-compare-entry-function)
- eshell-cmpl-compare-entry-function)
- (set (make-local-variable 'pcomplete-expand-before-complete)
- eshell-cmpl-expand-before-complete)
- (set (make-local-variable 'pcomplete-cycle-completions)
- eshell-cmpl-cycle-completions)
- (set (make-local-variable 'pcomplete-cycle-cutoff-length)
- eshell-cmpl-cycle-cutoff-length)
- (set (make-local-variable 'pcomplete-restore-window-delay)
- eshell-cmpl-restore-window-delay)
- (set (make-local-variable 'pcomplete-use-paring)
- eshell-cmpl-use-paring)
+ (setq-local pcomplete-suffix-list
+ eshell-cmpl-suffix-list))
+ (setq-local pcomplete-recexact
+ eshell-cmpl-recexact)
+ (setq-local pcomplete-man-function
+ eshell-cmpl-man-function)
+ (setq-local pcomplete-compare-entry-function
+ eshell-cmpl-compare-entry-function)
+ (setq-local pcomplete-expand-before-complete
+ eshell-cmpl-expand-before-complete)
+ (setq-local pcomplete-cycle-completions
+ eshell-cmpl-cycle-completions)
+ (setq-local pcomplete-cycle-cutoff-length
+ eshell-cmpl-cycle-cutoff-length)
+ (setq-local pcomplete-restore-window-delay
+ eshell-cmpl-restore-window-delay)
+ (setq-local pcomplete-use-paring
+ eshell-cmpl-use-paring)
;; `comint-file-name-quote-list' should only be set after all the
;; load-hooks for any other extension modules have been run, which
;; is true at the time `eshell-mode-hook' is run
(add-hook 'eshell-mode-hook
- (function
- (lambda ()
- (set (make-local-variable 'comint-file-name-quote-list)
- eshell-special-chars-outside-quoting)))
+ (lambda ()
+ (setq-local comint-file-name-quote-list
+ eshell-special-chars-outside-quoting))
nil t)
(add-hook 'pcomplete-quote-arg-hook #'eshell-quote-backslash nil t)
(add-hook 'completion-at-point-functions
@@ -391,19 +388,18 @@ to writing a completion function."
(nconc args (list ""))
(nconc posns (list (point))))
(cons (mapcar
- (function
- (lambda (arg)
- (let ((val
- (if (listp arg)
- (let ((result
- (eshell-do-eval
- (list 'eshell-commands arg) t)))
- (cl-assert (eq (car result) 'quote))
- (cadr result))
- arg)))
- (if (numberp val)
- (setq val (number-to-string val)))
- (or val ""))))
+ (lambda (arg)
+ (let ((val
+ (if (listp arg)
+ (let ((result
+ (eshell-do-eval
+ (list 'eshell-commands arg) t)))
+ (cl-assert (eq (car result) 'quote))
+ (cadr result))
+ arg)))
+ (if (numberp val)
+ (setq val (number-to-string val)))
+ (or val "")))
args)
posns)))
@@ -454,9 +450,8 @@ to writing a completion function."
(eshell-alias-completions filename))
(eshell-winnow-list
(mapcar
- (function
- (lambda (name)
- (substring name 7)))
+ (lambda (name)
+ (substring name 7))
(all-completions (concat "eshell/" filename)
obarray #'functionp))
nil '(eshell-find-alias-function))
diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el
index 51df6fa1d52..c702ee192a6 100644
--- a/lisp/eshell/em-dirs.el
+++ b/lisp/eshell/em-dirs.el
@@ -1,6 +1,6 @@
;;; em-dirs.el --- directory navigation commands -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -175,8 +175,7 @@ Thus, this does not include the current directory.")
(defun eshell-dirs-initialize () ;Called from `eshell-mode' via intern-soft!
"Initialize the builtin functions for Eshell."
- (make-local-variable 'eshell-variable-aliases-list)
- (setq eshell-variable-aliases-list
+ (setq-local eshell-variable-aliases-list
(append
eshell-variable-aliases-list
`(("-" ,(lambda (indices)
@@ -199,8 +198,7 @@ Thus, this does not include the current directory.")
t))))
(when eshell-cd-on-directory
- (make-local-variable 'eshell-interpreter-alist)
- (setq eshell-interpreter-alist
+ (setq-local eshell-interpreter-alist
(cons (cons #'(lambda (file _args)
(eshell-lone-directory-p file))
'eshell-dirs-substitute-cd)
@@ -289,9 +287,8 @@ Thus, this does not include the current directory.")
(eshell-read-user-names)
(pcomplete-uniquify-list
(mapcar
- (function
- (lambda (user)
- (file-name-as-directory (cdr user))))
+ (lambda (user)
+ (file-name-as-directory (cdr user)))
eshell-user-names)))))))
(defun eshell/pwd (&rest _args)
diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el
index a32a6abe29c..316094b17e4 100644
--- a/lisp/eshell/em-glob.el
+++ b/lisp/eshell/em-glob.el
@@ -1,6 +1,6 @@
;;; em-glob.el --- extended file name globbing -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -129,7 +129,7 @@ This option slows down recursive glob processing by quite a bit."
"Initialize the extended globbing code."
;; it's important that `eshell-glob-chars-list' come first
(when (boundp 'eshell-special-chars-outside-quoting)
- (set (make-local-variable 'eshell-special-chars-outside-quoting)
+ (setq-local eshell-special-chars-outside-quoting
(append eshell-glob-chars-list eshell-special-chars-outside-quoting)))
(add-hook 'eshell-parse-argument-hook 'eshell-parse-glob-chars t t)
(add-hook 'eshell-pre-rewrite-command-hook
@@ -205,7 +205,7 @@ resulting regular expression."
regexp)
(while (string-match
(or eshell-glob-chars-regexp
- (set (make-local-variable 'eshell-glob-chars-regexp)
+ (setq-local eshell-glob-chars-regexp
(format "[%s]+" (apply 'string eshell-glob-chars-list))))
pattern matched-in-pattern)
(let* ((op-begin (match-beginning 0))
diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el
index 5cee1bad364..0d09ef4a12e 100644
--- a/lisp/eshell/em-hist.el
+++ b/lisp/eshell/em-hist.el
@@ -1,6 +1,6 @@
;;; em-hist.el --- history list management -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -75,17 +75,14 @@
(defcustom eshell-hist-load-hook nil
"A list of functions to call when loading `eshell-hist'."
:version "24.1" ; removed eshell-hist-initialize
- :type 'hook
- :group 'eshell-hist)
+ :type 'hook)
(defcustom eshell-hist-unload-hook
(list
- (function
- (lambda ()
- (remove-hook 'kill-emacs-hook 'eshell-save-some-history))))
+ (lambda ()
+ (remove-hook 'kill-emacs-hook 'eshell-save-some-history)))
"A hook that gets run when `eshell-hist' is unloaded."
- :type 'hook
- :group 'eshell-hist)
+ :type 'hook)
(defcustom eshell-history-file-name
(expand-file-name "history" eshell-directory-name)
@@ -93,20 +90,17 @@
See also `eshell-read-history' and `eshell-write-history'.
If it is nil, Eshell will use the value of HISTFILE."
:type '(choice (const :tag "Use HISTFILE" nil)
- file)
- :group 'eshell-hist)
+ file))
(defcustom eshell-history-size 128
"Size of the input history ring. If nil, use envvar HISTSIZE."
:type '(choice (const :tag "Use HISTSIZE" nil)
- integer)
- :group 'eshell-hist)
+ integer))
(defcustom eshell-hist-ignoredups nil
"If non-nil, don't add input matching the last on the input ring.
This mirrors the optional behavior of bash."
- :type 'boolean
- :group 'eshell-hist)
+ :type 'boolean)
(defcustom eshell-save-history-on-exit t
"Determine if history should be automatically saved.
@@ -118,8 +112,7 @@ If set to `ask', ask if any Eshell buffers are open at exit time.
If set to t, history will always be saved, silently."
:type '(choice (const :tag "Never" nil)
(const :tag "Ask" ask)
- (const :tag "Always save" t))
- :group 'eshell-hist)
+ (const :tag "Always save" t)))
(defcustom eshell-input-filter 'eshell-input-filter-default
"Predicate for filtering additions to input history.
@@ -128,8 +121,7 @@ the input history list. Default is to save anything that isn't all
whitespace."
:type '(radio (function-item eshell-input-filter-default)
(function-item eshell-input-filter-initial-space)
- (function :tag "Other function"))
- :group 'eshell-hist)
+ (function :tag "Other function")))
(put 'eshell-input-filter 'risky-local-variable t)
@@ -138,31 +130,26 @@ whitespace."
Otherwise, typing <M-p> and <M-n> will always go to the next history
element, regardless of any text on the command line. In that case,
<C-c M-r> and <C-c M-s> still offer that functionality."
- :type 'boolean
- :group 'eshell-hist)
+ :type 'boolean)
(defcustom eshell-hist-move-to-end t
"If non-nil, move to the end of the buffer before cycling history."
- :type 'boolean
- :group 'eshell-hist)
+ :type 'boolean)
(defcustom eshell-hist-event-designator
"^!\\(!\\|-?[0-9]+\\|\\??[^:^$%*?]+\\??\\|#\\)"
"The regexp used to identifier history event designators."
- :type 'regexp
- :group 'eshell-hist)
+ :type 'regexp)
(defcustom eshell-hist-word-designator
"^:?\\([0-9]+\\|[$^%*]\\)?\\(-[0-9]*\\|[$^%*]\\)?"
"The regexp used to identify history word designators."
- :type 'regexp
- :group 'eshell-hist)
+ :type 'regexp)
(defcustom eshell-hist-modifier
"^\\(:\\([hretpqx&g]\\|s/\\([^/]*\\)/\\([^/]*\\)/\\)\\)*"
"The regexp used to identity history modifiers."
- :type 'regexp
- :group 'eshell-hist)
+ :type 'regexp)
(defcustom eshell-hist-rebind-keys-alist
'(([(control ?p)] . eshell-previous-input)
@@ -180,8 +167,7 @@ element, regardless of any text on the command line. In that case,
"History keys to bind differently if point is in input text."
:type '(repeat (cons (vector :tag "Keys to bind"
(repeat :inline t sexp))
- (function :tag "Command")))
- :group 'eshell-hist)
+ (function :tag "Command"))))
;;; Internal Variables:
@@ -257,22 +243,19 @@ Returns nil if INPUT is prepended by blank space, otherwise non-nil."
(if (and (eshell-using-module 'eshell-rebind)
(not eshell-non-interactive-p))
(let ((rebind-alist eshell-rebind-keys-alist))
- (make-local-variable 'eshell-rebind-keys-alist)
- (setq eshell-rebind-keys-alist
+ (setq-local eshell-rebind-keys-alist
(append rebind-alist eshell-hist-rebind-keys-alist))
- (set (make-local-variable 'search-invisible) t)
- (set (make-local-variable 'search-exit-option) t)
+ (setq-local search-invisible t)
+ (setq-local search-exit-option t)
(add-hook 'isearch-mode-hook
- (function
- (lambda ()
- (if (>= (point) eshell-last-output-end)
- (setq overriding-terminal-local-map
- eshell-isearch-map))))
+ (lambda ()
+ (if (>= (point) eshell-last-output-end)
+ (setq overriding-terminal-local-map
+ eshell-isearch-map)))
nil t)
(add-hook 'isearch-mode-end-hook
- (function
- (lambda ()
- (setq overriding-terminal-local-map nil)))
+ (lambda ()
+ (setq overriding-terminal-local-map nil))
nil t))
(eshell-hist-mode))
@@ -294,8 +277,8 @@ Returns nil if INPUT is prepended by blank space, otherwise non-nil."
(make-local-variable 'eshell-save-history-index)
(if (minibuffer-window-active-p (selected-window))
- (set (make-local-variable 'eshell-save-history-on-exit) nil)
- (set (make-local-variable 'eshell-history-ring) nil)
+ (setq-local eshell-save-history-on-exit nil)
+ (setq-local eshell-history-ring nil)
(if eshell-history-file-name
(eshell-read-history nil t))
@@ -308,7 +291,6 @@ Returns nil if INPUT is prepended by blank space, otherwise non-nil."
(add-hook 'kill-emacs-hook #'eshell-save-some-history)
- (make-local-variable 'eshell-input-filter-functions)
(add-hook 'eshell-input-filter-functions #'eshell-add-to-history nil t))
(defun eshell-save-some-history ()
diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el
index c1a022ee521..e942ae26928 100644
--- a/lisp/eshell/em-ls.el
+++ b/lisp/eshell/em-ls.el
@@ -1,6 +1,6 @@
;;; em-ls.el --- implementation of ls in Lisp -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -270,14 +270,13 @@ instead."
eshell-current-subjob-p
font-lock-mode)
;; use the fancy highlighting in `eshell-ls' rather than font-lock
- (when (and eshell-ls-use-colors
- (featurep 'font-lock))
+ (when eshell-ls-use-colors
(font-lock-mode -1)
(setq font-lock-defaults nil)
(if (boundp 'font-lock-buffers)
- (set 'font-lock-buffers
- (delq (current-buffer)
- (symbol-value 'font-lock-buffers)))))
+ (setq font-lock-buffers
+ (delq (current-buffer)
+ (symbol-value 'font-lock-buffers)))))
(require 'em-glob)
(let* ((insert-func 'insert)
(error-func 'insert)
@@ -631,38 +630,37 @@ In Eshell's implementation of ls, ENTRIES is always reversed."
(if (eq sort-method 'unsorted)
(nreverse entries)
(sort entries
- (function
- (lambda (l r)
- (let ((result
- (cond
- ((eq sort-method 'by-atime)
- (eshell-ls-compare-entries l r 4 'time-less-p))
- ((eq sort-method 'by-mtime)
- (eshell-ls-compare-entries l r 5 'time-less-p))
- ((eq sort-method 'by-ctime)
- (eshell-ls-compare-entries l r 6 'time-less-p))
- ((eq sort-method 'by-size)
- (eshell-ls-compare-entries l r 7 '<))
- ((eq sort-method 'by-extension)
- (let ((lx (file-name-extension
- (directory-file-name (car l))))
- (rx (file-name-extension
- (directory-file-name (car r)))))
- (cond
- ((or (and (not lx) (not rx))
- (equal lx rx))
- (string-lessp (directory-file-name (car l))
- (directory-file-name (car r))))
- ((not lx) t)
- ((not rx) nil)
- (t
- (string-lessp lx rx)))))
- (t
- (string-lessp (directory-file-name (car l))
- (directory-file-name (car r)))))))
- (if reverse-list
- (not result)
- result)))))))
+ (lambda (l r)
+ (let ((result
+ (cond
+ ((eq sort-method 'by-atime)
+ (eshell-ls-compare-entries l r 4 'time-less-p))
+ ((eq sort-method 'by-mtime)
+ (eshell-ls-compare-entries l r 5 'time-less-p))
+ ((eq sort-method 'by-ctime)
+ (eshell-ls-compare-entries l r 6 'time-less-p))
+ ((eq sort-method 'by-size)
+ (eshell-ls-compare-entries l r 7 '<))
+ ((eq sort-method 'by-extension)
+ (let ((lx (file-name-extension
+ (directory-file-name (car l))))
+ (rx (file-name-extension
+ (directory-file-name (car r)))))
+ (cond
+ ((or (and (not lx) (not rx))
+ (equal lx rx))
+ (string-lessp (directory-file-name (car l))
+ (directory-file-name (car r))))
+ ((not lx) t)
+ ((not rx) nil)
+ (t
+ (string-lessp lx rx)))))
+ (t
+ (string-lessp (directory-file-name (car l))
+ (directory-file-name (car r)))))))
+ (if reverse-list
+ (not result)
+ result))))))
(defun eshell-ls-files (files &optional size-width copy-fileinfo)
"Output a list of FILES.
@@ -799,9 +797,8 @@ to use, and each member of which is the width of that column
(width 0)
(widths
(mapcar
- (function
- (lambda (file)
- (+ 2 (length (car file)))))
+ (lambda (file)
+ (+ 2 (length (car file))))
files))
;; must account for the added space...
(max-width (+ (window-width) 2))
@@ -846,9 +843,8 @@ to use, and each member of which is the width of that column
(width 0)
(widths
(mapcar
- (function
- (lambda (file)
- (+ 2 (length (car file)))))
+ (lambda (file)
+ (+ 2 (length (car file))))
files))
(max-width (+ (window-width) 2))
col-widths
diff --git a/lisp/eshell/em-pred.el b/lisp/eshell/em-pred.el
index 59139da10db..aecc8bb4e0a 100644
--- a/lisp/eshell/em-pred.el
+++ b/lisp/eshell/em-pred.el
@@ -1,6 +1,6 @@
;;; em-pred.el --- argument predicates and modifiers (ala zsh) -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -116,10 +116,9 @@ The format of each entry is
(defcustom eshell-modifier-alist
'((?E . #'(lambda (lst)
(mapcar
- (function
- (lambda (str)
- (eshell-stringify
- (car (eshell-parse-argument str)))))
+ (lambda (str)
+ (eshell-stringify
+ (car (eshell-parse-argument str))))
lst)))
(?L . #'(lambda (lst) (mapcar 'downcase lst)))
(?U . #'(lambda (lst) (mapcar 'upcase lst)))
@@ -240,16 +239,14 @@ EXAMPLES:
(defun eshell-display-predicate-help ()
(interactive)
(with-electric-help
- (function
- (lambda ()
- (insert eshell-predicate-help-string)))))
+ (lambda ()
+ (insert eshell-predicate-help-string))))
(defun eshell-display-modifier-help ()
(interactive)
(with-electric-help
- (function
- (lambda ()
- (insert eshell-modifier-help-string)))))
+ (lambda ()
+ (insert eshell-modifier-help-string))))
(define-minor-mode eshell-pred-mode
"Minor mode for the eshell-pred module.
@@ -544,20 +541,20 @@ that `ls -l' will show in the first column of its display."
(if repeat
`(lambda (lst)
(mapcar
- (function
- (lambda (str)
- (let ((i 0))
- (while (setq i (string-match ,match str i))
- (setq str (replace-match ,replace t nil str))))
- str)) lst))
+ (lambda (str)
+ (let ((i 0))
+ (while (setq i (string-match ,match str i))
+ (setq str (replace-match ,replace t nil str))))
+ str)
+ lst))
`(lambda (lst)
(mapcar
- (function
- (lambda (str)
- (if (string-match ,match str)
- (setq str (replace-match ,replace t nil str))
- (error (concat str ": substitution failed")))
- str)) lst)))))
+ (lambda (str)
+ (if (string-match ,match str)
+ (setq str (replace-match ,replace t nil str))
+ (error (concat str ": substitution failed")))
+ str)
+ lst)))))
(defun eshell-include-members (&optional invert-p)
"Include only lisp members matching a regexp."
@@ -598,9 +595,8 @@ that `ls -l' will show in the first column of its display."
(goto-char (1+ end)))
`(lambda (lst)
(mapcar
- (function
- (lambda (str)
- (split-string str ,sep))) lst))))
+ (lambda (str)
+ (split-string str ,sep)) lst))))
(provide 'em-pred)
diff --git a/lisp/eshell/em-prompt.el b/lisp/eshell/em-prompt.el
index 9ae5ae12816..aa96166087a 100644
--- a/lisp/eshell/em-prompt.el
+++ b/lisp/eshell/em-prompt.el
@@ -1,6 +1,6 @@
;;; em-prompt.el --- command prompts -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -48,10 +48,9 @@ as is common with most shells."
(autoload 'eshell/pwd "em-dirs")
(defcustom eshell-prompt-function
- (function
- (lambda ()
- (concat (abbreviate-file-name (eshell/pwd))
- (if (= (user-uid) 0) " # " " $ "))))
+ (lambda ()
+ (concat (abbreviate-file-name (eshell/pwd))
+ (if (= (user-uid) 0) " # " " $ ")))
"A function that returns the Eshell prompt string.
Make sure to update `eshell-prompt-regexp' so that it will match your
prompt."
@@ -118,10 +117,9 @@ arriving, or after."
(make-local-variable 'eshell-prompt-regexp)
(if eshell-prompt-regexp
- (set (make-local-variable 'paragraph-start) eshell-prompt-regexp))
+ (setq-local paragraph-start eshell-prompt-regexp))
- (set (make-local-variable 'eshell-skip-prompt-function)
- 'eshell-skip-prompt)
+ (setq-local eshell-skip-prompt-function #'eshell-skip-prompt)
(eshell-prompt-mode)))
(defun eshell-emit-prompt ()
diff --git a/lisp/eshell/em-rebind.el b/lisp/eshell/em-rebind.el
index 7991c631772..fa61fffaec8 100644
--- a/lisp/eshell/em-rebind.el
+++ b/lisp/eshell/em-rebind.el
@@ -1,6 +1,6 @@
;;; em-rebind.el --- rebind keys when point is at current input -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -163,7 +163,7 @@ This is default behavior of shells like bash."
(add-hook 'pre-command-hook 'eshell-save-previous-point nil t)
(make-local-variable 'overriding-local-map)
(add-hook 'post-command-hook 'eshell-rebind-input-map nil t)
- (set (make-local-variable 'eshell-lock-keymap) nil)
+ (setq-local eshell-lock-keymap nil)
(eshell-rebind-mode)))
(defun eshell-lock-local-map (&optional arg)
@@ -219,8 +219,7 @@ lock it at that."
(defun eshell-setup-input-keymap ()
"Setup the input keymap to be used during input editing."
- (make-local-variable 'eshell-input-keymap)
- (setq eshell-input-keymap (make-sparse-keymap))
+ (setq-local eshell-input-keymap (make-sparse-keymap))
(set-keymap-parent eshell-input-keymap eshell-mode-map)
(let ((bindings eshell-rebind-keys-alist))
(while bindings
diff --git a/lisp/eshell/em-script.el b/lisp/eshell/em-script.el
index 5c2f145f595..aecc48610f7 100644
--- a/lisp/eshell/em-script.el
+++ b/lisp/eshell/em-script.el
@@ -1,6 +1,6 @@
;;; em-script.el --- Eshell script files -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -58,15 +58,13 @@ This includes when running `eshell-command'."
(defun eshell-script-initialize () ;Called from `eshell-mode' via intern-soft!
"Initialize the script parsing code."
- (make-local-variable 'eshell-interpreter-alist)
- (setq eshell-interpreter-alist
+ (setq-local eshell-interpreter-alist
(cons (cons #'(lambda (file _args)
(string= (file-name-nondirectory file)
"eshell"))
'eshell/source)
eshell-interpreter-alist))
- (make-local-variable 'eshell-complex-commands)
- (setq eshell-complex-commands
+ (setq-local eshell-complex-commands
(append '("source" ".") eshell-complex-commands))
;; these two variables are changed through usage, but we don't want
;; to ruin it for other modules
diff --git a/lisp/eshell/em-smart.el b/lisp/eshell/em-smart.el
index f173c8db9c1..d1c83db188a 100644
--- a/lisp/eshell/em-smart.el
+++ b/lisp/eshell/em-smart.el
@@ -1,6 +1,6 @@
;;; em-smart.el --- smart display of output -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -94,10 +94,9 @@ it to get a real sense of how it works."
(defcustom eshell-smart-unload-hook
(list
- (function
- (lambda ()
- (remove-hook 'window-configuration-change-hook
- 'eshell-refresh-windows))))
+ (lambda ()
+ (remove-hook 'window-configuration-change-hook
+ 'eshell-refresh-windows)))
"A hook that gets run when `eshell-smart' is unloaded."
:type 'hook
:group 'eshell-smart)
@@ -171,9 +170,9 @@ The options are `begin', `after' or `end'."
(unless eshell-non-interactive-p
;; override a few variables, since they would interfere with the
;; smart display functionality.
- (set (make-local-variable 'eshell-scroll-to-bottom-on-output) nil)
- (set (make-local-variable 'eshell-scroll-to-bottom-on-input) nil)
- (set (make-local-variable 'eshell-scroll-show-maximum-output) t)
+ (setq-local eshell-scroll-to-bottom-on-output nil)
+ (setq-local eshell-scroll-to-bottom-on-input nil)
+ (setq-local eshell-scroll-show-maximum-output t)
(add-hook 'window-scroll-functions 'eshell-smart-scroll-window nil t)
(add-hook 'window-configuration-change-hook 'eshell-refresh-windows)
@@ -186,9 +185,8 @@ The options are `begin', `after' or `end'."
(make-local-variable 'eshell-smart-command-done)
(add-hook 'eshell-post-command-hook
- (function
- (lambda ()
- (setq eshell-smart-command-done t)))
+ (lambda ()
+ (setq eshell-smart-command-done t))
t t)
(unless (eq eshell-review-quick-commands t)
@@ -208,13 +206,12 @@ The options are `begin', `after' or `end'."
"Refresh all visible Eshell buffers."
(let (affected)
(walk-windows
- (function
- (lambda (wind)
- (with-current-buffer (window-buffer wind)
- (if eshell-mode
- (let (window-scroll-functions) ;;FIXME: Why?
- (eshell-smart-scroll-window wind (window-start))
- (setq affected t))))))
+ (lambda (wind)
+ (with-current-buffer (window-buffer wind)
+ (if eshell-mode
+ (let (window-scroll-functions) ;;FIXME: Why?
+ (eshell-smart-scroll-window wind (window-start))
+ (setq affected t)))))
0 frame)
(if affected
(let (window-scroll-functions) ;;FIXME: Why?
diff --git a/lisp/eshell/em-term.el b/lisp/eshell/em-term.el
index f52b3cda73b..d199a939a31 100644
--- a/lisp/eshell/em-term.el
+++ b/lisp/eshell/em-term.el
@@ -1,6 +1,6 @@
;;; em-term.el --- running visual commands -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -143,8 +143,7 @@ behavior for short-lived processes, see bug#18108."
(defun eshell-term-initialize () ;Called from `eshell-mode' via intern-soft!
"Initialize the `term' interface code."
- (make-local-variable 'eshell-interpreter-alist)
- (setq eshell-interpreter-alist
+ (setq-local eshell-interpreter-alist
(cons (cons #'eshell-visual-command-p
'eshell-exec-visual)
eshell-interpreter-alist)))
@@ -179,9 +178,8 @@ allowed."
(save-current-buffer
(switch-to-buffer term-buf)
(term-mode)
- (set (make-local-variable 'term-term-name) eshell-term-name)
- (make-local-variable 'eshell-parent-buffer)
- (setq eshell-parent-buffer eshell-buf)
+ (setq-local term-term-name eshell-term-name)
+ (setq-local eshell-parent-buffer eshell-buf)
(term-exec term-buf program program nil args)
(let ((proc (get-buffer-process term-buf)))
(if (and proc (eq 'run (process-status proc)))
diff --git a/lisp/eshell/em-tramp.el b/lisp/eshell/em-tramp.el
index 01f7038e462..e29e9e3e3af 100644
--- a/lisp/eshell/em-tramp.el
+++ b/lisp/eshell/em-tramp.el
@@ -1,6 +1,6 @@
;;; em-tramp.el --- Eshell features that require TRAMP -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Aidan Gauland <aidalgol@no8wireless.co.nz>
@@ -51,10 +51,9 @@
(when (eshell-using-module 'eshell-cmpl)
(add-hook 'pcomplete-try-first-hook
'eshell-complete-host-reference nil t))
- (make-local-variable 'eshell-complex-commands)
- (setq eshell-complex-commands
- (append '("su" "sudo")
- eshell-complex-commands)))
+ (setq-local eshell-complex-commands
+ (append '("su" "sudo")
+ eshell-complex-commands)))
(autoload 'eshell-parse-command "esh-cmd")
diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el
index 68aa6803278..7e48a9c7578 100644
--- a/lisp/eshell/em-unix.el
+++ b/lisp/eshell/em-unix.el
@@ -1,6 +1,6 @@
;;; em-unix.el --- UNIX command aliases -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -144,8 +144,7 @@ Otherwise, Emacs will attempt to use rsh to invoke du on the remote machine."
(when (eshell-using-module 'eshell-cmpl)
(add-hook 'pcomplete-try-first-hook
'eshell-complete-host-reference nil t))
- (make-local-variable 'eshell-complex-commands)
- (setq eshell-complex-commands
+ (setq-local eshell-complex-commands
(append '("grep" "egrep" "fgrep" "agrep" "glimpse" "locate"
"cat" "time" "cp" "mv" "make" "du" "diff")
eshell-complex-commands)))
@@ -170,7 +169,8 @@ Otherwise, Emacs will attempt to use rsh to invoke du on the remote machine."
`info' => goes to top info window
`info arg1' => IF arg1 is a file, then visits arg1
`info arg1' => OTHERWISE goes to top info window and then menu item arg1
- `info arg1 arg2' => does action for arg1 (either visit-file or menu-item) and then menu item arg2
+ `info arg1 arg2' => does action for arg1 (either visit-file or menu-item) and
+ then menu item arg2
etc."
(eval-and-compile (require 'info))
(let ((file (cond
@@ -419,9 +419,8 @@ Remove the DIRECTORY(ies), if they are empty.")
(apply 'eshell-shuffle-files
command action
(mapcar
- (function
- (lambda (file)
- (concat source "/" file)))
+ (lambda (file)
+ (concat source "/" file))
(directory-files source))
target func t args)
(when (eq func 'rename-file)
@@ -755,15 +754,12 @@ external command."
(eshell-stringify-list
(flatten-tree args)))
" "))
- (cmd (progn
- (set-text-properties 0 (length args)
- '(invisible t) args)
- (format "%s -n %s"
- (pcase command
- ("egrep" "grep -E")
- ("fgrep" "grep -F")
- (x x))
- args)))
+ (cmd (format "%s -nH %s"
+ (pcase command
+ ("egrep" "grep -E")
+ ("fgrep" "grep -F")
+ (x x))
+ args))
compilation-scroll-output)
(grep cmd)))))
@@ -1007,18 +1003,17 @@ Show wall-clock time elapsed during execution of COMMAND.")
(throw 'eshell-replace-command
(eshell-parse-command "*diff" orig-args))))
(when (fboundp 'diff-mode)
- (make-local-variable 'compilation-finish-functions)
(add-hook
'compilation-finish-functions
- `(lambda (buff msg)
+ (lambda (buff _msg)
(with-current-buffer buff
(diff-mode)
- (set (make-local-variable 'eshell-diff-window-config)
- ,config)
- (local-set-key [?q] 'eshell-diff-quit)
+ (setq-local eshell-diff-window-config config)
+ (local-set-key [?q] #'eshell-diff-quit)
(if (fboundp 'turn-on-font-lock-if-enabled)
(turn-on-font-lock-if-enabled))
- (goto-char (point-min))))))
+ (goto-char (point-min))))
+ nil t))
(pop-to-buffer (current-buffer))))))
nil)
diff --git a/lisp/eshell/em-xtra.el b/lisp/eshell/em-xtra.el
index 3c038edfd18..fa3218baf2f 100644
--- a/lisp/eshell/em-xtra.el
+++ b/lisp/eshell/em-xtra.el
@@ -1,6 +1,6 @@
;;; em-xtra.el --- extra alias functions -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el
index e7b07b4208d..3cf80e45187 100644
--- a/lisp/eshell/esh-arg.el
+++ b/lisp/eshell/esh-arg.el
@@ -1,6 +1,6 @@
;;; esh-arg.el --- argument processing -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -85,51 +85,48 @@ If POS is nil, the location of point is checked."
'eshell-parse-special-reference
;; numbers convert to numbers if they stand alone
- (function
- (lambda ()
- (when (and (not eshell-current-argument)
- (not eshell-current-quoted)
- (looking-at eshell-number-regexp)
- (eshell-arg-delimiter (match-end 0)))
- (goto-char (match-end 0))
- (let ((str (match-string 0)))
- (if (> (length str) 0)
- (add-text-properties 0 (length str) '(number t) str))
- str))))
+ (lambda ()
+ (when (and (not eshell-current-argument)
+ (not eshell-current-quoted)
+ (looking-at eshell-number-regexp)
+ (eshell-arg-delimiter (match-end 0)))
+ (goto-char (match-end 0))
+ (let ((str (match-string 0)))
+ (if (> (length str) 0)
+ (add-text-properties 0 (length str) '(number t) str))
+ str)))
;; parse any non-special characters, based on the current context
- (function
- (lambda ()
- (unless eshell-inside-quote-regexp
- (setq eshell-inside-quote-regexp
- (format "[^%s]+"
- (apply 'string eshell-special-chars-inside-quoting))))
- (unless eshell-outside-quote-regexp
- (setq eshell-outside-quote-regexp
- (format "[^%s]+"
- (apply 'string eshell-special-chars-outside-quoting))))
- (when (looking-at (if eshell-current-quoted
- eshell-inside-quote-regexp
- eshell-outside-quote-regexp))
- (goto-char (match-end 0))
- (let ((str (match-string 0)))
- (if str
- (set-text-properties 0 (length str) nil str))
- str))))
+ (lambda ()
+ (unless eshell-inside-quote-regexp
+ (setq eshell-inside-quote-regexp
+ (format "[^%s]+"
+ (apply 'string eshell-special-chars-inside-quoting))))
+ (unless eshell-outside-quote-regexp
+ (setq eshell-outside-quote-regexp
+ (format "[^%s]+"
+ (apply 'string eshell-special-chars-outside-quoting))))
+ (when (looking-at (if eshell-current-quoted
+ eshell-inside-quote-regexp
+ eshell-outside-quote-regexp))
+ (goto-char (match-end 0))
+ (let ((str (match-string 0)))
+ (if str
+ (set-text-properties 0 (length str) nil str))
+ str)))
;; whitespace or a comment is an argument delimiter
- (function
- (lambda ()
- (let (comment-p)
- (when (or (looking-at "[ \t]+")
- (and (not eshell-current-argument)
- (looking-at "#\\([^<'].*\\|$\\)")
- (setq comment-p t)))
- (if comment-p
- (add-text-properties (match-beginning 0) (match-end 0)
- '(comment t)))
- (goto-char (match-end 0))
- (eshell-finish-arg)))))
+ (lambda ()
+ (let (comment-p)
+ (when (or (looking-at "[ \t]+")
+ (and (not eshell-current-argument)
+ (looking-at "#\\([^<'].*\\|$\\)")
+ (setq comment-p t)))
+ (if comment-p
+ (add-text-properties (match-beginning 0) (match-end 0)
+ '(comment t)))
+ (goto-char (match-end 0))
+ (eshell-finish-arg))))
;; parse backslash and the character after
'eshell-parse-backslash
@@ -171,8 +168,8 @@ treated as a literal character."
(defun eshell-arg-initialize () ;Called from `eshell-mode' via intern-soft!
"Initialize the argument parsing code."
(eshell-arg-mode)
- (set (make-local-variable 'eshell-inside-quote-regexp) nil)
- (set (make-local-variable 'eshell-outside-quote-regexp) nil))
+ (setq-local eshell-inside-quote-regexp nil)
+ (setq-local eshell-outside-quote-regexp nil))
(defun eshell-insert-buffer-name (buffer-name)
"Insert BUFFER-NAME into the current buffer at point."
diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el
index e0348ba5013..4d63467899b 100644
--- a/lisp/eshell/esh-cmd.el
+++ b/lisp/eshell/esh-cmd.el
@@ -1,6 +1,6 @@
;;; esh-cmd.el --- command invocation -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -290,12 +290,12 @@ otherwise t.")
(defun eshell-cmd-initialize () ;Called from `eshell-mode' via intern-soft!
"Initialize the Eshell command processing module."
- (set (make-local-variable 'eshell-current-command) nil)
- (set (make-local-variable 'eshell-command-name) nil)
- (set (make-local-variable 'eshell-command-arguments) nil)
- (set (make-local-variable 'eshell-last-arguments) nil)
- (set (make-local-variable 'eshell-last-command-name) nil)
- (set (make-local-variable 'eshell-last-async-proc) nil)
+ (setq-local eshell-current-command nil)
+ (setq-local eshell-command-name nil)
+ (setq-local eshell-command-arguments nil)
+ (setq-local eshell-last-arguments nil)
+ (setq-local eshell-last-command-name nil)
+ (setq-local eshell-last-async-proc nil)
(add-hook 'eshell-kill-hook #'eshell-resume-command nil t)
@@ -304,10 +304,9 @@ otherwise t.")
;; situation can occur, for example, if a Lisp function results in
;; `debug' being called, and the user then types \\[top-level]
(add-hook 'eshell-post-command-hook
- (function
- (lambda ()
- (setq eshell-current-command nil
- eshell-last-async-proc nil)))
+ (lambda ()
+ (setq eshell-current-command nil
+ eshell-last-async-proc nil))
nil t)
(add-hook 'eshell-parse-argument-hook
@@ -355,18 +354,17 @@ hooks should be run before and after the command."
args))
(commands
(mapcar
- (function
- (lambda (cmd)
- (setq cmd
- (if (or (not (car eshell--sep-terms))
- (string= (car eshell--sep-terms) ";"))
- (eshell-parse-pipeline cmd)
- `(eshell-do-subjob
- (list ,(eshell-parse-pipeline cmd)))))
- (setq eshell--sep-terms (cdr eshell--sep-terms))
- (if eshell-in-pipeline-p
- cmd
- `(eshell-trap-errors ,cmd))))
+ (lambda (cmd)
+ (setq cmd
+ (if (or (not (car eshell--sep-terms))
+ (string= (car eshell--sep-terms) ";"))
+ (eshell-parse-pipeline cmd)
+ `(eshell-do-subjob
+ (list ,(eshell-parse-pipeline cmd)))))
+ (setq eshell--sep-terms (cdr eshell--sep-terms))
+ (if eshell-in-pipeline-p
+ cmd
+ `(eshell-trap-errors ,cmd)))
(eshell-separate-commands terms "[&;]" nil 'eshell--sep-terms))))
(let ((cmd commands))
(while cmd
@@ -920,7 +918,7 @@ at the moment are:
(funcall pred name))
(throw 'simple nil)))
t))
- (fboundp (intern-soft (concat "eshell/" name))))))
+ (eshell-find-alias-function name))))
(defun eshell-eval-command (command &optional input)
"Evaluate the given COMMAND iteratively."
diff --git a/lisp/eshell/esh-ext.el b/lisp/eshell/esh-ext.el
index c88d3c9f59d..9930e0884cb 100644
--- a/lisp/eshell/esh-ext.el
+++ b/lisp/eshell/esh-ext.el
@@ -1,6 +1,6 @@
;;; esh-ext.el --- commands external to Eshell -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el
index b4154861908..0e98aa0049e 100644
--- a/lisp/eshell/esh-io.el
+++ b/lisp/eshell/esh-io.el
@@ -1,6 +1,6 @@
;;; esh-io.el --- I/O management -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -344,8 +344,8 @@ it defaults to `insert'."
(if buffer-file-read-only
(error "Cannot write to read-only file `%s'" target))
(setq buffer-read-only nil)
- (set (make-local-variable 'eshell-output-file-buffer)
- (if (eq exists buf) 0 t))
+ (setq-local eshell-output-file-buffer
+ (if (eq exists buf) 0 t))
(cond ((eq mode 'overwrite)
(erase-buffer))
((eq mode 'append)
@@ -382,8 +382,7 @@ it defaults to `insert'."
"Set handle INDEX, using MODE, to point to TARGET."
(when target
(if (and (stringp target)
- (or (string= target null-device)
- (string= target "/dev/null")))
+ (string= target (null-device)))
(aset eshell-current-handles index nil)
(let ((where (eshell-get-target target mode))
(current (car (aref eshell-current-handles index))))
diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el
index e0e86348bd8..d29b010ea09 100644
--- a/lisp/eshell/esh-mode.el
+++ b/lisp/eshell/esh-mode.el
@@ -1,6 +1,6 @@
;;; esh-mode.el --- user interface -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -312,45 +312,38 @@ and the hook `eshell-exit-hook'."
(if mode-line-elt
(setcar mode-line-elt 'eshell-command-running-string))))
- (set (make-local-variable 'bookmark-make-record-function)
- 'eshell-bookmark-make-record)
+ (setq-local bookmark-make-record-function #'eshell-bookmark-make-record)
(setq local-abbrev-table eshell-mode-abbrev-table)
- (set (make-local-variable 'list-buffers-directory)
- (expand-file-name default-directory))
+ (setq-local list-buffers-directory (expand-file-name default-directory))
;; always set the tab width to 8 in Eshell buffers, since external
;; commands which do their own formatting almost always expect this
- (set (make-local-variable 'tab-width) 8)
+ (setq-local tab-width 8)
;; don't ever use auto-fill in Eshell buffers
(setq auto-fill-function nil)
;; always display everything from a return value
- (if (boundp 'print-length)
- (set (make-local-variable 'print-length) nil))
- (if (boundp 'print-level)
- (set (make-local-variable 'print-level) nil))
+ (setq-local print-length nil)
+ (setq-local print-level nil)
;; set require-final-newline to nil; otherwise, all redirected
;; output will end with a newline, whether or not the source
;; indicated it!
- (set (make-local-variable 'require-final-newline) nil)
+ (setq-local require-final-newline nil)
- (set (make-local-variable 'max-lisp-eval-depth)
- (max 3000 max-lisp-eval-depth))
- (set (make-local-variable 'max-specpdl-size)
- (max 6000 max-lisp-eval-depth))
+ (setq-local max-lisp-eval-depth (max 3000 max-lisp-eval-depth))
+ (setq-local max-specpdl-size (max 6000 max-lisp-eval-depth))
- (set (make-local-variable 'eshell-last-input-start) (point-marker))
- (set (make-local-variable 'eshell-last-input-end) (point-marker))
- (set (make-local-variable 'eshell-last-output-start) (point-marker))
- (set (make-local-variable 'eshell-last-output-end) (point-marker))
- (set (make-local-variable 'eshell-last-output-block-begin) (point))
+ (setq-local eshell-last-input-start (point-marker))
+ (setq-local eshell-last-input-end (point-marker))
+ (setq-local eshell-last-output-start (point-marker))
+ (setq-local eshell-last-output-end (point-marker))
+ (setq-local eshell-last-output-block-begin (point))
(let ((modules-list (copy-sequence eshell-modules-list)))
- (make-local-variable 'eshell-modules-list)
- (setq eshell-modules-list modules-list))
+ (setq-local eshell-modules-list modules-list))
;; This is to avoid making the paragraph base direction
;; right-to-left if the first word just happens to start with a
@@ -391,7 +384,7 @@ and the hook `eshell-exit-hook'."
(add-hook 'pre-command-hook #'eshell-preinput-scroll-to-bottom t t))
(when eshell-scroll-show-maximum-output
- (set (make-local-variable 'scroll-conservatively) 1000))
+ (setq-local scroll-conservatively 1000))
(when eshell-status-in-mode-line
(add-hook 'eshell-pre-command-hook #'eshell-command-started nil t)
@@ -742,13 +735,12 @@ This function should be a pre-command hook."
(if (eq scroll 'this)
(goto-char (point-max))
(walk-windows
- (function
- (lambda (window)
- (when (and (eq (window-buffer window) current)
- (or (eq scroll t) (eq scroll 'all)))
- (select-window window)
- (goto-char (point-max))
- (select-window selected))))
+ (lambda (window)
+ (when (and (eq (window-buffer window) current)
+ (or (eq scroll t) (eq scroll 'all)))
+ (select-window window)
+ (goto-char (point-max))
+ (select-window selected)))
nil t))))))
;;; jww (1999-10-23): this needs testing
@@ -764,29 +756,28 @@ This function should be in the list `eshell-output-filter-functions'."
(scroll eshell-scroll-to-bottom-on-output))
(unwind-protect
(walk-windows
- (function
- (lambda (window)
- (if (eq (window-buffer window) current)
- (progn
- (select-window window)
- (if (and (< (point) eshell-last-output-end)
- (or (eq scroll t) (eq scroll 'all)
- ;; Maybe user wants point to jump to end.
- (and (eq scroll 'this)
- (eq selected window))
- (and (eq scroll 'others)
- (not (eq selected window)))
- ;; If point was at the end, keep it at end.
- (>= (point) eshell-last-output-start)))
- (goto-char eshell-last-output-end))
- ;; Optionally scroll so that the text
- ;; ends at the bottom of the window.
- (if (and eshell-scroll-show-maximum-output
- (>= (point) eshell-last-output-end))
- (save-excursion
- (goto-char (point-max))
- (recenter -1)))
- (select-window selected)))))
+ (lambda (window)
+ (if (eq (window-buffer window) current)
+ (progn
+ (select-window window)
+ (if (and (< (point) eshell-last-output-end)
+ (or (eq scroll t) (eq scroll 'all)
+ ;; Maybe user wants point to jump to end.
+ (and (eq scroll 'this)
+ (eq selected window))
+ (and (eq scroll 'others)
+ (not (eq selected window)))
+ ;; If point was at the end, keep it at end.
+ (>= (point) eshell-last-output-start)))
+ (goto-char eshell-last-output-end))
+ ;; Optionally scroll so that the text
+ ;; ends at the bottom of the window.
+ (if (and eshell-scroll-show-maximum-output
+ (>= (point) eshell-last-output-end))
+ (save-excursion
+ (goto-char (point-max))
+ (recenter -1)))
+ (select-window selected))))
nil t)
(set-buffer current))))
diff --git a/lisp/eshell/esh-module.el b/lisp/eshell/esh-module.el
index 45c4c9e13c0..703179504c1 100644
--- a/lisp/eshell/esh-module.el
+++ b/lisp/eshell/esh-module.el
@@ -1,6 +1,6 @@
;;; esh-module.el --- Eshell modules -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2000, 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2000, 2002-2021 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
;; Keywords: processes
@@ -65,16 +65,15 @@ Changes will only take effect in future Eshell buffers."
:type (append
(list 'set ':tag "Supported modules")
(mapcar
- (function
- (lambda (modname)
- (let ((modsym (intern modname)))
- (list 'const
- ':tag (format "%s -- %s" modname
- (get modsym 'custom-tag))
- ':link (caar (get modsym 'custom-links))
- ':doc (concat "\n" (get modsym 'group-documentation)
- "\n ")
- modsym))))
+ (lambda (modname)
+ (let ((modsym (intern modname)))
+ (list 'const
+ ':tag (format "%s -- %s" modname
+ (get modsym 'custom-tag))
+ ':link (caar (get modsym 'custom-links))
+ ':doc (concat "\n" (get modsym 'group-documentation)
+ "\n ")
+ modsym)))
(sort (mapcar 'symbol-name
(eshell-subgroups 'eshell-module))
'string-lessp))
diff --git a/lisp/eshell/esh-opt.el b/lisp/eshell/esh-opt.el
index dc8918891bd..c1db484be56 100644
--- a/lisp/eshell/esh-opt.el
+++ b/lisp/eshell/esh-opt.el
@@ -1,6 +1,6 @@
;;; esh-opt.el --- command options processing -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el
index db1b258c8f5..369382906c8 100644
--- a/lisp/eshell/esh-proc.el
+++ b/lisp/eshell/esh-proc.el
@@ -1,6 +1,6 @@
;;; esh-proc.el --- process management -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -215,9 +215,8 @@ and signal names."
The prompt will be set to PROMPT."
(completing-read prompt
(mapcar
- (function
- (lambda (proc)
- (cons (process-name proc) t)))
+ (lambda (proc)
+ (cons (process-name proc) t))
(process-list))
nil t))
@@ -499,9 +498,8 @@ See the variable `eshell-kill-processes-on-exit'."
(let ((sigs eshell-kill-process-signals))
(while sigs
(eshell-process-interact
- (function
- (lambda (proc)
- (signal-process (process-id proc) (car sigs)))) t query)
+ (lambda (proc)
+ (signal-process (process-id proc) (car sigs))) t query)
(setq query nil)
(if (not eshell-process-list)
(setq sigs nil)
diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el
index 9268921fadc..872e3b52046 100644
--- a/lisp/eshell/esh-util.el
+++ b/lisp/eshell/esh-util.el
@@ -1,6 +1,6 @@
;;; esh-util.el --- general utilities -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el
index 7388279f157..a09c47ce7c2 100644
--- a/lisp/eshell/esh-var.el
+++ b/lisp/eshell/esh-var.el
@@ -1,6 +1,6 @@
;;; esh-var.el --- handling of variables -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -113,7 +113,6 @@
(require 'esh-io)
(require 'pcomplete)
-(require 'env)
(require 'ring)
(defgroup eshell-var nil
@@ -228,12 +227,11 @@ environment of created subprocesses."
;; Break the association with our parent's environment. Otherwise,
;; changing a variable will affect all of Emacs.
(unless eshell-modify-global-environment
- (set (make-local-variable 'process-environment)
- (eshell-copy-environment)))
+ (setq-local process-environment (eshell-copy-environment)))
- (set (make-local-variable 'eshell-special-chars-inside-quoting)
+ (setq-local eshell-special-chars-inside-quoting
(append eshell-special-chars-inside-quoting '(?$)))
- (set (make-local-variable 'eshell-special-chars-outside-quoting)
+ (setq-local eshell-special-chars-outside-quoting
(append eshell-special-chars-outside-quoting '(?$)))
(add-hook 'eshell-parse-argument-hook #'eshell-interpolate-variable t t)
@@ -382,9 +380,8 @@ This function is explicit for adding to `eshell-parse-argument-hook'."
(defun eshell-envvar-names (&optional environment)
"Return a list of currently visible environment variable names."
- (mapcar (function
- (lambda (x)
- (substring x 0 (string-match "=" x))))
+ (mapcar (lambda (x)
+ (substring x 0 (string-match "=" x)))
(or environment process-environment)))
(defun eshell-environment-variables ()
@@ -618,14 +615,13 @@ For example, to retrieve the second element of a user's record in
(sort
(append
(mapcar
- (function
- (lambda (varname)
- (let ((value (eshell-get-variable varname)))
- (if (and value
- (stringp value)
- (file-directory-p value))
- (concat varname "/")
- varname))))
+ (lambda (varname)
+ (let ((value (eshell-get-variable varname)))
+ (if (and value
+ (stringp value)
+ (file-directory-p value))
+ (concat varname "/")
+ varname)))
(eshell-envvar-names (eshell-environment-variables)))
(all-completions argname obarray 'boundp)
completions)
diff --git a/lisp/eshell/eshell.el b/lisp/eshell/eshell.el
index 6698ca45de4..3aaf2fb78aa 100644
--- a/lisp/eshell/eshell.el
+++ b/lisp/eshell/eshell.el
@@ -1,6 +1,6 @@
;;; eshell.el --- the Emacs command shell -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
;; Version: 2.4.2
diff --git a/lisp/expand.el b/lisp/expand.el
index 77e4fc2657c..5c0b5f42817 100644
--- a/lisp/expand.el
+++ b/lisp/expand.el
@@ -1,6 +1,6 @@
;;; expand.el --- make abbreviations more usable
-;; Copyright (C) 1995-1996, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995-1996, 2001-2021 Free Software Foundation, Inc.
;; Author: Frederic Lepied <Frederic.Lepied@sugix.frmug.org>
;; Maintainer: emacs-devel@gnu.org
@@ -290,7 +290,7 @@ If ARG is omitted, point is placed at the end of the expanded text."
(defvar expand-list nil "Temporary variable used by the Expand package.")
(defvar expand-pos nil
- "If non-nil, stores a vector containing markers to positions defined by the last expansion.")
+ "If non-nil, store a vector with position markers defined by the last expansion.")
(make-variable-buffer-local 'expand-pos)
(defvar expand-index 0
diff --git a/lisp/ezimage.el b/lisp/ezimage.el
index dcedd8a5fb6..9c1d8599101 100644
--- a/lisp/ezimage.el
+++ b/lisp/ezimage.el
@@ -1,6 +1,6 @@
;;; ezimage --- Generalized Image management
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: file, tags, tools
diff --git a/lisp/face-remap.el b/lisp/face-remap.el
index 028269a4b0c..c53b20f3338 100644
--- a/lisp/face-remap.el
+++ b/lisp/face-remap.el
@@ -1,6 +1,6 @@
;;; face-remap.el --- Functions for managing `face-remapping-alist' -*- lexical-binding: t -*-
;;
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;;
;; Author: Miles Bader <miles@gnu.org>
;; Keywords: faces, face remapping, display, user commands
@@ -33,7 +33,7 @@
;;
;; (face RELATIVE_SPECS_1 RELATIVE_SPECS_2 ... BASE_SPECS)
;;
-;; The "specs" values are a lists of face names or face attribute-value
+;; The "specs" values are lists of face names or face attribute-value
;; pairs, and are merged together, with earlier values taking precedence.
;;
;; The RELATIVE_SPECS_* values are added by `face-remap-add-relative'
@@ -183,13 +183,13 @@ to apply on top of the normal definition of FACE."
This causes the remappings specified by `face-remap-add-relative'
to apply on top of the face specification given by SPECS.
-The remaining arguments, SPECS, should form a list of faces.
-Each list element should be either a face name or a property list
+The remaining arguments, SPECS, specify the base of the remapping.
+Each one of SPECS should be either a face name or a property list
of face attribute/value pairs, like in a `face' text property.
-If SPECS is empty, call `face-remap-reset-base' to use the normal
-definition of FACE as the base remapping; note that this is
-different from SPECS containing a single value nil, which means
+If SPECS is empty or a single face `eq' to FACE, call `face-remap-reset-base'
+to use the normal definition of FACE as the base remapping; note that
+this is different from SPECS containing a single value nil, which means
not to inherit from the global definition of FACE at all."
(while (and (consp specs) (not (null (car specs))) (null (cdr specs)))
(setq specs (car specs)))
@@ -229,6 +229,28 @@ Each positive or negative step scales the default face height by this amount."
(defvar text-scale-mode-amount 0)
(make-variable-buffer-local 'text-scale-mode-amount)
+(defvar text-scale-remap-header-line nil
+ "If non-nil, text scaling may change font size of header lines too.")
+(make-variable-buffer-local 'text-scale-header-line)
+
+(defun face-remap--clear-remappings ()
+ (dolist (remapping
+ ;; This is a bit messy to stay backwards compatible.
+ ;; In the future, this can be simplified to just use
+ ;; `text-scale-mode-remapping'.
+ (if (consp (car-safe text-scale-mode-remapping))
+ text-scale-mode-remapping
+ (list text-scale-mode-remapping)))
+ (face-remap-remove-relative remapping))
+ (setq text-scale-mode-remapping nil))
+
+(defun face-remap--remap-face (sym)
+ (push (face-remap-add-relative sym
+ :height
+ (expt text-scale-mode-step
+ text-scale-mode-amount))
+ text-scale-mode-remapping))
+
(define-minor-mode text-scale-mode
"Minor mode for displaying buffer text in a larger/smaller font.
@@ -240,21 +262,32 @@ face size by the value of the variable `text-scale-mode-step'
The `text-scale-increase', `text-scale-decrease', and
`text-scale-set' functions may be used to interactively modify
the variable `text-scale-mode-amount' (they also enable or
-disable `text-scale-mode' as necessary)."
+disable `text-scale-mode' as necessary).
+
+If `text-scale-remap-header-line' is non-nil, also change
+the font size of the header line."
:lighter (" " text-scale-mode-lighter)
- (when text-scale-mode-remapping
- (face-remap-remove-relative text-scale-mode-remapping))
+ (face-remap--clear-remappings)
(setq text-scale-mode-lighter
(format (if (>= text-scale-mode-amount 0) "+%d" "%d")
text-scale-mode-amount))
- (setq text-scale-mode-remapping
- (and text-scale-mode
- (face-remap-add-relative 'default
- :height
- (expt text-scale-mode-step
- text-scale-mode-amount))))
+ (when text-scale-mode
+ (face-remap--remap-face 'default)
+ (when text-scale-remap-header-line
+ (face-remap--remap-face 'header-line)))
(force-window-update (current-buffer)))
+(defun text-scale--refresh (symbol newval operation where)
+ "Watcher for `text-scale-remap-header-line'.
+See `add-variable-watcher'."
+ (when (and (eq symbol 'text-scale-remap-header-line)
+ (eq operation 'set)
+ text-scale-mode)
+ (with-current-buffer where
+ (let ((text-scale-remap-header-line newval))
+ (text-scale-mode 1)))))
+(add-variable-watcher 'text-scale-remap-header-line #'text-scale--refresh)
+
(defun text-scale-min-amount ()
"Return the minimum amount of text-scaling we allow."
;; When the resulting pixel-height of characters will become smaller
@@ -413,7 +446,7 @@ local, and sets it to FACE."
(setq specs (car specs)))
(if (null specs)
(buffer-face-mode 0)
- (set (make-local-variable 'buffer-face-mode-face) specs)
+ (setq-local buffer-face-mode-face specs)
(buffer-face-mode t)))
;;;###autoload
@@ -437,7 +470,7 @@ buffer local, and set it to SPECS."
(if (or (null specs)
(and buffer-face-mode (equal buffer-face-mode-face specs)))
(buffer-face-mode 0)
- (set (make-local-variable 'buffer-face-mode-face) specs)
+ (setq-local buffer-face-mode-face specs)
(buffer-face-mode t)))
(defun buffer-face-mode-invoke (specs arg &optional interactive)
diff --git a/lisp/facemenu.el b/lisp/facemenu.el
index 3ed4b54d223..dc5f8f46aba 100644
--- a/lisp/facemenu.el
+++ b/lisp/facemenu.el
@@ -1,6 +1,6 @@
-;;; facemenu.el --- create a face menu for interactively adding fonts to text
+;;; facemenu.el --- create a face menu for interactively adding fonts to text -*- lexical-binding: t; -*-
-;; Copyright (C) 1994-1996, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1996, 2001-2021 Free Software Foundation, Inc.
;; Author: Boris Goldowsky <boris@gnu.org>
;; Keywords: faces
@@ -85,10 +85,6 @@
;;; Code:
-(eval-when-compile
- (require 'help)
- (require 'button))
-
;; Global bindings:
(define-key global-map [C-down-mouse-2] 'facemenu-menu)
(define-key global-map "\M-o" 'facemenu-keymap)
@@ -610,9 +606,14 @@ color. The function should accept a single argument, the color name."
(defun list-colors-print (list &optional callback)
(let ((callback-fn
- (if callback
- `(lambda (button)
- (funcall ,callback (button-get button 'color-name))))))
+ ;; Expect CALLBACK to be a function, but allow it to be a form that
+ ;; evaluates to a function, for backward-compatibility. (Bug#45831)
+ (cond ((functionp callback)
+ (lambda (button)
+ (funcall callback (button-get button 'color-name))))
+ (callback
+ `(lambda (button)
+ (funcall ,callback (button-get button 'color-name)))))))
(dolist (color list)
(if (consp color)
(if (cdr color)
diff --git a/lisp/faces.el b/lisp/faces.el
index 728f8b0fe67..4e98338432f 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -1,6 +1,6 @@
;;; faces.el --- Lisp faces -*- lexical-binding: t -*-
-;; Copyright (C) 1992-1996, 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1992-1996, 1998-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
@@ -272,7 +272,7 @@ of a face name is the same for all frames."
(defun face-equal (face1 face2 &optional frame)
"Non-nil if faces FACE1 and FACE2 are equal.
Faces are considered equal if all their attributes are equal.
-If the optional argument FRAME is given, report on FACE1 and FACE2 in that frame.
+If optional argument FRAME is given, report on FACE1 and FACE2 in that frame.
If FRAME is t, report on the defaults for FACE1 and FACE2 (for new frames).
If FRAME is omitted or nil, use the selected frame."
(internal-lisp-face-equal-p face1 face2 frame))
@@ -484,7 +484,7 @@ FACES may be either a single face or a list of faces.
(defmacro face-attribute-specified-or (value &rest body)
- "Return VALUE, unless it's `unspecified', in which case evaluate BODY and return the result."
+ "Return VALUE or, if it's `unspecified', the result of evaluating BODY."
(let ((temp (make-symbol "value")))
`(let ((,temp ,value))
(if (not (eq ,temp 'unspecified))
@@ -2578,7 +2578,7 @@ non-nil."
:group 'basic-faces)
(defface mode-line-highlight
- '((((class color) (min-colors 88))
+ '((((supports :box t) (class color) (min-colors 88))
:box (:line-width 2 :color "grey40" :style released-button))
(t
:inherit highlight))
diff --git a/lisp/ffap.el b/lisp/ffap.el
index bf035886006..1f43bafdb93 100644
--- a/lisp/ffap.el
+++ b/lisp/ffap.el
@@ -1,6 +1,6 @@
;;; ffap.el --- find file (or url) at point -*- lexical-binding: t -*-
-;; Copyright (C) 1995-1997, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995-1997, 2000-2021 Free Software Foundation, Inc.
;; Author: Michelangelo Grigni <mic@mathcs.emory.edu>
;; Maintainer: emacs-devel@gnu.org
@@ -301,15 +301,14 @@ disable ffap most of the time."
:version "20.3")
-;;; Compatibility:
-;;
-;; This version of ffap supports only the Emacs it is distributed in.
-;; See the ftp site for a more general version. The following
-;; functions are necessary "leftovers" from the more general version.
+;;; Obsolete:
(defun ffap-mouse-event () ; current mouse event, or nil
+ (declare (obsolete nil "28.1"))
(and (listp last-nonmenu-event) last-nonmenu-event))
+
(defun ffap-event-buffer (event)
+ (declare (obsolete nil "28.1"))
(window-buffer (car (event-start event))))
@@ -690,14 +689,13 @@ Optional DEPTH limits search depth."
(setq depth (1- depth))
(cons dir
(and (not (eq depth -1))
- (apply 'nconc
+ (apply #'nconc
(mapcar
- (function
- (lambda (d)
- (cond
- ((not (file-directory-p d)) nil)
- ((file-symlink-p d) (list d))
- (t (ffap-all-subdirs-loop d depth)))))
+ (lambda (d)
+ (cond
+ ((not (file-directory-p d)) nil)
+ ((file-symlink-p d) (list d))
+ (t (ffap-all-subdirs-loop d depth))))
(directory-files dir t "\\`[^.]")
)))))
@@ -710,13 +708,12 @@ Set to 0 to avoid all searching, or nil for no limit.")
The subdirs begin with the original directory, and the depth of the
search is bounded by `ffap-kpathsea-depth'. This is intended to mimic
kpathsea, a library used by some versions of TeX."
- (apply 'nconc
+ (apply #'nconc
(mapcar
- (function
- (lambda (dir)
- (if (string-match "[^/]//\\'" dir)
- (ffap-all-subdirs (substring dir 0 -2) ffap-kpathsea-depth)
- (list dir))))
+ (lambda (dir)
+ (if (string-match "[^/]//\\'" dir)
+ (ffap-all-subdirs (substring dir 0 -2) ffap-kpathsea-depth)
+ (list dir)))
path)))
(defun ffap-locate-file (file nosuffix path)
@@ -1738,7 +1735,9 @@ Function CONT is applied to the entry chosen by the user."
(let (choice)
(cond
;; Emacs mouse:
- ((and (fboundp 'x-popup-menu) (ffap-mouse-event))
+ ((and (fboundp 'x-popup-menu)
+ (listp last-nonmenu-event)
+ last-nonmenu-event)
(setq choice
(x-popup-menu
t
@@ -1793,8 +1792,7 @@ Applies `ffap-menu-text-plist' text properties at all matches."
;; Remove duplicates.
(setq ffap-menu-alist ; sort by item
(sort ffap-menu-alist
- (function
- (lambda (a b) (string-lessp (car a) (car b))))))
+ (lambda (a b) (string-lessp (car a) (car b)))))
(let ((ptr ffap-menu-alist)) ; remove duplicates
(while (cdr ptr)
(if (equal (car (car ptr)) (car (car (cdr ptr))))
@@ -1802,8 +1800,7 @@ Applies `ffap-menu-text-plist' text properties at all matches."
(setq ptr (cdr ptr)))))
(setq ffap-menu-alist ; sort by position
(sort ffap-menu-alist
- (function
- (lambda (a b) (< (cdr a) (cdr b)))))))
+ (lambda (a b) (< (cdr a) (cdr b))))))
;;; Mouse Support (`ffap-at-mouse'):
@@ -1833,7 +1830,7 @@ Return value:
(ffap-guesser))))
(cond
(guess
- (set-buffer (ffap-event-buffer e))
+ (set-buffer (window-buffer (car (event-start e))))
(ffap-highlight)
(unwind-protect
(progn
diff --git a/lisp/filecache.el b/lisp/filecache.el
index 00c53138032..67d2939dd3c 100644
--- a/lisp/filecache.el
+++ b/lisp/filecache.el
@@ -1,6 +1,6 @@
;;; filecache.el --- find files using a pre-loaded cache -*- lexical-binding:t -*-
-;; Copyright (C) 1996, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 2000-2021 Free Software Foundation, Inc.
;; Author: Peter Breton <pbreton@cs.umb.edu>
;; Created: Sun Nov 10 1996
diff --git a/lisp/fileloop.el b/lisp/fileloop.el
index b778eca8e9b..cb9fe8f7769 100644
--- a/lisp/fileloop.el
+++ b/lisp/fileloop.el
@@ -1,6 +1,6 @@
;;; fileloop.el --- Operations on multiple files -*- lexical-binding: t; -*-
-;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2018-2021 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
diff --git a/lisp/filenotify.el b/lisp/filenotify.el
index 8aa7f3cd81f..78571776a39 100644
--- a/lisp/filenotify.el
+++ b/lisp/filenotify.el
@@ -1,6 +1,6 @@
;;; filenotify.el --- watch files for changes on disk -*- lexical-binding:t -*-
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
diff --git a/lisp/files-x.el b/lisp/files-x.el
index 911e7ba9e3d..628bf180929 100644
--- a/lisp/files-x.el
+++ b/lisp/files-x.el
@@ -1,6 +1,6 @@
;;; files-x.el --- extended file handling commands
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Juri Linkov <juri@jurta.org>
;; Maintainer: emacs-devel@gnu.org
@@ -730,6 +730,16 @@ Execute BODY, and unwind connection-local variables."
;; No connection-local variables to apply.
,@body))
+;;;###autoload
+(defun path-separator ()
+ "The connection-local value of `path-separator'."
+ (with-connection-local-variables path-separator))
+
+;;;###autoload
+(defun null-device ()
+ "The connection-local value of `null-device'."
+ (with-connection-local-variables null-device))
+
(provide 'files-x)
diff --git a/lisp/files.el b/lisp/files.el
index 59bcc3e8a78..d2e5413b3ad 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -1,6 +1,6 @@
;;; files.el --- file input and output commands for Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1985-1987, 1992-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1987, 1992-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Package: emacs
@@ -597,7 +597,7 @@ settings being applied, but still respect file-local ones.")
;; This is an odd variable IMO.
;; You might wonder why it is needed, when we could just do:
-;; (set (make-local-variable 'enable-local-variables) nil)
+;; (setq-local enable-local-variables nil)
;; These two are not precisely the same.
;; Setting this variable does not cause -*- mode settings to be
;; ignored, whereas setting enable-local-variables does.
@@ -888,6 +888,16 @@ recursion."
(push (concat dir "/" file) files)))))
(nconc result (nreverse files))))
+(defun directory-empty-p (dir)
+ "Return t if DIR names an existing directory containing no other files.
+Return nil if DIR does not name a directory, or if there was
+trouble determining whether DIR is a directory or empty.
+
+Symbolic links to directories count as directories.
+See `file-symlink-p' to distinguish symlinks."
+ (and (file-directory-p dir)
+ (null (directory-files dir nil directory-files-no-dot-files-regexp t 1))))
+
(defvar module-file-suffix)
(defun load-file (file)
@@ -1840,6 +1850,10 @@ expand wildcards (if any) and replace the file with multiple files."
The buffer being killed is current while the hook is running.
See `kill-buffer'.
+This hook is not run for internal or temporary buffers created by
+`get-buffer-create' or `generate-new-buffer' with argument
+INHIBIT-BUFFER-HOOKS non-nil.
+
Note: Be careful with let-binding this hook considering it is
frequently used for cleanup.")
@@ -1941,7 +1955,7 @@ this function prepends a \"|\" to the final result if necessary."
(let ((lastname (file-name-nondirectory filename)))
(if (string= lastname "")
(setq lastname filename))
- (generate-new-buffer (if (string-match-p "\\` " lastname)
+ (generate-new-buffer (if (string-prefix-p " " lastname)
(concat "|" lastname)
lastname))))
@@ -2127,7 +2141,7 @@ think it does, because \"free\" is pretty hard to define in practice."
("Yes" . ?y)
("No" . ?n)
("Open literally" . ?l)))
- (read-char-from-minibuffer
+ (read-char-choice
(concat prompt " (y)es or (n)o or (l)iterally ")
'(?y ?Y ?n ?N ?l ?L)))))
(cond ((memq choice '(?y ?Y)) nil)
@@ -2300,53 +2314,52 @@ the various files."
;; hexl-mode or image-mode.
(memq major-mode '(hexl-mode image-mode)))
(if (buffer-modified-p)
- (if (y-or-n-p
- (format
- (if rawfile
- "The file %s is already visited normally,
+ (if (let ((help-form
+ (format-message
+ (if rawfile "\
+The file %s is already visited normally,
and you have edited the buffer. Now you have asked to visit it literally,
meaning no coding system handling, format conversion, or local variables.
-Emacs can visit a file in only one way at a time.
-
-Do you want to save the file, and visit it literally instead? "
- "The file %s is already visited literally,
+Emacs can visit a file in only one way at a time."
+ "\
+The file %s is already visited literally,
meaning no coding system handling, format conversion, or local variables.
You have edited the buffer. Now you have asked to visit the file normally,
-but Emacs can visit a file in only one way at a time.
-
-Do you want to save the file, and visit it normally instead? ")
- (file-name-nondirectory filename)))
+but Emacs can visit a file in only one way at a time.")
+ (file-name-nondirectory filename))))
+ (y-or-n-p
+ (if rawfile "\
+Do you want to save the file, and visit it literally instead? " "\
+Do you want to save the file, and visit it normally instead? ")))
(progn
(save-buffer)
(find-file-noselect-1 buf filename nowarn
rawfile truename number))
(if (y-or-n-p
- (format
- (if rawfile
- "\
-Do you want to discard your changes, and visit the file literally now? "
- "\
-Do you want to discard your changes, and visit the file normally now? ")))
+ (if rawfile "\
+Do you want to discard your changes, and visit the file literally now? " "\
+Do you want to discard your changes, and visit the file normally now? "))
(find-file-noselect-1 buf filename nowarn
rawfile truename number)
(error (if rawfile "File already visited non-literally"
"File already visited literally"))))
- (if (y-or-n-p
- (format
- (if rawfile
- "The file %s is already visited normally.
+ (if (let ((help-form
+ (format-message
+ (if rawfile "\
+The file %s is already visited normally.
You have asked to visit it literally,
meaning no coding system decoding, format conversion, or local variables.
-But Emacs can visit a file in only one way at a time.
-
-Do you want to revisit the file literally now? "
- "The file %s is already visited literally,
+But Emacs can visit a file in only one way at a time."
+ "\
+The file %s is already visited literally,
meaning no coding system decoding, format conversion, or local variables.
You have asked to visit it normally,
-but Emacs can visit a file in only one way at a time.
-
-Do you want to revisit the file normally now? ")
- (file-name-nondirectory filename)))
+but Emacs can visit a file in only one way at a time.")
+ (file-name-nondirectory filename))))
+ (y-or-n-p
+ (if rawfile "\
+Do you want to revisit the file literally now? " "\
+Do you want to revisit the file normally now? ")))
(find-file-noselect-1 buf filename nowarn
rawfile truename number)
(error (if rawfile "File already visited non-literally"
@@ -2410,9 +2423,7 @@ Do you want to revisit the file normally now? ")
;; this is a permanent local, the major mode won't eliminate it.
(and backup-enable-predicate
(not (funcall backup-enable-predicate buffer-file-name))
- (progn
- (make-local-variable 'backup-inhibited)
- (setq backup-inhibited t)))
+ (setq-local backup-inhibited t))
(if rawfile
(progn
(set-buffer-multibyte nil)
@@ -2669,6 +2680,7 @@ since only a single case-insensitive search through the alist is made."
("\\.dir-locals\\(?:-2\\)?\\.el\\'" . lisp-data-mode)
("eww-bookmarks\\'" . lisp-data-mode)
("tramp\\'" . lisp-data-mode)
+ ("/archive-contents\\'" . lisp-data-mode)
("places\\'" . lisp-data-mode)
("\\.emacs-places\\'" . lisp-data-mode)
("\\.el\\'" . emacs-lisp-mode)
@@ -3510,7 +3522,7 @@ n -- to ignore the local variables list.")
(let ((print-escape-newlines t))
(prin1 (cdr elt) buf))
(insert "\n"))
- (set (make-local-variable 'cursor-type) nil)
+ (setq-local cursor-type nil)
(set-buffer-modified-p nil)
(goto-char (point-min)))
@@ -3526,7 +3538,7 @@ n -- to ignore the local variables list.")
", or C-v/M-v to scroll")))
char)
(if offer-save (push ?! exit-chars))
- (setq char (read-char-from-minibuffer prompt exit-chars))
+ (setq char (read-char-choice prompt exit-chars))
(when (and offer-save (= char ?!) unsafe-vars)
(customize-push-and-save 'safe-local-variable-values unsafe-vars))
(prog1 (memq char '(?! ?\s ?y))
@@ -4482,9 +4494,7 @@ the old visited file has been renamed to the new name FILENAME."
(and buffer-file-name
backup-enable-predicate
(not (funcall backup-enable-predicate buffer-file-name))
- (progn
- (make-local-variable 'backup-inhibited)
- (setq backup-inhibited t)))
+ (setq-local backup-inhibited t))
(let ((oauto buffer-auto-save-file-name))
(cond ((null filename)
(setq buffer-auto-save-file-name nil))
@@ -5857,10 +5867,7 @@ RECURSIVE if DIRECTORY is nonempty."
;; case, where the operation fails in delete-directory-internal.
;; As `move-file-to-trash' trashes directories (empty or
;; otherwise) as a unit, we do not need to recurse here.
- (if (and (not recursive)
- ;; Check if directory is empty apart from "." and "..".
- (directory-files
- directory 'full directory-files-no-dot-files-regexp))
+ (if (not (or recursive (directory-empty-p directory)))
(error "Directory is not empty, not moving to trash")
(move-file-to-trash directory)))
;; Otherwise, call ourselves recursively if needed.
@@ -6116,6 +6123,9 @@ This undoes all changes since the file was visited or saved.
With a prefix argument, offer to revert from latest auto-save file, if
that is more recent than the visited file.
+Reverting a buffer will try to preserve markers in the buffer;
+see the Info node `(elisp)Reverting' for details.
+
This command also implements an interface for special buffers
that contain text that doesn't come from a file, but reflects
some other data instead (e.g. Dired buffers, `buffer-list'
@@ -6212,7 +6222,7 @@ Non-file buffers need a custom function."
;; Run after-revert-hook as it was before we reverted.
(setq-default revert-buffer-internal-hook global-hook)
(if local-hook
- (set (make-local-variable 'revert-buffer-internal-hook)
+ (setq-local revert-buffer-internal-hook
local-hook)
(kill-local-variable 'revert-buffer-internal-hook))
(run-hooks 'revert-buffer-internal-hook))
@@ -7363,9 +7373,9 @@ if any returns nil. If `confirm-kill-emacs' is non-nil, calls it."
(save-some-buffers arg t)
(let ((confirm confirm-kill-emacs))
(and
- (or (not (memq t (mapcar (function
- (lambda (buf) (and (buffer-file-name buf)
- (buffer-modified-p buf))))
+ (or (not (memq t (mapcar (lambda (buf)
+ (and (buffer-file-name buf)
+ (buffer-modified-p buf)))
(buffer-list))))
(progn (setq confirm nil)
(yes-or-no-p "Modified buffers exist; exit anyway? ")))
diff --git a/lisp/filesets.el b/lisp/filesets.el
index 4f23faa2203..2ef13ae8320 100644
--- a/lisp/filesets.el
+++ b/lisp/filesets.el
@@ -1,6 +1,6 @@
-;;; filesets.el --- handle group of files
+;;; filesets.el --- handle group of files -*- lexical-binding: t; -*-
-;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Author: Thomas Link <sanobast-emacs@yahoo.de>
;; Maintainer: emacs-devel@gnu.org
@@ -35,7 +35,7 @@
;; inclusion group (i.e. a base file including other files).
;; Usage:
-;; 1. Put (require 'filesets) and (filesets-init) in your init file.
+;; 1. Put (filesets-init) in your init file.
;; 2. Type ;; M-x filesets-edit or choose "Edit Filesets" from the menu.
;; 3. Save your customizations.
@@ -88,7 +88,9 @@
;;; Code:
-(eval-when-compile (require 'cl-lib))
+(require 'cl-lib)
+(require 'seq)
+(require 'easymenu)
;;; Some variables
@@ -152,58 +154,31 @@ COND-FN takes one argument: the current element."
; (cl-remove 'dummy lst :test (lambda (dummy elt)
; (not (funcall cond-fn elt)))))
(let ((rv nil))
- (dolist (elt lst rv)
+ (dolist (elt lst)
(when (funcall cond-fn elt)
- (setq rv (append rv (list elt)))))))
+ (push elt rv)))
+ (nreverse rv)))
(defun filesets-ormap (fsom-pred lst)
"Return the tail of LST for the head of which FSOM-PRED is non-nil."
(let ((fsom-lst lst)
(fsom-rv nil))
- (while (and (not (null fsom-lst))
+ (while (and fsom-lst
(null fsom-rv))
(if (funcall fsom-pred (car fsom-lst))
(setq fsom-rv fsom-lst)
(setq fsom-lst (cdr fsom-lst))))
fsom-rv))
-(defun filesets-some (fss-pred fss-lst)
- "Return non-nil if FSS-PRED is non-nil for any element of FSS-LST.
-Like `some', return the first value of FSS-PRED that is non-nil."
- (catch 'exit
- (dolist (fss-this fss-lst nil)
- (let ((fss-rv (funcall fss-pred fss-this)))
- (when fss-rv
- (throw 'exit fss-rv))))))
-;(fset 'filesets-some 'cl-some) ;; or use the cl function
-
-(defun filesets-member (fsm-item fsm-lst &rest fsm-keys)
- "Find the first occurrence of FSM-ITEM in FSM-LST.
-It is supposed to work like cl's `member*'. At the moment only the :test
-key is supported."
- (let ((fsm-test (or (plist-get fsm-keys ':test)
- (function equal))))
- (filesets-ormap (lambda (fsm-this)
- (funcall fsm-test fsm-item fsm-this))
- fsm-lst)))
-;(fset 'filesets-member 'cl-member) ;; or use the cl function
-
-(defun filesets-sublist (lst beg &optional end)
- "Get the sublist of LST from BEG to END - 1."
- (let ((rv nil)
- (i beg)
- (top (or end
- (length lst))))
- (while (< i top)
- (setq rv (append rv (list (nth i lst))))
- (setq i (+ i 1)))
- rv))
+(define-obsolete-function-alias 'filesets-some #'cl-some "28.1")
+(define-obsolete-function-alias 'filesets-member #'cl-member "28.1")
+(define-obsolete-function-alias 'filesets-sublist #'seq-subseq "28.1")
(defun filesets-select-command (cmd-list)
"Select one command from CMD-LIST -- a string with space separated names."
(let ((this (shell-command-to-string
- (format "which --skip-alias %s 2> /dev/null | head -n 1"
- cmd-list))))
+ (format "which --skip-alias %s 2> %s | head -n 1"
+ cmd-list null-device))))
(if (equal this "")
nil
(file-name-nondirectory (substring this 0 (- (length this) 1))))))
@@ -221,7 +196,7 @@ key is supported."
(defun filesets-message (level &rest args)
"Show a message only if LEVEL is greater or equal then `filesets-verbosity'."
(when (<= level (abs filesets-verbosity))
- (apply 'message args)))
+ (apply #'message args)))
;;; config file
@@ -232,9 +207,9 @@ key is supported."
(defun filesets-reset-fileset (&optional fileset no-cache)
"Reset the cached values for one or all filesets."
- (if fileset
- (setq filesets-submenus (lax-plist-put filesets-submenus fileset nil))
- (setq filesets-submenus nil))
+ (setq filesets-submenus (if fileset
+ (lax-plist-put filesets-submenus fileset nil)
+ nil))
(setq filesets-has-changed-flag t)
(setq filesets-update-cache-file-flag (or filesets-update-cache-file-flag
(not no-cache))))
@@ -302,50 +277,46 @@ SYM to VAL and return t. If INIT-FLAG is non-nil, set with
(defcustom filesets-menu-name "Filesets"
"Filesets' menu name."
- :set (function filesets-set-default)
- :type 'string
- :group 'filesets)
+ :set #'filesets-set-default
+ :type 'string)
(defcustom filesets-menu-path '("File") ; cf recentf-menu-path
"The menu under which the filesets menu should be inserted.
-See `add-submenu' for documentation."
- :set (function filesets-set-default)
+See `easy-menu-add-item' for documentation."
+ :set #'filesets-set-default
:type '(choice (const :tag "Top Level" nil)
(sexp :tag "Menu Path"))
:version "23.1" ; was nil
- :group 'filesets)
+ )
(defcustom filesets-menu-before "Open File..." ; cf recentf-menu-before
"The name of a menu before which this menu should be added.
-See `add-submenu' for documentation."
- :set (function filesets-set-default)
+See `easy-menu-add-item' for documentation."
+ :set #'filesets-set-default
:type '(choice (string :tag "Name")
(const :tag "Last" nil))
:version "23.1" ; was "File"
- :group 'filesets)
+ )
(defcustom filesets-menu-in-menu nil
"Use that instead of `current-menubar' as the menu to change.
-See `add-submenu' for documentation."
- :set (function filesets-set-default)
- :type 'sexp
- :group 'filesets)
+See `easy-menu-add-item' for documentation."
+ :set #'filesets-set-default
+ :type 'sexp)
(defcustom filesets-menu-shortcuts-flag t
"Non-nil means to prepend menus with hopefully unique shortcuts."
- :set (function filesets-set-default!)
- :type 'boolean
- :group 'filesets)
+ :set #'filesets-set-default!
+ :type 'boolean)
(defcustom filesets-menu-shortcuts-marker "%_"
"String for marking menu shortcuts."
- :set (function filesets-set-default!)
- :type 'string
- :group 'filesets)
+ :set #'filesets-set-default!
+ :type 'string)
;;(defcustom filesets-menu-cnvfp-flag nil
;; "Non-nil means show \"Convert :pattern to :files\" entry for :pattern menus."
-;; :set (function filesets-set-default!)
+;; :set #'filesets-set-default!
;; :type 'boolean
;; :group 'filesets)
@@ -354,9 +325,8 @@ See `add-submenu' for documentation."
"File to be used for saving the filesets menu between sessions.
Set this to \"\", to disable caching of menus.
Don't forget to check out `filesets-menu-ensure-use-cached'."
- :set (function filesets-set-default)
- :type 'file
- :group 'filesets)
+ :set #'filesets-set-default
+ :type 'file)
(put 'filesets-menu-cache-file 'risky-local-variable t)
(defcustom filesets-menu-cache-contents
@@ -382,7 +352,7 @@ If you want caching to work properly, at least `filesets-submenus',
list.
Don't forget to check out `filesets-menu-ensure-use-cached'."
- :set (function filesets-set-default)
+ :set #'filesets-set-default
:type '(repeat
(choice :tag "Variable"
(const :tag "filesets-submenus"
@@ -399,8 +369,7 @@ Don't forget to check out `filesets-menu-ensure-use-cached'."
:value filesets-ingroup-patterns)
(const :tag "filesets-be-docile-flag"
:value filesets-be-docile-flag)
- (sexp :tag "Other" :value nil)))
- :group 'filesets)
+ (sexp :tag "Other" :value nil))))
(define-obsolete-variable-alias 'filesets-cache-fill-content-hooks
'filesets-cache-fill-content-hook "24.3")
@@ -422,48 +391,43 @@ configuration file, you can add a something like this
to this hook.
Don't forget to check out `filesets-menu-ensure-use-cached'."
- :set (function filesets-set-default)
- :type 'hook
- :group 'filesets)
+ :set #'filesets-set-default
+ :type 'hook)
(defcustom filesets-cache-hostname-flag nil
"Non-nil means cache the hostname.
If the current name differs from the cached one,
rebuild the menu and create a new cache file."
- :set (function filesets-set-default)
- :type 'boolean
- :group 'filesets)
+ :set #'filesets-set-default
+ :type 'boolean)
(defcustom filesets-cache-save-often-flag nil
"Non-nil means save buffer on every change of the filesets menu.
If this variable is set to nil and if Emacs crashes, the cache and
filesets-data could get out of sync. Set this to t if this happens from
time to time or if the fileset cache causes troubles."
- :set (function filesets-set-default)
- :type 'boolean
- :group 'filesets)
+ :set #'filesets-set-default
+ :type 'boolean)
(defcustom filesets-max-submenu-length 25
"Maximum length of submenus.
Set this value to 0 to turn menu splitting off. BTW, parts of submenus
will not be rewrapped if their length exceeds this value."
- :set (function filesets-set-default)
- :type 'integer
- :group 'filesets)
+ :set #'filesets-set-default
+ :type 'integer)
(defcustom filesets-max-entry-length 50
"Truncate names of split submenus to this length."
- :set (function filesets-set-default)
- :type 'integer
- :group 'filesets)
+ :set #'filesets-set-default
+ :type 'integer)
-(defcustom filesets-browse-dir-function 'dired
+(defcustom filesets-browse-dir-function #'dired
"A function or command used for browsing directories.
When using an external command, \"%s\" will be replaced with the
directory's name.
Note: You have to manually rebuild the menu if you change this value."
- :set (function filesets-set-default)
+ :set #'filesets-set-default
:type '(choice :tag "Function:"
(const :tag "dired"
:value dired)
@@ -472,10 +436,9 @@ Note: You have to manually rebuild the menu if you change this value."
(string :tag "Name")
(string :tag "Arguments"))
(function :tag "Function"
- :value nil))
- :group 'filesets)
+ :value nil)))
-(defcustom filesets-open-file-function 'filesets-find-or-display-file
+(defcustom filesets-open-file-function #'filesets-find-or-display-file
"The function used for opening files.
`filesets-find-or-display-file' ... Filesets' default function for
@@ -488,26 +451,24 @@ for a specific file type. Either this viewer, if defined, or
readable, will not be opened.
Caveat: Changes will take effect only after rebuilding the menu."
- :set (function filesets-set-default)
+ :set #'filesets-set-default
:type '(choice :tag "Function:"
(const :tag "filesets-find-or-display-file"
:value filesets-find-or-display-file)
(const :tag "filesets-find-file"
:value filesets-find-file)
(function :tag "Function"
- :value nil))
- :group 'filesets)
+ :value nil)))
-(defcustom filesets-save-buffer-function 'save-buffer
+(defcustom filesets-save-buffer-function #'save-buffer
"The function used to save a buffer.
Caveat: Changes will take effect after rebuilding the menu."
- :set (function filesets-set-default)
+ :set #'filesets-set-default
:type '(choice :tag "Function:"
(const :tag "save-buffer"
:value save-buffer)
(function :tag "Function"
- :value nil))
- :group 'filesets)
+ :value nil)))
(defcustom filesets-find-file-delay
(if (and (featurep 'xemacs) gutter-buffers-tab-visible-p)
@@ -518,29 +479,25 @@ This is for calls via `filesets-find-or-display-file'
or `filesets-find-file'.
Set this to 0, if you don't use XEmacs's buffer tabs."
- :set (function filesets-set-default)
- :type 'number
- :group 'filesets)
+ :set #'filesets-set-default
+ :type 'number)
(defcustom filesets-be-docile-flag nil
"Non-nil means don't complain if a file or a directory doesn't exist.
This is useful if you want to use the same startup files in different
computer environments."
- :set (function filesets-set-default)
- :type 'boolean
- :group 'filesets)
+ :set #'filesets-set-default
+ :type 'boolean)
(defcustom filesets-sort-menu-flag t
"Non-nil means sort the filesets menu alphabetically."
- :set (function filesets-set-default)
- :type 'boolean
- :group 'filesets)
+ :set #'filesets-set-default
+ :type 'boolean)
(defcustom filesets-sort-case-sensitive-flag t
"Non-nil means sorting of the filesets menu is case sensitive."
- :set (function filesets-set-default)
- :type 'boolean
- :group 'filesets)
+ :set #'filesets-set-default
+ :type 'boolean)
(defcustom filesets-tree-max-level 3
"Maximum scan depth for directory trees.
@@ -560,9 +517,8 @@ i.e. how deep the menu should be. Try something like
and it should become clear what this option is about. In any case,
including directory trees to the menu can take a lot of memory."
- :set (function filesets-set-default)
- :type 'integer
- :group 'filesets)
+ :set #'filesets-set-default
+ :type 'integer)
(defcustom filesets-commands
'(("Isearch"
@@ -589,7 +545,7 @@ function that returns one) to be run on a filesets' files.
The argument <file-name> or <<file-name>> (quoted) will be replaced with
the filename."
- :set (function filesets-set-default+)
+ :set #'filesets-set-default+
:type '(repeat :tag "Commands"
(list :tag "Definition" :value ("")
(string "Name")
@@ -605,8 +561,7 @@ the filename."
(string :tag "Quoted File Name"
:value "<<file-name>>")
(function :tag "Function"
- :value nil)))))
- :group 'filesets)
+ :value nil))))))
(put 'filesets-commands 'risky-local-variable t)
(defcustom filesets-external-viewers
@@ -626,28 +581,33 @@ the filename."
(dvi-cmd "xdvi")
(doc-cmd "antiword")
(pic-cmd "gqview"))
- `(("^.+\\..?html?$" browse-url
+ `((".\\..?html?\\'" browse-url
((:ignore-on-open-all t)))
- ("^.+\\.pdf$" ,pdf-cmd
+ (".\\.pdf\\'" ,pdf-cmd
((:ignore-on-open-all t)
(:ignore-on-read-text t)
- (:constraint-flag ,pdf-cmd)))
- ("^.+\\.e?ps\\(.gz\\)?$" ,ps-cmd
+ ;; (:constraintp ,pdf-cmd)
+ ))
+ (".\\.e?ps\\(?:\\.gz\\)?\\'" ,ps-cmd
((:ignore-on-open-all t)
(:ignore-on-read-text t)
- (:constraint-flag ,ps-cmd)))
- ("^.+\\.dvi$" ,dvi-cmd
+ ;; (:constraintp ,ps-cmd)
+ ))
+ (".\\.dvi\\'" ,dvi-cmd
((:ignore-on-open-all t)
(:ignore-on-read-text t)
- (:constraint-flag ,dvi-cmd)))
- ("^.+\\.doc$" ,doc-cmd
+ ;; (:constraintp ,dvi-cmd)
+ ))
+ (".\\.doc\\'" ,doc-cmd
((:capture-output t)
(:ignore-on-read-text t)
- (:constraint-flag ,doc-cmd)))
- ("^.+\\.\\(tiff\\|xpm\\|gif\\|pgn\\)$" ,pic-cmd
+ ;; (:constraintp ,doc-cmd)
+ ))
+ (".\\.\\(tiff\\|xpm\\|gif\\|pgn\\)\\'" ,pic-cmd
((:ignore-on-open-all t)
(:ignore-on-read-text t)
- (:constraint-flag ,pic-cmd)))))
+ ;; (:constraintp ,pic-cmd)
+ ))))
"Association list of file patterns and external viewers for use with
`filesets-find-or-display-file'.
@@ -664,10 +624,8 @@ i.e. on open-all-files-events or when running commands
:constraintp FUNCTION ... use this viewer only if FUNCTION returns non-nil
-:constraint-flag SEXP ... use this viewer only if SEXP evaluates to non-nil
-
-:open-hook HOOK ... run hooks after spawning the viewer -- mainly useful
-in conjunction with :capture-output
+:open-hook FUNCTIONs ... run FUNCTIONs after spawning the viewer -- mainly
+useful in conjunction with :capture-output
:args (FORMAT-STRING or SYMBOL or FUNCTION) ... a list of arguments
\(defaults to (list \"%S\")) when using shell commands
@@ -692,7 +650,7 @@ In order to view pdf or rtf files in an Emacs buffer, you could use these:
(:constraintp (lambda ()
(and (filesets-which-command-p \"rtf2htm\")
(filesets-which-command-p \"w3m\"))))))"
- :set (function filesets-set-default)
+ :set #'filesets-set-default
:type '(repeat :tag "Viewer"
(list :tag "Definition"
:value ("^.+\\.suffix$" "")
@@ -707,7 +665,7 @@ In order to view pdf or rtf files in an Emacs buffer, you could use these:
(const :format ""
:value :constraintp)
(function :tag "Function"))
- (list :tag ":constraint-flag"
+ (list :tag ":constraint-flag (obsolete)"
:value (:constraint-flag)
(const :format ""
:value :constraint-flag)
@@ -748,8 +706,7 @@ In order to view pdf or rtf files in an Emacs buffer, you could use these:
:value (:capture-output t)
(const :format ""
:value :capture-output)
- (boolean :tag "Boolean"))))))
- :group 'filesets)
+ (boolean :tag "Boolean")))))))
(put 'filesets-external-viewers 'risky-local-variable t)
(defcustom filesets-ingroup-patterns
@@ -890,7 +847,7 @@ With duplicates removed, it would be:
M + A - X
B"
- :set (function filesets-set-default)
+ :set #'filesets-set-default
:type '(repeat
:tag "Include"
(list
@@ -936,8 +893,7 @@ With duplicates removed, it would be:
(list :tag ":preprocess"
:value (:preprocess)
(const :format "" :value :preprocess)
- (function :tag "Function")))))))
- :group 'filesets)
+ (function :tag "Function"))))))))
(put 'filesets-ingroup-patterns 'risky-local-variable t)
(defcustom filesets-data nil
@@ -1008,8 +964,7 @@ is used.
Before using :ingroup, make sure that the file type is already
defined in `filesets-ingroup-patterns'."
- :group 'filesets
- :set (function filesets-data-set-default)
+ :set #'filesets-data-set-default
:type '(repeat
(cons :tag "Fileset"
(string :tag "Name" :value "")
@@ -1071,22 +1026,9 @@ defined in `filesets-ingroup-patterns'."
(defcustom filesets-query-user-limit 15
"Query the user before opening a fileset with that many files."
- :set (function filesets-set-default)
- :type 'integer
- :group 'filesets)
+ :set #'filesets-set-default
+ :type 'integer)
-;;; Emacs compatibility
-(eval-and-compile
- (if (featurep 'xemacs)
- (fset 'filesets-error 'error)
-
- (require 'easymenu)
-
- (defun filesets-error (_class &rest args)
- "`error' wrapper."
- (error "%s" (mapconcat 'identity args " ")))
-
- ))
(defun filesets-filter-dir-names (lst &optional negative)
"Remove non-directory names from a list of strings.
@@ -1138,16 +1080,16 @@ Return full path if FULL-FLAG is non-nil."
(string-match-p pattern this))
(filesets-message 5 "Filesets: matched dir %S with pattern %S"
this pattern)
- (setq dirs (cons this dirs))))
+ (push this dirs)))
(t
(when (or (not pattern)
(string-match-p pattern this))
(filesets-message 5 "Filesets: matched file %S with pattern %S"
this pattern)
- (setq files (cons (if full-flag
- (concat (file-name-as-directory dir) this)
- this)
- files))))))
+ (push (if full-flag
+ (concat (file-name-as-directory dir) this)
+ this)
+ files)))))
(cond
((equal what ':dirs)
(filesets-conditional-sort dirs))
@@ -1160,7 +1102,7 @@ Return full path if FULL-FLAG is non-nil."
(filesets-message 1 "Filesets: %S doesn't exist" dir)
nil)
(t
- (filesets-error 'error "Filesets: " dir " does not exist"))))
+ (error "Filesets: %s does not exist" dir))))
(defun filesets-quote (txt)
"Return TXT in quotes."
@@ -1172,7 +1114,7 @@ Return full path if FULL-FLAG is non-nil."
(p (point)))
(if m
(buffer-substring (min m p) (max m p))
- (filesets-error 'error "No selection."))))
+ (error "No selection"))))
(defun filesets-get-quoted-selection ()
"Return the currently selected text in quotes."
@@ -1204,7 +1146,7 @@ Return full path if FULL-FLAG is non-nil."
(defun filesets-convert-path-list (string)
"Return a path-list given as STRING as list."
(if string
- (mapcar (lambda (x) (file-name-as-directory x))
+ (mapcar #'file-name-as-directory
(split-string string path-separator))
nil))
@@ -1214,17 +1156,17 @@ Return full path if FULL-FLAG is non-nil."
filename)))
(if (file-exists-p f)
f
- (filesets-some
+ (cl-some
(lambda (dir)
(let ((dir (file-name-as-directory dir))
(files (if (file-exists-p dir)
(filesets-directory-files dir nil ':files)
nil)))
- (filesets-some (lambda (file)
- (if (equal filename (file-name-nondirectory file))
- (concat dir file)
- nil))
- files)))
+ (cl-some (lambda (file)
+ (if (equal filename (file-name-nondirectory file))
+ (concat dir file)
+ nil))
+ files)))
path-list))))
@@ -1234,12 +1176,14 @@ Return full path if FULL-FLAG is non-nil."
(defun filesets-eviewer-constraint-p (entry)
(let* ((props (filesets-eviewer-get-props entry))
- (constraint (assoc ':constraintp props))
- (constraint-flag (assoc ':constraint-flag props)))
+ (constraint (assoc :constraintp props))
+ (constraint-flag (assoc :constraint-flag props)))
(cond
(constraint
(funcall (cadr constraint)))
(constraint-flag
+ (message "Obsolete :constraint-flag %S, use :constraintp instead"
+ (cadr constraint-flag))
(eval (cadr constraint-flag)))
(t
t))))
@@ -1247,7 +1191,7 @@ Return full path if FULL-FLAG is non-nil."
(defun filesets-get-external-viewer (file)
"Find an external viewer for FILE."
(let ((filename (file-name-nondirectory file)))
- (filesets-some
+ (cl-some
(lambda (entry)
(when (and (string-match-p (nth 0 entry) filename)
(filesets-eviewer-constraint-p entry))
@@ -1257,7 +1201,7 @@ Return full path if FULL-FLAG is non-nil."
(defun filesets-get-external-viewer-by-name (name)
"Get the external viewer definition called NAME."
(when name
- (filesets-some
+ (cl-some
(lambda (entry)
(when (and (string-equal (nth 1 entry) name)
(filesets-eviewer-constraint-p entry))
@@ -1319,17 +1263,13 @@ Use the viewer defined in EV-ENTRY (a valid element of
(oh (filesets-filetype-get-prop ':open-hook file entry))
(args (let ((fmt (filesets-filetype-get-prop ':args file entry)))
(if fmt
- (let ((rv ""))
- (dolist (this fmt rv)
- (setq rv (concat rv
- (cond
- ((stringp this)
- (format this file))
- ((and (symbolp this)
- (fboundp this))
- (format "%S" (funcall this)))
- (t
- (format "%S" this)))))))
+ (mapconcat
+ (lambda (this)
+ (if (stringp this) (format this file)
+ (format "%S" (if (functionp this)
+ (funcall this)
+ this))))
+ fmt "")
(format "%S" file))))
(output
(cond
@@ -1347,18 +1287,18 @@ Use the viewer defined in EV-ENTRY (a valid element of
(progn
(switch-to-buffer (format "Filesets: %s %s" vwr file))
(insert output)
- (make-local-variable 'filesets-output-buffer-flag)
- (setq filesets-output-buffer-flag t)
+ (setq-local filesets-output-buffer-flag t)
(set-visited-file-name file t)
- (when oh
- (run-hooks 'oh))
+ (if (functionp oh)
+ (funcall oh)
+ (mapc #'funcall oh))
(set-buffer-modified-p nil)
(setq buffer-read-only t)
(goto-char (point-min)))
- (when oh
- (run-hooks 'oh))))
- (filesets-error 'error
- "Filesets: general error when spawning external viewer"))))
+ (if (functionp oh)
+ (funcall oh)
+ (mapc #'funcall oh))))
+ (error "Filesets: general error when spawning external viewer"))))
(defun filesets-find-file (file)
"Call `find-file' after a possible delay (see `filesets-find-file-delay').
@@ -1368,7 +1308,8 @@ not be opened."
(when (or (file-readable-p file)
(not filesets-be-docile-flag))
(sit-for filesets-find-file-delay)
- (find-file file)))
+ (with-suppressed-warnings ((interactive-only find-file))
+ (find-file file))))
(defun filesets-find-or-display-file (&optional file viewer)
"Visit FILE using an external VIEWER or open it in an Emacs buffer."
@@ -1407,7 +1348,8 @@ not be opened."
(if (functionp filesets-browse-dir-function)
(funcall filesets-browse-dir-function dir)
(let ((name (car filesets-browse-dir-function))
- (args (format (cadr filesets-browse-dir-function) (expand-file-name dir))))
+ (args (format (cadr filesets-browse-dir-function)
+ (expand-file-name dir))))
(with-temp-buffer
(start-process (concat "Filesets:" name)
"*Filesets external directory browser*"
@@ -1458,7 +1400,7 @@ Return DEFAULT if not found. Return (car VALUE) if CARP is non-nil."
"Return fileset ENTRY's mode: :files, :file, :tree, :pattern, or :ingroup.
See `filesets-data'."
(let ((data (filesets-data-get-data entry)))
- (filesets-some
+ (cl-some
(lambda (x)
(if (assoc x data)
x))
@@ -1570,16 +1512,15 @@ SAVE-FUNCTION takes no argument, but works on the current buffer."
(assoc cmd-name filesets-commands))
(defun filesets-cmd-get-args (cmd-name)
- (let ((args (let ((def (filesets-cmd-get-def cmd-name)))
- (nth 2 def)))
- (rv nil))
- (dolist (this args rv)
- (cond
- ((and (symbolp this) (fboundp this))
- (let ((x (funcall this)))
- (setq rv (append rv (if (listp x) x (list x))))))
- (t
- (setq rv (append rv (list this))))))))
+ (mapcan (lambda (this)
+ (cond
+ ((and (symbolp this) (fboundp this))
+ (let ((x (funcall this)))
+ (if (listp x) x (list x))))
+ (t
+ (list this))))
+ (let ((def (filesets-cmd-get-def cmd-name)))
+ (nth 2 def))))
(defun filesets-cmd-get-fn (cmd-name)
(let ((def (filesets-cmd-get-def cmd-name)))
@@ -1641,28 +1582,24 @@ Replace <file-name> or <<file-name>> with filename."
(cond
((stringp fn)
(let* ((args
- (let ((txt ""))
- (dolist (this args txt)
- (setq txt
- (concat txt
- (if (equal txt "") "" " ")
- (filesets-run-cmd--repl-fn
+ (mapconcat
+ (lambda (this)
+ (filesets-run-cmd--repl-fn
this
(lambda (this)
- (format "%s" this))))))))
+ (format "%s" this))))
+ args
+ " "))
(cmd (concat fn " " args)))
(filesets-cmd-show-result
cmd (shell-command-to-string cmd))))
((symbolp fn)
- (let ((args
- (let ((argl nil))
- (dolist (this args argl)
- (setq argl
- (append argl
- (filesets-run-cmd--repl-fn
- this
- 'list)))))))
- (apply fn args)))))))))))))))))
+ (apply fn
+ (mapcan (lambda (this)
+ (filesets-run-cmd--repl-fn
+ this
+ 'list))
+ args)))))))))))))))))
(defun filesets-get-cmd-menu ()
"Create filesets command menu."
@@ -1730,9 +1667,12 @@ Assume MODE (see `filesets-entry-mode'), if provided."
(filesets-entry-get-master entry)))))
(cons entry (filesets-ingroup-cache-get entry))))
(:tree
- (let ((dir (nth 0 entry))
- (patt (nth 1 entry)))
- (filesets-directory-files dir patt ':files t)))
+ (let* ((dirpatt (filesets-entry-get-tree entry))
+ (dir (nth 0 dirpatt))
+ (patt (nth 1 dirpatt))
+ (depth (or (filesets-entry-get-tree-max-level entry)
+ filesets-tree-max-level)))
+ (filesets-files-under 0 depth entry dir patt)))
(:pattern
(let ((dirpatt (filesets-entry-get-pattern entry)))
(if dirpatt
@@ -1741,12 +1681,39 @@ Assume MODE (see `filesets-entry-mode'), if provided."
;;(filesets-message 3 "Filesets: scanning %s" dirpatt)
(filesets-directory-files dir patt ':files t))
;; (message "Filesets: malformed entry: %s" entry)))))))
- (filesets-error 'error "Filesets: malformed entry: "
- entry)))))))
+ (error "Filesets: malformed entry: %s" entry)))))))
(filesets-filter-list fl
(lambda (file)
(not (filesets-filetype-property file event))))))
+(defun filesets-files-under (level depth entry dir patt &optional relativep)
+ "Files under DIR that match PATT.
+LEVEL is the current level under DIR.
+DEPTH is the maximal tree scanning depth for ENTRY.
+ENTRY is a fileset.
+DIR is a directory.
+PATT is a regexp that included file names must match.
+RELATIVEP non-nil means use relative file names."
+ (and (or (= depth 0) (< level depth))
+ (let* ((dir (file-name-as-directory dir))
+ (files-here (filesets-directory-files
+ dir patt nil (not relativep)
+ (filesets-entry-get-filter-dirs-flag entry)))
+ (subdirs (filesets-filter-dir-names files-here))
+ (files
+ (filesets-filter-dir-names
+ (apply #'append
+ files-here
+ (mapcar
+ (lambda (subdir)
+ (let* ((subdir (file-name-as-directory subdir))
+ (full-subdir (concat dir subdir)))
+ (filesets-files-under (+ level 1) depth entry
+ full-subdir patt)))
+ subdirs))
+ t)))
+ files)))
+
(defun filesets-open (&optional mode name lookup-name)
"Open the fileset called NAME.
Use LOOKUP-NAME for searching additional data if provided."
@@ -1768,7 +1735,7 @@ Use LOOKUP-NAME for searching additional data if provided."
(dolist (this files nil)
(filesets-file-open open-function this))
(message "Filesets: canceled")))
- (filesets-error 'error "Filesets: Unknown fileset: " name))))
+ (error "Filesets: Unknown fileset: %s" name))))
(defun filesets-close (&optional mode name lookup-name)
"Close all buffers belonging to the fileset called NAME.
@@ -1789,7 +1756,7 @@ Use LOOKUP-NAME for deducing the save-function, if provided."
(if buffer
(filesets-file-close save-function buffer)))))
; (message "Filesets: Unknown fileset: `%s'" name))))
- (filesets-error 'error "Filesets: Unknown fileset: " name))))
+ (error "Filesets: Unknown fileset: %s" name))))
(defun filesets-add-buffer (&optional name buffer)
"Add BUFFER (or current buffer) to the fileset called NAME.
@@ -1815,8 +1782,8 @@ User will be queried, if no fileset name is provided."
(if entry
(let* ((files (filesets-entry-get-files entry))
(this (buffer-file-name buffer))
- (inlist (filesets-member this files
- :test 'filesets-files-equalp)))
+ (inlist (cl-member this files
+ :test #'filesets-files-equalp)))
(cond
(inlist
(message "Filesets: `%s' is already in `%s'" this name))
@@ -1841,8 +1808,8 @@ User will be queried, if no fileset name is provided."
(if entry
(let* ((files (filesets-entry-get-files entry))
(this (buffer-file-name buffer))
- (inlist (filesets-member this files
- :test 'filesets-files-equalp)))
+ (inlist (cl-member this files
+ :test #'filesets-files-equalp)))
;;(message "%s %s %s" files this inlist)
(if (and files this inlist)
(let ((new (list (cons ':files (delete (car inlist) files)))))
@@ -1891,7 +1858,7 @@ User will be queried, if no fileset name is provided."
(substring (elt submenu 0) 2))))
(if (listp submenu)
(cons name (cdr submenu))
- (apply 'vector (list name (cdr (append submenu nil)))))))
+ (apply #'vector (list name (cadr (append submenu nil)))))))
; (vconcat `[,name] (subseq submenu 1)))))
(defun filesets-wrap-submenu (submenu-body)
@@ -1909,12 +1876,14 @@ User will be queried, if no fileset name is provided."
((or (> count bl)
(null data)))
;; (let ((sl (subseq submenu-body count
- (let ((sl (filesets-sublist submenu-body count
- (let ((x (+ count factor)))
- (if (>= bl x)
- x
- nil)))))
+ (let ((sl (seq-subseq submenu-body count
+ (let ((x (+ count factor)))
+ (if (>= bl x)
+ x
+ nil)))))
(when sl
+ ;; FIXME: O(n²) performance bug because of repeated `append':
+ ;; use `mapcan'?
(setq result
(append
result
@@ -1931,6 +1900,8 @@ User will be queried, if no fileset name is provided."
(if (null (cdr x))
""
", "))))
+ ;; FIXME: O(n²) performance bug because of
+ ;; repeated `concat': use `mapconcat'?
(setq rv
(concat
rv
@@ -1997,7 +1968,7 @@ LOOKUP-NAME is used as lookup name for retrieving fileset specific settings."
`(["Rebuild this submenu"
(filesets-rebuild-this-submenu ',lookup-name)]))))
(_
- (filesets-error 'error "Filesets: malformed definition of " something))))
+ (error "Filesets: malformed definition of %s" something))))
(defun filesets-ingroup-get-data (master pos &optional fun)
"Access to `filesets-ingroup-patterns'. Extract data section."
@@ -2006,11 +1977,11 @@ LOOKUP-NAME is used as lookup name for retrieving fileset specific settings."
(and (stringp a)
(stringp b)
(string-match-p a b))))))
- (filesets-some (lambda (x)
- (if (funcall fn (car x) masterfile)
- (nth pos x)
- nil))
- filesets-ingroup-patterns)))
+ (cl-some (lambda (x)
+ (if (funcall fn (car x) masterfile)
+ (nth pos x)
+ nil))
+ filesets-ingroup-patterns)))
(defun filesets-ingroup-get-pattern (master)
"Access to `filesets-ingroup-patterns'. Extract patterns."
@@ -2022,12 +1993,8 @@ LOOKUP-NAME is used as lookup name for retrieving fileset specific settings."
(defun filesets-ingroup-collect-finder (patt case-sensitivep)
"Helper function for `filesets-ingroup-collect'. Find pattern PATT."
- (let ((cfs case-fold-search)
- (rv (progn
- (setq case-fold-search (not case-sensitivep))
- (re-search-forward patt nil t))))
- (setq case-fold-search cfs)
- rv))
+ (let ((case-fold-search (not case-sensitivep)))
+ (re-search-forward patt nil t)))
(defun filesets-ingroup-cache-get (master)
"Access to `filesets-ingroup-cache'."
@@ -2070,8 +2037,7 @@ LOOKUP-NAME is used as lookup name for retrieving fileset specific settings."
(lst nil))
(cond
((not this-patt)
- (filesets-error 'error "Filesets: malformed :ingroup definition "
- this-def))
+ (error "Filesets: malformed :ingroup definition %s" this-def))
((< this-sd 0)
nil)
(t
@@ -2086,9 +2052,9 @@ LOOKUP-NAME is used as lookup name for retrieving fileset specific settings."
(when (and f
(not (member f flist))
(or (not remdupl-flag)
- (not (filesets-member
+ (not (cl-member
f filesets-ingroup-files
- :test 'filesets-files-equalp))))
+ :test #'filesets-files-equalp))))
(let ((no-stub-flag
(and (not this-stub-flag)
(if this-stubp
@@ -2100,16 +2066,18 @@ LOOKUP-NAME is used as lookup name for retrieving fileset specific settings."
(cons f filesets-ingroup-files))
(when no-stub-flag
(filesets-ingroup-cache-put master f))
- (setq lst (append lst (list f))))))))
+ (push f lst))))))
(when lst
(setq rv
+ ;; FIXME: O(n²) performance bug because of repeated
+ ;; `nconc'.
(nconc rv
(mapcar (lambda (this)
`((,this ,this-name)
,@(filesets-ingroup-collect-files
fs remdupl-flag this
(- this-sd 1))))
- lst))))))))
+ (nreverse lst)))))))))
(filesets-message 2 "Filesets: no patterns defined for %S" master)))))
(defun filesets-ingroup-collect-build-menu (fs flist &optional other-count)
@@ -2119,42 +2087,41 @@ FS is a fileset's name. FLIST is a list returned by
(if (null flist)
nil
(let ((count 0)
- (fsn fs)
- (rv nil))
- (dolist (this flist rv)
- (setq count (+ count 1))
- (let* ((def (if (listp this) (car this) (list this "")))
- (files (if (listp this) (cdr this) nil))
- (master (nth 0 def))
- (name (nth 1 def))
- (nm (concat (filesets-get-shortcut (if (or (not other-count) files)
- count other-count))
- (if (or (null name) (equal name ""))
- ""
- (format "%s: " name))
- (file-name-nondirectory master))))
- (setq rv
- (append rv
- (if files
- `((,nm
- [,(concat "Inclusion Group: "
- (file-name-nondirectory master))
- (filesets-open ':ingroup ',master ',fsn)]
- "---"
- [,master (filesets-file-open nil ',master ',fsn)]
- "---"
- ,@(let ((count 0))
- (mapcar
- (lambda (this)
- (setq count (+ count 1))
- (let ((ff (filesets-ingroup-collect-build-menu
- fs (list this) count)))
- (if (= (length ff) 1)
- (car ff)
- ff)))
- files))
- ,@(filesets-get-menu-epilog master ':ingroup fsn)))
- `([,nm (filesets-file-open nil ',master ',fsn)])))))))))
+ (fsn fs))
+ (mapcan (lambda (this)
+ (setq count (+ count 1))
+ (let* ((def (if (listp this) (car this) (list this "")))
+ (files (if (listp this) (cdr this) nil))
+ (master (nth 0 def))
+ (name (nth 1 def))
+ (nm (concat (filesets-get-shortcut
+ (if (or (not other-count) files)
+ count other-count))
+ (if (or (null name) (equal name ""))
+ ""
+ (format "%s: " name))
+ (file-name-nondirectory master))))
+ (if files
+ `((,nm
+ [,(concat "Inclusion Group: "
+ (file-name-nondirectory master))
+ (filesets-open ':ingroup ',master ',fsn)]
+ "---"
+ [,master (filesets-file-open nil ',master ',fsn)]
+ "---"
+ ,@(let ((count 0))
+ (mapcar
+ (lambda (this)
+ (setq count (+ count 1))
+ (let ((ff (filesets-ingroup-collect-build-menu
+ fs (list this) count)))
+ (if (= (length ff) 1)
+ (car ff)
+ ff)))
+ files))
+ ,@(filesets-get-menu-epilog master ':ingroup fsn)))
+ `([,nm (filesets-file-open nil ',master ',fsn)]))))
+ flist))))
(defun filesets-ingroup-collect (fs remdupl-flag master)
"Collect names of included files and build submenu."
@@ -2174,7 +2141,7 @@ FS is a fileset's name. FLIST is a list returned by
(progn
(message "Filesets: can't parse %s" master)
nil)
- (filesets-error 'error "Filesets: can't parse " master))))
+ (error "Filesets: can't parse %s" master))))
(defun filesets-build-dir-submenu-now (level depth entry lookup-name dir patt fd
&optional rebuild-flag)
@@ -2259,7 +2226,7 @@ Construct a shortcut from COUNT."
(:pattern
(let* ((files (filesets-get-filelist entry mode 'on-ls))
(dirpatt (filesets-entry-get-pattern entry))
- (pattname (apply 'concat (cons "Pattern: " dirpatt)))
+ (pattname (apply #'concat (cons "Pattern: " dirpatt)))
(count 0))
;;(filesets-message 3 "Filesets: scanning %S" pattname)
`([,pattname
@@ -2349,21 +2316,20 @@ bottom up, set `filesets-submenus' to nil, first.)"
(filesets-menu-cache-file-save-maybe)))
(let ((cb (current-buffer)))
(when (not (member cb filesets-updated-buffers))
- (add-submenu
- filesets-menu-path
- `(,filesets-menu-name
- ("# Filesets"
- ["Edit Filesets" filesets-edit]
- ["Save Filesets" filesets-save-config]
- ["Save Menu Cache" filesets-menu-cache-file-save]
- ["Rebuild Menu" filesets-build-menu]
- ["Customize" filesets-customize]
- ["About" filesets-info])
- ,(filesets-get-cmd-menu)
- "---"
- ,@filesets-menu-cache)
- filesets-menu-before
- filesets-menu-in-menu)
+ (easy-menu-add-item (or filesets-menu-in-menu (current-global-map))
+ (cons "menu-bar" filesets-menu-path)
+ `(,filesets-menu-name
+ ("# Filesets"
+ ["Edit Filesets" filesets-edit]
+ ["Save Filesets" filesets-save-config]
+ ["Save Menu Cache" filesets-menu-cache-file-save]
+ ["Rebuild Menu" filesets-build-menu]
+ ["Customize" filesets-customize]
+ ["About" filesets-info])
+ ,(filesets-get-cmd-menu)
+ "---"
+ ,@filesets-menu-cache)
+ filesets-menu-before)
(setq filesets-updated-buffers
(cons cb filesets-updated-buffers))
;; This wipes out other messages in the echo area.
@@ -2403,14 +2369,14 @@ fileset thinks this is necessary or not."
(dolist (this filesets-menu-cache-contents)
(if (get this 'custom-type)
(progn
- (insert (format "(setq-default %s '%S)" this (eval this)))
+ (insert (format "(setq-default %s '%S)" this (eval this t)))
(when filesets-menu-ensure-use-cached
(newline)
(insert (format "(setq %s (cons '%s %s))"
'filesets-ignore-next-set-default
this
'filesets-ignore-next-set-default))))
- (insert (format "(setq %s '%S)" this (eval this))))
+ (insert (format "(setq %s '%S)" this (eval this t))))
(newline 2))
(insert (format "(setq filesets-cache-version %S)" filesets-version))
(newline 2)
@@ -2474,7 +2440,7 @@ We apologize for the inconvenience.")))
(insert msg)
(when (y-or-n-p (format "Edit startup (%s) file now? " cf))
(find-file-other-window cf))
- (filesets-error 'error msg))))
+ (error msg))))
(defun filesets-update (cached-version)
"Do some cleanup after updating filesets.el."
@@ -2510,11 +2476,10 @@ We apologize for the inconvenience.")))
(defun filesets-init ()
"Filesets initialization.
Set up hooks, load the cache file -- if existing -- and build the menu."
- (add-hook (if (featurep 'xemacs) 'activate-menubar-hook 'menu-bar-update-hook)
- (function filesets-build-menu-maybe))
- (add-hook 'kill-buffer-hook (function filesets-remove-from-ubl))
- (add-hook 'first-change-hook (function filesets-reset-filename-on-change))
- (add-hook 'kill-emacs-hook (function filesets-exit))
+ (add-hook 'menu-bar-update-hook #'filesets-build-menu-maybe)
+ (add-hook 'kill-buffer-hook #'filesets-remove-from-ubl)
+ (add-hook 'first-change-hook #'filesets-reset-filename-on-change)
+ (add-hook 'kill-emacs-hook #'filesets-exit)
(if (filesets-menu-cache-file-load)
(progn
(filesets-build-menu-maybe)
@@ -2525,6 +2490,10 @@ Set up hooks, load the cache file -- if existing -- and build the menu."
(setq filesets-menu-use-cached-flag t)))
(filesets-build-menu)))
+(defun filesets-error (_class &rest args)
+ "`error' wrapper."
+ (declare (obsolete error "28.1"))
+ (error "%s" (mapconcat #'identity args " ")))
(provide 'filesets)
diff --git a/lisp/find-cmd.el b/lisp/find-cmd.el
index 13b41165d06..5866b308551 100644
--- a/lisp/find-cmd.el
+++ b/lisp/find-cmd.el
@@ -1,6 +1,6 @@
;;; find-cmd.el --- Build a valid find(1) command with sexps
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Philip Jackson <phil@shellarchive.co.uk>
;; Version: 0.6
diff --git a/lisp/find-dired.el b/lisp/find-dired.el
index 18330d821ce..adc5672eca9 100644
--- a/lisp/find-dired.el
+++ b/lisp/find-dired.el
@@ -1,6 +1,6 @@
;;; find-dired.el --- run a `find' command and dired the output -*- lexical-binding: t -*-
-;; Copyright (C) 1992, 1994-1995, 2000-2020 Free Software Foundation,
+;; Copyright (C) 1992, 1994-1995, 2000-2021 Free Software Foundation,
;; Inc.
;; Author: Roland McGrath <roland@gnu.org>,
@@ -223,11 +223,10 @@ it finishes, type \\[kill-find]."
(set-keymap-parent map (current-local-map))
(define-key map "\C-c\C-k" 'kill-find)
(use-local-map map))
- (make-local-variable 'dired-sort-inhibit)
- (setq dired-sort-inhibit t)
- (set (make-local-variable 'revert-buffer-function)
- `(lambda (ignore-auto noconfirm)
- (find-dired ,dir ,find-args)))
+ (setq-local dired-sort-inhibit t)
+ (setq-local revert-buffer-function
+ `(lambda (ignore-auto noconfirm)
+ (find-dired ,dir ,find-args)))
;; Set subdir-alist so that Tree Dired will work:
(if (fboundp 'dired-simple-subdir-alist)
;; will work even with nested dired format (dired-nstd.el,v 1.15
@@ -235,9 +234,9 @@ it finishes, type \\[kill-find]."
(dired-simple-subdir-alist)
;; else we have an ancient tree dired (or classic dired, where
;; this does no harm)
- (set (make-local-variable 'dired-subdir-alist)
- (list (cons default-directory (point-min-marker)))))
- (set (make-local-variable 'dired-subdir-switches) find-ls-subdir-switches)
+ (setq-local dired-subdir-alist
+ (list (cons default-directory (point-min-marker)))))
+ (setq-local dired-subdir-switches find-ls-subdir-switches)
(setq buffer-read-only nil)
;; Subdir headlerline must come first because the first marker in
;; subdir-alist points there.
diff --git a/lisp/find-file.el b/lisp/find-file.el
index 84d02cb4a26..8cc9c972ed4 100644
--- a/lisp/find-file.el
+++ b/lisp/find-file.el
@@ -4,7 +4,7 @@
;; Maintainer: emacs-devel@gnu.org
;; Keywords: c, matching, tools
-;; Copyright (C) 1994-1995, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1995, 2001-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/lisp/find-lisp.el b/lisp/find-lisp.el
index 352720412a5..2f432936033 100644
--- a/lisp/find-lisp.el
+++ b/lisp/find-lisp.el
@@ -4,7 +4,7 @@
;; Created: Fri Mar 26 1999
;; Keywords: unix
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -212,24 +212,17 @@ It is a function which takes two arguments, the directory and its parent."
(use-local-map (append (make-sparse-keymap) (current-local-map)))
- (make-local-variable 'find-lisp-file-predicate)
- (setq find-lisp-file-predicate file-predicate)
- (make-local-variable 'find-lisp-directory-predicate)
- (setq find-lisp-directory-predicate directory-predicate)
- (make-local-variable 'find-lisp-regexp)
- (setq find-lisp-regexp regexp)
-
- (make-local-variable 'revert-buffer-function)
- (setq revert-buffer-function
- (function
- (lambda (_ignore1 _ignore2)
- (find-lisp-insert-directory
- default-directory
- find-lisp-file-predicate
- find-lisp-directory-predicate
- 'ignore)
- )
- ))
+ (setq-local find-lisp-file-predicate file-predicate)
+ (setq-local find-lisp-directory-predicate directory-predicate)
+ (setq-local find-lisp-regexp regexp)
+
+ (setq-local revert-buffer-function
+ (lambda (_ignore1 _ignore2)
+ (find-lisp-insert-directory
+ default-directory
+ find-lisp-file-predicate
+ find-lisp-directory-predicate
+ 'ignore)))
;; Set subdir-alist so that Tree Dired will work:
(if (fboundp 'dired-simple-subdir-alist)
@@ -238,8 +231,8 @@ It is a function which takes two arguments, the directory and its parent."
(dired-simple-subdir-alist)
;; else we have an ancient tree dired (or classic dired, where
;; this does no harm)
- (set (make-local-variable 'dired-subdir-alist)
- (list (cons default-directory (point-min-marker)))))
+ (setq-local dired-subdir-alist
+ (list (cons default-directory (point-min-marker)))))
(find-lisp-insert-directory
dir file-predicate directory-predicate 'ignore)
(goto-char (point-min))
@@ -267,11 +260,10 @@ It is a function which takes two arguments, the directory and its parent."
(insert find-lisp-line-indent "\n")
;; Run the find function
(mapc
- (function
- (lambda (file)
- (find-lisp-find-dired-insert-file
- (substring file len)
- (current-buffer))))
+ (lambda (file)
+ (find-lisp-find-dired-insert-file
+ (substring file len)
+ (current-buffer)))
(sort files 'string-lessp))
;; FIXME: Sort function is ignored for now
;; (funcall sort-function files))
diff --git a/lisp/finder.el b/lisp/finder.el
index 820d6d0a3b9..15c3fcbac79 100644
--- a/lisp/finder.el
+++ b/lisp/finder.el
@@ -1,6 +1,6 @@
;;; finder.el --- topic & keyword-based code finder
-;; Copyright (C) 1992, 1997-1999, 2001-2020 Free Software Foundation,
+;; Copyright (C) 1992, 1997-1999, 2001-2021 Free Software Foundation,
;; Inc.
;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
@@ -178,6 +178,9 @@ directory name and PACKAGE is the name of a package (a symbol).
When generating `package--builtins', Emacs assumes any file in
DIR is part of the package PACKAGE.")
+(defconst finder-buffer "*Finder*"
+ "Name of the Finder buffer.")
+
(defun finder-compile-keywords (&rest dirs)
"Regenerate list of built-in Emacs packages.
This recomputes `package--builtins' and `finder-keywords-hash',
@@ -338,9 +341,9 @@ not `finder-known-keywords'."
(defun finder-list-keywords ()
"Display descriptions of the keywords in the Finder buffer."
(interactive)
- (if (get-buffer "*Finder*")
- (pop-to-buffer "*Finder*")
- (pop-to-buffer (get-buffer-create "*Finder*"))
+ (if (get-buffer finder-buffer)
+ (pop-to-buffer finder-buffer)
+ (pop-to-buffer (get-buffer-create finder-buffer))
(finder-mode)
(let ((inhibit-read-only t))
(erase-buffer)
@@ -445,7 +448,7 @@ FILE should be in a form suitable for passing to `locate-library'."
:syntax-table finder-mode-syntax-table
(setq buffer-read-only t
buffer-undo-list t)
- (set (make-local-variable 'finder-headmark) nil))
+ (setq-local finder-headmark nil))
(defun finder-summary ()
"Summarize basic Finder commands."
@@ -460,10 +463,9 @@ finder directory, \\[finder-exit] = quit, \\[finder-summary] = help")))
"Exit Finder mode.
Quit the window and kill all Finder-related buffers."
(interactive)
- (let ((buf "*Finder*"))
- (if (equal (current-buffer) buf)
- (quit-window t)
- (and (get-buffer buf) (kill-buffer buf)))))
+ (quit-window t)
+ (dolist (buf (list finder-buffer "*Finder-package*"))
+ (and (get-buffer buf) (kill-buffer buf))))
(defun finder-unload-function ()
"Unload the Finder library."
diff --git a/lisp/flow-ctrl.el b/lisp/flow-ctrl.el
index b679af80b80..656edf2eb09 100644
--- a/lisp/flow-ctrl.el
+++ b/lisp/flow-ctrl.el
@@ -1,6 +1,6 @@
;;; flow-ctrl.el --- help for lusers on cu(1) or ttys with wired-in ^S/^Q flow control
-;; Copyright (C) 1990-1991, 1994, 2001-2020 Free Software Foundation,
+;; Copyright (C) 1990-1991, 1994, 2001-2021 Free Software Foundation,
;; Inc.
;; Author: Kevin Gallagher
diff --git a/lisp/foldout.el b/lisp/foldout.el
index 0d7a7a88a6f..4c479d68e9a 100644
--- a/lisp/foldout.el
+++ b/lisp/foldout.el
@@ -1,6 +1,6 @@
;;; foldout.el --- folding extensions for outline-mode and outline-minor-mode
-;; Copyright (C) 1994, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 2001-2021 Free Software Foundation, Inc.
;; Author: Kevin Broadey <KevinB@bartley.demon.co.uk>
;; Maintainer: emacs-devel@gnu.org
@@ -487,7 +487,7 @@ What happens depends on the number of mouse clicks:-
Signal an error if the final event isn't the same type as the first one."
(let ((initial-event-type (event-basic-type event)))
(while (null (sit-for (/ double-click-time 1000.0) 'nodisplay))
- (setq event (read-event)))
+ (setq event (read--potential-mouse-event)))
(or (eq initial-event-type (event-basic-type event))
(error "")))
event)
@@ -527,19 +527,18 @@ Valid modifiers are shift, control, meta, alt, hyper and super.")
(define-key map "\C-z" 'foldout-zoom-subtree)
(define-key map "\C-x" 'foldout-exit-fold))
(let* ((modifiers (apply 'concat
- (mapcar (function
- (lambda (modifier)
- (vector
- (cond
- ((eq modifier 'shift) ?S)
- ((eq modifier 'control) ?C)
- ((eq modifier 'meta) ?M)
- ((eq modifier 'alt) ?A)
- ((eq modifier 'hyper) ?H)
- ((eq modifier 'super) ?s)
- (t (error "invalid mouse modifier %s"
- modifier)))
- ?-)))
+ (mapcar (lambda (modifier)
+ (vector
+ (cond
+ ((eq modifier 'shift) ?S)
+ ((eq modifier 'control) ?C)
+ ((eq modifier 'meta) ?M)
+ ((eq modifier 'alt) ?A)
+ ((eq modifier 'hyper) ?H)
+ ((eq modifier 'super) ?s)
+ (t (error "invalid mouse modifier %s"
+ modifier)))
+ ?-))
foldout-mouse-modifiers)))
(mouse-1 (vector (intern (concat modifiers "down-mouse-1"))))
(mouse-2 (vector (intern (concat modifiers "down-mouse-2"))))
diff --git a/lisp/follow.el b/lisp/follow.el
index f1d823d9f03..292dc4a0225 100644
--- a/lisp/follow.el
+++ b/lisp/follow.el
@@ -1,6 +1,6 @@
;;; follow.el --- synchronize windows showing the same buffer
-;; Copyright (C) 1995-1997, 1999, 2001-2020 Free Software Foundation,
+;; Copyright (C) 1995-1997, 1999, 2001-2021 Free Software Foundation,
;; Inc.
;; Author: Anders Lindgren
diff --git a/lisp/font-core.el b/lisp/font-core.el
index 098253eb162..0f1a3d1c364 100644
--- a/lisp/font-core.el
+++ b/lisp/font-core.el
@@ -1,6 +1,6 @@
-;;; font-core.el --- Core interface to font-lock
+;;; font-core.el --- Core interface to font-lock -*- lexical-binding: t; -*-
-;; Copyright (C) 1992-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1992-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: languages, faces
@@ -160,8 +160,8 @@ this function onto `change-major-mode-hook'."
(defun font-lock-default-function (mode)
;; Turn on Font Lock mode.
(when mode
- (set (make-local-variable 'char-property-alias-alist)
- (copy-tree char-property-alias-alist))
+ (setq-local char-property-alias-alist
+ (copy-tree char-property-alias-alist))
;; Add `font-lock-face' as an alias for the `face' property.
(let ((elt (assq 'face char-property-alias-alist)))
(if elt
@@ -171,8 +171,8 @@ this function onto `change-major-mode-hook'."
;; Turn off Font Lock mode.
(unless mode
;; Remove `font-lock-face' as an alias for the `face' property.
- (set (make-local-variable 'char-property-alias-alist)
- (copy-tree char-property-alias-alist))
+ (setq-local char-property-alias-alist
+ (copy-tree char-property-alias-alist))
(let ((elt (assq 'face char-property-alias-alist)))
(when elt
(setcdr elt (remq 'font-lock-face (cdr elt)))
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index e708e69bd59..a51434c38c9 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -1,6 +1,6 @@
;;; font-lock.el --- Electric font lock mode -*- lexical-binding:t -*-
-;; Copyright (C) 1992-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1992-2021 Free Software Foundation, Inc.
;; Author: Jamie Zawinski
;; Richard Stallman
@@ -152,8 +152,8 @@
;;
;; (add-hook 'foo-mode-hook
;; (lambda ()
-;; (set (make-local-variable 'font-lock-defaults)
-;; '(foo-font-lock-keywords t))))
+;; (setq-local font-lock-defaults
+;; '(foo-font-lock-keywords t))))
;;;; Adding Font Lock support for modes:
@@ -173,8 +173,8 @@
;;
;; and within `bar-mode' there could be:
;;
-;; (set (make-local-variable 'font-lock-defaults)
-;; '(bar-font-lock-keywords nil t))
+;; (setq-local font-lock-defaults
+;; '(bar-font-lock-keywords nil t))
;; What is fontification for? You might say, "It's to make my code look nice."
;; I think it should be for adding information in the form of cues. These cues
@@ -733,7 +733,7 @@ see the variables `c-font-lock-extra-types', `c++-font-lock-extra-types',
;; font-lock-mode it only enabled the font-core.el part, not the
;; font-lock-mode-internal. Try again.
(font-lock-mode -1)
- (set (make-local-variable 'font-lock-defaults) '(nil t))
+ (setq-local font-lock-defaults '(nil t))
(font-lock-mode 1))
;; Otherwise set or add the keywords now.
;; This is a no-op if it has been done already in this buffer
@@ -933,18 +933,15 @@ The value of this variable is used when Font Lock mode is turned on."
;; Prepare for jit-lock
(remove-hook 'after-change-functions
#'font-lock-after-change-function t)
- (set (make-local-variable 'font-lock-flush-function)
- #'jit-lock-refontify)
- (set (make-local-variable 'font-lock-ensure-function)
- #'jit-lock-fontify-now)
+ (setq-local font-lock-flush-function #'jit-lock-refontify)
+ (setq-local font-lock-ensure-function #'jit-lock-fontify-now)
;; Prevent font-lock-fontify-buffer from fontifying eagerly the whole
;; buffer. This is important for things like CWarn mode which
;; adds/removes a few keywords and does a refontify (which takes ages on
;; large files).
- (set (make-local-variable 'font-lock-fontify-buffer-function)
- #'jit-lock-refontify)
+ (setq-local font-lock-fontify-buffer-function #'jit-lock-refontify)
;; Don't fontify eagerly (and don't abort if the buffer is large).
- (set (make-local-variable 'font-lock-fontified) t)
+ (setq-local font-lock-fontified t)
;; Use jit-lock.
(jit-lock-register #'font-lock-fontify-region
(not font-lock-keywords-only))
@@ -1558,7 +1555,7 @@ START should be at the beginning of a line."
(unless parse-sexp-lookup-properties
;; We wouldn't go through so much trouble if we didn't intend to use those
;; properties, would we?
- (set (make-local-variable 'parse-sexp-lookup-properties) t))
+ (setq-local parse-sexp-lookup-properties t))
;; If `font-lock-syntactic-keywords' is a symbol, get the real keywords.
(when (symbolp font-lock-syntactic-keywords)
(setq font-lock-syntactic-keywords (font-lock-eval-keywords
@@ -1942,8 +1939,8 @@ Sets various variables using `font-lock-defaults' and
(set (make-local-variable (car x)) (cdr x)))
;; Set up `font-lock-keywords' last because its value might depend
;; on other settings.
- (set (make-local-variable 'font-lock-keywords)
- (font-lock-eval-keywords keywords))
+ (setq-local font-lock-keywords
+ (font-lock-eval-keywords keywords))
;; Local fontification?
(while local
(font-lock-add-keywords nil (car (car local)) (cdr (car local)))
@@ -2283,8 +2280,8 @@ This function could be MATCHER in a MATCH-ANCHORED `font-lock-keywords' item."
;; "ifndef" "import" "include" "line" "pragma" "undef" "warning")))
;;
(defconst cpp-font-lock-keywords-source-depth 0
- "An integer representing regular expression depth of `cpp-font-lock-keywords-source-directives'.
-Used in `cpp-font-lock-keywords'.")
+ "Regular expression depth of `cpp-font-lock-keywords-source-directives'.
+This should be an integer. Used in `cpp-font-lock-keywords'.")
(defconst cpp-font-lock-keywords
(let* ((directives cpp-font-lock-keywords-source-directives)
diff --git a/lisp/format-spec.el b/lisp/format-spec.el
index 6af79a44167..202d65d8fca 100644
--- a/lisp/format-spec.el
+++ b/lisp/format-spec.el
@@ -1,6 +1,6 @@
;;; format-spec.el --- format arbitrary formatting strings -*- lexical-binding: t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: tools
@@ -25,7 +25,7 @@
;;; Code:
;;;###autoload
-(defun format-spec (format specification &optional ignore-missing)
+(defun format-spec (format specification &optional ignore-missing split)
"Return a string based on FORMAT and SPECIFICATION.
FORMAT is a string containing `format'-like specs like \"su - %u %k\".
SPECIFICATION is an alist mapping format specification characters
@@ -68,50 +68,65 @@ error; if it is the symbol `ignore', leave those %-specs verbatim
in the result, including their text properties, if any; if it is
the symbol `delete', remove those %-specs from the result;
otherwise do the same as for the symbol `ignore', but also leave
-any occurrences of \"%%\" in FORMAT verbatim in the result."
+any occurrences of \"%%\" in FORMAT verbatim in the result.
+
+If SPLIT, instead of returning a single string, a list of strings
+is returned, where each format spec is its own element."
(with-temp-buffer
- (insert format)
- (goto-char (point-min))
- (while (search-forward "%" nil t)
- (cond
- ;; Quoted percent sign.
- ((= (following-char) ?%)
- (when (memq ignore-missing '(nil ignore delete))
- (delete-char 1)))
- ;; Valid format spec.
- ((looking-at (rx (? (group (+ (in " 0<>^_-"))))
- (? (group (+ digit)))
- (? (group ?. (+ digit)))
- (group alpha)))
- (let* ((beg (point))
- (end (match-end 0))
- (flags (match-string 1))
- (width (match-string 2))
- (trunc (match-string 3))
- (char (string-to-char (match-string 4)))
- (text (assq char specification)))
- (cond (text
- ;; Handle flags.
- (setq text (format-spec--do-flags
- (format "%s" (cdr text))
- (format-spec--parse-flags flags)
- (and width (string-to-number width))
- (and trunc (car (read-from-string trunc 1)))))
- ;; Insert first, to preserve text properties.
- (insert-and-inherit text)
- ;; Delete the specifier body.
- (delete-region (point) (+ end (length text)))
- ;; Delete the percent sign.
- (delete-region (1- beg) beg))
- ((eq ignore-missing 'delete)
- ;; Delete the whole format spec.
- (delete-region (1- beg) end))
- ((not ignore-missing)
- (error "Invalid format character: `%%%c'" char)))))
- ;; Signal an error on bogus format strings.
- ((not ignore-missing)
- (error "Invalid format string"))))
- (buffer-string)))
+ (let ((split-start (point-min))
+ (split-result nil))
+ (insert format)
+ (goto-char (point-min))
+ (while (search-forward "%" nil t)
+ (cond
+ ;; Quoted percent sign.
+ ((= (following-char) ?%)
+ (when (memq ignore-missing '(nil ignore delete))
+ (delete-char 1)))
+ ;; Valid format spec.
+ ((looking-at (rx (? (group (+ (in " 0<>^_-"))))
+ (? (group (+ digit)))
+ (? (group ?. (+ digit)))
+ (group alpha)))
+ (let* ((beg (point))
+ (end (match-end 0))
+ (flags (match-string 1))
+ (width (match-string 2))
+ (trunc (match-string 3))
+ (char (string-to-char (match-string 4)))
+ (text (assq char specification)))
+ (when (and split
+ (not (= (1- beg) split-start)))
+ (push (buffer-substring split-start (1- beg)) split-result))
+ (cond (text
+ ;; Handle flags.
+ (setq text (format-spec--do-flags
+ (format "%s" (cdr text))
+ (format-spec--parse-flags flags)
+ (and width (string-to-number width))
+ (and trunc (car (read-from-string trunc 1)))))
+ ;; Insert first, to preserve text properties.
+ (insert-and-inherit text)
+ ;; Delete the specifier body.
+ (delete-region (point) (+ end (length text)))
+ ;; Delete the percent sign.
+ (delete-region (1- beg) beg))
+ ((eq ignore-missing 'delete)
+ ;; Delete the whole format spec.
+ (delete-region (1- beg) end))
+ ((not ignore-missing)
+ (error "Invalid format character: `%%%c'" char)))
+ (when split
+ (push (buffer-substring (1- beg) (point)) split-result)
+ (setq split-start (point)))))
+ ;; Signal an error on bogus format strings.
+ ((not ignore-missing)
+ (error "Invalid format string"))))
+ (if (not split)
+ (buffer-string)
+ (unless (= split-start (point-max))
+ (push (buffer-substring split-start (point-max)) split-result))
+ (nreverse split-result)))))
(defun format-spec--do-flags (str flags width trunc)
"Return STR formatted according to FLAGS, WIDTH, and TRUNC.
diff --git a/lisp/format.el b/lisp/format.el
index 905ca2d9ec9..4209fc6401a 100644
--- a/lisp/format.el
+++ b/lisp/format.el
@@ -1,6 +1,6 @@
-;;; format.el --- read and save files in multiple formats
+;;; format.el --- read and save files in multiple formats -*- lexical-binding: t; -*-
-;; Copyright (C) 1994-1995, 1997, 1999, 2001-2020 Free Software
+;; Copyright (C) 1994-1995, 1997, 1999, 2001-2021 Free Software
;; Foundation, Inc.
;; Author: Boris Goldowsky <boris@gnu.org>
@@ -237,9 +237,8 @@ For most purposes, consider using `format-encode-region' instead."
;; delete the buffer once the write is done, but do
;; it after running to-fn so it doesn't affect
;; write-region calls in to-fn.
- (set (make-local-variable
- 'write-region-post-annotation-function)
- 'kill-buffer)))
+ (setq-local write-region-post-annotation-function
+ #'kill-buffer)))
nil)
;; Otherwise just call function, it will return annotations.
(funcall to-fn from to orig-buf)))))
@@ -420,7 +419,8 @@ If FORMAT is nil then do not do any format conversion."
(file-name-nondirectory file)))))
(list file fmt)))
(let ((format-alist nil))
- (find-file filename))
+ (with-suppressed-warnings ((interactive-only find-file))
+ (find-file filename)))
(if format
(format-decode-buffer format)))
diff --git a/lisp/forms.el b/lisp/forms.el
index 8974f99ef57..5d7e6dde96c 100644
--- a/lisp/forms.el
+++ b/lisp/forms.el
@@ -1,6 +1,6 @@
;;; forms.el --- Forms mode: edit a file as a form to fill in
-;; Copyright (C) 1991, 1994-1997, 2001-2020 Free Software Foundation,
+;; Copyright (C) 1991, 1994-1997, 2001-2021 Free Software Foundation,
;; Inc.
;; Author: Johan Vromans <jvromans@squirrel.nl>
@@ -436,6 +436,14 @@ Also, initial position is at last record."
(defvar read-file-filter) ; bound in forms--intuit-from-file
+;; The code used to use `run-hooks' but in a way that's actually
+;; incompatible with hooks (and with lexical scoping), so this function
+;; approximates the actual behavior that `run-hooks' provided.
+(defun forms--run-functions (functions)
+ (if (functionp functions)
+ (funcall functions)
+ (mapc #'funcall functions)))
+
;;;###autoload
(defun forms-mode (&optional primary)
;; FIXME: use define-derived-mode
@@ -547,8 +555,6 @@ Commands: Equivalent keys in read-only mode:
"`forms-multi-line' is equal to `forms-field-sep'")))
(error (concat "Forms control file error: "
"`forms-multi-line' must be nil or a one-character string"))))
- (or (fboundp 'set-text-properties)
- (setq forms-use-text-properties nil))
;; Validate and process forms-format-list.
;;(message "forms: pre-processing format list...")
@@ -568,12 +574,12 @@ Commands: Equivalent keys in read-only mode:
;; Check if record filters are defined.
(if (and forms-new-record-filter
- (not (fboundp forms-new-record-filter)))
+ (not (functionp forms-new-record-filter)))
(error (concat "Forms control file error: "
"`forms-new-record-filter' is not a function")))
(if (and forms-modified-record-filter
- (not (fboundp forms-modified-record-filter)))
+ (not (functionp forms-modified-record-filter)))
(error (concat "Forms control file error: "
"`forms-modified-record-filter' is not a function")))
@@ -647,7 +653,7 @@ Commands: Equivalent keys in read-only mode:
(with-current-buffer forms--file-buffer
(let ((inhibit-read-only t)
(file-modified (buffer-modified-p)))
- (mapc #'funcall read-file-filter)
+ (forms--run-functions read-file-filter)
(if (not file-modified) (set-buffer-modified-p nil)))
(if write-file-filter
(add-hook 'write-file-functions write-file-filter nil t)))
@@ -875,8 +881,7 @@ Commands: Equivalent keys in read-only mode:
(list 'face forms--rw-face 'front-sticky '(face))))
;; Enable `post-command-hook' to restore the properties.
- (setq post-command-hook
- (append (list 'forms--iif-post-command-hook) post-command-hook)))
+ (add-hook 'post-command-hook #'forms--iif-post-command-hook))
;; No action needed. Clear marker.
(setq forms--iif-start nil)))
@@ -885,8 +890,7 @@ Commands: Equivalent keys in read-only mode:
"`post-command-hook' function for read-only segments."
;; Disable `post-command-hook'.
- (setq post-command-hook
- (delq 'forms--iif-hook-post-command-hook post-command-hook))
+ (remove-hook 'post-command-hook #'forms--iif-post-command-hook)
;; Restore properties.
(if forms--iif-start
@@ -916,7 +920,7 @@ Commands: Equivalent keys in read-only mode:
(if forms-use-text-properties
`(lambda (arg)
(let ((inhibit-read-only t))
- ,@(apply 'append
+ ,@(apply #'append
(mapcar #'forms--make-format-elt-using-text-properties
forms-format-list))
;; Prevent insertion before the first text.
@@ -929,7 +933,7 @@ Commands: Equivalent keys in read-only mode:
'(rear-nonsticky nil)))
(setq forms--iif-start nil))
`(lambda (arg)
- ,@(apply 'append
+ ,@(apply #'append
(mapcar #'forms--make-format-elt forms-format-list)))))
;; We have tallied the number of markers and dynamic texts,
@@ -1100,7 +1104,7 @@ Commands: Equivalent keys in read-only mode:
`(lambda nil
(let (here)
(goto-char (point-min))
- ,@(apply 'append
+ ,@(apply #'append
(mapcar
#'forms--make-parser-elt
(append forms-format-list (list nil)))))))))
@@ -1219,7 +1223,7 @@ Commands: Equivalent keys in read-only mode:
(setq the-record
(with-current-buffer forms--file-buffer
(let ((inhibit-read-only t))
- (run-hooks 'read-file-filter))
+ (forms--run-functions read-file-filter))
(goto-char (point-min))
(forms--get-record)))
@@ -1427,7 +1431,7 @@ Commands: Equivalent keys in read-only mode:
;;
;; We have our own revert function - use it.
(make-local-variable 'revert-buffer-function)
- (setq revert-buffer-function 'forms--revert-buffer)
+ (setq revert-buffer-function #'forms--revert-buffer)
t)
@@ -1900,7 +1904,7 @@ after writing out the data."
;; Write file hooks are run via write-file-functions.
;; (if write-file-filter
;; (save-excursion
- ;; (run-hooks 'write-file-filter)))
+ ;; (forms--run-functions write-file-filter)))
;; If they have a write-file-filter, force the buffer to be
;; saved even if it doesn't seem to be changed. First, they
@@ -1912,7 +1916,7 @@ after writing out the data."
(save-buffer args)
(if read-file-filter
(save-excursion
- (run-hooks 'read-file-filter)))
+ (forms--run-functions read-file-filter)))
(set-buffer-modified-p nil)))
;; Make sure we end up with the same record number as we started.
;; Since read-file-filter may perform arbitrary transformations on
@@ -2037,20 +2041,19 @@ Usage: (setq forms-number-of-fields
(defun forms--debug (&rest args)
"Internal debugging routine."
(if forms--debug
- (let ((ret nil))
- (while args
- (let ((el (car-safe args)))
- (setq args (cdr-safe args))
- (if (stringp el)
- (setq ret (concat ret el))
- (setq ret (concat ret (prin1-to-string el) " = "))
- (if (boundp el)
- (let ((vel (eval el)))
- (setq ret (concat ret (prin1-to-string vel) "\n")))
- (setq ret (concat ret "<unbound>" "\n")))
- (if (fboundp el)
- (setq ret (concat ret (prin1-to-string (symbol-function el))
- "\n"))))))
+ (let ((ret
+ (mapconcat
+ (lambda (el)
+ (if (stringp el) el
+ (concat (prin1-to-string el) " = "
+ (if (boundp el)
+ (prin1-to-string (eval el))
+ "<unbound>")
+ "\n"
+ (if (fboundp el)
+ (concat (prin1-to-string (symbol-function el))
+ "\n")))))
+ args "")))
(with-current-buffer (get-buffer-create "*forms-mode debug*")
(if (zerop (buffer-size))
(emacs-lisp-mode))
diff --git a/lisp/frame.el b/lisp/frame.el
index 772ba3d8c47..06aab269ddd 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -1,6 +1,6 @@
;;; frame.el --- multi-frame management independent of window systems -*- lexical-binding:t -*-
-;; Copyright (C) 1993-1994, 1996-1997, 2000-2020 Free Software
+;; Copyright (C) 1993-1994, 1996-1997, 2000-2021 Free Software
;; Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
@@ -2552,13 +2552,15 @@ Use 0 or negative value to blink forever."
This starts the timer `blink-cursor-timer', which makes the cursor blink
if appropriate. It also arranges to cancel that timer when the next
command starts, by installing a pre-command hook."
- (when (null blink-cursor-timer)
+ (cond
+ ((null blink-cursor-mode) (blink-cursor-mode -1))
+ ((null blink-cursor-timer)
;; Set up the timer first, so that if this signals an error,
;; blink-cursor-end is not added to pre-command-hook.
(setq blink-cursor-blinks-done 1)
(blink-cursor--start-timer)
- (add-hook 'pre-command-hook 'blink-cursor-end)
- (internal-show-cursor nil nil)))
+ (add-hook 'pre-command-hook #'blink-cursor-end)
+ (internal-show-cursor nil nil))))
(defun blink-cursor-timer-function ()
"Timer function of timer `blink-cursor-timer'."
@@ -2572,14 +2574,14 @@ command starts, by installing a pre-command hook."
(when (and (> blink-cursor-blinks 0)
(<= (* 2 blink-cursor-blinks) blink-cursor-blinks-done))
(blink-cursor-suspend)
- (add-hook 'post-command-hook 'blink-cursor-check)))
+ (add-hook 'post-command-hook #'blink-cursor-check)))
(defun blink-cursor-end ()
"Stop cursor blinking.
This is installed as a pre-command hook by `blink-cursor-start'.
When run, it cancels the timer `blink-cursor-timer' and removes
itself as a pre-command hook."
- (remove-hook 'pre-command-hook 'blink-cursor-end)
+ (remove-hook 'pre-command-hook #'blink-cursor-end)
(internal-show-cursor nil t)
(when blink-cursor-timer
(cancel-timer blink-cursor-timer)
@@ -2615,7 +2617,7 @@ stopped by `blink-cursor-suspend'. Internally calls
`blink-cursor--should-blink' and returns its result."
(let ((should-blink (blink-cursor--should-blink)))
(when (and should-blink (not blink-cursor-idle-timer))
- (remove-hook 'post-command-hook 'blink-cursor-check)
+ (remove-hook 'post-command-hook #'blink-cursor-check)
(blink-cursor--start-idle-timer))
should-blink))
@@ -2637,18 +2639,18 @@ This command is effective only on graphical frames. On text-only
terminals, cursor blinking is controlled by the terminal."
:init-value (not (or noninteractive
no-blinking-cursor
- (eq system-type 'ms-dos)
- (not (display-blink-cursor-p))))
- :initialize 'custom-initialize-delay
+ (eq system-type 'ms-dos)))
+ :initialize #'custom-initialize-delay
:group 'cursor
:global t
(blink-cursor-suspend)
(remove-hook 'after-delete-frame-functions #'blink-cursor--rescan-frames)
(remove-function after-focus-change-function #'blink-cursor--rescan-frames)
(when blink-cursor-mode
- (add-function :after after-focus-change-function #'blink-cursor--rescan-frames)
+ (add-function :after after-focus-change-function
+ #'blink-cursor--rescan-frames)
(add-hook 'after-delete-frame-functions #'blink-cursor--rescan-frames)
- (blink-cursor--start-idle-timer)))
+ (blink-cursor-check)))
;; Frame maximization/fullscreen
diff --git a/lisp/frameset.el b/lisp/frameset.el
index 0462d776c0e..e698d5401db 100644
--- a/lisp/frameset.el
+++ b/lisp/frameset.el
@@ -1,6 +1,6 @@
;;; frameset.el --- save and restore frame and window setup -*- lexical-binding: t -*-
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; Author: Juanma Barranquero <lekktu@gmail.com>
;; Keywords: convenience
diff --git a/lisp/fringe.el b/lisp/fringe.el
index 422d014397d..e2d7968adde 100644
--- a/lisp/fringe.el
+++ b/lisp/fringe.el
@@ -1,6 +1,6 @@
;;; fringe.el --- fringe setup and control -*- lexical-binding:t -*-
-;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/generic-x.el b/lisp/generic-x.el
index 48ac1232051..f3ea22a4a30 100644
--- a/lisp/generic-x.el
+++ b/lisp/generic-x.el
@@ -1,6 +1,6 @@
;;; generic-x.el --- A collection of generic modes
-;; Copyright (C) 1997-1998, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2001-2021 Free Software Foundation, Inc.
;; Author: Peter Breton <pbreton@cs.umb.edu>
;; Created: Tue Oct 08 1996
@@ -107,8 +107,6 @@
;;; Code:
-(eval-when-compile (require 'font-lock))
-
(defgroup generic-x nil
"A collection of generic modes."
:prefix "generic-"
@@ -280,12 +278,11 @@ your changes into effect."
("^\\s-*\\(\\sw+\\)\\s-" 1 font-lock-variable-name-face))
'("srm\\.conf\\'" "httpd\\.conf\\'" "access\\.conf\\'")
(list
- (function
- (lambda ()
- (setq imenu-generic-expression
- '((nil "^\\([-A-Za-z0-9_]+\\)" 1)
- ("*Directories*" "^\\s-*<Directory\\s-*\\([^>]+\\)>" 1)
- ("*Locations*" "^\\s-*<Location\\s-*\\([^>]+\\)>" 1))))))
+ (lambda ()
+ (setq imenu-generic-expression
+ '((nil "^\\([-A-Za-z0-9_]+\\)" 1)
+ ("*Directories*" "^\\s-*<Directory\\s-*\\([^>]+\\)>" 1)
+ ("*Locations*" "^\\s-*<Location\\s-*\\([^>]+\\)>" 1)))))
"Generic mode for Apache or HTTPD configuration files."))
(when (memq 'apache-log-generic-mode generic-extras-enable-list)
@@ -401,11 +398,10 @@ your changes into effect."
(2 font-lock-variable-name-face)))
'("\\.[iI][nN][iI]\\'")
(list
- (function
- (lambda ()
- (setq imenu-generic-expression
- '((nil "^\\[\\(.*\\)\\]" 1)
- ("*Variables*" "^\\s-*\\([^=]+\\)\\s-*=" 1))))))
+ (lambda ()
+ (setq imenu-generic-expression
+ '((nil "^\\[\\(.*\\)\\]" 1)
+ ("*Variables*" "^\\s-*\\([^=]+\\)\\s-*=" 1)))))
"Generic mode for MS-Windows INI files.
You can use `ini-generic-mode-find-file-hook' to enter this mode
automatically for INI files whose names do not end in \".ini\".")
@@ -432,10 +428,9 @@ like an INI file. You can add this hook to `find-file-hook'."
("^\\([^\n\r]*\\)\\s-*=" 1 font-lock-variable-name-face))
'("\\.[rR][eE][gG]\\'")
(list
- (function
- (lambda ()
- (setq imenu-generic-expression
- '((nil "^\\s-*\\(.*\\)\\s-*=" 1))))))
+ (lambda ()
+ (setq imenu-generic-expression
+ '((nil "^\\s-*\\(.*\\)\\s-*=" 1)))))
"Generic mode for MS-Windows Registry files."))
(declare-function w32-shell-name "w32-fns" ())
@@ -456,10 +451,9 @@ like an INI file. You can add this hook to `find-file-hook'."
("\\s-/\\([^/]+\\)/[i, \t\n]" 1 font-lock-constant-face))
'("\\.rules\\'")
(list
- (function
- (lambda ()
- (setq imenu-generic-expression
- '((nil "\\s-/\\([^/]+\\)/[i, \t\n]" 1))))))
+ (lambda ()
+ (setq imenu-generic-expression
+ '((nil "\\s-/\\([^/]+\\)/[i, \t\n]" 1)))))
"Generic mode for Mailagent rules files."))
;; Solaris/Sys V prototype files
@@ -548,13 +542,12 @@ like an INI file. You can add this hook to `find-file-hook'."
(2 font-lock-variable-name-face)))
'("\\.wrl\\'")
(list
- (function
- (lambda ()
- (setq imenu-generic-expression
- '((nil "^\\([A-Za-z0-9_]+\\)\\s-*{" 1)
- ("*Definitions*"
- "DEF\\s-+\\([-A-Za-z0-9_]+\\)\\s-+\\([A-Za-z0-9]+\\)\\s-*{"
- 1))))))
+ (lambda ()
+ (setq imenu-generic-expression
+ '((nil "^\\([A-Za-z0-9_]+\\)\\s-*{" 1)
+ ("*Definitions*"
+ "DEF\\s-+\\([-A-Za-z0-9_]+\\)\\s-+\\([A-Za-z0-9]+\\)\\s-*{"
+ 1)))))
"Generic Mode for VRML files."))
;; Java Manifests
@@ -594,20 +587,18 @@ like an INI file. You can add this hook to `find-file-hook'."
;; * an equal sign
;; * a colon
(mapcar
- (function
- (lambda (elt)
- (list
- (concat "^" java-properties-key elt java-properties-value "$")
- '(1 font-lock-constant-face)
- '(4 font-lock-variable-name-face))))
+ (lambda (elt)
+ (list
+ (concat "^" java-properties-key elt java-properties-value "$")
+ '(1 font-lock-constant-face)
+ '(4 font-lock-variable-name-face)))
;; These are the separators
'(":\\s-*" "\\s-+" "\\s-*=\\s-*"))))
nil
(list
- (function
- (lambda ()
- (setq imenu-generic-expression
- '((nil "^\\([^#! \t\n\r=:]+\\)" 1))))))
+ (lambda ()
+ (setq imenu-generic-expression
+ '((nil "^\\([^#! \t\n\r=:]+\\)" 1)))))
"Generic mode for Java properties files."))
;; C shell alias definitions
@@ -622,10 +613,9 @@ like an INI file. You can add this hook to `find-file-hook'."
(1 font-lock-variable-name-face)))
'("alias\\'")
(list
- (function
- (lambda ()
- (setq imenu-generic-expression
- '((nil "^\\(alias\\|unalias\\)\\s-+\\([-a-zA-Z0-9_]+\\)" 2))))))
+ (lambda ()
+ (setq imenu-generic-expression
+ '((nil "^\\(alias\\|unalias\\)\\s-+\\([-a-zA-Z0-9_]+\\)" 2)))))
"Generic mode for C Shell alias files."))
;; Ansible inventory files
@@ -645,11 +635,10 @@ like an INI file. You can add this hook to `find-file-hook'."
(2 font-lock-keyword-face)))
'("inventory\\'")
(list
- (function
- (lambda ()
- (setq imenu-generic-expression
- '((nil "^\\s-*\\[\\(.*\\)\\]" 1)
- ("*Variables*" "\\s-+\\([^ =\n\r]+\\)=" 1))))))
+ (lambda ()
+ (setq imenu-generic-expression
+ '((nil "^\\s-*\\[\\(.*\\)\\]" 1)
+ ("*Variables*" "\\s-+\\([^ =\n\r]+\\)=" 1)))))
"Generic mode for Ansible inventory files."))
;;; Windows RC files
@@ -1432,10 +1421,9 @@ like an INI file. You can add this hook to `find-file-hook'."
'(("^\\([-A-Za-z0-9_]+\\)" 1 font-lock-type-face))
'("/etc/inetd\\.conf\\'")
(list
- (function
- (lambda ()
- (setq imenu-generic-expression
- '((nil "^\\([-A-Za-z0-9_]+\\)" 1))))))))
+ (lambda ()
+ (setq imenu-generic-expression
+ '((nil "^\\([-A-Za-z0-9_]+\\)" 1)))))))
;; Services
(when (memq 'etc-services-generic-mode generic-extras-enable-list)
@@ -1450,10 +1438,9 @@ like an INI file. You can add this hook to `find-file-hook'."
(2 font-lock-variable-name-face)))
'("/etc/services\\'")
(list
- (function
- (lambda ()
- (setq imenu-generic-expression
- '((nil "^\\([-A-Za-z0-9_]+\\)" 1))))))))
+ (lambda ()
+ (setq imenu-generic-expression
+ '((nil "^\\([-A-Za-z0-9_]+\\)" 1)))))))
;; Password and Group files
(when (memq 'etc-passwd-generic-mode generic-extras-enable-list)
@@ -1493,10 +1480,9 @@ like an INI file. You can add this hook to `find-file-hook'."
;; /etc/passwd- is a backup file for /etc/passwd, so is group- and shadow-
'("/etc/passwd-?\\'" "/etc/group-?\\'" "/etc/shadow-?\\'")
(list
- (function
- (lambda ()
- (setq imenu-generic-expression
- '((nil "^\\([-A-Za-z0-9_]+\\):" 1))))))))
+ (lambda ()
+ (setq imenu-generic-expression
+ '((nil "^\\([-A-Za-z0-9_]+\\):" 1)))))))
;; Fstab
(when (memq 'etc-fstab-generic-mode generic-extras-enable-list)
@@ -1547,10 +1533,9 @@ like an INI file. You can add this hook to `find-file-hook'."
(2 font-lock-variable-name-face t)))
'("/etc/[v]*fstab\\'")
(list
- (function
- (lambda ()
- (setq imenu-generic-expression
- '((nil "^\\([^# \t]+\\)\\s-+" 1))))))))
+ (lambda ()
+ (setq imenu-generic-expression
+ '((nil "^\\([^# \t]+\\)\\s-+" 1)))))))
;; /etc/sudoers
(when (memq 'etc-sudoers-generic-mode generic-extras-enable-list)
@@ -1710,9 +1695,8 @@ like an INI file. You can add this hook to `find-file-hook'."
(list
'generic-bracket-support
;; Make keywords case-insensitive
- (function
- (lambda()
- (setq font-lock-defaults '(generic-font-lock-keywords nil t)))))
+ (lambda ()
+ (setq font-lock-defaults '(generic-font-lock-keywords nil t))))
"Generic mode for SPICE circuit netlist files."))
(when (memq 'ibis-generic-mode generic-extras-enable-list)
@@ -1758,9 +1742,8 @@ like an INI file. You can add this hook to `find-file-hook'."
(list
'generic-bracket-support
;; Make keywords case-insensitive
- (function
- (lambda()
- (setq font-lock-defaults '(generic-font-lock-keywords nil t)))))
+ (lambda ()
+ (setq font-lock-defaults '(generic-font-lock-keywords nil t))))
"Generic mode for ASTAP circuit netlist files."))
(when (memq 'etc-modules-conf-generic-mode generic-extras-enable-list)
diff --git a/lisp/gnus/ChangeLog.1 b/lisp/gnus/ChangeLog.1
index e3265303437..6ad87f06f27 100644
--- a/lisp/gnus/ChangeLog.1
+++ b/lisp/gnus/ChangeLog.1
@@ -3702,7 +3702,7 @@
* gnus.el: Quassia Gnus v0.1 is released.
- Copyright (C) 1997-2020 Free Software Foundation, Inc.
+ Copyright (C) 1997-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/gnus/ChangeLog.2 b/lisp/gnus/ChangeLog.2
index 533ceb84bf1..35402dffd07 100644
--- a/lisp/gnus/ChangeLog.2
+++ b/lisp/gnus/ChangeLog.2
@@ -18538,7 +18538,7 @@
See ChangeLog.1 for earlier changes.
- Copyright (C) 2000-2002, 2004-2020 Free Software Foundation, Inc.
+ Copyright (C) 2000-2002, 2004-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/gnus/ChangeLog.3 b/lisp/gnus/ChangeLog.3
index 582c9bd10b7..2aba3a5706f 100644
--- a/lisp/gnus/ChangeLog.3
+++ b/lisp/gnus/ChangeLog.3
@@ -26325,7 +26325,7 @@
See ChangeLog.2 for earlier changes.
- Copyright (C) 2004-2020 Free Software Foundation, Inc.
+ Copyright (C) 2004-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/gnus/canlock.el b/lisp/gnus/canlock.el
index ed0a89cf927..6c8c1a5927a 100644
--- a/lisp/gnus/canlock.el
+++ b/lisp/gnus/canlock.el
@@ -1,6 +1,6 @@
;;; canlock.el --- functions for Cancel-Lock feature
-;; Copyright (C) 1998-1999, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-1999, 2001-2021 Free Software Foundation, Inc.
;; Author: Katsumi Yamaoka <yamaoka@jpl.org>
;; Keywords: news, cancel-lock, hmac, sha1, rfc2104
diff --git a/lisp/gnus/deuglify.el b/lisp/gnus/deuglify.el
index 647f643c962..b77dcdd4624 100644
--- a/lisp/gnus/deuglify.el
+++ b/lisp/gnus/deuglify.el
@@ -1,6 +1,6 @@
;;; deuglify.el --- deuglify broken Outlook (Express) articles
-;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Author: Raymond Scholz <rscholz@zonix.de>
;; Thomas Steffen
@@ -250,21 +250,25 @@
:group 'gnus-outlook-deuglify)
(defcustom gnus-outlook-deuglify-unwrap-stop-chars nil ;; ".?!" or nil
- "Characters that inhibit unwrapping if they are the last one on the cited line above the possible wrapped line."
+ "Characters that, when at end of cited line, inhibit unwrapping.
+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)
(defcustom gnus-outlook-deuglify-no-wrap-chars "`"
- "Characters that inhibit unwrapping if they are the first one in the possibly wrapped line."
+ "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)
(defcustom gnus-outlook-deuglify-attrib-cut-regexp
"\\(On \\|Am \\)?\\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\),[^,]+, "
- "Regular expression matching the beginning of an attribution line that should be cut off."
+ "Regexp matching beginning of attribution line that should be cut off."
:version "22.1"
:type 'regexp
:group 'gnus-outlook-deuglify)
@@ -338,7 +342,7 @@ NODISPLAY is non-nil, don't redisplay the article buffer."
(unless nodisplay (gnus-outlook-display-article-buffer)))
(defun gnus-outlook-rearrange-article (attr-start)
- "Put the text from ATTR-START to the end of buffer at the top of 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))
diff --git a/lisp/gnus/gmm-utils.el b/lisp/gnus/gmm-utils.el
index 6d24b409ed0..ab97c593d9c 100644
--- a/lisp/gnus/gmm-utils.el
+++ b/lisp/gnus/gmm-utils.el
@@ -1,6 +1,6 @@
;;; gmm-utils.el --- Utility functions for Gnus, Message and MML
-;; Copyright (C) 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2021 Free Software Foundation, Inc.
;; Author: Reiner Steib <reiner.steib@gmx.de>
;; Keywords: news
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index 6a7e81b3e91..686623029ed 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -1,6 +1,6 @@
;;; gnus-agent.el --- unplugged support for Gnus
-;; Copyright (C) 1997-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
@@ -454,7 +454,7 @@ manipulated as follows:
(symbol-name major-mode))
(match-string 1 (symbol-name major-mode))))
(mode (intern (format "gnus-agent-%s-mode" buffer))))
- (set (make-local-variable 'gnus-agent-mode) t)
+ (setq-local gnus-agent-mode t)
(set mode nil)
(set (make-local-variable mode) t)
;; Set up the menu.
@@ -1056,8 +1056,8 @@ article's mark is toggled."
(defun gnus-agent-get-undownloaded-list ()
"Construct list of articles that have not been downloaded."
(let ((gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name)))
- (when (set (make-local-variable 'gnus-newsgroup-agentized)
- (gnus-agent-method-p gnus-command-method))
+ (when (setq-local gnus-newsgroup-agentized
+ (gnus-agent-method-p gnus-command-method))
(let* ((alist (gnus-agent-load-alist gnus-newsgroup-name))
(headers (sort (mapcar (lambda (h)
(mail-header-number h))
@@ -1440,7 +1440,7 @@ downloaded into the agent."
(let ((file (gnus-agent-lib-file "history")))
(when (file-exists-p file)
(nnheader-insert-file-contents file))
- (set (make-local-variable 'gnus-agent-file-name) file))))
+ (setq-local gnus-agent-file-name file))))
(defun gnus-agent-close-history ()
(when (gnus-buffer-live-p gnus-agent-current-history)
@@ -1789,6 +1789,7 @@ 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
@@ -1810,10 +1811,9 @@ 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))
+ (file-name-coding-system nnmail-pathname-coding-system)
+ headers fetched-headers)
(unless fetch-all
;; Add articles with marks to the list of article headers we want to
@@ -1824,7 +1824,7 @@ article numbers will be returned."
(dolist (arts (gnus-info-marks (gnus-get-info group)))
(unless (memq (car arts) '(seen recent killed cache))
(setq articles (gnus-range-add articles (cdr arts)))))
- (setq articles (sort (gnus-uncompress-sequence articles) '<)))
+ (setq articles (sort (gnus-uncompress-range 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,41 +1867,56 @@ article numbers will be returned."
10 "gnus-agent-fetch-headers: undownloaded articles are `%s'"
(gnus-compress-sequence articles t)))
- (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))
+ ;; 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))
(defsubst gnus-agent-read-article-number ()
- "Reads the article number at point. Returns nil when a valid article number can not be read."
+ "Read the article number at point.
+Return nil when a valid article number can not be read."
(when (looking-at "[0-9]+\t")
(read (current-buffer))))
@@ -1923,96 +1938,6 @@ article numbers will be returned."
(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)
@@ -2385,10 +2310,9 @@ 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)
@@ -2409,38 +2333,35 @@ 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))
- ))))
+ marked-articles))))))
(setq marked-articles (sort marked-articles '<))
- ;; Fetch any new articles from the server
- (setq articles (gnus-agent-fetch-headers group))
+ (setq gnus-newsgroup-dependencies
+ (or gnus-newsgroup-dependencies
+ (gnus-make-hashtable)))
- ;; Merge new articles with marked
- (setq articles (sort (append marked-articles articles) '<))
+ ;; Fetch headers for any new articles from the server.
+ (setq fetched-headers (gnus-agent-fetch-headers group))
- (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))))
+ (when fetched-headers
(setq gnus-newsgroup-headers
- (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.
+ (or gnus-newsgroup-headers
+ fetched-headers)))
+ (when marked-articles
+ ;; `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)))
+ (gnus-get-predicate
+ (gnus-agent-find-parameter group 'agent-predicate)))
+
+ ;; If the selection predicate requires scoring, score each header.
- ;; 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)
@@ -3567,22 +3488,21 @@ articles in every agentized group? "))
(let* (delete-recursive
files f
(delete-recursive
- (function
- (lambda (f-or-d)
- (ignore-errors
- (if (file-directory-p f-or-d)
- (condition-case nil
- (delete-directory f-or-d)
- (file-error
- (setq files (directory-files f-or-d))
- (while files
- (setq f (pop files))
- (or (member f '("." ".."))
- (funcall delete-recursive
- (nnheader-concat
- f-or-d f))))
- (delete-directory f-or-d)))
- (delete-file f-or-d)))))))
+ (lambda (f-or-d)
+ (ignore-errors
+ (if (file-directory-p f-or-d)
+ (condition-case nil
+ (delete-directory f-or-d)
+ (file-error
+ (setq files (directory-files f-or-d))
+ (while files
+ (setq f (pop files))
+ (or (member f '("." ".."))
+ (funcall delete-recursive
+ (nnheader-concat
+ f-or-d f))))
+ (delete-directory f-or-d)))
+ (delete-file f-or-d))))))
(funcall delete-recursive dir)))))))))
;;;###autoload
@@ -3661,11 +3581,9 @@ has been fetched."
(defun gnus-agent-retrieve-headers (articles group &optional fetch-old)
(save-excursion
(gnus-agent-create-buffer)
- (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))
+ (let ((file (gnus-agent-article-name ".overview" group))
+ (file-name-coding-system nnmail-pathname-coding-system)
+ uncached-articles headers fetched-headers)
(gnus-make-directory (nnheader-translate-file-chars
(file-name-directory file) t))
@@ -3676,122 +3594,63 @@ has been fetched."
1)
(car (last articles))))))
- ;; Populate temp buffer with known headers
+ ;; 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.
(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)))))
-
- (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)
+ (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.
(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)
-
- ;; 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))
+ (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)))
(defun gnus-agent-request-article (article group)
"Retrieve ARTICLE in GROUP from the agent cache."
@@ -4033,11 +3892,11 @@ If REREAD is not nil, downloaded articles are marked as unread."
(list (list
(if (listp reread)
reread
- (delq nil (mapcar (function (lambda (c)
- (cond ((eq reread t)
- (car c))
- ((cdr c)
- (car c)))))
+ (delq nil (mapcar (lambda (c)
+ (cond ((eq reread t)
+ (car c))
+ ((cdr c)
+ (car c))))
gnus-agent-article-alist)))
'del '(read)))
gnus-command-method)
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 1efc1d6f7d9..4ade36f4b9c 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -1,6 +1,6 @@
;;; gnus-art.el --- article mode commands for Gnus
-;; Copyright (C) 1996-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -289,7 +289,9 @@ asynchronously. The compressed face will be piped to this command."
(defcustom gnus-article-banner-alist nil
"Banner alist for stripping.
For example,
- ((egroups . \"^[ \\t\\n]*-------------------+\\\\( \\\\(e\\\\|Yahoo! \\\\)Groups Sponsor -+\\\\)?....\\n\\\\(.+\\n\\\\)+\"))"
+ ((egroups . (concat \"^[ \\t\\n]*-------------------+\\\\\"
+ \"( \\\\(e\\\\|Yahoo! \\\\)Groups Sponsor -+\\\\)?\"
+ \"....\\n\\\\(.+\\n\\\\)+\")))"
:version "21.1"
:type '(repeat (cons symbol regexp))
:group 'gnus-article-washing)
@@ -1059,7 +1061,7 @@ used."
("view the part" . gnus-mime-view-part)
("pipe to command" . gnus-mime-pipe-part)
("toggle display" . gnus-article-press-button)
- ("toggle display" . gnus-article-view-part-as-charset)
+ ("view as charset" . gnus-mime-view-part-as-charset)
("view as type" . gnus-mime-view-part-as-type)
("view internally" . gnus-mime-view-part-internally)
("view externally" . gnus-mime-view-part-externally))
@@ -3850,8 +3852,7 @@ This format is defined by the `gnus-article-time-format' variable."
(unless gnus-article-emphasis-alist
(let ((name (and gnus-newsgroup-name
(gnus-group-real-name gnus-newsgroup-name))))
- (make-local-variable 'gnus-article-emphasis-alist)
- (setq gnus-article-emphasis-alist
+ (setq-local gnus-article-emphasis-alist
(nconc
(let ((alist gnus-group-highlight-words-alist) elem highlight)
(while (setq elem (pop alist))
@@ -4495,10 +4496,10 @@ commands:
(when (gnus-visual-p 'article-menu 'menu)
(gnus-article-make-menu-bar)
(when gnus-summary-tool-bar-map
- (set (make-local-variable 'tool-bar-map) gnus-summary-tool-bar-map)))
+ (setq-local tool-bar-map gnus-summary-tool-bar-map)))
(gnus-update-format-specifications nil 'article-mode)
- (set (make-local-variable 'page-delimiter) gnus-page-delimiter)
- (set (make-local-variable 'gnus-page-broken) nil)
+ (setq-local page-delimiter gnus-page-delimiter)
+ (setq-local gnus-page-broken nil)
(make-local-variable 'gnus-article-current-summary)
(make-local-variable 'gnus-article-mime-handles)
(make-local-variable 'gnus-article-decoded-p)
@@ -4507,13 +4508,12 @@ commands:
(make-local-variable 'gnus-article-image-alist)
(make-local-variable 'gnus-article-charset)
(make-local-variable 'gnus-article-ignored-charsets)
- (set (make-local-variable 'bookmark-make-record-function)
- 'gnus-summary-bookmark-make-record)
+ (setq-local bookmark-make-record-function 'gnus-summary-bookmark-make-record)
;; Prevent Emacs from displaying non-break space with
;; `nobreak-space' face.
- (set (make-local-variable 'nobreak-char-display) nil)
+ (setq-local nobreak-char-display nil)
;; Enable `gnus-article-remove-images' to delete images shr.el renders.
- (set (make-local-variable 'shr-put-image-function) 'gnus-shr-put-image)
+ (setq-local shr-put-image-function 'gnus-shr-put-image)
(unless gnus-article-show-cursor
(setq cursor-in-non-selected-windows nil))
(gnus-set-default-directory)
@@ -4557,7 +4557,7 @@ commands:
t)))
(let ((summary gnus-summary-buffer))
(with-current-buffer name
- (set (make-local-variable 'gnus-article-edit-mode) nil)
+ (setq-local gnus-article-edit-mode nil)
(gnus-article-stop-animations)
(when gnus-article-mime-handles
(mm-destroy-parts gnus-article-mime-handles)
@@ -4568,14 +4568,14 @@ commands:
(setq buffer-read-only t)
(unless (derived-mode-p 'gnus-article-mode)
(gnus-article-mode))
- (set (make-local-variable 'gnus-summary-buffer) summary)
+ (setq-local gnus-summary-buffer summary)
(setq truncate-lines gnus-article-truncate-lines)
(current-buffer)))
(let ((summary gnus-summary-buffer))
(with-current-buffer (gnus-get-buffer-create name)
(gnus-article-mode)
(setq truncate-lines gnus-article-truncate-lines)
- (set (make-local-variable 'gnus-summary-buffer) summary)
+ (setq-local gnus-summary-buffer summary)
(gnus-summary-set-local-parameters gnus-newsgroup-name)
(when article-lapsed-timer
(gnus-stop-date-timer))
@@ -5036,7 +5036,7 @@ and `gnus-mime-delete-part', and not provided at run-time normally."
(setq gnus-article-mime-handles nil)
(let ((mbl1 mml-buffer-list))
(setq mml-buffer-list mbl)
- (set (make-local-variable 'mml-buffer-list) mbl1))
+ (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
@@ -6175,7 +6175,6 @@ If nil, don't show those extra buttons."
face ,gnus-article-button-face
follow-link t
gnus-part ,id
- button t
article-type multipart
rear-nonsticky t))
;; Do the handles
@@ -6200,6 +6199,7 @@ If nil, don't show those extra buttons."
follow-link t
gnus-part ,id
button t
+ category t
gnus-data ,handle
rear-nonsticky t))
(insert " "))
@@ -6902,8 +6902,8 @@ then we display only bindings that start with that prefix."
(setq draft gnus-draft-mode)))
(with-temp-buffer
(use-local-map keymap)
- (set (make-local-variable 'gnus-agent-summary-mode) agent)
- (set (make-local-variable 'gnus-draft-mode) draft)
+ (setq-local gnus-agent-summary-mode agent)
+ (setq-local gnus-draft-mode draft)
(describe-bindings prefix))
(let ((item `((lambda (prefix)
(with-current-buffer ,(current-buffer)
@@ -7247,11 +7247,9 @@ This is an extended text-mode.
\\{gnus-article-edit-mode-map}"
(make-local-variable 'gnus-article-edit-done-function)
(make-local-variable 'gnus-prev-winconf)
- (set (make-local-variable 'font-lock-defaults)
- '(message-font-lock-keywords t))
- (set (make-local-variable 'mail-header-separator) "")
- (set (make-local-variable 'gnus-article-edit-mode) t)
- (easy-menu-add message-mode-field-menu message-mode-map)
+ (setq-local font-lock-defaults '(message-font-lock-keywords t))
+ (setq-local mail-header-separator "")
+ (setq-local gnus-article-edit-mode t)
(mml-mode)
(setq buffer-read-only nil)
(buffer-enable-undo)
diff --git a/lisp/gnus/gnus-async.el b/lisp/gnus/gnus-async.el
index 9b08e6a0ef8..ed948a26c0b 100644
--- a/lisp/gnus/gnus-async.el
+++ b/lisp/gnus/gnus-async.el
@@ -1,6 +1,6 @@
;;; gnus-async.el --- asynchronous support for Gnus -*- lexical-binding:t -*-
-;; Copyright (C) 1996-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -357,8 +357,13 @@ that was fetched."
(let ((nntp-server-buffer (current-buffer))
(nnheader-callback-function
(lambda (_arg)
- (setq gnus-async-header-prefetched
- (cons group unread)))))
+ (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.
(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 d28ae857de0..d6f53e4b380 100644
--- a/lisp/gnus/gnus-bcklg.el
+++ b/lisp/gnus/gnus-bcklg.el
@@ -1,6 +1,6 @@
;;; gnus-bcklg.el --- backlog functions for Gnus
-;; Copyright (C) 1996-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
diff --git a/lisp/gnus/gnus-bookmark.el b/lisp/gnus/gnus-bookmark.el
index 1b00bbbc69c..57859d806c9 100644
--- a/lisp/gnus/gnus-bookmark.el
+++ b/lisp/gnus/gnus-bookmark.el
@@ -1,6 +1,6 @@
;;; gnus-bookmark.el --- Bookmarks in Gnus
-;; Copyright (C) 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2021 Free Software Foundation, Inc.
;; Author: Bastien Guerry <bzg AT altern DOT org>
;; Keywords: news
@@ -345,8 +345,7 @@ copy of the alist."
(when gnus-bookmark-sort-flag
(setq gnus-bookmark-alist
(sort (copy-alist gnus-bookmark-alist)
- (function
- (lambda (x y) (string-lessp (car x) (car y))))))))
+ (lambda (x y) (string-lessp (car x) (car y)))))))
;;;###autoload
(defun gnus-bookmark-bmenu-list ()
diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el
index c31d97d41cd..9423d9f2f6b 100644
--- a/lisp/gnus/gnus-cache.el
+++ b/lisp/gnus/gnus-cache.el
@@ -1,6 +1,6 @@
;;; gnus-cache.el --- cache interface for Gnus
-;; Copyright (C) 1995-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -294,49 +294,47 @@ 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))))
+ (setq gnus-newsgroup-cached (gnus-cache-articles-in-group group)))
+ (gnus-newsgroup-name group)
+ (gnus-fetch-old-headers fetch-old))
(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 fetch-old))
+ (gnus-retrieve-headers articles group))
(let ((uncached-articles (gnus-sorted-difference articles cached))
(cache-file (gnus-cache-file-name group ".overview"))
- type
- (file-name-coding-system nnmail-pathname-coding-system))
+ (file-name-coding-system nnmail-pathname-coding-system)
+ headers)
;; We first retrieve all the headers that we don't have in
;; the cache.
(let ((gnus-use-cache nil))
(when uncached-articles
- (setq type (and articles
- (gnus-retrieve-headers
- uncached-articles group fetch-old)))))
+ (setq headers (and articles
+ (gnus-fetch-headers uncached-articles)))))
(gnus-cache-save-buffers)
- ;; 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)))))))
+ ;; 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))))
(defun gnus-cache-enter-article (&optional n)
"Enter the next N articles into the cache.
@@ -529,70 +527,6 @@ 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.
diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el
index 912671a401d..d02e898e230 100644
--- a/lisp/gnus/gnus-cite.el
+++ b/lisp/gnus/gnus-cite.el
@@ -1,6 +1,6 @@
;;; gnus-cite.el --- parse citations in articles for Gnus
-;; Copyright (C) 1995-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
diff --git a/lisp/gnus/gnus-cloud.el b/lisp/gnus/gnus-cloud.el
index 3e23e263262..00b85f546c2 100644
--- a/lisp/gnus/gnus-cloud.el
+++ b/lisp/gnus/gnus-cloud.el
@@ -1,6 +1,6 @@
;;; gnus-cloud.el --- storing and retrieving data via IMAP
-;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: mail
@@ -30,6 +30,8 @@
(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")
@@ -391,8 +393,6 @@ 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,14 +407,10 @@ 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))
- 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))))
+ (gnus-newsgroup-name group)
+ (headers (gnus-fetch-headers (gnus-uncompress-range active))))
+ (when gnus-alter-header-function
+ (mapc gnus-alter-header-function 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 f0c4d07ca93..dc14943a060 100644
--- a/lisp/gnus/gnus-cus.el
+++ b/lisp/gnus/gnus-cus.el
@@ -1,6 +1,6 @@
;;; gnus-cus.el --- customization commands for Gnus
-;; Copyright (C) 1996, 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1999-2021 Free Software Foundation, Inc.
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: news
@@ -49,18 +49,15 @@ if that value is non-nil."
;; Emacs stuff:
(when (and (facep 'custom-button-face)
(facep 'custom-button-pressed-face))
- (set (make-local-variable 'widget-button-face)
- 'custom-button-face)
- (set (make-local-variable 'widget-button-pressed-face)
- 'custom-button-pressed-face)
- (set (make-local-variable 'widget-mouse-face)
- 'custom-button-pressed-face))
+ (setq-local widget-button-face 'custom-button-face)
+ (setq-local widget-button-pressed-face 'custom-button-pressed-face)
+ (setq-local widget-mouse-face 'custom-button-pressed-face))
(when (and (boundp 'custom-raised-buttons)
(symbol-value 'custom-raised-buttons))
- (set (make-local-variable 'widget-push-button-prefix) "")
- (set (make-local-variable 'widget-push-button-suffix) "")
- (set (make-local-variable 'widget-link-prefix) "")
- (set (make-local-variable 'widget-link-suffix) "")))
+ (setq-local widget-push-button-prefix "")
+ (setq-local widget-push-button-suffix "")
+ (setq-local widget-link-prefix "")
+ (setq-local widget-link-suffix "")))
;;; Group Customization:
@@ -380,10 +377,8 @@ category."))
(gnus-kill-buffer "*Gnus Customize*")
(switch-to-buffer (gnus-get-buffer-create "*Gnus Customize*"))
(gnus-custom-mode)
- (make-local-variable 'gnus-custom-group)
- (setq gnus-custom-group group)
- (make-local-variable 'gnus-custom-topic)
- (setq gnus-custom-topic topic)
+ (setq-local gnus-custom-group group)
+ (setq-local gnus-custom-topic topic)
(buffer-disable-undo)
(widget-insert "Customize the ")
(if group
@@ -848,8 +843,7 @@ This can be changed using the `\\[gnus-score-change-score-file]' command."
(kill-buffer (gnus-get-buffer-create "*Gnus Customize*"))
(switch-to-buffer (gnus-get-buffer-create "*Gnus Customize*"))
(gnus-custom-mode)
- (make-local-variable 'gnus-custom-score-alist)
- (setq gnus-custom-score-alist scores)
+ (setq-local gnus-custom-score-alist scores)
(widget-insert "Customize the ")
(widget-create 'info-link
:help-echo "Push me to learn more."
@@ -867,8 +861,7 @@ Check the [ ] for the entries you want to apply to this score file, then
edit the value to suit your taste. Don't forget to mark the checkbox,
if you do all your changes will be lost. ")
(widget-insert "\n\n")
- (make-local-variable 'gnus-custom-scores)
- (setq gnus-custom-scores
+ (setq-local gnus-custom-scores
(widget-create 'group
:value scores
`(checklist :inline t
@@ -1052,10 +1045,9 @@ articles in the thread.
"\n Note: Empty fields default to the customizable global\
variables.\n\n")
- (set (make-local-variable 'gnus-agent-cat-name)
- name))
+ (setq-local gnus-agent-cat-name name))
- (set (make-local-variable 'category-fields) nil)
+ (setq-local category-fields nil)
(gnus-agent-cat-prepare-category-field agent-predicate)
(gnus-agent-cat-prepare-category-field agent-score)
diff --git a/lisp/gnus/gnus-dbus.el b/lisp/gnus/gnus-dbus.el
index 8fbeffba437..12bf7bb926a 100644
--- a/lisp/gnus/gnus-dbus.el
+++ b/lisp/gnus/gnus-dbus.el
@@ -1,6 +1,6 @@
;;; gnus-dbus.el --- DBUS integration for Gnus -*- lexical-binding: t; -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; Author: Eric Abrahamsen <eric@ericabrahamsen.net>
diff --git a/lisp/gnus/gnus-delay.el b/lisp/gnus/gnus-delay.el
index 63e938e7453..477ad88a9ca 100644
--- a/lisp/gnus/gnus-delay.el
+++ b/lisp/gnus/gnus-delay.el
@@ -1,6 +1,6 @@
;;; gnus-delay.el --- Delayed posting of articles
-;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Author: Kai Großjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
;; Keywords: mail, news, extensions
diff --git a/lisp/gnus/gnus-demon.el b/lisp/gnus/gnus-demon.el
index 99a736f8f44..219f15e2227 100644
--- a/lisp/gnus/gnus-demon.el
+++ b/lisp/gnus/gnus-demon.el
@@ -1,6 +1,6 @@
;;; gnus-demon.el --- daemonic Gnus behavior
-;; Copyright (C) 1995-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
diff --git a/lisp/gnus/gnus-diary.el b/lisp/gnus/gnus-diary.el
index b36faa86a22..78f1e53ff7a 100644
--- a/lisp/gnus/gnus-diary.el
+++ b/lisp/gnus/gnus-diary.el
@@ -1,6 +1,6 @@
;;; gnus-diary.el --- Wrapper around the NNDiary Gnus back end
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Didier Verna <didier@didierverna.net>
;; Created: Tue Jul 20 10:42:55 1999
diff --git a/lisp/gnus/gnus-dired.el b/lisp/gnus/gnus-dired.el
index 0063ed25ef6..6f231c4fbb8 100644
--- a/lisp/gnus/gnus-dired.el
+++ b/lisp/gnus/gnus-dired.el
@@ -1,6 +1,6 @@
;;; gnus-dired.el --- utility functions where gnus and dired meet
-;; Copyright (C) 1996-1999, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2001-2021 Free Software Foundation, Inc.
;; Authors: Benjamin Rutt <brutt@bloomington.in.us>,
;; Shenghuo Zhu <zsh@cs.rochester.edu>
diff --git a/lisp/gnus/gnus-draft.el b/lisp/gnus/gnus-draft.el
index 3a9bf2a7e8f..5f7ed386297 100644
--- a/lisp/gnus/gnus-draft.el
+++ b/lisp/gnus/gnus-draft.el
@@ -1,6 +1,6 @@
;;; gnus-draft.el --- draft message support for Gnus
-;; Copyright (C) 1997-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
diff --git a/lisp/gnus/gnus-dup.el b/lisp/gnus/gnus-dup.el
index 1f247aa4aea..f7d61bb35fc 100644
--- a/lisp/gnus/gnus-dup.el
+++ b/lisp/gnus/gnus-dup.el
@@ -1,6 +1,6 @@
;;; gnus-dup.el --- suppression of duplicate articles in Gnus -*- lexical-binding: t -*-
-;; Copyright (C) 1996-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
diff --git a/lisp/gnus/gnus-eform.el b/lisp/gnus/gnus-eform.el
index 1bc1261ee8f..feee7326cd2 100644
--- a/lisp/gnus/gnus-eform.el
+++ b/lisp/gnus/gnus-eform.el
@@ -1,6 +1,6 @@
;;; gnus-eform.el --- a mode for editing forms for Gnus
-;; Copyright (C) 1996-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
diff --git a/lisp/gnus/gnus-fun.el b/lisp/gnus/gnus-fun.el
index 3218649761a..615f4a55bc5 100644
--- a/lisp/gnus/gnus-fun.el
+++ b/lisp/gnus/gnus-fun.el
@@ -1,6 +1,6 @@
;;; gnus-fun.el --- various frivolous extension functions to Gnus
-;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -286,8 +286,8 @@ colors of the displayed X-Faces."
(setq file (car file))
(with-temp-buffer
(shell-command
- (format "pnmcut -left 110 -top 30 -width 144 -height 144 '%s' | ppmnorm 2>/dev/null | pnmscale -width 48 | ppmtopgm | pgmtopbm -threshold -value 0.92 | pbmtoxbm | compface"
- file)
+ (format "pnmcut -left 110 -top 30 -width 144 -height 144 '%s' | ppmnorm 2>%s | pnmscale -width 48 | ppmtopgm | pgmtopbm -threshold -value 0.92 | pbmtoxbm | compface"
+ file null-device)
(current-buffer))
;;(sleep-for 3)
(delete-file file)
diff --git a/lisp/gnus/gnus-gravatar.el b/lisp/gnus/gnus-gravatar.el
index 9c24de44cd6..a7ca733e755 100644
--- a/lisp/gnus/gnus-gravatar.el
+++ b/lisp/gnus/gnus-gravatar.el
@@ -1,6 +1,6 @@
;;; gnus-gravatar.el --- Gnus Gravatar support -*- lexical-binding: t -*-
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Julien Danjou <julien@danjou.info>
;; Keywords: multimedia, news
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index 1d614f8a8d4..ff792c57065 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -1,6 +1,6 @@
;;; gnus-group.el --- group mode commands for Gnus
-;; Copyright (C) 1996-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -52,13 +52,15 @@
(autoload 'gnus-cloud-upload-all-data "gnus-cloud")
(autoload 'gnus-cloud-download-all-data "gnus-cloud")
+(autoload 'gnus-topic-find-groups "gnus-topic")
+
(defcustom gnus-no-groups-message "No news is good news"
"Message displayed by Gnus when no groups are available."
:group 'gnus-start
:type 'string)
(defcustom gnus-keep-same-level nil
- "Non-nil means that the next newsgroup after the current will be on the same level.
+ "Non-nil means that the newsgroup after this one will be on the same level.
When you type, for instance, `n' after reading the last article in the
current newsgroup, you will go to the next newsgroup. If this variable
is nil, the next newsgroup will be the next from the group
@@ -1096,7 +1098,7 @@ When FORCE, rebuild the tool bar."
gnus-group-tool-bar-zap-list
'gnus-group-mode-map)))
(if map
- (set (make-local-variable 'tool-bar-map) map))))
+ (setq-local tool-bar-map map))))
gnus-group-tool-bar-map)
(define-derived-mode gnus-group-mode gnus-mode "Group"
@@ -1743,7 +1745,8 @@ already. If INFO-UNCHANGED is non-nil, dribble buffer is not updated."
(prog1
(setq mode-line-buffer-identification
(gnus-mode-line-buffer-identification
- (list mode-string)))
+ (list (propertize mode-string
+ 'face 'mode-line-buffer-id))))
(set-buffer-modified-p modified))))))
(defun gnus-group-group-name ()
@@ -3165,28 +3168,27 @@ mail messages or news articles in files that have numeric names."
(gnus-group-real-name group)
(list 'nndir (gnus-group-real-name group) (list 'nndir-directory dir)))))
-
-(autoload 'nnir-read-parms "nnir")
-(autoload 'nnir-server-to-search-engine "nnir")
(autoload 'gnus-group-topic-name "gnus-topic")
+(autoload 'gnus-search-make-spec "gnus-search")
;; Temporary to make group creation easier
-(defun gnus-group-make-search-group (nnir-extra-parms &optional specs)
+(defun gnus-group-make-search-group (no-parse &optional specs)
"Make a group based on a search.
Prompt for a search query and determine the groups to search as
follows: if called from the *Server* buffer search all groups
belonging to the server on the current line; if called from the
*Group* buffer search any marked groups, or the group on the
-current line, or all the groups under the current topic. Calling
-with a prefix arg prompts for additional search-engine specific
-constraints. A non-nil SPECS arg must be an alist with
-`nnir-query-spec' and `nnir-group-spec' keys, and skips all
-prompting."
+current line, or all the groups under the current topic. A
+prefix arg NO-PARSE means that Gnus should not parse the search
+query before passing it to the underlying search engine. A
+non-nil SPECS arg must be an alist with `search-query-spec' and
+`search-group-spec' keys, and skips all prompting."
(interactive "P")
(let ((name (gnus-read-group "Group name: ")))
(with-current-buffer gnus-group-buffer
(let* ((group-spec
(or
+ (cdr (assq 'search-group-spec specs))
(cdr (assq 'nnir-group-spec specs))
(if (gnus-server-server-name)
(list (list (gnus-server-server-name)))
@@ -3195,20 +3197,19 @@ prompting."
(or gnus-group-marked
(if (gnus-group-group-name)
(list (gnus-group-group-name))
- (cdr
- (assoc (gnus-group-topic-name) gnus-topic-alist))))))))
+ (mapcar #'caadr
+ (gnus-topic-find-groups
+ (gnus-group-topic-name)
+ nil 'all nil t))))))))
(query-spec
(or
+ (cdr (assq 'search-query-spec specs))
(cdr (assq 'nnir-query-spec specs))
- (apply
- 'append
- (list (cons 'query
- (read-string "Query: " nil 'nnir-search-history)))
- (when nnir-extra-parms
- (mapcar
- (lambda (x)
- (nnir-read-parms (nnir-server-to-search-engine (car x))))
- group-spec))))))
+ (gnus-search-make-spec no-parse))))
+ ;; If our query came via an old call to nnir, we know not to
+ ;; parse the query.
+ (when (assq 'nnir-query-spec specs)
+ (setf (alist-get 'raw query-spec) t))
(gnus-group-make-group
name
(list 'nnselect "nnselect")
@@ -3216,29 +3217,30 @@ prompting."
(list
(cons 'nnselect-specs
(list
- (cons 'nnselect-function 'nnir-run-query)
+ (cons 'nnselect-function 'gnus-search-run-query)
(cons 'nnselect-args
- (list (cons 'nnir-query-spec query-spec)
- (cons 'nnir-group-spec group-spec)))))
+ (list (cons 'search-query-spec query-spec)
+ (cons 'search-group-spec group-spec)))))
(cons 'nnselect-artlist nil)))))))
(define-obsolete-function-alias 'gnus-group-make-nnir-group
'gnus-group-read-ephemeral-search-group "28.1")
-(defun gnus-group-read-ephemeral-search-group (nnir-extra-parms &optional specs)
+(defun gnus-group-read-ephemeral-search-group (no-parse &optional specs)
"Read an nnselect group based on a search.
Prompt for a search query and determine the groups to search as
follows: if called from the *Server* buffer search all groups
belonging to the server on the current line; if called from the
*Group* buffer search any marked groups, or the group on the
-current line, or all the groups under the current topic. Calling
-with a prefix arg prompts for additional search-engine specific
-constraints. A non-nil SPECS arg must be an alist with
-`nnir-query-spec' and `nnir-group-spec' keys, and skips all
-prompting."
+current line, or all the groups under the current topic. A
+prefix arg NO-PARSE means that Gnus should not parse the search
+query before passing it to the underlying search engine. A
+non-nil SPECS arg must be an alist with `search-query-spec' and
+`search-group-spec' keys, and skips all prompting."
(interactive "P")
(let* ((group-spec
- (or (cdr (assq 'nnir-group-spec specs))
+ (or (cdr (assq 'search-group-spec specs))
+ (cdr (assq 'nnir-group-spec specs))
(if (gnus-server-server-name)
(list (list (gnus-server-server-name)))
(seq-group-by
@@ -3246,19 +3248,18 @@ prompting."
(or gnus-group-marked
(if (gnus-group-group-name)
(list (gnus-group-group-name))
- (cdr
- (assoc (gnus-group-topic-name) gnus-topic-alist))))))))
+ (mapcar #'caadr
+ (gnus-topic-find-groups
+ (gnus-group-topic-name)
+ nil 'all nil t))))))))
(query-spec
- (or (cdr (assq 'nnir-query-spec specs))
- (apply
- 'append
- (list (cons 'query
- (read-string "Query: " nil 'nnir-search-history)))
- (when nnir-extra-parms
- (mapcar
- (lambda (x)
- (nnir-read-parms (nnir-server-to-search-engine (car x))))
- group-spec))))))
+ (or (cdr (assq 'search-query-spec specs))
+ (cdr (assq 'nnir-query-spec specs))
+ (gnus-search-make-spec no-parse))))
+ ;; If our query came via an old call to nnir, we know not to parse
+ ;; the query.
+ (when (assq 'nnir-query-spec specs)
+ (setf (alist-get 'raw query-spec) t))
(gnus-group-read-ephemeral-group
(concat "nnselect-" (message-unique-id))
(list 'nnselect "nnselect")
@@ -3268,10 +3269,10 @@ prompting."
(list
(cons 'nnselect-specs
(list
- (cons 'nnselect-function 'nnir-run-query)
+ (cons 'nnselect-function 'gnus-search-run-query)
(cons 'nnselect-args
- (list (cons 'nnir-query-spec query-spec)
- (cons 'nnir-group-spec group-spec)))))
+ (list (cons 'search-query-spec query-spec)
+ (cons 'search-group-spec group-spec)))))
(cons 'nnselect-artlist nil)))))
(defun gnus-group-add-to-virtual (n vgroup)
diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el
index 002a1c1fded..bb1ee5a806a 100644
--- a/lisp/gnus/gnus-html.el
+++ b/lisp/gnus/gnus-html.el
@@ -1,6 +1,6 @@
;;; gnus-html.el --- Render HTML in a buffer.
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: html, web
diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el
index 389bce85e8b..1e0e2071018 100644
--- a/lisp/gnus/gnus-icalendar.el
+++ b/lisp/gnus/gnus-icalendar.el
@@ -1,6 +1,6 @@
;;; gnus-icalendar.el --- reply to iCalendar meeting requests -*- lexical-binding:t -*-
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; Author: Jan Tatarik <Jan.Tatarik@gmail.com>
;; Keywords: mail, icalendar, org
diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el
index b8be766c84f..9c68773e19a 100644
--- a/lisp/gnus/gnus-int.el
+++ b/lisp/gnus/gnus-int.el
@@ -1,6 +1,6 @@
;;; gnus-int.el --- backend interface functions for Gnus
-;; Copyright (C) 1996-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
diff --git a/lisp/gnus/gnus-kill.el b/lisp/gnus/gnus-kill.el
index a772281d4c3..7e592026cd0 100644
--- a/lisp/gnus/gnus-kill.el
+++ b/lisp/gnus/gnus-kill.el
@@ -1,6 +1,6 @@
;;; gnus-kill.el --- kill commands for Gnus
-;; Copyright (C) 1995-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
diff --git a/lisp/gnus/gnus-logic.el b/lisp/gnus/gnus-logic.el
index a29772f41e1..105222d6797 100644
--- a/lisp/gnus/gnus-logic.el
+++ b/lisp/gnus/gnus-logic.el
@@ -1,6 +1,6 @@
;;; gnus-logic.el --- advanced scoring code for Gnus
-;; Copyright (C) 1996-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
diff --git a/lisp/gnus/gnus-mh.el b/lisp/gnus/gnus-mh.el
index 64333692463..b26b736d055 100644
--- a/lisp/gnus/gnus-mh.el
+++ b/lisp/gnus/gnus-mh.el
@@ -1,6 +1,6 @@
;;; gnus-mh.el --- mh-e interface for Gnus
-;; Copyright (C) 1994-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2021 Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
diff --git a/lisp/gnus/gnus-ml.el b/lisp/gnus/gnus-ml.el
index acef537197c..a47c15525a3 100644
--- a/lisp/gnus/gnus-ml.el
+++ b/lisp/gnus/gnus-ml.el
@@ -1,6 +1,6 @@
;;; gnus-ml.el --- Mailing list minor mode for Gnus
-;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;; Author: Julien Gilles <jgilles@free.fr>
;; Keywords: news, mail
diff --git a/lisp/gnus/gnus-mlspl.el b/lisp/gnus/gnus-mlspl.el
index 8cbe858dc9e..ed8d15a2feb 100644
--- a/lisp/gnus/gnus-mlspl.el
+++ b/lisp/gnus/gnus-mlspl.el
@@ -1,6 +1,6 @@
;;; gnus-mlspl.el --- a group params-based mail splitting mechanism
-;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: Alexandre Oliva <oliva@lsd.ic.unicamp.br>
;; Keywords: news, mail
diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index 465871eafbd..419b5ead563 100644
--- a/lisp/gnus/gnus-msg.el
+++ b/lisp/gnus/gnus-msg.el
@@ -1,6 +1,6 @@
;;; gnus-msg.el --- mail and post interface for Gnus
-;; Copyright (C) 1995-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -464,8 +464,7 @@ only affect the Gcc copy, but not the original message."
(gnus-inews-add-send-actions ,winconf ,buffer ,oarticle ,config
,yanked ,winconf-name)
(setq gnus-message-buffer (current-buffer))
- (set (make-local-variable 'gnus-message-group-art)
- (cons ,group ,article))
+ (setq-local gnus-message-group-art (cons ,group ,article))
;; Enable highlighting of different citation levels
(when gnus-message-highlight-citation
(gnus-message-citation-mode 1))
@@ -473,7 +472,7 @@ only affect the Gcc copy, but not the original message."
(if (eq major-mode 'message-mode)
(let ((mbl1 mml-buffer-list))
(setq mml-buffer-list mbl) ;; Global value
- (set (make-local-variable 'mml-buffer-list) mbl1);; Local 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))
(mml-destroy-buffers)
@@ -724,10 +723,10 @@ network. The corresponding back end must have a `request-post' method."
(gnus-setup-message 'message
(progn
(message-news (gnus-group-real-name gnus-newsgroup-name))
- (set (make-local-variable 'gnus-discouraged-post-methods)
- (remove
- (car (gnus-find-method-for-group gnus-newsgroup-name))
- gnus-discouraged-post-methods)))))))))
+ (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.
@@ -1926,8 +1925,8 @@ this is a reply."
(message-goto-body)
(insert ,(cdr result)))))
((eq 'signature (car result))
- (set (make-local-variable 'message-signature) nil)
- (set (make-local-variable 'message-signature-file) nil)
+ (setq-local message-signature nil)
+ (setq-local message-signature-file nil)
(if (not (cdr result))
'ignore
`(lambda ()
@@ -1953,8 +1952,8 @@ this is a reply."
(when (or name address)
(add-hook 'message-setup-hook
`(lambda ()
- (set (make-local-variable 'user-mail-address)
- ,(or (cdr address) user-mail-address))
+ (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)))
diff --git a/lisp/gnus/gnus-notifications.el b/lisp/gnus/gnus-notifications.el
index 90e4a98b35d..e772dd8e625 100644
--- a/lisp/gnus/gnus-notifications.el
+++ b/lisp/gnus/gnus-notifications.el
@@ -1,6 +1,6 @@
;; gnus-notifications.el -- Send notification on new message in Gnus
-;; Copyright (C) 2012-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
;; Author: Julien Danjou <julien@danjou.info>
;; Keywords: news
diff --git a/lisp/gnus/gnus-picon.el b/lisp/gnus/gnus-picon.el
index a4d2d99fb89..92def9a72d0 100644
--- a/lisp/gnus/gnus-picon.el
+++ b/lisp/gnus/gnus-picon.el
@@ -1,6 +1,6 @@
;;; gnus-picon.el --- displaying pretty icons in Gnus
-;; Copyright (C) 1996-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news xpm annotation glyph faces
diff --git a/lisp/gnus/gnus-range.el b/lisp/gnus/gnus-range.el
index 57a97936b1a..1e5d2a066f6 100644
--- a/lisp/gnus/gnus-range.el
+++ b/lisp/gnus/gnus-range.el
@@ -1,6 +1,6 @@
;;; gnus-range.el --- range and sequence functions for Gnus
-;; Copyright (C) 1996-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el
index 65bcd0e8a36..068066e38c9 100644
--- a/lisp/gnus/gnus-registry.el
+++ b/lisp/gnus/gnus-registry.el
@@ -1,6 +1,6 @@
;;; gnus-registry.el --- article registry for Gnus -*- lexical-binding: t; -*-
-;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Author: Ted Zlatanov <tzz@lifelogs.com>
;; Keywords: news registry
@@ -54,6 +54,9 @@
;; (: gnus-registry-split-fancy-with-parent)
+;; This won't work as expected unless `gnus-registry-register-all'
+;; is set to t.
+
;; You should also consider using the nnregistry backend to look up
;; articles. See the Gnus manual for more information.
@@ -160,6 +163,11 @@ nnmairix groups are specifically excluded because they are ephemeral."
(const :tag "Always Install" t)
(const :tag "Ask Me" ask)))
+(defcustom gnus-registry-register-all t
+ "If non-nil, register all articles in the registry."
+ :type 'boolean
+ :version "28.1")
+
(defvar gnus-registry-enabled nil)
(defvar gnus-summary-misc-menu) ;; Avoid byte compiler warning.
@@ -478,8 +486,8 @@ This is not required after changing `gnus-registry-cache-file'."
(let ((db gnus-registry-db)
;; if the group is ignored, set the destination to nil (same as delete)
(to (if (gnus-registry-ignore-group-p to) nil to))
- ;; safe if not found
- (entry (gnus-registry-get-or-make-entry id))
+ ;; Only retrieve an existing entry, don't create a new one.
+ (entry (gnus-registry-get-or-make-entry id t))
(subject (gnus-string-remove-all-properties
(gnus-registry-simplify-subject subject)))
(sender (gnus-string-remove-all-properties sender)))
@@ -488,29 +496,30 @@ This is not required after changing `gnus-registry-cache-file'."
;; several times but it's better to bunch the transactions
;; together
- (registry-delete db (list id) nil)
- (when from
- (setq entry (cons (delete from (assoc 'group entry))
- (assq-delete-all 'group entry))))
- ;; Only keep the entry if the message is going to a new group, or
- ;; it's still in some previous group.
- (when (or to (alist-get 'group entry))
- (dolist (kv `((group ,to)
- (sender ,sender)
- (recipient ,@recipients)
- (subject ,subject)))
- (when (cadr kv)
- (let ((new (or (assq (car kv) entry)
- (list (car kv)))))
- (dolist (toadd (cdr kv))
- (unless (member toadd new)
- (setq new (append new (list toadd)))))
- (setq entry (cons new
- (assq-delete-all (car kv) entry))))))
- (gnus-message 10 "Gnus registry: new entry for %s is %S"
- id
- entry)
- (gnus-registry-insert db id entry))))
+ (when entry
+ (registry-delete db (list id) nil)
+ (when from
+ (setq entry (cons (delete from (assoc 'group entry))
+ (assq-delete-all 'group entry))))
+ ;; Only keep the entry if the message is going to a new group, or
+ ;; it's still in some previous group.
+ (when (or to (alist-get 'group entry))
+ (dolist (kv `((group ,to)
+ (sender ,sender)
+ (recipient ,@recipients)
+ (subject ,subject)))
+ (when (cadr kv)
+ (let ((new (or (assq (car kv) entry)
+ (list (car kv)))))
+ (dolist (toadd (cdr kv))
+ (unless (member toadd new)
+ (setq new (append new (list toadd)))))
+ (setq entry (cons new
+ (assq-delete-all (car kv) entry))))))
+ (gnus-message 10 "Gnus registry: new entry for %s is %S"
+ id
+ entry)
+ (gnus-registry-insert db id entry)))))
;; Function for nn{mail|imap}-split-fancy: look up all references in
;; the cache and if a match is found, return that group.
@@ -846,7 +855,8 @@ Overrides existing keywords with FORCE set non-nil."
(defun gnus-registry-register-message-ids ()
"Register the Message-ID of every article in the group."
- (unless (gnus-parameter-registry-ignore gnus-newsgroup-name)
+ (unless (or (gnus-parameter-registry-ignore gnus-newsgroup-name)
+ (null gnus-registry-register-all))
(dolist (article gnus-newsgroup-articles)
(let* ((id (gnus-registry-fetch-message-id-fast article))
(groups (gnus-registry-get-id-key id 'group)))
@@ -1082,12 +1092,15 @@ only the last one's marks are returned."
"Get the number of groups of a message, based on the message ID."
(length (gnus-registry-get-id-key id 'group)))
-(defun gnus-registry-get-or-make-entry (id)
+(defun gnus-registry-get-or-make-entry (id &optional no-create)
+ "Return registry entry for ID.
+If entry is not found, create a new one, unless NO-CREATE is
+non-nil."
(let* ((db gnus-registry-db)
;; safe if not found
(entries (registry-lookup db (list id))))
- (when (null entries)
+ (unless (or entries no-create)
(gnus-registry-insert db id (list (list 'creation-time (current-time))
'(group) '(sender) '(subject)))
(setq entries (registry-lookup db (list id))))
@@ -1098,7 +1111,8 @@ only the last one's marks are returned."
(registry-delete gnus-registry-db idlist nil))
(defun gnus-registry-get-id-key (id key)
- (cdr-safe (assq key (gnus-registry-get-or-make-entry id))))
+ (cdr-safe (assq key (gnus-registry-get-or-make-entry
+ id (null gnus-registry-register-all)))))
(defun gnus-registry-set-id-key (id key vals)
(let* ((db gnus-registry-db)
diff --git a/lisp/gnus/gnus-rfc1843.el b/lisp/gnus/gnus-rfc1843.el
index 45a6aff1fae..107e96350bb 100644
--- a/lisp/gnus/gnus-rfc1843.el
+++ b/lisp/gnus/gnus-rfc1843.el
@@ -1,6 +1,6 @@
;;; gnus-rfc1843.el --- HZ (rfc1843) decoding interface functions for Gnus
-;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
;; Keywords: news HZ HZ+ mail i18n
diff --git a/lisp/gnus/gnus-salt.el b/lisp/gnus/gnus-salt.el
index 8d58cd59e45..abaa844f58a 100644
--- a/lisp/gnus/gnus-salt.el
+++ b/lisp/gnus/gnus-salt.el
@@ -1,6 +1,6 @@
;;; gnus-salt.el --- alternate summary mode interfaces for Gnus
-;; Copyright (C) 1996-1999, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2001-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -106,7 +106,7 @@ It accepts the same format specs that `gnus-summary-line-format' does."
(remove-hook 'gnus-message-setup-hook 'gnus-pick-setup-message))
(t
;; Make sure that we don't select any articles upon group entry.
- (set (make-local-variable 'gnus-auto-select-first) nil)
+ (setq-local gnus-auto-select-first nil)
;; Change line format.
(setq gnus-summary-line-format gnus-summary-pick-line-format)
(setq gnus-summary-line-format-spec nil)
@@ -114,7 +114,7 @@ It accepts the same format specs that `gnus-summary-line-format' does."
(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)
- (set (make-local-variable 'gnus-summary-goto-unread) 'never)
+ (setq-local gnus-summary-goto-unread 'never)
;; Set up the menu.
(when (gnus-visual-p 'pick-menu 'menu)
(gnus-pick-make-menu-bar)))))
@@ -333,10 +333,8 @@ This must be bound to a button-down mouse event."
((not (derived-mode-p 'gnus-summary-mode)) (setq gnus-binary-mode nil))
(gnus-binary-mode
;; Make sure that we don't select any articles upon group entry.
- (make-local-variable 'gnus-auto-select-first)
- (setq gnus-auto-select-first nil)
- (make-local-variable 'gnus-summary-display-article-function)
- (setq gnus-summary-display-article-function 'gnus-binary-display-article)
+ (setq-local gnus-auto-select-first nil)
+ (setq-local gnus-summary-display-article-function 'gnus-binary-display-article)
;; Set up the menu.
(when (gnus-visual-p 'binary-menu 'menu)
(gnus-binary-make-menu-bar)))))
diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el
index 2e3abe7832d..e74c4980879 100644
--- a/lisp/gnus/gnus-score.el
+++ b/lisp/gnus/gnus-score.el
@@ -1,6 +1,6 @@
;;; gnus-score.el --- scoring code for Gnus
-;; Copyright (C) 1995-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
;; Author: Per Abrahamsen <amanda@iesd.auc.dk>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -248,7 +248,7 @@ If you use score decays, you might want to set values higher than
(integer :tag "Score"))))))
(defcustom gnus-adaptive-word-length-limit nil
- "Words of a length lesser than this limit will be ignored when doing adaptive scoring."
+ "Words shorter than this limit will be ignored when doing adaptive scoring."
:version "22.1"
:group 'gnus-score-adapt
:type '(radio (const :format "Unlimited " nil)
@@ -1117,8 +1117,7 @@ EXTRA is the possible non-standard header."
(gnus-configure-windows 'edit-score)
(gnus-score-mode)
(setq gnus-score-edit-exit-function 'gnus-score-edit-done)
- (make-local-variable 'gnus-prev-winconf)
- (setq gnus-prev-winconf winconf))
+ (setq-local gnus-prev-winconf winconf))
(gnus-message
4 "%s" (substitute-command-keys
"\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits"))))
@@ -1145,8 +1144,7 @@ EXTRA is the possible non-standard header."
(gnus-configure-windows 'edit-score)
(gnus-score-mode)
(setq gnus-score-edit-exit-function 'gnus-score-edit-done)
- (make-local-variable 'gnus-prev-winconf)
- (setq gnus-prev-winconf winconf))
+ (setq-local gnus-prev-winconf winconf))
(gnus-message
4 "%s" (substitute-command-keys
"\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits")))
diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el
new file mode 100644
index 00000000000..5c6a5b9efd0
--- /dev/null
+++ b/lisp/gnus/gnus-search.el
@@ -0,0 +1,2186 @@
+;;; gnus-search.el --- Search facilities for Gnus -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
+
+;; Author: Eric Abrahamsen <eric@ericabrahamsen.net>
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file defines a generalized search language, and search engines
+;; that interface with various search programs. It is responsible for
+;; parsing the user's search input, sending that query to the search
+;; engines, and collecting results. Results are in the form of a
+;; vector of vectors, each vector representing a found article. The
+;; nnselect backend interprets that value to create a group containing
+;; the search results.
+
+;; This file was formerly known as nnir. Later, the backend parts of
+;; nnir became nnselect, and only the search functionality was left
+;; here.
+
+;; See the Gnus manual for details of the search language. Tests are
+;; in tests/gnus-search-test.el.
+
+;; The search parsing routines are responsible for accepting the
+;; user's search query as a string and parsing it into a sexp
+;; structure. The function `gnus-search-parse-query' is the entry
+;; point for that. Once the query is in sexp form, it is passed to
+;; the search engines themselves, which are responsible for
+;; transforming the query into a form that the external program can
+;; understand, and then filtering the search results into a format
+;; that nnselect can understand.
+
+;; The general flow is:
+
+;; 1. The user calls one of `gnus-group-make-search-group' or
+;; `gnus-group-make-permanent-search-group' (or a few other entry
+;; points). These functions prompt for a search query, and collect
+;; the groups to search, then create an nnselect group, setting an
+;; 'nnselect-specs group parameter where 'nnselect-function is
+;; `gnus-search-run-query', and 'nnselect-args is the search query and
+;; groups to search.
+
+;; 2. `gnus-search-run-query' is called with 'nnselect-args. It looks
+;; at the groups to search, categorizes them by server, and for each
+;; server finds the search engine to use. It calls each engine's
+;; `gnus-search-run-search' method with the query and groups passed as
+;; arguments, and the results are collected and handed off to the
+;; nnselect group.
+
+;; For information on writing new search engines, see the Gnus manual.
+
+;; TODO: Rewrite the query parser using syntax tables and
+;; `parse-partial-sexp'.
+
+;; TODO: Refactor IMAP search so we can move code that uses nnimap-*
+;; functions out into nnimap.el.
+
+;; TODO: Is there anything we can do about sorting results?
+
+;; TODO: Provide for returning a result count. This would probably
+;; need a completely separate top-level command, since we wouldn't be
+;; creating a group at all.
+
+;;; Code:
+
+(require 'gnus-group)
+(require 'gnus-sum)
+(require 'message)
+(require 'gnus-util)
+(require 'eieio)
+(eval-when-compile (require 'cl-lib))
+(autoload 'eieio-build-class-alist "eieio-opt")
+(autoload 'nnmaildir-base-name-to-article-number "nnmaildir")
+
+(defvar gnus-inhibit-demon)
+(defvar gnus-english-month-names)
+
+;;; Internal Variables:
+
+;; When Gnus servers are implemented as objects or structs, give them
+;; a `search-engine' slot and get rid of this variable.
+(defvar gnus-search-engine-instance-alist nil
+ "Mapping between servers and instantiated search engines.")
+
+(defvar gnus-search-history ()
+ "Internal history of Gnus searches.")
+
+(defun gnus-search-shutdown ()
+ (setq gnus-search-engine-instance-alist nil))
+
+(gnus-add-shutdown #'gnus-search-shutdown 'gnus)
+
+(define-error 'gnus-search-parse-error "Gnus search parsing error")
+
+(define-error 'gnus-search-config-error "Gnus search configuration error")
+
+;;; User Customizable Variables:
+
+(defgroup gnus-search nil
+ "Search groups in Gnus with assorted search engines."
+ :group 'gnus)
+
+(defcustom gnus-search-use-parsed-queries nil
+ "When t, use Gnus' generalized search language.
+The generalized search language is a search language that can be
+used across all search engines that Gnus supports. See the Gnus
+manual for details.
+
+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)
+
+(define-obsolete-variable-alias 'nnir-ignored-newsgroups
+ 'gnus-search-ignored-newsgroups "28.1")
+
+(defcustom gnus-search-ignored-newsgroups ""
+ "A regexp to match newsgroups in the active file that should
+ be skipped when searching."
+ :version "24.1"
+ :type 'regexp
+ :group 'gnus-search)
+
+(make-obsolete-variable
+ 'nnir-imap-default-search-key
+ "specify imap search keys, or use parsed queries." "28.1")
+
+;; Engine-specific configuration options.
+
+(defcustom gnus-search-swish++-config-file
+ (expand-file-name "~/Mail/swish++.conf")
+ "Location of Swish++ configuration file.
+This variable can also be set per-server."
+ :type 'file
+ :group 'gnus-search)
+
+(defcustom gnus-search-swish++-program "search"
+ "Name of swish++ search executable.
+This variable can also be set per-server."
+ :type 'string
+ :group 'gnus-search)
+
+(defcustom gnus-search-swish++-switches '()
+ "A list of strings, to be given as additional arguments to swish++.
+Note that this should be a list. I.e., do NOT use the following:
+ (setq gnus-search-swish++-switches \"-i -w\") ; wrong
+Instead, use this:
+ (setq gnus-search-swish++-switches \\='(\"-i\" \"-w\"))
+
+This variable can also be set per-server."
+ :type '(repeat string)
+ :group 'gnus-search)
+
+(defcustom gnus-search-swish++-remove-prefix (concat (getenv "HOME") "/Mail/")
+ "The prefix to remove from each file name returned by swish++
+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)
+
+(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)
+
+(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)
+
+(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)
+
+(defcustom gnus-search-swish-e-switches '()
+ "A list of strings, to be given as additional arguments to swish-e.
+Note that this should be a list. I.e., do NOT use the following:
+ (setq gnus-search-swish-e-switches \"-i -w\") ; wrong
+Instead, use this:
+ (setq gnus-search-swish-e-switches \\='(\"-i\" \"-w\"))
+
+This variable can also be set per-server."
+ :type '(repeat string)
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-swish-e-remove-prefix (concat (getenv "HOME") "/Mail/")
+ "The prefix to remove from each file name returned by swish-e
+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
+ :version "28.1"
+ :group 'gnus-search)
+
+(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)
+
+(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)
+
+;; Namazu engine, see <URL:http://www.namazu.org/>
+
+(defcustom gnus-search-namazu-program "namazu"
+ "Name of Namazu search executable.
+This variable can also be set per-server."
+ :type 'string
+ :version "28.1"
+ :group 'gnus-search)
+
+(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)
+
+(defcustom gnus-search-namazu-switches '()
+ "A list of strings, to be given as additional arguments to namazu.
+The switches `-q', `-a', and `-s' are always used, very few other switches
+make any sense in this context.
+
+Note that this should be a list. I.e., do NOT use the following:
+ (setq gnus-search-namazu-switches \"-i -w\") ; wrong
+Instead, use this:
+ (setq gnus-search-namazu-switches \\='(\"-i\" \"-w\"))
+
+This variable can also be set per-server."
+ :type '(repeat string)
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-namazu-remove-prefix (concat (getenv "HOME") "/Mail/")
+ "The prefix to remove from each file name returned by Namazu
+in order to get a group name (albeit with / instead of .).
+
+For example, suppose that Namazu returns file names such as
+\"/home/john/Mail/mail/misc/42\". For this example, use the following
+setting: (setq gnus-search-namazu-remove-prefix \"/home/john/Mail/\")
+Note the trailing slash. Removing this prefix gives \"mail/misc/42\".
+Gnus knows to remove the \"/42\" and to replace \"/\" with \".\" to
+arrive at the correct group name, \"mail.misc\".
+
+This variable can also be set per-server."
+ :type 'directory
+ :version "28.1"
+ :group 'gnus-search)
+
+(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)
+
+(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)
+
+(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)
+
+(defcustom gnus-search-notmuch-switches '()
+ "A list of strings, to be given as additional arguments to notmuch.
+Note that this should be a list. I.e., do NOT use the following:
+ (setq gnus-search-notmuch-switches \"-i -w\") ; wrong
+Instead, use this:
+ (setq gnus-search-notmuch-switches \\='(\"-i\" \"-w\"))
+
+This variable can also be set per-server."
+ :type '(repeat string)
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-notmuch-remove-prefix (concat (getenv "HOME") "/Mail/")
+ "The prefix to remove from each file name returned by notmuch
+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
+ :version "28.1"
+ :group 'gnus-search)
+
+(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)
+
+(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)
+
+(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)
+
+(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)
+
+(defcustom gnus-search-mairix-switches '()
+ "A list of strings, to be given as additional arguments to mairix.
+Note that this should be a list. I.e., do NOT use the following:
+ (setq gnus-search-mairix-switches \"-i -w\") ; wrong
+Instead, use this:
+ (setq gnu-search-mairix-switches \\='(\"-i\" \"-w\"))
+
+This variable can also be set per-server."
+ :version "28.1"
+ :type '(repeat string)
+ :group 'gnus-search)
+
+(defcustom gnus-search-mairix-remove-prefix (concat (getenv "HOME") "/Mail/")
+ "The prefix to remove from each file name returned by mairix
+in order to get a group name (albeit with / instead of .). This is a
+regular expression.
+
+This variable can also be set per-server."
+ :version "28.1"
+ :type 'regexp
+ :group 'gnus-search)
+
+(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)
+
+;; Options for search language parsing.
+
+(defcustom gnus-search-expandable-keys
+ '("from" "subject" "to" "cc" "bcc" "body" "recipient" "date"
+ "mark" "before" "after" "larger" "smaller" "attachment" "text"
+ "since" "thread" "sender" "address" "tag" "size" "grep" "limit"
+ "raw" "message-id" "id")
+ "A list of strings representing expandable search keys.
+\"Expandable\" simply means the key can be abbreviated while
+typing in search queries, ie \"subject\" could be entered as
+\"subj\" or even \"su\", though \"s\" is ambigous between
+\"subject\" and \"since\".
+
+Ambiguous abbreviations will raise an error."
+ :group 'gnus-search
+ :version "28.1"
+ :type '(repeat string))
+
+(defcustom gnus-search-date-keys
+ '("date" "before" "after" "on" "senton" "sentbefore" "sentsince" "since")
+ "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))
+
+(defcustom gnus-search-contact-tables '()
+ "A list of completion tables used to search for messages from contacts.
+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))
+
+;;; Search language
+
+;; This "language" was generalized from the original IMAP search query
+;; parsing routine.
+
+(defun gnus-search-parse-query (string)
+ "Turn STRING into an s-expression based query.
+The resulting query structure is passed to the various search
+backends, each of which adapts it as needed.
+
+The search \"language\" is essentially a series of key:value
+expressions. Key is most often a mail header, but there are
+other keys. Value is a string, quoted if it contains spaces.
+Key and value are separated by a colon, no space. Expressions
+are implictly ANDed; the \"or\" keyword can be used to
+OR. \"not\" will negate the following expression, or keys can be
+prefixed with a \"-\". The \"near\" operator will work for
+engines that understand it; other engines will convert it to
+\"or\". Parenthetical groups work as expected.
+
+A key that matches the name of a mail header will search that
+header.
+
+Search keys can be expanded with TAB during entry, or left
+abbreviated so long as they remain unambiguous, ie \"f\" will
+search the \"from\" header. \"s\" will raise an error.
+
+Other keys:
+
+\"address\" will search all sender and recipient headers.
+
+\"recipient\" will search \"To\", \"Cc\", and \"Bcc\".
+
+\"before\" will search messages sent before the specified
+date (date specifications to come later). Date is exclusive.
+
+\"after\" (or its synonym \"since\") will search messages sent
+after the specified date. Date is inclusive.
+
+\"mark\" will search messages that have some sort of mark.
+Likely values include \"flag\", \"seen\", \"read\", \"replied\".
+It's also possible to use Gnus' internal marks, ie \"mark:R\"
+will be interpreted as mark:read.
+
+\"tag\" will search tags -- right now that's translated to
+\"keyword\" in IMAP, and left as \"tag\" for notmuch. At some
+point this should also be used to search marks in the Gnus
+registry.
+
+Other keys can be specified, provided that the search backends
+know how to interpret them.
+
+External contact-management packages can push completion tables
+onto the list variable `gnus-search-contact-tables', to provide
+auto-completion of contact names and addresses for keys like
+\"from\" and \"to\".
+
+Date values (any key in `gnus-search-date-keys') can be provided
+in any format that `parse-time-string' can parse (note that this
+can produce weird results). Dates with missing bits will be
+interpreted as the most recent occurance thereof (ie \"march 03\"
+is the most recent March 3rd). Lastly, relative specifications
+such as 1d (one day ago) are understood. This also accepts w, m,
+and y. m is assumed to be 30 days.
+
+This function will accept pretty much anything as input. Its
+only job is to parse the query into a sexp, and pass that on --
+it is the job of the search backends to make sense of the
+structured query. Malformed, unusable or invalid queries will
+typically be silently ignored."
+ (with-temp-buffer
+ ;; Set up the parsing environment.
+ (insert string)
+ (goto-char (point-min))
+ ;; Now, collect the output terms and return them.
+ (let (out)
+ (while (not (gnus-search-query-end-of-input))
+ (push (gnus-search-query-next-expr) out))
+ (reverse out))))
+
+(defun gnus-search-query-next-expr (&optional count halt)
+ "Return the next expression from the current buffer."
+ (let ((term (gnus-search-query-next-term count))
+ (next (gnus-search-query-peek-symbol)))
+ ;; Deal with top-level expressions. And, or, not, near... What
+ ;; else? Notmuch also provides xor and adj. It also provides a
+ ;; "nearness" parameter for near and adj.
+ (cond
+ ;; Handle 'expr or expr'
+ ((and (eq next 'or)
+ (null halt))
+ (list 'or term (gnus-search-query-next-expr 2)))
+ ;; Handle 'near operator.
+ ((eq next 'near)
+ (let ((near-next (gnus-search-query-next-expr 2)))
+ (if (and (stringp term)
+ (stringp near-next))
+ (list 'near term near-next)
+ (signal 'gnus-search-parse-error
+ (list "\"Near\" keyword must appear between two plain strings.")))))
+ ;; Anything else
+ (t term))))
+
+(defun gnus-search-query-next-term (&optional count)
+ "Return the next TERM from the current buffer."
+ (let ((term (gnus-search-query-next-symbol count)))
+ ;; What sort of term is this?
+ (cond
+ ;; negated term
+ ((eq term 'not) (list 'not (gnus-search-query-next-expr nil 'halt)))
+ ;; generic term
+ (t term))))
+
+(defun gnus-search-query-peek-symbol ()
+ "Return the next symbol from the current buffer, but don't consume it."
+ (save-excursion
+ (gnus-search-query-next-symbol)))
+
+(defun gnus-search-query-next-symbol (&optional count)
+ "Return the next symbol from the current buffer, or nil if we are
+at the end of the buffer. If supplied COUNT skips some symbols before
+returning the one at the supplied position."
+ (when (and (numberp count) (> count 1))
+ (gnus-search-query-next-symbol (1- count)))
+ (let ((case-fold-search t))
+ ;; end of input stream?
+ (unless (gnus-search-query-end-of-input)
+ ;; No, return the next symbol from the stream.
+ (cond
+ ;; Negated expression -- return it and advance one char.
+ ((looking-at "-") (forward-char 1) 'not)
+ ;; List expression -- we parse the content and return this as a list.
+ ((looking-at "(")
+ (gnus-search-parse-query (gnus-search-query-return-string ")" t)))
+ ;; Keyword input -- return a symbol version.
+ ((looking-at "\\band\\b") (forward-char 3) 'and)
+ ((looking-at "\\bor\\b") (forward-char 2) 'or)
+ ((looking-at "\\bnot\\b") (forward-char 3) 'not)
+ ((looking-at "\\bnear\\b") (forward-char 4) 'near)
+ ;; Plain string, no keyword
+ ((looking-at "[\"/]?\\b[^:]+\\([[:blank:]]\\|\\'\\)")
+ (gnus-search-query-return-string
+ (when (looking-at-p "[\"/]") t)))
+ ;; Assume a K:V expression.
+ (t (let ((key (gnus-search-query-expand-key
+ (buffer-substring
+ (point)
+ (progn
+ (re-search-forward ":" (point-at-eol) t)
+ (1- (point))))))
+ (value (gnus-search-query-return-string
+ (when (looking-at-p "[\"/]") t))))
+ (gnus-search-query-parse-kv key value)))))))
+
+(defun gnus-search-query-parse-kv (key value)
+ "Handle KEY and VALUE, parsing and expanding as necessary.
+This may result in (key value) being turned into a larger query
+structure.
+
+In the simplest case, they are simply consed together. String
+KEY is converted to a symbol."
+ (let (return)
+ (cond
+ ((member key gnus-search-date-keys)
+ (when (string= "after" key)
+ (setq key "since"))
+ (setq value (gnus-search-query-parse-date value)))
+ ((equal key "mark")
+ (setq value (gnus-search-query-parse-mark value)))
+ ((string= "message-id" key)
+ (setq key "id")))
+ (or return
+ (cons (intern key) value))))
+
+(defun gnus-search-query-parse-date (value &optional rel-date)
+ "Interpret VALUE as a date specification.
+See the docstring of `gnus-search-parse-query' for details.
+
+The result is a list of (dd mm yyyy); individual elements can be
+nil.
+
+If VALUE is a relative time, interpret it as relative to
+REL-DATE, or (current-time) if REL-DATE is nil."
+ ;; Time parsing doesn't seem to work with slashes.
+ (let ((value (replace-regexp-in-string "/" "-" value))
+ (now (append '(0 0 0)
+ (seq-subseq (decode-time (or rel-date
+ (current-time)))
+ 3))))
+ ;; Check for relative time parsing.
+ (if (string-match "\\([[:digit:]]+\\)\\([dwmy]\\)" value)
+ (seq-subseq
+ (decode-time
+ (time-subtract
+ (apply #'encode-time now)
+ (days-to-time
+ (* (string-to-number (match-string 1 value))
+ (cdr (assoc (match-string 2 value)
+ '(("d" . 1)
+ ("w" . 7)
+ ("m" . 30)
+ ("y" . 365))))))))
+ 3 6)
+ ;; Otherwise check the value of `parse-time-string'.
+
+ ;; (SEC MIN HOUR DAY MON YEAR DOW DST TZ)
+ (let ((d-time (parse-time-string value)))
+ ;; Did parsing produce anything at all?
+ (if (seq-some #'integerp (seq-subseq d-time 3 7))
+ (seq-subseq
+ ;; If DOW is given, handle that specially.
+ (if (and (seq-elt d-time 6) (null (seq-elt d-time 3)))
+ (decode-time
+ (time-subtract (apply #'encode-time now)
+ (days-to-time
+ (+ (if (> (seq-elt d-time 6)
+ (seq-elt now 6))
+ 7 0)
+ (- (seq-elt now 6) (seq-elt d-time 6))))))
+ d-time)
+ 3 6)
+ ;; `parse-time-string' failed to produce anything, just
+ ;; return the string.
+ value)))))
+
+(defun gnus-search-query-parse-mark (mark)
+ "Possibly transform MARK.
+If MARK is a single character, assume it is one of the
+gnus-*-mark marks, and return an appropriate string."
+ (if (= 1 (length mark))
+ (let ((m (aref mark 0)))
+ ;; Neither pcase nor cl-case will work here.
+ (cond
+ ((eql m gnus-ticked-mark) "flag")
+ ((eql m gnus-read-mark) "read")
+ ((eql m gnus-replied-mark) "replied")
+ ((eql m gnus-recent-mark) "recent")
+ (t mark)))
+ mark))
+
+(defun gnus-search-query-expand-key (key)
+ (cond ((test-completion key gnus-search-expandable-keys)
+ ;; We're done!
+ key)
+ ;; There is more than one possible completion.
+ ((consp (cdr (completion-all-completions
+ key gnus-search-expandable-keys #'stringp 0)))
+ (signal 'gnus-search-parse-error
+ (list (format "Ambiguous keyword: %s" key))))
+ ;; Return KEY, either completed or untouched.
+ ((car-safe (completion-try-completion
+ key gnus-search-expandable-keys
+ #'stringp 0)))))
+
+(defun gnus-search-query-return-string (&optional delimited trim)
+ "Return a string from the current buffer.
+If DELIMITED is non-nil, assume the next character is a delimiter
+character, and return everything between point and the next
+occurance of the delimiter, including the delimiters themselves.
+If TRIM is non-nil, do not return the delimiters. Otherwise,
+return one word."
+ ;; This function cannot handle nested delimiters, as it's not a
+ ;; proper parser. Ie, you cannot parse "to:bob or (from:bob or
+ ;; (cc:bob or bcc:bob))".
+ (let ((start (point))
+ (delimiter (if (stringp delimited)
+ delimited
+ (when delimited
+ (char-to-string (char-after)))))
+ end)
+ (if delimiter
+ (progn
+ (when trim
+ ;; Skip past first delimiter if we're trimming.
+ (forward-char 1))
+ (while (not end)
+ (unless (search-forward delimiter nil t (unless trim 2))
+ (signal 'gnus-search-parse-error
+ (list (format "Unmatched delimited input with %s in query" delimiter))))
+ (let ((here (point)))
+ (unless (equal (buffer-substring (- here 2) (- here 1)) "\\")
+ (setq end (if trim (1- (point)) (point))
+ start (if trim (1+ start) start))))))
+ (setq end (progn (re-search-forward "\\([[:blank:]]+\\|$\\)" (point-max) t)
+ (match-beginning 0))))
+ (buffer-substring-no-properties start end)))
+
+(defun gnus-search-query-end-of-input ()
+ "Are we at the end of input?"
+ (skip-chars-forward "[:blank:]")
+ (looking-at "$"))
+
+;;; Search engines
+
+;; Search engines are implemented as classes. This is good for two
+;; things: encapsulating things like indexes and search prefixes, and
+;; transforming search queries.
+
+(defclass gnus-search-engine ()
+ ((raw-queries-p
+ :initarg :raw-queries-p
+ :initform nil
+ :type boolean
+ :custom boolean
+ :documentation
+ "When t, searches through this engine will never be parsed or
+ transformed, and must be entered \"raw\"."))
+ :abstract t
+ :documentation "Abstract base class for Gnus search engines.")
+
+(defclass gnus-search-grep ()
+ ((grep-program
+ :initarg :grep-program
+ :initform "grep"
+ :type string
+ :documentation "Grep executable to use for second-pass grep
+ searches.")
+ (grep-options
+ :initarg :grep-options
+ :initform nil
+ :type list
+ :documentation "Additional options, in the form of a list,
+ passed to the second-pass grep search, when present."))
+ :abstract t
+ :documentation "An abstract mixin class that can be added to
+ local-filesystem search engines, providing an additional grep:
+ search key. After the base engine returns a list of search
+ results (as local filenames), an external grep process is used
+ to further filter the results.")
+
+(cl-defgeneric gnus-search-grep-search (engine artlist criteria)
+ "Run a secondary grep search over a list of preliminary results.
+
+ARTLIST is a list of (filename score) pairs, produced by one of
+the other search engines. CRITERIA is a grep-specific search
+key. This method uses an external grep program to further filter
+the files in ARTLIST by that search key.")
+
+(cl-defmethod gnus-search-grep-search ((engine gnus-search-grep)
+ artlist criteria)
+ (with-slots (grep-program grep-options) engine
+ (if (executable-find grep-program)
+ ;; Don't catch errors -- allow them to propagate.
+ (let ((matched-files
+ (apply
+ #'process-lines
+ grep-program
+ `("-l" ,@grep-options
+ "-e" ,(shell-quote-argument criteria)
+ ,@(mapcar #'car artlist)))))
+ (seq-filter (lambda (a) (member (car a) matched-files))
+ artlist))
+ (nnheader-report 'search "invalid grep program: %s" grep-program))))
+
+(defclass gnus-search-process ()
+ ((proc-buffer
+ :initarg :proc-buffer
+ :type buffer
+ :documentation "A temporary buffer this engine uses for its
+ search process, and for munging its search results."))
+ :abstract t
+ :documentation
+ "A mixin class for engines that do their searching in a single
+ process launched for this purpose, which returns at the end of
+ the search. Subclass instances are safe to be run in
+ threads.")
+
+(cl-defmethod shared-initialize ((engine gnus-search-process)
+ slots)
+ (setq slots (plist-put slots :proc-buffer
+ (generate-new-buffer " *gnus-search-")))
+ (cl-call-next-method engine slots))
+
+(defclass gnus-search-imap (gnus-search-engine)
+ ((literal-plus
+ :initarg :literal-plus
+ :initform nil
+ :type boolean
+ :documentation
+ "Can this search engine handle literal+ searches? This slot
+ is set automatically by the imap server, and cannot be
+ set manually. Only the LITERAL+ capability is handled.")
+ (multisearch
+ :initarg :multisearch
+ :initform nil
+ :type boolean
+ :documentation
+ "Can this search engine handle the MULTISEARCH capability?
+ This slot is set automatically by the imap server, and cannot
+ be set manually. Currently unimplemented.")
+ (fuzzy
+ :initarg :fuzzy
+ :initform nil
+ :type boolean
+ :documentation
+ "Can this search engine handle the FUZZY search capability?
+ This slot is set automatically by the imap server, and cannot
+ be set manually. Currently only partially implemented.")
+ (raw-queries-p
+ :initform (symbol-value 'gnus-search-imap-raw-queries-p)))
+ :documentation
+ "The base IMAP search engine, using an IMAP server's search capabilites.
+This backend may be subclassed to handle particular IMAP servers'
+quirks.")
+
+(defclass gnus-search-find-grep (gnus-search-engine
+ gnus-search-process
+ gnus-search-grep)
+ nil)
+
+;;; The "indexed" search engine.
+
+;; These are engines that use an external program, with indexes kept
+;; on disk, to search messages usually kept in some local directory.
+;; They have several slots in common, for instance program name or
+;; configuration file. Many of the subclasses also allow
+;; distinguishing multiple databases or indexes. These slots can be
+;; set using a global default, or on a per-server basis.
+
+(defclass gnus-search-indexed (gnus-search-engine
+ gnus-search-process
+ gnus-search-grep)
+ ((program
+ :initarg :program
+ :type string
+ :documentation
+ "The executable used for indexing and searching.")
+ (config-file
+ :init-arg :config-file
+ :type string
+ :custom file
+ :documentation "Location of the config file, if any.")
+ (remove-prefix
+ :initarg :remove-prefix
+ :initform (concat (getenv "HOME") "/Mail/")
+ :type string
+ :documentation
+ "The path to the directory where the indexed mails are
+ kept. This path is removed from the search results.")
+ (switches
+ :initarg :switches
+ :type list
+ :documentation
+ "Additional switches passed to the search engine command-line
+ program."))
+ :abstract t
+ :allow-nil-initform t
+ :documentation "A base search engine class that assumes a local search index
+ accessed by a command line program.")
+
+(defclass gnus-search-swish-e (gnus-search-indexed)
+ ((index-files
+ :init-arg :index-files
+ :initform (symbol-value 'gnus-search-swish-e-index-files)
+ :type list)
+ (program
+ :initform (symbol-value 'gnus-search-swish-e-program))
+ (remove-prefix
+ :initform (symbol-value 'gnus-search-swish-e-remove-prefix))
+ (switches
+ :initform (symbol-value 'gnus-search-swish-e-switches))
+ (raw-queries-p
+ :initform (symbol-value 'gnus-search-swish-e-raw-queries-p))))
+
+(defclass gnus-search-swish++ (gnus-search-indexed)
+ ((program
+ :initform (symbol-value 'gnus-search-swish++-program))
+ (remove-prefix
+ :initform (symbol-value 'gnus-search-swish++-remove-prefix))
+ (switches
+ :initform (symbol-value 'gnus-search-swish++-switches))
+ (config-file
+ :initform (symbol-value 'gnus-search-swish++-config-file))
+ (raw-queries-p
+ :initform (symbol-value 'gnus-search-swish++-raw-queries-p))))
+
+(defclass gnus-search-mairix (gnus-search-indexed)
+ ((program
+ :initform (symbol-value 'gnus-search-mairix-program))
+ (remove-prefix
+ :initform (symbol-value 'gnus-search-mairix-remove-prefix))
+ (switches
+ :initform (symbol-value 'gnus-search-mairix-switches))
+ (config-file
+ :initform (symbol-value 'gnus-search-mairix-config-file))
+ (raw-queries-p
+ :initform (symbol-value 'gnus-search-mairix-raw-queries-p))))
+
+(defclass gnus-search-namazu (gnus-search-indexed)
+ ((index-directory
+ :initarg :index-directory
+ :type string
+ :custom directory)
+ (program
+ :initform (symbol-value 'gnus-search-namazu-program))
+ (remove-prefix
+ :initform (symbol-value 'gnus-search-namazu-remove-prefix))
+ (switches
+ :initform (symbol-value 'gnus-search-namazu-switches))
+ (raw-queries-p
+ :initform (symbol-value 'gnus-search-namazu-raw-queries-p))))
+
+(defclass gnus-search-notmuch (gnus-search-indexed)
+ ((program
+ :initform (symbol-value 'gnus-search-notmuch-program))
+ (remove-prefix
+ :initform (symbol-value 'gnus-search-notmuch-remove-prefix))
+ (switches
+ :initform (symbol-value 'gnus-search-notmuch-switches))
+ (config-file
+ :initform (symbol-value 'gnus-search-notmuch-config-file))
+ (raw-queries-p
+ :initform (symbol-value 'gnus-search-notmuch-raw-queries-p))))
+
+(define-obsolete-variable-alias 'nnir-method-default-engines
+ 'gnus-search-default-engines "28.1")
+
+(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)
+ (const nnfolder) (const nnmaildir))
+ (choice
+ ,@(mapcar
+ (lambda (el) (list 'const (intern (car el))))
+ (eieio-build-class-alist 'gnus-search-engine t))))))
+
+;;; Transforming and running search queries.
+
+(cl-defgeneric gnus-search-run-search (engine server query groups)
+ "Run QUERY in GROUPS against SERVER, using search ENGINE.
+Should return results as a vector of vectors.")
+
+(cl-defgeneric gnus-search-transform (engine expression)
+ "Transform sexp EXPRESSION into a string search query usable by ENGINE.
+Responsible for handling and, or, and parenthetical expressions.")
+
+(cl-defgeneric gnus-search-transform-expression (engine expression)
+ "Transform a basic EXPRESSION into a string usable by ENGINE.")
+
+(cl-defgeneric gnus-search-make-query-string (engine query-spec)
+ "Extract the actual query string to use from QUERY-SPEC.")
+
+;; Methods that are likely to be the same for all engines.
+
+(cl-defmethod gnus-search-make-query-string ((engine gnus-search-engine)
+ query-spec)
+ (let ((parsed-query (alist-get 'parsed-query query-spec))
+ (raw-query (alist-get 'query query-spec)))
+ (if (and gnus-search-use-parsed-queries
+ (null (alist-get 'raw query-spec))
+ (null (slot-value engine 'raw-queries-p))
+ parsed-query)
+ (gnus-search-transform engine parsed-query)
+ (if (listp raw-query)
+ ;; Some callers are sending this in as (query "query"), not
+ ;; as a cons cell?
+ (car raw-query)
+ raw-query))))
+
+(defsubst gnus-search-single-p (query)
+ "Return t if QUERY is a search for a single message."
+ (let ((q (alist-get 'parsed-query query)))
+ (and (= (length q ) 1)
+ (consp (car-safe q))
+ (eq (caar q) 'id))))
+
+(cl-defmethod gnus-search-transform ((engine gnus-search-engine)
+ (query list))
+ (let (clauses)
+ (mapc
+ (lambda (item)
+ (when-let ((expr (gnus-search-transform-expression engine item)))
+ (push expr clauses)))
+ query)
+ (mapconcat #'identity (reverse clauses) " ")))
+
+;; Most search engines just pass through plain strings.
+(cl-defmethod gnus-search-transform-expression ((_ gnus-search-engine)
+ (expr string))
+ expr)
+
+;; Most search engines use implicit ANDs.
+(cl-defmethod gnus-search-transform-expression ((_ gnus-search-engine)
+ (_expr (eql and)))
+ nil)
+
+;; Most search engines use explicit infixed ORs.
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-engine)
+ (expr (head or)))
+ (let ((left (gnus-search-transform-expression engine (nth 1 expr)))
+ (right (gnus-search-transform-expression engine (nth 2 expr))))
+ ;; Unhandled keywords return a nil; don't create an "or" expression
+ ;; unless both sub-expressions are non-nil.
+ (if (and left right)
+ (format "%s or %s" left right)
+ (or left right))))
+
+;; Most search engines just use the string "not"
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-engine)
+ (expr (head not)))
+ (let ((next (gnus-search-transform-expression engine (cadr expr))))
+ (when next
+ (format "not %s" next))))
+
+;;; Search Engine Interfaces:
+
+(autoload 'nnimap-change-group "nnimap")
+(declare-function nnimap-buffer "nnimap" ())
+(declare-function nnimap-command "nnimap" (&rest args))
+
+(defvar gnus-search-imap-search-keys
+ '(body cc bcc from header keyword larger smaller subject text to uid x-gm-raw
+ answered before deleted draft flagged on since recent seen sentbefore
+ senton sentsince unanswered undeleted undraft unflagged unkeyword
+ unseen all old new or not)
+ "Known IMAP search keys.")
+
+;; imap interface
+(cl-defmethod gnus-search-run-search ((engine gnus-search-imap)
+ srv query groups)
+ (save-excursion
+ (let ((server (cadr (gnus-server-to-method srv)))
+ (gnus-inhibit-demon t)
+ ;; We're using the message id to look for a single message.
+ (single-search (gnus-search-single-p query))
+ (grouplist (or groups (gnus-search-get-active srv)))
+ q-string artlist group)
+ (message "Opening server %s" server)
+ (gnus-open-server srv)
+ ;; We should only be doing this once, in
+ ;; `nnimap-open-connection', but it's too frustrating to try to
+ ;; get to the server from the process buffer.
+ (with-current-buffer (nnimap-buffer)
+ (setf (slot-value engine 'literal-plus)
+ (when (nnimap-capability "LITERAL+") t))
+ ;; MULTISEARCH not yet implemented.
+ (setf (slot-value engine 'multisearch)
+ (when (nnimap-capability "MULTISEARCH") t))
+ ;; FUZZY only partially supported: the command is sent to the
+ ;; server (and presumably acted upon), but we don't yet
+ ;; request a RELEVANCY score as part of the response.
+ (setf (slot-value engine 'fuzzy)
+ (when (nnimap-capability "SEARCH=FUZZY") t)))
+
+ (setq q-string
+ (gnus-search-make-query-string engine query))
+
+ ;; A bit of backward-compatibility slash convenience: if the
+ ;; query string doesn't start with any known IMAP search
+ ;; keyword, assume it is a "TEXT" search.
+ (unless (or (looking-at "(")
+ (and (string-match "\\`[^[:blank:]]+" q-string)
+ (memql (intern-soft (downcase
+ (match-string 0 q-string)))
+ gnus-search-imap-search-keys)))
+ (setq q-string (concat "TEXT " q-string)))
+
+ ;; If it's a thread query, make sure that all message-id
+ ;; searches are also references searches.
+ (when (alist-get 'thread query)
+ (setq q-string
+ (replace-regexp-in-string
+ "HEADER Message-Id \\([^ )]+\\)"
+ "(OR HEADER Message-Id \\1 HEADER References \\1)"
+ q-string)))
+
+ (while (and (setq group (pop grouplist))
+ (or (null single-search) (null artlist)))
+ (when (nnimap-change-group
+ (gnus-group-short-name group) server)
+ (with-current-buffer (nnimap-buffer)
+ (message "Searching %s..." group)
+ (let ((result
+ (gnus-search-imap-search-command engine q-string)))
+ (when (car result)
+ (setq artlist
+ (vconcat
+ (mapcar
+ (lambda (artnum)
+ (let ((artn (string-to-number artnum)))
+ (when (> artn 0)
+ (vector group artn 100))))
+ (cdr (assoc "SEARCH" (cdr result))))
+ artlist))))
+ (message "Searching %s...done" group))))
+ (nreverse artlist))))
+
+(cl-defmethod gnus-search-imap-search-command ((engine gnus-search-imap)
+ (query string))
+ "Create the IMAP search command for QUERY.
+Currenly takes into account support for the LITERAL+ capability.
+Other capabilities could be tested here."
+ (with-slots (literal-plus) engine
+ (when literal-plus
+ (setq query (split-string query "\n")))
+ (cond
+ ((consp query)
+ ;; We're not really streaming, just need to prevent
+ ;; `nnimap-send-command' from waiting for a response.
+ (let* ((nnimap-streaming t)
+ (call
+ (nnimap-send-command
+ "UID SEARCH CHARSET UTF-8 %s"
+ (pop query))))
+ (dolist (l query)
+ (process-send-string (get-buffer-process (current-buffer)) l)
+ (process-send-string (get-buffer-process (current-buffer))
+ (if (nnimap-newlinep nnimap-object)
+ "\n"
+ "\r\n")))
+ (nnimap-get-response call)))
+ (t (nnimap-command "UID SEARCH %s" query)))))
+
+(cl-defmethod gnus-search-transform ((_ gnus-search-imap)
+ (_query null))
+ "ALL")
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-imap)
+ (expr string))
+ (unless (string-match-p "\\`/.+/\\'" expr)
+ ;; Also need to check for fuzzy here. Or better, do some
+ ;; refactoring of this stuff.
+ (format "TEXT %s"
+ (gnus-search-imap-handle-string engine expr))))
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-imap)
+ (expr (head or)))
+ (let ((left (gnus-search-transform-expression engine (nth 1 expr)))
+ (right (gnus-search-transform-expression engine (nth 2 expr))))
+ (if (and left right)
+ (format "(OR %s %s)"
+ left (format (if (eq 'or (car-safe (nth 2 expr)))
+ "(%s)" "%s")
+ right))
+ (or left right))))
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-imap)
+ (expr (head near)))
+ "Imap searches interpret \"near\" as \"or\"."
+ (setcar expr 'or)
+ (gnus-search-transform-expression engine expr))
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-imap)
+ (expr (head not)))
+ "Transform IMAP NOT.
+If the term to be negated is a flag, then use the appropriate UN*
+boolean instead."
+ (if (eql (caadr expr) 'mark)
+ (if (string= (cdadr expr) "new")
+ "OLD"
+ (format "UN%s" (gnus-search-imap-handle-flag (cdadr expr))))
+ (format "NOT %s"
+ (gnus-search-transform-expression engine (cadr expr)))))
+
+(cl-defmethod gnus-search-transform-expression ((_ gnus-search-imap)
+ (expr (head mark)))
+ (gnus-search-imap-handle-flag (cdr expr)))
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-imap)
+ (expr list))
+ "Handle a search keyword for IMAP.
+All IMAP search keywords that take a value are supported
+directly. Keywords that are boolean are supported through other
+means (usually the \"mark\" keyword)."
+ (let ((fuzzy-supported (slot-value engine 'fuzzy))
+ (fuzzy ""))
+ (cl-case (car expr)
+ (date (setcar expr 'on))
+ (tag (setcar expr 'keyword))
+ (sender (setcar expr 'from))
+ (attachment (setcar expr 'body)))
+ ;; Allow sizes specified as KB or MB.
+ (let ((case-fold-search t)
+ unit)
+ (when (and (memq (car expr) '(larger smaller))
+ (string-match "\\(kb?\\|mb?\\)\\'" (cdr expr)))
+ (setq unit (match-string 1 (cdr expr)))
+ (setcdr expr
+ (number-to-string
+ (* (string-to-number
+ (string-replace unit "" (cdr expr)))
+ (if (string-prefix-p "k" unit)
+ 1024
+ 1048576))))))
+ (cond
+ ((consp (car expr))
+ (format "(%s)" (gnus-search-transform engine expr)))
+ ((eq (car expr) 'recipient)
+ (gnus-search-transform
+ engine (gnus-search-parse-query
+ (format
+ "to:%s or cc:%s or bcc:%s"
+ (cdr expr) (cdr expr) (cdr expr)))))
+ ((eq (car expr) 'address)
+ (gnus-search-transform
+ engine (gnus-search-parse-query
+ (format
+ "from:%s or to:%s or cc:%s or bcc:%s"
+ (cdr expr) (cdr expr) (cdr expr) (cdr expr)))))
+ ((memq (car expr) '(before since on sentbefore senton sentsince))
+ ;; Ignore dates given as strings.
+ (when (listp (cdr expr))
+ (format "%s %s"
+ (upcase (symbol-name (car expr)))
+ (gnus-search-imap-handle-date engine (cdr expr)))))
+ ((stringp (cdr expr))
+ ;; If the search term starts or ends with "*", remove the
+ ;; asterisk. If the engine supports FUZZY, then additionally make
+ ;; the search fuzzy.
+ (when (string-match "\\`\\*\\|\\*\\'" (cdr expr))
+ (setcdr expr (replace-regexp-in-string
+ "\\`\\*\\|\\*\\'" "" (cdr expr)))
+ (when fuzzy-supported
+ (setq fuzzy "FUZZY ")))
+ ;; If the search term is a regexp, drop the expression altogether.
+ (unless (string-match-p "\\`/.+/\\'" (cdr expr))
+ (cond
+ ((memq (car expr) gnus-search-imap-search-keys)
+ (format "%s%s %s"
+ fuzzy
+ (upcase (symbol-name (car expr)))
+ (gnus-search-imap-handle-string engine (cdr expr))))
+ ((eq (car expr) 'id)
+ (format "HEADER Message-ID \"%s\"" (cdr expr)))
+ ;; Treat what can't be handled as a HEADER search. Probably a bad
+ ;; idea.
+ (t (format "%sHEADER %s %s"
+ fuzzy
+ (car expr)
+ (gnus-search-imap-handle-string engine (cdr expr))))))))))
+
+(cl-defmethod gnus-search-imap-handle-date ((_engine gnus-search-imap)
+ (date list))
+ "Turn DATE into a date string recognizable by IMAP.
+While other search engines can interpret partially-qualified
+dates such as a plain \"January\", IMAP requires an absolute
+date.
+
+DATE is a list of (dd mm yyyy), any element of which could be
+nil (except that (dd nil yyyy) is not allowed). Massage those
+numbers into the most recent past occurrence of whichever date
+elements are present."
+ (pcase-let ((`(,nday ,nmonth ,nyear)
+ (seq-subseq (decode-time (current-time))
+ 3 6))
+ (`(,dday ,dmonth ,dyear) date))
+ (unless (and dday dmonth dyear)
+ (unless dday (setq dday 1))
+ (if dyear
+ ;; If we have a year, then leave everything else as is or set
+ ;; to 1.
+ (setq dmonth (or dmonth 1))
+ (if dmonth
+ (setq dyear
+ (if (or (> dmonth nmonth)
+ (and (= dmonth nmonth)
+ (> dday nday)))
+ ;; If our day/month combo is ahead of "now",
+ ;; move the year back.
+ (1- nyear)
+ nyear))
+ (setq dmonth 1))))
+ (format-time-string
+ "%e-%b-%Y"
+ (apply #'encode-time
+ (append '(0 0 0)
+ (list dday dmonth dyear))))))
+
+(cl-defmethod gnus-search-imap-handle-string ((engine gnus-search-imap)
+ (str string))
+ (with-slots (literal-plus) engine
+ (if (multibyte-string-p str)
+ ;; If LITERAL+ is available, use it and encode string as
+ ;; UTF-8.
+ (if literal-plus
+ (format "{%d+}\n%s"
+ (string-bytes str)
+ (encode-coding-string str 'utf-8))
+ ;; Otherwise, if the user hasn't already quoted the string,
+ ;; quote it for them.
+ (if (string-prefix-p "\"" str)
+ str
+ (format "\"%s\"" str)))
+ str)))
+
+(defun gnus-search-imap-handle-flag (flag)
+ "Make sure string FLAG is something IMAP will recognize."
+ ;; What else? What about the KEYWORD search key?
+ (setq flag
+ (pcase flag
+ ("flag" "flagged")
+ ("read" "seen")
+ ("replied" "answered")
+ (_ flag)))
+ (if (member flag '("seen" "answered" "deleted" "draft" "flagged"))
+ (upcase flag)
+ ""))
+
+;;; Methods for the indexed search engines.
+
+;; First, some common methods.
+
+(cl-defgeneric gnus-search-indexed-parse-output (engine server &optional groups)
+ "Parse the results of ENGINE's query against SERVER in GROUPS.
+Locally-indexed search engines return results as a list of
+filenames, sometimes with additional information. Returns a list
+of viable results, in the form of a list of [group article score]
+vectors.")
+
+(cl-defgeneric gnus-search-indexed-extract (engine)
+ "Extract a single article result from the current buffer.
+Returns a list of two values: a file name, and a relevancy score.
+Advances point to the beginning of the next result.")
+
+(cl-defmethod gnus-search-run-search ((engine gnus-search-indexed)
+ server query groups)
+ "Run QUERY against SERVER using ENGINE.
+This method is common to all indexed search engines.
+
+Returns a list of [group article score] vectors."
+
+ (save-excursion
+ (let* ((qstring (gnus-search-make-query-string engine query))
+ (program (slot-value engine 'program))
+ (buffer (slot-value engine 'proc-buffer))
+ (cp-list (gnus-search-indexed-search-command
+ engine qstring query groups))
+ proc exitstatus)
+ (set-buffer buffer)
+ (erase-buffer)
+
+ (if groups
+ (message "Doing %s query on %s..." program groups)
+ (message "Doing %s query..." program))
+ (setq proc (apply #'start-process (format "search-%s" server)
+ buffer program cp-list))
+ (while (process-live-p proc)
+ (accept-process-output proc))
+ (setq exitstatus (process-exit-status proc))
+ (if (zerop exitstatus)
+ ;; The search results have been put into the current buffer;
+ ;; `parse-output' finds them there and returns the article
+ ;; list.
+ (gnus-search-indexed-parse-output engine server query groups)
+ (nnheader-report 'search "%s error: %s" program exitstatus)
+ ;; Failure reason is in this buffer, show it if the user
+ ;; wants it.
+ (when (> gnus-verbose 6)
+ (display-buffer buffer))
+ nil))))
+
+(cl-defmethod gnus-search-indexed-parse-output ((engine gnus-search-indexed)
+ server query &optional groups)
+ (let ((prefix (slot-value engine 'remove-prefix))
+ (group-regexp (when groups
+ (mapconcat
+ (lambda (x)
+ (replace-regexp-in-string
+ ;; Accept any of [.\/] as path separators.
+ "[.\\/]" "[.\\\\/]"
+ (gnus-group-real-name x)))
+ groups "\\|")))
+ artlist vectors article group)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (pcase-let ((`(,f-name ,score) (gnus-search-indexed-extract engine)))
+ (when (and (file-readable-p f-name)
+ (null (file-directory-p f-name))
+ (or (null groups)
+ (and (gnus-search-single-p query)
+ (alist-get 'thread query))
+ (string-match-p group-regexp f-name)))
+ (push (list f-name score) artlist))))
+ ;; Are we running an additional grep query?
+ (when-let ((grep-reg (alist-get 'grep query)))
+ (setq artlist (gnus-search-grep-search engine artlist grep-reg)))
+ ;; Prep prefix.
+ (when (and prefix (null (string-empty-p prefix)))
+ (setq prefix (file-name-as-directory (expand-file-name prefix))))
+ ;; Turn (file-name score) into [group article score].
+ (pcase-dolist (`(,f-name ,score) artlist)
+ (setq article (file-name-nondirectory f-name)
+ group (file-name-directory f-name))
+ ;; Remove prefix.
+ (when prefix
+ (setq group (string-remove-prefix prefix group)))
+ ;; Break the directory name down until it's something that
+ ;; (probably) can be used as a group name.
+ (setq group
+ (replace-regexp-in-string
+ "[/\\]" "."
+ (replace-regexp-in-string
+ "/?\\(cur\\|new\\|tmp\\)?/\\'" ""
+ (replace-regexp-in-string
+ "^[./\\]" ""
+ group nil t)
+ nil t)
+ nil t))
+
+ (push (vector (gnus-group-full-name group server)
+ (if (string-match-p "\\`[[:digit:]]+\\'" article)
+ (string-to-number article)
+ (nnmaildir-base-name-to-article-number
+ (substring article 0 (string-match ":" article))
+ group (string-remove-prefix "nnmaildir:" server)))
+ (if (numberp score)
+ score
+ (string-to-number score)))
+ vectors))
+ vectors))
+
+(cl-defmethod gnus-search-indexed-extract ((_engine gnus-search-indexed))
+ "Base implementation treats the whole line as a filename, and
+fudges a relevancy score of 100."
+ (prog1
+ (list (buffer-substring-no-properties (line-beginning-position)
+ (line-end-position))
+ 100)
+ (forward-line 1)))
+
+;; Swish++
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-swish++)
+ (expr (head near)))
+ (format "%s near %s"
+ (gnus-search-transform-expression engine (nth 1 expr))
+ (gnus-search-transform-expression engine (nth 2 expr))))
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-swish++)
+ (expr list))
+ (cond
+ ((listp (car expr))
+ (format "(%s)" (gnus-search-transform engine expr)))
+ ;; Untested and likely wrong.
+ ((and (stringp (cdr expr))
+ (string-prefix-p "(" (cdr expr)))
+ (format "%s = %s" (car expr) (gnus-search-transform
+ engine
+ (gnus-search-parse-query (cdr expr)))))
+ (t (format "%s = %s" (car expr) (cdr expr)))))
+
+(cl-defmethod gnus-search-indexed-search-command ((engine gnus-search-swish++)
+ (qstring string)
+ _query &optional _groups)
+ (with-slots (config-file switches) engine
+ `("--config-file" ,config-file
+ ,@switches
+ ,qstring
+ )))
+
+(cl-defmethod gnus-search-indexed-extract ((_engine gnus-search-swish++))
+ (when (re-search-forward
+ "\\(^[0-9]+\\) \\([^ ]+\\) [0-9]+ \\(.*\\)$" nil t)
+ (list (match-string 2)
+ (match-string 1))))
+
+;; Swish-e
+
+;; I didn't do the query transformation for Swish-e, because the
+;; program seems no longer to exist.
+
+(cl-defmethod gnus-search-indexed-search-command ((engine gnus-search-swish-e)
+ (qstring string)
+ _query &optional _groups)
+ (with-slots (index-files switches) engine
+ `("-f" ,@index-files
+ ,@switches
+ "-w"
+ ,qstring
+ )))
+
+(cl-defmethod gnus-search-indexed-extract ((_engine gnus-search-swish-e))
+ (when (re-search-forward
+ "\\(^[0-9]+\\) \\([^ ]+\\) \"\\([^\"]+\\)\" [0-9]+$" nil t)
+ (list (match-string 3)
+ (match-string 1))))
+
+;; Namazu interface
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-namazu)
+ (expr list))
+ (cond
+ ((listp (car expr))
+ (format "(%s)" (gnus-search-transform engine expr)))
+ ((eql (car expr) 'body)
+ (cadr expr))
+ ;; I have no idea which fields namazu can handle. Just do these
+ ;; for now.
+ ((memq (car expr) '(subject from to))
+ (format "+%s:%s" (car expr) (cdr expr)))
+ ((eql (car expr) 'address)
+ (gnus-search-transform engine `((or (from . ,(cdr expr))
+ (to . ,(cdr expr))))))
+ ((eq (car expr) 'id)
+ (format "+message-id:%s" (cdr expr)))
+ (t (ignore-errors (cl-call-next-method)))))
+
+;; I can't tell if this is actually necessary.
+(cl-defmethod gnus-search-run-search :around ((_e gnus-search-namazu)
+ _server _query _groups)
+ (let ((process-environment (copy-sequence process-environment)))
+ (setenv "LC_MESSAGES" "C")
+ (cl-call-next-method)))
+
+(cl-defmethod gnus-search-indexed-search-command ((engine gnus-search-namazu)
+ (qstring string)
+ query &optional _groups)
+ (let ((max (alist-get 'limit query)))
+ (with-slots (switches index-directory) engine
+ (append
+ (list "-q" ; don't be verbose
+ "-a" ; show all matches
+ "-s") ; use short format
+ (when max (list (format "--max=%d" max)))
+ switches
+ (list qstring index-directory)))))
+
+(cl-defmethod gnus-search-indexed-extract ((_engine gnus-search-namazu))
+ "Extract a single message result for Namazu.
+Namazu provides a little more information, for instance a score."
+
+ (when (re-search-forward
+ "^\\([0-9,]+\\.\\).*\\((score: \\([0-9]+\\)\\))\n\\([^ ]+\\)"
+ nil t)
+ (list (match-string 4)
+ (match-string 3))))
+
+;;; Notmuch interface
+
+(cl-defmethod gnus-search-transform ((_engine gnus-search-notmuch)
+ (_query null))
+ "*")
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-notmuch)
+ (expr (head near)))
+ (format "%s near %s"
+ (gnus-search-transform-expression engine (nth 1 expr))
+ (gnus-search-transform-expression engine (nth 2 expr))))
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-notmuch)
+ (expr list))
+ ;; Swap keywords as necessary.
+ (cl-case (car expr)
+ (sender (setcar expr 'from))
+ ;; Notmuch's "to" is already equivalent to our "recipient".
+ (recipient (setcar expr 'to))
+ (mark (setcar expr 'tag)))
+ ;; Then actually format the results.
+ (cl-flet ((notmuch-date (date)
+ (if (stringp date)
+ date
+ (pcase date
+ (`(nil ,m nil)
+ (nth (1- m) gnus-english-month-names))
+ (`(nil nil ,y)
+ (number-to-string y))
+ (`(,d ,m nil)
+ (format "%02d-%02d" d m))
+ (`(nil ,m ,y)
+ (format "%02d-%d" m y))
+ (`(,d ,m ,y)
+ (format "%d/%d/%d" m d y))))))
+ (cond
+ ((consp (car expr))
+ (format "(%s)" (gnus-search-transform engine expr)))
+ ((eql (car expr) 'address)
+ (gnus-search-transform engine `((or (from . ,(cdr expr))
+ (to . ,(cdr expr))))))
+ ((eql (car expr) 'body)
+ (cdr expr))
+ ((memq (car expr) '(from to subject attachment mimetype tag id
+ thread folder path lastmod query property))
+ ;; Notmuch requires message-id with no angle brackets.
+ (when (eql (car expr) 'id)
+ (setcdr
+ expr (replace-regexp-in-string "\\`<\\|>\\'" "" (cdr expr))))
+ (format "%s:%s" (car expr)
+ (if (string-match "\\`\\*" (cdr expr))
+ ;; Notmuch can only handle trailing asterisk
+ ;; wildcards, so strip leading asterisks.
+ (replace-match "" nil nil (cdr expr))
+ (cdr expr))))
+ ((eq (car expr) 'date)
+ (format "date:%s" (notmuch-date (cdr expr))))
+ ((eq (car expr) 'before)
+ (format "date:..%s" (notmuch-date (cdr expr))))
+ ((eq (car expr) 'since)
+ (format "date:%s.." (notmuch-date (cdr expr))))
+ (t (ignore-errors (cl-call-next-method))))))
+
+(cl-defmethod gnus-search-run-search :around ((engine gnus-search-notmuch)
+ server query groups)
+ "Handle notmuch's thread-search routine."
+ ;; Notmuch allows for searching threads, but only using its own
+ ;; thread ids. That means a thread search is a \"double-bounce\":
+ ;; once to find the relevant thread ids, and again to find the
+ ;; actual messages. This method performs the first \"bounce\".
+ (if (alist-get 'thread query)
+ (with-slots (program proc-buffer) engine
+ (let* ((qstring
+ (gnus-search-make-query-string engine query))
+ (cp-list (gnus-search-indexed-search-command
+ engine qstring query groups))
+ thread-ids proc)
+ (set-buffer proc-buffer)
+ (erase-buffer)
+ (setq proc (apply #'start-process (format "search-%s" server)
+ proc-buffer program cp-list))
+ (while (process-live-p proc)
+ (accept-process-output proc))
+ (while (re-search-forward "^thread:\\([^ ]+\\)" (point-max) t)
+ (push (match-string 1) thread-ids))
+ (cl-call-next-method
+ engine server
+ ;; Completely replace the query with our new thread-based one.
+ (mapconcat (lambda (thrd) (concat "thread:" thrd))
+ thread-ids " or ")
+ nil)))
+ (cl-call-next-method engine server query groups)))
+
+(cl-defmethod gnus-search-indexed-search-command ((engine gnus-search-notmuch)
+ (qstring string)
+ query &optional _groups)
+ ;; Theoretically we could use the GROUPS parameter to pass a
+ ;; --folder switch to notmuch, but I'm not confident of getting the
+ ;; format right.
+ (let ((limit (alist-get 'limit query))
+ (thread (alist-get 'thread query)))
+ (with-slots (switches config-file) engine
+ `(,(format "--config=%s" config-file)
+ "search"
+ ,(if thread
+ "--output=threads"
+ "--output=files")
+ "--duplicate=1" ; I have found this necessary, I don't know why.
+ ,@switches
+ ,(if limit (format "--limit=%d" limit) "")
+ ,qstring
+ ))))
+
+;;; Mairix interface
+
+;; See the Gnus manual for why mairix searching is a bit weird.
+
+(cl-defmethod gnus-search-transform ((engine gnus-search-mairix)
+ (query list))
+ "Transform QUERY for a Mairix engine.
+Because Mairix doesn't accept parenthesized expressions, nor
+\"or\" statements between different keys, results may differ from
+other engines. We unpeel parenthesized expressions, and just
+cross our fingers for the rest of it."
+ (let (clauses)
+ (mapc
+ (lambda (item)
+ (when-let ((expr (if (consp (car-safe item))
+ (gnus-search-transform engine item)
+ (gnus-search-transform-expression engine item))))
+ (push expr clauses)))
+ query)
+ (mapconcat #'identity (reverse clauses) " ")))
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-mairix)
+ (expr (head not)))
+ "Transform Mairix \"not\".
+Mairix negation requires a \"~\" preceding string search terms,
+and \"-\" before marks."
+ (let ((next (gnus-search-transform-expression engine (cadr expr))))
+ (replace-regexp-in-string
+ ":"
+ (if (eql (caadr expr) 'mark)
+ ":-"
+ ":~")
+ next)))
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-mairix)
+ (expr (head or)))
+ "Handle Mairix \"or\" statement.
+Mairix only accepts \"or\" expressions on homogenous keys. We
+cast \"or\" expressions on heterogenous keys as \"and\", which
+isn't quite right, but it's the best we can do. For date keys,
+only keep one of the terms."
+ (let ((term1 (caadr expr))
+ (term2 (caaddr expr))
+ (val1 (gnus-search-transform-expression engine (nth 1 expr)))
+ (val2 (gnus-search-transform-expression engine (nth 2 expr))))
+ (cond
+ ((or (listp term1) (listp term2))
+ (concat val1 " " val2))
+ ((and (member (symbol-name term1) gnus-search-date-keys)
+ (member (symbol-name term2) gnus-search-date-keys))
+ (or val1 val2))
+ ((eql term1 term2)
+ (if (and val1 val2)
+ (format "%s/%s"
+ val1
+ (nth 1 (split-string val2 ":")))
+ (or val1 val2)))
+ (t (concat val1 " " val2)))))
+
+
+(cl-defmethod gnus-search-transform-expression ((_ gnus-search-mairix)
+ (expr (head mark)))
+ (gnus-search-mairix-handle-mark (cdr expr)))
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-mairix)
+ (expr list))
+ (let ((key (cl-case (car expr)
+ (sender "f")
+ (from "f")
+ (to "t")
+ (cc "c")
+ (subject "s")
+ (id "m")
+ (body "b")
+ (address "a")
+ (recipient "tc")
+ (text "bs")
+ (attachment "n")
+ (t nil))))
+ (cond
+ ((consp (car expr))
+ (gnus-search-transform engine expr))
+ ((member (symbol-name (car expr)) gnus-search-date-keys)
+ (gnus-search-mairix-handle-date expr))
+ ((memq (car expr) '(size smaller larger))
+ (gnus-search-mairix-handle-size expr))
+ ;; Drop regular expressions.
+ ((string-match-p "\\`/" (cdr expr))
+ nil)
+ ;; Turn parenthesized phrases into multiple word terms. Again,
+ ;; this isn't quite what the user is asking for, but better to
+ ;; return false positives.
+ ((and key (string-match-p "[[:blank:]]" (cdr expr)))
+ (mapconcat
+ (lambda (s) (format "%s:%s" key s))
+ (split-string (gnus-search-mairix-treat-string
+ (cdr expr)))
+ " "))
+ (key (format "%s:%s" key
+ (gnus-search-mairix-treat-string
+ (cdr expr))))
+ (t nil))))
+
+(defun gnus-search-mairix-treat-string (str)
+ "Treat string for wildcards.
+Mairix accepts trailing wildcards, but not leading. Also remove
+double quotes."
+ (replace-regexp-in-string
+ "\\`\\*\\|\"" ""
+ (replace-regexp-in-string "\\*\\'" "=" str)))
+
+(defun gnus-search-mairix-handle-size (expr)
+ "Format a mairix size search.
+Assume \"size\" key is equal to \"larger\"."
+ (format
+ (if (eql (car expr) 'smaller)
+ "z:-%s"
+ "z:%s-")
+ (cdr expr)))
+
+(defun gnus-search-mairix-handle-mark (expr)
+ "Format a mairix mark search."
+ (let ((mark
+ (pcase (cdr expr)
+ ("flag" "f")
+ ("read" "s")
+ ("seen" "s")
+ ("replied" "r")
+ (_ nil))))
+ (when mark
+ (format "F:%s" mark))))
+
+(defun gnus-search-mairix-handle-date (expr)
+ (let ((str
+ (pcase (cdr expr)
+ (`(nil ,m nil)
+ (substring
+ (nth (1- m) gnus-english-month-names)
+ 0 3))
+ (`(nil nil ,y)
+ (number-to-string y))
+ (`(,d ,m nil)
+ (format "%s%02d"
+ (substring
+ (nth (1- m) gnus-english-month-names)
+ 0 3)
+ d))
+ (`(nil ,m ,y)
+ (format "%d%s"
+ y (substring
+ (nth (1- m) gnus-english-month-names)
+ 0 3)))
+ (`(,d ,m ,y)
+ (format "%d%02d%02d" y m d)))))
+ (format
+ (pcase (car expr)
+ ('date "d:%s")
+ ('since "d:%s-")
+ ('after "d:%s-")
+ ('before "d:-%s"))
+ str)))
+
+(cl-defmethod gnus-search-indexed-search-command ((engine gnus-search-mairix)
+ (qstring string)
+ query &optional _groups)
+ (with-slots (switches config-file) engine
+ (append `("--rcfile" ,config-file "-r")
+ switches
+ (when (alist-get 'thread query) (list "-t"))
+ (list qstring))))
+
+;;; Find-grep interface
+
+(cl-defmethod gnus-search-transform-expression ((_engine gnus-search-find-grep)
+ (_ list))
+ ;; Drop everything that isn't a plain string.
+ nil)
+
+(cl-defmethod gnus-search-run-search ((engine gnus-search-find-grep)
+ server query
+ &optional groups)
+ "Run find and grep to obtain matching articles."
+ (let* ((method (gnus-server-to-method server))
+ (sym (intern
+ (concat (symbol-name (car method)) "-directory")))
+ (directory (cadr (assoc sym (cddr method))))
+ (regexp (alist-get 'grep query))
+ (grep-options (slot-value engine 'grep-options))
+ (grouplist (or groups (gnus-search-get-active server)))
+ (buffer (slot-value engine 'proc-buffer)))
+ (unless directory
+ (signal 'gnus-search-config-error
+ (list (format-message
+ "No directory found in definition of server %s"
+ server))))
+ (apply
+ 'vconcat
+ (mapcar (lambda (x)
+ (let ((group x)
+ artlist)
+ (message "Searching %s using find-grep..."
+ (or group server))
+ (save-window-excursion
+ (set-buffer buffer)
+ (if (> gnus-verbose 6)
+ (pop-to-buffer (current-buffer)))
+ (cd directory) ; Using relative paths simplifies
+ ; postprocessing.
+ (let ((group
+ (if (not group)
+ "."
+ ;; Try accessing the group literally as
+ ;; well as interpreting dots as directory
+ ;; separators so the engine works with
+ ;; plain nnml as well as the Gnus Cache.
+ (let ((group (gnus-group-real-name group)))
+ ;; Replace cl-func find-if.
+ (if (file-directory-p group)
+ group
+ (if (file-directory-p
+ (setq group
+ (replace-regexp-in-string
+ "\\." "/"
+ group nil t)))
+ group))))))
+ (unless group
+ (signal 'gnus-search-config-error
+ (list
+ "Cannot locate directory for group")))
+ (save-excursion
+ (apply
+ 'call-process "find" nil t
+ "find" group "-maxdepth" "1" "-type" "f"
+ "-name" "[0-9]*" "-exec"
+ (slot-value engine 'grep-program)
+ `("-l" ,@(and grep-options
+ (split-string grep-options "\\s-" t))
+ "-e" ,regexp "{}" "+"))))
+
+ ;; Translate relative paths to group names.
+ (while (not (eobp))
+ (let* ((path (split-string
+ (buffer-substring
+ (point)
+ (line-end-position)) "/" t))
+ (art (string-to-number (car (last path)))))
+ (while (string= "." (car path))
+ (setq path (cdr path)))
+ (let ((group (mapconcat #'identity
+ (cl-subseq path 0 -1)
+ ".")))
+ (push
+ (vector (gnus-group-full-name group server) art 0)
+ artlist))
+ (forward-line 1)))
+ (message "Searching %s using find-grep...done"
+ (or group server))
+ artlist)))
+ grouplist))))
+
+;;; Util Code:
+
+(defun gnus-search-run-query (specs)
+ "Invoke appropriate search engine function."
+ ;; For now, run the searches synchronously. At some point
+ ;; multiple-server searches can each be run in their own thread,
+ ;; allowing concurrent searches of multiple backends. At present
+ ;; this causes problems when searching more than one server that
+ ;; uses `nntp-server-buffer', as their return values are written
+ ;; interleaved into that buffer. Anyway, that's the reason for the
+ ;; `mapc'.
+ (let* ((results [])
+ (prepared-query (gnus-search-prepare-query
+ (alist-get 'search-query-spec specs)))
+ (limit (alist-get 'limit prepared-query)))
+ (mapc
+ (pcase-lambda (`(,server . ,groups))
+ (condition-case err
+ (let ((search-engine (gnus-search-server-to-engine server)))
+ (setq results
+ (vconcat
+ (gnus-search-run-search
+ search-engine server prepared-query groups)
+ results)))
+ (gnus-search-config-error
+ (if (< 1 (length (alist-get 'search-group-spec specs)))
+ (apply #'nnheader-message 4
+ "Search engine for %s improperly configured: %s"
+ server (cdr err))
+ (signal 'gnus-search-config-error err)))))
+ (alist-get 'search-group-spec specs))
+ ;; Some search engines do their own limiting, but some don't, so
+ ;; do it again here. This is bad because, if the user is
+ ;; searching multiple groups, they would reasonably expect the
+ ;; limiting to apply to the search results *after sorting*. Doing
+ ;; it this way is liable to, for instance, eliminate all results
+ ;; from a later group entirely.
+ (if limit
+ (seq-subseq results 0 (min limit (length results)))
+ results)))
+
+(defun gnus-search-prepare-query (query-spec)
+ "Accept a search query in raw format, and prepare it.
+QUERY-SPEC is an alist produced by functions such as
+`gnus-group-make-search-group', and contains at least a 'query
+key, and possibly some meta keys. This function extracts any
+additional meta keys from the 'query string, and parses the
+remaining string, then adds all that to the top-level spec."
+ (let ((query (alist-get 'query query-spec))
+ val)
+ (when (stringp query)
+ ;; Look for these meta keys:
+ (while (string-match
+ "\\(thread\\|grep\\|limit\\|raw\\):\\([^ ]+\\)"
+ query)
+ (setq val (match-string 2 query))
+ (setf (alist-get (intern (match-string 1 query)) query-spec)
+ ;; This is stupid.
+ (cond
+ ((equal val "t"))
+ ((null (zerop (string-to-number val)))
+ (string-to-number val))
+ (t val)))
+ (setq query
+ (string-trim (replace-match "" t t query 0)))
+ (setf (alist-get 'query query-spec) query)))
+ (when (and gnus-search-use-parsed-queries
+ (null (alist-get 'raw query-spec)))
+ (setf (alist-get 'parsed-query query-spec)
+ (gnus-search-parse-query query)))
+ query-spec))
+
+;; This should be done once at Gnus startup time, when the servers are
+;; first opened, and the resulting engine instance attached to the
+;; server.
+(defun gnus-search-server-to-engine (srv)
+ (let* ((method (gnus-server-to-method srv))
+ (engine-config (assoc 'gnus-search-engine (cddr method)))
+ (server (or (cdr-safe
+ (assoc-string srv gnus-search-engine-instance-alist t))
+ (nth 1 engine-config)
+ (cdr-safe (assoc (car method) gnus-search-default-engines))
+ (when-let ((old (assoc 'nnir-search-engine
+ (cddr method))))
+ (nnheader-message
+ 8 "\"nnir-search-engine\" is no longer a valid parameter")
+ (nth 1 old))))
+ inst)
+ (setq server
+ (pcase server
+ ('notmuch 'gnus-search-notmuch)
+ ('namazu 'gnus-search-namazu)
+ ('find-grep 'gnus-search-find-grep)
+ ('imap 'gnus-search-imap)
+ (_ server))
+ inst
+ (cond
+ ((null server) nil)
+ ((eieio-object-p server)
+ server)
+ ((class-p server)
+ (make-instance server))
+ (t nil)))
+ (if inst
+ (unless (assoc-string srv gnus-search-engine-instance-alist t)
+ (when (cddr engine-config)
+ ;; We're not being completely backward-compatible here,
+ ;; because we're not checking for nnir-specific config
+ ;; options in the server definition.
+ (pcase-dolist (`(,key ,value) (cddr engine-config))
+ (condition-case nil
+ (setf (slot-value inst key) value)
+ ((invalid-slot-name invalid-slot-type)
+ (nnheader-report 'search
+ "Invalid search engine parameter: (%s %s)"
+ key value)))))
+ (push (cons srv inst) gnus-search-engine-instance-alist))
+ (signal 'gnus-search-config-error
+ (list (format-message
+ "No search engine configured for %s" srv))))
+ inst))
+
+(declare-function gnus-registry-get-id-key "gnus-registry" (id key))
+
+(defun gnus-search-thread (header)
+ "Make an nnselect group based on the thread containing the article
+header. The current server will be searched. If the registry is
+installed, the server that the registry reports the current
+article came from is also searched."
+ (let* ((ids (cons (mail-header-id header)
+ (split-string
+ (or (mail-header-references header)
+ ""))))
+ (query
+ (list (cons 'query (mapconcat (lambda (i)
+ (format "id:%s" i))
+ ids " or "))
+ (cons 'thread t)))
+ (server
+ (list (list (gnus-method-to-server
+ (gnus-find-method-for-group gnus-newsgroup-name)))))
+ (registry-group (and
+ (bound-and-true-p gnus-registry-enabled)
+ (car (gnus-registry-get-id-key
+ (mail-header-id header) 'group))))
+ (registry-server
+ (and registry-group
+ (gnus-method-to-server
+ (gnus-find-method-for-group registry-group)))))
+ (when registry-server
+ (cl-pushnew (list registry-server) server :test #'equal))
+ (gnus-group-make-search-group nil (list
+ (cons 'search-query-spec query)
+ (cons 'search-group-spec server)))
+ (gnus-summary-goto-subject (gnus-id-to-article (mail-header-id header)))))
+
+(defun gnus-search-get-active (srv)
+ (let ((method (gnus-server-to-method srv))
+ groups)
+ (gnus-request-list method)
+ (with-current-buffer nntp-server-buffer
+ (let ((cur (current-buffer)))
+ (goto-char (point-min))
+ (unless (or (null gnus-search-ignored-newsgroups)
+ (string= gnus-search-ignored-newsgroups ""))
+ (delete-matching-lines gnus-search-ignored-newsgroups))
+ (if (eq (car method) 'nntp)
+ (while (not (eobp))
+ (ignore-errors
+ (push (gnus-group-decoded-name
+ (gnus-group-full-name
+ (buffer-substring
+ (point)
+ (progn
+ (skip-chars-forward "^ \t")
+ (point)))
+ method))
+ groups))
+ (forward-line))
+ (while (not (eobp))
+ (ignore-errors
+ (push (gnus-group-decoded-name
+ (if (eq (char-after) ?\")
+ (gnus-group-full-name (read cur) method)
+ (let ((p (point)) (name ""))
+ (skip-chars-forward "^ \t\\\\")
+ (setq name (buffer-substring p (point)))
+ (while (eq (char-after) ?\\)
+ (setq p (1+ (point)))
+ (forward-char 2)
+ (skip-chars-forward "^ \t\\\\")
+ (setq name (concat name (buffer-substring
+ p (point)))))
+ (gnus-group-full-name name method))))
+ groups))
+ (forward-line)))))
+ groups))
+
+(defvar gnus-search-minibuffer-map
+ (let ((km (make-sparse-keymap)))
+ (set-keymap-parent km minibuffer-local-map)
+ (define-key km (kbd "TAB") #'completion-at-point)
+ km))
+
+(defun gnus-search--complete-key-data ()
+ "Potentially return completion data for a search key or value."
+ (let* ((key-start (save-excursion
+ (or (re-search-backward " " (minibuffer-prompt-end) t)
+ (goto-char (minibuffer-prompt-end)))
+ (skip-chars-forward " -")
+ (point)))
+ (after-colon (save-excursion
+ (when (re-search-backward ":" key-start t)
+ (1+ (point)))))
+ in-string)
+ (if after-colon
+ ;; We're in the value part of a key:value pair, which we
+ ;; only handle in a contact-completion context.
+ (when (and gnus-search-contact-tables
+ (save-excursion
+ (re-search-backward "\\<-?\\(\\w+\\):" key-start t)
+ (member (match-string 1)
+ '("from" "to" "cc"
+ "bcc" "recipient" "address"))))
+ (setq in-string (nth 3 (syntax-ppss)))
+ (list (if in-string (1+ after-colon) after-colon)
+ (point) (apply #'completion-table-merge
+ gnus-search-contact-tables)
+ :exit-function
+ (lambda (str status)
+ ;; If the value contains spaces, make sure it's
+ ;; quoted.
+ (when (and (memql status '(exact finished))
+ (or (string-match-p " " str)
+ in-string))
+ (unless (looking-at-p "\\s\"")
+ (insert "\""))
+ ;; Unless we already have an opening quote...
+ (unless in-string
+ (save-excursion
+ (goto-char after-colon)
+ (insert "\"")))))))
+ (list
+ key-start (point) gnus-search-expandable-keys
+ :exit-function (lambda (_s status)
+ (when (memql status '(exact finished))
+ (insert ":")))))))
+
+(defun gnus-search-make-spec (arg)
+ (list (cons 'query
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (add-hook 'completion-at-point-functions
+ #'gnus-search--complete-key-data
+ nil t))
+ (read-from-minibuffer
+ "Query: " nil gnus-search-minibuffer-map
+ nil 'gnus-search-history)))
+ (cons 'raw arg)))
+
+(provide 'gnus-search)
+;;; gnus-search.el ends here
diff --git a/lisp/gnus/gnus-sieve.el b/lisp/gnus/gnus-sieve.el
index 5d8f9b55deb..3b79d578644 100644
--- a/lisp/gnus/gnus-sieve.el
+++ b/lisp/gnus/gnus-sieve.el
@@ -1,6 +1,6 @@
;;; gnus-sieve.el --- Utilities to manage sieve scripts for Gnus
-;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Author: NAGY Andras <nagya@inf.elte.hu>,
;; Simon Josefsson <simon@josefsson.org>
diff --git a/lisp/gnus/gnus-spec.el b/lisp/gnus/gnus-spec.el
index 6e3e802c830..a5228551396 100644
--- a/lisp/gnus/gnus-spec.el
+++ b/lisp/gnus/gnus-spec.el
@@ -1,6 +1,6 @@
;;; gnus-spec.el --- format spec functions for Gnus
-;; Copyright (C) 1996-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el
index 6beb543e5a1..34e5ceb3f67 100644
--- a/lisp/gnus/gnus-srvr.el
+++ b/lisp/gnus/gnus-srvr.el
@@ -1,6 +1,6 @@
;;; gnus-srvr.el --- virtual server support for Gnus
-;; Copyright (C) 1995-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -262,8 +262,7 @@ The following commands are available:
(setq mode-line-process nil)
(buffer-disable-undo)
(setq truncate-lines t)
- (set (make-local-variable 'font-lock-defaults)
- '(gnus-server-font-lock-keywords t)))
+ (setq-local font-lock-defaults '(gnus-server-font-lock-keywords t)))
(defun gnus-server-insert-server-line (name method)
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index 615f8dfa877..fbdbf41dc05 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -1,6 +1,6 @@
;;; gnus-start.el --- startup functions for Gnus -*- lexical-binding:t -*-
-;; Copyright (C) 1996-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -741,8 +741,7 @@ of an NNTP server to use. As opposed to \\[gnus], this command
will not connect to the local server."
(let ((val (or arg (1- gnus-level-default-subscribed))))
(gnus val t child)
- (make-local-variable 'gnus-group-use-permanent-levels)
- (setq gnus-group-use-permanent-levels val)))
+ (setq-local gnus-group-use-permanent-levels val)))
(defun gnus-1 (&optional arg dont-connect child)
"Read network news.
@@ -875,13 +874,13 @@ If REGEXP is given, lines that match it will be deleted."
(with-current-buffer (setq gnus-dribble-buffer
(gnus-get-buffer-create
(file-name-nondirectory dribble-file)))
- (set (make-local-variable 'file-precious-flag) t)
+ (setq-local file-precious-flag t)
(setq buffer-save-without-query t)
(erase-buffer)
(setq buffer-file-name dribble-file)
;; The buffer may be shrunk a lot when deleting old entries.
;; It caused the auto-saving to stop.
- (set (make-local-variable 'auto-save-include-big-deletions) t)
+ (setq-local auto-save-include-big-deletions t)
(auto-save-mode t)
(buffer-disable-undo)
(bury-buffer (current-buffer))
@@ -2763,8 +2762,7 @@ values from `gnus-newsrc-hashtb', and write a new value of
;; Save .newsrc.eld.
(set-buffer (gnus-get-buffer-create " *Gnus-newsrc*"))
- (make-local-variable 'version-control)
- (setq version-control gnus-backup-startup-file)
+ (setq-local version-control gnus-backup-startup-file)
(setq buffer-file-name
(concat gnus-current-startup-file ".eld"))
(setq default-directory (file-name-directory buffer-file-name))
@@ -2973,8 +2971,7 @@ SPECIFIC-VARIABLES, or those in `gnus-variable-list'."
(when ranges
(insert ",")))))
(insert "\n")))
- (make-local-variable 'version-control)
- (setq version-control 'never)
+ (setq-local version-control 'never)
;; It has been reported that sometime the modtime on the .newsrc
;; file seems to be off. We really do want to overwrite it, so
;; we clear the modtime here before saving. It's a bit odd,
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 561f199531e..5bd58b690af 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -1,6 +1,6 @@
;;; gnus-sum.el --- summary mode commands for Gnus -*- lexical-binding:t -*-
-;; Copyright (C) 1996-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -442,6 +442,16 @@ will go to the next group without confirmation."
(const slightly-quietly)
(sexp :menu-tag "on" t)))
+(defcustom gnus-paging-select-next t
+ "Control whether to select the next/prev article when paging.
+If non-nil, select the next article when reaching the end of the
+article (or the previous article when paging backwards).
+
+If nil, don't do anything at the end/start of the articles."
+ :version "28.1"
+ :group 'gnus-summary-maneuvering
+ :type 'boolean)
+
(defcustom gnus-auto-select-same nil
"If non-nil, select the next article with the same subject.
If there are no more articles with the same subject, go to
@@ -734,7 +744,8 @@ string with the suggested prefix."
:type '(repeat character))
(defcustom gnus-inhibit-user-auto-expire t
- "If non-nil, user marking commands will not mark an article as expirable, even if the group has auto-expire turned on."
+ "If non-nil, user marking commands will not mark an article as expirable.
+This is true even if the group has auto-expire turned on."
:version "21.1"
:group 'gnus-summary
:type 'boolean)
@@ -1389,7 +1400,7 @@ the normal Gnus MIME machinery."
(defvar gnus-thread-indent-array nil)
(defvar gnus-thread-indent-array-level gnus-thread-indent-level)
(defvar gnus-sort-gathered-threads-function #'gnus-thread-sort-by-number
- "Function called to sort the articles within a thread after it has been gathered together.")
+ "Function to sort articles within a thread after it has been gathered together.")
(defvar gnus-summary-save-parts-type-history nil)
(defvar gnus-summary-save-parts-last-directory mm-default-directory)
@@ -1450,8 +1461,8 @@ the normal Gnus MIME machinery."
(?I gnus-tmp-indentation ?s)
(?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s)
(?R gnus-tmp-replied ?c)
- (?\[ gnus-tmp-opening-bracket ?c)
- (?\] gnus-tmp-closing-bracket ?c)
+ (?\[ gnus-tmp-opening-bracket ?s)
+ (?\] gnus-tmp-closing-bracket ?s)
(?\> (make-string gnus-tmp-level ? ) ?s)
(?\< (make-string (max 0 (- 20 gnus-tmp-level)) ? ) ?s)
(?i gnus-tmp-score ?d)
@@ -1515,7 +1526,7 @@ the type of the variable (string, integer, character, etc).")
"Default shell command on article.")
(defvar gnus-newsgroup-agentized nil
- "Locally bound in each summary buffer to indicate whether the server has been agentized.")
+ "Locally bound in each summary buffer to indicate if server has been agentized.")
(defvar gnus-newsgroup-begin nil)
(defvar gnus-newsgroup-end nil)
(defvar gnus-newsgroup-last-rmail nil)
@@ -1545,7 +1556,7 @@ the type of the variable (string, integer, character, etc).")
(defvar gnus-newsgroup-expunged-tally nil)
(defvar gnus-newsgroup-marked nil
- "Sorted list of ticked articles in the current newsgroup (a subset of unread art).")
+ "Sorted list of ticked articles in current newsgroup (a subset of unread art).")
(defvar gnus-newsgroup-spam-marked nil
"List of ranges of articles that have been marked as spam.")
@@ -3028,7 +3039,7 @@ When FORCE, rebuild the tool bar."
;; Need to set `gnus-summary-tool-bar-map' because `gnus-article-mode'
;; uses its value.
(setq gnus-summary-tool-bar-map map))))
- (set (make-local-variable 'tool-bar-map) gnus-summary-tool-bar-map))
+ (setq-local tool-bar-map gnus-summary-tool-bar-map))
(defun gnus-make-score-map (type)
"Make a summary score map of type TYPE."
@@ -3164,8 +3175,8 @@ The following commands are available:
(make-local-variable 'gnus-original-article-buffer)
(add-hook 'pre-command-hook #'gnus-set-global-variables nil t)
(mm-enable-multibyte)
- (set (make-local-variable 'bookmark-make-record-function)
- #'gnus-summary-bookmark-make-record))
+ (setq-local bookmark-make-record-function
+ #'gnus-summary-bookmark-make-record))
(defun gnus-summary-make-local-variables ()
"Make all the local summary buffer variables."
@@ -3537,7 +3548,7 @@ Returns non-nil if the setup was successful."
(let ((gnus-summary-mode-group group))
(gnus-summary-mode))
(when (gnus-group-quit-config group)
- (set (make-local-variable 'gnus-single-article-buffer) nil))
+ (setq-local gnus-single-article-buffer nil))
(turn-on-gnus-mailing-list-mode)
;; These functions don't currently depend on GROUP, but might in
;; the future.
@@ -3647,6 +3658,7 @@ buffer that was in action when the last article was fetched."
;; so we don't call gnus-data-<field> accessors on nil.
(gnus-newsgroup-data gnus--dummy-data-list)
(gnus-newsgroup-downloadable '(0))
+ (gnus-visual nil)
case-fold-search ignores)
;; Here, all marks are bound to Z.
(gnus-summary-insert-line gnus--dummy-mail-header
@@ -3738,6 +3750,30 @@ buffer that was in action when the last article was fetched."
(inline
(gnus-summary-extract-address-component gnus-tmp-from))))))
+(defcustom gnus-sum-opening-bracket "["
+ "With %[ spec, used to identify normal (non-adopted) articles."
+ :version "28.1"
+ :type 'string
+ :group 'gnus-summary-format)
+
+(defcustom gnus-sum-closing-bracket "]"
+ "With %] spec, used to identify normal (non-adopted) articles."
+ :version "28.1"
+ :type 'string
+ :group 'gnus-summary-format)
+
+(defcustom gnus-sum-opening-bracket-adopted "<"
+ "With %[ spec, used to identify adopted articles."
+ :version "28.1"
+ :type 'string
+ :group 'gnus-summary-format)
+
+(defcustom gnus-sum-closing-bracket-adopted ">"
+ "With %] spec, used to identify adopted articles."
+ :version "28.1"
+ :type 'string
+ :group 'gnus-summary-format)
+
(defun gnus-summary-insert-line (header level current undownloaded
unread replied expirable subject-or-nil
&optional dummy score process)
@@ -3795,8 +3831,14 @@ buffer that was in action when the last article was fetched."
(1+ (match-beginning 0)) (1- (match-end 0))))
(t gnus-tmp-from)))
(gnus-tmp-subject (mail-header-subject gnus-tmp-header))
- (gnus-tmp-opening-bracket (if gnus-tmp-dummy ?\< ?\[))
- (gnus-tmp-closing-bracket (if gnus-tmp-dummy ?\> ?\]))
+ (gnus-tmp-opening-bracket
+ (if gnus-tmp-dummy
+ gnus-sum-opening-bracket-adopted
+ gnus-sum-opening-bracket))
+ (gnus-tmp-closing-bracket
+ (if gnus-tmp-dummy
+ gnus-sum-closing-bracket-adopted
+ gnus-sum-closing-bracket))
(inhibit-read-only t))
(when (string= gnus-tmp-name "")
(setq gnus-tmp-name gnus-tmp-from))
@@ -4060,8 +4102,6 @@ If SELECT-ARTICLES, only select those articles from GROUP."
;; The group was successfully selected.
(t
(gnus-set-global-variables)
- (when (boundp 'gnus-pick-line-number)
- (setq gnus-pick-line-number 0))
(when (boundp 'spam-install-hooks)
(spam-initialize))
;; Save the active value in effect when the group was entered.
@@ -4186,6 +4226,8 @@ If SELECT-ARTICLES, only select those articles from GROUP."
gnus-newsgroup-data-reverse nil)
(gnus-run-hooks 'gnus-summary-generate-hook)
;; Generate the buffer, either with threads or without.
+ (when (boundp 'gnus-pick-line-number)
+ (setq gnus-pick-line-number 0))
(when gnus-newsgroup-headers
(gnus-summary-prepare-threads
(if gnus-show-threads
@@ -5429,10 +5471,10 @@ or a straight list of headers."
(if (and (eq gnus-summary-make-false-root 'adopt)
(= gnus-tmp-level 1)
(memq number gnus-tmp-gathered))
- (setq gnus-tmp-opening-bracket ?\<
- gnus-tmp-closing-bracket ?\>)
- (setq gnus-tmp-opening-bracket ?\[
- gnus-tmp-closing-bracket ?\]))
+ (setq gnus-tmp-opening-bracket gnus-sum-opening-bracket-adopted
+ gnus-tmp-closing-bracket gnus-sum-closing-bracket-adopted)
+ (setq gnus-tmp-opening-bracket gnus-sum-opening-bracket
+ gnus-tmp-closing-bracket gnus-sum-closing-bracket))
(if (>= gnus-tmp-level (length gnus-thread-indent-array))
(gnus-make-thread-indent-array
(max (* 2 (length gnus-thread-indent-array))
@@ -5616,10 +5658,21 @@ 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."
+ "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."
(gnus-message 7 "Fetching headers for %s..." gnus-newsgroup-name)
- (prog1
- (pcase (setq gnus-headers-retrieved-by
+ (let ((res (setq gnus-headers-retrieved-by
(gnus-retrieve-headers
articles gnus-newsgroup-name
(or limit
@@ -5629,22 +5682,34 @@ or a straight list of headers."
(not (eq gnus-fetch-old-headers 'some))
(not (numberp gnus-fetch-old-headers)))
(> (length articles) 1))
- 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)))
+ 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))))
(defun gnus-select-newsgroup (group &optional read-all select-articles)
"Select newsgroup GROUP.
@@ -5660,8 +5725,8 @@ If SELECT-ARTICLES, only select those articles from GROUP."
articles fetched-articles cached)
(unless (gnus-check-server
- (set (make-local-variable 'gnus-current-select-method)
- (gnus-find-method-for-group group)))
+ (setq-local gnus-current-select-method
+ (gnus-find-method-for-group group)))
(error "Couldn't open server"))
(or (and entry (not (eq (car entry) t))) ; Either it's active...
@@ -6244,7 +6309,9 @@ If WHERE is `summary', the summary mode line format will be used."
mode-string (- max-len 3) nil nil t)))))
;; Update the mode line.
(setq mode-line-buffer-identification
- (gnus-mode-line-buffer-identification (list mode-string)))
+ (gnus-mode-line-buffer-identification
+ (list (propertize mode-string
+ 'face 'mode-line-buffer-id))))
(set-buffer-modified-p t))))
(defun gnus-create-xref-hashtb (from-newsgroup headers unreads)
@@ -6399,6 +6466,10 @@ 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
@@ -7898,7 +7969,8 @@ Also see the variable `gnus-article-skip-boring'."
(gnus-message 3 "End of message"))
(circular
(gnus-summary-beginning-of-article))
- (lines
+ ((or lines
+ (not gnus-paging-select-next))
(gnus-message 3 "End of message"))
((null lines)
(if (and (eq gnus-summary-goto-unread 'never)
@@ -7929,7 +8001,8 @@ the beginning of the buffer."
(gnus-eval-in-buffer-window gnus-article-buffer
(setq endp (gnus-article-prev-page lines)))
(when (and move endp)
- (cond (lines
+ (cond ((or lines
+ (not gnus-paging-select-next))
(gnus-message 3 "Beginning of message"))
((null lines)
(if (and (eq gnus-summary-goto-unread 'never)
@@ -10626,7 +10699,7 @@ groups."
(mime-to-mml current-handles))
(let ((mbl1 mml-buffer-list))
(setq mml-buffer-list mbl)
- (set (make-local-variable 'mml-buffer-list) mbl1))
+ (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)
@@ -12834,8 +12907,7 @@ UNREAD is a sorted list."
(and gnus-newsgroup-name
(gnus-parameter-charset gnus-newsgroup-name))
gnus-default-charset))
- (set (make-local-variable 'gnus-newsgroup-ignored-charsets)
- ignored-charsets))))
+ (setq-local gnus-newsgroup-ignored-charsets ignored-charsets))))
;;;
;;; Mime Commands
diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el
index c913002f70b..8a77c532d29 100644
--- a/lisp/gnus/gnus-topic.el
+++ b/lisp/gnus/gnus-topic.el
@@ -1,6 +1,6 @@
;;; gnus-topic.el --- a folding minor mode for Gnus group buffers
-;; Copyright (C) 1995-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
;; Author: Ilja Weis <kult@uni-paderborn.de>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -1129,18 +1129,17 @@ articles in the topic and its subtopics."
(gnus-topic-make-menu-bar))
(gnus-set-format 'topic t)
(add-hook 'gnus-group-catchup-group-hook 'gnus-topic-update-topic)
- (set (make-local-variable 'gnus-group-prepare-function)
- 'gnus-group-prepare-topics)
- (set (make-local-variable 'gnus-group-get-parameter-function)
- 'gnus-group-topic-parameters)
- (set (make-local-variable 'gnus-group-goto-next-group-function)
- 'gnus-topic-goto-next-group)
- (set (make-local-variable 'gnus-group-indentation-function)
- 'gnus-topic-group-indentation)
- (set (make-local-variable 'gnus-group-update-group-function)
- 'gnus-topic-update-topics-containing-group)
- (set (make-local-variable 'gnus-group-sort-alist-function)
- 'gnus-group-sort-topic)
+ (setq-local gnus-group-prepare-function
+ 'gnus-group-prepare-topics)
+ (setq-local gnus-group-get-parameter-function
+ 'gnus-group-topic-parameters)
+ (setq-local gnus-group-goto-next-group-function
+ 'gnus-topic-goto-next-group)
+ (setq-local gnus-group-indentation-function
+ '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
diff --git a/lisp/gnus/gnus-undo.el b/lisp/gnus/gnus-undo.el
index 3f2b5768db2..b1c1fb832fe 100644
--- a/lisp/gnus/gnus-undo.el
+++ b/lisp/gnus/gnus-undo.el
@@ -1,6 +1,6 @@
;;; gnus-undo.el --- minor mode for undoing in Gnus
-;; Copyright (C) 1996-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -100,8 +100,8 @@
\\{gnus-undo-mode-map}"
:keymap gnus-undo-mode-map
- (set (make-local-variable 'gnus-undo-actions) nil)
- (set (make-local-variable 'gnus-undo-boundary) t)
+ (setq-local gnus-undo-actions nil)
+ (setq-local gnus-undo-boundary t)
(when gnus-undo-mode
;; Set up the menu.
(when (gnus-visual-p 'undo-menu 'menu)
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index ef811c65b86..de3c854ca56 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -1,6 +1,6 @@
;;; gnus-util.el --- utility functions for Gnus
-;; Copyright (C) 1996-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -785,7 +785,7 @@ If there's no subdirectory, delete DIRECTORY as well."
string)
(defsubst gnus-put-text-property-excluding-newlines (beg end prop val)
- "The same as `put-text-property', but don't put this prop on any newlines in the region."
+ "Like `put-text-property', but don't put this prop on any newlines in the region."
(save-match-data
(save-excursion
(save-restriction
@@ -796,7 +796,7 @@ If there's no subdirectory, delete DIRECTORY as well."
(put-text-property beg (point) prop val)))))
(defsubst gnus-put-overlay-excluding-newlines (beg end prop val)
- "The same as `put-text-property', but don't put this prop on any newlines in the region."
+ "Like `put-text-property', but don't put this prop on any newlines in the region."
(save-match-data
(save-excursion
(save-restriction
diff --git a/lisp/gnus/gnus-uu.el b/lisp/gnus/gnus-uu.el
index 70aeac00d7f..db0ffc6d0df 100644
--- a/lisp/gnus/gnus-uu.el
+++ b/lisp/gnus/gnus-uu.el
@@ -1,6 +1,6 @@
;;; gnus-uu.el --- extract (uu)encoded files in Gnus
-;; Copyright (C) 1985-1987, 1993-1998, 2000-2020 Free Software
+;; Copyright (C) 1985-1987, 1993-1998, 2000-2021 Free Software
;; Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -162,7 +162,7 @@ Note that this variable can be used in conjunction with the
(regexp :format "%v")))
(defcustom gnus-uu-ignore-files-by-type nil
- "A regular expression saying what files that shouldn't be viewed, based on MIME file type.
+ "Regexp matching files that shouldn't be viewed, based on MIME file type.
If, for instance, you want gnus-uu to ignore all audio files and all mpegs,
you could say something like
@@ -224,7 +224,7 @@ Default is \"/tmp/\"."
:type 'directory)
(defcustom gnus-uu-do-not-unpack-archives nil
- "Non-nil means that gnus-uu won't peek inside archives looking for files to display.
+ "If non-nil, gnus-uu won't peek inside archives looking for files to display.
Default is nil."
:group 'gnus-extract-archive
:type 'boolean)
@@ -265,19 +265,19 @@ it nil."
:type 'boolean)
(defcustom gnus-uu-unmark-articles-not-decoded nil
- "Non-nil means that gnus-uu will mark articles that were unsuccessfully decoded as unread.
+ "If non-nil, gnus-uu will mark unsuccessfully decoded articles as unread.
Default is nil."
:group 'gnus-extract
:type 'boolean)
(defcustom gnus-uu-correct-stripped-uucode nil
- "Non-nil means that gnus-uu will *try* to fix uuencoded files that have had trailing spaces deleted.
+ "If non-nil, *try* to fix uuencoded files that have had trailing spaces deleted.
Default is nil."
:group 'gnus-extract
:type 'boolean)
(defcustom gnus-uu-save-in-digest nil
- "Non-nil means that gnus-uu, when asked to save without decoding, will save in digests.
+ "If non-nil, gnus-uu, when asked to save without decoding, will save in digests.
If this variable is nil, gnus-uu will just save everything in a
file without any embellishments. The digesting almost conforms to RFC1153 -
no easy way to specify any meaningful volume and issue numbers were found,
@@ -1587,8 +1587,7 @@ Gnus might fail to display all of it.")
(save-excursion
(switch-to-buffer (current-buffer))
(delete-other-windows)
- (let ((buffer (get-buffer-create (generate-new-buffer-name
- "*Warning*"))))
+ (let ((buffer (generate-new-buffer "*Warning*")))
(unless
(unwind-protect
(with-current-buffer buffer
@@ -1858,7 +1857,7 @@ uuencode and adds MIME headers."
(function :tag "Other")))
(defcustom gnus-uu-post-include-before-composing nil
- "Non-nil means that gnus-uu will ask for a file to encode before you compose the article.
+ "If non-nil, gnus-uu asks for a file to encode before you compose the article.
If this variable is t, you can either include an encoded file with
\\[gnus-uu-post-insert-binary-in-article] or have one included for you when you post the article."
:group 'gnus-extract-post
diff --git a/lisp/gnus/gnus-vm.el b/lisp/gnus/gnus-vm.el
index 08f6ce6d818..533b1e2a580 100644
--- a/lisp/gnus/gnus-vm.el
+++ b/lisp/gnus/gnus-vm.el
@@ -1,6 +1,6 @@
;;; gnus-vm.el --- vm interface for Gnus
-;; Copyright (C) 1994-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2021 Free Software Foundation, Inc.
;; Author: Per Persson <pp@gnu.ai.mit.edu>
;; Keywords: news, mail
diff --git a/lisp/gnus/gnus-win.el b/lisp/gnus/gnus-win.el
index baa3146e64e..3fb8e469d04 100644
--- a/lisp/gnus/gnus-win.el
+++ b/lisp/gnus/gnus-win.el
@@ -1,6 +1,6 @@
;;; gnus-win.el --- window configuration functions for Gnus
-;; Copyright (C) 1996-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -68,7 +68,7 @@ used to display Gnus windows."
:type 'boolean)
(defvar gnus-buffer-configuration
- '((group
+ `((group
(vertical 1.0
(group 1.0 point)))
(summary
@@ -142,10 +142,9 @@ used to display Gnus windows."
(pipe
(vertical 1.0
(summary 0.25 point)
- (shell-command-buffer-name 1.0)))
+ (,shell-command-buffer-name 1.0)))
(bug
(vertical 1.0
- (if gnus-bug-create-help-buffer '("*Gnus Help Bug*" 0.5))
("*Gnus Bug*" 1.0 point)))
(score-trace
(vertical 1.0
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index c1cfddc87b3..2e9ee7189d2 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -1,6 +1,6 @@
;;; gnus.el --- a newsreader for GNU Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1987-1990, 1993-1998, 2000-2020 Free Software
+;; Copyright (C) 1987-1990, 1993-1998, 2000-2021 Free Software
;; Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
@@ -309,34 +309,29 @@ be set in `.emacs' instead."
:group 'gnus-start
:type 'boolean)
-(defvar gnus-mode-line-image-cache t)
-
-(eval-and-compile
- (if (fboundp 'find-image)
- (defun gnus-mode-line-buffer-identification (line)
- (let ((str (car-safe line))
- (load-path (append (mm-image-load-path) load-path)))
- (if (and (display-graphic-p)
- (stringp str)
- (string-match "^Gnus:" str))
- (progn (add-text-properties
- 0 5
- (list 'display
- (if (eq t gnus-mode-line-image-cache)
- (setq gnus-mode-line-image-cache
- (find-image
- '((:type xpm :file "gnus-pointer.xpm"
- :ascent center)
- (:type xbm :file "gnus-pointer.xbm"
- :ascent center))))
- gnus-mode-line-image-cache)
- 'help-echo (format
- "This is %s, %s."
- gnus-version (gnus-emacs-version)))
- str)
- (list str))
- line)))
- (defalias 'gnus-mode-line-buffer-identification 'identity)))
+(defun gnus-mode-line-buffer-identification (line)
+ (let ((str (car-safe line)))
+ (if (or (not (fboundp 'find-image))
+ (not (display-graphic-p))
+ (not (stringp str))
+ (not (string-match "^Gnus:" str)))
+ line
+ (let ((load-path (append (mm-image-load-path) load-path)))
+ ;; Add the Gnus logo.
+ (add-text-properties
+ 0 5
+ (list 'display
+ (find-image
+ '((:type xpm :file "gnus-pointer.xpm"
+ :ascent center)
+ (:type xbm :file "gnus-pointer.xbm"
+ :ascent center))
+ t)
+ 'help-echo (format
+ "This is %s, %s."
+ gnus-version (gnus-emacs-version)))
+ str)
+ (list str)))))
;; We define these group faces here to avoid the display
;; update forced when creating new faces.
@@ -1200,7 +1195,7 @@ Also see `gnus-large-ephemeral-newsgroup'."
integer))
(defcustom gnus-use-long-file-name (not (memq system-type '(usg-unix-v)))
- "Non-nil means that the default name of a file to save articles in is the group name.
+ "Non-nil means that the default file name to save articles in is the group name.
If it's nil, the directory form of the group name is used instead.
If this variable is a list, and the list contains the element
@@ -1550,7 +1545,7 @@ Use with caution.")
("\\(^\\|:\\)soc.culture.vietnamese\\>" vietnamese-viqr)
("\\(^\\|:\\)\\(comp\\|rec\\|alt\\|sci\\|soc\\|news\\|gnu\\|bofh\\)\\>" iso-8859-1))
:variable-document
- "Alist of regexps (to match group names) and default charsets to be used when reading."
+ "Alist of regexps (to match group names) and charsets to be used when reading."
:variable-group gnus-charset
:variable-type '(repeat (list (regexp :tag "Group")
(symbol :tag "Charset")))
@@ -1623,7 +1618,8 @@ total number of articles in the group.")
;; group parameters for spam processing added by Ted Zlatanov <tzz@lifelogs.com>
(defcustom gnus-install-group-spam-parameters t
"Disable the group parameters for spam detection.
-Enable if `G c' in XEmacs is giving you trouble, and make sure to submit a bug report."
+Enable if `G c' in XEmacs is giving you trouble, and make sure to
+submit a bug report."
:version "22.1"
:type 'boolean
:group 'gnus-start)
@@ -2392,7 +2388,14 @@ 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)
+(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-article-reply nil)
(defvar gnus-override-method nil)
(defvar gnus-opened-servers nil)
@@ -3175,8 +3178,7 @@ that that variable is buffer-local to the summary buffers."
"Make mode lines a bit simpler."
(setq mode-line-modified "--")
(when (listp mode-line-format)
- (make-local-variable 'mode-line-format)
- (setq mode-line-format (copy-sequence mode-line-format))
+ (setq-local mode-line-format (copy-sequence mode-line-format))
(when (equal (nth 3 mode-line-format) " ")
(setcar (nthcdr 3 mode-line-format) " "))))
diff --git a/lisp/gnus/gssapi.el b/lisp/gnus/gssapi.el
index 485d58ad94e..20562fb9ad2 100644
--- a/lisp/gnus/gssapi.el
+++ b/lisp/gnus/gssapi.el
@@ -1,6 +1,6 @@
;;; gssapi.el --- GSSAPI/Kerberos 5 interface for Emacs
-;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
diff --git a/lisp/gnus/legacy-gnus-agent.el b/lisp/gnus/legacy-gnus-agent.el
index 44b6c295b3c..b47e69ffa4b 100644
--- a/lisp/gnus/legacy-gnus-agent.el
+++ b/lisp/gnus/legacy-gnus-agent.el
@@ -1,6 +1,6 @@
;;; gnus-agent.el --- Legacy unplugged support for Gnus
-;; Copyright (C) 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;; Author: Kevin Greiner <kgreiner@xpediantsolutions.com>
;; Keywords: news
diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el
index 43180726c45..52470196f62 100644
--- a/lisp/gnus/mail-source.el
+++ b/lisp/gnus/mail-source.el
@@ -1,6 +1,6 @@
;;; mail-source.el --- functions for fetching mail
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news, mail
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 0782778fd43..b22b4543e71 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -1,6 +1,6 @@
;;; message.el --- composing mail and news messages -*- lexical-binding: t -*-
-;; Copyright (C) 1996-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: mail, news
@@ -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 only consulted when forwarding \"normally\", not
-when forwarding as MIME or the like.
+This variable is not consulted when forwarding encrypted messages
+and `message-forward-show-mml' is `best'.
This may also be a list of regexps."
:version "21.1"
@@ -1155,7 +1155,7 @@ Note: Many newsgroups frown upon nontraditional reply styles.
You probably want to set this variable only for specific groups,
e.g. using `gnus-posting-styles':
- (eval (set (make-local-variable \\='message-cite-reply-position) \\='above))"
+ (eval (setq-local message-cite-reply-position \\='above))"
:version "24.1"
:type '(choice (const :tag "Reply inline" traditional)
(const :tag "Reply above" above)
@@ -1172,7 +1172,8 @@ Presets to impersonate popular mail agents are found in the
message-cite-style-* variables. This variable is intended for
use in `gnus-posting-styles', such as:
- ((posting-from-work-p) (eval (set (make-local-variable \\='message-cite-style) message-cite-style-outlook)))"
+ ((posting-from-work-p) (eval (setq-local message-cite-style
+ message-cite-style-outlook)))"
:version "24.1"
:group 'message-insertion
:type '(choice (const :tag "Do not override variables" :value nil)
@@ -1199,7 +1200,8 @@ use in `gnus-posting-styles', such as:
(message-yank-cited-prefix ">")
(message-yank-empty-prefix ">")
(message-citation-line-format "On %D %R %p, %N wrote:"))
- "Message citation style used by Mozilla Thunderbird. Use with `message-cite-style'.")
+ "Message citation style used by Mozilla Thunderbird.
+Use with `message-cite-style'.")
(defconst message-cite-style-gmail
'((message-cite-function 'message-cite-original)
@@ -2090,14 +2092,21 @@ is used by default."
(goto-char (point-min))
(looking-at message-unix-mail-delimiter))))
-(defun message-fetch-field (header &optional not-all)
- "The same as `mail-fetch-field', only remove all newlines.
+(defun message-fetch-field (header &optional first)
+ "Return the value of the header field named HEADER.
+Continuation lines are folded (i.e., newlines are removed).
Surrounding whitespace is also removed.
+By default, if there's more than one header field named HEADER,
+all the values are returned as one concatenated string, and
+values are comma-separated.
+
+If FIRST is non-nil, only the first value is returned.
+
The buffer is expected to be narrowed to just the header of the message;
see `message-narrow-to-headers-or-head'."
(let* ((inhibit-point-motion-hooks t)
- (value (mail-fetch-field header nil (not not-all))))
+ (value (mail-fetch-field header nil (not first))))
(when value
(while (string-match "\n[\t ]+" value)
(setq value (replace-match " " t t value)))
@@ -2105,12 +2114,12 @@ see `message-narrow-to-headers-or-head'."
;; we have initial or trailing white space; remove it.
(string-trim value))))
-(defun message-field-value (header &optional not-all)
+(defun message-field-value (header &optional first)
"The same as `message-fetch-field', only narrow to the headers first."
(save-excursion
(save-restriction
(message-narrow-to-headers-or-head)
- (message-fetch-field header not-all))))
+ (message-fetch-field header first))))
(defun message-narrow-to-field ()
"Narrow the buffer to the header on the current line."
@@ -2660,7 +2669,7 @@ Point is left at the beginning of the narrowed-to region."
10000))))
(defun message-sort-headers ()
- "Sort the headers of the current message according to `message-header-format-alist'."
+ "Sort headers of the current message according to `message-header-format-alist'."
(interactive)
(save-excursion
(save-restriction
@@ -3048,22 +3057,23 @@ See also `message-forbidden-properties'."
(defun message--syntax-propertize (beg end)
"Syntax-propertize certain message text specially."
- (let ((citation-regexp (concat "^" message-cite-prefix-regexp ".*$"))
- (smiley-regexp (regexp-opt message-smileys)))
- (goto-char beg)
- (while (search-forward-regexp citation-regexp
- end 'noerror)
- (let ((start (match-beginning 0))
- (end (match-end 0)))
- (add-text-properties start (1+ start)
- `(syntax-table ,(string-to-syntax "<")))
- (add-text-properties end (min (1+ end) (point-max))
- `(syntax-table ,(string-to-syntax ">")))))
- (goto-char beg)
- (while (search-forward-regexp smiley-regexp
- end 'noerror)
- (add-text-properties (match-beginning 0) (match-end 0)
- `(syntax-table ,(string-to-syntax "."))))))
+ (with-syntax-table message-mode-syntax-table
+ (let ((citation-regexp (concat "^" message-cite-prefix-regexp ".*$"))
+ (smiley-regexp (regexp-opt message-smileys)))
+ (goto-char beg)
+ (while (search-forward-regexp citation-regexp
+ end 'noerror)
+ (let ((start (match-beginning 0))
+ (end (match-end 0)))
+ (add-text-properties start (1+ start)
+ `(syntax-table ,(string-to-syntax "<")))
+ (add-text-properties end (min (1+ end) (point-max))
+ `(syntax-table ,(string-to-syntax ">")))))
+ (goto-char beg)
+ (while (search-forward-regexp smiley-regexp
+ end 'noerror)
+ (add-text-properties (match-beginning 0) (match-end 0)
+ `(syntax-table ,(string-to-syntax ".")))))))
;;;###autoload
(define-derived-mode message-mode text-mode "Message"
@@ -3071,46 +3081,43 @@ See also `message-forbidden-properties'."
Like `text-mode', but with these additional commands:
\\{message-mode-map}"
- (set (make-local-variable 'message-reply-buffer) nil)
- (set (make-local-variable 'message-inserted-headers) nil)
- (set (make-local-variable 'message-send-actions) nil)
- (set (make-local-variable 'message-return-action) nil)
- (set (make-local-variable 'message-exit-actions) nil)
- (set (make-local-variable 'message-kill-actions) nil)
- (set (make-local-variable 'message-postpone-actions) nil)
- (set (make-local-variable 'message-draft-article) nil)
+ (setq-local message-reply-buffer nil)
+ (setq-local message-inserted-headers nil)
+ (setq-local message-send-actions nil)
+ (setq-local message-return-action nil)
+ (setq-local message-exit-actions nil)
+ (setq-local message-kill-actions nil)
+ (setq-local message-postpone-actions nil)
+ (setq-local message-draft-article nil)
(setq buffer-offer-save t)
- (set (make-local-variable 'facemenu-add-face-function)
+ (setq-local facemenu-add-face-function
(lambda (face end)
(let ((face-fun (cdr (assq face message-face-alist))))
(if face-fun
(funcall face-fun (point) end)
(error "Face %s not configured for %s mode" face mode-name)))
""))
- (set (make-local-variable 'facemenu-remove-face-function) t)
- (set (make-local-variable 'message-reply-headers) nil)
+ (setq-local facemenu-remove-face-function t)
+ (setq-local message-reply-headers nil)
(make-local-variable 'message-newsreader)
(make-local-variable 'message-mailer)
(make-local-variable 'message-post-method)
- (set (make-local-variable 'message-sent-message-via) nil)
- (set (make-local-variable 'message-checksum) nil)
- (set (make-local-variable 'message-mime-part) 0)
+ (setq-local message-sent-message-via nil)
+ (setq-local message-checksum nil)
+ (setq-local message-mime-part 0)
(message-setup-fill-variables)
(when message-fill-column
(setq fill-column message-fill-column)
(turn-on-auto-fill))
;; Allow using comment commands to add/remove quoting.
- ;; (set (make-local-variable 'comment-start) message-yank-prefix)
+ ;; (setq-local comment-start message-yank-prefix)
(when message-yank-prefix
- (set (make-local-variable 'comment-start) message-yank-prefix)
- (set (make-local-variable 'comment-start-skip)
- (concat "^" (regexp-quote message-yank-prefix) "[ \t]*")))
- (set (make-local-variable 'font-lock-defaults)
- '(message-font-lock-keywords t))
+ (setq-local comment-start message-yank-prefix)
+ (setq-local comment-start-skip
+ (concat "^" (regexp-quote message-yank-prefix) "[ \t]*")))
+ (setq-local font-lock-defaults '(message-font-lock-keywords t))
(if (boundp 'tool-bar-map)
- (set (make-local-variable 'tool-bar-map) (message-make-tool-bar)))
- (easy-menu-add message-mode-menu message-mode-map)
- (easy-menu-add message-mode-field-menu message-mode-map)
+ (setq-local tool-bar-map (message-make-tool-bar)))
;; Mmmm... Forbidden properties...
(add-hook 'after-change-functions #'message-strip-forbidden-properties
nil 'local)
@@ -3129,45 +3136,41 @@ Like `text-mode', but with these additional commands:
;; Don't enable multibyte on an indirect buffer. Maybe enabling
;; multibyte is not necessary at all. -- zsh
(mm-enable-multibyte))
- (set (make-local-variable 'indent-tabs-mode) nil) ;No tabs for indentation.
+ (setq-local indent-tabs-mode nil) ; No tabs for indentation.
(mml-mode)
;; Syntactic fontification. Helps `show-paren-mode',
;; `electric-pair-mode', and C-M-* navigation by syntactically
;; excluding citations and other artifacts.
;;
- (set (make-local-variable 'syntax-propertize-function) 'message--syntax-propertize)
- (set (make-local-variable 'parse-sexp-ignore-comments) t)
+ (setq-local syntax-propertize-function 'message--syntax-propertize)
+ (setq-local parse-sexp-ignore-comments t)
(setq-local message-encoded-mail-cache nil))
(defun message-setup-fill-variables ()
"Setup message fill variables."
- (set (make-local-variable 'fill-paragraph-function)
- 'message-fill-paragraph)
- (make-local-variable 'paragraph-separate)
- (make-local-variable 'paragraph-start)
- (make-local-variable 'adaptive-fill-regexp)
+ (setq-local fill-paragraph-function 'message-fill-paragraph)
(make-local-variable 'adaptive-fill-first-line-regexp)
(let ((quote-prefix-regexp
;; User should change message-cite-prefix-regexp if
;; message-yank-prefix is set to an abnormal value.
(concat "\\(" message-cite-prefix-regexp "\\)[ \t]*")))
- (setq paragraph-start
- (concat
- (regexp-quote mail-header-separator) "$\\|"
- "[ \t]*$\\|" ; blank lines
- "-- $\\|" ; signature delimiter
- "---+$\\|" ; delimiters for forwarded messages
- page-delimiter "$\\|" ; spoiler warnings
- ".*wrote:$\\|" ; attribution lines
- quote-prefix-regexp "$\\|" ; empty lines in quoted text
- ; mml tags
- "<#!*/?\\(multipart\\|part\\|external\\|mml\\|secure\\)"))
- (setq paragraph-separate paragraph-start)
- (setq adaptive-fill-regexp
- (concat quote-prefix-regexp "\\|" adaptive-fill-regexp))
- (setq adaptive-fill-first-line-regexp
- (concat quote-prefix-regexp "\\|"
- adaptive-fill-first-line-regexp)))
+ (setq-local paragraph-start
+ (concat
+ (regexp-quote mail-header-separator) "$\\|"
+ "[ \t]*$\\|" ; blank lines
+ "-- $\\|" ; signature delimiter
+ "---+$\\|" ; delimiters for forwarded messages
+ page-delimiter "$\\|" ; spoiler warnings
+ ".*wrote:$\\|" ; attribution lines
+ quote-prefix-regexp "$\\|" ; empty lines in quoted text
+ ; mml tags
+ "<#!*/?\\(multipart\\|part\\|external\\|mml\\|secure\\)"))
+ (setq-local paragraph-separate paragraph-start)
+ (setq-local adaptive-fill-regexp
+ (concat quote-prefix-regexp "\\|" adaptive-fill-regexp))
+ (setq-local adaptive-fill-first-line-regexp
+ (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))
@@ -7636,7 +7639,8 @@ Optional DIGEST will use digest to forward."
message-forward-included-headers)
t nil t)))))
-(defun message-forward-make-body-mime (forward-buffer &optional beg end)
+(defun message-forward-make-body-mime (forward-buffer &optional beg end
+ remove-headers)
(let ((b (point)))
(insert "\n\n<#part type=message/rfc822 disposition=inline raw=t>\n")
(save-restriction
@@ -7646,12 +7650,14 @@ 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)))
(goto-char (point-max)))
(insert "<#/part>\n")
;; Consider there is no illegible text.
(add-text-properties
b (point)
- '(no-illegible-text t rear-nonsticky t start-open t))))
+ '(no-illegible-text t rear-nonsticky t))))
(defun message-forward-make-body-mml (forward-buffer)
(insert "\n\n<#mml type=message/rfc822 disposition=inline>\n")
@@ -7784,7 +7790,8 @@ 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))
+ (message-forward-make-body-mime
+ forward-buffer nil nil (not (eq message-forward-show-mml 'best))))
(message-forward-make-body-plain forward-buffer)))
(message-position-point))
diff --git a/lisp/gnus/mm-archive.el b/lisp/gnus/mm-archive.el
index 56253afa193..635e7f4ee84 100644
--- a/lisp/gnus/mm-archive.el
+++ b/lisp/gnus/mm-archive.el
@@ -1,6 +1,6 @@
;;; mm-archive.el --- Functions for parsing archive files as MIME
-;; Copyright (C) 2012-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
diff --git a/lisp/gnus/mm-bodies.el b/lisp/gnus/mm-bodies.el
index 35332109681..f35ba3a0b91 100644
--- a/lisp/gnus/mm-bodies.el
+++ b/lisp/gnus/mm-bodies.el
@@ -1,6 +1,6 @@
;;; mm-bodies.el --- Functions for decoding MIME things
-;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index 1bce6ca020e..61946aa5811 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -1,6 +1,6 @@
;;; mm-decode.el --- Functions for decoding MIME things -*- lexical-binding:t -*-
-;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
diff --git a/lisp/gnus/mm-encode.el b/lisp/gnus/mm-encode.el
index d66ae607ed9..8bd3e0b3d2d 100644
--- a/lisp/gnus/mm-encode.el
+++ b/lisp/gnus/mm-encode.el
@@ -1,6 +1,6 @@
;;; mm-encode.el --- Functions for encoding MIME things
-;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
diff --git a/lisp/gnus/mm-extern.el b/lisp/gnus/mm-extern.el
index 96f2a78f0d6..4099a10eb35 100644
--- a/lisp/gnus/mm-extern.el
+++ b/lisp/gnus/mm-extern.el
@@ -1,6 +1,6 @@
;;; mm-extern.el --- showing message/external-body -*- lexical-binding:t -*-
-;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
;; Keywords: message external-body
diff --git a/lisp/gnus/mm-partial.el b/lisp/gnus/mm-partial.el
index 9bf49681648..165c19139ce 100644
--- a/lisp/gnus/mm-partial.el
+++ b/lisp/gnus/mm-partial.el
@@ -1,6 +1,6 @@
;;; mm-partial.el --- showing message/partial
-;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
;; Keywords: message partial
diff --git a/lisp/gnus/mm-url.el b/lisp/gnus/mm-url.el
index 4d56b19c3d7..412a4744125 100644
--- a/lisp/gnus/mm-url.el
+++ b/lisp/gnus/mm-url.el
@@ -1,6 +1,6 @@
;;; mm-url.el --- a wrapper of url functions/commands for Gnus
-;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el
index 958e24c39f5..db42bfa4b10 100644
--- a/lisp/gnus/mm-util.el
+++ b/lisp/gnus/mm-util.el
@@ -1,6 +1,6 @@
;;; mm-util.el --- Utility functions for Mule and low level things -*- lexical-binding:t -*-
-;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
diff --git a/lisp/gnus/mm-uu.el b/lisp/gnus/mm-uu.el
index aedd6c948c2..9d4c4bfead7 100644
--- a/lisp/gnus/mm-uu.el
+++ b/lisp/gnus/mm-uu.el
@@ -1,6 +1,6 @@
;;; mm-uu.el --- Return uu stuff as mm handles -*- lexical-binding:t -*-
-;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
;; Keywords: postscript uudecode binhex shar forward gnatsweb pgp
diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el
index ca610010917..0683703a4ea 100644
--- a/lisp/gnus/mm-view.el
+++ b/lisp/gnus/mm-view.el
@@ -1,6 +1,6 @@
;;; mm-view.el --- functions for viewing MIME objects
-;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
@@ -486,7 +486,7 @@ If MODE is not set, try to find mode automatically."
;; support modes, but now that we use font-lock-ensure, support modes
;; aren't a problem any more. So we could probably get rid of this
;; setting now, but it seems harmless and potentially still useful.
- (set (make-local-variable 'font-lock-mode-hook) nil)
+ (setq-local font-lock-mode-hook nil)
(setq buffer-file-name (mm-handle-filename handle))
(with-demoted-errors
(if mode
diff --git a/lisp/gnus/mml-sec.el b/lisp/gnus/mml-sec.el
index 74af99da7e3..c117a3866ab 100644
--- a/lisp/gnus/mml-sec.el
+++ b/lisp/gnus/mml-sec.el
@@ -1,6 +1,6 @@
;;; mml-sec.el --- A package with security functions for MML documents
-;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
diff --git a/lisp/gnus/mml-smime.el b/lisp/gnus/mml-smime.el
index acddb300339..5baeaffa53a 100644
--- a/lisp/gnus/mml-smime.el
+++ b/lisp/gnus/mml-smime.el
@@ -1,6 +1,6 @@
;;; mml-smime.el --- S/MIME support for MML
-;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
;; Keywords: Gnus, MIME, S/MIME, MML
diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el
index 067396fc2a6..424215de941 100644
--- a/lisp/gnus/mml.el
+++ b/lisp/gnus/mml.el
@@ -1,6 +1,6 @@
;;; mml.el --- A package for parsing and validating MML documents
-;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
@@ -1266,8 +1266,8 @@ See Info node `(emacs-mime)Composing'.
:lighter " MML" :keymap mml-mode-map
(when mml-mode
(when (boundp 'dnd-protocol-alist)
- (set (make-local-variable 'dnd-protocol-alist)
- (append mml-dnd-protocol-alist dnd-protocol-alist)))))
+ (setq-local dnd-protocol-alist
+ (append mml-dnd-protocol-alist dnd-protocol-alist)))))
;;;
;;; Helper functions for reading MIME stuff from the minibuffer and
diff --git a/lisp/gnus/mml1991.el b/lisp/gnus/mml1991.el
index 88864ea3579..a87e642c07d 100644
--- a/lisp/gnus/mml1991.el
+++ b/lisp/gnus/mml1991.el
@@ -1,6 +1,6 @@
;;; mml1991.el --- Old PGP message format (RFC 1991) support for MML
-;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: Sascha Lüdecke <sascha@meta-x.de>,
;; Simon Josefsson <simon@josefsson.org> (Mailcrypt interface, Gnus glue)
diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el
index 45c9bbfe905..8eda59372fb 100644
--- a/lisp/gnus/mml2015.el
+++ b/lisp/gnus/mml2015.el
@@ -1,6 +1,6 @@
;;; mml2015.el --- MIME Security with Pretty Good Privacy (PGP)
-;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
;; Keywords: PGP MIME MML
@@ -735,8 +735,9 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
(let* ((coding-system-for-write 'binary)
(coding-system-for-read 'binary)
(data (shell-command-to-string
- (format "%s --list-options no-show-photos --attribute-fd 3 --list-keys %s 3>&1 >/dev/null 2>&1"
- (shell-quote-argument epg-gpg-program) key-id))))
+ (format "%s --list-options no-show-photos --attribute-fd 3 --list-keys %s 3>&1 >%s 2>&1"
+ (shell-quote-argument epg-gpg-program)
+ key-id null-device))))
(when (> (length data) 0)
(insert (substring data 16))
(condition-case nil
diff --git a/lisp/gnus/nnagent.el b/lisp/gnus/nnagent.el
index 1b5b9757dc5..f2acea4fa64 100644
--- a/lisp/gnus/nnagent.el
+++ b/lisp/gnus/nnagent.el
@@ -1,6 +1,6 @@
;;; nnagent.el --- offline backend for Gnus
-;; Copyright (C) 1997-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news, mail
diff --git a/lisp/gnus/nnbabyl.el b/lisp/gnus/nnbabyl.el
index 480d794b9ac..130f56ad92f 100644
--- a/lisp/gnus/nnbabyl.el
+++ b/lisp/gnus/nnbabyl.el
@@ -1,6 +1,6 @@
;;; nnbabyl.el --- rmail mbox access for Gnus
-;; Copyright (C) 1995-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el
index ccd17744993..b3e83e494d7 100644
--- a/lisp/gnus/nndiary.el
+++ b/lisp/gnus/nndiary.el
@@ -1,6 +1,6 @@
;;; nndiary.el --- A diary back end for Gnus
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Didier Verna <didier@didierverna.net>
;; Created: Fri Jul 16 18:55:42 1999
@@ -1002,10 +1002,10 @@ all. This may very well take some time.")
(let ((buffer (gnus-get-buffer-create
(format " *nndiary overview %s*" group))))
(with-current-buffer buffer
- (set (make-local-variable 'nndiary-nov-buffer-file-name)
- (expand-file-name
- nndiary-nov-file-name
- (nnmail-group-pathname group nndiary-directory)))
+ (setq-local nndiary-nov-buffer-file-name
+ (expand-file-name
+ nndiary-nov-file-name
+ (nnmail-group-pathname group nndiary-directory)))
(erase-buffer)
(when (file-exists-p nndiary-nov-buffer-file-name)
(nnheader-insert-file-contents nndiary-nov-buffer-file-name)))
diff --git a/lisp/gnus/nndir.el b/lisp/gnus/nndir.el
index 32d6c0f856b..46351d0004f 100644
--- a/lisp/gnus/nndir.el
+++ b/lisp/gnus/nndir.el
@@ -1,6 +1,6 @@
;;; nndir.el --- single directory newsgroup access for Gnus
-;; Copyright (C) 1995-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
diff --git a/lisp/gnus/nndoc.el b/lisp/gnus/nndoc.el
index 81431270d7c..a3a66454853 100644
--- a/lisp/gnus/nndoc.el
+++ b/lisp/gnus/nndoc.el
@@ -1,6 +1,6 @@
;;; nndoc.el --- single file access for Gnus
-;; Copyright (C) 1995-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
diff --git a/lisp/gnus/nndraft.el b/lisp/gnus/nndraft.el
index a3c26ea4ac0..1f87beda5f5 100644
--- a/lisp/gnus/nndraft.el
+++ b/lisp/gnus/nndraft.el
@@ -1,6 +1,6 @@
;;; nndraft.el --- draft article access for Gnus
-;; Copyright (C) 1995-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
diff --git a/lisp/gnus/nneething.el b/lisp/gnus/nneething.el
index 9f1fdbae5ae..014ad3adfb1 100644
--- a/lisp/gnus/nneething.el
+++ b/lisp/gnus/nneething.el
@@ -1,6 +1,6 @@
;;; nneething.el --- arbitrary file access for Gnus
-;; Copyright (C) 1995-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
diff --git a/lisp/gnus/nnfolder.el b/lisp/gnus/nnfolder.el
index 6ff99056d84..9a0219c1436 100644
--- a/lisp/gnus/nnfolder.el
+++ b/lisp/gnus/nnfolder.el
@@ -1,6 +1,6 @@
;;; nnfolder.el --- mail folder access for Gnus
-;; Copyright (C) 1995-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
;; ShengHuo Zhu <zsh@cs.rochester.edu> (adding NOV)
@@ -1083,7 +1083,7 @@ This command does not work if you use short group names."
(let ((coding-system-for-write
(or nnfolder-file-coding-system-for-write
nnfolder-file-coding-system)))
- (set (make-local-variable 'copyright-update) nil)
+ (setq-local copyright-update nil)
(save-buffer)))
(unless (or gnus-nov-is-evil nnfolder-nov-is-evil)
(nnfolder-save-nov))))
@@ -1098,8 +1098,8 @@ This command does not work if you use short group names."
(or (cdr (assoc group nnfolder-nov-buffer-alist))
(let ((buffer (gnus-get-buffer-create (format " *nnfolder overview %s*" group))))
(with-current-buffer buffer
- (set (make-local-variable 'nnfolder-nov-buffer-file-name)
- (nnfolder-group-nov-pathname group))
+ (setq-local nnfolder-nov-buffer-file-name
+ (nnfolder-group-nov-pathname group))
(erase-buffer)
(when (file-exists-p nnfolder-nov-buffer-file-name)
(nnheader-insert-file-contents nnfolder-nov-buffer-file-name)))
diff --git a/lisp/gnus/nngateway.el b/lisp/gnus/nngateway.el
index 13cc65bfb85..15e4876642c 100644
--- a/lisp/gnus/nngateway.el
+++ b/lisp/gnus/nngateway.el
@@ -1,6 +1,6 @@
;;; nngateway.el --- posting news via mail gateways
-;; Copyright (C) 1996-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news, mail
diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el
index 2952e20928b..a381720f24c 100644
--- a/lisp/gnus/nnheader.el
+++ b/lisp/gnus/nnheader.el
@@ -1,6 +1,6 @@
;;; nnheader.el --- header access macros for Gnus and its backends
-;; Copyright (C) 1987-1990, 1993-1998, 2000-2020 Free Software
+;; Copyright (C) 1987-1990, 1993-1998, 2000-2021 Free Software
;; Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
@@ -568,7 +568,7 @@ the line could be found."
(mm-enable-multibyte)
(kill-all-local-variables)
(setq case-fold-search t) ;Should ignore case.
- (set (make-local-variable 'nntp-process-response) nil)
+ (setq-local nntp-process-response nil)
t))
;;; Various functions the backends use.
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index 8a88e0e6e64..121513117b2 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -1,6 +1,6 @@
;;; nnimap.el --- IMAP interface for Gnus
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Simon Josefsson <simon@josefsson.org>
@@ -146,13 +146,24 @@ textual parts.")
:version "24.4"
:group 'nnimap)
+(define-obsolete-variable-alias
+ 'nnimap-split-download-body-default 'nnimap-split-download-body
+ "28.1")
+
+(defcustom nnimap-split-download-body nil
+ "If non-nil, make message bodies available for consideration during splitting.
+This requires downloading the full message from the IMAP server
+during splitting, which may be slow."
+ :version "28.1"
+ :type 'boolean)
+
+(defvar nnimap--split-download-body nil
+ "Like `nnimap-split-download-body', but for internal use.")
+
(defvar nnimap-process nil)
(defvar nnimap-status-string "")
-(defvar nnimap-split-download-body-default nil
- "Internal variable with default value for `nnimap-split-download-body'.")
-
(defvar nnimap-keepalive-timer nil)
(defvar nnimap-process-buffers nil)
@@ -365,10 +376,10 @@ textual parts.")
(mm-disable-multibyte)
(buffer-disable-undo)
(gnus-add-buffer)
- (set (make-local-variable 'after-change-functions) nil)
- (set (make-local-variable 'nnimap-object)
- (make-nnimap :server (nnoo-current-server 'nnimap)
- :initial-resync 0))
+ (setq-local after-change-functions nil) ;FIXME: Why?
+ (setq-local nnimap-object
+ (make-nnimap :server (nnoo-current-server 'nnimap)
+ :initial-resync 0))
(push (list buffer (current-buffer)) nnimap-connection-alist)
(push (current-buffer) nnimap-process-buffers)
(current-buffer)))
@@ -2100,7 +2111,8 @@ Return the server's response to the SELECT or EXAMINE command."
"BODY.PEEK"
"RFC822.PEEK"))
(cond
- (nnimap-split-download-body-default
+ ((or nnimap-split-download-body
+ nnimap--split-download-body)
"[]")
((nnimap-ver4-p)
"[HEADER]")
diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el
index 57801d6f9e6..d043ae1b426 100644
--- a/lisp/gnus/nnmail.el
+++ b/lisp/gnus/nnmail.el
@@ -1,6 +1,6 @@
;;; nnmail.el --- mail support functions for the Gnus mail backends
-;; Copyright (C) 1995-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news, mail
@@ -115,7 +115,7 @@ If nil, the first match found will be used."
:type 'boolean)
(defcustom nnmail-split-fancy-with-parent-ignore-groups nil
- "Regexp that matches group names to be ignored when applying `nnmail-split-fancy-with-parent'.
+ "Regexp matching group names ignored by `nnmail-split-fancy-with-parent'.
This can also be a list of regexps."
:version "22.1"
:group 'nnmail-split
@@ -124,7 +124,8 @@ This can also be a list of regexps."
(repeat :value (".*") regexp)))
(defcustom nnmail-cache-ignore-groups nil
- "Regexp that matches group names to be ignored when inserting message ids into the cache (`nnmail-cache-insert').
+ "Regexp matching group ignored when inserting message ids into the cache.
+This is used by `nnmail-cache-insert'.
This can also be a list of regexps."
:version "22.1"
:group 'nnmail-split
diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el
index 68c31dc4510..2a4c74db5e8 100644
--- a/lisp/gnus/nnmaildir.el
+++ b/lisp/gnus/nnmaildir.el
@@ -494,7 +494,7 @@ This variable is set by `nnmaildir-request-article'.")
(delete-char 1)
(setq nov (nnheader-parse-head t)
field (or (mail-header-lines nov) 0)))
- (unless (or (zerop field) (nnmaildir--param pgname 'distrust-Lines:))
+ (unless (or (<= field 0) (nnmaildir--param pgname 'distrust-Lines:))
(setq nov-mid field))
(setq nov-mid (number-to-string nov-mid)
nov-mid (concat (number-to-string attr) "\t" nov-mid))
@@ -1351,7 +1351,8 @@ This variable is set by `nnmaildir-request-article'.")
(throw 'return nil))
(with-current-buffer (or to-buffer nntp-server-buffer)
(erase-buffer)
- (nnheader-insert-file-contents nnmaildir-article-file-name))
+ (let ((coding-system-for-read mm-text-coding-system))
+ (mm-insert-file-contents nnmaildir-article-file-name)))
(cons gname num-msgid))))
(defun nnmaildir-request-post (&optional _server)
diff --git a/lisp/gnus/nnmairix.el b/lisp/gnus/nnmairix.el
index dcecfcf6519..c061031b40a 100644
--- a/lisp/gnus/nnmairix.el
+++ b/lisp/gnus/nnmairix.el
@@ -1,6 +1,6 @@
;;; nnmairix.el --- Mairix back end for Gnus, the Emacs newsreader
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: David Engster <deng@randomsample.de>
;; Keywords: mail searching
@@ -1548,9 +1548,8 @@ See %s for details" proc nnmairix-mairix-output-buffer)))
(defun nnmairix-create-message-line-for-search ()
"Create message line for interactive query in minibuffer."
(mapconcat
- (function
- (lambda (cur)
- (format "%c=%s" (car cur) (nth 3 cur))))
+ (lambda (cur)
+ (format "%c=%s" (car cur) (nth 3 cur)))
nnmairix-interactive-query-parameters ","))
(defun nnmairix-replace-illegal-chars (header)
@@ -1811,13 +1810,12 @@ If VERSION is a string: must be contained in mairix version output."
(gnus-summary-toggle-header 1)
(set-buffer gnus-article-buffer)
(mapcar
- (function
- (lambda (field)
- (list (car (cddr field))
- (if (car field)
- (nnmairix-replace-illegal-chars
- (gnus-fetch-field (car field)))
- nil))))
+ (lambda (field)
+ (list (car (cddr field))
+ (if (car field)
+ (nnmairix-replace-illegal-chars
+ (gnus-fetch-field (car field)))
+ nil)))
nnmairix-widget-fields-list))))
@@ -1911,14 +1909,13 @@ If WITHVALUES is t, query is based on current article."
(when (member 'flags nnmairix-widget-other)
(setq flag
(mapconcat
- (function
- (lambda (flag)
- (setq temp
- (widget-value (cadr (assoc (car flag) nnmairix-widgets))))
- (if (string= "yes" temp)
- (cadr flag)
- (if (string= "no" temp)
- (concat "-" (cadr flag))))))
+ (lambda (flag)
+ (setq temp
+ (widget-value (cadr (assoc (car flag) nnmairix-widgets))))
+ (if (string= "yes" temp)
+ (cadr flag)
+ (if (string= "no" temp)
+ (concat "-" (cadr flag)))))
'(("seen" "s") ("replied" "r") ("flagged" "f")) ""))
(when (not (zerop (length flag)))
(push (concat "F:" flag) query)))
@@ -1968,32 +1965,31 @@ VALUES may contain values for editable fields from current article."
;; how can this be done less ugly?
(let ((ret))
(mapc
- (function
- (lambda (field)
- (setq field (car (cddr field)))
- (setq ret
- (nconc
- (list
- (list
- (concat "c" field)
- (widget-create 'checkbox
- :tag field
- :notify (lambda (widget &rest ignore)
- (nnmairix-widget-toggle-activate widget))
- nil)))
- (list
- (list
- (concat "e" field)
- (widget-create 'editable-field
- :size 60
- :format (concat " " field ":"
- (make-string (- 11 (length field)) ?\ )
- "%v")
- :value (or (cadr (assoc field values)) ""))))
- ret))
- (widget-insert "\n")
- ;; Deactivate editable field
- (widget-apply (cadr (nth 1 ret)) :deactivate)))
+ (lambda (field)
+ (setq field (car (cddr field)))
+ (setq ret
+ (nconc
+ (list
+ (list
+ (concat "c" field)
+ (widget-create 'checkbox
+ :tag field
+ :notify (lambda (widget &rest ignore)
+ (nnmairix-widget-toggle-activate widget))
+ nil)))
+ (list
+ (list
+ (concat "e" field)
+ (widget-create 'editable-field
+ :size 60
+ :format (concat " " field ":"
+ (make-string (- 11 (length field)) ?\ )
+ "%v")
+ :value (or (cadr (assoc field values)) ""))))
+ ret))
+ (widget-insert "\n")
+ ;; Deactivate editable field
+ (widget-apply (cadr (nth 1 ret)) :deactivate))
nnmairix-widget-fields-list)
ret))
diff --git a/lisp/gnus/nnmbox.el b/lisp/gnus/nnmbox.el
index 8b3d80266e7..a4863c3e1fa 100644
--- a/lisp/gnus/nnmbox.el
+++ b/lisp/gnus/nnmbox.el
@@ -1,6 +1,6 @@
;;; nnmbox.el --- mail mbox access for Gnus
-;; Copyright (C) 1995-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
diff --git a/lisp/gnus/nnmh.el b/lisp/gnus/nnmh.el
index 581a408009d..82ed091982e 100644
--- a/lisp/gnus/nnmh.el
+++ b/lisp/gnus/nnmh.el
@@ -1,6 +1,6 @@
;;; nnmh.el --- mhspool access for Gnus
-;; Copyright (C) 1995-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
@@ -46,7 +46,7 @@
"Hook run narrowed to an article before saving.")
(defvoo nnmh-be-safe nil
- "If non-nil, nnmh will check all articles to make sure whether they are new or not.
+ "If non-nil, nnmh will check all articles to make sure if they are new or not.
Go through the .nnmh-articles file and compare with the actual
articles in this folder. The articles that are \"new\" will be marked
as unread by Gnus.")
diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el
index ad608b6575e..ebececa3ce2 100644
--- a/lisp/gnus/nnml.el
+++ b/lisp/gnus/nnml.el
@@ -1,6 +1,6 @@
;;; nnml.el --- mail spool access for Gnus
-;; Copyright (C) 1995-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
;; Authors: Didier Verna <didier@didierverna.net> (adding compaction)
;; Simon Josefsson <simon@josefsson.org>
@@ -778,8 +778,8 @@ article number. This function is called narrowed to an article."
group)))
(file-name-coding-system nnmail-pathname-coding-system))
(with-current-buffer buffer
- (set (make-local-variable 'nnml-nov-buffer-file-name)
- (nnmail-group-pathname group nnml-directory nnml-nov-file-name))
+ (setq-local nnml-nov-buffer-file-name
+ (nnmail-group-pathname group nnml-directory nnml-nov-file-name))
(erase-buffer)
(when (and (not incrementalp)
(file-exists-p nnml-nov-buffer-file-name))
diff --git a/lisp/gnus/nnoo.el b/lisp/gnus/nnoo.el
index ba527a1c4b6..9bb86d65aba 100644
--- a/lisp/gnus/nnoo.el
+++ b/lisp/gnus/nnoo.el
@@ -1,6 +1,6 @@
;;; nnoo.el --- OO Gnus Backends
-;; Copyright (C) 1996-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
diff --git a/lisp/gnus/nnregistry.el b/lisp/gnus/nnregistry.el
index 29ca56817ed..e78f93d829a 100644
--- a/lisp/gnus/nnregistry.el
+++ b/lisp/gnus/nnregistry.el
@@ -1,7 +1,7 @@
;;; nnregistry.el --- access to articles via Gnus' message-id registry
;;; -*- coding: utf-8 -*-
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Ludovic Courtès <ludo@gnu.org>
;; Keywords: news, mail
diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el
index 48c07da1cc8..f9e0a08a06e 100644
--- a/lisp/gnus/nnrss.el
+++ b/lisp/gnus/nnrss.el
@@ -1,6 +1,6 @@
;;; nnrss.el --- interfacing with RSS
-;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
;; Keywords: RSS
diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el
index 21206b683cf..ba0e60a2673 100644
--- a/lisp/gnus/nnselect.el
+++ b/lisp/gnus/nnselect.el
@@ -1,6 +1,6 @@
;;; nnselect.el --- a virtual group backend -*- lexical-binding:t -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; Author: Andrew Cohen <cohen@andy.bu.edu>
;; Keywords: news mail
@@ -36,10 +36,10 @@
;; sorting. Most functions will just chose a fixed number, such as
;; 100, for this score.
-;; For example the search function `nnir-run-query' applied to
-;; arguments specifying a search query (see "nnir.el") can be used to
-;; return a list of articles from a search. Or the function can be the
-;; identity and the args a vector of articles.
+;; For example the search function `gnus-search-run-query' applied to
+;; arguments specifying a search query (see "gnus-search.el") can be
+;; used to return a list of articles from a search. Or the function
+;; can be the identity and the args a vector of articles.
;;; Code:
@@ -47,7 +47,7 @@
;;; Setup:
(require 'gnus-art)
-(require 'nnir)
+(require 'gnus-search)
(eval-when-compile (require 'cl-lib))
@@ -295,6 +295,10 @@ If this variable is nil, or if the provided function returns nil,
(if (zerop (setq length (nnselect-artlist-length nnselect-artlist)))
(progn
(nnheader-report 'nnselect "Selection produced empty results.")
+ (when (gnus-ephemeral-group-p group)
+ (gnus-kill-ephemeral-group group)
+ (setq gnus-ephemeral-servers
+ (assq-delete-all 'nnselect gnus-ephemeral-servers)))
(nnheader-insert ""))
(with-current-buffer nntp-server-buffer
(nnheader-insert "211 %d %d %d %s\n"
@@ -372,25 +376,25 @@ If this variable is nil, or if the provided function returns nil,
;; find the servers for a pseudo-article
(if (eq 'nnselect (car (gnus-server-to-method server)))
(with-current-buffer gnus-summary-buffer
- (let ((thread (gnus-id-to-thread article)))
+ (let ((thread (gnus-id-to-thread article)))
(when thread
(mapc
- #'(lambda (x)
- (when (and x (> x 0))
- (cl-pushnew
- (list
- (gnus-method-to-server
- (gnus-find-method-for-group
- (nnselect-article-group x)))) servers :test 'equal)))
+ (lambda (x)
+ (when (and x (> x 0))
+ (cl-pushnew
+ (list
+ (gnus-method-to-server
+ (gnus-find-method-for-group
+ (nnselect-article-group x)))) servers :test 'equal)))
(gnus-articles-in-thread thread)))))
(setq servers (list (list server))))
(setq artlist
- (nnir-run-query
+ (gnus-search-run-query
(list
- (cons 'nnir-query-spec
- (list (cons 'query (format "HEADER Message-ID %s" article))
- (cons 'criteria "") (cons 'shortcut t)))
- (cons 'nnir-group-spec servers))))
+ (cons 'search-query-spec
+ (list (cons 'query `((id . ,article)))
+ (cons 'criteria "") (cons 'shortcut t)))
+ (cons 'search-group-spec servers))))
(unless (zerop (nnselect-artlist-length artlist))
(setq
group-art
@@ -603,26 +607,35 @@ If this variable is nil, or if the provided function returns nil,
(cl-some #'(lambda (x)
(when (and x (> x 0)) x))
(gnus-articles-in-thread thread)))))))))
- ;; Check if we are dealing with an imap backend.
- (if (eq 'nnimap
- (car (gnus-find-method-for-group artgroup)))
+ ;; Check if search-based thread referral is permitted, and
+ ;; available.
+ (if (and gnus-refer-thread-use-search
+ (gnus-search-server-to-engine
+ (gnus-method-to-server
+ (gnus-find-method-for-group artgroup))))
;; If so we perform the query, massage the result, and return
;; the new headers back to the caller to incorporate into the
;; current summary buffer.
(let* ((group-spec
(list (delq nil (list
(or server (gnus-group-server artgroup))
- (unless gnus-refer-thread-use-search
+ (unless gnus-refer-thread-use-search
artgroup)))))
+ (ids (cons (mail-header-id header)
+ (split-string
+ (or (mail-header-references header)
+ ""))))
(query-spec
- (list (cons 'query (nnimap-make-thread-query header))
- (cons 'criteria "")))
+ (list (cons 'query (mapconcat (lambda (i)
+ (format "id:%s" i))
+ ids " or "))
+ (cons 'thread t)))
(last (nnselect-artlist-length gnus-newsgroup-selection))
(first (1+ last))
(new-nnselect-artlist
- (nnir-run-query
- (list (cons 'nnir-query-spec query-spec)
- (cons 'nnir-group-spec group-spec))))
+ (gnus-search-run-query
+ (list (cons 'search-query-spec query-spec)
+ (cons 'search-group-spec group-spec))))
old-arts seq
headers)
(mapc
@@ -670,7 +683,7 @@ If this variable is nil, or if the provided function returns nil,
group
(cons 1 (nnselect-artlist-length gnus-newsgroup-selection))))
headers)
- ;; If not an imap backend just warp to the original article
+ ;; If we can't or won't use search, just warp to the original
;; group and punt back to gnus-summary-refer-thread.
(and (gnus-warp-to-article) (gnus-summary-refer-thread))))))
@@ -760,17 +773,25 @@ If this variable is nil, or if the provided function returns nil,
Return an article list."
(let ((func (alist-get 'nnselect-function specs))
(args (alist-get 'nnselect-args specs)))
- (funcall func args)))
-
+ (condition-case err
+ (funcall func args)
+ (error (gnus-error 3 "nnselect-run: %s on %s gave error %s" func args err)
+ []))))
(defun nnselect-search-thread (header)
"Make an nnselect group containing the thread with article HEADER.
The current server will be searched. If the registry is
installed, the server that the registry reports the current
article came from is also searched."
- (let* ((query
- (list (cons 'query (nnimap-make-thread-query header))
- (cons 'criteria "")))
+ (let* ((ids (cons (mail-header-id header)
+ (split-string
+ (or (mail-header-references header)
+ ""))))
+ (query
+ (list (cons 'query (mapconcat (lambda (i)
+ (format "id:%s" i))
+ ids " or "))
+ (cons 'thread t)))
(server
(list (list (gnus-method-to-server
(gnus-find-method-for-group gnus-newsgroup-name)))))
@@ -794,10 +815,10 @@ article came from is also searched."
(list
(cons 'nnselect-specs
(list
- (cons 'nnselect-function 'nnir-run-query)
+ (cons 'nnselect-function 'gnus-search-run-query)
(cons 'nnselect-args
- (list (cons 'nnir-query-spec query)
- (cons 'nnir-group-spec server)))))
+ (list (cons 'search-query-spec query)
+ (cons 'search-group-spec server)))))
(cons 'nnselect-artlist nil)))
(gnus-summary-goto-subject (gnus-id-to-article (mail-header-id header)))))
@@ -929,18 +950,18 @@ article came from is also searched."
(declare-function gnus-registry-get-id-key "gnus-registry" (id key))
-(defun gnus-summary-make-search-group (nnir-extra-parms)
+(defun gnus-summary-make-search-group (no-parse)
"Search a group from the summary buffer.
-Pass NNIR-EXTRA-PARMS on to the search engine."
+Pass NO-PARSE on to the search engine."
(interactive "P")
(gnus-warp-to-article)
(let ((spec
(list
- (cons 'nnir-group-spec
+ (cons 'search-group-spec
(list (list
(gnus-group-server gnus-newsgroup-name)
gnus-newsgroup-name))))))
- (gnus-group-make-search-group nnir-extra-parms spec)))
+ (gnus-group-make-search-group no-parse spec)))
;; The end.
diff --git a/lisp/gnus/nnspool.el b/lisp/gnus/nnspool.el
index 0b6bba5fea7..9de59d8631d 100644
--- a/lisp/gnus/nnspool.el
+++ b/lisp/gnus/nnspool.el
@@ -1,6 +1,6 @@
;;; nnspool.el --- spool access for GNU Emacs
-;; Copyright (C) 1988-1990, 1993-1998, 2000-2020 Free Software
+;; Copyright (C) 1988-1990, 1993-1998, 2000-2021 Free Software
;; Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el
index a5c82447926..c2bb960f945 100644
--- a/lisp/gnus/nntp.el
+++ b/lisp/gnus/nntp.el
@@ -1,6 +1,6 @@
;;; nntp.el --- nntp access for Gnus -*- lexical-binding:t -*-
-;; Copyright (C) 1987-1990, 1992-1998, 2000-2020 Free Software
+;; Copyright (C) 1987-1990, 1992-1998, 2000-2021 Free Software
;; Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -600,7 +600,7 @@ retried once before actually displaying the error report."
nil)))
(defun nntp-with-open-group-function (group server connectionless bodyfun)
- "Protect against servers that don't like clients that keep idle connections opens.
+ "Protect against servers that don't like clients that keep idle connections open.
The problem being that these servers may either close a connection or
simply ignore any further requests on a connection. Closed
connections are not detected until `accept-process-output' has updated
@@ -651,7 +651,7 @@ command whose response triggered the error."
nntp-with-open-group-internal))
(defmacro nntp-with-open-group (group server &optional connectionless &rest forms)
- "Protect against servers that don't like clients that keep idle connections opens.
+ "Protect against servers that don't like clients that keep idle connections open.
The problem being that these servers may either close a connection or
simply ignore any further requests on a connection. Closed
connections are not detected until `accept-process-output' has updated
@@ -1209,7 +1209,7 @@ If SEND-IF-FORCE, only send authinfo to the server if the
(read-passwd (format "NNTP (%s@%s) password: "
user nntp-address)))))))
(if (not result)
- (signal 'nntp-authinfo-rejected "Password rejected")
+ (error "Password rejected")
result))))))
;;; Internal functions.
@@ -1751,7 +1751,8 @@ If SEND-IF-FORCE, only send authinfo to the server if the
;; ==========================================================================
(defvoo nntp-open-telnet-envuser nil
- "If non-nil, telnet session (client and server both) will support the ENVIRON option and not prompt for login name.")
+ "If non-nil, telnet session supports the ENVIRON option.
+Don't prompt for login name. This applies to both client and server.")
(defvoo nntp-telnet-shell-prompt "bash\\|[$>] *\r?$"
"Regular expression to match the shell prompt on the remote machine.")
diff --git a/lisp/gnus/nnvirtual.el b/lisp/gnus/nnvirtual.el
index 54c2f7be820..ba2934351d6 100644
--- a/lisp/gnus/nnvirtual.el
+++ b/lisp/gnus/nnvirtual.el
@@ -1,6 +1,6 @@
;;; nnvirtual.el --- virtual newsgroups access for Gnus
-;; Copyright (C) 1994-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2021 Free Software Foundation, Inc.
;; Author: David Moore <dmoore@ucsd.edu>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -61,22 +61,27 @@ component group will show up when you enter the virtual group.")
(defvoo nnvirtual-current-group nil)
(defvoo nnvirtual-mapping-table nil
- "Table of rules on how to map between component group and article number to virtual article number.")
+ "Table of rules for mapping groups and articles to virtual article numbers.
+These rules determine how to map between component group and article number
+on the one hand, and virtual article number on the other hand.")
(defvoo nnvirtual-mapping-offsets nil
- "Table indexed by component group to an offset to be applied to article numbers in that group.")
+ "Table of mapping offsets to be applied to article numbers in a group.
+The table is indexed by component group number of the group.")
(defvoo nnvirtual-mapping-len 0
"Number of articles in this virtual group.")
(defvoo nnvirtual-mapping-reads nil
- "Compressed sequence of read articles on the virtual group as computed from the unread status of individual component groups.")
+ "Compressed sequence of read articles on the virtual group.
+It is computed from the unread status of individual component groups.")
(defvoo nnvirtual-mapping-marks nil
- "Compressed marks alist for the virtual group as computed from the marks of individual component groups.")
+ "Compressed marks alist for the virtual group.
+It is computed from the marks of individual component groups.")
(defvoo nnvirtual-info-installed nil
- "T if we have already installed the group info for this group, and shouldn't blast over it again.")
+ "t if the group info for this group is already installed.")
(defvoo nnvirtual-status-string "")
@@ -96,15 +101,10 @@ component group will show up when you enter the virtual group.")
(erase-buffer)
(if (stringp (car articles))
'headers
- (let ((vbuf (nnheader-set-temp-buffer
- (gnus-get-buffer-create " *virtual headers*")))
- (carticles (nnvirtual-partition-sequence articles))
+ (let ((carticles (nnvirtual-partition-sequence articles))
(sysname (system-name))
- cgroup carticle article result prefix)
- (while carticles
- (setq cgroup (caar carticles))
- (setq articles (cdar carticles))
- (pop carticles)
+ cgroup headers all-headers article prefix)
+ (pcase-dolist (`(,cgroup . ,articles) carticles)
(when (and articles
(gnus-check-server
(gnus-find-method-for-group cgroup) t)
@@ -114,69 +114,37 @@ component group will show up when you enter the virtual group.")
;; 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))
- (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)))))))
+ (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)))))))))
(defvoo nnvirtual-last-accessed-component-group nil)
@@ -367,61 +335,18 @@ component group will show up when you enter the virtual group.")
;;; Internal functions.
-(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-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-possibly-change-server (server)
(or (not server)
@@ -662,7 +587,7 @@ the result."
(defun nnvirtual-create-mapping (dont-check)
- "Build the tables necessary to map between component (group, article) to virtual article.
+ "Build tables to map between component (group, article) to virtual article.
Generate the set of read messages and marks for the virtual group
based on the marks on the component groups."
(let ((cnt 0)
diff --git a/lisp/gnus/nnweb.el b/lisp/gnus/nnweb.el
index 64b6f495197..b8fb4a8373a 100644
--- a/lisp/gnus/nnweb.el
+++ b/lisp/gnus/nnweb.el
@@ -1,6 +1,6 @@
;;; nnweb.el --- retrieving articles via web search engines
-;; Copyright (C) 1996-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
diff --git a/lisp/gnus/score-mode.el b/lisp/gnus/score-mode.el
index d8d8af8de1b..b8726c03c3e 100644
--- a/lisp/gnus/score-mode.el
+++ b/lisp/gnus/score-mode.el
@@ -1,6 +1,6 @@
;;; score-mode.el --- mode for editing Gnus score files
-;; Copyright (C) 1996, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 2001-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news, mail
diff --git a/lisp/gnus/smiley.el b/lisp/gnus/smiley.el
index 3edae04fcc0..d9e04f3b40c 100644
--- a/lisp/gnus/smiley.el
+++ b/lisp/gnus/smiley.el
@@ -1,6 +1,6 @@
;;; smiley.el --- displaying smiley faces
-;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: news mail multimedia
diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el
index eb27fee88ce..ae5d171d871 100644
--- a/lisp/gnus/smime.el
+++ b/lisp/gnus/smime.el
@@ -1,6 +1,6 @@
;;; smime.el --- S/MIME support library -*- lexical-binding:t -*-
-;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
;; Keywords: SMIME X.509 PEM OpenSSL
@@ -398,7 +398,7 @@ 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)
- "smime" "-verify" "-noverify" "-out" '("/dev/null"))
+ "smime" "-verify" "-noverify" "-out" `(,null-device))
t
(insert-buffer-substring smime-details-buffer)
nil))
diff --git a/lisp/gnus/spam-report.el b/lisp/gnus/spam-report.el
index f414c1ef069..8c148ce9d91 100644
--- a/lisp/gnus/spam-report.el
+++ b/lisp/gnus/spam-report.el
@@ -1,6 +1,6 @@
;;; spam-report.el --- Reporting spam
-;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Author: Ted Zlatanov <tzz@lifelogs.com>
;; Keywords: network, spam, mail, gmane, report
diff --git a/lisp/gnus/spam-stat.el b/lisp/gnus/spam-stat.el
index bf593865d72..3662ade2663 100644
--- a/lisp/gnus/spam-stat.el
+++ b/lisp/gnus/spam-stat.el
@@ -1,6 +1,6 @@
;;; spam-stat.el --- detecting spam based on statistics
-;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Author: Alex Schroeder <alex@gnu.org>
;; Keywords: network
diff --git a/lisp/gnus/spam-wash.el b/lisp/gnus/spam-wash.el
index 7ce0ce24d17..1d00a39060d 100644
--- a/lisp/gnus/spam-wash.el
+++ b/lisp/gnus/spam-wash.el
@@ -1,6 +1,6 @@
;;; spam-wash.el --- wash spam before analysis
-;; Copyright (C) 2004, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2004, 2007-2021 Free Software Foundation, Inc.
;; Author: Andrew Cohen <cohen@andy.bu.edu>
;; Keywords: mail
diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el
index 96a7da2313c..22810332b65 100644
--- a/lisp/gnus/spam.el
+++ b/lisp/gnus/spam.el
@@ -1,6 +1,6 @@
;;; spam.el --- Identifying spam
-;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Maintainer: Ted Zlatanov <tzz@lifelogs.com>
@@ -44,12 +44,9 @@
;;; for the definitions of group content classification and spam processors
(require 'gnus)
-(eval-when-compile (require 'hashcash))
-
-;; for nnimap-split-download-body-default
-(eval-when-compile (require 'nnimap))
-
-(eval-when-compile (require 'cl-lib))
+(eval-when-compile
+ (require 'cl-lib)
+ (require 'hashcash))
;; autoload query-dig
(autoload 'query-dig "dig")
@@ -1228,10 +1225,20 @@ Will not return a nil score."
;;{{{ set up widening, processor checks
-;;; set up IMAP widening if it's necessary
+(defconst spam--widened (list ())
+ "Unique value identifying changes to `nnimap--split-download-body'.")
+
(defun spam-setup-widening ()
- (when (spam-widening-needed-p)
- (setq nnimap-split-download-body-default t)))
+ "Set up IMAP widening if it's necessary."
+ (and (boundp 'nnimap--split-download-body)
+ (not nnimap--split-download-body)
+ (spam-widening-needed-p)
+ (setq nnimap--split-download-body spam--widened)))
+
+(defun spam-teardown-widening ()
+ "Tear down IMAP widening."
+ (when (eq (bound-and-true-p nnimap--split-download-body) spam--widened)
+ (setq nnimap--split-download-body nil)))
(defun spam-widening-needed-p (&optional force-symbols)
(let (found)
@@ -2865,6 +2872,7 @@ installed through `spam-necessary-extra-headers'."
(defun spam-unload-hook ()
"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)
diff --git a/lisp/help-at-pt.el b/lisp/help-at-pt.el
index 1d9e051a8cf..e17bd0a081b 100644
--- a/lisp/help-at-pt.el
+++ b/lisp/help-at-pt.el
@@ -1,6 +1,6 @@
;;; help-at-pt.el --- local help through the keyboard
-;; Copyright (C) 2003-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
;; Author: Luc Teirlinck <teirllm@auburn.edu>
;; Keywords: help
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 170f497541a..da905192467 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -1,6 +1,6 @@
;;; help-fns.el --- Complex help functions -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1986, 1993-1994, 1998-2020 Free Software
+;; Copyright (C) 1985-1986, 1993-1994, 1998-2021 Free Software
;; Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
@@ -126,17 +126,48 @@ with the current prefix. The files are chosen according to
:group 'help
:version "26.3")
+(defun help--symbol-completion-table-affixation (completions)
+ (mapcar (lambda (c)
+ (let* ((s (intern c))
+ (doc (condition-case nil (documentation s) (error nil)))
+ (doc (and doc (substring doc 0 (string-match "\n" doc)))))
+ (list c (propertize
+ (concat (cond ((commandp s)
+ "c") ; command
+ ((eq (car-safe (symbol-function s)) 'macro)
+ "m") ; macro
+ ((fboundp s)
+ "f") ; function
+ ((custom-variable-p s)
+ "u") ; user option
+ ((boundp s)
+ "v") ; variable
+ ((facep s)
+ "a") ; fAce
+ ((and (fboundp 'cl-find-class)
+ (cl-find-class s))
+ "t") ; CL type
+ (" ")) ; something else
+ " ") ; prefix separator
+ 'face 'completions-annotations)
+ (if doc (propertize (format " -- %s" doc)
+ 'face 'completions-annotations)
+ ""))))
+ completions))
+
(defun help--symbol-completion-table (string pred action)
- (when help-enable-completion-autoload
- (let ((prefixes (radix-tree-prefixes (help-definition-prefixes) string)))
- (help--load-prefixes prefixes)))
- (let ((prefix-completions
- (and help-enable-completion-autoload
- (mapcar #'intern (all-completions string definition-prefixes)))))
- (complete-with-action action obarray string
- (if pred (lambda (sym)
- (or (funcall pred sym)
- (memq sym prefix-completions)))))))
+ (if (and completions-detailed (eq action 'metadata))
+ '(metadata (affixation-function . help--symbol-completion-table-affixation))
+ (when help-enable-completion-autoload
+ (let ((prefixes (radix-tree-prefixes (help-definition-prefixes) string)))
+ (help--load-prefixes prefixes)))
+ (let ((prefix-completions
+ (and help-enable-completion-autoload
+ (mapcar #'intern (all-completions string definition-prefixes)))))
+ (complete-with-action action obarray string
+ (if pred (lambda (sym)
+ (or (funcall pred sym)
+ (memq sym prefix-completions))))))))
(defvar describe-function-orig-buffer nil
"Buffer that was current when `describe-function' was invoked.
@@ -622,7 +653,7 @@ FILE is the file where FUNCTION was probably defined."
;; of the *packages* in which the function is defined.
(let* ((name (symbol-name symbol))
(re (concat "\\_<" (regexp-quote name) "\\_>"))
- (news (directory-files data-directory t "\\`NEWS\\($\\|\\.\\)"))
+ (news (directory-files data-directory t "\\`NEWS\\(\\'\\|\\.\\)"))
(place nil)
(first nil))
(with-temp-buffer
@@ -682,7 +713,9 @@ FILE is the file where FUNCTION was probably defined."
(insert-text-button
(symbol-name group)
'action (lambda (_)
- (shortdoc-display-group group))))
+ (shortdoc-display-group group))
+ 'follow-link t
+ 'help-echo (purecopy "mouse-1, RET: show documentation group")))
groups)
(insert (if (= (length groups) 1)
" group.\n"
@@ -1106,8 +1139,7 @@ it is displayed along with the global value."
(when (looking-at "value is") (replace-match ""))
(save-excursion
(insert "\n\nValue:")
- (set (make-local-variable 'help-button-cache)
- (point-marker)))
+ (setq-local help-button-cache (point-marker)))
(insert "value is shown ")
(insert-button "below"
'action help-button-cache
@@ -1621,6 +1653,9 @@ in `describe-keymap'. See also `Searching the Active Keymaps'."
(get-char-property (point) 'local-map)
(current-local-map)))))
+(defvar keymap-name-history nil
+ "History for input to `describe-keymap'.")
+
;;;###autoload
(defun describe-keymap (keymap)
"Describe key bindings in KEYMAP.
diff --git a/lisp/help-macro.el b/lisp/help-macro.el
index 877de781217..791b10a878f 100644
--- a/lisp/help-macro.el
+++ b/lisp/help-macro.el
@@ -1,6 +1,6 @@
;;; help-macro.el --- makes command line help such as help-for-help
-;; Copyright (C) 1993-1994, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2001-2021 Free Software Foundation, Inc.
;; Author: Lynn Slater <lrs@indetech.com>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index f0770fb6602..7043f12c9a3 100644
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -1,6 +1,6 @@
;;; help-mode.el --- `help-mode' used by *Help* buffers -*- lexical-binding: t; -*-
-;; Copyright (C) 1985-1986, 1993-1994, 1998-2020 Free Software
+;; Copyright (C) 1985-1986, 1993-1994, 1998-2021 Free Software
;; Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
@@ -29,7 +29,6 @@
;;; Code:
-(require 'button)
(require 'cl-lib)
(eval-when-compile (require 'easymenu))
@@ -320,10 +319,10 @@ The format is (FUNCTION ARGS...).")
Entry to this mode runs the normal hook `help-mode-hook'.
Commands:
\\{help-mode-map}"
- (set (make-local-variable 'revert-buffer-function)
- 'help-mode-revert-buffer)
- (set (make-local-variable 'bookmark-make-record-function)
- 'help-bookmark-make-record))
+ (setq-local revert-buffer-function
+ #'help-mode-revert-buffer)
+ (setq-local bookmark-make-record-function
+ #'help-bookmark-make-record))
;;;###autoload
(defun help-mode-setup ()
@@ -358,8 +357,7 @@ Commands:
"\\(symbol\\|program\\|property\\)\\|" ; Don't link
"\\(source \\(?:code \\)?\\(?:of\\|for\\)\\)\\)"
"[ \t\n]+\\)?"
- ;; Note starting with word-syntax character:
- "['`‘]\\(\\sw\\(\\sw\\|\\s_\\)+\\|`\\)['’]"))
+ "['`‘]\\(\\(?:\\sw\\|\\s_\\)+\\|`\\)['’]"))
"Regexp matching doc string references to symbols.
The words preceding the quoted symbol can be used in doc strings to
diff --git a/lisp/help.el b/lisp/help.el
index df055d602fe..084e941549e 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -1,6 +1,6 @@
;;; help.el --- help commands for Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1985-1986, 1993-1994, 1998-2020 Free Software
+;; Copyright (C) 1985-1986, 1993-1994, 1998-2021 Free Software
;; Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
@@ -1103,13 +1103,13 @@ Otherwise, return a new string (without any text properties)."
(describe-map-tree this-keymap t (nreverse earlier-maps)
nil nil t nil nil t))))))))
;; 2. Handle quotes.
- ((and (eq (get-quoting-style) 'curve)
+ ((and (eq (text-quoting-style) 'curve)
(or (and (= (following-char) ?\`)
(prog1 t (insert "‘")))
(and (= (following-char) ?')
(prog1 t (insert "’")))))
(delete-char 1))
- ((and (eq (get-quoting-style) 'straight)
+ ((and (eq (text-quoting-style) 'straight)
(= (following-char) ?\`))
(insert "'")
(delete-char 1))
@@ -1189,8 +1189,8 @@ Any inserted text ends in two newlines (used by
;; map.
(or (keymapp sub-shadows)
(null sub-shadows)
- (consp sub-shadows)
- (not (keymapp (car sub-shadows)))))
+ (and (consp sub-shadows)
+ (keymapp (car sub-shadows)))))
;; Maps we have already listed in this loop shadow this map.
(let ((tail orig-maps))
(while (not (equal tail maps))
@@ -1310,6 +1310,7 @@ TRANSL, PARTIAL, SHADOW, NOMENU, MENTION-SHADOW are as in
((and mention-shadow (not (eq tem definition)))
(setq this-shadowed t))
(t nil))))
+ (eq definition (lookup-key tail (vector event) t))
(push (list event definition this-shadowed) vect))))
((eq (car tail) 'keymap)
;; The same keymap might be in the structure twice, if
diff --git a/lisp/hex-util.el b/lisp/hex-util.el
index d3ea705b944..41bdc39875a 100644
--- a/lisp/hex-util.el
+++ b/lisp/hex-util.el
@@ -1,6 +1,6 @@
;;; hex-util.el --- Functions to encode/decode hexadecimal string -*- lexical-binding: t -*-
-;; Copyright (C) 1999, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2001-2021 Free Software Foundation, Inc.
;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
;; Keywords: data
diff --git a/lisp/hexl.el b/lisp/hexl.el
index 5d813c410c2..8d3cfe6de4f 100644
--- a/lisp/hexl.el
+++ b/lisp/hexl.el
@@ -1,6 +1,6 @@
;;; hexl.el --- edit a file in a hex dump format using the hexl filter -*- lexical-binding: t -*-
-;; Copyright (C) 1989, 1994, 1998, 2001-2020 Free Software Foundation,
+;; Copyright (C) 1989, 1994, 1998, 2001-2021 Free Software Foundation,
;; Inc.
;; Author: Keith Gabryelski <ag@wheaties.ai.mit.edu>
@@ -722,7 +722,10 @@ With prefix arg N, puts point N bytes of the way from the true beginning."
"Scroll hexl buffer window upward ARG lines; or near full window if no ARG."
(interactive "P")
(setq arg (if (null arg)
- (1- (window-height))
+ (- (window-height)
+ 1
+ (if ruler-mode 1 0)
+ next-screen-context-lines)
(prefix-numeric-value arg)))
(hexl-scroll-up (- arg)))
@@ -731,7 +734,10 @@ With prefix arg N, puts point N bytes of the way from the true beginning."
If there's no byte at the target address, move to the first or last line."
(interactive "P")
(setq arg (if (null arg)
- (1- (window-height))
+ (- (window-height)
+ 1
+ (if ruler-mode 1 0)
+ next-screen-context-lines)
(prefix-numeric-value arg)))
(let* ((movement (* arg 16))
(address (hexl-current-address))
diff --git a/lisp/hfy-cmap.el b/lisp/hfy-cmap.el
index a3398f6e809..b7de65f5b78 100644
--- a/lisp/hfy-cmap.el
+++ b/lisp/hfy-cmap.el
@@ -1,6 +1,6 @@
;;; hfy-cmap.el --- Fallback color name -> rgb mapping for `htmlfontify' -*- lexical-binding:t -*-
-;; Copyright (C) 2002-2003, 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2003, 2009-2021 Free Software Foundation, Inc.
;; Emacs Lisp Archive Entry
;; Package: htmlfontify
diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el
index 536a1af8462..e214ab640de 100644
--- a/lisp/hi-lock.el
+++ b/lisp/hi-lock.el
@@ -1,6 +1,6 @@
;;; hi-lock.el --- minor mode for interactive automatic highlighting -*- lexical-binding: t -*-
-;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;; Author: David M. Koppelman <koppel@ece.lsu.edu>
;; Keywords: faces, minor-mode, matching, display
@@ -87,8 +87,6 @@
;;; Code:
-(require 'font-lock)
-
(defgroup hi-lock nil
"Interactively add and remove font-lock patterns for highlighting text."
:link '(custom-manual "(emacs)Highlight Interactively")
diff --git a/lisp/hilit-chg.el b/lisp/hilit-chg.el
index ae97bb008af..fb33cd92e35 100644
--- a/lisp/hilit-chg.el
+++ b/lisp/hilit-chg.el
@@ -1,6 +1,6 @@
;;; hilit-chg.el --- minor mode displaying buffer changes with special face
-;; Copyright (C) 1998, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2000-2021 Free Software Foundation, Inc.
;; Author: Richard Sharman <rsharman@pobox.com>
;; Keywords: faces
diff --git a/lisp/hippie-exp.el b/lisp/hippie-exp.el
index ce5fc585c81..4d020232939 100644
--- a/lisp/hippie-exp.el
+++ b/lisp/hippie-exp.el
@@ -1,6 +1,6 @@
;;; hippie-exp.el --- expand text trying various ways to find its expansion
-;; Copyright (C) 1992, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 2001-2021 Free Software Foundation, Inc.
;; Author: Anders Holst <aho@sans.kth.se>
;; Maintainer: emacs-devel@gnu.org
@@ -411,14 +411,14 @@ undoes the expansion."
"Construct a function similar to `hippie-expand'.
Make it use the expansion functions in TRY-LIST. An optional second
argument VERBOSE non-nil makes the function verbose."
- `(function (lambda (arg)
- ,(concat
- "Try to expand text before point, using the following functions: \n"
- (mapconcat 'prin1-to-string (eval try-list) ", "))
- (interactive "P")
- (let ((hippie-expand-try-functions-list ,try-list)
- (hippie-expand-verbose ,verbose))
- (hippie-expand arg)))))
+ `(lambda (arg)
+ ,(concat
+ "Try to expand text before point, using the following functions: \n"
+ (mapconcat 'prin1-to-string (eval try-list) ", "))
+ (interactive "P")
+ (let ((hippie-expand-try-functions-list ,try-list)
+ (hippie-expand-verbose ,verbose))
+ (hippie-expand arg))))
;;; Here follows the try-functions and their requisites:
@@ -534,10 +534,10 @@ string). It returns t if a new completion is found, nil otherwise."
(setq he-expand-list
(and (not (equal he-search-string ""))
(sort (all-completions he-search-string obarray
- (function (lambda (sym)
+ (lambda (sym)
(or (boundp sym)
(fboundp sym)
- (symbol-plist sym)))))
+ (symbol-plist sym))))
'string-lessp)))))
(while (and he-expand-list
(he-string-member (car he-expand-list) he-tried-table))
@@ -563,10 +563,10 @@ otherwise."
(if (not (string= he-search-string ""))
(setq expansion
(try-completion he-search-string obarray
- (function (lambda (sym)
+ (lambda (sym)
(or (boundp sym)
(fboundp sym)
- (symbol-plist sym)))))))
+ (symbol-plist sym))))))
(if (or (eq expansion t)
(string= expansion he-search-string)
(he-string-member expansion he-tried-table))
@@ -821,10 +821,10 @@ string). It returns t if a new expansion is found, nil otherwise."
(he-init-string (he-dabbrev-beg) (point))
(setq he-expand-list
(and (not (equal he-search-string ""))
- (mapcar (function (lambda (sym)
+ (mapcar (lambda (sym)
(if (and (boundp sym) (vectorp (eval sym)))
(abbrev-expansion (downcase he-search-string)
- (eval sym)))))
+ (eval sym))))
(append '(local-abbrev-table
global-abbrev-table)
abbrev-table-name-list))))))
diff --git a/lisp/hl-line.el b/lisp/hl-line.el
index fe7e03f6bc2..73870f9579e 100644
--- a/lisp/hl-line.el
+++ b/lisp/hl-line.el
@@ -1,6 +1,6 @@
;;; hl-line.el --- highlight the current line -*- lexical-binding:t -*-
-;; Copyright (C) 1998, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2000-2021 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el
index ed2cd26f0de..bfbe0ee165b 100644
--- a/lisp/htmlfontify.el
+++ b/lisp/htmlfontify.el
@@ -1,6 +1,6 @@
;;; htmlfontify.el --- htmlize a buffer/source tree with optional hyperlinks -*- lexical-binding: t -*-
-;; Copyright (C) 2002-2003, 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2003, 2009-2021 Free Software Foundation, Inc.
;; Emacs Lisp Archive Entry
;; Package: htmlfontify
@@ -78,12 +78,6 @@
;;; Code:
(eval-when-compile (require 'cl-lib))
-(require 'faces)
-;; (`facep' `face-attr-construct' `x-color-values' `color-values' `face-name')
-(require 'custom)
-;; (`defgroup' `defcustom')
-(require 'font-lock)
-;; (`font-lock-fontify-region')
(require 'cus-edit)
(require 'htmlfontify-loaddefs)
@@ -1857,9 +1851,7 @@ Hardly bombproof, but good enough in the context in which it is being used."
adding an extension of `hfy-extn'. Fontification is actually done by
`htmlfontify-buffer'. If the buffer is not fontified, just copy it."
;;(message "hfy-copy-and-fontify-file");;DBUG
- (let (;;(fast-lock-minimum-size hfy-fast-lock-save)
- ;;(font-lock-support-mode 'fast-lock-mode)
- ;;(window-system (or window-system 'htmlfontify))
+ (let (;;(window-system (or window-system 'htmlfontify))
(target nil)
(source nil)
(html nil))
diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el
index 80c5b073985..ed5c9c02115 100644
--- a/lisp/ibuf-ext.el
+++ b/lisp/ibuf-ext.el
@@ -1,6 +1,6 @@
;;; ibuf-ext.el --- extensions for ibuffer -*- lexical-binding:t -*-
-;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;; Author: Colin Walters <walters@verbum.org>
;; Maintainer: John Paul Wallington <jpw@gnu.org>
@@ -208,11 +208,9 @@ either clicking or hitting return "
'follow-link t
'help-echo "Click or RET: save new value in customize"
'action (lambda (_)
- (if (not (fboundp 'customize-save-variable))
- (message "Customize not available; value not saved")
- (customize-save-variable 'ibuffer-saved-filters
- ibuffer-saved-filters)
- (message "Saved updated ibuffer-saved-filters."))))
+ (customize-save-variable 'ibuffer-saved-filters
+ ibuffer-saved-filters)
+ (message "Saved updated ibuffer-saved-filters.")))
". See below for
an explanation and alternative ways to save the repaired value.
@@ -1116,13 +1114,10 @@ filter into parts."
(defun ibuffer-maybe-save-stuff ()
(when ibuffer-save-with-custom
- (if (fboundp 'customize-save-variable)
- (progn
- (customize-save-variable 'ibuffer-saved-filters
- ibuffer-saved-filters)
- (customize-save-variable 'ibuffer-saved-filter-groups
- ibuffer-saved-filter-groups))
- (message "Not saved permanently: Customize not available"))))
+ (customize-save-variable 'ibuffer-saved-filters
+ ibuffer-saved-filters)
+ (customize-save-variable 'ibuffer-saved-filter-groups
+ ibuffer-saved-filter-groups)))
;;;###autoload
(defun ibuffer-save-filters (name filters)
@@ -1828,18 +1823,12 @@ When BUF nil, default to the buffer at current line."
;;;###autoload
(defun ibuffer-mark-by-file-name-regexp (regexp)
"Mark all buffers whose file name matches REGEXP."
- (interactive "sMark by file name (regexp): ")
+ (interactive (list (read-regexp "Mark by file name (regexp)")))
(ibuffer-mark-on-buffer
- #'(lambda (buf)
- (let ((name (or (buffer-file-name buf)
- (with-current-buffer buf
- (and
- (boundp 'dired-directory)
- (stringp dired-directory)
- dired-directory)))))
- (when name
- ;; Match on the displayed file name (which is abbreviated).
- (string-match regexp (abbreviate-file-name name)))))))
+ (lambda (buf)
+ (when-let ((name (with-current-buffer buf (ibuffer-buffer-file-name))))
+ ;; Match on the displayed file name (which is abbreviated).
+ (string-match-p regexp (ibuffer--abbreviate-file-name name))))))
;;;###autoload
(defun ibuffer-mark-by-content-regexp (regexp &optional all-buffers)
diff --git a/lisp/ibuf-macs.el b/lisp/ibuf-macs.el
index 0d5fd9c8629..be09c6582ce 100644
--- a/lisp/ibuf-macs.el
+++ b/lisp/ibuf-macs.el
@@ -1,6 +1,6 @@
;;; ibuf-macs.el --- macros for ibuffer -*- lexical-binding:t -*-
-;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;; Author: Colin Walters <walters@verbum.org>
;; Maintainer: John Paul Wallington <jpw@gnu.org>
diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el
index 8ff3b56c5e6..84c53b16acf 100644
--- a/lisp/ibuffer.el
+++ b/lisp/ibuffer.el
@@ -1,6 +1,6 @@
;;; ibuffer.el --- operate on buffers like dired -*- lexical-binding:t -*-
-;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;; Author: Colin Walters <walters@verbum.org>
;; Maintainer: John Paul Wallington <jpw@gnu.org>
@@ -48,7 +48,6 @@
(require 'ibuf-macs)
(require 'dired))
-(require 'font-core)
(require 'seq)
(require 'ibuffer-loaddefs)
@@ -1309,6 +1308,11 @@ a new window in the current frame, splitting vertically."
(car dired-directory)))))
(and dirname (expand-file-name dirname))))))
+(defun ibuffer--abbreviate-file-name (filename)
+ "Abbreviate FILENAME using `ibuffer-directory-abbrev-alist'."
+ (let ((directory-abbrev-alist ibuffer-directory-abbrev-alist))
+ (abbreviate-file-name filename)))
+
(define-ibuffer-op ibuffer-do-save ()
"Save marked buffers as with `save-buffer'."
(:complex t
@@ -1886,9 +1890,7 @@ If point is on a group name, this function operates on that group."
(cond ((zerop total) "No files")
((= 1 total) "1 file")
(t (format "%d files" total))))))
- (let ((directory-abbrev-alist ibuffer-directory-abbrev-alist))
- (abbreviate-file-name
- (or (ibuffer-buffer-file-name) ""))))
+ (ibuffer--abbreviate-file-name (or (ibuffer-buffer-file-name) "")))
(define-ibuffer-column filename-and-process
(:name "Filename/Process"
@@ -2465,7 +2467,7 @@ FORMATS is the value to use for `ibuffer-formats'.
(require 'ibuf-ext)
(setq ibuffer-filter-groups filter-groups))
(when formats
- (set (make-local-variable 'ibuffer-formats) formats))
+ (setq-local ibuffer-formats formats))
(ibuffer-update nil)
;; Skip the group name by default.
(ibuffer-forward-line 0 t)
@@ -2684,7 +2686,7 @@ You may rearrange filter groups by using the usual pair
`\\[ibuffer-kill-line]' and `\\[ibuffer-yank]'. Yanked groups
will be inserted before the group at point."
;; Include state info next to the mode name.
- (set (make-local-variable 'mode-line-process)
+ (setq-local mode-line-process
'(" by "
(ibuffer-sorting-mode (:eval (symbol-name ibuffer-sorting-mode))
"view time")
@@ -2713,28 +2715,27 @@ will be inserted before the group at point."
(setq show-trailing-whitespace nil)
;; disable `show-paren-mode' buffer-locally
(if (bound-and-true-p show-paren-mode)
- (set (make-local-variable 'show-paren-mode) nil))
- (set (make-local-variable 'revert-buffer-function)
- #'ibuffer-update)
- (set (make-local-variable 'ibuffer-sorting-mode)
- ibuffer-default-sorting-mode)
- (set (make-local-variable 'ibuffer-sorting-reversep)
- ibuffer-default-sorting-reversep)
- (set (make-local-variable 'ibuffer-shrink-to-minimum-size)
- ibuffer-default-shrink-to-minimum-size)
- (set (make-local-variable 'ibuffer-display-maybe-show-predicates)
- ibuffer-default-display-maybe-show-predicates)
- (set (make-local-variable 'ibuffer-filtering-qualifiers) nil)
- (set (make-local-variable 'ibuffer-filter-groups) nil)
- (set (make-local-variable 'ibuffer-filter-group-kill-ring) nil)
- (set (make-local-variable 'ibuffer-hidden-filter-groups) nil)
- (set (make-local-variable 'ibuffer-compiled-formats) nil)
- (set (make-local-variable 'ibuffer-cached-formats) nil)
- (set (make-local-variable 'ibuffer-cached-eliding-string) nil)
- (set (make-local-variable 'ibuffer-current-format) nil)
- (set (make-local-variable 'ibuffer-did-modification) nil)
- (set (make-local-variable 'ibuffer-tmp-hide-regexps) nil)
- (set (make-local-variable 'ibuffer-tmp-show-regexps) nil)
+ (setq-local show-paren-mode nil))
+ (setq-local revert-buffer-function #'ibuffer-update)
+ (setq-local ibuffer-sorting-mode
+ ibuffer-default-sorting-mode)
+ (setq-local ibuffer-sorting-reversep
+ ibuffer-default-sorting-reversep)
+ (setq-local ibuffer-shrink-to-minimum-size
+ ibuffer-default-shrink-to-minimum-size)
+ (setq-local ibuffer-display-maybe-show-predicates
+ ibuffer-default-display-maybe-show-predicates)
+ (setq-local ibuffer-filtering-qualifiers nil)
+ (setq-local ibuffer-filter-groups nil)
+ (setq-local ibuffer-filter-group-kill-ring nil)
+ (setq-local ibuffer-hidden-filter-groups nil)
+ (setq-local ibuffer-compiled-formats nil)
+ (setq-local ibuffer-cached-formats nil)
+ (setq-local ibuffer-cached-eliding-string nil)
+ (setq-local ibuffer-current-format nil)
+ (setq-local ibuffer-did-modification nil)
+ (setq-local ibuffer-tmp-hide-regexps nil)
+ (setq-local ibuffer-tmp-show-regexps nil)
(define-key ibuffer-mode-map [menu-bar edit] 'undefined)
(define-key ibuffer-mode-map [menu-bar operate] (cons "Operate" ibuffer-mode-operate-map))
(ibuffer-update-format)
diff --git a/lisp/icomplete.el b/lisp/icomplete.el
index 4e546807b7f..da589c00649 100644
--- a/lisp/icomplete.el
+++ b/lisp/icomplete.el
@@ -1,6 +1,6 @@
;;; icomplete.el --- minibuffer completion incremental feedback -*- lexical-binding: t -*-
-;; Copyright (C) 1992-1994, 1997, 1999, 2001-2020 Free Software
+;; Copyright (C) 1992-1994, 1997, 1999, 2001-2021 Free Software
;; Foundation, Inc.
;; Author: Ken Manheimer <ken dot manheimer at gmail...>
@@ -76,6 +76,8 @@ selection process starts again from the user's $HOME.")
(defcustom icomplete-show-matches-on-no-input nil
"When non-nil, show completions when first prompting for input.
+This means to show completions even when the current minibuffer contents
+is the same as was the initial input after minibuffer activation.
This also means that if you traverse the list of completions with
commands like `C-.' and just hit RET without typing any
characters, the match under point will be chosen instead of the
@@ -146,6 +148,10 @@ icompletion is occurring."
(defvar icomplete-overlay (make-overlay (point-min) (point-min) nil t t)
"Overlay used to display the list of completions.")
+(defvar icomplete--initial-input nil
+ "Initial input in the minibuffer when icomplete-mode was activated.
+Used to implement the option `icomplete-show-matches-on-no-input'.")
+
(defun icomplete-pre-command-hook ()
(let ((non-essential t))
(icomplete-tidy)))
@@ -169,7 +175,7 @@ icompletion is occurring."
(interactive)
(if (and icomplete-show-matches-on-no-input
(car completion-all-sorted-completions)
- (eql (icomplete--field-end) (icomplete--field-beg)))
+ (equal (icomplete--field-string) icomplete--initial-input))
(icomplete-force-complete-and-exit)
(minibuffer-complete-and-exit)))
@@ -189,7 +195,7 @@ the default otherwise."
(if (or
;; there's some input, meaning the default in off the table by
;; definition; OR
- (> (icomplete--field-end) (icomplete--field-beg))
+ (not (equal (icomplete--field-string) icomplete--initial-input))
;; there's no input, but there's also no minibuffer default
;; (and the user really wants to see completions on no input,
;; meaning he expects a "force" to be at least attempted); OR
@@ -441,7 +447,8 @@ Conditions are:
"Run in minibuffer on activation to establish incremental completion.
Usually run by inclusion in `minibuffer-setup-hook'."
(when (and icomplete-mode (icomplete-simple-completing-p))
- (set (make-local-variable 'completion-show-inline-help) nil)
+ (setq-local icomplete--initial-input (icomplete--field-string))
+ (setq-local completion-show-inline-help nil)
(use-local-map (make-composed-keymap icomplete-minibuffer-map
(current-local-map)))
(add-hook 'pre-command-hook #'icomplete-pre-command-hook nil t)
@@ -464,7 +471,7 @@ Usually run by inclusion in `minibuffer-setup-hook'."
(when (and completion-in-region-mode
icomplete-mode (icomplete-simple-completing-p))
(setq icomplete--in-region-buffer (current-buffer))
- (set (make-local-variable 'completion-show-inline-help) nil)
+ (setq-local completion-show-inline-help nil)
(let ((tem (assq 'completion-in-region-mode
minor-mode-overriding-map-alist)))
(unless (memq icomplete-minibuffer-map (cdr tem))
@@ -486,7 +493,7 @@ Usually run by inclusion in `minibuffer-setup-hook'."
;; `completing-read' invocations, described below:
for fn in (cond ((and minibuffer-default
(stringp minibuffer-default) ; bug#38992
- (= (icomplete--field-end) (icomplete--field-beg)))
+ (equal (icomplete--field-string) icomplete--initial-input))
;; Here, we have a non-nil string default and
;; no input whatsoever. We want to make sure
;; that the default is bubbled to the top so
@@ -579,7 +586,8 @@ See `icomplete-mode' and `minibuffer-setup-hook'."
(goto-char (point-max))
; Insert the match-status information:
(when (and (or icomplete-show-matches-on-no-input
- (> (icomplete--field-end) (icomplete--field-beg)))
+ (not (equal (icomplete--field-string)
+ icomplete--initial-input)))
(or
;; Don't bother with delay after certain number of chars:
(> (- (point) (icomplete--field-beg))
@@ -602,7 +610,7 @@ See `icomplete-mode' and `minibuffer-setup-hook'."
(or (>= (- (point) (overlay-end rfn-eshadow-overlay)) 2)
(eq ?/ (char-before (- (point) 2)))))
(delete-region (overlay-start rfn-eshadow-overlay)
- (overlay-end rfn-eshadow-overlay)) )
+ (overlay-end rfn-eshadow-overlay)))
(let* ((field-string (icomplete--field-string))
;; Not sure why, but such requests seem to come
;; every once in a while. It's not fully
diff --git a/lisp/ido.el b/lisp/ido.el
index c83b700e656..89b6a62f5a8 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -1,6 +1,6 @@
;;; ido.el --- interactively do things with buffers and files -*- lexical-binding: t -*-
-;; Copyright (C) 1996-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
;; Author: Kim F. Storm <storm@cua.dk>
;; Based on: iswitchb by Stephen Eglen <stephen@cns.ed.ac.uk>
@@ -842,7 +842,7 @@ variables:
max-width - the max width of the resulting dirname; nil means no limit
prompt - the basic prompt (e.g. \"Find File: \")
literal - the string shown if doing \"literal\" find; set to nil to omit
- vc-off - the string shown if version control is inhibited; set to nil to omit
+ vc-off - the string shown if version control is inhibited; use nil to omit
prefix - either nil or a fixed prefix for the dirname
The following variables are available, but should not be changed:
@@ -2367,7 +2367,16 @@ If cursor is not at the end of the user input, move to end of input."
(read-file-name-function nil))
(setq this-command (or ido-fallback fallback 'find-file))
(run-hook-with-args 'ido-before-fallback-functions this-command)
- (call-interactively this-command)))
+ (if (eq this-command 'write-file)
+ (write-file (read-file-name
+ "Write file: "
+ default-directory
+ (and buffer-file-name
+ (expand-file-name
+ (file-name-nondirectory buffer-file-name)
+ default-directory)))
+ t)
+ (call-interactively this-command))))
((eq ido-exit 'switch-to-buffer)
(ido-buffer-internal
@@ -3966,7 +3975,7 @@ If `ido-change-word-sub' cannot be found in WORD, return nil."
(boundp 'ido-completion-buffer-full))
(set-window-start win (point-min))
(with-no-warnings
- (set (make-local-variable 'ido-completion-buffer-full) t))
+ (setq-local ido-completion-buffer-full t))
(setq full-list t
display-it t))
(scroll-other-window))
@@ -4810,8 +4819,7 @@ Modified from `icomplete-completions'."
(delete-region ido-eoinput (point-max))))
;; Reestablish the local variable 'cause minibuffer-setup is weird:
- (make-local-variable 'ido-eoinput)
- (setq ido-eoinput 1))))
+ (setq-local ido-eoinput 1))))
(defun ido-summary-buffers-to-end ()
;; Move the summaries to the end of the buffer list.
diff --git a/lisp/ielm.el b/lisp/ielm.el
index b3654b91d37..fd8dac74b74 100644
--- a/lisp/ielm.el
+++ b/lisp/ielm.el
@@ -1,6 +1,6 @@
;;; ielm.el --- interaction mode for Emacs Lisp -*- lexical-binding: t -*-
-;; Copyright (C) 1994, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 2001-2021 Free Software Foundation, Inc.
;; Author: David Smith <maa036@lancaster.ac.uk>
;; Maintainer: emacs-devel@gnu.org
@@ -529,39 +529,40 @@ Customized bindings may be defined in `ielm-map', which currently contains:
:syntax-table emacs-lisp-mode-syntax-table
(setq comint-prompt-regexp (concat "^" (regexp-quote ielm-prompt)))
- (set (make-local-variable 'paragraph-separate) "\\'")
- (set (make-local-variable 'paragraph-start) comint-prompt-regexp)
+ (setq-local paragraph-separate "\\'")
+ (setq-local paragraph-start comint-prompt-regexp)
(setq comint-input-sender 'ielm-input-sender)
(setq comint-process-echoes nil)
- (set (make-local-variable 'completion-at-point-functions)
- '(comint-replace-by-expanded-history
- ielm-complete-filename elisp-completion-at-point))
+ (dolist (f '(elisp-completion-at-point
+ ielm-complete-filename
+ comint-replace-by-expanded-history))
+ (add-hook 'completion-at-point-functions f nil t))
(add-hook 'eldoc-documentation-functions
#'elisp-eldoc-var-docstring nil t)
(add-hook 'eldoc-documentation-functions
#'elisp-eldoc-funcall nil t)
- (set (make-local-variable 'ielm-prompt-internal) ielm-prompt)
- (set (make-local-variable 'comint-prompt-read-only) ielm-prompt-read-only)
+ (setq-local ielm-prompt-internal ielm-prompt)
+ (setq-local comint-prompt-read-only ielm-prompt-read-only)
(setq comint-get-old-input 'ielm-get-old-input)
- (set (make-local-variable 'comint-completion-addsuffix) '("/" . ""))
+ (setq-local comint-completion-addsuffix '("/" . ""))
(setq mode-line-process '(":%s on " (:eval (buffer-name ielm-working-buffer))))
;; Useful for `hs-minor-mode'.
(setq-local comment-start ";")
(setq-local comment-use-syntax t)
(setq-local lexical-binding t)
- (set (make-local-variable 'indent-line-function) #'ielm-indent-line)
- (set (make-local-variable 'ielm-working-buffer) (current-buffer))
- (set (make-local-variable 'fill-paragraph-function) #'lisp-fill-paragraph)
+ (setq-local indent-line-function #'ielm-indent-line)
+ (setq-local ielm-working-buffer (current-buffer))
+ (setq-local fill-paragraph-function #'lisp-fill-paragraph)
;; Value holders
- (set (make-local-variable '*) nil)
- (set (make-local-variable '**) nil)
- (set (make-local-variable '***) nil)
- (set (make-local-variable 'ielm-match-data) nil)
+ (setq-local * nil)
+ (setq-local ** nil)
+ (setq-local *** nil)
+ (setq-local ielm-match-data nil)
;; font-lock support
- (set (make-local-variable 'font-lock-defaults)
+ (setq-local font-lock-defaults
'(ielm-font-lock-keywords nil nil ((?: . "w") (?- . "w") (?* . "w"))))
;; A dummy process to keep comint happy. It will never get any input
@@ -576,7 +577,7 @@ Customized bindings may be defined in `ielm-map', which currently contains:
;; Lisp output can include raw characters that confuse comint's
;; carriage control code.
- (set (make-local-variable 'comint-inhibit-carriage-motion) t)
+ (setq-local comint-inhibit-carriage-motion t)
;; Add a silly header
(insert ielm-header)
diff --git a/lisp/iimage.el b/lisp/iimage.el
index 07c18863249..cc1461d7b0f 100644
--- a/lisp/iimage.el
+++ b/lisp/iimage.el
@@ -1,6 +1,6 @@
;;; iimage.el --- Inline image minor mode.
-;; Copyright (C) 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;; Author: KOSEKI Yoshinori <kose@meadowy.org>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/image-dired.el b/lisp/image-dired.el
index a29adde8325..48f9cd0767c 100644
--- a/lisp/image-dired.el
+++ b/lisp/image-dired.el
@@ -1,6 +1,6 @@
;;; image-dired.el --- use dired to browse and manipulate your images -*- lexical-binding: t -*-
;;
-;; Copyright (C) 2005-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2005-2021 Free Software Foundation, Inc.
;;
;; Version: 0.4.11
;; Keywords: multimedia
diff --git a/lisp/image-file.el b/lisp/image-file.el
index 3b4f5722518..fbc9eaaf94e 100644
--- a/lisp/image-file.el
+++ b/lisp/image-file.el
@@ -1,6 +1,6 @@
;;; image-file.el --- support for visiting image files -*- lexical-binding:t -*-
;;
-;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;;
;; Author: Miles Bader <miles@gnu.org>
;; Keywords: multimedia
diff --git a/lisp/image-mode.el b/lisp/image-mode.el
index 032ebf38733..9ed295e2aa1 100644
--- a/lisp/image-mode.el
+++ b/lisp/image-mode.el
@@ -1,6 +1,6 @@
;;; image-mode.el --- support for visiting image files -*- lexical-binding: t -*-
;;
-;; Copyright (C) 2005-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2005-2021 Free Software Foundation, Inc.
;;
;; Author: Richard Stallman <rms@gnu.org>
;; Keywords: multimedia
@@ -667,6 +667,9 @@ Key bindings:
(when image-auto-resize-on-window-resize
(add-hook 'window-state-change-functions #'image--window-state-change nil t))
+ (add-function :before-while (local 'isearch-filter-predicate)
+ #'image-mode-isearch-filter)
+
(run-mode-hooks 'image-mode-hook)
(let ((image (image-get-display-property))
(msg1 (substitute-command-keys
@@ -782,6 +785,14 @@ Remove text properties that display the image."
(if (called-interactively-p 'any)
(message "Repeat this command to go back to displaying the image"))))
+(defun image-mode-isearch-filter (_beg _end)
+ "Show image as text when trying to search/replace in the image buffer."
+ (save-match-data
+ (when (and (derived-mode-p 'image-mode)
+ (image-get-display-property))
+ (image-mode-as-text)))
+ t)
+
(defvar archive-superior-buffer)
(defvar tar-superior-buffer)
(declare-function image-flush "image.c" (spec &optional frame))
@@ -942,6 +953,9 @@ Otherwise, display the image by calling `image-mode'."
(get-buffer-window-list (current-buffer) 'nomini 'visible))
(image-toggle-display-image)))
+(defvar image-auto-resize-timer nil
+ "Timer for `image-auto-resize-on-window-resize' option.")
+
(defun image--window-state-change (window)
;; Wait for a bit of idle-time before actually performing the change,
;; so as to batch together sequences of closely consecutive size changes.
@@ -950,8 +964,14 @@ Otherwise, display the image by calling `image-mode'."
;; consecutive calls happen without any redisplay between them,
;; the costly operation of image resizing should happen only once.
(when (numberp image-auto-resize-on-window-resize)
- (run-with-idle-timer image-auto-resize-on-window-resize nil
- #'image-fit-to-window window)))
+ (when image-auto-resize-timer
+ (cancel-timer image-auto-resize-timer))
+ (setq image-auto-resize-timer
+ (run-with-idle-timer image-auto-resize-on-window-resize nil
+ #'image-fit-to-window window))))
+
+(defvar image-fit-to-window-lock nil
+ "Lock for `image-fit-to-window' timer function.")
(defun image-fit-to-window (window)
"Adjust size of image to display it exactly in WINDOW boundaries."
@@ -968,7 +988,13 @@ Otherwise, display the image by calling `image-mode'."
(when (and image-width image-height
(or (not (= image-width window-width))
(not (= image-height window-height))))
- (image-toggle-display-image)))))))))
+ (unless image-fit-to-window-lock
+ (unwind-protect
+ (progn
+ (setq-local image-fit-to-window-lock t)
+ (ignore-error 'remote-file-error
+ (image-toggle-display-image)))
+ (setq image-fit-to-window-lock nil)))))))))))
;;; Animated images
diff --git a/lisp/image.el b/lisp/image.el
index 9ebb603086e..814035594b6 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -1,6 +1,6 @@
;;; image.el --- image API -*- lexical-binding:t -*-
-;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: multimedia
@@ -679,8 +679,10 @@ BUFFER nil or omitted means use the current buffer."
(setq path (cdr path)))
(if found filename)))
+(defvar find-image--cache (make-hash-table :test #'equal))
+
;;;###autoload
-(defun find-image (specs)
+(defun find-image (specs &optional cache)
"Find an image, choosing one of a list of image specifications.
SPECS is a list of image specifications.
@@ -695,26 +697,33 @@ is supported, and FILE exists, is used to construct the image
specification to be returned. Return nil if no specification is
satisfied.
+If CACHE is non-nil, results are cached and returned on subsequent calls.
+
The image is looked for in `image-load-path'.
Image files should not be larger than specified by `max-image-size'."
- (let (image)
- (while (and specs (null image))
- (let* ((spec (car specs))
- (type (plist-get spec :type))
- (data (plist-get spec :data))
- (file (plist-get spec :file))
- found)
- (when (image-type-available-p type)
- (cond ((stringp file)
- (if (setq found (image-search-load-path file))
- (setq image
- (cons 'image (plist-put (copy-sequence spec)
- :file found)))))
- ((not (null data))
- (setq image (cons 'image spec)))))
- (setq specs (cdr specs))))
- image))
+ (or (and cache
+ (gethash specs find-image--cache))
+ (let ((orig-specs specs)
+ image)
+ (while (and specs (null image))
+ (let* ((spec (car specs))
+ (type (plist-get spec :type))
+ (data (plist-get spec :data))
+ (file (plist-get spec :file))
+ found)
+ (when (image-type-available-p type)
+ (cond ((stringp file)
+ (if (setq found (image-search-load-path file))
+ (setq image
+ (cons 'image (plist-put (copy-sequence spec)
+ :file found)))))
+ ((not (null data))
+ (setq image (cons 'image spec)))))
+ (setq specs (cdr specs))))
+ (when cache
+ (setf (gethash orig-specs find-image--cache) image))
+ image)))
;;;###autoload
diff --git a/lisp/image/compface.el b/lisp/image/compface.el
index 12473e802b8..6519615f4ec 100644
--- a/lisp/image/compface.el
+++ b/lisp/image/compface.el
@@ -1,6 +1,6 @@
;;; compface.el --- functions for converting X-Face headers -*- lexical-binding: t -*-
-;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: multimedia, news
diff --git a/lisp/image/exif.el b/lisp/image/exif.el
index 6aeb52c726d..2dc9419b817 100644
--- a/lisp/image/exif.el
+++ b/lisp/image/exif.el
@@ -1,6 +1,6 @@
;;; exif.el --- parsing Exif data in JPEG images -*- lexical-binding: t -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: images
@@ -165,7 +165,7 @@ If the orientation isn't present in the data, return nil."
;; Another magical number.
(unless (= (exif--read-number 2 le) #x002a)
(signal 'exif-error "Invalid TIFF header length"))
- (let ((offset (exif--read-number 2 le)))
+ (let ((offset (exif--read-number 4 le)))
;; Jump to where the IFD (directory) starts and parse it.
(when (> (1+ offset) (point-max))
(signal 'exif-error "Invalid IFD (directory) offset"))
diff --git a/lisp/image/gravatar.el b/lisp/image/gravatar.el
index 3543be6de91..4f37834a27f 100644
--- a/lisp/image/gravatar.el
+++ b/lisp/image/gravatar.el
@@ -1,6 +1,6 @@
;;; gravatar.el --- Get Gravatars -*- lexical-binding: t -*-
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Julien Danjou <julien@danjou.info>
;; Keywords: comm, multimedia
diff --git a/lisp/image/image-converter.el b/lisp/image/image-converter.el
index c31a3b8d3cf..e47f1f76e42 100644
--- a/lisp/image/image-converter.el
+++ b/lisp/image/image-converter.el
@@ -1,6 +1,6 @@
;;; image-converter.el --- Converting images from exotic formats -*- lexical-binding: t -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: images
diff --git a/lisp/imenu.el b/lisp/imenu.el
index 8fdacb0214d..b5cd18a689d 100644
--- a/lisp/imenu.el
+++ b/lisp/imenu.el
@@ -1,6 +1,6 @@
;;; imenu.el --- framework for mode-specific buffer indexes -*- lexical-binding: t -*-
-;; Copyright (C) 1994-1998, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1998, 2001-2021 Free Software Foundation, Inc.
;; Author: Ake Stenhoff <etxaksf@aom.ericsson.se>
;; Lars Lindberg <lli@sypro.cap.se>
diff --git a/lisp/indent.el b/lisp/indent.el
index e67109ab431..5c5270b07c4 100644
--- a/lisp/indent.el
+++ b/lisp/indent.el
@@ -1,6 +1,6 @@
;;; indent.el --- indentation commands for Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1985, 1995, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1995, 2001-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Package: emacs
diff --git a/lisp/info-look.el b/lisp/info-look.el
index bcc2930ffc0..fd6f8f15082 100644
--- a/lisp/info-look.el
+++ b/lisp/info-look.el
@@ -1,7 +1,7 @@
;;; info-look.el --- major-mode-sensitive Info index lookup facility -*- lexical-binding: t -*-
;; An older version of this was known as libc.el.
-;; Copyright (C) 1995-1999, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995-1999, 2001-2021 Free Software Foundation, Inc.
;; Author: Ralph Schleicher <rs@ralph-schleicher.de>
;; Keywords: help languages
diff --git a/lisp/info-xref.el b/lisp/info-xref.el
index 6d0ebe0b2a9..be1928d692b 100644
--- a/lisp/info-xref.el
+++ b/lisp/info-xref.el
@@ -1,6 +1,6 @@
;;; info-xref.el --- check external references in an Info document -*- lexical-binding: t -*-
-;; Copyright (C) 2003-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
;; Author: Kevin Ryde <user42@zip.com.au>
;; Keywords: docs
diff --git a/lisp/info.el b/lisp/info.el
index c3684deb96b..dec93928b38 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -1,6 +1,6 @@
;; info.el --- Info package for Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1985-1986, 1992-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1986, 1992-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: help
@@ -160,17 +160,14 @@ A header-line does not scroll with the rest of the buffer."
:version "24.4")
;; This is a defcustom largely so that we can get the benefit
-;; of custom-initialize-delay. Perhaps it would work to make it a
-;; defvar and explicitly give it a standard-value property, and
-;; call custom-initialize-delay on it.
-;; The progn forces the autoloader to include the whole thing, not
-;; just an abbreviated version. The value is initialized at startup
-;; time, when command-line calls custom-reevaluate-setting on all
-;; the defcustoms in custom-delayed-init-variables. This is
-;; somewhat sub-optimal, as ideally this should be done when Info
-;; mode is first invoked.
+;; of `custom-initialize-delay'. Perhaps it would work to make it a
+;; `defvar' and explicitly give it a `standard-value' property, and
+;; call `custom-initialize-delay' on it.
+;; The value is initialized at startup time, when command-line calls
+;; `custom-reevaluate-setting' on all the defcustoms in
+;; `custom-delayed-init-variables'. This is somewhat sub-optimal, as ideally
+;; this should be done when Info mode is first invoked.
;;;###autoload
-(progn
(defcustom Info-default-directory-list
(let* ((config-dir
(file-name-as-directory
@@ -232,8 +229,8 @@ the environment variable INFOPATH is set.
Although this is a customizable variable, that is mainly for technical
reasons. Normally, you should either set INFOPATH or customize
`Info-additional-directory-list', rather than changing this variable."
- :initialize 'custom-initialize-delay
- :type '(repeat directory)))
+ :initialize #'custom-initialize-delay
+ :type '(repeat directory))
(defvar Info-directory-list nil
"List of directories to search for Info documentation files.
@@ -1976,7 +1973,6 @@ If DIRECTION is `backward', search in the reverse direction."
"Regexp search%s" (car Info-search-history)
(if case-fold-search "" " case-sensitively"))
nil 'Info-search-history)))
- (deactivate-mark)
(when (equal regexp "")
(setq regexp (car Info-search-history)))
(when regexp
@@ -2069,6 +2065,7 @@ If DIRECTION is `backward', search in the reverse direction."
(< found opoint-max))
;; Search landed in the same node
(goto-char found)
+ (deactivate-mark)
(widen)
(goto-char found)
(save-match-data (Info-select-node)))
@@ -2473,7 +2470,7 @@ Table of contents is created from the tree structure of menus."
(setq bound (or (and (equal nodename "Top")
(save-excursion
(re-search-forward
- "^[ \t-]*The Detailed Node Listing" nil t)))
+ "^[ \t—-]*The Detailed Node Listing" nil t)))
bound))
(while (< (point) bound)
(cond
@@ -3105,9 +3102,11 @@ See `Info-scroll-down'."
(defun Info-next-reference-or-link (pat prop)
"Move point to the next pattern-based cross-reference or property-based link.
The next cross-reference is searched using the regexp PAT, and the next link
-is searched using the text property PROP. Move point to the closest found position
-of either a cross-reference found by `re-search-forward' or a link found by
-`next-single-char-property-change'. Return the new position of point, or nil."
+is searched using the text property PROP. Move point to the closest found
+position of either a cross-reference found by `re-search-forward' or a link
+found by `next-single-char-property-change'.
+
+Return the new position of point, or nil."
(let ((pxref (save-excursion (re-search-forward pat nil t)))
(plink (next-single-char-property-change (point) prop)))
(when (and (< plink (point-max)) (not (get-char-property plink prop)))
@@ -3120,10 +3119,12 @@ of either a cross-reference found by `re-search-forward' or a link found by
(defun Info-prev-reference-or-link (pat prop)
"Move point to the previous pattern-based cross-reference or property-based link.
-The previous cross-reference is searched using the regexp PAT, and the previous link
-is searched using the text property PROP. Move point to the closest found position
-of either a cross-reference found by `re-search-backward' or a link found by
-`previous-single-char-property-change'. Return the new position of point, or nil."
+The previous cross-reference is searched using the regexp PAT, and the previous
+link is searched using the text property PROP. Move point to the closest found
+position of either a cross-reference found by `re-search-backward' or a link
+found by `previous-single-char-property-change'.
+
+Return the new position of point, or nil."
(let ((pxref (save-excursion (re-search-backward pat nil t)))
(plink (previous-single-char-property-change (point) prop)))
(when (and (> plink (point-min)) (not (get-char-property plink prop)))
@@ -4790,10 +4791,10 @@ first line or header line, and for breadcrumb links.")
;; an end of sentence
(skip-syntax-backward " ("))
(setq other-tag
- (cond ((save-match-data (looking-back "\\<see"
+ (cond ((save-match-data (looking-back "\\(^\\| \\)see"
(- (point) 3)))
"")
- ((save-match-data (looking-back "\\<in"
+ ((save-match-data (looking-back "\\(^\\| \\)in"
(- (point) 2)))
"")
((memq (char-before) '(nil ?\. ?! ??))
diff --git a/lisp/informat.el b/lisp/informat.el
index 7750ab00898..3da23516333 100644
--- a/lisp/informat.el
+++ b/lisp/informat.el
@@ -1,6 +1,6 @@
;;; informat.el --- info support functions package for Emacs
-;; Copyright (C) 1986, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1986, 2001-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: help
diff --git a/lisp/international/ccl.el b/lisp/international/ccl.el
index 3b3fcf4c041..3c5a461a31e 100644
--- a/lisp/international/ccl.el
+++ b/lisp/international/ccl.el
@@ -1,6 +1,6 @@
;;; ccl.el --- CCL (Code Conversion Language) compiler -*- lexical-binding:t -*-
-;; Copyright (C) 1997-1998, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/international/characters.el b/lisp/international/characters.el
index 0b6920cf180..9bce419b489 100644
--- a/lisp/international/characters.el
+++ b/lisp/international/characters.el
@@ -1,6 +1,6 @@
-;;; characters.el --- set syntax and category for multibyte characters
+;;; characters.el --- set syntax and category for multibyte characters -*- lexical-binding: t; -*-
-;; Copyright (C) 1997, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2000-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -226,6 +226,7 @@ with L, LRE, or LRO Unicode bidi character type.")
;; JISX0208
+;; Note: Some of these have their syntax updated later below.
(map-charset-chars #'modify-syntax-entry 'japanese-jisx0208 "_" #x2121 #x227E)
(map-charset-chars #'modify-syntax-entry 'japanese-jisx0208 "_" #x2821 #x287E)
(let ((chars '(?ー ?゛ ?゜ ?ヽ ?ヾ ?ゝ ?ゞ ?〃 ?仝 ?々 ?〆 ?〇)))
@@ -317,6 +318,7 @@ with L, LRE, or LRO Unicode bidi character type.")
(modify-syntax-entry #x5be ".") ; MAQAF
(modify-syntax-entry #x5c0 ".") ; PASEQ
(modify-syntax-entry #x5c3 ".") ; SOF PASUQ
+(modify-syntax-entry #x5c6 ".") ; NUN HAFUKHA
(modify-syntax-entry #x5f3 ".") ; GERESH
(modify-syntax-entry #x5f4 ".") ; GERSHAYIM
@@ -521,9 +523,9 @@ with L, LRE, or LRO Unicode bidi character type.")
;; syntax: ¢£¤¥¨ª¯²³´¶¸¹º.) There should be a well-defined way of
;; relating Unicode categories to Emacs syntax codes.
- ;; NBSP isn't semantically interchangeable with other whitespace chars,
- ;; so it's more like punctuation.
- (set-case-syntax ?  "." tbl)
+ ;; FIXME: We should probably just use the Unicode properties to set
+ ;; up the syntax table.
+
(set-case-syntax ?¡ "." tbl)
(set-case-syntax ?¦ "_" tbl)
(set-case-syntax ?§ "." tbl)
@@ -558,7 +560,7 @@ with L, LRE, or LRO Unicode bidi character type.")
(setq c (1+ c)))
;; Latin Extended Additional
- (modify-category-entry '(#x1e00 . #x1ef9) ?l)
+ (modify-category-entry '(#x1E00 . #x1EF9) ?l)
;; Latin Extended-C
(setq c #x2C60)
@@ -579,13 +581,13 @@ with L, LRE, or LRO Unicode bidi character type.")
(setq c (1+ c)))
;; Greek
- (modify-category-entry '(#x0370 . #x03ff) ?g)
+ (modify-category-entry '(#x0370 . #x03FF) ?g)
;; Armenian
(setq c #x531)
;; Greek Extended
- (modify-category-entry '(#x1f00 . #x1fff) ?g)
+ (modify-category-entry '(#x1F00 . #x1FFF) ?g)
;; cyrillic
(modify-category-entry '(#x0400 . #x04FF) ?y)
@@ -597,48 +599,57 @@ with L, LRE, or LRO Unicode bidi character type.")
;; Cyrillic Extended-C
(modify-category-entry '(#x1C80 . #x1C8F) ?y)
- ;; general punctuation
+ ;; space characters (see section 6.2 in the Unicode Standard)
+ (set-case-syntax ?  " " tbl)
(setq c #x2000)
(while (<= c #x200b)
(set-case-syntax c " " tbl)
(setq c (1+ c)))
+ (let ((chars '(#x202F #x205F #x3000)))
+ (while chars
+ (set-case-syntax (car chars) " " tbl)
+ (setq chars (cdr chars))))
+ ;; general punctuation
(while (<= c #x200F)
(set-case-syntax c "." tbl)
(setq c (1+ c)))
- ;; Fixme: These aren't all right:
(setq c #x2010)
- (while (<= c #x2016)
- (set-case-syntax c "_" tbl)
+ ;; Fixme: What to do with characters that have Pi and Pf
+ ;; Unicode properties?
+ (while (<= c #x2017)
+ (set-case-syntax c "." tbl)
(setq c (1+ c)))
;; Punctuation syntax for quotation marks (like `)
- (while (<= c #x201f)
+ (while (<= c #x201F)
(set-case-syntax c "." tbl)
(setq c (1+ c)))
- ;; Fixme: These aren't all right:
(while (<= c #x2027)
- (set-case-syntax c "_" tbl)
+ (set-case-syntax c "." tbl)
(setq c (1+ c)))
- (while (<= c #x206F)
+ (setq c #x2030)
+ (while (<= c #x205E)
(set-case-syntax c "." tbl)
(setq c (1+ c)))
+ (let ((chars '(?‹ ?› ?⁄ ?⁒)))
+ (while chars
+ (modify-syntax-entry (car chars) "_")
+ (setq chars (cdr chars))))
- ;; Fixme: The following blocks might be better as symbol rather than
- ;; punctuation.
;; Arrows
(setq c #x2190)
(while (<= c #x21FF)
- (set-case-syntax c "." tbl)
+ (set-case-syntax c "_" tbl)
(setq c (1+ c)))
;; Mathematical Operators
(while (<= c #x22FF)
- (set-case-syntax c "." tbl)
+ (set-case-syntax c "_" tbl)
(setq c (1+ c)))
;; Miscellaneous Technical
(while (<= c #x23FF)
- (set-case-syntax c "." tbl)
+ (set-case-syntax c "_" tbl)
(setq c (1+ c)))
;; Control Pictures
- (while (<= c #x243F)
+ (while (<= c #x244F)
(set-case-syntax c "_" tbl)
(setq c (1+ c)))
@@ -652,13 +663,13 @@ with L, LRE, or LRO Unicode bidi character type.")
;; Supplemental Mathematical Operators
(setq c #x2A00)
(while (<= c #x2AFF)
- (set-case-syntax c "." tbl)
+ (set-case-syntax c "_" tbl)
(setq c (1+ c)))
;; Miscellaneous Symbols and Arrows
(setq c #x2B00)
(while (<= c #x2BFF)
- (set-case-syntax c "." tbl)
+ (set-case-syntax c "_" tbl)
(setq c (1+ c)))
;; Coptic
@@ -674,19 +685,47 @@ with L, LRE, or LRO Unicode bidi character type.")
(set-case-syntax c "." tbl)
(setq c (1+ c)))
+ ;; Ideographic punctuation
+ (setq c #x3001)
+ (while (<= c #x3003)
+ (set-case-syntax c "." tbl)
+ (setq c (1+ c)))
+ (set-case-syntax #x30FB "." tbl)
+
;; Symbols for Legacy Computing
(setq c #x1FB00)
+ (while (<= c #x1FBCA)
+ (set-case-syntax c "_" tbl)
+ (setq c (1+ c)))
+ ;; FIXME: Should these be digits?
(while (<= c #x1FBFF)
(set-case-syntax c "." tbl)
(setq c (1+ c)))
;; Fullwidth Latin
- (setq c #xff21)
- (while (<= c #xff3a)
+ (setq c #xFF01)
+ (while (<= c #xFF0F)
+ (set-case-syntax c "." tbl)
+ (setq c (1+ c)))
+ (set-case-syntax #xFF04 "_" tbl)
+ (set-case-syntax #xFF0B "_" tbl)
+ (set-case-syntax #xFF1A "." tbl)
+ (set-case-syntax #xFF1B "." tbl)
+ (set-case-syntax #xFF1F "." tbl)
+ (set-case-syntax #xFF20 "." tbl)
+ (setq c #xFF21)
+ (while (<= c #xFF3A)
(modify-category-entry c ?l)
(modify-category-entry (+ c #x20) ?l)
(setq c (1+ c)))
+ ;; Halfwidth Latin
+ (setq c #xFF64)
+ (while (<= c #xFF65)
+ (set-case-syntax c "." tbl)
+ (setq c (1+ c)))
+ (set-case-syntax #xFF61 "." tbl)
+
;; Combining diacritics
(modify-category-entry '(#x300 . #x362) ?^)
;; Combining marks
@@ -759,7 +798,14 @@ with L, LRE, or LRO Unicode bidi character type.")
(funcall map-unicode-property 'uppercase
(lambda (lc uc) (aset up lc uc) (aset up uc uc)))
(funcall map-unicode-property 'lowercase
- (lambda (uc lc) (aset down uc lc) (aset down lc lc))))))
+ (lambda (uc lc) (aset down uc lc) (aset down lc lc)))
+
+ ;; Override the Unicode uppercase property for ß, since we are
+ ;; using our case tables for determining the case of a
+ ;; character (see uppercasep and lowercasep in buffer.h).
+ ;; The special-uppercase property of ß ensures that it is
+ ;; still upcased to SS per the usual convention.
+ (aset up ?ß ?ẞ))))
;; Clear out the extra slots so that they will be recomputed from the main
;; (downcase) table and upcase table. Since we’re side-stepping the usual
diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el
index a52b6283c3e..8f0f263dcce 100644
--- a/lisp/international/fontset.el
+++ b/lisp/international/fontset.el
@@ -1,6 +1,6 @@
-;;; fontset.el --- commands for handling fontset
+;;; fontset.el --- commands for handling fontset -*- lexical-binding: t; -*-
-;; Copyright (C) 1997-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -719,6 +719,7 @@
georgian
cherokee
canadian-aboriginal
+ cham
ogham
runic
symbol
diff --git a/lisp/international/isearch-x.el b/lisp/international/isearch-x.el
index d77234ec77b..400421ddb23 100644
--- a/lisp/international/isearch-x.el
+++ b/lisp/international/isearch-x.el
@@ -1,6 +1,6 @@
;;; isearch-x.el --- extended isearch handling commands
-;; Copyright (C) 1997, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -35,9 +35,8 @@
(interactive)
(let ((overriding-terminal-local-map nil))
(toggle-input-method t))
- (setq isearch-input-method-function input-method-function
- isearch-input-method-local-p t)
- (setq input-method-function nil)
+ (setq isearch-input-method-function input-method-function)
+ (setq-local input-method-function nil)
(isearch-update))
;;;###autoload
@@ -46,9 +45,17 @@
(interactive)
(let ((overriding-terminal-local-map nil))
(toggle-input-method))
- (setq isearch-input-method-function input-method-function
- isearch-input-method-local-p t)
- (setq input-method-function nil)
+ (setq isearch-input-method-function input-method-function)
+ (setq-local input-method-function nil)
+ (isearch-update))
+
+;;;###autoload
+(defun isearch-transient-input-method ()
+ "Activate transient input method in interactive search."
+ (interactive)
+ (let ((overriding-terminal-local-map nil))
+ (activate-transient-input-method))
+ (setq-local input-method-function nil)
(isearch-update))
(defvar isearch-minibuffer-local-map
@@ -117,6 +124,7 @@
(cons last-char unread-command-events))
;; Inherit current-input-method in a minibuffer.
str (read-string prompt isearch-message 'junk-hist nil t))
+ (deactivate-transient-input-method)
(if (or (not str) (< (length str) (length isearch-message)))
;; All inputs were deleted while the input method
;; was working.
diff --git a/lisp/international/iso-ascii.el b/lisp/international/iso-ascii.el
index 0df07d65148..f8cb61c08f9 100644
--- a/lisp/international/iso-ascii.el
+++ b/lisp/international/iso-ascii.el
@@ -1,6 +1,6 @@
;;; iso-ascii.el --- set up char tables for ISO 8859/1 on ASCII terminals -*- lexical-binding: t -*-
-;; Copyright (C) 1987, 1995, 1998, 2001-2020 Free Software Foundation,
+;; Copyright (C) 1987, 1995, 1998, 2001-2021 Free Software Foundation,
;; Inc.
;; Author: Howard Gayle
diff --git a/lisp/international/iso-cvt.el b/lisp/international/iso-cvt.el
index e55ae1a5930..3f3843e23dd 100644
--- a/lisp/international/iso-cvt.el
+++ b/lisp/international/iso-cvt.el
@@ -1,7 +1,7 @@
;;; iso-cvt.el --- translate ISO 8859-1 from/to various encodings -*- coding: utf-8 -*-
;; This file was formerly called gm-lingo.el.
-;; Copyright (C) 1993-1998, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1998, 2000-2021 Free Software Foundation, Inc.
;; Author: Michael Gschwind <mike@vlsivie.tuwien.ac.at>
;; Keywords: tex, iso, latin, i18n
diff --git a/lisp/international/iso-transl.el b/lisp/international/iso-transl.el
index bde989d41de..2c7da2b7cdf 100644
--- a/lisp/international/iso-transl.el
+++ b/lisp/international/iso-transl.el
@@ -1,6 +1,6 @@
-;;; iso-transl.el --- keyboard input for ISO 10646 chars -*- coding: utf-8 -*-
+;;; iso-transl.el --- keyboard input for ISO 10646 chars -*- coding: utf-8; lexical-binding: t; -*-
-;; Copyright (C) 1987, 1993-1999, 2001-2020 Free Software Foundation,
+;; Copyright (C) 1987, 1993-1999, 2001-2021 Free Software Foundation,
;; Inc.
;; Author: Howard Gayle
@@ -30,22 +30,12 @@
;; A-umlaut as `C-x 8 " A' or `Alt-" A' (if you have an Alt key) or
;; `umlaut A' (if you have an umlaut/diaeresis key).
-;; C-x 8 is set up to autoload this package,
-;; but Alt keys and dead accent keys are only defined
-;; once you have loaded the package. It is nontrivial
-;; to make all of the Alt keys autoload, and it is not clear
-;; that the dead accent keys SHOULD autoload this package.
-
;; This package supports all characters defined by ISO 8859-1, along
;; with a few other ISO 10646 characters commonly used in English and
;; basic math.
;;; Code:
-;;; Provide some binding for startup:
-;;;###autoload (define-key key-translation-map "\C-x8" 'iso-transl-ctl-x-8-map)
-;;;###autoload (autoload 'iso-transl-ctl-x-8-map "iso-transl" "Keymap for C-x 8 prefix." t 'keymap)
-
(defvar iso-transl-dead-key-alist
'((?\' . mute-acute)
(?\` . mute-grave)
diff --git a/lisp/international/ja-dic-cnv.el b/lisp/international/ja-dic-cnv.el
index 5f645b6e8e4..b80590491c1 100644
--- a/lisp/international/ja-dic-cnv.el
+++ b/lisp/international/ja-dic-cnv.el
@@ -1,6 +1,6 @@
;;; ja-dic-cnv.el --- convert a Japanese dictionary (SKK-JISYO.L) to Emacs Lisp
-;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; 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 4e9b6b015a5..cd740acc6ac 100644
--- a/lisp/international/kinsoku.el
+++ b/lisp/international/kinsoku.el
@@ -1,6 +1,6 @@
;;; kinsoku.el --- `Kinsoku' processing funcs
-;; Copyright (C) 1997, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/international/kkc.el b/lisp/international/kkc.el
index 9da9d14b92d..290f4fa0cf1 100644
--- a/lisp/international/kkc.el
+++ b/lisp/international/kkc.el
@@ -1,6 +1,6 @@
;;; kkc.el --- Kana Kanji converter
-;; Copyright (C) 1997-1998, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/international/latexenc.el b/lisp/international/latexenc.el
index cce5e06002a..e2ee3fb37e3 100644
--- a/lisp/international/latexenc.el
+++ b/lisp/international/latexenc.el
@@ -1,6 +1,6 @@
;;; latexenc.el --- guess correct coding system in LaTeX files -*-coding: utf-8 -*-
-;; Copyright (C) 2005-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2005-2021 Free Software Foundation, Inc.
;; Author: Arne Jørgensen <arne@arnested.dk>
;; Keywords: mule, coding system, latex
diff --git a/lisp/international/latin1-disp.el b/lisp/international/latin1-disp.el
index f2e35e93672..bda2c51ab9d 100644
--- a/lisp/international/latin1-disp.el
+++ b/lisp/international/latin1-disp.el
@@ -1,6 +1,6 @@
;;; latin1-disp.el --- display tables for other ISO 8859 on Latin-1 terminals -*-coding: utf-8;-*-
-;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: i18n
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index e3155dfc52c..347e6782590 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -1,6 +1,6 @@
;;; mule-cmds.el --- commands for multilingual environment -*- lexical-binding:t -*-
-;; Copyright (C) 1997-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -55,6 +55,7 @@
;; Keep "C-x C-m ..." for mule specific commands.
(define-key ctl-x-map "\C-m" mule-keymap)
+(define-key ctl-x-map "\\" 'activate-transient-input-method)
(defvar describe-language-environment-map
(let ((map (make-sparse-keymap "Describe Language Environment")))
@@ -139,8 +140,8 @@
`(menu-item "Set Coding Systems" ,set-coding-system-map))
(bindings--define-key map [separator-input-method] menu-bar-separator)
- (bindings--define-key map [describe-input-method]
- '(menu-item "Describe Input Method" describe-input-method))
+ (bindings--define-key map [activate-transient-input-method]
+ '(menu-item "Transient Input Method" activate-transient-input-method))
(bindings--define-key map [set-input-method]
'(menu-item "Select Input Method..." set-input-method))
(bindings--define-key map [toggle-input-method]
@@ -440,58 +441,57 @@ non-nil, it is used to sort CODINGS instead."
(most-preferred (car from-priority))
(lang-preferred (get-language-info current-language-environment
'coding-system))
- (func (function
- (lambda (x)
- (let ((base (coding-system-base x)))
- ;; We calculate the priority number 0..255 by
- ;; using the 8 bits PMMLCEII as this:
- ;; P: 1 if most preferred.
- ;; MM: greater than 0 if mime-charset.
- ;; L: 1 if one of the current lang. env.'s codings.
- ;; C: 1 if one of codings listed in the category list.
- ;; E: 1 if not XXX-with-esc
- ;; II: if iso-2022 based, 0..3, else 1.
- (logior
- (ash (if (eq base most-preferred) 1 0) 7)
- (ash
- (let ((mime (coding-system-get base :mime-charset)))
- ;; Prefer coding systems corresponding to a
- ;; MIME charset.
- (if mime
- ;; Lower utf-16 priority so that we
- ;; normally prefer utf-8 to it, and put
- ;; x-ctext below that.
- (cond ((string-match-p "utf-16"
- (symbol-name mime))
- 2)
- ((string-match-p "^x-" (symbol-name mime))
- 1)
- (t 3))
- 0))
- 5)
- (ash (if (memq base lang-preferred) 1 0) 4)
- (ash (if (memq base from-priority) 1 0) 3)
- (ash (if (string-match-p "-with-esc\\'"
- (symbol-name base))
- 0 1) 2)
- (if (eq (coding-system-type base) 'iso-2022)
- (let ((category (coding-system-category base)))
- ;; For ISO based coding systems, prefer
- ;; one that doesn't use designation nor
- ;; locking/single shifting.
- (cond
- ((or (eq category 'coding-category-iso-8-1)
- (eq category 'coding-category-iso-8-2))
- 2)
- ((or (eq category 'coding-category-iso-7-tight)
- (eq category 'coding-category-iso-7))
- 1)
- (t
- 0)))
- 1)
- ))))))
- (sort codings (function (lambda (x y)
- (> (funcall func x) (funcall func y))))))))
+ (func (lambda (x)
+ (let ((base (coding-system-base x)))
+ ;; We calculate the priority number 0..255 by
+ ;; using the 8 bits PMMLCEII as this:
+ ;; P: 1 if most preferred.
+ ;; MM: greater than 0 if mime-charset.
+ ;; L: 1 if one of the current lang. env.'s codings.
+ ;; C: 1 if one of codings listed in the category list.
+ ;; E: 1 if not XXX-with-esc
+ ;; II: if iso-2022 based, 0..3, else 1.
+ (logior
+ (ash (if (eq base most-preferred) 1 0) 7)
+ (ash
+ (let ((mime (coding-system-get base :mime-charset)))
+ ;; Prefer coding systems corresponding to a
+ ;; MIME charset.
+ (if mime
+ ;; Lower utf-16 priority so that we
+ ;; normally prefer utf-8 to it, and put
+ ;; x-ctext below that.
+ (cond ((string-match-p "utf-16"
+ (symbol-name mime))
+ 2)
+ ((string-match-p "^x-" (symbol-name mime))
+ 1)
+ (t 3))
+ 0))
+ 5)
+ (ash (if (memq base lang-preferred) 1 0) 4)
+ (ash (if (memq base from-priority) 1 0) 3)
+ (ash (if (string-match-p "-with-esc\\'"
+ (symbol-name base))
+ 0 1) 2)
+ (if (eq (coding-system-type base) 'iso-2022)
+ (let ((category (coding-system-category base)))
+ ;; For ISO based coding systems, prefer
+ ;; one that doesn't use designation nor
+ ;; locking/single shifting.
+ (cond
+ ((or (eq category 'coding-category-iso-8-1)
+ (eq category 'coding-category-iso-8-2))
+ 2)
+ ((or (eq category 'coding-category-iso-7-tight)
+ (eq category 'coding-category-iso-7))
+ 1)
+ (t
+ 0)))
+ 1)
+ )))))
+ (sort codings (lambda (x y)
+ (> (funcall func x) (funcall func y)))))))
(defun find-coding-systems-region (from to)
"Return a list of proper coding systems to encode a text between FROM and TO.
@@ -887,7 +887,7 @@ It is highly recommended to fix it before writing to a file."
;; Change elements of the list to (coding . base-coding).
(setq default-coding-system
- (mapcar (function (lambda (x) (cons x (coding-system-base x))))
+ (mapcar (lambda (x) (cons x (coding-system-base x)))
default-coding-system))
(if (and auto-cs (not no-other-defaults))
@@ -1081,7 +1081,7 @@ it asks the user to select a proper coding system."
(if (fboundp select-safe-coding-system-function)
(funcall select-safe-coding-system-function
(point-min) (point-max) coding
- (function (lambda (x) (coding-system-get x :mime-charset))))
+ (lambda (x) (coding-system-get x :mime-charset)))
coding)))
;;; Language support stuff.
@@ -1260,7 +1260,7 @@ This returns a language environment name as a string."
(name (completing-read prompt
language-info-alist
(and key
- (function (lambda (elm) (and (listp elm) (assq key elm)))))
+ (lambda (elm) (and (listp elm) (assq key elm))))
t nil nil default)))
(if (and (> (length name) 0)
(or (not key)
@@ -1344,6 +1344,29 @@ This is the input method activated automatically by the command
mule-input-method-string)
:set-after '(current-language-environment))
+(defcustom default-transient-input-method nil
+ "Default transient input method.
+This is the input method activated by the command
+`activate-transient-input-method' (\\[activate-transient-input-method])."
+ :link '(custom-manual "(emacs)Input Methods")
+ :group 'mule
+ :type '(choice (const nil)
+ mule-input-method-string)
+ :set-after '(current-language-environment)
+ :version "28.1")
+
+(defvar 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
+ "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
@@ -1478,7 +1501,8 @@ If INPUT-METHOD is nil, deactivate any current input method."
(defun deactivate-input-method ()
"Turn off the current input method."
(when current-input-method
- (add-to-history 'input-method-history current-input-method)
+ (unless current-transient-input-method
+ (add-to-history 'input-method-history current-input-method))
(unwind-protect
(progn
(setq input-method-function nil
@@ -1540,7 +1564,9 @@ which marks the variable `default-input-method' as set for Custom buffers."
(if toggle-input-method-active
(error "Recursive use of `toggle-input-method'"))
(if (and current-input-method (not arg))
- (deactivate-input-method)
+ (if current-transient-input-method
+ (deactivate-transient-input-method)
+ (deactivate-input-method))
(let ((toggle-input-method-active t)
(default (or (car input-method-history) default-input-method)))
(if (and arg default (equal current-input-method default)
@@ -1559,6 +1585,42 @@ which marks the variable `default-input-method' as set for Custom buffers."
(when interactive
(customize-mark-as-set 'default-input-method)))))))
+(defun activate-transient-input-method (&optional arg interactive)
+ "Select and enable a transient input method for the current buffer.
+If `default-transient-input-method' was not yet defined, prompt for it."
+ (interactive "P\np")
+ (when (or arg (not default-transient-input-method))
+ (let* ((default (or (car input-method-history) default-input-method))
+ (input-method
+ (read-input-method-name
+ (format-prompt "Transient input method" default)
+ default t)))
+ (setq default-transient-input-method input-method)
+ (when interactive
+ (customize-mark-as-set 'default-transient-input-method))))
+ (let* ((clearfun (make-symbol "clear-transient-input-method"))
+ (exitfun
+ (lambda ()
+ (deactivate-transient-input-method)
+ (remove-hook 'input-method-after-insert-chunk-hook clearfun))))
+ (fset clearfun (lambda () (funcall exitfun)))
+ (add-hook 'input-method-after-insert-chunk-hook clearfun)
+ (setq previous-transient-input-method current-input-method)
+ (when previous-transient-input-method
+ (deactivate-input-method))
+ (activate-input-method default-transient-input-method)
+ (setq current-transient-input-method default-transient-input-method)
+ exitfun))
+
+(defun deactivate-transient-input-method ()
+ "Disable currently active transient input method for the current buffer."
+ (when current-transient-input-method
+ (deactivate-input-method)
+ (when previous-transient-input-method
+ (activate-input-method previous-transient-input-method)
+ (setq previous-transient-input-method nil))
+ (setq current-transient-input-method nil)))
+
(autoload 'help-buffer "help-mode")
(defun describe-input-method (input-method)
@@ -2902,9 +2964,9 @@ STR should be a unibyte string."
(mapconcat
(if (and coding-system (eq (coding-system-type coding-system) 'iso-2022))
;; Try to get a pretty description for ISO 2022 escape sequences.
- (function (lambda (x) (or (cdr (assq x iso-2022-control-alist))
- (format "#x%02X" x))))
- (function (lambda (x) (format "#x%02X" x))))
+ (lambda (x) (or (cdr (assq x iso-2022-control-alist))
+ (format "#x%02X" x)))
+ (lambda (x) (format "#x%02X" x)))
str " "))
(defun encode-coding-char (char coding-system &optional charset)
@@ -3022,13 +3084,11 @@ on encoding."
(puthash "BELL (BEL)" ?\a names)
(setq ucs-names names))))
-(defun mule--ucs-names-annotation (name)
- ;; FIXME: It would be much better to add this annotation before rather than
- ;; after the char name, so the annotations are aligned.
- ;; FIXME: The default behavior of displaying annotations in italics
- ;; doesn't work well here.
- (let ((char (gethash name ucs-names)))
- (when char (format " (%c)" char))))
+(defun mule--ucs-names-affixation (names)
+ (mapcar (lambda (name)
+ (let ((char (gethash name ucs-names)))
+ (list name (concat (if char (format "%c" char) " ") "\t") "")))
+ names))
(defun char-from-name (string &optional ignore-case)
"Return a character as a number from its Unicode name STRING.
@@ -3071,13 +3131,14 @@ octal). Treat otherwise-ambiguous strings like \"BED\" (U+1F6CF)
as names, not numbers."
(let* ((enable-recursive-minibuffers t)
(completion-ignore-case t)
+ (completion-tab-width 4)
(input
(completing-read
prompt
(lambda (string pred action)
(if (eq action 'metadata)
'(metadata
- (annotation-function . mule--ucs-names-annotation)
+ (affixation-function . mule--ucs-names-affixation)
(category . unicode-name))
(complete-with-action action (ucs-names) string pred)))))
(char
diff --git a/lisp/international/mule-conf.el b/lisp/international/mule-conf.el
index 42dd19842c8..64aac46fcee 100644
--- a/lisp/international/mule-conf.el
+++ b/lisp/international/mule-conf.el
@@ -1,6 +1,6 @@
-;;; mule-conf.el --- configure multilingual environment
+;;; mule-conf.el --- configure multilingual environment -*- lexical-binding: t; -*-
-;; Copyright (C) 1997-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
@@ -1075,6 +1075,90 @@
(define-charset-alias 'ebcdic-int 'ibm038)
(define-charset-alias 'cp038 'ibm038)
+(define-charset 'ibm256
+ "Netherlands version of EBCDIC"
+ :short-name "IBM256"
+ :code-space [0 255]
+ :mime-charset 'ibm256
+ :map "IBM256")
+
+(define-charset 'ibm273
+ "Austrian / German version of EBCDIC"
+ :short-name "IBM273"
+ :code-space [0 255]
+ :mime-charset 'ibm273
+ :map "IBM273")
+
+(define-charset 'ibm274
+ "Belgian version of EBCDIC"
+ :short-name "IBM274"
+ :code-space [0 255]
+ :mime-charset 'ibm274
+ :map "IBM274")
+
+(define-charset 'ibm275
+ "Brazilian version of EBCDIC"
+ :short-name "IBM275"
+ :code-space [0 255]
+ :mime-charset 'ibm275
+ :map "IBM275")
+
+(define-charset 'ibm277
+ "Danish / Norwegian version of EBCDIC"
+ :short-name "IBM277"
+ :code-space [0 255]
+ :mime-charset 'ibm277
+ :map "IBM277")
+
+(define-charset 'ibm278
+ "Finnish / Swedish version of EBCDIC"
+ :short-name "IBM278"
+ :code-space [0 255]
+ :mime-charset 'ibm278
+ :map "IBM278")
+
+(define-charset 'ibm280
+ "Italian version of EBCDIC"
+ :short-name "IBM280"
+ :code-space [0 255]
+ :mime-charset 'ibm270
+ :map "IBM280")
+
+(define-charset 'ibm281
+ "Japanese-E version of EBCDIC"
+ :short-name "IBM281"
+ :code-space [0 255]
+ :mime-charset 'ibm281
+ :map "IBM281")
+
+(define-charset 'ibm284
+ "Spanish version of EBCDIC"
+ :short-name "IBM284"
+ :code-space [0 255]
+ :mime-charset 'ibm284
+ :map "IBM284")
+
+(define-charset 'ibm285
+ "UK english version of EBCDIC"
+ :short-name "IBM285"
+ :code-space [0 255]
+ :mime-charset 'ibm285
+ :map "IBM285")
+
+(define-charset 'ibm290
+ "Japanese katakana version of EBCDIC"
+ :short-name "IBM290"
+ :code-space [0 255]
+ :mime-charset 'ibm290
+ :map "IBM290")
+
+(define-charset 'ibm297
+ "French version of EBCDIC"
+ :short-name "IBM297"
+ :code-space [0 255]
+ :mime-charset 'ibm297
+ :map "IBM297")
+
(define-charset 'ibm1047
;; Says groff:
"IBM1047, `EBCDIC Latin 1/Open Systems' used by OS/390 Unix."
@@ -1251,7 +1335,9 @@ by UTF-8."
:coding-type 'undecided
:mnemonic ?-
:charset-list '(emacs)
- :prefer-utf-8 t)
+ :prefer-utf-8 t
+ :inhibit-null-byte-detection 0
+ :inhibit-iso-escape-detection 0)
(define-coding-system 'raw-text
"Raw text, which means text contains random 8-bit codes.
diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el
index b13bde58ca1..d6222685251 100644
--- a/lisp/international/mule-diag.el
+++ b/lisp/international/mule-diag.el
@@ -1,6 +1,6 @@
;;; mule-diag.el --- show diagnosis of multilingual environment (Mule)
-;; Copyright (C) 1997-1998, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2000-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -136,13 +136,12 @@ SORT-KEY should be `name' or `iso-spec' (default `name')."
((eq sort-key 'iso-spec)
;; Sort by DIMENSION CHARS FINAL-CHAR
- (function
- (lambda (x y)
- (or (< (nth 1 x) (nth 1 y))
- (and (= (nth 1 x) (nth 1 y))
- (or (< (nth 2 x) (nth 2 y))
- (and (= (nth 2 x) (nth 2 y))
- (< (nth 3 x) (nth 3 y)))))))))
+ (lambda (x y)
+ (or (< (nth 1 x) (nth 1 y))
+ (and (= (nth 1 x) (nth 1 y))
+ (or (< (nth 2 x) (nth 2 y))
+ (and (= (nth 2 x) (nth 2 y))
+ (< (nth 3 x) (nth 3 y))))))))
(t
(error "Invalid charset sort key: %s" sort-key))))
diff --git a/lisp/international/mule-util.el b/lisp/international/mule-util.el
index 8f316332249..580bd293e73 100644
--- a/lisp/international/mule-util.el
+++ b/lisp/international/mule-util.el
@@ -1,6 +1,6 @@
;;; mule-util.el --- utility functions for multilingual environment (mule) -*- lexical-binding:t -*-
-;; Copyright (C) 1997-1998, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2000-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/international/mule.el b/lisp/international/mule.el
index ad9c3a23066..6a32cffe9a6 100644
--- a/lisp/international/mule.el
+++ b/lisp/international/mule.el
@@ -1,6 +1,6 @@
-;;; mule.el --- basic commands for multilingual environment
+;;; mule.el --- basic commands for multilingual environment -*- lexical-binding: t; -*-
-;; Copyright (C) 1997-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -307,12 +307,9 @@ Return t if file exists."
(and (null noerror)
(signal 'file-error (list "Cannot open load file" file)))
;; Read file with code conversion, and then eval.
- (let* ((buffer
- ;; We can't use `generate-new-buffer' because files.el
- ;; is not yet loaded.
- (get-buffer-create (generate-new-buffer-name " *load*")))
- (load-in-progress t)
- (source (save-match-data (string-match "\\.el\\'" fullname))))
+ (let ((buffer (generate-new-buffer " *load*"))
+ (load-in-progress t)
+ (source (string-suffix-p ".el" fullname)))
(unless nomessage
(if source
(message "Loading %s (source)..." file)
@@ -857,16 +854,23 @@ as an encoding result.
`:inhibit-null-byte-detection'
-VALUE non-nil means Emacs ignore null bytes on code detection.
+VALUE non-nil means Emacs should ignore null bytes on code detection.
See the variable `inhibit-null-byte-detection'. This attribute
is meaningful only when `:coding-type' is `undecided'.
+If VALUE is t, Emacs will ignore null bytes unconditionally while
+detecting encoding. If VALUE is non-nil and not t, Emacs will
+ignore null bytes if `inhibit-null-byte-detection' is non-nil.
`:inhibit-iso-escape-detection'
-VALUE non-nil means Emacs ignores ISO-2022 escape sequences on
+VALUE non-nil means Emacs should ignore ISO-2022 escape sequences on
code detection. See the variable `inhibit-iso-escape-detection'.
This attribute is meaningful only when `:coding-type' is
`undecided'.
+If VALUE is t, Emacs will ignore escape sequences unconditionally
+while detecting encoding. If VALUE is non-nil and not t, Emacs
+will ignore escape sequences if `inhibit-iso-escape-detection' is
+non-nil.
`:prefer-utf-8'
diff --git a/lisp/international/ogonek.el b/lisp/international/ogonek.el
index 37fcda70b37..79e446875da 100644
--- a/lisp/international/ogonek.el
+++ b/lisp/international/ogonek.el
@@ -1,6 +1,6 @@
;;; ogonek.el --- change the encoding of Polish diacritics
-;; Copyright (C) 1997-1998, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2001-2021 Free Software Foundation, Inc.
;; Author: Włodek Bzyl
;; Ryszard Kubiak
diff --git a/lisp/international/quail.el b/lisp/international/quail.el
index 3299cc55a28..f2ac44a8a60 100644
--- a/lisp/international/quail.el
+++ b/lisp/international/quail.el
@@ -1,6 +1,6 @@
;;; quail.el --- provides simple input method for multilingual text
-;; Copyright (C) 1997-1998, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2000-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -787,7 +787,7 @@ you type is correctly handled."
(defun quail-keyseq-translate (keyseq)
(apply 'string
- (mapcar (function (lambda (x) (quail-keyboard-translate x)))
+ (mapcar (lambda (x) (quail-keyboard-translate x))
keyseq)))
(defun quail-insert-kbd-layout (kbd-layout)
@@ -1330,7 +1330,8 @@ If STR has `advice' text property, append the following special event:
(defun quail-input-method (key)
(if (or (and (or buffer-read-only
- (get-char-property (point) 'read-only))
+ (and (get-char-property (point) 'read-only)
+ (get-char-property (point) 'front-sticky)))
(not (or inhibit-read-only
(get-char-property (point) 'inhibit-read-only))))
(and overriding-terminal-local-map
@@ -2145,7 +2146,7 @@ minibuffer and the selected frame has no other windows)."
(setq str
(format "%s[%s]"
str
- (concat (sort (mapcar (function (lambda (x) (car x)))
+ (concat (sort (mapcar (lambda (x) (car x))
(cdr map))
'<)))))
;; Show list of translations.
@@ -2349,13 +2350,13 @@ Optional 6th arg IGNORES is a list of translations to ignore."
((consp translation)
(setq translation (cdr translation))
(let ((multibyte nil))
- (mapc (function (lambda (x)
- ;; Accept only non-ASCII chars not
- ;; listed in IGNORES.
- (if (and (if (integerp x) (> x 127)
- (string-match-p "[^[:ascii:]]" x))
- (not (member x ignores)))
- (setq multibyte t))))
+ (mapc (lambda (x)
+ ;; Accept only non-ASCII chars not
+ ;; listed in IGNORES.
+ (if (and (if (integerp x) (> x 127)
+ (string-match-p "[^[:ascii:]]" x))
+ (not (member x ignores)))
+ (setq multibyte t)))
translation)
(when multibyte
(setcdr decode-map
@@ -2380,11 +2381,11 @@ These are stored in DECODE-MAP using the concise format. DECODE-MAP
should be made by `quail-build-decode-map' (which see)."
(setq decode-map
(sort (cdr decode-map)
- (function (lambda (x y)
- (setq x (car x) y (car y))
- (or (> (length x) (length y))
- (and (= (length x) (length y))
- (not (string< x y))))))))
+ (lambda (x y)
+ (setq x (car x) y (car y))
+ (or (> (length x) (length y))
+ (and (= (length x) (length y))
+ (not (string< x y)))))))
(let ((window-width (window-width (get-buffer-window
(current-buffer) 'visible)))
(single-trans-width 4)
@@ -2477,14 +2478,13 @@ should be made by `quail-build-decode-map' (which see)."
'face 'font-lock-comment-face))
(quail-indent-to max-key-width)
(if (vectorp (cdr elt))
- (mapc (function
- (lambda (x)
- (let ((width (if (integerp x) (char-width x)
- (string-width x))))
- (when (> (+ (current-column) 1 width) window-width)
- (insert "\n")
- (quail-indent-to max-key-width))
- (insert " " x))))
+ (mapc (lambda (x)
+ (let ((width (if (integerp x) (char-width x)
+ (string-width x))))
+ (when (> (+ (current-column) 1 width) window-width)
+ (insert "\n")
+ (quail-indent-to max-key-width))
+ (insert " " x)))
(cdr elt))
(insert " " (cdr elt)))
(insert ?\n))
diff --git a/lisp/international/rfc1843.el b/lisp/international/rfc1843.el
index c59538f5469..bd83a7a289b 100644
--- a/lisp/international/rfc1843.el
+++ b/lisp/international/rfc1843.el
@@ -1,6 +1,6 @@
;;; rfc1843.el --- HZ (rfc1843) decoding -*- lexical-binding:t -*-
-;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
;; Keywords: news HZ HZ+ mail i18n
diff --git a/lisp/international/robin.el b/lisp/international/robin.el
index 94d2bf18088..16cac07c773 100644
--- a/lisp/international/robin.el
+++ b/lisp/international/robin.el
@@ -424,8 +424,7 @@ While this input method is active, the variable
(add-hook 'minibuffer-exit-hook 'robin-exit-from-minibuffer))
(run-hooks 'input-method-activate-hook
'robin-activate-hook)
- (set (make-local-variable 'input-method-function)
- 'robin-input-method)))
+ (setq-local input-method-function 'robin-input-method)))
(define-obsolete-variable-alias
'robin-inactivate-hook
diff --git a/lisp/international/titdic-cnv.el b/lisp/international/titdic-cnv.el
index 2da8635f80b..58c81bfd1f3 100644
--- a/lisp/international/titdic-cnv.el
+++ b/lisp/international/titdic-cnv.el
@@ -1,6 +1,6 @@
;;; titdic-cnv.el --- convert cxterm dictionary (TIT format) to Quail package -*- coding:iso-2022-7bit; lexical-binding:t -*-
-;; Copyright (C) 1997-1998, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2000-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/international/ucs-normalize.el b/lisp/international/ucs-normalize.el
index 33d0f0dda29..0f8dedfc09b 100644
--- a/lisp/international/ucs-normalize.el
+++ b/lisp/international/ucs-normalize.el
@@ -1,6 +1,6 @@
-;;; ucs-normalize.el --- Unicode normalization NFC/NFD/NFKD/NFKC
+;;; ucs-normalize.el --- Unicode normalization NFC/NFD/NFKD/NFKC -*- lexical-binding: t; -*-
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Taichi Kawabata <kawabata.taichi@gmail.com>
;; Keywords: unicode, normalization
@@ -185,7 +185,7 @@
;; always returns nil, something the code here doesn't like.
(define-char-code-property 'decomposition "uni-decomposition.el")
(define-char-code-property 'canonical-combining-class "uni-combining.el")
- (let ((char 0) ccc decomposition)
+ (let (ccc decomposition)
(mapc
(lambda (start-end)
(cl-do ((char (car start-end) (+ char 1))) ((> char (cdr start-end)))
@@ -441,7 +441,7 @@ decomposition."
(concat (quick-check-list-to-regexp quick-check-list) "\\|[가-힣]"))
(defun quick-check-composition-list-to-regexp (quick-check-list)
- (concat (quick-check-list-to-regexp quick-check-list) "\\|[ᅡ-ᅵᆨ-ᇂ]"))
+ (quick-check-list-to-regexp quick-check-list))
)
diff --git a/lisp/international/utf-7.el b/lisp/international/utf-7.el
index fe676e2635c..e941abb463e 100644
--- a/lisp/international/utf-7.el
+++ b/lisp/international/utf-7.el
@@ -1,6 +1,6 @@
;;; utf-7.el --- utf-7 coding system
-;; Copyright (C) 2003-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: i18n, mail
diff --git a/lisp/international/utf7.el b/lisp/international/utf7.el
index 6df74d0d8da..d78e3975e64 100644
--- a/lisp/international/utf7.el
+++ b/lisp/international/utf7.el
@@ -1,6 +1,6 @@
;;; utf7.el --- UTF-7 encoding/decoding for Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Jon K Hellan <hellan@acm.org>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 245bf452b1f..a86678572c4 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -1,6 +1,6 @@
;;; isearch.el --- incremental search minor mode -*- lexical-binding: t -*-
-;; Copyright (C) 1992-1997, 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1992-1997, 1999-2021 Free Software Foundation, Inc.
;; Author: Daniel LaLiberte <liberte@cs.uiuc.edu>
;; Maintainer: emacs-devel@gnu.org
@@ -519,7 +519,7 @@ This is like `describe-bindings', but displays only Isearch keys."
(defvar isearch-menu-bar-yank-map
(let ((map (make-sparse-keymap)))
(define-key map [isearch-yank-pop]
- '(menu-item "Previous kill" isearch-yank-pop
+ '(menu-item "Previous kill" isearch-yank-pop-only
:help "Replace previous yanked kill on search string"))
(define-key map [isearch-yank-kill]
'(menu-item "Current kill" isearch-yank-kill
@@ -565,6 +565,10 @@ This is like `describe-bindings', but displays only Isearch keys."
:help "Highlight all matches for current search string"))
(define-key map [isearch-search-replace-separator]
'(menu-item "--"))
+ (define-key map [isearch-transient-input-method]
+ '(menu-item "Turn on transient input method"
+ isearch-transient-input-method
+ :help "Turn on transient input method for search"))
(define-key map [isearch-toggle-specified-input-method]
'(menu-item "Turn on specific input method"
isearch-toggle-specified-input-method
@@ -665,6 +669,10 @@ This is like `describe-bindings', but displays only Isearch keys."
(if isearch-success 'isearch-abort binding))))
map))
+;; Note: Before adding more key bindings to this map, please keep in
+;; mind that any unbound key exits Isearch and runs the command bound
+;; to it in the local or global map. So in effect every key unbound
+;; in this map is implicitly bound.
(defvar isearch-mode-map
(let ((i 0)
(map (make-keymap)))
@@ -730,7 +738,7 @@ This is like `describe-bindings', but displays only Isearch keys."
(define-key map "\M-n" 'isearch-ring-advance)
(define-key map "\M-p" 'isearch-ring-retreat)
- (define-key map "\M-y" 'isearch-yank-pop)
+ (define-key map "\M-y" 'isearch-yank-pop-only)
(define-key map "\M-\t" 'isearch-complete)
@@ -747,6 +755,7 @@ This is like `describe-bindings', but displays only Isearch keys."
;; For searching multilingual text.
(define-key map "\C-\\" 'isearch-toggle-input-method)
(define-key map "\C-^" 'isearch-toggle-specified-input-method)
+ (define-key map "\C-x\\" 'isearch-transient-input-method)
;; People expect to be able to paste with the mouse.
(define-key map [mouse-2] #'isearch-mouse-2)
@@ -960,10 +969,6 @@ Each element is an `isearch--state' struct where the slots are
;; The value of input-method-function when isearch is invoked.
(defvar isearch-input-method-function nil)
-;; A flag to tell if input-method-function is locally bound when
-;; isearch is invoked.
-(defvar isearch-input-method-local-p nil)
-
(defvar isearch--saved-overriding-local-map nil)
;; Minor-mode-alist changes - kind of redundant with the
@@ -1018,7 +1023,7 @@ Type \\[isearch-yank-until-char] to yank from point until the next instance of a
Type \\[isearch-yank-line] to yank rest of line onto end of search string\
and search for it.
Type \\[isearch-yank-kill] to yank the last string of killed text.
-Type \\[isearch-yank-pop] to replace string just yanked into search prompt
+Type \\[isearch-yank-pop-only] to replace string just yanked into search prompt
with string killed before it.
Type \\[isearch-quote-char] to quote control character to search for it.
Type \\[isearch-char-by-name] to add a character to search by Unicode name,\
@@ -1078,6 +1083,8 @@ To use a different input method for searching, type \
\\[isearch-toggle-specified-input-method],
and specify an input method you want to use.
+To activate a transient input method, type \\[isearch-transient-input-method].
+
The above keys, bound in `isearch-mode-map', are often controlled by
options; do \\[apropos] on search-.* to find them.
Other control and meta characters terminate the search
@@ -1231,7 +1238,6 @@ used to set the value of `isearch-regexp-function'."
search-ring-yank-pointer nil
isearch-opened-overlays nil
isearch-input-method-function input-method-function
- isearch-input-method-local-p (local-variable-p 'input-method-function)
regexp-search-ring-yank-pointer nil
isearch-pre-scroll-point nil
@@ -1252,9 +1258,7 @@ used to set the value of `isearch-regexp-function'."
;; We must bypass input method while reading key. When a user type
;; printable character, appropriate input method is turned on in
;; minibuffer to read multibyte characters.
- (or isearch-input-method-local-p
- (make-local-variable 'input-method-function))
- (setq input-method-function nil)
+ (setq-local input-method-function nil)
(looking-at "")
(setq isearch-window-configuration
@@ -1411,8 +1415,8 @@ NOPUSH is t and EDIT is t."
(set-window-group-start (selected-window) found-start t))))
(setq isearch-mode nil)
- (if isearch-input-method-local-p
- (setq input-method-function isearch-input-method-function)
+ (if isearch-input-method-function
+ (setq-local input-method-function isearch-input-method-function)
(kill-local-variable 'input-method-function))
(if isearch-tool-bar-old-map
@@ -1603,7 +1607,8 @@ If this is set inside code wrapped by the macro
"Exit Isearch mode, run BODY, and reinvoke the pending search.
You can update the global isearch variables by setting new values to
`isearch-new-string', `isearch-new-message', `isearch-new-forward',
-`isearch-new-regexp-function', `isearch-new-case-fold', `isearch-new-nonincremental'."
+`isearch-new-regexp-function', `isearch-new-case-fold',
+`isearch-new-nonincremental'."
;; This code is very hairy for several reasons, explained in the code.
;; Mainly, isearch-mode must be terminated while editing and then restarted.
;; If there were a way to catch any change of buffer from the minibuffer,
@@ -2489,18 +2494,55 @@ If search string is empty, just beep."
(unless isearch-mode (isearch-mode t))
(isearch-yank-string (current-kill 0)))
+(defun isearch-yank-from-kill-ring ()
+ "Read a string from the `kill-ring' and append it to the search string."
+ (interactive)
+ (with-isearch-suspended
+ (let ((string (read-from-kill-ring)))
+ (if (and isearch-case-fold-search
+ (eq 'not-yanks search-upper-case))
+ (setq string (downcase string)))
+ (if isearch-regexp (setq string (regexp-quote string)))
+ (setq isearch-yank-flag t)
+ (setq isearch-new-string (concat isearch-string string)
+ isearch-new-message (concat isearch-message
+ (mapconcat 'isearch-text-char-description
+ string ""))))))
+
(defun isearch-yank-pop ()
- "Replace just-yanked search string with previously killed string."
+ "Replace just-yanked search string with previously killed string.
+Unlike `isearch-yank-pop-only', when this command is called not immediately
+after a `isearch-yank-kill' or a `isearch-yank-pop', it activates the
+minibuffer to read a string from the `kill-ring' as `yank-pop' does."
(interactive)
- (if (not (memq last-command '(isearch-yank-kill isearch-yank-pop)))
- ;; Fall back on `isearch-yank-kill' for the benefits of people
- ;; who are used to the old behavior of `M-y' in isearch mode. In
- ;; future, this fallback may be changed if we ever change
- ;; `yank-pop' to do something like the kill-ring-browser.
- (isearch-yank-kill)
+ (if (not (memq last-command '(isearch-yank-kill
+ isearch-yank-pop isearch-yank-pop-only)))
+ (isearch-yank-from-kill-ring)
(isearch-pop-state)
(isearch-yank-string (current-kill 1))))
+(defun isearch-yank-pop-only (&optional arg)
+ "Replace just-yanked search string with previously killed string.
+Unlike `isearch-yank-pop', when this command is called not immediately
+after a `isearch-yank-kill' or a `isearch-yank-pop-only', it only pops
+the last killed string instead of activating the minibuffer to read
+a string from the `kill-ring' as `yank-pop' does. The prefix arg C-u
+always reads a string from the `kill-ring' using the minibuffer."
+ (interactive "P")
+ (cond
+ ((equal arg '(4))
+ (isearch-yank-from-kill-ring))
+ ((not (memq last-command '(isearch-yank-kill
+ isearch-yank-pop isearch-yank-pop-only)))
+ ;; Fall back on `isearch-yank-kill' for the benefits of people
+ ;; who are used to the old behavior of `M-y' in isearch mode.
+ ;; In future, `M-y' could be changed from `isearch-yank-pop-only'
+ ;; to `isearch-yank-pop' that uses the kill-ring-browser.
+ (isearch-yank-kill))
+ (t
+ (isearch-pop-state)
+ (isearch-yank-string (current-kill 1)))))
+
(defun isearch-yank-x-selection ()
"Pull current X selection into search string."
(interactive)
@@ -2960,7 +3002,7 @@ See more for options in `search-exit-option'."
((and (eq (car-safe main-event) 'down-mouse-1)
(window-minibuffer-p (posn-window (event-start main-event))))
;; Swallow the up-event.
- (read-event)
+ (read--potential-mouse-event)
(setq this-command 'isearch-edit-string))
;; Don't terminate the search for motion commands.
((and isearch-yank-on-move
@@ -3263,7 +3305,7 @@ the word mode."
"over")
(if isearch-wrapped "wrapped ")
(if (and (not isearch-success) (buffer-narrowed-p) widen-automatically)
- "narrowed-buffer " "")
+ "narrowed " "")
(if (and (not isearch-success) (not isearch-case-fold-search))
"case-sensitive ")
(let ((prefix ""))
@@ -3715,23 +3757,27 @@ since they have special meaning in a regexp."
(overlay-put isearch-overlay 'priority 1001)
(overlay-put isearch-overlay 'face isearch-face)))
- (when (and search-highlight-submatches
- isearch-regexp)
+ (when (and search-highlight-submatches isearch-regexp)
(mapc 'delete-overlay isearch-submatches-overlays)
(setq isearch-submatches-overlays nil)
- (let ((submatch-data (cddr (butlast match-data)))
+ ;; 'cddr' removes whole expression match from match-data
+ (let ((submatch-data (cddr match-data))
(group 0)
- ov face)
+ b e ov face)
(while submatch-data
- (setq group (1+ group))
- (setq ov (make-overlay (pop submatch-data) (pop submatch-data))
- face (intern-soft (format "isearch-group-%d" group)))
- ;; Recycle faces from beginning.
- (unless (facep face)
- (setq group 1 face 'isearch-group-1))
- (overlay-put ov 'face face)
- (overlay-put ov 'priority 1002)
- (push ov isearch-submatches-overlays)))))
+ (setq b (pop submatch-data)
+ e (pop submatch-data))
+ (when (and (integer-or-marker-p b)
+ (integer-or-marker-p e))
+ (setq ov (make-overlay b e)
+ group (1+ group)
+ face (intern-soft (format "isearch-group-%d" group)))
+ ;; Recycle faces from beginning
+ (unless (facep face)
+ (setq group 1 face 'isearch-group-1))
+ (overlay-put ov 'face face)
+ (overlay-put ov 'priority 1002)
+ (push ov isearch-submatches-overlays))))))
(defun isearch-dehighlight ()
(when isearch-overlay
diff --git a/lisp/isearchb.el b/lisp/isearchb.el
index f75a4b40336..3713879e3b6 100644
--- a/lisp/isearchb.el
+++ b/lisp/isearchb.el
@@ -1,6 +1,6 @@
;;; isearchb --- a marriage between iswitchb and isearch
-;; Copyright (C) 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el
index 8b3384ae827..d169e40b817 100644
--- a/lisp/jit-lock.el
+++ b/lisp/jit-lock.el
@@ -1,6 +1,6 @@
;;; jit-lock.el --- just-in-time fontification -*- lexical-binding: t -*-
-;; Copyright (C) 1998, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2000-2021 Free Software Foundation, Inc.
;; Author: Gerd Moellmann <gerd@gnu.org>
;; Keywords: faces files
diff --git a/lisp/jka-cmpr-hook.el b/lisp/jka-cmpr-hook.el
index 79d81a2559b..11d93a6df9a 100644
--- a/lisp/jka-cmpr-hook.el
+++ b/lisp/jka-cmpr-hook.el
@@ -1,6 +1,6 @@
-;;; jka-cmpr-hook.el --- preloaded code to enable jka-compr.el
+;;; jka-cmpr-hook.el --- preloaded code to enable jka-compr.el -*- lexical-binding: t; -*-
-;; Copyright (C) 1993-1995, 1997, 1999-2000, 2002-2020 Free Software
+;; Copyright (C) 1993-1995, 1997, 1999-2000, 2002-2021 Free Software
;; Foundation, Inc.
;; Author: Jay K. Adams <jka@ece.cmu.edu>
@@ -93,6 +93,7 @@ Otherwise, it is nil.")
"\\)" file-name-version-regexp "?\\'"))))
;; Functions for accessing the return value of jka-compr-get-compression-info
+;; FIXME: Use cl-defstruct!
(defun jka-compr-info-regexp (info) (aref info 0))
(defun jka-compr-info-compress-message (info) (aref info 1))
(defun jka-compr-info-compress-program (info) (aref info 2))
diff --git a/lisp/jka-compr.el b/lisp/jka-compr.el
index eef3d14fe21..877f2eb825a 100644
--- a/lisp/jka-compr.el
+++ b/lisp/jka-compr.el
@@ -1,6 +1,6 @@
;;; jka-compr.el --- reading/writing/loading compressed files
-;; Copyright (C) 1993-1995, 1997, 1999-2020 Free Software Foundation,
+;; Copyright (C) 1993-1995, 1997, 1999-2021 Free Software Foundation,
;; Inc.
;; Author: Jay K. Adams <jka@ece.cmu.edu>
@@ -664,11 +664,11 @@ and `inhibit-local-variables-suffixes' that were added
by `jka-compr-installed'."
;; Delete from inhibit-local-variables-suffixes what jka-compr-install added.
(mapc
- (function (lambda (x)
- (and (jka-compr-info-strip-extension x)
- (setq inhibit-local-variables-suffixes
- (delete (jka-compr-info-regexp x)
- inhibit-local-variables-suffixes)))))
+ (lambda (x)
+ (and (jka-compr-info-strip-extension x)
+ (setq inhibit-local-variables-suffixes
+ (delete (jka-compr-info-regexp x)
+ inhibit-local-variables-suffixes))))
jka-compr-compression-info-list--internal)
(let* ((fnha (cons nil file-name-handler-alist))
diff --git a/lisp/json.el b/lisp/json.el
index c2fc1574faa..1f1f608eaba 100644
--- a/lisp/json.el
+++ b/lisp/json.el
@@ -1,6 +1,6 @@
;;; json.el --- JavaScript Object Notation parser / generator -*- lexical-binding: t -*-
-;; Copyright (C) 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2021 Free Software Foundation, Inc.
;; Author: Theresa O'Connor <ted@oconnor.cx>
;; Version: 1.5
@@ -55,7 +55,6 @@
;;; Code:
(require 'map)
-(require 'seq)
(require 'subr-x)
;; Parameters
@@ -435,7 +434,7 @@ Initialized lazily by `json-encode-string'.")
(concat "\"" (substring-no-properties string) "\"")
(with-current-buffer
(or json--string-buffer
- (with-current-buffer (generate-new-buffer " *json-string*")
+ (with-current-buffer (generate-new-buffer " *json-string*" t)
;; This seems to afford decent performance gains.
(setq-local inhibit-modification-hooks t)
(setq json--string-buffer (current-buffer))))
@@ -655,7 +654,9 @@ become JSON objects."
(defun json-encode-array (array)
"Return a JSON representation of ARRAY."
(if (and json-encoding-pretty-print
- (not (seq-empty-p array)))
+ (if (listp array)
+ array
+ (> (length array) 0)))
(concat
"["
(json--with-indentation
diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el
index 7de6baeb00a..7f5aa8295fe 100644
--- a/lisp/jsonrpc.el
+++ b/lisp/jsonrpc.el
@@ -1,10 +1,10 @@
;;; jsonrpc.el --- JSON-RPC library -*- lexical-binding: t; -*-
-;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2018-2021 Free Software Foundation, Inc.
;; Author: João Távora <joaotavora@gmail.com>
;; Keywords: processes, languages, extensions
-;; Version: 1.0.12
+;; Version: 1.0.14
;; Package-Requires: ((emacs "25.2"))
;; This is a GNU ELPA :core package. Avoid functionality that is not
@@ -138,18 +138,15 @@ immediately."
(defun jsonrpc-events-buffer (connection)
"Get or create JSONRPC events buffer for CONNECTION."
- (let* ((probe (jsonrpc--events-buffer connection))
- (buffer (or (and (buffer-live-p probe)
- probe)
- (let ((buffer (get-buffer-create
- (format "*%s events*"
- (jsonrpc-name connection)))))
- (with-current-buffer buffer
- (buffer-disable-undo)
- (read-only-mode t)
- (setf (jsonrpc--events-buffer connection) buffer))
- buffer))))
- buffer))
+ (let ((probe (jsonrpc--events-buffer connection)))
+ (if (buffer-live-p probe)
+ probe
+ (with-current-buffer
+ (get-buffer-create (format "*%s events*" (jsonrpc-name connection)))
+ (buffer-disable-undo)
+ (setq buffer-read-only t)
+ (setf (jsonrpc--events-buffer connection)
+ (current-buffer))))))
(defun jsonrpc-forget-pending-continuations (connection)
"Stop waiting for responses from the current JSONRPC CONNECTION."
@@ -271,7 +268,7 @@ it only exits locally (returning the JSONRPC result object) if
the request is successful, otherwise it exits non-locally with an
error of type `jsonrpc-error'.
-DEFERRED is passed to `jsonrpc-async-request', which see.
+DEFERRED and TIMEOUT as in `jsonrpc-async-request', which see.
If CANCEL-ON-INPUT is non-nil and the user inputs something while
the function is waiting, then it exits immediately, returning
@@ -284,7 +281,8 @@ ignored."
(catch tag
(setq
id-and-timer
- (jsonrpc--async-request-1
+ (apply
+ #'jsonrpc--async-request-1
connection method params
:success-fn (lambda (result)
(unless cancelled
@@ -300,11 +298,12 @@ ignored."
(lambda ()
(unless cancelled
(throw tag '(error (jsonrpc-error-message . "Timed out")))))
- :deferred deferred
- :timeout timeout))
+ `(,@(when deferred `(:deferred ,deferred))
+ ,@(when timeout `(:timeout ,timeout)))))
(cond (cancel-on-input
- (while (sit-for 30))
- (setq cancelled t)
+ (unwind-protect
+ (let ((inhibit-quit t)) (while (sit-for 30)))
+ (setq cancelled t))
`(cancelled ,cancel-on-input-retval))
(t (while t (accept-process-output nil 30)))))
;; In normal operation, cancellation is handled by the
@@ -404,7 +403,7 @@ connection object, called when the process dies .")
(ignore-errors (kill-buffer hidden-name))
(rename-buffer hidden-name)
(process-put proc 'jsonrpc-stderr (current-buffer))
- (read-only-mode t))))
+ (setq buffer-read-only t))))
(setf (jsonrpc--process conn) proc)
(set-process-buffer proc (get-buffer-create (format " *%s output*" name)))
(set-process-filter proc #'jsonrpc--process-filter)
@@ -412,7 +411,9 @@ connection object, called when the process dies .")
(with-current-buffer (process-buffer proc)
(buffer-disable-undo)
(set-marker (process-mark proc) (point-min))
- (let ((inhibit-read-only t)) (erase-buffer) (read-only-mode t)))
+ (let ((inhibit-read-only t))
+ (erase-buffer))
+ (setq buffer-read-only t))
(process-put proc 'jsonrpc-connection conn)))
(cl-defmethod jsonrpc-connection-send ((connection jsonrpc-process-connection)
diff --git a/lisp/kermit.el b/lisp/kermit.el
index f2607bfcf4c..fdab7e5a505 100644
--- a/lisp/kermit.el
+++ b/lisp/kermit.el
@@ -1,6 +1,6 @@
;;; kermit.el --- additions to shell mode for use with kermit -*- lexical-binding: t -*-
-;; Copyright (C) 1988, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 2001-2021 Free Software Foundation, Inc.
;; Author: Jeff Norden <jeff@colgate.csnet>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/kmacro.el b/lisp/kmacro.el
index 3437dba5e6a..bb8dacf4f48 100644
--- a/lisp/kmacro.el
+++ b/lisp/kmacro.el
@@ -1,6 +1,6 @@
;;; kmacro.el --- enhanced keyboard macros -*- lexical-binding: t -*-
-;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Author: Kim F. Storm <storm@cua.dk>
;; Keywords: keyboard convenience
@@ -289,7 +289,8 @@ the last increment."
(defun kmacro-set-counter (arg)
"Set the value of `kmacro-counter' to ARG, or prompt for value if no argument.
-With \\[universal-argument] prefix, reset counter to its value prior to this iteration of the macro."
+With \\[universal-argument] prefix, reset counter to its value prior to this iteration of the
+macro."
(interactive "NMacro counter value: ")
(if (not (or defining-kbd-macro executing-kbd-macro))
(kmacro-display-counter (setq kmacro-initial-counter-value arg))
@@ -1272,7 +1273,8 @@ following additional answers: `insert', `insert-1', `replace', `replace-1',
(defun kmacro-step-edit-macro ()
"Step edit and execute last keyboard macro.
-To customize possible responses, change the \"bindings\" in `kmacro-step-edit-map'."
+To customize possible responses, change the \"bindings\" in
+`kmacro-step-edit-map'."
(interactive)
(let ((kmacro-step-edit-active t)
(kmacro-step-edit-new-macro "")
diff --git a/lisp/language/cham.el b/lisp/language/cham.el
index eef6d6f8f9f..089988da918 100644
--- a/lisp/language/cham.el
+++ b/lisp/language/cham.el
@@ -34,6 +34,12 @@
(set-language-info-alist
"Cham" '((charset unicode)
(coding-system utf-8)
- (coding-priority utf-8)))
+ (coding-priority utf-8)
+ (input-method . "cham")
+ (sample-text . "Cham (ꨌꩌ)\tꨦꨤꩌ ꨦꨁꨰ")
+ (documentation . "\
+The Cham script is a Brahmic script used to write Cham,
+an Austronesian language spoken by some 245,000 Chams
+in Vietnam and Cambodia.")))
(provide 'cham)
diff --git a/lisp/language/china-util.el b/lisp/language/china-util.el
index 04d40326543..4bc2eaa2cdd 100644
--- a/lisp/language/china-util.el
+++ b/lisp/language/china-util.el
@@ -1,6 +1,6 @@
;;; china-util.el --- utilities for Chinese -*- coding: utf-8 -*-
-;; Copyright (C) 1995, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/chinese.el b/lisp/language/chinese.el
index 4389db961d8..5cb8344c094 100644
--- a/lisp/language/chinese.el
+++ b/lisp/language/chinese.el
@@ -1,6 +1,6 @@
-;;; chinese.el --- support for Chinese -*- coding: utf-8; -*-
+;;; chinese.el --- support for Chinese -*- coding: utf-8; lexical-binding: t; -*-
-;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/cyril-util.el b/lisp/language/cyril-util.el
index ce60d1a3ad4..72ceffdf0d6 100644
--- a/lisp/language/cyril-util.el
+++ b/lisp/language/cyril-util.el
@@ -1,6 +1,6 @@
;;; cyril-util.el --- utilities for Cyrillic scripts
-;; Copyright (C) 1997-1998, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2001-2021 Free Software Foundation, Inc.
;; Keywords: mule, multilingual, Cyrillic
diff --git a/lisp/language/cyrillic.el b/lisp/language/cyrillic.el
index c19637010a2..c12096f95eb 100644
--- a/lisp/language/cyrillic.el
+++ b/lisp/language/cyrillic.el
@@ -1,6 +1,6 @@
-;;; cyrillic.el --- support for Cyrillic -*- coding: utf-8; -*-
+;;; cyrillic.el --- support for Cyrillic -*- coding: utf-8; lexical-binding: t; -*-
-;; Copyright (C) 1997-1998, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/czech.el b/lisp/language/czech.el
index e6923426b52..e449a7e9279 100644
--- a/lisp/language/czech.el
+++ b/lisp/language/czech.el
@@ -1,6 +1,6 @@
;;; czech.el --- support for Czech -*- coding: utf-8; lexical-binding: t -*-
-;; Copyright (C) 1998, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2001-2021 Free Software Foundation, Inc.
;; Author: Milan Zamazal <pdm@zamazal.org>
;; Maintainer: Pavel Janík <Pavel@Janik.cz>
diff --git a/lisp/language/english.el b/lisp/language/english.el
index b7af84c8f75..41d56be7d46 100644
--- a/lisp/language/english.el
+++ b/lisp/language/english.el
@@ -1,6 +1,6 @@
-;;; english.el --- support for English
+;;; english.el --- support for English -*- lexical-binding: t; -*-
-;; Copyright (C) 1997, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/ethio-util.el b/lisp/language/ethio-util.el
index 55e59ab516f..174b9ecfda2 100644
--- a/lisp/language/ethio-util.el
+++ b/lisp/language/ethio-util.el
@@ -1,6 +1,6 @@
;;; ethio-util.el --- utilities for Ethiopic -*- coding: utf-8-emacs; -*-
-;; Copyright (C) 1997-1998, 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2002-2021 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -113,17 +113,21 @@ vertically stacked dots. All SERA <--> FIDEL converters refer this
variable.")
(defvar ethio-use-three-dot-question nil
- "Non-nil means associate ASCII question mark with Ethiopic old style question mark (three vertically stacked dots).
+ "If non-nil, associate ASCII question mark with Ethiopic question mark.
+The Ethiopic old style question mark is three vertically stacked dots.
If nil, associate ASCII question mark with Ethiopic stylized question
mark. All SERA <--> FIDEL converters refer this variable.")
(defvar ethio-quote-vowel-always nil
- "Non-nil means always put an apostrophe before an isolated vowel (except at word initial) in FIDEL --> SERA conversion.
+ "Non-nil means always put an apostrophe before an isolated vowel.
+This happens in FIDEL --> SERA conversions. Isolated vowels at
+word beginning do not get an apostrophe put before them.
If nil, put an apostrophe only between a 6th-form consonant and an
isolated vowel.")
(defvar ethio-W-sixth-always nil
- "Non-nil means convert the Wu-form of a 12-form consonant to \"W'\" instead of \"Wu\" in FIDEL --> SERA conversion.")
+ "Non-nil means convert the Wu-form of a 12-form consonant to \"W'\".
+This is instead of \"Wu\" in FIDEL --> SERA conversion.")
(defvar ethio-numeric-reduction 0
"Degree of reduction in converting Ethiopic digits into Arabic digits.
diff --git a/lisp/language/ethiopic.el b/lisp/language/ethiopic.el
index 1f8b9b18d65..8573f6177df 100644
--- a/lisp/language/ethiopic.el
+++ b/lisp/language/ethiopic.el
@@ -1,6 +1,6 @@
-;;; ethiopic.el --- support for Ethiopic -*- coding: utf-8-emacs; -*-
+;;; ethiopic.el --- support for Ethiopic -*- coding: utf-8-emacs; lexical-binding: t; -*-
-;; Copyright (C) 1997, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/european.el b/lisp/language/european.el
index 713a0fdb344..bcd62a14c4c 100644
--- a/lisp/language/european.el
+++ b/lisp/language/european.el
@@ -1,6 +1,6 @@
-;;; european.el --- support for European languages -*- coding: utf-8; -*-
+;;; european.el --- support for European languages -*- coding: utf-8; lexical-binding: t; -*-
-;; Copyright (C) 1997-1998, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2000-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -324,6 +324,87 @@ Latin-9 is sometimes nicknamed `Latin-0'."))
:mime-charset 'windows-1257)
(define-coding-system-alias 'cp1257 'windows-1257)
+(define-coding-system 'ibm256
+ "Netherlands version of EBCDIC"
+ :coding-type 'charset
+ :charset-list '(ibm256)
+ :mnemonic ?*)
+(define-coding-system-alias 'ebcdic-int1 'ibm256)
+(define-coding-system-alias 'cp256 'ibm256)
+
+(define-coding-system 'ibm273
+ "Austrian / German version of EBCDIC"
+ :coding-type 'charset
+ :charset-list '(ibm273)
+ :mnemonic ?*)
+(define-coding-system-alias 'cp273 'ibm273)
+
+(define-coding-system 'ibm274
+ "Belgian version of EBCDIC"
+ :coding-type 'charset
+ :charset-list '(ibm274)
+ :mnemonic ?*)
+(define-coding-system-alias 'ebcdic-be 'ibm274)
+(define-coding-system-alias 'cp274 'ibm274)
+
+(define-coding-system 'ibm275
+ "Brazilian version of EBCDIC"
+ :coding-type 'charset
+ :charset-list '(ibm275)
+ :mnemonic ?*)
+(define-coding-system-alias 'ebcdic-br 'ibm275)
+(define-coding-system-alias 'cp275 'ibm275)
+
+(define-coding-system 'ibm277
+ "Danish / Norwegian version of EBCDIC"
+ :coding-type 'charset
+ :charset-list '(ibm277)
+ :mnemonic ?*)
+(define-coding-system-alias 'ebcdic-cp-dk 'ibm277)
+(define-coding-system-alias 'ebcdic-cp-no 'ibm277)
+(define-coding-system-alias 'cp277 'ibm277)
+
+(define-coding-system 'ibm278
+ "Finnish / Swedish version of EBCDIC"
+ :coding-type 'charset
+ :charset-list '(ibm278)
+ :mnemonic ?*)
+(define-coding-system-alias 'ebcdic-cp-fi 'ibm278)
+(define-coding-system-alias 'ebcdic-cp-se 'ibm278)
+(define-coding-system-alias 'cp278 'ibm278)
+
+(define-coding-system 'ibm280
+ "Italian version of EBCDIC"
+ :coding-type 'charset
+ :charset-list '(ibm280)
+ :mnemonic ?*)
+(define-coding-system-alias 'ebcdic-cp-it 'ibm280)
+(define-coding-system-alias 'cp280 'ibm280)
+
+(define-coding-system 'ibm284
+ "Spanish version of EBCDIC"
+ :coding-type 'charset
+ :charset-list '(ibm284)
+ :mnemonic ?*)
+(define-coding-system-alias 'ebcdic-cp-es 'ibm284)
+(define-coding-system-alias 'cp284 'ibm284)
+
+(define-coding-system 'ibm285
+ "UK english version of EBCDIC"
+ :coding-type 'charset
+ :charset-list '(ibm285)
+ :mnemonic ?*)
+(define-coding-system-alias 'ebcdic-cp-gb 'ibm285)
+(define-coding-system-alias 'cp285 'ibm285)
+
+(define-coding-system 'ibm297
+ "French version of EBCDIC"
+ :coding-type 'charset
+ :charset-list '(ibm297)
+ :mnemonic ?*)
+(define-coding-system-alias 'ebcdic-cp-fr 'ibm297)
+(define-coding-system-alias 'cp297 'ibm297)
+
(define-coding-system 'cp775
"DOS codepage 775 (PC Baltic, MS-DOS Baltic Rim)"
:coding-type 'charset
diff --git a/lisp/language/georgian.el b/lisp/language/georgian.el
index 53c994bd76f..321ef43f5f2 100644
--- a/lisp/language/georgian.el
+++ b/lisp/language/georgian.el
@@ -1,6 +1,6 @@
;;; georgian.el --- language support for Georgian -*- lexical-binding: t -*-
-;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: i18n
diff --git a/lisp/language/greek.el b/lisp/language/greek.el
index 15ae5f42f94..403a87d2535 100644
--- a/lisp/language/greek.el
+++ b/lisp/language/greek.el
@@ -1,6 +1,6 @@
;;; greek.el --- support for Greek -*- lexical-binding: t -*-
-;; Copyright (C) 2002, 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002, 2013-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/hanja-util.el b/lisp/language/hanja-util.el
index f38dead5a23..313fc63bebd 100644
--- a/lisp/language/hanja-util.el
+++ b/lisp/language/hanja-util.el
@@ -1,6 +1,6 @@
;;; hanja-util.el --- Korean Hanja util module -*- coding: utf-8 -*-
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Jihyun Cho <jihyun.jo@gmail.com>
;; Keywords: multilingual, input method, Korean, Hanja
diff --git a/lisp/language/hebrew.el b/lisp/language/hebrew.el
index 08b70abfc29..389565669a9 100644
--- a/lisp/language/hebrew.el
+++ b/lisp/language/hebrew.el
@@ -1,6 +1,6 @@
-;;; hebrew.el --- support for Hebrew -*- coding: utf-8 -*-
+;;; hebrew.el --- support for Hebrew -*- coding: utf-8; lexical-binding: t; -*-
-;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/ind-util.el b/lisp/language/ind-util.el
index 62885227f10..4bd1cd76a6d 100644
--- a/lisp/language/ind-util.el
+++ b/lisp/language/ind-util.el
@@ -1,6 +1,6 @@
;;; ind-util.el --- Transliteration and Misc. Tools for Indian Languages -*- coding: utf-8-emacs; -*-
-;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Keywords: multilingual, Indian, Devanagari
diff --git a/lisp/language/indian.el b/lisp/language/indian.el
index 657ad6915eb..5ff57966c12 100644
--- a/lisp/language/indian.el
+++ b/lisp/language/indian.el
@@ -1,6 +1,6 @@
-;;; indian.el --- Indian languages support -*- coding: utf-8; -*-
+;;; indian.el --- Indian languages support -*- coding: utf-8; lexical-binding: t; -*-
-;; Copyright (C) 1997, 1999, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1999, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
diff --git a/lisp/language/japan-util.el b/lisp/language/japan-util.el
index 56052b1395c..9dce17c4967 100644
--- a/lisp/language/japan-util.el
+++ b/lisp/language/japan-util.el
@@ -1,6 +1,6 @@
;;; japan-util.el --- utilities for Japanese
-;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/japanese.el b/lisp/language/japanese.el
index 9a99245dfde..bd8ef6ec857 100644
--- a/lisp/language/japanese.el
+++ b/lisp/language/japanese.el
@@ -1,6 +1,6 @@
-;;; japanese.el --- support for Japanese
+;;; japanese.el --- support for Japanese -*- lexical-binding: t; -*-
-;; Copyright (C) 1997, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -188,6 +188,22 @@ eucJP-ms is defined in <http://www.opengroup.or.jp/jvc/cde/appendix.html>."
(define-coding-system-alias 'shift_jis-2004 'japanese-shift-jis-2004)
+(define-coding-system 'ibm281
+ "Japanese-E version of EBCDIC"
+ :coding-type 'charset
+ :charset-list '(ibm281)
+ :mnemonic ?*)
+(define-coding-system-alias 'ebcdic-jp-e 'ibm281)
+(define-coding-system-alias 'cp281 'ibm281)
+
+(define-coding-system 'ibm290
+ "Japanese katakana version of EBCDIC"
+ :coding-type 'charset
+ :charset-list '(ibm290)
+ :mnemonic ?*)
+(define-coding-system-alias 'ebcdic-jp-kana 'ibm290)
+(define-coding-system-alias 'cp290 'ibm290)
+
(set-language-info-alist
"Japanese" '((setup-function . setup-japanese-environment-internal)
(exit-function . use-default-char-width-table)
diff --git a/lisp/language/korea-util.el b/lisp/language/korea-util.el
index 3821785da73..eb7b85bce81 100644
--- a/lisp/language/korea-util.el
+++ b/lisp/language/korea-util.el
@@ -1,6 +1,6 @@
;;; korea-util.el --- utilities for Korean
-;; Copyright (C) 1997, 1999, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1999, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
;; 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -70,27 +70,24 @@
(interactive)
(let ((overriding-terminal-local-map nil))
(toggle-korean-input-method))
- (setq isearch-input-method-function input-method-function
- isearch-input-method-local-p t)
- (setq input-method-function nil)
+ (setq isearch-input-method-function input-method-function)
+ (setq-local input-method-function nil)
(isearch-update))
(defun isearch-hangul-switch-symbol-ksc ()
(interactive)
(let ((overriding-terminal-local-map nil))
(quail-hangul-switch-symbol-ksc))
- (setq isearch-input-method-function input-method-function
- isearch-input-method-local-p t)
- (setq input-method-function nil)
+ (setq isearch-input-method-function input-method-function)
+ (setq-local input-method-function nil)
(isearch-update))
(defun isearch-hangul-switch-hanja ()
(interactive)
(let ((overriding-terminal-local-map nil))
(quail-hangul-switch-hanja))
- (setq isearch-input-method-function input-method-function
- isearch-input-method-local-p t)
- (setq input-method-function nil)
+ (setq isearch-input-method-function input-method-function)
+ (setq-local input-method-function nil)
(isearch-update))
;; Information for setting and exiting Korean environment.
diff --git a/lisp/language/korean.el b/lisp/language/korean.el
index 7e758159a48..22b33a440ef 100644
--- a/lisp/language/korean.el
+++ b/lisp/language/korean.el
@@ -1,6 +1,6 @@
-;;; korean.el --- support for Korean -*- coding: utf-8 -*-
+;;; korean.el --- support for Korean -*- coding: utf-8; lexical-binding: t; -*-
-;; Copyright (C) 1998, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -42,6 +42,7 @@
(define-coding-system-alias 'euc-kr 'korean-iso-8bit)
(define-coding-system-alias 'euc-korea 'korean-iso-8bit)
+(define-coding-system-alias 'ks_c_5601-1987 'korean-iso-8bit)
(define-coding-system 'iso-2022-kr
"ISO 2022 based 7-bit encoding for Korean KSC5601 (MIME:ISO-2022-KR)."
diff --git a/lisp/language/lao-util.el b/lisp/language/lao-util.el
index fa4c2f7f891..59c9850b1a1 100644
--- a/lisp/language/lao-util.el
+++ b/lisp/language/lao-util.el
@@ -1,6 +1,6 @@
;;; lao-util.el --- utilities for Lao -*- coding: utf-8; -*-
-;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
;; 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/lao.el b/lisp/language/lao.el
index ad96fe3c70c..5252f1e60ea 100644
--- a/lisp/language/lao.el
+++ b/lisp/language/lao.el
@@ -1,6 +1,6 @@
-;;; lao.el --- support for Lao -*- coding: utf-8 -*-
+;;; lao.el --- support for Lao -*- coding: utf-8; lexical-binding: t; -*-
-;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
;; 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/misc-lang.el b/lisp/language/misc-lang.el
index 089b79c5208..0a274f144c2 100644
--- a/lisp/language/misc-lang.el
+++ b/lisp/language/misc-lang.el
@@ -1,4 +1,4 @@
-;;; misc-lang.el --- support for miscellaneous languages (characters)
+;;; misc-lang.el --- support for miscellaneous languages (characters) -*- lexical-binding: t; -*-
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
diff --git a/lisp/language/romanian.el b/lisp/language/romanian.el
index 9f1c67765e1..2112df7b150 100644
--- a/lisp/language/romanian.el
+++ b/lisp/language/romanian.el
@@ -1,6 +1,6 @@
;;; romanian.el --- support for Romanian -*- coding: utf-8; lexical-binding: t -*-
-;; Copyright (C) 1998, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2001-2021 Free Software Foundation, Inc.
;; Author: Dan Nicolaescu <done@ece.arizona.edu>
;; Keywords: multilingual, Romanian, i18n
diff --git a/lisp/language/slovak.el b/lisp/language/slovak.el
index c42a872574d..2a738467d20 100644
--- a/lisp/language/slovak.el
+++ b/lisp/language/slovak.el
@@ -1,6 +1,6 @@
;;; slovak.el --- support for Slovak -*- coding: utf-8; lexical-binding: t -*-
-;; Copyright (C) 1998, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2001-2021 Free Software Foundation, Inc.
;; Authors: Tibor Šimko <tibor.simko@fmph.uniba.sk>,
;; Milan Zamazal <pdm@zamazal.org>
diff --git a/lisp/language/tai-viet.el b/lisp/language/tai-viet.el
index 039e478b162..17abf136f7f 100644
--- a/lisp/language/tai-viet.el
+++ b/lisp/language/tai-viet.el
@@ -1,6 +1,6 @@
;;; tai-viet.el --- support for Tai Viet -*- coding: utf-8; lexical-binding: t -*-
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Copyright (C) 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H13PRO009
diff --git a/lisp/language/thai-util.el b/lisp/language/thai-util.el
index b856e67df1e..f9c57e8ca83 100644
--- a/lisp/language/thai-util.el
+++ b/lisp/language/thai-util.el
@@ -1,6 +1,6 @@
;;; thai-util.el --- utilities for Thai -*- coding: utf-8; -*-
-;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/thai.el b/lisp/language/thai.el
index 800657b99af..be15db49db9 100644
--- a/lisp/language/thai.el
+++ b/lisp/language/thai.el
@@ -1,6 +1,6 @@
-;;; thai.el --- support for Thai -*- coding: utf-8 -*-
+;;; thai.el --- support for Thai -*- coding: utf-8; lexical-binding: t; -*-
-;; Copyright (C) 1997-1998, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2000-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/tibet-util.el b/lisp/language/tibet-util.el
index 04369f6af87..e741af18740 100644
--- a/lisp/language/tibet-util.el
+++ b/lisp/language/tibet-util.el
@@ -1,6 +1,6 @@
;;; tibet-util.el --- utilities for Tibetan -*- coding: utf-8-emacs; -*-
-;; Copyright (C) 1997, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/tibetan.el b/lisp/language/tibetan.el
index bbd4729f6c5..edd9d765b1e 100644
--- a/lisp/language/tibetan.el
+++ b/lisp/language/tibetan.el
@@ -1,6 +1,6 @@
-;;; tibetan.el --- support for Tibetan language -*- coding: utf-8-emacs; -*-
+;;; tibetan.el --- support for Tibetan language -*- coding: utf-8-emacs; lexical-binding: t; -*-
-;; Copyright (C) 1997, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/utf-8-lang.el b/lisp/language/utf-8-lang.el
index 9e59f61ee10..f23b3889cc4 100644
--- a/lisp/language/utf-8-lang.el
+++ b/lisp/language/utf-8-lang.el
@@ -1,6 +1,6 @@
;;; utf-8-lang.el --- generic UTF-8 language environment -*- lexical-binding: t -*-
-;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: i18n
diff --git a/lisp/language/viet-util.el b/lisp/language/viet-util.el
index bd9aa596d2c..177b04bc473 100644
--- a/lisp/language/viet-util.el
+++ b/lisp/language/viet-util.el
@@ -1,6 +1,6 @@
;;; viet-util.el --- utilities for Vietnamese -*- coding: utf-8; -*-
-;; Copyright (C) 1998, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/vietnamese.el b/lisp/language/vietnamese.el
index c1cef962865..7980041e2b3 100644
--- a/lisp/language/vietnamese.el
+++ b/lisp/language/vietnamese.el
@@ -1,6 +1,6 @@
;;; vietnamese.el --- support for Vietnamese -*- coding: utf-8; lexical-binding: t -*-
-;; Copyright (C) 1998, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el
index f5ae3adf2eb..c6fa497c213 100644
--- a/lisp/ldefs-boot.el
+++ b/lisp/ldefs-boot.el
@@ -1,4 +1,4 @@
-;;; loaddefs.el --- automatically extracted autoloads
+;;; loaddefs.el --- automatically extracted autoloads -*- lexical-binding: t -*-
;;
;;; Code:
@@ -515,9 +515,9 @@ If called interactively, toggle `Allout mode'. If the prefix argument
is positive, enable the mode, and if it is zero or negative, disable
the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -836,9 +836,9 @@ If called interactively, toggle `Allout-Widgets mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -1202,14 +1202,16 @@ The variables are:
Variables you assign:
array-max-row: The number of rows in the array.
array-max-column: The number of columns in the array.
- array-columns-per-line: The number of columns in the array per line of buffer.
+ array-columns-per-line: The number of columns in the array
+ per line of buffer.
array-field-width: The width of each field, in characters.
array-rows-numbered: A logical variable describing whether to ignore
- row numbers in the buffer.
+ row numbers in the buffer.
Variables which are calculated:
array-line-length: The number of characters in a buffer line.
- array-lines-per-row: The number of buffer lines used to display each row.
+ array-lines-per-row: The number of buffer lines used to
+ display each row.
The following commands are available (an asterisk indicates it may
take a numeric prefix argument):
@@ -1219,17 +1221,17 @@ take a numeric prefix argument):
* \\[array-next-row] Move down one row.
* \\[array-previous-row] Move up one row.
- * \\[array-copy-forward] Copy the current field into the column to the right.
- * \\[array-copy-backward] Copy the current field into the column to the left.
- * \\[array-copy-down] Copy the current field into the row below.
- * \\[array-copy-up] Copy the current field into the row above.
+ * \\[array-copy-forward] Copy current field into the column to the right.
+ * \\[array-copy-backward] Copy current field into the column to the left.
+ * \\[array-copy-down] Copy current field into the row below.
+ * \\[array-copy-up] Copy current field into the row above.
- * \\[array-copy-column-forward] Copy the current column into the column to the right.
- * \\[array-copy-column-backward] Copy the current column into the column to the left.
+ * \\[array-copy-column-forward] Copy current column into the column to the right.
+ * \\[array-copy-column-backward] Copy current column into the column to the left.
* \\[array-copy-row-down] Copy the current row into the row below.
* \\[array-copy-row-up] Copy the current row into the row above.
- \\[array-fill-rectangle] Copy the field at mark into every cell with row and column
+ \\[array-fill-rectangle] Copy field at mark into every cell with row and column
between that of point and mark.
\\[array-what-position] Display the current array row and column.
@@ -1240,7 +1242,7 @@ take a numeric prefix argument):
\\[array-expand-rows] Expand the array (remove row numbers and
newlines inside rows)
- \\[array-display-local-variables] Display the current values of local variables.
+ \\[array-display-local-variables] Display current values of local variables.
Entering array mode calls the function `array-mode-hook'.
@@ -1260,9 +1262,9 @@ If called interactively, toggle `Artist mode'. If the prefix argument
is positive, enable the mode, and if it is zero or negative, disable
the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -1510,8 +1512,9 @@ let-binding.")
(autoload 'authinfo-mode "auth-source" "\
Mode for editing .authinfo/.netrc files.
-This is just like `fundamental-mode', but hides passwords. The
-passwords are revealed when point moved into the password.
+This is just like `fundamental-mode', but has basic syntax
+highlighting and hides passwords. Passwords are revealed when
+point is moved into the passwords (see `authinfo-hide-elements').
\\{authinfo-mode-map}
@@ -1598,9 +1601,9 @@ If called interactively, toggle `Autoarg-Kp mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -1660,9 +1663,9 @@ If called interactively, toggle `Auto-Insert mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -1753,9 +1756,9 @@ If called interactively, toggle `Auto-Revert mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -1786,9 +1789,9 @@ If called interactively, toggle `Auto-Revert-Tail mode'. If the
prefix argument is positive, enable the mode, and if it is zero or
negative, disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -1833,9 +1836,9 @@ If called interactively, toggle `Global Auto-Revert mode'. If the
prefix argument is positive, enable the mode, and if it is zero or
negative, disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -1970,9 +1973,9 @@ If called interactively, toggle `Display-Battery mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -1994,7 +1997,7 @@ seconds.
(autoload 'benchmark-run "benchmark" "\
Time execution of FORMS.
-If REPETITIONS is supplied as a number, run forms that many times,
+If REPETITIONS is supplied as a number, run FORMS that many times,
accounting for the overhead of the resulting loop. Otherwise run
FORMS once.
Return a list of the total elapsed time for execution, the number of
@@ -2952,9 +2955,9 @@ If called interactively, toggle `Bug-Reference mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -2968,9 +2971,9 @@ If called interactively, toggle `Bug-Reference-Prog mode'. If the
prefix argument is positive, enable the mode, and if it is zero or
negative, disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -3038,7 +3041,11 @@ before scanning it.
If the third argument FORCE is non-nil, recompile every `.el' file
that already has a `.elc' file.
-\(fn DIRECTORY &optional ARG FORCE)" t nil)
+This command will normally not follow symlinks when compiling
+files. If FOLLOW-SYMLINKS is non-nil, symlinked `.el' files will
+also be compiled.
+
+\(fn DIRECTORY &optional ARG FORCE FOLLOW-SYMLINKS)" t nil)
(put 'no-byte-compile 'safe-local-variable 'booleanp)
(autoload 'byte-compile-file "bytecomp" "\
@@ -4713,9 +4720,9 @@ If called interactively, toggle `Checkdoc minor mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -4829,9 +4836,9 @@ If called interactively, toggle `Cl-Font-Lock-Built-In mode'. If the
prefix argument is positive, enable the mode, and if it is zero or
negative, disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -4873,8 +4880,18 @@ DEFAULT-BODY, if present, is used as the body of a default method.
(autoload 'cl-defmethod "cl-generic" "\
Define a new method for generic function NAME.
-I.e. it defines the implementation of NAME to use for invocations where the
-values of the dispatch arguments match the specified TYPEs.
+This it defines an implementation of NAME to use for invocations
+of specific types of arguments.
+
+ARGS is a list of dispatch arguments (see `cl-defun'), but where
+each variable element is either just a single variable name VAR,
+or a list on the form (VAR TYPE).
+
+For instance:
+
+ (cl-defmethod foo (bar (format-string string) &optional zot)
+ (format format-string bar))
+
The dispatch arguments have to be among the mandatory arguments, and
all methods of NAME have to use the same set of arguments for dispatch.
Each dispatch argument and TYPE are specified in ARGS where the corresponding
@@ -5047,9 +5064,9 @@ If called interactively, toggle `Cl-Old-Struct-Compat mode'. If the
prefix argument is positive, enable the mode, and if it is zero or
negative, disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -5395,7 +5412,7 @@ You might also use mode hooks to specify it in certain modes, like this:
(lambda ()
(unless (or (file-exists-p \"makefile\")
(file-exists-p \"Makefile\"))
- (set (make-local-variable \\='compile-command)
+ (setq-local compile-command
(concat \"make -k \"
(if buffer-file-name
(shell-quote-argument
@@ -5486,9 +5503,9 @@ If called interactively, toggle `Compilation-Shell minor mode'. If
the prefix argument is positive, enable the mode, and if it is zero or
negative, disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -5507,9 +5524,9 @@ If called interactively, toggle `Compilation minor mode'. If the
prefix argument is positive, enable the mode, and if it is zero or
negative, disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -5550,9 +5567,9 @@ If called interactively, toggle `Dynamic-Completion mode'. If the
prefix argument is positive, enable the mode, and if it is zero or
negative, disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -6117,9 +6134,9 @@ If called interactively, toggle `Cua mode'. If the prefix argument is
positive, enable the mode, and if it is zero or negative, disable the
mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -6171,9 +6188,9 @@ If called interactively, toggle `Cua-Rectangle-Mark mode'. If the
prefix argument is positive, enable the mode, and if it is zero or
negative, disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -6200,9 +6217,9 @@ If called interactively, toggle `Cursor-Intangible mode'. If the
prefix argument is positive, enable the mode, and if it is zero or
negative, disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -6221,9 +6238,9 @@ If called interactively, toggle `Cursor-Sensor mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -6607,9 +6624,9 @@ If called interactively, toggle `Cwarn mode'. If the prefix argument
is positive, enable the mode, and if it is zero or negative, disable
the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -6639,14 +6656,13 @@ or call the function `global-cwarn-mode'.")
(autoload 'global-cwarn-mode "cwarn" "\
Toggle Cwarn mode in all buffers.
With prefix ARG, enable Global Cwarn mode if ARG is positive;
-otherwise, disable it. If called from Lisp, enable the mode if
-ARG is omitted or nil.
+otherwise, disable it. If called from Lisp, enable the mode if ARG is
+omitted or nil.
Cwarn mode is enabled in all buffers where
`turn-on-cwarn-mode-if-enabled' would do it.
-See `cwarn-mode' for more information on
-Cwarn mode.
+See `cwarn-mode' for more information on Cwarn mode.
\(fn &optional ARG)" t nil)
@@ -7062,9 +7078,9 @@ If called interactively, toggle `Delete-Selection mode'. If the
prefix argument is positive, enable the mode, and if it is zero or
negative, disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -7237,9 +7253,9 @@ If called interactively, toggle `Desktop-Save mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -7534,6 +7550,90 @@ Major mode for editing the diary file.
;;;***
+;;;### (autoloads nil "dictionary" "net/dictionary.el" (0 0 0 0))
+;;; Generated autoloads from net/dictionary.el
+
+(autoload 'dictionary-mode "dictionary" "\
+Mode for searching a dictionary.
+This is a mode for searching a dictionary server implementing the
+protocol defined in RFC 2229.
+
+This is a quick reference to this mode describing the default key bindings:
+
+* q close the dictionary buffer
+* h display this help information
+* s ask for a new word to search
+* d search the word at point
+* n or Tab place point to the next link
+* p or S-Tab place point to the prev link
+
+* m ask for a pattern and list all matching words.
+* D select the default dictionary
+* M select the default search strategy
+
+* Return or Button2 visit that link
+" nil nil)
+
+(autoload 'dictionary "dictionary" "\
+Create a new dictonary buffer and install dictionary-mode." t nil)
+
+(autoload 'dictionary-search "dictionary" "\
+Search the WORD in DICTIONARY if given or in all if nil.
+It presents the selection or word at point as default input and
+allows editing it.
+
+\(fn WORD &optional DICTIONARY)" t nil)
+
+(autoload 'dictionary-lookup-definition "dictionary" "\
+Unconditionally lookup the word at point." t nil)
+
+(autoload 'dictionary-match-words "dictionary" "\
+Search PATTERN in current default dictionary using default strategy.
+
+\(fn &optional PATTERN &rest IGNORED)" t nil)
+
+(autoload 'dictionary-mouse-popup-matching-words "dictionary" "\
+Display entries matching the word at the cursor retrieved using EVENT.
+
+\(fn EVENT)" t nil)
+
+(autoload 'dictionary-popup-matching-words "dictionary" "\
+Display entries matching WORD or the current word if not given.
+
+\(fn &optional WORD)" t nil)
+
+(autoload 'dictionary-tooltip-mode "dictionary" "\
+Display tooltips for the current word.
+
+This function can be used to enable or disable the tooltip mode
+for the current buffer (based on ARG). If global-tooltip-mode is
+active it will overwrite that mode for the current buffer.
+
+\(fn &optional ARG)" t nil)
+
+(autoload 'global-dictionary-tooltip-mode "dictionary" "\
+Enable/disable dictionary-tooltip-mode for all buffers.
+
+Internally it provides a default for the dictionary-tooltip-mode.
+It can be overwritten for each buffer using dictionary-tooltip-mode.
+
+Note: (global-dictionary-tooltip-mode 0) will not disable the mode
+any buffer where (dictionary-tooltip-mode 1) has been called.
+
+\(fn &optional ARG)" t nil)
+
+(register-definition-prefixes "dictionary" '("dictionary-" "global-dictionary-tooltip-mode"))
+
+;;;***
+
+;;;### (autoloads nil "dictionary-connection" "net/dictionary-connection.el"
+;;;;;; (0 0 0 0))
+;;; Generated autoloads from net/dictionary-connection.el
+
+(register-definition-prefixes "dictionary-connection" '("dictionary-connection-"))
+
+;;;***
+
;;;### (autoloads nil "diff" "vc/diff.el" (0 0 0 0))
;;; Generated autoloads from vc/diff.el
@@ -7636,9 +7736,9 @@ If called interactively, toggle `Diff minor mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -7828,9 +7928,9 @@ If called interactively, toggle `Dirtrack mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -8005,9 +8105,9 @@ If called interactively, toggle `Display-Fill-Column-Indicator mode'.
If the prefix argument is positive, enable the mode, and if it is zero
or negative, disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -8035,9 +8135,9 @@ or call the function `global-display-fill-column-indicator-mode'.")
(autoload 'global-display-fill-column-indicator-mode "display-fill-column-indicator" "\
Toggle Display-Fill-Column-Indicator mode in all buffers.
-With prefix ARG, enable Global Display-Fill-Column-Indicator mode if ARG is positive;
-otherwise, disable it. If called from Lisp, enable the mode if
-ARG is omitted or nil.
+With prefix ARG, enable Global Display-Fill-Column-Indicator mode if
+ARG is positive; otherwise, disable it. If called from Lisp, enable
+the mode if ARG is omitted or nil.
Display-Fill-Column-Indicator mode is enabled in all buffers where
`display-fill-column-indicator--turn-on' would do it.
@@ -8045,8 +8145,8 @@ Display-Fill-Column-Indicator mode is enabled in all buffers where
See `display-fill-column-indicator-mode' for more information on
Display-Fill-Column-Indicator mode.
-`global-display-fill-column-indicator-modes' is used to control which modes
-this minor mode is used in.
+`global-display-fill-column-indicator-modes' is used to control
+which modes this minor mode is used in.
\(fn &optional ARG)" t nil)
@@ -8082,9 +8182,9 @@ If called interactively, toggle `Display-Line-Numbers mode'. If the
prefix argument is positive, enable the mode, and if it is zero or
negative, disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -8109,9 +8209,9 @@ or call the function `global-display-line-numbers-mode'.")
(autoload 'global-display-line-numbers-mode "display-line-numbers" "\
Toggle Display-Line-Numbers mode in all buffers.
-With prefix ARG, enable Global Display-Line-Numbers mode if ARG is positive;
-otherwise, disable it. If called from Lisp, enable the mode if
-ARG is omitted or nil.
+With prefix ARG, enable Global Display-Line-Numbers mode if ARG is
+positive; otherwise, disable it. If called from Lisp, enable the mode
+if ARG is omitted or nil.
Display-Line-Numbers mode is enabled in all buffers where
`display-line-numbers--turn-on' would do it.
@@ -8225,9 +8325,9 @@ If called interactively, toggle `Doc-View minor mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -8293,9 +8393,9 @@ If called interactively, toggle `Double mode'. If the prefix argument
is positive, enable the mode, and if it is zero or negative, disable
the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -8315,6 +8415,9 @@ strings when pressed twice. See `double-map' for details.
(autoload 'dunnet "dunnet" "\
Switch to *dungeon* buffer and start game." t nil)
+(autoload 'dun-batch "dunnet" "\
+Start `dunnet' in batch mode." nil nil)
+
(register-definition-prefixes "dunnet" '("dun" "obj-special"))
;;;***
@@ -9143,9 +9246,9 @@ If called interactively, toggle `Global Ede mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -9997,9 +10100,9 @@ If called interactively, toggle `Electric-Pair mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -10021,9 +10124,9 @@ If called interactively, toggle `Electric-Pair-Local mode'. If the
prefix argument is positive, enable the mode, and if it is zero or
negative, disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -10244,9 +10347,9 @@ If called interactively, toggle `Enriched mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -10509,9 +10612,9 @@ If called interactively, toggle `epa-mail mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -10579,9 +10682,9 @@ If called interactively, toggle `Epa-Global-Mail mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -11200,8 +11303,8 @@ Search through all files listed in tags table for match for REGEXP.
Stops when a match is found.
To continue searching for next match, use command \\[tags-loop-continue].
-If FILES if non-nil should be a list or an iterator returning the files to search.
-The search will be restricted to these files.
+If FILES if non-nil should be a list or an iterator returning the
+files to search. The search will be restricted to these files.
Also see the documentation of the `tags-file-name' variable.
@@ -11883,13 +11986,13 @@ Set the base remapping of FACE in the current buffer to SPECS.
This causes the remappings specified by `face-remap-add-relative'
to apply on top of the face specification given by SPECS.
-The remaining arguments, SPECS, should form a list of faces.
-Each list element should be either a face name or a property list
+The remaining arguments, SPECS, specify the base of the remapping.
+Each one of SPECS should be either a face name or a property list
of face attribute/value pairs, like in a `face' text property.
-If SPECS is empty, call `face-remap-reset-base' to use the normal
-definition of FACE as the base remapping; note that this is
-different from SPECS containing a single value nil, which means
+If SPECS is empty or a single face `eq' to FACE, call `face-remap-reset-base'
+to use the normal definition of FACE as the base remapping; note that
+this is different from SPECS containing a single value nil, which means
not to inherit from the global definition of FACE at all.
\(fn FACE &rest SPECS)" nil nil)
@@ -11962,9 +12065,9 @@ If called interactively, toggle `Buffer-Face mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -12011,7 +12114,7 @@ Besides the choice of face, it is the same as `buffer-face-mode'.
\(fn &optional ARG)" t nil)
-(register-definition-prefixes "face-remap" '("buffer-face-mode-" "face-" "internal-lisp-face-attributes" "text-scale-m"))
+(register-definition-prefixes "face-remap" '("buffer-face-mode-" "face-" "internal-lisp-face-attributes" "text-scale-"))
;;;***
@@ -12097,10 +12200,10 @@ internally by feedmail):
after-run (the queue has just been run, possibly sending messages)
WHAT-EVENT is used as a key into the table `feedmail-queue-reminder-alist'. If
-the associated value is a function, it is called without arguments and is expected
-to perform the reminder activity. You can supply your own reminder functions
-by redefining `feedmail-queue-reminder-alist'. If you don't want any reminders,
-you can set `feedmail-queue-reminder-alist' to nil.
+the associated value is a function, it is called without arguments and is
+expected to perform the reminder activity. You can supply your own reminder
+functions by redefining `feedmail-queue-reminder-alist'. If you don't want any
+reminders, you can set `feedmail-queue-reminder-alist' to nil.
\(fn &optional WHAT-EVENT)" t nil)
@@ -12385,6 +12488,12 @@ Execute BODY, and unwind connection-local variables.
\(fn &rest BODY)" nil t)
+(autoload 'path-separator "files-x" "\
+The connection-local value of `path-separator'." nil nil)
+
+(autoload 'null-device "files-x" "\
+The connection-local value of `null-device'." nil nil)
+
(register-definition-prefixes "files-x" '("connection-local-" "dir-locals-to-string" "hack-connection-local-variables" "modify-" "read-file-local-variable"))
;;;***
@@ -12873,7 +12982,7 @@ diagnostics at BEG.
(autoload 'flymake-diag-region "flymake" "\
Compute BUFFER's region (BEG . END) corresponding to LINE and COL.
If COL is nil, return a region just for LINE. Return nil if the
-region is invalid.
+region is invalid. This function saves match data.
\(fn BUFFER LINE &optional COL)" nil nil)
@@ -12884,9 +12993,9 @@ If called interactively, toggle `Flymake mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -12972,9 +13081,9 @@ If called interactively, toggle `Flyspell mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -13055,9 +13164,9 @@ If called interactively, toggle `Follow mode'. If the prefix argument
is positive, enable the mode, and if it is zero or negative, disable
the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -13185,9 +13294,9 @@ If called interactively, toggle `Footnote mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -13251,7 +13360,10 @@ the symbol `delete', remove those %-specs from the result;
otherwise do the same as for the symbol `ignore', but also leave
any occurrences of \"%%\" in FORMAT verbatim in the result.
-\(fn FORMAT SPECIFICATION &optional IGNORE-MISSING)" nil nil)
+If SPLIT, instead of returning a single string, a list of strings
+is returned, where each format spec is its own element.
+
+\(fn FORMAT SPECIFICATION &optional IGNORE-MISSING SPLIT)" nil nil)
(register-definition-prefixes "format-spec" '("format-spec-"))
@@ -13652,9 +13764,9 @@ If called interactively, toggle `Gdb-Enable-Debug mode'. If the
prefix argument is positive, enable the mode, and if it is zero or
negative, disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -13836,9 +13948,9 @@ If called interactively, toggle `Glasses mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -14451,9 +14563,9 @@ If called interactively, toggle `Gnus-Mailing-List mode'. If the
prefix argument is positive, enable the mode, and if it is zero
or negative, disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'.
-Enable the mode if ARG is nil, omitted, or is a positive number.
-All other values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when
it is disabled.
@@ -14731,6 +14843,14 @@ Initialize the Gnus registry." t nil)
;;;***
+;;;### (autoloads nil "gnus-search" "gnus/gnus-search.el" (0 0 0
+;;;;;; 0))
+;;; Generated autoloads from gnus/gnus-search.el
+
+(register-definition-prefixes "gnus-search" '("gnus-search-"))
+
+;;;***
+
;;;### (autoloads nil "gnus-sieve" "gnus/gnus-sieve.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-sieve.el
@@ -14908,9 +15028,9 @@ If called interactively, toggle `Goto-Address mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -14932,14 +15052,13 @@ or call the function `global-goto-address-mode'.")
(autoload 'global-goto-address-mode "goto-addr" "\
Toggle Goto-Address mode in all buffers.
With prefix ARG, enable Global Goto-Address mode if ARG is positive;
-otherwise, disable it. If called from Lisp, enable the mode if
-ARG is omitted or nil.
+otherwise, disable it. If called from Lisp, enable the mode if ARG
+is omitted or nil.
Goto-Address mode is enabled in all buffers where
`goto-addr-mode--turn-on' would do it.
-See `goto-address-mode' for more information on
-Goto-Address mode.
+See `goto-address-mode' for more information on Goto-Address mode.
\(fn &optional ARG)" t nil)
@@ -14950,9 +15069,9 @@ If called interactively, toggle `Goto-Address-Prog mode'. If the
prefix argument is positive, enable the mode, and if it is zero or
negative, disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -15023,7 +15142,7 @@ List of hook functions run by `grep-process-setup' (see `run-hooks').")
(custom-autoload 'grep-setup-hook "grep" t)
-(defconst grep-regexp-alist `((,(concat "^\\(?:" "\\(?1:[^\0\n]+\\)\\(?3:\0\\)\\(?2:[0-9]+\\):" "\\|" "\\(?1:" "\\(?:[a-zA-Z]:\\)?" "[^\n:]+?[^\n/:]\\):[\11 ]*\\(?2:[1-9][0-9]*\\)[\11 ]*:" "\\)") 1 2 (,(lambda nil (when grep-highlight-matches (let* ((beg (match-end 0)) (end (save-excursion (goto-char beg) (line-end-position))) (mbeg (text-property-any beg end 'font-lock-face grep-match-face))) (when mbeg (- mbeg beg))))) \, (lambda nil (when grep-highlight-matches (let* ((beg (match-end 0)) (end (save-excursion (goto-char beg) (line-end-position))) (mbeg (text-property-any beg end 'font-lock-face grep-match-face)) (mend (and mbeg (next-single-property-change mbeg 'font-lock-face nil end)))) (when mend (- mend beg)))))) nil nil (3 '(face nil display ":"))) ("^Binary file \\(.+\\) matches$" 1 nil nil 0 1)) "\
+(defconst grep-regexp-alist `((,(concat "^\\(?:" "\\(?1:[^\0\n]+\\)\\(?3:\0\\)\\(?2:[0-9]+\\):" "\\|" "\\(?1:" "\\(?:[a-zA-Z]:\\)?" "[^\n:]+?[^\n/:]\\):[\11 ]*\\(?2:[1-9][0-9]*\\)[\11 ]*:" "\\)") 1 2 (,(lambda nil (when grep-highlight-matches (let* ((beg (match-end 0)) (end (save-excursion (goto-char beg) (line-end-position))) (mbeg (text-property-any beg end 'font-lock-face grep-match-face))) (when mbeg (- mbeg beg))))) \, (lambda nil (when grep-highlight-matches (let* ((beg (match-end 0)) (end (save-excursion (goto-char beg) (line-end-position))) (mbeg (text-property-any beg end 'font-lock-face grep-match-face)) (mend (and mbeg (next-single-property-change mbeg 'font-lock-face nil end)))) (when mend (- mend beg)))))) nil nil (3 '(face nil display ":"))) ("^Binary file \\(.+\\) matches" 1 nil nil 0 1)) "\
Regexp used to match grep hits.
See `compilation-error-regexp-alist' for format details.")
@@ -15233,7 +15352,7 @@ and source-file directory for your debugger.
\(fn COMMAND-LINE)" t nil)
(autoload 'pdb "gud" "\
-Run COMMAND-LINE in the `*gud-FILE*' buffer.
+Run COMMAND-LINE in the `*gud-FILE*' buffer to debug Python programs.
COMMAND-LINE should include the pdb executable
name (`gud-pdb-command-name') and the file to be debugged.
@@ -15290,9 +15409,9 @@ If called interactively, toggle `Gud-Tooltip mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -16011,9 +16130,9 @@ If called interactively, toggle `Hi-Lock mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -16095,14 +16214,13 @@ or call the function `global-hi-lock-mode'.")
(autoload 'global-hi-lock-mode "hi-lock" "\
Toggle Hi-Lock mode in all buffers.
With prefix ARG, enable Global Hi-Lock mode if ARG is positive;
-otherwise, disable it. If called from Lisp, enable the mode if
-ARG is omitted or nil.
+otherwise, disable it. If called from Lisp, enable the mode if ARG is
+omitted or nil.
Hi-Lock mode is enabled in all buffers where
`turn-on-hi-lock-if-enabled' would do it.
-See `hi-lock-mode' for more information on
-Hi-Lock mode.
+See `hi-lock-mode' for more information on Hi-Lock mode.
\(fn &optional ARG)" t nil)
@@ -16223,9 +16341,9 @@ If called interactively, toggle `Hide-Ifdef mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -16308,9 +16426,9 @@ If called interactively, toggle `Hs minor mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -16358,9 +16476,9 @@ If called interactively, toggle `Highlight-Changes mode'. If the
prefix argument is positive, enable the mode, and if it is zero or
negative, disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -16389,9 +16507,9 @@ If called interactively, toggle `Highlight-Changes-Visible mode'. If
the prefix argument is positive, enable the mode, and if it is zero or
negative, disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -16480,8 +16598,8 @@ or call the function `global-highlight-changes-mode'.")
(autoload 'global-highlight-changes-mode "hilit-chg" "\
Toggle Highlight-Changes mode in all buffers.
-With prefix ARG, enable Global Highlight-Changes mode if ARG is positive;
-otherwise, disable it. If called from Lisp, enable the mode if
+With prefix ARG, enable Global Highlight-Changes mode if ARG is
+positive; otherwise, disable it. If called from Lisp, enable the mode if
ARG is omitted or nil.
Highlight-Changes mode is enabled in all buffers where
@@ -16539,9 +16657,9 @@ If called interactively, toggle `Hl-Line mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -16577,9 +16695,9 @@ If called interactively, toggle `Global Hl-Line mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -16995,9 +17113,9 @@ If called interactively, toggle `Fido mode'. If the prefix argument
is positive, enable the mode, and if it is zero or negative, disable
the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -17024,9 +17142,9 @@ If called interactively, toggle `Icomplete mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -17572,9 +17690,9 @@ If called interactively, toggle `Iimage mode'. If the prefix argument
is positive, enable the mode, and if it is zero or negative, disable
the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -17741,11 +17859,13 @@ is supported, and FILE exists, is used to construct the image
specification to be returned. Return nil if no specification is
satisfied.
+If CACHE is non-nil, results are cached and returned on subsequent calls.
+
The image is looked for in `image-load-path'.
Image files should not be larger than specified by `max-image-size'.
-\(fn SPECS)" nil nil)
+\(fn SPECS &optional CACHE)" nil nil)
(autoload 'defimage "image" "\
Define SYMBOL as an image, and return SYMBOL.
@@ -17783,7 +17903,7 @@ recognizes these files as having image type `imagemagick'.
If Emacs is compiled without ImageMagick support, this does nothing." nil nil)
-(register-definition-prefixes "image" '("image" "unknown-image-type"))
+(register-definition-prefixes "image" '("find-image--cache" "image" "unknown-image-type"))
;;;***
@@ -17886,9 +18006,9 @@ If called interactively, toggle `Image-Dired minor mode'. If the
prefix argument is positive, enable the mode, and if it is zero or
negative, disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -17988,9 +18108,9 @@ If called interactively, toggle `Auto-Image-File mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -18023,9 +18143,9 @@ If called interactively, toggle `Image minor mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -18648,8 +18768,13 @@ See Info node `(elisp)Defining Functions' for more details.
Declare that you need either EMACS-VER, XEMACS-VER or SXEMACS-ver.
Only checks one based on which kind of Emacs is being run.
+This function is obsolete; do this instead:
+ (when (version<= \"28.1\" emacs-version) ...)
+
\(fn EMACS-VER XEMACS-VER SXEMACS-VER)" nil nil)
+(make-obsolete 'inversion-require-emacs 'nil '"28.1")
+
(register-definition-prefixes "inversion" '("inversion-"))
;;;***
@@ -18664,6 +18789,9 @@ Select an input method and turn it on in interactive search." t nil)
(autoload 'isearch-toggle-input-method "isearch-x" "\
Toggle input method in interactive search." t nil)
+(autoload 'isearch-transient-input-method "isearch-x" "\
+Activate transient input method in interactive search." t nil)
+
(autoload 'isearch-process-search-multibyte-characters "isearch-x" "\
@@ -18786,16 +18914,6 @@ Add submenus to the File menu, to convert to and from various formats." t nil)
;;;***
-;;;### (autoloads nil "iso-transl" "international/iso-transl.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from international/iso-transl.el
- (define-key key-translation-map "\C-x8" 'iso-transl-ctl-x-8-map)
- (autoload 'iso-transl-ctl-x-8-map "iso-transl" "Keymap for C-x 8 prefix." t 'keymap)
-
-(register-definition-prefixes "iso-transl" '("iso-transl-"))
-
-;;;***
-
;;;### (autoloads nil "iso8601" "calendar/iso8601.el" (0 0 0 0))
;;; Generated autoloads from calendar/iso8601.el
@@ -18984,9 +19102,9 @@ If called interactively, toggle `ISpell minor mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -19185,7 +19303,7 @@ one of the aforementioned options instead of using this mode.
;;;### (autoloads nil "jsonrpc" "jsonrpc.el" (0 0 0 0))
;;; Generated autoloads from jsonrpc.el
-(push (purecopy '(jsonrpc 1 0 12)) package--builtin-versions)
+(push (purecopy '(jsonrpc 1 0 14)) package--builtin-versions)
(register-definition-prefixes "jsonrpc" '("jsonrpc-"))
@@ -19679,9 +19797,9 @@ If called interactively, toggle `Linum mode'. If the prefix argument
is positive, enable the mode, and if it is zero or negative, disable
the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -19705,14 +19823,12 @@ or call the function `global-linum-mode'.")
(autoload 'global-linum-mode "linum" "\
Toggle Linum mode in all buffers.
With prefix ARG, enable Global Linum mode if ARG is positive;
-otherwise, disable it. If called from Lisp, enable the mode if
-ARG is omitted or nil.
+otherwise, disable it. If called from Lisp, enable the mode if ARG is
+omitted or nil.
-Linum mode is enabled in all buffers where
-`linum-on' would do it.
+Linum mode is enabled in all buffers where `linum-on' would do it.
-See `linum-mode' for more information on
-Linum mode.
+See `linum-mode' for more information on Linum mode.
\(fn &optional ARG)" t nil)
@@ -20259,9 +20375,9 @@ If called interactively, toggle `Mail-Abbrevs mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -20601,9 +20717,9 @@ If called interactively, toggle `Master mode'. If the prefix argument
is positive, enable the mode, and if it is zero or negative, disable
the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -20643,9 +20759,9 @@ If called interactively, toggle `Minibuffer-Depth-Indicate mode'. If
the prefix argument is positive, enable the mode, and if it is zero or
negative, disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -20668,6 +20784,21 @@ recursion depth in the minibuffer prompt. This is only useful if
;;;***
+;;;### (autoloads nil "memory-report" "emacs-lisp/memory-report.el"
+;;;;;; (0 0 0 0))
+;;; Generated autoloads from emacs-lisp/memory-report.el
+
+(autoload 'memory-report "memory-report" "\
+Generate a report of how Emacs is using memory.
+
+This report is approximate, and will commonly over-count memory
+usage by variables, because shared data structures will usually
+by counted more than once." t nil)
+
+(register-definition-prefixes "memory-report" '("memory-report-"))
+
+;;;***
+
;;;### (autoloads nil "message" "gnus/message.el" (0 0 0 0))
;;; Generated autoloads from gnus/message.el
@@ -21190,9 +21321,9 @@ If called interactively, toggle `Midnight mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -21242,9 +21373,9 @@ If called interactively, toggle `Minibuffer-Electric-Default mode'.
If the prefix argument is positive, enable the mode, and if it is zero
or negative, disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -21818,9 +21949,9 @@ If called interactively, toggle `Msb mode'. If the prefix argument is
positive, enable the mode, and if it is zero or negative, disable the
mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -22558,13 +22689,6 @@ This command does not work if you use short group names." t nil)
;;;***
-;;;### (autoloads nil "nnir" "gnus/nnir.el" (0 0 0 0))
-;;; Generated autoloads from gnus/nnir.el
-
-(register-definition-prefixes "nnir" '("nnir-"))
-
-;;;***
-
;;;### (autoloads nil "nnmail" "gnus/nnmail.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnmail.el
@@ -22879,7 +23003,6 @@ Many aspects this mode can be customized using
;;;### (autoloads nil "ob-abc" "org/ob-abc.el" (0 0 0 0))
;;; Generated autoloads from org/ob-abc.el
-(push (purecopy '(ob-abc 0 1)) package--builtin-versions)
(register-definition-prefixes "ob-abc" '("org-babel-"))
@@ -22910,7 +23033,7 @@ Many aspects this mode can be customized using
;;;### (autoloads nil "ob-clojure" "org/ob-clojure.el" (0 0 0 0))
;;; Generated autoloads from org/ob-clojure.el
-(register-definition-prefixes "ob-clojure" '("org-babel-"))
+(register-definition-prefixes "ob-clojure" '("ob-clojure-" "org-babel-"))
;;;***
@@ -22951,7 +23074,6 @@ Many aspects this mode can be customized using
;;;### (autoloads nil "ob-ebnf" "org/ob-ebnf.el" (0 0 0 0))
;;; Generated autoloads from org/ob-ebnf.el
-(push (purecopy '(ob-ebnf 1 0)) package--builtin-versions)
(register-definition-prefixes "ob-ebnf" '("org-babel-"))
@@ -23199,7 +23321,6 @@ Many aspects this mode can be customized using
;;;### (autoloads nil "ob-sed" "org/ob-sed.el" (0 0 0 0))
;;; Generated autoloads from org/ob-sed.el
-(push (purecopy '(ob-sed 0 1 1)) package--builtin-versions)
(register-definition-prefixes "ob-sed" '("org-babel-"))
@@ -23304,110 +23425,6 @@ startup file, `~/.emacs-octave'.
;;;***
-;;;### (autoloads nil "ol" "org/ol.el" (0 0 0 0))
-;;; Generated autoloads from org/ol.el
-
-(autoload 'org-next-link "ol" "\
-Move forward to the next link.
-If the link is in hidden text, expose it. When SEARCH-BACKWARD
-is non-nil, move backward.
-
-\(fn &optional SEARCH-BACKWARD)" t nil)
-
-(autoload 'org-previous-link "ol" "\
-Move backward to the previous link.
-If the link is in hidden text, expose it." t nil)
-
-(autoload 'org-toggle-link-display "ol" "\
-Toggle the literal or descriptive display of links." t nil)
-
-(autoload 'org-store-link "ol" "\
-Store a link to the current location.
-\\<org-mode-map>
-This link is added to `org-stored-links' and can later be inserted
-into an Org buffer with `org-insert-link' (`\\[org-insert-link]').
-
-For some link types, a `\\[universal-argument]' prefix ARG is interpreted. A single
-`\\[universal-argument]' negates `org-context-in-file-links' for file links or
-`org-gnus-prefer-web-links' for links to Usenet articles.
-
-A `\\[universal-argument] \\[universal-argument]' prefix ARG forces skipping storing functions that are not
-part of Org core.
-
-A `\\[universal-argument] \\[universal-argument] \\[universal-argument]' prefix ARG forces storing a link for each line in the
-active region.
-
-Assume the function is called interactively if INTERACTIVE? is
-non-nil.
-
-\(fn ARG &optional INTERACTIVE\\=\\?)" t nil)
-
-(autoload 'org-insert-link "ol" "\
-Insert a link. At the prompt, enter the link.
-
-Completion can be used to insert any of the link protocol prefixes in use.
-
-The history can be used to select a link previously stored with
-`org-store-link'. When the empty string is entered (i.e. if you just
-press `RET' at the prompt), the link defaults to the most recently
-stored link. As `SPC' triggers completion in the minibuffer, you need to
-use `M-SPC' or `C-q SPC' to force the insertion of a space character.
-
-You will also be prompted for a description, and if one is given, it will
-be displayed in the buffer instead of the link.
-
-If there is already a link at point, this command will allow you to edit
-link and description parts.
-
-With a `\\[universal-argument]' prefix, prompts for a file to link to. The file name can be
-selected using completion. The path to the file will be relative to the
-current directory if the file is in the current directory or a subdirectory.
-Otherwise, the link will be the absolute path as completed in the minibuffer
-\(i.e. normally ~/path/to/file). You can configure this behavior using the
-option `org-link-file-path-type'.
-
-With a `\\[universal-argument] \\[universal-argument]' prefix, enforce an absolute path even if the file is in
-the current directory or below.
-
-A `\\[universal-argument] \\[universal-argument] \\[universal-argument]' prefix negates `org-link-keep-stored-after-insertion'.
-
-If the LINK-LOCATION parameter is non-nil, this value will be used as
-the link location instead of reading one interactively.
-
-If the DESCRIPTION parameter is non-nil, this value will be used as the
-default description. Otherwise, if `org-link-make-description-function'
-is non-nil, this function will be called with the link target, and the
-result will be the default link description. When called non-interactively,
-don't allow to edit the default description.
-
-\(fn &optional COMPLETE-FILE LINK-LOCATION DESCRIPTION)" t nil)
-
-(autoload 'org-insert-all-links "ol" "\
-Insert all links in `org-stored-links'.
-When a universal prefix, do not delete the links from `org-stored-links'.
-When `ARG' is a number, insert the last N link(s).
-`PRE' and `POST' are optional arguments to define a string to
-prepend or to append.
-
-\(fn ARG &optional PRE POST)" t nil)
-
-(autoload 'org-insert-last-stored-link "ol" "\
-Insert the last link stored in `org-stored-links'.
-
-\(fn ARG)" t nil)
-
-(autoload 'org-insert-link-global "ol" "\
-Insert a link like Org mode does.
-This command can be called in any mode to insert a link in Org syntax." t nil)
-
-(autoload 'org-update-radio-target-regexp "ol" "\
-Find all radio targets in this file and update the regular expression.
-Also refresh fontification if needed." t nil)
-
-(register-definition-prefixes "ol" '("org-"))
-
-;;;***
-
;;;### (autoloads nil "ol-bibtex" "org/ol-bibtex.el" (0 0 0 0))
;;; Generated autoloads from org/ol-bibtex.el
@@ -23510,7 +23527,7 @@ Coloring:
;;;### (autoloads nil "org" "org/org.el" (0 0 0 0))
;;; Generated autoloads from org/org.el
-(push (purecopy '(org 9 3)) package--builtin-versions)
+(push (purecopy '(org 9 4 4)) package--builtin-versions)
(autoload 'org-babel-do-load-languages "org" "\
Load the languages defined in `org-babel-load-languages'.
@@ -23535,6 +23552,11 @@ FULL is given.
\(fn &optional HERE FULL MESSAGE)" t nil)
+(autoload 'org-load-modules-maybe "org" "\
+Load all extensions listed in `org-modules'.
+
+\(fn &optional FORCE)" nil nil)
+
(autoload 'org-clock-persistence-insinuate "org" "\
Set up hooks for clock persistence." nil nil)
@@ -23604,10 +23626,10 @@ When point is not at the beginning of a headline, execute the global
binding for `TAB', which is re-indenting the line. See the option
`org-cycle-emulate-tab' for details.
-As a special case, if point is at the beginning of the buffer and there is
-no headline in line 1, this function will act as if called with prefix arg
-\(`\\[universal-argument] TAB', same as `S-TAB') also when called without prefix arg, but only
-if the variable `org-cycle-global-at-bob' is t.
+As a special case, if point is at the very beginning of the buffer, if
+there is no headline there, and if the variable `org-cycle-global-at-bob'
+is non-nil, this function acts as if called with prefix argument (`\\[universal-argument] TAB',
+same as `S-TAB') also when called without prefix argument.
\(fn &optional ARG)" t nil)
@@ -24033,109 +24055,23 @@ Set `org-capture-templates' to be similar to `org-remember-templates'." t nil)
;;;***
-;;;### (autoloads nil "org-colview" "org/org-colview.el" (0 0 0 0))
-;;; Generated autoloads from org/org-colview.el
-
-(autoload 'org-columns-remove-overlays "org-colview" "\
-Remove all currently active column overlays." t nil)
-
-(autoload 'org-columns-get-format-and-top-level "org-colview" nil nil nil)
-
-(autoload 'org-columns "org-colview" "\
-Turn on column view on an Org mode file.
-
-Column view applies to the whole buffer if point is before the
-first headline. Otherwise, it applies to the first ancestor
-setting \"COLUMNS\" property. If there is none, it defaults to
-the current headline. With a `\\[universal-argument]' prefix argument, turn on column
-view for the whole buffer unconditionally.
-
-When COLUMNS-FMT-STRING is non-nil, use it as the column format.
-
-\(fn &optional GLOBAL COLUMNS-FMT-STRING)" t nil)
-
-(autoload 'org-columns-compute "org-colview" "\
-Summarize the values of PROPERTY hierarchically.
-Also update existing values for PROPERTY according to the first
-column specification.
-
-\(fn PROPERTY)" t nil)
-
-(autoload 'org-dblock-write:columnview "org-colview" "\
-Write the column view table.
-
-PARAMS is a property list of parameters:
-
-`:id' (mandatory)
-
- The ID property of the entry where the columns view should be
- built. When the symbol `local', call locally. When `global'
- call column view with the cursor at the beginning of the
- buffer (usually this means that the whole buffer switches to
- column view). When \"file:path/to/file.org\", invoke column
- view at the start of that file. Otherwise, the ID is located
- using `org-id-find'.
-
-`:exclude-tags'
-
- List of tags to exclude from column view table.
-
-`:format'
-
- When non-nil, specify the column view format to use.
-
-`:hlines'
-
- When non-nil, insert a hline before each item. When
- a number, insert a hline before each level inferior or equal
- to that number.
-
-`:indent'
-
- When non-nil, indent each ITEM field according to its level.
-
-`:match'
-
- When set to a string, use this as a tags/property match filter.
-
-`:maxlevel'
-
- When set to a number, don't capture headlines below this level.
-
-`:skip-empty-rows'
-
- When non-nil, skip rows where all specifiers other than ITEM
- are empty.
-
-`:vlines'
-
- When non-nil, make each column a column group to enforce
- vertical lines.
-
-\(fn PARAMS)" nil nil)
-
-(autoload 'org-columns-insert-dblock "org-colview" "\
-Create a dynamic block capturing a column view table." t nil)
+;;;### (autoloads nil "org-crypt" "org/org-crypt.el" (0 0 0 0))
+;;; Generated autoloads from org/org-crypt.el
-(autoload 'org-agenda-columns "org-colview" "\
-Turn on or update column view in the agenda." t nil)
+(autoload 'org-encrypt-entry "org-crypt" "\
+Encrypt the content of the current headline." t nil)
-(register-definition-prefixes "org-colview" '("org-"))
+(autoload 'org-decrypt-entry "org-crypt" "\
+Decrypt the content of the current headline." t nil)
-;;;***
-
-;;;### (autoloads nil "org-compat" "org/org-compat.el" (0 0 0 0))
-;;; Generated autoloads from org/org-compat.el
+(autoload 'org-encrypt-entries "org-crypt" "\
+Encrypt all top-level entries in the current buffer." t nil)
-(autoload 'org-check-version "org-compat" "\
-Try very hard to provide sensible version strings." nil t)
+(autoload 'org-decrypt-entries "org-crypt" "\
+Decrypt all entries in the current buffer." t nil)
-(register-definition-prefixes "org-compat" '("org-"))
-
-;;;***
-
-;;;### (autoloads nil "org-crypt" "org/org-crypt.el" (0 0 0 0))
-;;; Generated autoloads from org/org-crypt.el
+(autoload 'org-crypt-use-before-save-magic "org-crypt" "\
+Add a hook to automatically encrypt entries before a file is saved to disk." nil nil)
(register-definition-prefixes "org-crypt" '("org-"))
@@ -24148,61 +24084,6 @@ Try very hard to provide sensible version strings." nil t)
;;;***
-;;;### (autoloads nil "org-duration" "org/org-duration.el" (0 0 0
-;;;;;; 0))
-;;; Generated autoloads from org/org-duration.el
-
-(autoload 'org-duration-set-regexps "org-duration" "\
-Set duration related regexps." t nil)
-
-(autoload 'org-duration-p "org-duration" "\
-Non-nil when string S is a time duration.
-
-\(fn S)" nil nil)
-
-(autoload 'org-duration-to-minutes "org-duration" "\
-Return number of minutes of DURATION string.
-
-When optional argument CANONICAL is non-nil, ignore
-`org-duration-units' and use standard time units value.
-
-A bare number is translated into minutes. The empty string is
-translated into 0.0.
-
-Return value as a float. Raise an error if duration format is
-not recognized.
-
-\(fn DURATION &optional CANONICAL)" nil nil)
-
-(autoload 'org-duration-from-minutes "org-duration" "\
-Return duration string for a given number of MINUTES.
-
-Format duration according to `org-duration-format' or FMT, when
-non-nil.
-
-When optional argument CANONICAL is non-nil, ignore
-`org-duration-units' and use standard time units value.
-
-Raise an error if expected format is unknown.
-
-\(fn MINUTES &optional FMT CANONICAL)" nil nil)
-
-(autoload 'org-duration-h:mm-only-p "org-duration" "\
-Non-nil when every duration in TIMES has \"H:MM\" or \"H:MM:SS\" format.
-
-TIMES is a list of duration strings.
-
-Return nil if any duration is expressed with units, as defined in
-`org-duration-units'. Otherwise, if any duration is expressed
-with \"H:MM:SS\" format, return `h:mm:ss'. Otherwise, return
-`h:mm'.
-
-\(fn TIMES)" nil nil)
-
-(register-definition-prefixes "org-duration" '("org-duration-"))
-
-;;;***
-
;;;### (autoloads nil "org-entities" "org/org-entities.el" (0 0 0
;;;;;; 0))
;;; Generated autoloads from org/org-entities.el
@@ -24218,42 +24099,6 @@ with \"H:MM:SS\" format, return `h:mm:ss'. Otherwise, return
;;;***
-;;;### (autoloads nil "org-goto" "org/org-goto.el" (0 0 0 0))
-;;; Generated autoloads from org/org-goto.el
-
-(autoload 'org-goto-location "org-goto" "\
-Let the user select a location in current buffer.
-This function uses a recursive edit. It returns the selected
-position or nil.
-
-\(fn &optional BUF HELP)" nil nil)
-
-(autoload 'org-goto "org-goto" "\
-Look up a different location in the current file, keeping current visibility.
-
-When you want look-up or go to a different location in a
-document, the fastest way is often to fold the entire buffer and
-then dive into the tree. This method has the disadvantage, that
-the previous location will be folded, which may not be what you
-want.
-
-This command works around this by showing a copy of the current
-buffer in an indirect buffer, in overview mode. You can dive
-into the tree in that copy, use org-occur and incremental search
-to find a location. When pressing RET or `Q', the command
-returns to the original buffer in which the visibility is still
-unchanged. After RET it will also jump to the location selected
-in the indirect buffer and expose the headline hierarchy above.
-
-With a prefix argument, use the alternative interface: e.g., if
-`org-goto-interface' is `outline' use `outline-path-completion'.
-
-\(fn &optional ALTERNATIVE-INTERFACE)" t nil)
-
-(register-definition-prefixes "org-goto" '("org-goto-"))
-
-;;;***
-
;;;### (autoloads nil "org-habit" "org/org-habit.el" (0 0 0 0))
;;; Generated autoloads from org/org-habit.el
@@ -24269,41 +24114,6 @@ With a prefix argument, use the alternative interface: e.g., if
;;;***
-;;;### (autoloads nil "org-keys" "org/org-keys.el" (0 0 0 0))
-;;; Generated autoloads from org/org-keys.el
-
-(autoload 'org-babel-describe-bindings "org-keys" "\
-Describe all keybindings behind `org-babel-key-prefix'." t nil)
-
-(register-definition-prefixes "org-keys" '("org-"))
-
-;;;***
-
-;;;### (autoloads nil "org-lint" "org/org-lint.el" (0 0 0 0))
-;;; Generated autoloads from org/org-lint.el
-
-(autoload 'org-lint "org-lint" "\
-Check current Org buffer for syntax mistakes.
-
-By default, run all checkers. With a `\\[universal-argument]' prefix ARG, select one
-category of checkers only. With a `\\[universal-argument] \\[universal-argument]' prefix, run one precise
-checker by its name.
-
-ARG can also be a list of checker names, as symbols, to run.
-
-\(fn &optional ARG)" t nil)
-
-(register-definition-prefixes "org-lint" '("org-lint-"))
-
-;;;***
-
-;;;### (autoloads nil "org-list" "org/org-list.el" (0 0 0 0))
-;;; Generated autoloads from org/org-list.el
-
-(register-definition-prefixes "org-list" '("org-"))
-
-;;;***
-
;;;### (autoloads nil "org-macro" "org/org-macro.el" (0 0 0 0))
;;; Generated autoloads from org/org-macro.el
@@ -24311,18 +24121,6 @@ ARG can also be a list of checker names, as symbols, to run.
;;;***
-;;;### (autoloads nil "org-macs" "org/org-macs.el" (0 0 0 0))
-;;; Generated autoloads from org/org-macs.el
-
-(autoload 'org-load-noerror-mustsuffix "org-macs" "\
-Load FILE with optional arguments NOERROR and MUSTSUFFIX.
-
-\(fn FILE)" nil t)
-
-(register-definition-prefixes "org-macs" '("org-"))
-
-;;;***
-
;;;### (autoloads nil "org-mouse" "org/org-mouse.el" (0 0 0 0))
;;; Generated autoloads from org/org-mouse.el
@@ -24330,35 +24128,6 @@ Load FILE with optional arguments NOERROR and MUSTSUFFIX.
;;;***
-;;;### (autoloads nil "org-num" "org/org-num.el" (0 0 0 0))
-;;; Generated autoloads from org/org-num.el
-
-(autoload 'org-num-default-format "org-num" "\
-Default numbering display function.
-NUMBERING is a list of numbers.
-
-\(fn NUMBERING)" nil nil)
-
-(autoload 'org-num-mode "org-num" "\
-Dynamic numbering of headlines in an Org buffer.
-
-If called interactively, toggle `Org-Num mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
-
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
-
-The mode's hook is called both when the mode is enabled and when it is
-disabled.
-
-\(fn &optional ARG)" t nil)
-
-(register-definition-prefixes "org-num" '("org-num-"))
-
-;;;***
-
;;;### (autoloads nil "org-pcomplete" "org/org-pcomplete.el" (0 0
;;;;;; 0 0))
;;; Generated autoloads from org/org-pcomplete.el
@@ -24440,9 +24209,9 @@ If called interactively, toggle `Outline minor mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -24455,6 +24224,13 @@ See the command `outline-mode' for more information on this mode.
;;;***
+;;;### (autoloads nil "ox-man" "org/ox-man.el" (0 0 0 0))
+;;; Generated autoloads from org/ox-man.el
+
+(register-definition-prefixes "ox-man" '("org-man-"))
+
+;;;***
+
;;;### (autoloads nil "package" "emacs-lisp/package.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/package.el
(push (purecopy '(package 1 1 0)) package--builtin-versions)
@@ -24648,9 +24424,9 @@ If called interactively, toggle `Show-Paren mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -25361,9 +25137,9 @@ If called interactively, toggle `Pixel-Scroll mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -26075,7 +25851,7 @@ Open profile FILENAME.
;;;### (autoloads nil "project" "progmodes/project.el" (0 0 0 0))
;;; Generated autoloads from progmodes/project.el
-(push (purecopy '(project 0 5 2)) package--builtin-versions)
+(push (purecopy '(project 0 5 3)) package--builtin-versions)
(autoload 'project-current "project" "\
Return the project instance in DIRECTORY, defaulting to `default-directory'.
@@ -26096,7 +25872,7 @@ of the project instance object.
\(fn &optional MAYBE-PROMPT DIRECTORY)" nil nil)
-(defvar project-prefix-map (let ((map (make-sparse-keymap))) (define-key map "!" 'project-shell-command) (define-key map "&" 'project-async-shell-command) (define-key map "f" 'project-find-file) (define-key map "F" 'project-or-external-find-file) (define-key map "b" 'project-switch-to-buffer) (define-key map "s" 'project-shell) (define-key map "d" 'project-dired) (define-key map "v" 'project-vc-dir) (define-key map "c" 'project-compile) (define-key map "e" 'project-eshell) (define-key map "k" 'project-kill-buffers) (define-key map "p" 'project-switch-project) (define-key map "g" 'project-find-regexp) (define-key map "G" 'project-or-external-find-regexp) (define-key map "r" 'project-query-replace-regexp) map) "\
+(defvar project-prefix-map (let ((map (make-sparse-keymap))) (define-key map "!" 'project-shell-command) (define-key map "&" 'project-async-shell-command) (define-key map "f" 'project-find-file) (define-key map "F" 'project-or-external-find-file) (define-key map "b" 'project-switch-to-buffer) (define-key map "s" 'project-shell) (define-key map "d" 'project-dired) (define-key map "v" 'project-vc-dir) (define-key map "c" 'project-compile) (define-key map "e" 'project-eshell) (define-key map "k" 'project-kill-buffers) (define-key map "p" 'project-switch-project) (define-key map "g" 'project-find-regexp) (define-key map "G" 'project-or-external-find-regexp) (define-key map "r" 'project-query-replace-regexp) (define-key map "x" 'project-execute-extended-command) map) "\
Keymap for project commands.")
(define-key ctl-x-map "p" project-prefix-map)
@@ -26147,13 +25923,15 @@ pattern to search for.
(autoload 'project-find-file "project" "\
Visit a file (with completion) in the current project.
-The completion default is the filename at point, if one is
-recognized." t nil)
+
+The completion default is the filename at point, determined by
+`thing-at-point' (whether such file exists or not)." t nil)
(autoload 'project-or-external-find-file "project" "\
Visit a file (with completion) in the current project or external roots.
-The completion default is the filename at point, if one is
-recognized." t nil)
+
+The completion default is the filename at point, determined by
+`thing-at-point' (whether such file exists or not)." t nil)
(autoload 'project-dired "project" "\
Start Dired in the current project's root." t nil)
@@ -26258,19 +26036,33 @@ Save the result in `project-list-file' if the list of projects has changed.
(autoload 'project-known-project-roots "project" "\
Return the list of root directories of all known projects." nil nil)
-(defvar project-switch-commands '((102 "Find file" project-find-file) (103 "Find regexp" project-find-regexp) (100 "Dired" project-dired) (118 "VC-Dir" project-vc-dir) (101 "Eshell" project-eshell)) "\
-Alist mapping keys to project switching menu entries.
+(autoload 'project-execute-extended-command "project" "\
+Execute an extended command in project root." t nil)
+
+(function-put 'project-execute-extended-command 'interactive-only 'command-execute)
+
+(defvar project-switch-commands '((project-find-file "Find file") (project-find-regexp "Find regexp") (project-dired "Dired") (project-vc-dir "VC-Dir") (project-eshell "Eshell")) "\
+Alist mapping commands to descriptions.
Used by `project-switch-project' to construct a dispatch menu of
commands available upon \"switching\" to another project.
-Each element is of the form (KEY LABEL COMMAND), where COMMAND is the
-command to run when KEY is pressed. LABEL is used to distinguish
-the menu entries in the dispatch menu.")
+Each element is of the form (COMMAND LABEL &optional KEY) where
+COMMAND is the command to run when KEY is pressed. LABEL is used
+to distinguish the menu entries in the dispatch menu. If KEY is
+absent, COMMAND must be bound in `project-prefix-map', and the
+key is looked up in that map.")
+
+(custom-autoload 'project-switch-commands "project" t)
(autoload 'project-switch-project "project" "\
\"Switch\" to another project by running an Emacs command.
The available commands are presented as a dispatch menu
-made from `project-switch-commands'." t nil)
+made from `project-switch-commands'.
+
+When called in a program, it will use the project corresponding
+to directory DIR.
+
+\(fn DIR)" t nil)
(register-definition-prefixes "project" '("project-"))
@@ -26604,7 +26396,7 @@ Optional argument FACE specifies the face to do the highlighting.
;;;### (autoloads nil "python" "progmodes/python.el" (0 0 0 0))
;;; Generated autoloads from progmodes/python.el
-(push (purecopy '(python 0 27)) package--builtin-versions)
+(push (purecopy '(python 0 27 1)) package--builtin-versions)
(add-to-list 'auto-mode-alist (cons (purecopy "\\.py[iw]?\\'") 'python-mode))
@@ -27112,9 +26904,9 @@ If called interactively, toggle `Rcirc-Track minor mode'. If the
prefix argument is positive, enable the mode, and if it is zero or
negative, disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -27164,9 +26956,9 @@ If called interactively, toggle `Recentf mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -27322,9 +27114,9 @@ If called interactively, toggle `Rectangle-Mark mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -27361,9 +27153,9 @@ If called interactively, toggle `Refill mode'. If the prefix argument
is positive, enable the mode, and if it is zero or negative, disable
the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -27398,9 +27190,9 @@ If called interactively, toggle `Reftex mode'. If the prefix argument
is positive, enable the mode, and if it is zero or negative, disable
the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -27679,9 +27471,9 @@ If called interactively, toggle `Reveal mode'. If the prefix argument
is positive, enable the mode, and if it is zero or negative, disable
the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -27711,9 +27503,9 @@ If called interactively, toggle `Global Reveal mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -27992,6 +27784,7 @@ Instead, these commands are available:
\\[rmail-undelete-previous-message] Undelete message. Tries current message, then earlier messages
till a deleted message is found.
\\[rmail-edit-current-message] Edit the current message. \\[rmail-cease-edit] to return to Rmail.
+\\[rmail-epa-decrypt] Decrypt the current message.
\\[rmail-expunge] Expunge deleted messages.
\\[rmail-expunge-and-save] Expunge and save the file.
\\[rmail-quit] Quit Rmail: expunge, save, then switch to another buffer.
@@ -28245,9 +28038,9 @@ If called interactively, toggle `Rng-Validate mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -28402,9 +28195,9 @@ If called interactively, toggle `Rst minor mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -28436,7 +28229,7 @@ Major mode for editing Ruby code.
\(fn)" t nil)
-(add-to-list 'auto-mode-alist (cons (purecopy (concat "\\(?:\\.\\(?:" "rbw?\\|ru\\|rake\\|thor" "\\|jbuilder\\|rabl\\|gemspec\\|podspec" "\\)" "\\|/" "\\(?:Gem\\|Rake\\|Cap\\|Thor" "\\|Puppet\\|Berks" "\\|Vagrant\\|Guard\\|Pod\\)file" "\\)\\'")) 'ruby-mode))
+(add-to-list 'auto-mode-alist (cons (purecopy (concat "\\(?:\\.\\(?:" "rbw?\\|ru\\|rake\\|thor" "\\|jbuilder\\|rabl\\|gemspec\\|podspec" "\\)" "\\|/" "\\(?:Gem\\|Rake\\|Cap\\|Thor" "\\|Puppet\\|Berks\\|Brew" "\\|Vagrant\\|Guard\\|Pod\\)file" "\\)\\'")) 'ruby-mode))
(dolist (name (list "ruby" "rbx" "jruby" "ruby1.9" "ruby1.8")) (add-to-list 'interpreter-mode-alist (cons (purecopy name) 'ruby-mode)))
@@ -28458,9 +28251,9 @@ If called interactively, toggle `Ruler mode'. If the prefix argument
is positive, enable the mode, and if it is zero or negative, disable
the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -28661,6 +28454,29 @@ For more details, see Info node `(elisp) Extending Rx'.
(function-put 'rx-define 'lisp-indent-function 'defun)
+(autoload 'rx--pcase-macroexpander "rx" "\
+A pattern that matches strings against `rx' REGEXPS in sexp form.
+REGEXPS are interpreted as in `rx'. The pattern matches any
+string that is a match for REGEXPS, as if by `string-match'.
+
+In addition to the usual `rx' syntax, REGEXPS can contain the
+following constructs:
+
+ (let REF RX...) binds the symbol REF to a submatch that matches
+ the regular expressions RX. REF is bound in
+ CODE to the string of the submatch or nil, but
+ can also be used in `backref'.
+ (backref REF) matches whatever the submatch REF matched.
+ REF can be a number, as usual, or a name
+ introduced by a previous (let REF ...)
+ construct.
+
+\(fn &rest REGEXPS)" nil nil)
+
+(define-symbol-prop 'rx--pcase-macroexpander 'edebug-form-spec 'nil)
+
+(define-symbol-prop 'rx 'pcase-macroexpander #'rx--pcase-macroexpander)
+
(register-definition-prefixes "rx" '("rx-"))
;;;***
@@ -28729,9 +28545,9 @@ If called interactively, toggle `Savehist mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -28790,9 +28606,9 @@ If called interactively, toggle `Save-Place mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -28809,9 +28625,9 @@ If called interactively, toggle `Save-Place-Local mode'. If the
prefix argument is positive, enable the mode, and if it is zero or
negative, disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -28903,9 +28719,9 @@ If called interactively, toggle `Scroll-All mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -28936,9 +28752,9 @@ If called interactively, toggle `Scroll-Lock mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -28983,7 +28799,6 @@ The possible elements of this list include the following:
`global-semantic-stickyfunc-mode' - Show current fun in header line.
`global-semantic-mru-bookmark-mode' - Provide `switch-to-buffer'-like
keybinding for tag names.
- `global-cedet-m3-minor-mode' - A mouse 3 context menu.
`global-semantic-idle-local-symbol-highlight-mode' - Highlight references
of the symbol under point.
The following modes are more targeted at people who want to see
@@ -29013,9 +28828,9 @@ If called interactively, toggle `Semantic mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -29531,7 +29346,7 @@ sorted. FUNCTION must be a function of one argument.
\(fn FUNCTION PRED SEQUENCE)" nil nil)
(autoload 'seq-filter "seq" "\
-Return a list of all the elements for which (PRED element) is non-nil in SEQUENCE.
+Return a list of all elements for which (PRED element) is non-nil in SEQUENCE.
\(fn PRED SEQUENCE)" nil nil)
@@ -29653,9 +29468,9 @@ If called interactively, toggle `Server mode'. If the prefix argument
is positive, enable the mode, and if it is zero or negative, disable
the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -29768,8 +29583,8 @@ have <h1>Very Major Headlines</h1> through <h6>Very Minor Headlines</h6>
<p>Paragraphs only need an opening tag. Line breaks and multiple spaces are
ignored unless the text is <pre>preformatted.</pre> Text can be marked as
-<strong>bold</strong>, <em>italic</em> or <u>underlined</u> using the normal M-o or
-Edit/Text Properties/Face commands.
+<strong>bold</strong>, <em>italic</em> or <u>underlined</u> using the normal M-o
+or Edit/Text Properties/Face commands.
Pages can have <a name=\"SOMENAME\">named points</a> and can link other points
to them with <a href=\"#SOMENAME\">see also somename</a>. In the same way <a
@@ -30290,9 +30105,9 @@ If called interactively, toggle `Smerge mode'. If the prefix argument
is positive, enable the mode, and if it is zero or negative, disable
the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -30423,9 +30238,9 @@ If called interactively, toggle `So-Long minor mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -30505,9 +30320,9 @@ If called interactively, toggle `Global So-Long mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -31623,9 +31438,9 @@ If called interactively, toggle `Strokes mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -31733,9 +31548,9 @@ If called interactively, toggle `Subword mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -31775,14 +31590,13 @@ or call the function `global-subword-mode'.")
(autoload 'global-subword-mode "subword" "\
Toggle Subword mode in all buffers.
With prefix ARG, enable Global Subword mode if ARG is positive;
-otherwise, disable it. If called from Lisp, enable the mode if
-ARG is omitted or nil.
+otherwise, disable it. If called from Lisp, enable the mode if ARG is
+omitted or nil.
-Subword mode is enabled in all buffers where
-`(lambda nil (subword-mode 1))' would do it.
+Subword mode is enabled in all buffers where `(lambda nil
+\(subword-mode 1))' would do it.
-See `subword-mode' for more information on
-Subword mode.
+See `subword-mode' for more information on Subword mode.
\(fn &optional ARG)" t nil)
@@ -31793,9 +31607,9 @@ If called interactively, toggle `Superword mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -31824,14 +31638,13 @@ or call the function `global-superword-mode'.")
(autoload 'global-superword-mode "subword" "\
Toggle Superword mode in all buffers.
With prefix ARG, enable Global Superword mode if ARG is positive;
-otherwise, disable it. If called from Lisp, enable the mode if
-ARG is omitted or nil.
+otherwise, disable it. If called from Lisp, enable the mode if ARG is
+omitted or nil.
-Superword mode is enabled in all buffers where
-`(lambda nil (superword-mode 1))' would do it.
+Superword mode is enabled in all buffers where `(lambda nil
+\(superword-mode 1))' would do it.
-See `superword-mode' for more information on
-Superword mode.
+See `superword-mode' for more information on Superword mode.
\(fn &optional ARG)" t nil)
@@ -31899,9 +31712,9 @@ If called interactively, toggle `Gpm-Mouse mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -31930,9 +31743,9 @@ If called interactively, toggle `Tab-Line mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -31958,14 +31771,13 @@ or call the function `global-tab-line-mode'.")
(autoload 'global-tab-line-mode "tab-line" "\
Toggle Tab-Line mode in all buffers.
With prefix ARG, enable Global Tab-Line mode if ARG is positive;
-otherwise, disable it. If called from Lisp, enable the mode if
-ARG is omitted or nil.
+otherwise, disable it. If called from Lisp, enable the mode if ARG is
+omitted or nil.
Tab-Line mode is enabled in all buffers where
`tab-line-mode--turn-on' would do it.
-See `tab-line-mode' for more information on
-Tab-Line mode.
+See `tab-line-mode' for more information on Tab-Line mode.
\(fn &optional ARG)" t nil)
@@ -32294,7 +32106,8 @@ Creates a cell above and a cell below the current point location." t nil)
(autoload 'table-split-cell-horizontally "table" "\
Split current cell horizontally.
-Creates a cell on the left and a cell on the right of the current point location." t nil)
+Creates a cell on the left and a cell on the right of the current
+point location." t nil)
(autoload 'table-split-cell "table" "\
Split current cell in ORIENTATION.
@@ -32346,9 +32159,9 @@ If called interactively, toggle `Table-Fixed-Width mode'. If the
prefix argument is positive, enable the mode, and if it is zero or
negative, disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -32762,7 +32575,7 @@ use in that buffer.
\(fn PORT SPEED &optional LINE-MODE)" t nil)
-(register-definition-prefixes "term" '("ansi-term-color-vector" "explicit-shell-file-name" "serial-" "term-"))
+(register-definition-prefixes "term" '("ansi-term-color-vector" "serial-" "term-"))
;;;***
@@ -32785,7 +32598,6 @@ Start coverage on function under point." t nil)
;;;### (autoloads nil "tetris" "play/tetris.el" (0 0 0 0))
;;; Generated autoloads from play/tetris.el
-(push (purecopy '(tetris 2 1)) package--builtin-versions)
(autoload 'tetris "tetris" "\
Play the Tetris game.
@@ -32794,17 +32606,15 @@ rotate the shape to fit in with those at the bottom of the screen so
as to form complete rows.
tetris-mode keybindings:
- \\<tetris-mode-map>
-\\[tetris-start-game] Starts a new game of Tetris
-\\[tetris-end-game] Terminates the current game
-\\[tetris-pause-game] Pauses (or resumes) the current game
-\\[tetris-move-left] Moves the shape one square to the left
-\\[tetris-move-right] Moves the shape one square to the right
-\\[tetris-rotate-prev] Rotates the shape clockwise
-\\[tetris-rotate-next] Rotates the shape anticlockwise
-\\[tetris-move-bottom] Drops the shape to the bottom of the playing area
-
-" t nil)
+\\<tetris-mode-map>
+\\[tetris-start-game] Start a new game of Tetris
+\\[tetris-end-game] Terminate the current game
+\\[tetris-pause-game] Pause (or resume) the current game
+\\[tetris-move-left] Move the shape one square to the left
+\\[tetris-move-right] Move the shape one square to the right
+\\[tetris-rotate-prev] Rotate the shape clockwise
+\\[tetris-rotate-next] Rotate the shape anticlockwise
+\\[tetris-move-bottom] Drop the shape to the bottom of the playing area" t nil)
(register-definition-prefixes "tetris" '("tetris-"))
@@ -33537,9 +33347,9 @@ If called interactively, toggle `Tildify mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -33592,9 +33402,9 @@ If called interactively, toggle `Display-Time mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -34191,7 +34001,6 @@ the output buffer or changing the window configuration.
;;;### (autoloads nil "tramp" "net/tramp.el" (0 0 0 0))
;;; Generated autoloads from net/tramp.el
-(push (purecopy '(tramp 2 5 0 -1)) package--builtin-versions)
(defvar tramp-mode t "\
Whether Tramp is enabled.
@@ -34365,6 +34174,7 @@ Add archive file name handler to `file-name-handler-alist'." (when tramp-archive
;;;### (autoloads nil "trampver" "net/trampver.el" (0 0 0 0))
;;; Generated autoloads from net/trampver.el
+(push (purecopy '(tramp 2 5 0)) package--builtin-versions)
(register-definition-prefixes "trampver" '("tramp-"))
@@ -34484,9 +34294,9 @@ If called interactively, toggle `Type-Break mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -35015,9 +34825,9 @@ If called interactively, toggle `Url-Handler mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -37176,9 +36986,9 @@ If called interactively, toggle `View mode'. If the prefix argument
is positive, enable the mode, and if it is zero or negative, disable
the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -37555,9 +37365,9 @@ If called interactively, toggle `Which-Function mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -37583,9 +37393,9 @@ If called interactively, toggle `Whitespace mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -37602,9 +37412,9 @@ If called interactively, toggle `Whitespace-Newline mode'. If the
prefix argument is positive, enable the mode, and if it is zero or
negative, disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -37635,9 +37445,9 @@ If called interactively, toggle `Global Whitespace mode'. If the
prefix argument is positive, enable the mode, and if it is zero or
negative, disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -37664,9 +37474,9 @@ If called interactively, toggle `Global Whitespace-Newline mode'. If
the prefix argument is positive, enable the mode, and if it is zero or
negative, disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -37994,9 +37804,9 @@ If called interactively, toggle `Widget minor mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -38234,9 +38044,9 @@ If called interactively, toggle `Winner mode'. If the prefix argument
is positive, enable the mode, and if it is zero or negative, disable
the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -38402,7 +38212,7 @@ If LIMIT is non-nil, then do not consider characters beyond LIMIT.
;;;### (autoloads nil "xref" "progmodes/xref.el" (0 0 0 0))
;;; Generated autoloads from progmodes/xref.el
-(push (purecopy '(xref 1 0 3)) package--builtin-versions)
+(push (purecopy '(xref 1 0 4)) package--builtin-versions)
(autoload 'xref-find-backend "xref" nil nil nil)
@@ -38526,9 +38336,9 @@ If called interactively, toggle `Xterm-Mouse mode'. If the prefix
argument is positive, enable the mode, and if it is zero or negative,
disable the mode.
-If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number. All other
-values will disable the mode.
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -38656,58 +38466,61 @@ Zone out, completely." t nil)
;;;;;; "font-lock.el" "format.el" "frame.el" "help.el" "hfy-cmap.el"
;;;;;; "ibuf-ext.el" "indent.el" "international/characters.el" "international/charprop.el"
;;;;;; "international/charscript.el" "international/cp51932.el"
-;;;;;; "international/eucjp-ms.el" "international/mule-cmds.el"
-;;;;;; "international/mule-conf.el" "international/mule.el" "international/uni-bidi.el"
-;;;;;; "international/uni-brackets.el" "international/uni-category.el"
-;;;;;; "international/uni-combining.el" "international/uni-comment.el"
-;;;;;; "international/uni-decimal.el" "international/uni-decomposition.el"
-;;;;;; "international/uni-digit.el" "international/uni-lowercase.el"
-;;;;;; "international/uni-mirrored.el" "international/uni-name.el"
-;;;;;; "international/uni-numeric.el" "international/uni-old-name.el"
-;;;;;; "international/uni-special-lowercase.el" "international/uni-special-titlecase.el"
-;;;;;; "international/uni-special-uppercase.el" "international/uni-titlecase.el"
-;;;;;; "international/uni-uppercase.el" "isearch.el" "jit-lock.el"
-;;;;;; "jka-cmpr-hook.el" "language/burmese.el" "language/cham.el"
-;;;;;; "language/chinese.el" "language/cyrillic.el" "language/czech.el"
-;;;;;; "language/english.el" "language/ethiopic.el" "language/european.el"
-;;;;;; "language/georgian.el" "language/greek.el" "language/hebrew.el"
-;;;;;; "language/indian.el" "language/japanese.el" "language/khmer.el"
-;;;;;; "language/korean.el" "language/lao.el" "language/misc-lang.el"
-;;;;;; "language/romanian.el" "language/sinhala.el" "language/slovak.el"
-;;;;;; "language/tai-viet.el" "language/thai.el" "language/tibetan.el"
-;;;;;; "language/utf-8-lang.el" "language/vietnamese.el" "ldefs-boot.el"
-;;;;;; "leim/ja-dic/ja-dic.el" "leim/leim-list.el" "leim/quail/4Corner.el"
-;;;;;; "leim/quail/ARRAY30.el" "leim/quail/CCDOSPY.el" "leim/quail/CTLau-b5.el"
-;;;;;; "leim/quail/CTLau.el" "leim/quail/ECDICT.el" "leim/quail/ETZY.el"
-;;;;;; "leim/quail/PY-b5.el" "leim/quail/PY.el" "leim/quail/Punct-b5.el"
-;;;;;; "leim/quail/Punct.el" "leim/quail/QJ-b5.el" "leim/quail/QJ.el"
-;;;;;; "leim/quail/SW.el" "leim/quail/TONEPY.el" "leim/quail/ZIRANMA.el"
-;;;;;; "leim/quail/ZOZY.el" "leim/quail/arabic.el" "leim/quail/croatian.el"
-;;;;;; "leim/quail/cyril-jis.el" "leim/quail/cyrillic.el" "leim/quail/czech.el"
-;;;;;; "leim/quail/georgian.el" "leim/quail/greek.el" "leim/quail/hanja-jis.el"
-;;;;;; "leim/quail/hanja.el" "leim/quail/hanja3.el" "leim/quail/hebrew.el"
-;;;;;; "leim/quail/ipa-praat.el" "leim/quail/latin-alt.el" "leim/quail/latin-ltx.el"
-;;;;;; "leim/quail/latin-post.el" "leim/quail/latin-pre.el" "leim/quail/persian.el"
-;;;;;; "leim/quail/programmer-dvorak.el" "leim/quail/py-punct.el"
-;;;;;; "leim/quail/pypunct-b5.el" "leim/quail/quick-b5.el" "leim/quail/quick-cns.el"
-;;;;;; "leim/quail/rfc1345.el" "leim/quail/sami.el" "leim/quail/sgml-input.el"
-;;;;;; "leim/quail/slovak.el" "leim/quail/symbol-ksc.el" "leim/quail/tamil-dvorak.el"
-;;;;;; "leim/quail/tsang-b5.el" "leim/quail/tsang-cns.el" "leim/quail/vntelex.el"
-;;;;;; "leim/quail/vnvni.el" "leim/quail/welsh.el" "loadup.el" "mail/blessmail.el"
-;;;;;; "mail/rmailedit.el" "mail/rmailkwd.el" "mail/rmailmm.el"
-;;;;;; "mail/rmailmsc.el" "mail/rmailsort.el" "mail/rmailsum.el"
-;;;;;; "mail/undigest.el" "menu-bar.el" "mh-e/mh-gnus.el" "mh-e/mh-loaddefs.el"
-;;;;;; "minibuffer.el" "mouse.el" "net/tramp-loaddefs.el" "newcomment.el"
-;;;;;; "obarray.el" "org/ob-core.el" "org/ob-lob.el" "org/ob-matlab.el"
-;;;;;; "org/ob-tangle.el" "org/ob.el" "org/ol-bbdb.el" "org/ol-irc.el"
-;;;;;; "org/org-archive.el" "org/org-attach.el" "org/org-clock.el"
-;;;;;; "org/org-datetree.el" "org/org-element.el" "org/org-feed.el"
-;;;;;; "org/org-footnote.el" "org/org-id.el" "org/org-indent.el"
-;;;;;; "org/org-install.el" "org/org-mobile.el" "org/org-plot.el"
+;;;;;; "international/eucjp-ms.el" "international/iso-transl.el"
+;;;;;; "international/mule-cmds.el" "international/mule-conf.el"
+;;;;;; "international/mule.el" "international/uni-bidi.el" "international/uni-brackets.el"
+;;;;;; "international/uni-category.el" "international/uni-combining.el"
+;;;;;; "international/uni-comment.el" "international/uni-decimal.el"
+;;;;;; "international/uni-decomposition.el" "international/uni-digit.el"
+;;;;;; "international/uni-lowercase.el" "international/uni-mirrored.el"
+;;;;;; "international/uni-name.el" "international/uni-numeric.el"
+;;;;;; "international/uni-old-name.el" "international/uni-special-lowercase.el"
+;;;;;; "international/uni-special-titlecase.el" "international/uni-special-uppercase.el"
+;;;;;; "international/uni-titlecase.el" "international/uni-uppercase.el"
+;;;;;; "isearch.el" "jit-lock.el" "jka-cmpr-hook.el" "language/burmese.el"
+;;;;;; "language/cham.el" "language/chinese.el" "language/cyrillic.el"
+;;;;;; "language/czech.el" "language/english.el" "language/ethiopic.el"
+;;;;;; "language/european.el" "language/georgian.el" "language/greek.el"
+;;;;;; "language/hebrew.el" "language/indian.el" "language/japanese.el"
+;;;;;; "language/khmer.el" "language/korean.el" "language/lao.el"
+;;;;;; "language/misc-lang.el" "language/romanian.el" "language/sinhala.el"
+;;;;;; "language/slovak.el" "language/tai-viet.el" "language/thai.el"
+;;;;;; "language/tibetan.el" "language/utf-8-lang.el" "language/vietnamese.el"
+;;;;;; "ldefs-boot.el" "leim/ja-dic/ja-dic.el" "leim/leim-list.el"
+;;;;;; "leim/quail/4Corner.el" "leim/quail/ARRAY30.el" "leim/quail/CCDOSPY.el"
+;;;;;; "leim/quail/CTLau-b5.el" "leim/quail/CTLau.el" "leim/quail/ECDICT.el"
+;;;;;; "leim/quail/ETZY.el" "leim/quail/PY-b5.el" "leim/quail/PY.el"
+;;;;;; "leim/quail/Punct-b5.el" "leim/quail/Punct.el" "leim/quail/QJ-b5.el"
+;;;;;; "leim/quail/QJ.el" "leim/quail/SW.el" "leim/quail/TONEPY.el"
+;;;;;; "leim/quail/ZIRANMA.el" "leim/quail/ZOZY.el" "leim/quail/arabic.el"
+;;;;;; "leim/quail/compose.el" "leim/quail/croatian.el" "leim/quail/cyril-jis.el"
+;;;;;; "leim/quail/cyrillic.el" "leim/quail/czech.el" "leim/quail/georgian.el"
+;;;;;; "leim/quail/greek.el" "leim/quail/hanja-jis.el" "leim/quail/hanja.el"
+;;;;;; "leim/quail/hanja3.el" "leim/quail/hebrew.el" "leim/quail/ipa-praat.el"
+;;;;;; "leim/quail/latin-alt.el" "leim/quail/latin-ltx.el" "leim/quail/latin-post.el"
+;;;;;; "leim/quail/latin-pre.el" "leim/quail/persian.el" "leim/quail/programmer-dvorak.el"
+;;;;;; "leim/quail/py-punct.el" "leim/quail/pypunct-b5.el" "leim/quail/quick-b5.el"
+;;;;;; "leim/quail/quick-cns.el" "leim/quail/rfc1345.el" "leim/quail/sami.el"
+;;;;;; "leim/quail/sgml-input.el" "leim/quail/slovak.el" "leim/quail/symbol-ksc.el"
+;;;;;; "leim/quail/tamil-dvorak.el" "leim/quail/tsang-b5.el" "leim/quail/tsang-cns.el"
+;;;;;; "leim/quail/vntelex.el" "leim/quail/vnvni.el" "leim/quail/welsh.el"
+;;;;;; "loadup.el" "mail/blessmail.el" "mail/rmailedit.el" "mail/rmailkwd.el"
+;;;;;; "mail/rmailmm.el" "mail/rmailmsc.el" "mail/rmailsort.el"
+;;;;;; "mail/rmailsum.el" "mail/undigest.el" "menu-bar.el" "mh-e/mh-gnus.el"
+;;;;;; "mh-e/mh-loaddefs.el" "minibuffer.el" "mouse.el" "net/tramp-loaddefs.el"
+;;;;;; "newcomment.el" "obarray.el" "org/ob-core.el" "org/ob-lob.el"
+;;;;;; "org/ob-matlab.el" "org/ob-tangle.el" "org/ob.el" "org/ol-bbdb.el"
+;;;;;; "org/ol-irc.el" "org/ol.el" "org/org-archive.el" "org/org-attach.el"
+;;;;;; "org/org-clock.el" "org/org-colview.el" "org/org-compat.el"
+;;;;;; "org/org-datetree.el" "org/org-duration.el" "org/org-element.el"
+;;;;;; "org/org-feed.el" "org/org-footnote.el" "org/org-goto.el"
+;;;;;; "org/org-id.el" "org/org-indent.el" "org/org-install.el"
+;;;;;; "org/org-keys.el" "org/org-lint.el" "org/org-list.el" "org/org-macs.el"
+;;;;;; "org/org-mobile.el" "org/org-num.el" "org/org-plot.el" "org/org-refile.el"
;;;;;; "org/org-table.el" "org/org-timer.el" "org/ox-ascii.el" "org/ox-beamer.el"
;;;;;; "org/ox-html.el" "org/ox-icalendar.el" "org/ox-latex.el"
-;;;;;; "org/ox-man.el" "org/ox-md.el" "org/ox-odt.el" "org/ox-org.el"
-;;;;;; "org/ox-publish.el" "org/ox-texinfo.el" "org/ox.el" "progmodes/elisp-mode.el"
+;;;;;; "org/ox-md.el" "org/ox-odt.el" "org/ox-org.el" "org/ox-publish.el"
+;;;;;; "org/ox-texinfo.el" "org/ox.el" "progmodes/elisp-mode.el"
;;;;;; "progmodes/prog-mode.el" "ps-mule.el" "register.el" "replace.el"
;;;;;; "rfn-eshadow.el" "select.el" "simple.el" "startup.el" "subdirs.el"
;;;;;; "subr.el" "tab-bar.el" "textmodes/fill.el" "textmodes/page.el"
diff --git a/lisp/leim/quail/arabic.el b/lisp/leim/quail/arabic.el
index a3424c8404d..e5bd62b9096 100644
--- a/lisp/leim/quail/arabic.el
+++ b/lisp/leim/quail/arabic.el
@@ -1,6 +1,6 @@
-;;; arabic.el --- Quail package for inputting Arabic -*- coding: utf-8;-*-
+;;; arabic.el --- Quail package for inputting Arabic -*- coding: utf-8; lexical-binding:t -*-
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: James Cloos <cloos@jhcloos.com>
;; Keywords: mule, input method, Arabic
diff --git a/lisp/leim/quail/cham.el b/lisp/leim/quail/cham.el
new file mode 100644
index 00000000000..d12ae6cddf0
--- /dev/null
+++ b/lisp/leim/quail/cham.el
@@ -0,0 +1,116 @@
+;;; cham.el --- Quail package for inputting Cham characters -*- coding: utf-8; lexical-binding:t -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; Author: Eli Zaretskii <eliz@gnu.org>
+;; Keywords: i18n
+
+;; 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:
+
+;; This file defines the following Cham keyboards:
+;;
+;; - QWERTY-based Cham.
+
+;;; Code:
+
+(require 'quail)
+
+(quail-define-package
+ "cham" "Cham" "ꨌꩌ" t
+ "A QWERTY-based Cham input method."
+ nil t nil nil t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("a" ?ꨀ)
+ ("A" ?ꨄ)
+ ("i" ?ꨁ)
+ ("u" ?ꨂ)
+ ("e" ?ꨃ)
+ ("o" ?ꨅ)
+ ("k" ?ꨆ)
+ ("K" ?ꨇ)
+ ("g" ?ꨈ)
+ ("G" ?ꨉ)
+ ("q" ?ꨊ)
+ ("Q" ?ꨋ)
+ ("c" ?ꨌ)
+ ("C" ?ꨍ)
+ ("j" ?ꨎ)
+ ("J" ?ꨏ)
+ ("z" ?ꨐ)
+ ("Z" ?ꨑ)
+ ("zz" ?ꨒ)
+ ("t" ?ꨓ)
+ ("T" ?ꨔ)
+ ("d" ?ꨕ)
+ ("D" ?ꨖ)
+ ("n" ?ꨗ)
+ ("N" ?ꨘ)
+ ("p" ?ꨚ)
+ ("P" ?ꨛ)
+ ("f" ?ꨜ)
+ ("b" ?ꨝ)
+ ("B" ?ꨞ)
+ ("m" ?ꨟ)
+ ("M" ?ꨠ)
+ ("mm" ?ꨡ)
+ ("y" ?ꨢ)
+ ("r" ?ꨣ)
+ ("l" ?ꨤ)
+ ("w" ?ꨥ)
+ ("v" ?ꨥ)
+ ("x" ?ꨦ)
+ ("s" ?ꨧ)
+ ("h" ?ꨨ)
+ ("kk" ?ꩀ)
+ ("ww" ?ꩁ)
+ ("vv" ?ꩁ)
+ ("qq" ?ꩂ)
+ ("cc" ?ꩄ)
+ ("tt" ?ꩅ)
+ ("nn" ?ꩆ)
+ ("pp" ?ꩇ)
+ ("yy" ?ꩈ)
+ ("rr" ?ꩉ)
+ ("ll" ?ꩊ)
+ ("gg" ?ꩊ)
+ ("xx" ?ꩋ)
+ ("." ?ꩌ)
+ ("H" ?ꩍ)
+ ("0" ?꩐)
+ ("1" ?꩑)
+ ("2" ?꩒)
+ ("3" ?꩓)
+ ("4" ?꩔)
+ ("5" ?꩕)
+ ("6" ?꩖)
+ ("7" ?꩗)
+ ("8" ?꩘)
+ ("9" ?꩙)
+ ("!" ?ꨩ)
+ ("#" ?ꨪ)
+ ("$" ?ꨫ)
+ ("^" ?ꨬ)
+ ("&" ?ꨮ)
+ ("`" ?꩜)
+ ("=" ?ꨱ)
+ ("-" ?ꩃ)
+ ("~" ?꩟)
+ )
+
+;;; cham.el ends here
diff --git a/lisp/leim/quail/compose.el b/lisp/leim/quail/compose.el
new file mode 100644
index 00000000000..f7ac83aec5b
--- /dev/null
+++ b/lisp/leim/quail/compose.el
@@ -0,0 +1,2952 @@
+;;; compose.el --- Quail package for Multi_key character composition -*-coding: utf-8;-*-
+
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
+
+;; Author: Juri Linkov <juri@linkov.net>
+;; Keywords: multilingual, input method, i18n
+
+;; 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:
+
+;; This input method supports the same key sequences as defined by the
+;; standard X Multi_key: https://en.wikipedia.org/wiki/Compose_key
+
+;; You can enable this input method transiently with `C-u C-x \ compose RET'.
+;; Then typing `C-x \' will enable this input method temporarily, and
+;; after typing a key sequence it will be disabled. So typing
+;; e.g. `C-x \ E =' will insert the Euro sign character, and disable
+;; this input method automatically afterwards.
+
+;;; Code:
+
+(require 'quail)
+
+(quail-define-package
+ "compose" "UTF-8" "+" t
+ "Compose-like input method with the same key sequences as X Multi_key.
+Examples:
+ E = -> € 1 2 -> ½ ^ 3 -> ³"
+ '(("\t" . quail-completion))
+ t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("''" ?´)
+ ("-^" ?¯)
+ ("^-" ?¯)
+ ("__" ?¯)
+ ("_^" ?¯)
+ (" (" ?˘)
+ ("( " ?˘)
+ ("\"\"" ?¨)
+ (" <" ?ˇ)
+ ("< " ?ˇ)
+ ("-- " ?­)
+ ("++" ?#)
+ ("' " ?\')
+ (" '" ?\')
+ ("AT" ?@)
+ ("((" ?\[)
+ ("//" ["\\\\"])
+ ("/<" ["\\\\"])
+ ("</" ["\\\\"])
+ ("))" ?\])
+ ("^ " ?^)
+ (" ^" ?^)
+ ("> " ?^)
+ (" >" ?^)
+ ("` " ?`)
+ (" `" ?`)
+ (", " ?¸)
+ (" ," ?¸)
+ (",," ?¸)
+ ("(-" ?\{)
+ ("-(" ?\{)
+ ("/^" ?|)
+ ("^/" ?|)
+ ("VL" ?|)
+ ("LV" ?|)
+ ("vl" ?|)
+ ("lv" ?|)
+ (")-" ?\})
+ ("-)" ?\})
+ ("~ " ?~)
+ (" ~" ?~)
+ ("- " ?~)
+ (" -" ?~)
+ (" " ? )
+ (" ." ? )
+ ("oc" ?©)
+ ("oC" ?©)
+ ("Oc" ?©)
+ ("OC" ?©)
+ ("Co" ?©)
+ ("CO" ?©)
+ ("or" ?®)
+ ("oR" ?®)
+ ("Or" ?®)
+ ("OR" ?®)
+ ("Ro" ?®)
+ ("RO" ?®)
+ (".>" ?›)
+ (".<" ?‹)
+ (".." ?…)
+ (".-" ?·)
+ (".^" ?·)
+ ("^." ?·)
+ (".=" ?•)
+ ("!^" ?¦)
+ ("!!" ?¡)
+ ("p!" ?¶)
+ ("P!" ?¶)
+ ("+-" ?±)
+ ("-+" ?±)
+ ("??" ?¿)
+ ("ss" ?ß)
+ ("SS" ?ẞ)
+ ("oe" ?œ)
+ ("OE" ?Œ)
+ ("ae" ?æ)
+ ("AE" ?Æ)
+ ("ff" ?ff)
+ ("fi" ?fi)
+ ("fl" ?fl)
+ ("Fi" ?ffi)
+ ("Fl" ?ffl)
+ ("IJ" ?IJ)
+ ("Ij" ?IJ)
+ ("ij" ?ij)
+ ("oo" ?°)
+ ("*0" ?°)
+ ("0*" ?°)
+ ("<<" ?«)
+ (">>" ?»)
+ ("<'" ?‘)
+ ("'<" ?‘)
+ (">'" ?’)
+ ("'>" ?’)
+ (",'" ?‚)
+ ("'," ?‚)
+ ("<\"" ?“)
+ ("\"<" ?“)
+ (">\"" ?”)
+ ("\">" ?”)
+ (",\"" ?„)
+ ("\"," ?„)
+ ("%o" ?‰)
+ ("CE" ?₠)
+ ("C/" ?₡)
+ ("/C" ?₡)
+ ("Cr" ?₢)
+ ("Fr" ?₣)
+ ("L=" ?₤)
+ ("=L" ?₤)
+ ("m/" ?₥)
+ ("/m" ?₥)
+ ("N=" ?₦)
+ ("=N" ?₦)
+ ("Pt" ?₧)
+ ("Rs" ?₨)
+ ("W=" ?₩)
+ ("=W" ?₩)
+ ("d=" ?₫)
+ ("=d" ?₫)
+ ("C=" ?€)
+ ("=C" ?€)
+ ("c=" ?€)
+ ("=c" ?€)
+ ("E=" ?€)
+ ("=E" ?€)
+ ("e=" ?€)
+ ("=e" ?€)
+ ("С=" ?€)
+ ("=С" ?€)
+ ("Е=" ?€)
+ ("=Е" ?€)
+ ("P=" ?₽)
+ ("p=" ?₽)
+ ("=P" ?₽)
+ ("=p" ?₽)
+ ("З=" ?₽)
+ ("з=" ?₽)
+ ("=З" ?₽)
+ ("=з" ?₽)
+ ("R=" ?₹)
+ ("=R" ?₹)
+ ("r=" ?₹)
+ ("=r" ?₹)
+ ("C|" ?¢)
+ ("|C" ?¢)
+ ("c|" ?¢)
+ ("|c" ?¢)
+ ("c/" ?¢)
+ ("/c" ?¢)
+ ("L-" ?£)
+ ("-L" ?£)
+ ("l-" ?£)
+ ("-l" ?£)
+ ("Y=" ?¥)
+ ("=Y" ?¥)
+ ("y=" ?¥)
+ ("=y" ?¥)
+ ("Y-" ?¥)
+ ("-Y" ?¥)
+ ("y-" ?¥)
+ ("-y" ?¥)
+ ("fs" ?ſ)
+ ("fS" ?ſ)
+ ("--." ?–)
+ ("---" ?—)
+ ("#q" ?♩)
+ ("#e" ?♪)
+ ("#E" ?♫)
+ ("#S" ?♬)
+ ("#b" ?♭)
+ ("#f" ?♮)
+ ("##" ?♯)
+ ("so" ?§)
+ ("os" ?§)
+ ("SO" ?§)
+ ("OS" ?§)
+ ("s!" ?§)
+ ("S!" ?§)
+ ("па" ?§)
+ ("ox" ?¤)
+ ("xo" ?¤)
+ ("oX" ?¤)
+ ("Xo" ?¤)
+ ("OX" ?¤)
+ ("XO" ?¤)
+ ("Ox" ?¤)
+ ("xO" ?¤)
+ ("PP" ?¶)
+ ("No" ?№)
+ ("NO" ?№)
+ ("Но" ?№)
+ ("НО" ?№)
+ ("?!" ?⸘)
+ ("!?" ?‽)
+ ("CCCP" ?☭)
+ ("OA" ?Ⓐ)
+ ("<3" ?♥)
+ (":)" ?☺)
+ (":(" ?☹)
+ ("\\o/" ?🙌)
+ ("poo" ?💩)
+ ("FU" ?🖕)
+ ("LLAP" ?🖖)
+ ("ᄀᄀ" ?ᄁ)
+ ("ᄃᄃ" ?ᄄ)
+ ("ᄇᄇ" ?ᄈ)
+ ("ᄉᄉ" ?ᄊ)
+ ("ᄌᄌ" ?ᄍ)
+ ("ᄂᄀ" ?ᄓ)
+ ("ᄂᄂ" ?ᄔ)
+ ("ᄂᄃ" ?ᄕ)
+ ("ᄂᄇ" ?ᄖ)
+ ("ᄃᄀ" ?ᄗ)
+ ("ᄅᄂ" ?ᄘ)
+ ("ᄅᄅ" ?ᄙ)
+ ("ᄅᄒ" ?ᄚ)
+ ("ᄅᄋ" ?ᄛ)
+ ("ᄆᄇ" ?ᄜ)
+ ("ᄆᄋ" ?ᄝ)
+ ("ᄇᄀ" ?ᄞ)
+ ("ᄇᄂ" ?ᄟ)
+ ("ᄇᄃ" ?ᄠ)
+ ("ᄇᄉ" ?ᄡ)
+ ("ᄇᄌ" ?ᄧ)
+ ("ᄇᄎ" ?ᄨ)
+ ("ᄇᄐ" ?ᄩ)
+ ("ᄇᄑ" ?ᄪ)
+ ("ᄇᄋ" ?ᄫ)
+ ("ᄉᄀ" ?ᄭ)
+ ("ᄉᄂ" ?ᄮ)
+ ("ᄉᄃ" ?ᄯ)
+ ("ᄉᄅ" ?ᄰ)
+ ("ᄉᄆ" ?ᄱ)
+ ("ᄉᄇ" ?ᄲ)
+ ("ᄉᄋ" ?ᄵ)
+ ("ᄉᄌ" ?ᄶ)
+ ("ᄉᄎ" ?ᄷ)
+ ("ᄉᄏ" ?ᄸ)
+ ("ᄉᄐ" ?ᄹ)
+ ("ᄉᄑ" ?ᄺ)
+ ("ᄉᄒ" ?ᄻ)
+ ("ᄼᄼ" ?ᄽ)
+ ("ᄾᄾ" ?ᄿ)
+ ("ᄋᄀ" ?ᅁ)
+ ("ᄋᄃ" ?ᅂ)
+ ("ᄋᄆ" ?ᅃ)
+ ("ᄋᄇ" ?ᅄ)
+ ("ᄋᄉ" ?ᅅ)
+ ("ᄋᅀ" ?ᅆ)
+ ("ᄋᄋ" ?ᅇ)
+ ("ᄋᄌ" ?ᅈ)
+ ("ᄋᄎ" ?ᅉ)
+ ("ᄋᄐ" ?ᅊ)
+ ("ᄋᄑ" ?ᅋ)
+ ("ᄌᄋ" ?ᅍ)
+ ("ᅎᅎ" ?ᅏ)
+ ("ᅐᅐ" ?ᅑ)
+ ("ᄎᄏ" ?ᅒ)
+ ("ᄎᄒ" ?ᅓ)
+ ("ᄑᄇ" ?ᅖ)
+ ("ᄑᄋ" ?ᅗ)
+ ("ᄒᄒ" ?ᅘ)
+ ("ᅡᅵ" ?ᅢ)
+ ("ᅣᅵ" ?ᅤ)
+ ("ᅥᅵ" ?ᅦ)
+ ("ᅧᅵ" ?ᅨ)
+ ("ᅩᅡ" ?ᅪ)
+ ("ᅩᅵ" ?ᅬ)
+ ("ᅮᅥ" ?ᅯ)
+ ("ᅮᅵ" ?ᅱ)
+ ("ᅳᅵ" ?ᅴ)
+ ("ᅡᅩ" ?ᅶ)
+ ("ᅡᅮ" ?ᅷ)
+ ("ᅣᅩ" ?ᅸ)
+ ("ᅣᅭ" ?ᅹ)
+ ("ᅥᅩ" ?ᅺ)
+ ("ᅥᅮ" ?ᅻ)
+ ("ᅥᅳ" ?ᅼ)
+ ("ᅧᅩ" ?ᅽ)
+ ("ᅧᅮ" ?ᅾ)
+ ("ᅩᅥ" ?ᅿ)
+ ("ᅩᅦ" ?ᆀ)
+ ("ᅩᅨ" ?ᆁ)
+ ("ᅩᅩ" ?ᆂ)
+ ("ᅩᅮ" ?ᆃ)
+ ("ᅭᅣ" ?ᆄ)
+ ("ᅭᅤ" ?ᆅ)
+ ("ᅭᅧ" ?ᆆ)
+ ("ᅭᅩ" ?ᆇ)
+ ("ᅭᅵ" ?ᆈ)
+ ("ᅮᅡ" ?ᆉ)
+ ("ᅮᅢ" ?ᆊ)
+ ("ᅮᅨ" ?ᆌ)
+ ("ᅮᅮ" ?ᆍ)
+ ("ᅲᅡ" ?ᆎ)
+ ("ᅲᅥ" ?ᆏ)
+ ("ᅲᅦ" ?ᆐ)
+ ("ᅲᅧ" ?ᆑ)
+ ("ᅲᅨ" ?ᆒ)
+ ("ᅲᅮ" ?ᆓ)
+ ("ᅲᅵ" ?ᆔ)
+ ("ᅳᅮ" ?ᆕ)
+ ("ᅳᅳ" ?ᆖ)
+ ("ᅴᅮ" ?ᆗ)
+ ("ᅵᅡ" ?ᆘ)
+ ("ᅵᅣ" ?ᆙ)
+ ("ᅵᅩ" ?ᆚ)
+ ("ᅵᅮ" ?ᆛ)
+ ("ᅵᅳ" ?ᆜ)
+ ("ᅵᆞ" ?ᆝ)
+ ("ᆞᅥ" ?ᆟ)
+ ("ᆞᅮ" ?ᆠ)
+ ("ᆞᅵ" ?ᆡ)
+ ("ᆞᆞ" ?ᆢ)
+ ("ᆨᆨ" ?ᆩ)
+ ("ᆨᆺ" ?ᆪ)
+ ("ᆫᆽ" ?ᆬ)
+ ("ᆫᇂ" ?ᆭ)
+ ("ᆯᆨ" ?ᆰ)
+ ("ᆯᆷ" ?ᆱ)
+ ("ᆯᆸ" ?ᆲ)
+ ("ᆯᆺ" ?ᆳ)
+ ("ᆯᇀ" ?ᆴ)
+ ("ᆯᇁ" ?ᆵ)
+ ("ᆯᇂ" ?ᆶ)
+ ("ᆸᆺ" ?ᆹ)
+ ("ᆺᆺ" ?ᆻ)
+ ("ᆨᆯ" ?ᇃ)
+ ("ᆫᆨ" ?ᇅ)
+ ("ᆫᆮ" ?ᇆ)
+ ("ᆫᆺ" ?ᇇ)
+ ("ᆫᇫ" ?ᇈ)
+ ("ᆫᇀ" ?ᇉ)
+ ("ᆮᆨ" ?ᇊ)
+ ("ᆮᆯ" ?ᇋ)
+ ("ᆯᆫ" ?ᇍ)
+ ("ᆯᆮ" ?ᇎ)
+ ("ᆯᆯ" ?ᇐ)
+ ("ᆯᇫ" ?ᇗ)
+ ("ᆯᆿ" ?ᇘ)
+ ("ᆯᇹ" ?ᇙ)
+ ("ᆷᆨ" ?ᇚ)
+ ("ᆷᆯ" ?ᇛ)
+ ("ᆷᆸ" ?ᇜ)
+ ("ᆷᆺ" ?ᇝ)
+ ("ᆷᇫ" ?ᇟ)
+ ("ᆷᆾ" ?ᇠ)
+ ("ᆷᇂ" ?ᇡ)
+ ("ᆷᆼ" ?ᇢ)
+ ("ᆸᆯ" ?ᇣ)
+ ("ᆸᇁ" ?ᇤ)
+ ("ᆸᇂ" ?ᇥ)
+ ("ᆸᆼ" ?ᇦ)
+ ("ᆺᆨ" ?ᇧ)
+ ("ᆺᆮ" ?ᇨ)
+ ("ᆺᆯ" ?ᇩ)
+ ("ᆺᆸ" ?ᇪ)
+ ("ᆼᆨ" ?ᇬ)
+ ("ᆼᆼ" ?ᇮ)
+ ("ᆼᆿ" ?ᇯ)
+ ("ᇰᆺ" ?ᇱ)
+ ("ᇰᇫ" ?ᇲ)
+ ("ᇁᆸ" ?ᇳ)
+ ("ᇁᆼ" ?ᇴ)
+ ("ᇂᆫ" ?ᇵ)
+ ("ᇂᆯ" ?ᇶ)
+ ("ᇂᆷ" ?ᇷ)
+ ("ᇂᆸ" ?ᇸ)
+ ("ᄡᄀ" ?ᄢ)
+ ("ᄡᄃ" ?ᄣ)
+ ("ᄡᄇ" ?ᄤ)
+ ("ᄡᄉ" ?ᄥ)
+ ("ᄡᄌ" ?ᄦ)
+ ("ᄈᄋ" ?ᄬ)
+ ("ᄲᄀ" ?ᄳ)
+ ("ᄊᄉ" ?ᄴ)
+ ("ᅪᅵ" ?ᅫ)
+ ("ᅯᅵ" ?ᅰ)
+ ("ᅯᅳ" ?ᆋ)
+ ("ᆪᆨ" ?ᇄ)
+ ("ᆰᆺ" ?ᇌ)
+ ("ᇎᇂ" ?ᇏ)
+ ("ᆱᆨ" ?ᇑ)
+ ("ᆱᆺ" ?ᇒ)
+ ("ᆲᆺ" ?ᇓ)
+ ("ᆲᇂ" ?ᇔ)
+ ("ᆲᆼ" ?ᇕ)
+ ("ᆳᆺ" ?ᇖ)
+ ("ᇝᆺ" ?ᇞ)
+ ("ᇬᆨ" ?ᇭ)
+ ("ᄇᄭ" ?ᄢ)
+ ("ᄇᄯ" ?ᄣ)
+ ("ᄇᄲ" ?ᄤ)
+ ("ᄇᄊ" ?ᄥ)
+ ("ᄇᄶ" ?ᄦ)
+ ("ᄇᄫ" ?ᄬ)
+ ("ᄉᄞ" ?ᄳ)
+ ("ᄉᄊ" ?ᄴ)
+ ("ᅩᅢ" ?ᅫ)
+ ("ᅮᅦ" ?ᅰ)
+ ("ᅮᅼ" ?ᆋ)
+ ("ᆨᇧ" ?ᇄ)
+ ("ᆯᆪ" ?ᇌ)
+ ("ᆯᇚ" ?ᇑ)
+ ("ᆯᇝ" ?ᇒ)
+ ("ᆯᆹ" ?ᇓ)
+ ("ᆯᇥ" ?ᇔ)
+ ("ᆯᇦ" ?ᇕ)
+ ("ᆯᆻ" ?ᇖ)
+ ("ᆷᆻ" ?ᇞ)
+ ("ᆼᆩ" ?ᇭ)
+ (",-" ?¬)
+ ("-," ?¬)
+ ("^_a" ?ª)
+ ("^_a" ?ª)
+ ("^2" ?²)
+ ("2^" ?²)
+ ("^3" ?³)
+ ("3^" ?³)
+ ("mu" ?µ)
+ ("/u" ?µ)
+ ("u/" ?µ)
+ ("^1" ?¹)
+ ("1^" ?¹)
+ ("^_o" ?º)
+ ("^_o" ?º)
+ ("14" ?¼)
+ ("12" ?½)
+ ("34" ?¾)
+ ("`A" ?À)
+ ("A`" ?À)
+ ("´A" ?Á)
+ ("A´" ?Á)
+ ("'A" ?Á)
+ ("A'" ?Á)
+ ("^A" ?Â)
+ ("A^" ?Â)
+ (">A" ?Â)
+ ("A>" ?Â)
+ ("~A" ?Ã)
+ ("A~" ?Ã)
+ ("\"A" ?Ä)
+ ("A\"" ?Ä)
+ ("¨A" ?Ä)
+ ("A¨" ?Ä)
+ ("oA" ?Å)
+ ("*A" ?Å)
+ ("A*" ?Å)
+ ("AA" ?Å)
+ (",C" ?Ç)
+ ("C," ?Ç)
+ ("¸C" ?Ç)
+ ("`E" ?È)
+ ("E`" ?È)
+ ("´E" ?É)
+ ("E´" ?É)
+ ("'E" ?É)
+ ("E'" ?É)
+ ("^E" ?Ê)
+ ("E^" ?Ê)
+ (">E" ?Ê)
+ ("E>" ?Ê)
+ ("\"E" ?Ë)
+ ("E\"" ?Ë)
+ ("¨E" ?Ë)
+ ("E¨" ?Ë)
+ ("`I" ?Ì)
+ ("I`" ?Ì)
+ ("´I" ?Í)
+ ("I´" ?Í)
+ ("'I" ?Í)
+ ("I'" ?Í)
+ ("^I" ?Î)
+ ("I^" ?Î)
+ (">I" ?Î)
+ ("I>" ?Î)
+ ("\"I" ?Ï)
+ ("I\"" ?Ï)
+ ("¨I" ?Ï)
+ ("I¨" ?Ï)
+ ("'J" ["J́"])
+ ("J'" ["J́"])
+ ("´J" ["J́"])
+ ("J´" ["J́"])
+ ("DH" ?Ð)
+ ("~N" ?Ñ)
+ ("N~" ?Ñ)
+ ("`O" ?Ò)
+ ("O`" ?Ò)
+ ("´O" ?Ó)
+ ("O´" ?Ó)
+ ("'O" ?Ó)
+ ("O'" ?Ó)
+ ("^O" ?Ô)
+ ("O^" ?Ô)
+ (">O" ?Ô)
+ ("O>" ?Ô)
+ ("~O" ?Õ)
+ ("O~" ?Õ)
+ ("\"O" ?Ö)
+ ("O\"" ?Ö)
+ ("¨O" ?Ö)
+ ("O¨" ?Ö)
+ ("xx" ?×)
+ ("/O" ?Ø)
+ ("O/" ?Ø)
+ ("`U" ?Ù)
+ ("U`" ?Ù)
+ ("´U" ?Ú)
+ ("U´" ?Ú)
+ ("'U" ?Ú)
+ ("U'" ?Ú)
+ ("^U" ?Û)
+ ("U^" ?Û)
+ (">U" ?Û)
+ ("U>" ?Û)
+ ("\"U" ?Ü)
+ ("U\"" ?Ü)
+ ("¨U" ?Ü)
+ ("U¨" ?Ü)
+ ("´Y" ?Ý)
+ ("Y´" ?Ý)
+ ("'Y" ?Ý)
+ ("Y'" ?Ý)
+ ("TH" ?Þ)
+ ("`a" ?à)
+ ("a`" ?à)
+ ("´a" ?á)
+ ("a´" ?á)
+ ("'a" ?á)
+ ("a'" ?á)
+ ("^a" ?â)
+ ("a^" ?â)
+ (">a" ?â)
+ ("a>" ?â)
+ ("~a" ?ã)
+ ("a~" ?ã)
+ ("\"a" ?ä)
+ ("a\"" ?ä)
+ ("¨a" ?ä)
+ ("a¨" ?ä)
+ ("oa" ?å)
+ ("*a" ?å)
+ ("a*" ?å)
+ ("aa" ?å)
+ (",c" ?ç)
+ ("c," ?ç)
+ ("¸c" ?ç)
+ ("`e" ?è)
+ ("e`" ?è)
+ ("´e" ?é)
+ ("e´" ?é)
+ ("'e" ?é)
+ ("e'" ?é)
+ ("^e" ?ê)
+ ("e^" ?ê)
+ (">e" ?ê)
+ ("e>" ?ê)
+ ("\"e" ?ë)
+ ("e\"" ?ë)
+ ("¨e" ?ë)
+ ("e¨" ?ë)
+ ("`i" ?ì)
+ ("i`" ?ì)
+ ("´i" ?í)
+ ("i´" ?í)
+ ("'i" ?í)
+ ("i'" ?í)
+ ("^i" ?î)
+ ("i^" ?î)
+ (">i" ?î)
+ ("i>" ?î)
+ ("\"i" ?ï)
+ ("i\"" ?ï)
+ ("¨i" ?ï)
+ ("i¨" ?ï)
+ ("'j" ["j́"])
+ ("j'" ["j́"])
+ ("´j" ["j́"])
+ ("j´" ["j́"])
+ ("dh" ?ð)
+ ("~n" ?ñ)
+ ("n~" ?ñ)
+ ("`o" ?ò)
+ ("o`" ?ò)
+ ("´o" ?ó)
+ ("o´" ?ó)
+ ("'o" ?ó)
+ ("o'" ?ó)
+ ("^o" ?ô)
+ ("o^" ?ô)
+ (">o" ?ô)
+ ("o>" ?ô)
+ ("~o" ?õ)
+ ("o~" ?õ)
+ ("o¨" ?ö)
+ ("¨o" ?ö)
+ ("\"o" ?ö)
+ ("o\"" ?ö)
+ (":-" ?÷)
+ ("-:" ?÷)
+ ("/o" ?ø)
+ ("o/" ?ø)
+ ("`u" ?ù)
+ ("u`" ?ù)
+ ("´u" ?ú)
+ ("u´" ?ú)
+ ("'u" ?ú)
+ ("u'" ?ú)
+ ("^u" ?û)
+ ("u^" ?û)
+ (">u" ?û)
+ ("u>" ?û)
+ ("\"u" ?ü)
+ ("u\"" ?ü)
+ ("¨u" ?ü)
+ ("u¨" ?ü)
+ ("´y" ?ý)
+ ("y´" ?ý)
+ ("'y" ?ý)
+ ("y'" ?ý)
+ ("th" ?þ)
+ ("\"y" ?ÿ)
+ ("y\"" ?ÿ)
+ ("¨y" ?ÿ)
+ ("y¨" ?ÿ)
+ ("¯A" ?Ā)
+ ("_A" ?Ā)
+ ("A_" ?Ā)
+ ("-A" ?Ā)
+ ("A-" ?Ā)
+ ("¯a" ?ā)
+ ("_a" ?ā)
+ ("a_" ?ā)
+ ("-a" ?ā)
+ ("a-" ?ā)
+ ("UA" ?Ă)
+ ("uA" ?Ă)
+ ("bA" ?Ă)
+ ("A(" ?Ă)
+ ("Ua" ?ă)
+ ("ua" ?ă)
+ ("ba" ?ă)
+ ("a(" ?ă)
+ (";A" ?Ą)
+ ("A;" ?Ą)
+ (",A" ?Ą)
+ ("A," ?Ą)
+ (";a" ?ą)
+ ("a;" ?ą)
+ (",a" ?ą)
+ ("a," ?ą)
+ ("´C" ?Ć)
+ ("'C" ?Ć)
+ ("C'" ?Ć)
+ ("´c" ?ć)
+ ("'c" ?ć)
+ ("c'" ?ć)
+ ("^C" ?Ĉ)
+ ("^c" ?ĉ)
+ (".C" ?Ċ)
+ ("C." ?Ċ)
+ (".c" ?ċ)
+ ("c." ?ċ)
+ ("cC" ?Č)
+ ("<C" ?Č)
+ ("C<" ?Č)
+ ("cc" ?č)
+ ("<c" ?č)
+ ("c<" ?č)
+ ("cD" ?Ď)
+ ("<D" ?Ď)
+ ("D<" ?Ď)
+ ("cd" ?ď)
+ ("<d" ?ď)
+ ("d<" ?ď)
+ ("-D" ?Đ)
+ ("D-" ?Đ)
+ ("/D" ?Đ)
+ ("-d" ?đ)
+ ("d-" ?đ)
+ ("/d" ?đ)
+ ("¯E" ?Ē)
+ ("_E" ?Ē)
+ ("E_" ?Ē)
+ ("-E" ?Ē)
+ ("E-" ?Ē)
+ ("¯e" ?ē)
+ ("_e" ?ē)
+ ("e_" ?ē)
+ ("-e" ?ē)
+ ("e-" ?ē)
+ ("UE" ?Ĕ)
+ ("bE" ?Ĕ)
+ ("Ue" ?ĕ)
+ ("be" ?ĕ)
+ (".E" ?Ė)
+ ("E." ?Ė)
+ (".e" ?ė)
+ ("e." ?ė)
+ (";E" ?Ę)
+ ("E;" ?Ę)
+ (",E" ?Ę)
+ ("E," ?Ę)
+ (";e" ?ę)
+ ("e;" ?ę)
+ (",e" ?ę)
+ ("e," ?ę)
+ ("cE" ?Ě)
+ ("<E" ?Ě)
+ ("E<" ?Ě)
+ ("ce" ?ě)
+ ("<e" ?ě)
+ ("e<" ?ě)
+ ("^G" ?Ĝ)
+ ("^g" ?ĝ)
+ ("UG" ?Ğ)
+ ("GU" ?Ğ)
+ ("bG" ?Ğ)
+ ("˘G" ?Ğ)
+ ("G˘" ?Ğ)
+ ("G(" ?Ğ)
+ ("Ug" ?ğ)
+ ("gU" ?ğ)
+ ("bg" ?ğ)
+ ("˘g" ?ğ)
+ ("g˘" ?ğ)
+ ("g(" ?ğ)
+ (".G" ?Ġ)
+ ("G." ?Ġ)
+ (".g" ?ġ)
+ ("g." ?ġ)
+ (",G" ?Ģ)
+ ("G," ?Ģ)
+ ("¸G" ?Ģ)
+ (",g" ?ģ)
+ ("g," ?ģ)
+ ("¸g" ?ģ)
+ ("^H" ?Ĥ)
+ ("^h" ?ĥ)
+ ("/H" ?Ħ)
+ ("/h" ?ħ)
+ ("~I" ?Ĩ)
+ ("I~" ?Ĩ)
+ ("~i" ?ĩ)
+ ("i~" ?ĩ)
+ ("¯I" ?Ī)
+ ("_I" ?Ī)
+ ("I_" ?Ī)
+ ("-I" ?Ī)
+ ("I-" ?Ī)
+ ("¯i" ?ī)
+ ("_i" ?ī)
+ ("i_" ?ī)
+ ("-i" ?ī)
+ ("i-" ?ī)
+ ("UI" ?Ĭ)
+ ("bI" ?Ĭ)
+ ("Ui" ?ĭ)
+ ("bi" ?ĭ)
+ (";I" ?Į)
+ ("I;" ?Į)
+ (",I" ?Į)
+ ("I," ?Į)
+ (";i" ?į)
+ ("i;" ?į)
+ (",i" ?į)
+ ("i," ?į)
+ (".I" ?İ)
+ ("I." ?İ)
+ ("i." ?ı)
+ (".i" ?ı)
+ ("^J" ?Ĵ)
+ ("^j" ?ĵ)
+ (",K" ?Ķ)
+ ("K," ?Ķ)
+ ("¸K" ?Ķ)
+ (",k" ?ķ)
+ ("k," ?ķ)
+ ("¸k" ?ķ)
+ ("kk" ?ĸ)
+ ("´L" ?Ĺ)
+ ("'L" ?Ĺ)
+ ("L'" ?Ĺ)
+ ("´l" ?ĺ)
+ ("'l" ?ĺ)
+ ("l'" ?ĺ)
+ (",L" ?Ļ)
+ ("L," ?Ļ)
+ ("¸L" ?Ļ)
+ (",l" ?ļ)
+ ("l," ?ļ)
+ ("¸l" ?ļ)
+ ("cL" ?Ľ)
+ ("<L" ?Ľ)
+ ("L<" ?Ľ)
+ ("cl" ?ľ)
+ ("<l" ?ľ)
+ ("l<" ?ľ)
+ ("/L" ?Ł)
+ ("L/" ?Ł)
+ ("/l" ?ł)
+ ("l/" ?ł)
+ ("´N" ?Ń)
+ ("'N" ?Ń)
+ ("N'" ?Ń)
+ ("´n" ?ń)
+ ("'n" ?ń)
+ ("n'" ?ń)
+ (",N" ?Ņ)
+ ("N," ?Ņ)
+ ("¸N" ?Ņ)
+ (",n" ?ņ)
+ ("n," ?ņ)
+ ("¸n" ?ņ)
+ ("cN" ?Ň)
+ ("<N" ?Ň)
+ ("N<" ?Ň)
+ ("cn" ?ň)
+ ("<n" ?ň)
+ ("n<" ?ň)
+ ("NG" ?Ŋ)
+ ("ng" ?ŋ)
+ ("¯O" ?Ō)
+ ("_O" ?Ō)
+ ("O_" ?Ō)
+ ("-O" ?Ō)
+ ("O-" ?Ō)
+ ("¯o" ?ō)
+ ("_o" ?ō)
+ ("o_" ?ō)
+ ("-o" ?ō)
+ ("o-" ?ō)
+ ("UO" ?Ŏ)
+ ("bO" ?Ŏ)
+ ("Uo" ?ŏ)
+ ("bo" ?ŏ)
+ ("=O" ?Ő)
+ ("=o" ?ő)
+ ("´R" ?Ŕ)
+ ("'R" ?Ŕ)
+ ("R'" ?Ŕ)
+ ("´r" ?ŕ)
+ ("'r" ?ŕ)
+ ("r'" ?ŕ)
+ (",R" ?Ŗ)
+ ("R," ?Ŗ)
+ ("¸R" ?Ŗ)
+ (",r" ?ŗ)
+ ("r," ?ŗ)
+ ("¸r" ?ŗ)
+ ("cR" ?Ř)
+ ("<R" ?Ř)
+ ("R<" ?Ř)
+ ("cr" ?ř)
+ ("<r" ?ř)
+ ("r<" ?ř)
+ ("´S" ?Ś)
+ ("'S" ?Ś)
+ ("S'" ?Ś)
+ ("´s" ?ś)
+ ("'s" ?ś)
+ ("s'" ?ś)
+ ("^S" ?Ŝ)
+ ("^s" ?ŝ)
+ (",S" ?Ş)
+ ("S," ?Ş)
+ ("¸S" ?Ş)
+ (",s" ?ş)
+ ("s," ?ş)
+ ("¸s" ?ş)
+ ("s¸" ?ş)
+ ("cS" ?Š)
+ ("<S" ?Š)
+ ("S<" ?Š)
+ ("cs" ?š)
+ ("<s" ?š)
+ ("s<" ?š)
+ (",T" ?Ţ)
+ ("T," ?Ţ)
+ ("¸T" ?Ţ)
+ (",t" ?ţ)
+ ("t," ?ţ)
+ ("¸t" ?ţ)
+ ("cT" ?Ť)
+ ("<T" ?Ť)
+ ("T<" ?Ť)
+ ("ct" ?ť)
+ ("<t" ?ť)
+ ("t<" ?ť)
+ ("/T" ?Ŧ)
+ ("T/" ?Ŧ)
+ ("T-" ?Ŧ)
+ ("/t" ?ŧ)
+ ("t/" ?ŧ)
+ ("t-" ?ŧ)
+ ("~U" ?Ũ)
+ ("U~" ?Ũ)
+ ("~u" ?ũ)
+ ("u~" ?ũ)
+ ("¯U" ?Ū)
+ ("_U" ?Ū)
+ ("U_" ?Ū)
+ ("-U" ?Ū)
+ ("U-" ?Ū)
+ ("¯u" ?ū)
+ ("_u" ?ū)
+ ("u_" ?ū)
+ ("-u" ?ū)
+ ("u-" ?ū)
+ ("UU" ?Ŭ)
+ ("uU" ?Ŭ)
+ ("bU" ?Ŭ)
+ ("Uu" ?ŭ)
+ ("uu" ?ŭ)
+ ("bu" ?ŭ)
+ ("oU" ?Ů)
+ ("*U" ?Ů)
+ ("U*" ?Ů)
+ ("ou" ?ů)
+ ("*u" ?ů)
+ ("u*" ?ů)
+ ("=U" ?Ű)
+ ("=u" ?ű)
+ (";U" ?Ų)
+ ("U;" ?Ų)
+ (",U" ?Ų)
+ ("U," ?Ų)
+ (";u" ?ų)
+ ("u;" ?ų)
+ (",u" ?ų)
+ ("u," ?ų)
+ ("^W" ?Ŵ)
+ ("W^" ?Ŵ)
+ ("^w" ?ŵ)
+ ("w^" ?ŵ)
+ ("^Y" ?Ŷ)
+ ("Y^" ?Ŷ)
+ ("^y" ?ŷ)
+ ("y^" ?ŷ)
+ ("\"Y" ?Ÿ)
+ ("Y\"" ?Ÿ)
+ ("¨Y" ?Ÿ)
+ ("Y¨" ?Ÿ)
+ ("´Z" ?Ź)
+ ("'Z" ?Ź)
+ ("Z'" ?Ź)
+ ("´z" ?ź)
+ ("'z" ?ź)
+ ("z'" ?ź)
+ (".Z" ?Ż)
+ ("Z." ?Ż)
+ (".z" ?ż)
+ ("z." ?ż)
+ ("cZ" ?Ž)
+ ("vZ" ?Ž)
+ ("<Z" ?Ž)
+ ("Z<" ?Ž)
+ ("cz" ?ž)
+ ("vz" ?ž)
+ ("<z" ?ž)
+ ("z<" ?ž)
+ ("/b" ?ƀ)
+ ("/I" ?Ɨ)
+ ("+O" ?Ơ)
+ ("+o" ?ơ)
+ ("+U" ?Ư)
+ ("+u" ?ư)
+ ("/Z" ?Ƶ)
+ ("/z" ?ƶ)
+ ("cA" ?Ǎ)
+ ("ca" ?ǎ)
+ ("cI" ?Ǐ)
+ ("ci" ?ǐ)
+ ("cO" ?Ǒ)
+ ("co" ?ǒ)
+ ("cU" ?Ǔ)
+ ("cu" ?ǔ)
+ ("¯Ü" ?Ǖ)
+ ("_Ü" ?Ǖ)
+ ("¯\"U" ?Ǖ)
+ ("_\"U" ?Ǖ)
+ ("¯ü" ?ǖ)
+ ("_ü" ?ǖ)
+ ("¯\"u" ?ǖ)
+ ("_\"u" ?ǖ)
+ ("´Ü" ?Ǘ)
+ ("'Ü" ?Ǘ)
+ ("´\"U" ?Ǘ)
+ ("'\"U" ?Ǘ)
+ ("´ü" ?ǘ)
+ ("'ü" ?ǘ)
+ ("´\"u" ?ǘ)
+ ("'\"u" ?ǘ)
+ ("cÜ" ?Ǚ)
+ ("c\"U" ?Ǚ)
+ ("cü" ?ǚ)
+ ("c\"u" ?ǚ)
+ ("`Ü" ?Ǜ)
+ ("`\"U" ?Ǜ)
+ ("`ü" ?ǜ)
+ ("`\"u" ?ǜ)
+ ("¯Ä" ?Ǟ)
+ ("_Ä" ?Ǟ)
+ ("¯\"A" ?Ǟ)
+ ("_\"A" ?Ǟ)
+ ("¯ä" ?ǟ)
+ ("_ä" ?ǟ)
+ ("¯\"a" ?ǟ)
+ ("_\"a" ?ǟ)
+ ("¯Ȧ" ?Ǡ)
+ ("_Ȧ" ?Ǡ)
+ ("¯.A" ?Ǡ)
+ ("_.A" ?Ǡ)
+ ("¯ȧ" ?ǡ)
+ ("_ȧ" ?ǡ)
+ ("¯.a" ?ǡ)
+ ("_.a" ?ǡ)
+ ("¯Æ" ?Ǣ)
+ ("_Æ" ?Ǣ)
+ ("¯æ" ?ǣ)
+ ("_æ" ?ǣ)
+ ("/G" ?Ǥ)
+ ("/g" ?ǥ)
+ ("cG" ?Ǧ)
+ ("cg" ?ǧ)
+ ("cK" ?Ǩ)
+ ("ck" ?ǩ)
+ (";O" ?Ǫ)
+ ("O;" ?Ǫ)
+ (",O" ?Ǫ)
+ ("O," ?Ǫ)
+ (";o" ?ǫ)
+ ("o;" ?ǫ)
+ (",o" ?ǫ)
+ ("o," ?ǫ)
+ ("¯Ǫ" ?Ǭ)
+ ("_Ǫ" ?Ǭ)
+ ("¯;O" ?Ǭ)
+ ("_;O" ?Ǭ)
+ ("¯ǫ" ?ǭ)
+ ("_ǫ" ?ǭ)
+ ("¯;o" ?ǭ)
+ ("_;o" ?ǭ)
+ ("cƷ" ?Ǯ)
+ ("cʒ" ?ǯ)
+ ("cj" ?ǰ)
+ ("´G" ?Ǵ)
+ ("'G" ?Ǵ)
+ ("´g" ?ǵ)
+ ("'g" ?ǵ)
+ ("`N" ?Ǹ)
+ ("`n" ?ǹ)
+ ("´Å" ?Ǻ)
+ ("'Å" ?Ǻ)
+ ("*'A" ?Ǻ)
+ ("´å" ?ǻ)
+ ("'å" ?ǻ)
+ ("*'a" ?ǻ)
+ ("´Æ" ?Ǽ)
+ ("'Æ" ?Ǽ)
+ ("´æ" ?ǽ)
+ ("'æ" ?ǽ)
+ ("´Ø" ?Ǿ)
+ ("'Ø" ?Ǿ)
+ ("´/O" ?Ǿ)
+ ("'/O" ?Ǿ)
+ ("´ø" ?ǿ)
+ ("'ø" ?ǿ)
+ ("´/o" ?ǿ)
+ ("'/o" ?ǿ)
+ ("cH" ?Ȟ)
+ ("ch" ?ȟ)
+ (".A" ?Ȧ)
+ (".a" ?ȧ)
+ ("¸E" ?Ȩ)
+ ("¸e" ?ȩ)
+ ("¯Ö" ?Ȫ)
+ ("_Ö" ?Ȫ)
+ ("¯\"O" ?Ȫ)
+ ("_\"O" ?Ȫ)
+ ("¯ö" ?ȫ)
+ ("_ö" ?ȫ)
+ ("¯\"o" ?ȫ)
+ ("_\"o" ?ȫ)
+ ("¯Õ" ?Ȭ)
+ ("_Õ" ?Ȭ)
+ ("¯~O" ?Ȭ)
+ ("_~O" ?Ȭ)
+ ("¯õ" ?ȭ)
+ ("_õ" ?ȭ)
+ ("¯~o" ?ȭ)
+ ("_~o" ?ȭ)
+ (".O" ?Ȯ)
+ (".o" ?ȯ)
+ ("¯Ȯ" ?Ȱ)
+ ("_Ȯ" ?Ȱ)
+ ("¯.O" ?Ȱ)
+ ("_.O" ?Ȱ)
+ ("¯ȯ" ?ȱ)
+ ("_ȯ" ?ȱ)
+ ("¯.o" ?ȱ)
+ ("_.o" ?ȱ)
+ ("¯Y" ?Ȳ)
+ ("_Y" ?Ȳ)
+ ("¯y" ?ȳ)
+ ("_y" ?ȳ)
+ ("ee" ?ə)
+ ("/i" ?ɨ)
+ ("/ʔ" ?ʡ)
+ ("^_h" ?ʰ)
+ ("^_h" ?ʰ)
+ ("^_ɦ" ?ʱ)
+ ("^_ɦ" ?ʱ)
+ ("^_j" ?ʲ)
+ ("^_j" ?ʲ)
+ ("^_r" ?ʳ)
+ ("^_r" ?ʳ)
+ ("^_ɹ" ?ʴ)
+ ("^_ɹ" ?ʴ)
+ ("^_ɻ" ?ʵ)
+ ("^_ɻ" ?ʵ)
+ ("^_ʁ" ?ʶ)
+ ("^_ʁ" ?ʶ)
+ ("^_w" ?ʷ)
+ ("^_w" ?ʷ)
+ ("^_y" ?ʸ)
+ ("^_y" ?ʸ)
+ ("^_ɣ" ?ˠ)
+ ("^_ɣ" ?ˠ)
+ ("^_l" ?ˡ)
+ ("^_l" ?ˡ)
+ ("^_s" ?ˢ)
+ ("^_s" ?ˢ)
+ ("^_x" ?ˣ)
+ ("^_x" ?ˣ)
+ ("^_ʕ" ?ˤ)
+ ("^_ʕ" ?ˤ)
+ ("\"´" ?̈́)
+ ("\"'" ?̈́)
+ ("¨´" ?΅)
+ ("¨'" ?΅)
+ ("'\" " ?΅)
+ ("´Α" ?Ά)
+ ("'Α" ?Ά)
+ ("Α'" ?Ά)
+ ("´Ε" ?Έ)
+ ("'Ε" ?Έ)
+ ("Ε'" ?Έ)
+ ("´Η" ?Ή)
+ ("'Η" ?Ή)
+ ("Η'" ?Ή)
+ ("´Ι" ?Ί)
+ ("'Ι" ?Ί)
+ ("Ι'" ?Ί)
+ ("´Ο" ?Ό)
+ ("'Ο" ?Ό)
+ ("Ο'" ?Ό)
+ ("´Υ" ?Ύ)
+ ("'Υ" ?Ύ)
+ ("Υ'" ?Ύ)
+ ("´Ω" ?Ώ)
+ ("'Ω" ?Ώ)
+ ("Ω'" ?Ώ)
+ ("´ϊ" ?ΐ)
+ ("'ϊ" ?ΐ)
+ ("´\"ι" ?ΐ)
+ ("'\"ι" ?ΐ)
+ ("\"Ι" ?Ϊ)
+ ("Ι\"" ?Ϊ)
+ ("\"Υ" ?Ϋ)
+ ("Υ\"" ?Ϋ)
+ ("´α" ?ά)
+ ("'α" ?ά)
+ ("α'" ?ά)
+ ("´ε" ?έ)
+ ("'ε" ?έ)
+ ("ε'" ?έ)
+ ("´η" ?ή)
+ ("'η" ?ή)
+ ("η'" ?ή)
+ ("´ι" ?ί)
+ ("'ι" ?ί)
+ ("´ϋ" ?ΰ)
+ ("'ϋ" ?ΰ)
+ ("´\"υ" ?ΰ)
+ ("'\"υ" ?ΰ)
+ ("\"ι" ?ϊ)
+ ("ι\"" ?ϊ)
+ ("\"υ" ?ϋ)
+ ("υ\"" ?ϋ)
+ ("´ο" ?ό)
+ ("'ο" ?ό)
+ ("ο'" ?ό)
+ ("´υ" ?ύ)
+ ("'υ" ?ύ)
+ ("υ'" ?ύ)
+ ("´ω" ?ώ)
+ ("'ω" ?ώ)
+ ("ω'" ?ώ)
+ ("\"ϒ" ?ϔ)
+ ("`Е" ?Ѐ)
+ ("\"Е" ?Ё)
+ ("´Г" ?Ѓ)
+ ("'Г" ?Ѓ)
+ ("\"І" ?Ї)
+ ("´К" ?Ќ)
+ ("'К" ?Ќ)
+ ("`И" ?Ѝ)
+ ("UУ" ?Ў)
+ ("bУ" ?Ў)
+ ("UИ" ?Й)
+ ("bИ" ?Й)
+ ("Uи" ?й)
+ ("bи" ?й)
+ ("`е" ?ѐ)
+ ("\"е" ?ё)
+ ("´г" ?ѓ)
+ ("'г" ?ѓ)
+ ("\"і" ?ї)
+ ("´к" ?ќ)
+ ("'к" ?ќ)
+ ("`и" ?ѝ)
+ ("Uу" ?ў)
+ ("bу" ?ў)
+ ("/Г" ?Ғ)
+ ("/г" ?ғ)
+ ("/К" ?Ҟ)
+ ("/к" ?ҟ)
+ ("/Ү" ?Ұ)
+ ("/ү" ?ұ)
+ ("UЖ" ?Ӂ)
+ ("bЖ" ?Ӂ)
+ ("Uж" ?ӂ)
+ ("bж" ?ӂ)
+ ("UА" ?Ӑ)
+ ("bА" ?Ӑ)
+ ("Uа" ?ӑ)
+ ("bа" ?ӑ)
+ ("\"А" ?Ӓ)
+ ("\"а" ?ӓ)
+ ("UЕ" ?Ӗ)
+ ("bЕ" ?Ӗ)
+ ("Uе" ?ӗ)
+ ("bе" ?ӗ)
+ ("\"Ә" ?Ӛ)
+ ("\"ә" ?ӛ)
+ ("\"Ж" ?Ӝ)
+ ("\"ж" ?ӝ)
+ ("\"З" ?Ӟ)
+ ("\"з" ?ӟ)
+ ("¯И" ?Ӣ)
+ ("_И" ?Ӣ)
+ ("¯и" ?ӣ)
+ ("_и" ?ӣ)
+ ("\"И" ?Ӥ)
+ ("\"и" ?ӥ)
+ ("\"О" ?Ӧ)
+ ("\"о" ?ӧ)
+ ("\"Ө" ?Ӫ)
+ ("\"ө" ?ӫ)
+ ("\"Э" ?Ӭ)
+ ("\"э" ?ӭ)
+ ("¯У" ?Ӯ)
+ ("_У" ?Ӯ)
+ ("¯у" ?ӯ)
+ ("_у" ?ӯ)
+ ("\"У" ?Ӱ)
+ ("\"у" ?ӱ)
+ ("=У" ?Ӳ)
+ ("=у" ?ӳ)
+ ("\"Ч" ?Ӵ)
+ ("\"ч" ?ӵ)
+ ("\"Ы" ?Ӹ)
+ ("\"ы" ?ӹ)
+ ("ٓا" ?آ)
+ ("ٔا" ?أ)
+ ("ٔو" ?ؤ)
+ ("ٕا" ?إ)
+ ("ٔي" ?ئ)
+ ("ٔە" ?ۀ)
+ ("ٔہ" ?ۂ)
+ ("ٔے" ?ۓ)
+ ("़न" ?ऩ)
+ ("़र" ?ऱ)
+ ("़ळ" ?ऴ)
+ ("़क" ?क़)
+ ("़ख" ?ख़)
+ ("़ग" ?ग़)
+ ("़ज" ?ज़)
+ ("़ड" ?ड़)
+ ("़ढ" ?ढ़)
+ ("़फ" ?फ़)
+ ("़य" ?य़)
+ ("ো" ?ো)
+ ("ৌ" ?ৌ)
+ ("়ড" ?ড়)
+ ("়ঢ" ?ঢ়)
+ ("়য" ?য়)
+ ("਼ਲ" ?ਲ਼)
+ ("਼ਸ" ?ਸ਼)
+ ("਼ਖ" ?ਖ਼)
+ ("਼ਗ" ?ਗ਼)
+ ("਼ਜ" ?ਜ਼)
+ ("਼ਫ" ?ਫ਼)
+ ("ୈ" ?ୈ)
+ ("ୋ" ?ୋ)
+ ("ୌ" ?ୌ)
+ ("଼ଡ" ?ଡ଼)
+ ("଼ଢ" ?ଢ଼)
+ ("ௗஒ" ?ஔ)
+ ("ொ" ?ொ)
+ ("ோ" ?ோ)
+ ("ௌ" ?ௌ)
+ ("ై" ?ై)
+ ("ೀ" ?ೀ)
+ ("ೇ" ?ೇ)
+ ("ೈ" ?ೈ)
+ ("ೊ" ?ೊ)
+ ("ೋ" ?ೋ)
+ ("ൊ" ?ൊ)
+ ("ോ" ?ോ)
+ ("ൌ" ?ൌ)
+ ("ේ" ?ේ)
+ ("ො" ?ො)
+ ("ෝ" ?ෝ)
+ ("ෞ" ?ෞ)
+ ("ྷག" ?གྷ)
+ ("ྷཌ" ?ཌྷ)
+ ("ྷད" ?དྷ)
+ ("ྷབ" ?བྷ)
+ ("ྷཛ" ?ཛྷ)
+ ("ྵཀ" ?ཀྵ)
+ ("ཱི" ?ཱི)
+ ("ཱུ" ?ཱུ)
+ ("ྲྀ" ?ྲྀ)
+ ("ླྀ" ?ླྀ)
+ ("ཱྀ" ?ཱྀ)
+ ("ྒྷ" ?ྒྷ)
+ ("ྜྷ" ?ྜྷ)
+ ("ྡྷ" ?ྡྷ)
+ ("ྦྷ" ?ྦྷ)
+ ("ྫྷ" ?ྫྷ)
+ ("ྐྵ" ?ྐྵ)
+ ("ီဥ" ?ဦ)
+ (".B" ?Ḃ)
+ ("B." ?Ḃ)
+ (".b" ?ḃ)
+ ("b." ?ḃ)
+ ("!B" ?Ḅ)
+ ("!b" ?ḅ)
+ ("´Ç" ?Ḉ)
+ ("'Ç" ?Ḉ)
+ ("´,C" ?Ḉ)
+ ("´¸C" ?Ḉ)
+ ("'¸C" ?Ḉ)
+ ("´ç" ?ḉ)
+ ("'ç" ?ḉ)
+ ("´,c" ?ḉ)
+ ("´¸c" ?ḉ)
+ ("'¸c" ?ḉ)
+ (".D" ?Ḋ)
+ ("D." ?Ḋ)
+ (".d" ?ḋ)
+ ("d." ?ḋ)
+ ("!D" ?Ḍ)
+ ("!d" ?ḍ)
+ (",D" ?Ḑ)
+ ("D," ?Ḑ)
+ ("¸D" ?Ḑ)
+ (",d" ?ḑ)
+ ("d," ?ḑ)
+ ("¸d" ?ḑ)
+ ("`Ē" ?Ḕ)
+ ("`¯E" ?Ḕ)
+ ("`_E" ?Ḕ)
+ ("`ē" ?ḕ)
+ ("`¯e" ?ḕ)
+ ("`_e" ?ḕ)
+ ("´Ē" ?Ḗ)
+ ("'Ē" ?Ḗ)
+ ("´¯E" ?Ḗ)
+ ("´_E" ?Ḗ)
+ ("'¯E" ?Ḗ)
+ ("'_E" ?Ḗ)
+ ("´ē" ?ḗ)
+ ("'ē" ?ḗ)
+ ("´¯e" ?ḗ)
+ ("´_e" ?ḗ)
+ ("'¯e" ?ḗ)
+ ("'_e" ?ḗ)
+ ("UȨ" ?Ḝ)
+ ("bȨ" ?Ḝ)
+ ("U ,E" ?Ḝ)
+ ("U¸E" ?Ḝ)
+ ("b,E" ?Ḝ)
+ ("b¸E" ?Ḝ)
+ ("Uȩ" ?ḝ)
+ ("bȩ" ?ḝ)
+ ("U ,e" ?ḝ)
+ ("U¸e" ?ḝ)
+ ("b,e" ?ḝ)
+ ("b¸e" ?ḝ)
+ (".F" ?Ḟ)
+ ("F." ?Ḟ)
+ (".f" ?ḟ)
+ ("f." ?ḟ)
+ ("¯G" ?Ḡ)
+ ("_G" ?Ḡ)
+ ("¯g" ?ḡ)
+ ("_g" ?ḡ)
+ (".H" ?Ḣ)
+ (".h" ?ḣ)
+ ("!H" ?Ḥ)
+ ("!h" ?ḥ)
+ ("\"H" ?Ḧ)
+ ("\"h" ?ḧ)
+ (",H" ?Ḩ)
+ ("H," ?Ḩ)
+ ("¸H" ?Ḩ)
+ (",h" ?ḩ)
+ ("h," ?ḩ)
+ ("¸h" ?ḩ)
+ ("´Ï" ?Ḯ)
+ ("'Ï" ?Ḯ)
+ ("´\"I" ?Ḯ)
+ ("'\"I" ?Ḯ)
+ ("´ï" ?ḯ)
+ ("'ï" ?ḯ)
+ ("´\"i" ?ḯ)
+ ("'\"i" ?ḯ)
+ ("´K" ?Ḱ)
+ ("'K" ?Ḱ)
+ ("´k" ?ḱ)
+ ("'k" ?ḱ)
+ ("!K" ?Ḳ)
+ ("!k" ?ḳ)
+ ("!L" ?Ḷ)
+ ("!l" ?ḷ)
+ ("¯Ḷ" ?Ḹ)
+ ("_Ḷ" ?Ḹ)
+ ("¯!L" ?Ḹ)
+ ("_!L" ?Ḹ)
+ ("¯ḷ" ?ḹ)
+ ("_ḷ" ?ḹ)
+ ("¯!l" ?ḹ)
+ ("_!l" ?ḹ)
+ ("´M" ?Ḿ)
+ ("'M" ?Ḿ)
+ ("´m" ?ḿ)
+ ("'m" ?ḿ)
+ (".M" ?Ṁ)
+ ("M." ?Ṁ)
+ (".m" ?ṁ)
+ ("m." ?ṁ)
+ ("!M" ?Ṃ)
+ ("!m" ?ṃ)
+ (".N" ?Ṅ)
+ (".n" ?ṅ)
+ ("!N" ?Ṇ)
+ ("!n" ?ṇ)
+ ("´Õ" ?Ṍ)
+ ("'Õ" ?Ṍ)
+ ("´~O" ?Ṍ)
+ ("'~O" ?Ṍ)
+ ("´õ" ?ṍ)
+ ("'õ" ?ṍ)
+ ("´~o" ?ṍ)
+ ("'~o" ?ṍ)
+ ("\"Õ" ?Ṏ)
+ ("\"~O" ?Ṏ)
+ ("\"õ" ?ṏ)
+ ("\"~o" ?ṏ)
+ ("`Ō" ?Ṑ)
+ ("`¯O" ?Ṑ)
+ ("`_O" ?Ṑ)
+ ("`ō" ?ṑ)
+ ("`¯o" ?ṑ)
+ ("`_o" ?ṑ)
+ ("´Ō" ?Ṓ)
+ ("'Ō" ?Ṓ)
+ ("´¯O" ?Ṓ)
+ ("´_O" ?Ṓ)
+ ("'¯O" ?Ṓ)
+ ("'_O" ?Ṓ)
+ ("´ō" ?ṓ)
+ ("'ō" ?ṓ)
+ ("´¯o" ?ṓ)
+ ("´_o" ?ṓ)
+ ("'¯o" ?ṓ)
+ ("'_o" ?ṓ)
+ ("´P" ?Ṕ)
+ ("'P" ?Ṕ)
+ ("´p" ?ṕ)
+ ("'p" ?ṕ)
+ (".P" ?Ṗ)
+ ("P." ?Ṗ)
+ (".p" ?ṗ)
+ ("p." ?ṗ)
+ (".R" ?Ṙ)
+ (".r" ?ṙ)
+ ("!R" ?Ṛ)
+ ("!r" ?ṛ)
+ ("¯Ṛ" ?Ṝ)
+ ("_Ṛ" ?Ṝ)
+ ("¯!R" ?Ṝ)
+ ("_!R" ?Ṝ)
+ ("¯ṛ" ?ṝ)
+ ("_ṛ" ?ṝ)
+ ("¯!r" ?ṝ)
+ ("_!r" ?ṝ)
+ (".S" ?Ṡ)
+ ("S." ?Ṡ)
+ (".s" ?ṡ)
+ ("s." ?ṡ)
+ ("!S" ?Ṣ)
+ ("!s" ?ṣ)
+ (".Ś" ?Ṥ)
+ (".´S" ?Ṥ)
+ (".'S" ?Ṥ)
+ (".ś" ?ṥ)
+ (".´s" ?ṥ)
+ (".'s" ?ṥ)
+ (".Š" ?Ṧ)
+ (".š" ?ṧ)
+ (".Ṣ" ?Ṩ)
+ (".!S" ?Ṩ)
+ (".ṣ" ?ṩ)
+ (".!s" ?ṩ)
+ (".T" ?Ṫ)
+ ("T." ?Ṫ)
+ (".t" ?ṫ)
+ ("t." ?ṫ)
+ ("!T" ?Ṭ)
+ ("!t" ?ṭ)
+ ("´Ũ" ?Ṹ)
+ ("'Ũ" ?Ṹ)
+ ("´~U" ?Ṹ)
+ ("'~U" ?Ṹ)
+ ("´ũ" ?ṹ)
+ ("'ũ" ?ṹ)
+ ("´~u" ?ṹ)
+ ("'~u" ?ṹ)
+ ("\"Ū" ?Ṻ)
+ ("\"¯U" ?Ṻ)
+ ("\"_U" ?Ṻ)
+ ("\"ū" ?ṻ)
+ ("\"¯u" ?ṻ)
+ ("\"_u" ?ṻ)
+ ("~V" ?Ṽ)
+ ("~v" ?ṽ)
+ ("!V" ?Ṿ)
+ ("!v" ?ṿ)
+ ("`W" ?Ẁ)
+ ("`w" ?ẁ)
+ ("´W" ?Ẃ)
+ ("'W" ?Ẃ)
+ ("´w" ?ẃ)
+ ("'w" ?ẃ)
+ ("\"W" ?Ẅ)
+ ("\"w" ?ẅ)
+ (".W" ?Ẇ)
+ (".w" ?ẇ)
+ ("!W" ?Ẉ)
+ ("!w" ?ẉ)
+ (".X" ?Ẋ)
+ (".x" ?ẋ)
+ ("\"X" ?Ẍ)
+ ("\"x" ?ẍ)
+ (".Y" ?Ẏ)
+ (".y" ?ẏ)
+ ("^Z" ?Ẑ)
+ ("^z" ?ẑ)
+ ("!Z" ?Ẓ)
+ ("!z" ?ẓ)
+ ("\"t" ?ẗ)
+ ("ow" ?ẘ)
+ ("oy" ?ẙ)
+ (".ſ" ?ẛ)
+ ("!A" ?Ạ)
+ ("!a" ?ạ)
+ ("?A" ?Ả)
+ ("?a" ?ả)
+ ("´Â" ?Ấ)
+ ("'Â" ?Ấ)
+ ("´^A" ?Ấ)
+ ("'^A" ?Ấ)
+ ("´â" ?ấ)
+ ("'â" ?ấ)
+ ("´^a" ?ấ)
+ ("'^a" ?ấ)
+ ("`Â" ?Ầ)
+ ("`^A" ?Ầ)
+ ("`â" ?ầ)
+ ("`^a" ?ầ)
+ ("?Â" ?Ẩ)
+ ("?^A" ?Ẩ)
+ ("?â" ?ẩ)
+ ("?^a" ?ẩ)
+ ("~Â" ?Ẫ)
+ ("~^A" ?Ẫ)
+ ("~â" ?ẫ)
+ ("~^a" ?ẫ)
+ ("^Ạ" ?Ậ)
+ ("^!A" ?Ậ)
+ ("^ạ" ?ậ)
+ ("^!a" ?ậ)
+ ("´Ă" ?Ắ)
+ ("'Ă" ?Ắ)
+ ("´bA" ?Ắ)
+ ("'bA" ?Ắ)
+ ("´ă" ?ắ)
+ ("'ă" ?ắ)
+ ("´ba" ?ắ)
+ ("'ba" ?ắ)
+ ("`Ă" ?Ằ)
+ ("`bA" ?Ằ)
+ ("`ă" ?ằ)
+ ("`ba" ?ằ)
+ ("?Ă" ?Ẳ)
+ ("?bA" ?Ẳ)
+ ("?ă" ?ẳ)
+ ("?ba" ?ẳ)
+ ("~Ă" ?Ẵ)
+ ("~bA" ?Ẵ)
+ ("~ă" ?ẵ)
+ ("~ba" ?ẵ)
+ ("UẠ" ?Ặ)
+ ("bẠ" ?Ặ)
+ ("U!A" ?Ặ)
+ ("b!A" ?Ặ)
+ ("Uạ" ?ặ)
+ ("bạ" ?ặ)
+ ("U!a" ?ặ)
+ ("b!a" ?ặ)
+ ("!E" ?Ẹ)
+ ("!e" ?ẹ)
+ ("?E" ?Ẻ)
+ ("?e" ?ẻ)
+ ("~E" ?Ẽ)
+ ("~e" ?ẽ)
+ ("´Ê" ?Ế)
+ ("'Ê" ?Ế)
+ ("´^E" ?Ế)
+ ("'^E" ?Ế)
+ ("´ê" ?ế)
+ ("'ê" ?ế)
+ ("´^e" ?ế)
+ ("'^e" ?ế)
+ ("`Ê" ?Ề)
+ ("`^E" ?Ề)
+ ("`ê" ?ề)
+ ("`^e" ?ề)
+ ("?Ê" ?Ể)
+ ("?^E" ?Ể)
+ ("?ê" ?ể)
+ ("?^e" ?ể)
+ ("~Ê" ?Ễ)
+ ("~^E" ?Ễ)
+ ("~ê" ?ễ)
+ ("~^e" ?ễ)
+ ("^Ẹ" ?Ệ)
+ ("^!E" ?Ệ)
+ ("^ẹ" ?ệ)
+ ("^!e" ?ệ)
+ ("?I" ?Ỉ)
+ ("?i" ?ỉ)
+ ("!I" ?Ị)
+ ("!i" ?ị)
+ ("!O" ?Ọ)
+ ("!o" ?ọ)
+ ("?O" ?Ỏ)
+ ("?o" ?ỏ)
+ ("´Ô" ?Ố)
+ ("'Ô" ?Ố)
+ ("´^O" ?Ố)
+ ("'^O" ?Ố)
+ ("´ô" ?ố)
+ ("'ô" ?ố)
+ ("´^o" ?ố)
+ ("'^o" ?ố)
+ ("`Ô" ?Ồ)
+ ("`^O" ?Ồ)
+ ("`ô" ?ồ)
+ ("`^o" ?ồ)
+ ("?Ô" ?Ổ)
+ ("?^O" ?Ổ)
+ ("?ô" ?ổ)
+ ("?^o" ?ổ)
+ ("~Ô" ?Ỗ)
+ ("~^O" ?Ỗ)
+ ("~ô" ?ỗ)
+ ("~^o" ?ỗ)
+ ("^Ọ" ?Ộ)
+ ("^!O" ?Ộ)
+ ("^ọ" ?ộ)
+ ("^!o" ?ộ)
+ ("´Ơ" ?Ớ)
+ ("'Ơ" ?Ớ)
+ ("´+O" ?Ớ)
+ ("'+O" ?Ớ)
+ ("´ơ" ?ớ)
+ ("'ơ" ?ớ)
+ ("´+o" ?ớ)
+ ("'+o" ?ớ)
+ ("`Ơ" ?Ờ)
+ ("`+O" ?Ờ)
+ ("`ơ" ?ờ)
+ ("`+o" ?ờ)
+ ("?Ơ" ?Ở)
+ ("?+O" ?Ở)
+ ("?ơ" ?ở)
+ ("?+o" ?ở)
+ ("~Ơ" ?Ỡ)
+ ("~+O" ?Ỡ)
+ ("~ơ" ?ỡ)
+ ("~+o" ?ỡ)
+ ("!Ơ" ?Ợ)
+ ("!+O" ?Ợ)
+ ("!ơ" ?ợ)
+ ("!+o" ?ợ)
+ ("!U" ?Ụ)
+ ("!u" ?ụ)
+ ("?U" ?Ủ)
+ ("?u" ?ủ)
+ ("´Ư" ?Ứ)
+ ("'Ư" ?Ứ)
+ ("´+U" ?Ứ)
+ ("'+U" ?Ứ)
+ ("´ư" ?ứ)
+ ("'ư" ?ứ)
+ ("´+u" ?ứ)
+ ("'+u" ?ứ)
+ ("`Ư" ?Ừ)
+ ("`+U" ?Ừ)
+ ("`ư" ?ừ)
+ ("`+u" ?ừ)
+ ("?Ư" ?Ử)
+ ("?+U" ?Ử)
+ ("?ư" ?ử)
+ ("?+u" ?ử)
+ ("~Ư" ?Ữ)
+ ("~+U" ?Ữ)
+ ("~ư" ?ữ)
+ ("~+u" ?ữ)
+ ("!Ư" ?Ự)
+ ("!+U" ?Ự)
+ ("!ư" ?ự)
+ ("!+u" ?ự)
+ ("`Y" ?Ỳ)
+ ("`y" ?ỳ)
+ ("!Y" ?Ỵ)
+ ("!y" ?ỵ)
+ ("?Y" ?Ỷ)
+ ("?y" ?ỷ)
+ ("~Y" ?Ỹ)
+ ("~y" ?ỹ)
+ (")α" ?ἀ)
+ ("(α" ?ἁ)
+ ("`ἀ" ?ἂ)
+ ("`)α" ?ἂ)
+ ("`ἁ" ?ἃ)
+ ("`(α" ?ἃ)
+ ("´ἀ" ?ἄ)
+ ("'ἀ" ?ἄ)
+ ("´)α" ?ἄ)
+ ("')α" ?ἄ)
+ ("´ἁ" ?ἅ)
+ ("'ἁ" ?ἅ)
+ ("´(α" ?ἅ)
+ ("'(α" ?ἅ)
+ ("~ἀ" ?ἆ)
+ ("~)α" ?ἆ)
+ ("~ἁ" ?ἇ)
+ ("~(α" ?ἇ)
+ (")Α" ?Ἀ)
+ ("(Α" ?Ἁ)
+ ("`Ἀ" ?Ἂ)
+ ("`)Α" ?Ἂ)
+ ("`Ἁ" ?Ἃ)
+ ("`(Α" ?Ἃ)
+ ("´Ἀ" ?Ἄ)
+ ("'Ἀ" ?Ἄ)
+ ("´)Α" ?Ἄ)
+ ("')Α" ?Ἄ)
+ ("´Ἁ" ?Ἅ)
+ ("'Ἁ" ?Ἅ)
+ ("´(Α" ?Ἅ)
+ ("'(Α" ?Ἅ)
+ ("~Ἀ" ?Ἆ)
+ ("~)Α" ?Ἆ)
+ ("~Ἁ" ?Ἇ)
+ ("~(Α" ?Ἇ)
+ (")ε" ?ἐ)
+ ("(ε" ?ἑ)
+ ("`ἐ" ?ἒ)
+ ("`)ε" ?ἒ)
+ ("`ἑ" ?ἓ)
+ ("`(ε" ?ἓ)
+ ("´ἐ" ?ἔ)
+ ("'ἐ" ?ἔ)
+ ("´)ε" ?ἔ)
+ ("')ε" ?ἔ)
+ ("´ἑ" ?ἕ)
+ ("'ἑ" ?ἕ)
+ ("´(ε" ?ἕ)
+ ("'(ε" ?ἕ)
+ (")Ε" ?Ἐ)
+ ("(Ε" ?Ἑ)
+ ("`Ἐ" ?Ἒ)
+ ("`)Ε" ?Ἒ)
+ ("`Ἑ" ?Ἓ)
+ ("`(Ε" ?Ἓ)
+ ("´Ἐ" ?Ἔ)
+ ("'Ἐ" ?Ἔ)
+ ("´)Ε" ?Ἔ)
+ ("')Ε" ?Ἔ)
+ ("´Ἑ" ?Ἕ)
+ ("'Ἑ" ?Ἕ)
+ ("´(Ε" ?Ἕ)
+ ("'(Ε" ?Ἕ)
+ (")η" ?ἠ)
+ ("(η" ?ἡ)
+ ("`ἠ" ?ἢ)
+ ("`)η" ?ἢ)
+ ("`ἡ" ?ἣ)
+ ("`(η" ?ἣ)
+ ("´ἠ" ?ἤ)
+ ("'ἠ" ?ἤ)
+ ("´)η" ?ἤ)
+ ("')η" ?ἤ)
+ ("´ἡ" ?ἥ)
+ ("'ἡ" ?ἥ)
+ ("´(η" ?ἥ)
+ ("'(η" ?ἥ)
+ ("~ἠ" ?ἦ)
+ ("~)η" ?ἦ)
+ ("~ἡ" ?ἧ)
+ ("~(η" ?ἧ)
+ (")Η" ?Ἠ)
+ ("(Η" ?Ἡ)
+ ("`Ἠ" ?Ἢ)
+ ("`)Η" ?Ἢ)
+ ("`Ἡ" ?Ἣ)
+ ("`(Η" ?Ἣ)
+ ("´Ἠ" ?Ἤ)
+ ("'Ἠ" ?Ἤ)
+ ("´)Η" ?Ἤ)
+ ("')Η" ?Ἤ)
+ ("´Ἡ" ?Ἥ)
+ ("'Ἡ" ?Ἥ)
+ ("´(Η" ?Ἥ)
+ ("'(Η" ?Ἥ)
+ ("~Ἠ" ?Ἦ)
+ ("~)Η" ?Ἦ)
+ ("~Ἡ" ?Ἧ)
+ ("~(Η" ?Ἧ)
+ (")ι" ?ἰ)
+ ("(ι" ?ἱ)
+ ("`ἰ" ?ἲ)
+ ("`)ι" ?ἲ)
+ ("`ἱ" ?ἳ)
+ ("`(ι" ?ἳ)
+ ("´ἰ" ?ἴ)
+ ("'ἰ" ?ἴ)
+ ("´)ι" ?ἴ)
+ ("')ι" ?ἴ)
+ ("´ἱ" ?ἵ)
+ ("'ἱ" ?ἵ)
+ ("´(ι" ?ἵ)
+ ("'(ι" ?ἵ)
+ ("~ἰ" ?ἶ)
+ ("~)ι" ?ἶ)
+ ("~ἱ" ?ἷ)
+ ("~(ι" ?ἷ)
+ (")Ι" ?Ἰ)
+ ("(Ι" ?Ἱ)
+ ("`Ἰ" ?Ἲ)
+ ("`)Ι" ?Ἲ)
+ ("`Ἱ" ?Ἳ)
+ ("`(Ι" ?Ἳ)
+ ("´Ἰ" ?Ἴ)
+ ("'Ἰ" ?Ἴ)
+ ("´)Ι" ?Ἴ)
+ ("')Ι" ?Ἴ)
+ ("´Ἱ" ?Ἵ)
+ ("'Ἱ" ?Ἵ)
+ ("´(Ι" ?Ἵ)
+ ("'(Ι" ?Ἵ)
+ ("~Ἰ" ?Ἶ)
+ ("~)Ι" ?Ἶ)
+ ("~Ἱ" ?Ἷ)
+ ("~(Ι" ?Ἷ)
+ (")ο" ?ὀ)
+ ("(ο" ?ὁ)
+ ("`ὀ" ?ὂ)
+ ("`)ο" ?ὂ)
+ ("`ὁ" ?ὃ)
+ ("`(ο" ?ὃ)
+ ("´ὀ" ?ὄ)
+ ("'ὀ" ?ὄ)
+ ("´)ο" ?ὄ)
+ ("')ο" ?ὄ)
+ ("´ὁ" ?ὅ)
+ ("'ὁ" ?ὅ)
+ ("´(ο" ?ὅ)
+ ("'(ο" ?ὅ)
+ (")Ο" ?Ὀ)
+ ("(Ο" ?Ὁ)
+ ("`Ὀ" ?Ὂ)
+ ("`)Ο" ?Ὂ)
+ ("`Ὁ" ?Ὃ)
+ ("`(Ο" ?Ὃ)
+ ("´Ὀ" ?Ὄ)
+ ("'Ὀ" ?Ὄ)
+ ("´)Ο" ?Ὄ)
+ ("')Ο" ?Ὄ)
+ ("´Ὁ" ?Ὅ)
+ ("'Ὁ" ?Ὅ)
+ ("´(Ο" ?Ὅ)
+ ("'(Ο" ?Ὅ)
+ (")υ" ?ὐ)
+ ("(υ" ?ὑ)
+ ("`ὐ" ?ὒ)
+ ("`)υ" ?ὒ)
+ ("`ὑ" ?ὓ)
+ ("`(υ" ?ὓ)
+ ("´ὐ" ?ὔ)
+ ("'ὐ" ?ὔ)
+ ("´)υ" ?ὔ)
+ ("')υ" ?ὔ)
+ ("´ὑ" ?ὕ)
+ ("'ὑ" ?ὕ)
+ ("´(υ" ?ὕ)
+ ("'(υ" ?ὕ)
+ ("~ὐ" ?ὖ)
+ ("~)υ" ?ὖ)
+ ("~ὑ" ?ὗ)
+ ("~(υ" ?ὗ)
+ ("(Υ" ?Ὑ)
+ ("`Ὑ" ?Ὓ)
+ ("`(Υ" ?Ὓ)
+ ("´Ὑ" ?Ὕ)
+ ("'Ὑ" ?Ὕ)
+ ("´(Υ" ?Ὕ)
+ ("'(Υ" ?Ὕ)
+ ("~Ὑ" ?Ὗ)
+ ("~(Υ" ?Ὗ)
+ (")ω" ?ὠ)
+ ("(ω" ?ὡ)
+ ("`ὠ" ?ὢ)
+ ("`)ω" ?ὢ)
+ ("`ὡ" ?ὣ)
+ ("`(ω" ?ὣ)
+ ("´ὠ" ?ὤ)
+ ("'ὠ" ?ὤ)
+ ("´)ω" ?ὤ)
+ ("')ω" ?ὤ)
+ ("´ὡ" ?ὥ)
+ ("'ὡ" ?ὥ)
+ ("´(ω" ?ὥ)
+ ("'(ω" ?ὥ)
+ ("~ὠ" ?ὦ)
+ ("~)ω" ?ὦ)
+ ("~ὡ" ?ὧ)
+ ("~(ω" ?ὧ)
+ (")Ω" ?Ὠ)
+ ("(Ω" ?Ὡ)
+ ("`Ὠ" ?Ὢ)
+ ("`)Ω" ?Ὢ)
+ ("`Ὡ" ?Ὣ)
+ ("`(Ω" ?Ὣ)
+ ("´Ὠ" ?Ὤ)
+ ("'Ὠ" ?Ὤ)
+ ("´)Ω" ?Ὤ)
+ ("')Ω" ?Ὤ)
+ ("´Ὡ" ?Ὥ)
+ ("'Ὡ" ?Ὥ)
+ ("´(Ω" ?Ὥ)
+ ("'(Ω" ?Ὥ)
+ ("~Ὠ" ?Ὦ)
+ ("~)Ω" ?Ὦ)
+ ("~Ὡ" ?Ὧ)
+ ("~(Ω" ?Ὧ)
+ ("`α" ?ὰ)
+ ("`ε" ?ὲ)
+ ("`η" ?ὴ)
+ ("`ι" ?ὶ)
+ ("`ο" ?ὸ)
+ ("`υ" ?ὺ)
+ ("`ω" ?ὼ)
+ ("ιἀ" ?ᾀ)
+ ("ι)α" ?ᾀ)
+ ("ιἁ" ?ᾁ)
+ ("ι(α" ?ᾁ)
+ ("ιἂ" ?ᾂ)
+ ("ι`ἀ" ?ᾂ)
+ ("ι`)α" ?ᾂ)
+ ("ιἃ" ?ᾃ)
+ ("ι`ἁ" ?ᾃ)
+ ("ι`(α" ?ᾃ)
+ ("ιἄ" ?ᾄ)
+ ("ι´ἀ" ?ᾄ)
+ ("ι'ἀ" ?ᾄ)
+ ("ι´)α" ?ᾄ)
+ ("ι')α" ?ᾄ)
+ ("ιἅ" ?ᾅ)
+ ("ι´ἁ" ?ᾅ)
+ ("ι'ἁ" ?ᾅ)
+ ("ι´(α" ?ᾅ)
+ ("ι'(α" ?ᾅ)
+ ("ιἆ" ?ᾆ)
+ ("ι~ἀ" ?ᾆ)
+ ("ι~)α" ?ᾆ)
+ ("ιἇ" ?ᾇ)
+ ("ι~ἁ" ?ᾇ)
+ ("ι~(α" ?ᾇ)
+ ("ιἈ" ?ᾈ)
+ ("ι)Α" ?ᾈ)
+ ("ιἉ" ?ᾉ)
+ ("ι(Α" ?ᾉ)
+ ("ιἊ" ?ᾊ)
+ ("ι`Ἀ" ?ᾊ)
+ ("ι`)Α" ?ᾊ)
+ ("ιἋ" ?ᾋ)
+ ("ι`Ἁ" ?ᾋ)
+ ("ι`(Α" ?ᾋ)
+ ("ιἌ" ?ᾌ)
+ ("ι´Ἀ" ?ᾌ)
+ ("ι'Ἀ" ?ᾌ)
+ ("ι´)Α" ?ᾌ)
+ ("ι')Α" ?ᾌ)
+ ("ιἍ" ?ᾍ)
+ ("ι´Ἁ" ?ᾍ)
+ ("ι'Ἁ" ?ᾍ)
+ ("ι´(Α" ?ᾍ)
+ ("ι'(Α" ?ᾍ)
+ ("ιἎ" ?ᾎ)
+ ("ι~Ἀ" ?ᾎ)
+ ("ι~)Α" ?ᾎ)
+ ("ιἏ" ?ᾏ)
+ ("ι~Ἁ" ?ᾏ)
+ ("ι~(Α" ?ᾏ)
+ ("ιἠ" ?ᾐ)
+ ("ι)η" ?ᾐ)
+ ("ιἡ" ?ᾑ)
+ ("ι(η" ?ᾑ)
+ ("ιἢ" ?ᾒ)
+ ("ι`ἠ" ?ᾒ)
+ ("ι`)η" ?ᾒ)
+ ("ιἣ" ?ᾓ)
+ ("ι`ἡ" ?ᾓ)
+ ("ι`(η" ?ᾓ)
+ ("ιἤ" ?ᾔ)
+ ("ι´ἠ" ?ᾔ)
+ ("ι'ἠ" ?ᾔ)
+ ("ι´)η" ?ᾔ)
+ ("ι')η" ?ᾔ)
+ ("ιἥ" ?ᾕ)
+ ("ι´ἡ" ?ᾕ)
+ ("ι'ἡ" ?ᾕ)
+ ("ι´(η" ?ᾕ)
+ ("ι'(η" ?ᾕ)
+ ("ιἦ" ?ᾖ)
+ ("ι~ἠ" ?ᾖ)
+ ("ι~)η" ?ᾖ)
+ ("ιἧ" ?ᾗ)
+ ("ι~ἡ" ?ᾗ)
+ ("ι~(η" ?ᾗ)
+ ("ιἨ" ?ᾘ)
+ ("ι)Η" ?ᾘ)
+ ("ιἩ" ?ᾙ)
+ ("ι(Η" ?ᾙ)
+ ("ιἪ" ?ᾚ)
+ ("ι`Ἠ" ?ᾚ)
+ ("ι`)Η" ?ᾚ)
+ ("ιἫ" ?ᾛ)
+ ("ι`Ἡ" ?ᾛ)
+ ("ι`(Η" ?ᾛ)
+ ("ιἬ" ?ᾜ)
+ ("ι´Ἠ" ?ᾜ)
+ ("ι'Ἠ" ?ᾜ)
+ ("ι´)Η" ?ᾜ)
+ ("ι')Η" ?ᾜ)
+ ("ιἭ" ?ᾝ)
+ ("ι´Ἡ" ?ᾝ)
+ ("ι'Ἡ" ?ᾝ)
+ ("ι´(Η" ?ᾝ)
+ ("ι'(Η" ?ᾝ)
+ ("ιἮ" ?ᾞ)
+ ("ι~Ἠ" ?ᾞ)
+ ("ι~)Η" ?ᾞ)
+ ("ιἯ" ?ᾟ)
+ ("ι~Ἡ" ?ᾟ)
+ ("ι~(Η" ?ᾟ)
+ ("ιὠ" ?ᾠ)
+ ("ι)ω" ?ᾠ)
+ ("ιὡ" ?ᾡ)
+ ("ι(ω" ?ᾡ)
+ ("ιὢ" ?ᾢ)
+ ("ι`ὠ" ?ᾢ)
+ ("ι`)ω" ?ᾢ)
+ ("ιὣ" ?ᾣ)
+ ("ι`ὡ" ?ᾣ)
+ ("ι`(ω" ?ᾣ)
+ ("ιὤ" ?ᾤ)
+ ("ι´ὠ" ?ᾤ)
+ ("ι'ὠ" ?ᾤ)
+ ("ι´)ω" ?ᾤ)
+ ("ι')ω" ?ᾤ)
+ ("ιὥ" ?ᾥ)
+ ("ι´ὡ" ?ᾥ)
+ ("ι'ὡ" ?ᾥ)
+ ("ι´(ω" ?ᾥ)
+ ("ι'(ω" ?ᾥ)
+ ("ιὦ" ?ᾦ)
+ ("ι~ὠ" ?ᾦ)
+ ("ι~)ω" ?ᾦ)
+ ("ιὧ" ?ᾧ)
+ ("ι~ὡ" ?ᾧ)
+ ("ι~(ω" ?ᾧ)
+ ("ιὨ" ?ᾨ)
+ ("ι)Ω" ?ᾨ)
+ ("ιὩ" ?ᾩ)
+ ("ι(Ω" ?ᾩ)
+ ("ιὪ" ?ᾪ)
+ ("ι`Ὠ" ?ᾪ)
+ ("ι`)Ω" ?ᾪ)
+ ("ιὫ" ?ᾫ)
+ ("ι`Ὡ" ?ᾫ)
+ ("ι`(Ω" ?ᾫ)
+ ("ιὬ" ?ᾬ)
+ ("ι´Ὠ" ?ᾬ)
+ ("ι'Ὠ" ?ᾬ)
+ ("ι´)Ω" ?ᾬ)
+ ("ι')Ω" ?ᾬ)
+ ("ιὭ" ?ᾭ)
+ ("ι´Ὡ" ?ᾭ)
+ ("ι'Ὡ" ?ᾭ)
+ ("ι´(Ω" ?ᾭ)
+ ("ι'(Ω" ?ᾭ)
+ ("ιὮ" ?ᾮ)
+ ("ι~Ὠ" ?ᾮ)
+ ("ι~)Ω" ?ᾮ)
+ ("ιὯ" ?ᾯ)
+ ("ι~Ὡ" ?ᾯ)
+ ("ι~(Ω" ?ᾯ)
+ ("Uα" ?ᾰ)
+ ("bα" ?ᾰ)
+ ("¯α" ?ᾱ)
+ ("_α" ?ᾱ)
+ ("ιὰ" ?ᾲ)
+ ("ι`α" ?ᾲ)
+ ("ια" ?ᾳ)
+ ("ιά" ?ᾴ)
+ ("ι´α" ?ᾴ)
+ ("ι'α" ?ᾴ)
+ ("~α" ?ᾶ)
+ ("ιᾶ" ?ᾷ)
+ ("ι~α" ?ᾷ)
+ ("UΑ" ?Ᾰ)
+ ("bΑ" ?Ᾰ)
+ ("¯Α" ?Ᾱ)
+ ("_Α" ?Ᾱ)
+ ("`Α" ?Ὰ)
+ ("ιΑ" ?ᾼ)
+ ("¨~" ?῁)
+ ("ιὴ" ?ῂ)
+ ("ι`η" ?ῂ)
+ ("ιη" ?ῃ)
+ ("ιή" ?ῄ)
+ ("ι´η" ?ῄ)
+ ("ι'η" ?ῄ)
+ ("~η" ?ῆ)
+ ("ιῆ" ?ῇ)
+ ("ι~η" ?ῇ)
+ ("`Ε" ?Ὲ)
+ ("`Η" ?Ὴ)
+ ("ιΗ" ?ῌ)
+ ("᾿`" ?῍)
+ ("᾿´" ?῎)
+ ("᾿'" ?῎)
+ ("᾿~" ?῏)
+ ("Uι" ?ῐ)
+ ("bι" ?ῐ)
+ ("¯ι" ?ῑ)
+ ("_ι" ?ῑ)
+ ("`ϊ" ?ῒ)
+ ("`\"ι" ?ῒ)
+ ("~ι" ?ῖ)
+ ("~ϊ" ?ῗ)
+ ("~\"ι" ?ῗ)
+ ("UΙ" ?Ῐ)
+ ("bΙ" ?Ῐ)
+ ("¯Ι" ?Ῑ)
+ ("_Ι" ?Ῑ)
+ ("`Ι" ?Ὶ)
+ ("῾`" ?῝)
+ ("῾´" ?῞)
+ ("῾'" ?῞)
+ ("῾~" ?῟)
+ ("Uυ" ?ῠ)
+ ("bυ" ?ῠ)
+ ("¯υ" ?ῡ)
+ ("_υ" ?ῡ)
+ ("`ϋ" ?ῢ)
+ ("`\"υ" ?ῢ)
+ (")ρ" ?ῤ)
+ ("(ρ" ?ῥ)
+ ("~υ" ?ῦ)
+ ("~ϋ" ?ῧ)
+ ("~\"υ" ?ῧ)
+ ("UΥ" ?Ῠ)
+ ("bΥ" ?Ῠ)
+ ("¯Υ" ?Ῡ)
+ ("_Υ" ?Ῡ)
+ ("`Υ" ?Ὺ)
+ ("(Ρ" ?Ῥ)
+ ("¨`" ?῭)
+ ("ιὼ" ?ῲ)
+ ("ι`ω" ?ῲ)
+ ("ιω" ?ῳ)
+ ("ιώ" ?ῴ)
+ ("ι´ω" ?ῴ)
+ ("ι'ω" ?ῴ)
+ ("~ω" ?ῶ)
+ ("ιῶ" ?ῷ)
+ ("ι~ω" ?ῷ)
+ ("`Ο" ?Ὸ)
+ ("`Ω" ?Ὼ)
+ ("ιΩ" ?ῼ)
+ ("^0" ?⁰)
+ ("^_i" ?ⁱ)
+ ("^_i" ?ⁱ)
+ ("^4" ?⁴)
+ ("^5" ?⁵)
+ ("^6" ?⁶)
+ ("^7" ?⁷)
+ ("^8" ?⁸)
+ ("^9" ?⁹)
+ ("^+" ?⁺)
+ ("^−" ?⁻)
+ ("^=" ?⁼)
+ ("^(" ?⁽)
+ ("^)" ?⁾)
+ ("^_n" ?ⁿ)
+ ("^_n" ?ⁿ)
+ ("_0" ?₀)
+ ("_0" ?₀)
+ ("_1" ?₁)
+ ("_1" ?₁)
+ ("_2" ?₂)
+ ("_2" ?₂)
+ ("_3" ?₃)
+ ("_3" ?₃)
+ ("_4" ?₄)
+ ("_4" ?₄)
+ ("_5" ?₅)
+ ("_5" ?₅)
+ ("_6" ?₆)
+ ("_6" ?₆)
+ ("_7" ?₇)
+ ("_7" ?₇)
+ ("_8" ?₈)
+ ("_8" ?₈)
+ ("_9" ?₉)
+ ("_9" ?₉)
+ ("_+" ?₊)
+ ("_+" ?₊)
+ ("_−" ?₋)
+ ("_−" ?₋)
+ ("_=" ?₌)
+ ("_=" ?₌)
+ ("_(" ?₍)
+ ("_(" ?₍)
+ ("_)" ?₎)
+ ("_)" ?₎)
+ ("SM" ?℠)
+ ("sM" ?℠)
+ ("Sm" ?℠)
+ ("sm" ?℠)
+ ("TM" ?™)
+ ("tM" ?™)
+ ("Tm" ?™)
+ ("tm" ?™)
+ ("17" ?⅐)
+ ("19" ?⅑)
+ ("110" ?⅒)
+ ("13" ?⅓)
+ ("23" ?⅔)
+ ("15" ?⅕)
+ ("25" ?⅖)
+ ("35" ?⅗)
+ ("45" ?⅘)
+ ("16" ?⅙)
+ ("56" ?⅚)
+ ("18" ?⅛)
+ ("38" ?⅜)
+ ("58" ?⅝)
+ ("78" ?⅞)
+ ("03" ?↉)
+ ("/←" ?↚)
+ ("/→" ?↛)
+ ("/↔" ?↮)
+ ("<-" ?←)
+ ("->" ?→)
+ ("=>" ?⇒)
+ ("∄" ?∄)
+ ("{}" ?∅)
+ ("∉" ?∉)
+ ("∌" ?∌)
+ ("∤" ?∤)
+ ("∦" ?∦)
+ ("≁" ?≁)
+ ("≄" ?≄)
+ ("≁" ?≇)
+ ("≉" ?≉)
+ ("/=" ?≠)
+ ("=/" ?≠)
+ ("≠" ?≠)
+ ("≢" ?≢)
+ ("<=" ?≤)
+ (">=" ?≥)
+ ("≭" ?≭)
+ ("≮" ?≮)
+ ("≮" ?≮)
+ ("≯" ?≯)
+ ("≯" ?≯)
+ ("≰" ?≰)
+ ("≱" ?≱)
+ ("≴" ?≴)
+ ("≵" ?≵)
+ ("≸" ?≸)
+ ("≹" ?≹)
+ ("⊀" ?⊀)
+ ("⊁" ?⊁)
+ ("⊄" ?⊄)
+ ("⊄" ?⊄)
+ ("⊅" ?⊅)
+ ("⊅" ?⊅)
+ ("⊈" ?⊈)
+ ("⊉" ?⊉)
+ ("⊬" ?⊬)
+ ("⊭" ?⊭)
+ ("⊮" ?⊮)
+ ("⊯" ?⊯)
+ ("⋠" ?⋠)
+ ("⋡" ?⋡)
+ ("⋢" ?⋢)
+ ("⋣" ?⋣)
+ ("⋪" ?⋪)
+ ("⋫" ?⋫)
+ ("⋬" ?⋬)
+ ("⋭" ?⋭)
+ ("di" ?⌀)
+ ("(1)" ?①)
+ ("(2)" ?②)
+ ("(3)" ?③)
+ ("(4)" ?④)
+ ("(5)" ?⑤)
+ ("(6)" ?⑥)
+ ("(7)" ?⑦)
+ ("(8)" ?⑧)
+ ("(9)" ?⑨)
+ ("(10)" ?⑩)
+ ("(11)" ?⑪)
+ ("(12)" ?⑫)
+ ("(13)" ?⑬)
+ ("(14)" ?⑭)
+ ("(15)" ?⑮)
+ ("(16)" ?⑯)
+ ("(17)" ?⑰)
+ ("(18)" ?⑱)
+ ("(19)" ?⑲)
+ ("(20)" ?⑳)
+ ("(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)" ?Ⓩ)
+ ("(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)" ?ⓩ)
+ ("(0)" ?⓪)
+ ("⫝̸" ?⫝̸)
+ ("^一" ?㆒)
+ ("^二" ?㆓)
+ ("^三" ?㆔)
+ ("^四" ?㆕)
+ ("^上" ?㆖)
+ ("^中" ?㆗)
+ ("^下" ?㆘)
+ ("^甲" ?㆙)
+ ("^乙" ?㆚)
+ ("^丙" ?㆛)
+ ("^丁" ?㆜)
+ ("^天" ?㆝)
+ ("^地" ?㆞)
+ ("^人" ?㆟)
+ ("(21)" ?㉑)
+ ("(22)" ?㉒)
+ ("(23)" ?㉓)
+ ("(24)" ?㉔)
+ ("(25)" ?㉕)
+ ("(26)" ?㉖)
+ ("(27)" ?㉗)
+ ("(28)" ?㉘)
+ ("(29)" ?㉙)
+ ("(30)" ?㉚)
+ ("(31)" ?㉛)
+ ("(32)" ?㉜)
+ ("(33)" ?㉝)
+ ("(34)" ?㉞)
+ ("(35)" ?㉟)
+ ("(ᄀ)" ?㉠)
+ ("(ᄂ)" ?㉡)
+ ("(ᄃ)" ?㉢)
+ ("(ᄅ)" ?㉣)
+ ("(ᄆ)" ?㉤)
+ ("(ᄇ)" ?㉥)
+ ("(ᄉ)" ?㉦)
+ ("(ᄋ)" ?㉧)
+ ("(ᄌ)" ?㉨)
+ ("(ᄎ)" ?㉩)
+ ("(ᄏ)" ?㉪)
+ ("(ᄐ)" ?㉫)
+ ("(ᄑ)" ?㉬)
+ ("(ᄒ)" ?㉭)
+ ("(가)" ?㉮)
+ ("(나)" ?㉯)
+ ("(다)" ?㉰)
+ ("(라)" ?㉱)
+ ("(마)" ?㉲)
+ ("(바)" ?㉳)
+ ("(사)" ?㉴)
+ ("(아)" ?㉵)
+ ("(자)" ?㉶)
+ ("(차)" ?㉷)
+ ("(카)" ?㉸)
+ ("(타)" ?㉹)
+ ("(파)" ?㉺)
+ ("(하)" ?㉻)
+ ("(一)" ?㊀)
+ ("(二)" ?㊁)
+ ("(三)" ?㊂)
+ ("(四)" ?㊃)
+ ("(五)" ?㊄)
+ ("(六)" ?㊅)
+ ("(七)" ?㊆)
+ ("(八)" ?㊇)
+ ("(九)" ?㊈)
+ ("(十)" ?㊉)
+ ("(月)" ?㊊)
+ ("(火)" ?㊋)
+ ("(水)" ?㊌)
+ ("(木)" ?㊍)
+ ("(金)" ?㊎)
+ ("(土)" ?㊏)
+ ("(日)" ?㊐)
+ ("(株)" ?㊑)
+ ("(有)" ?㊒)
+ ("(社)" ?㊓)
+ ("(名)" ?㊔)
+ ("(特)" ?㊕)
+ ("(財)" ?㊖)
+ ("(祝)" ?㊗)
+ ("(労)" ?㊘)
+ ("(秘)" ?㊙)
+ ("(男)" ?㊚)
+ ("(女)" ?㊛)
+ ("(適)" ?㊜)
+ ("(優)" ?㊝)
+ ("(印)" ?㊞)
+ ("(注)" ?㊟)
+ ("(項)" ?㊠)
+ ("(休)" ?㊡)
+ ("(写)" ?㊢)
+ ("(正)" ?㊣)
+ ("(上)" ?㊤)
+ ("(中)" ?㊥)
+ ("(下)" ?㊦)
+ ("(左)" ?㊧)
+ ("(右)" ?㊨)
+ ("(医)" ?㊩)
+ ("(宗)" ?㊪)
+ ("(学)" ?㊫)
+ ("(監)" ?㊬)
+ ("(企)" ?㊭)
+ ("(資)" ?㊮)
+ ("(協)" ?㊯)
+ ("(夜)" ?㊰)
+ ("(36)" ?㊱)
+ ("(37)" ?㊲)
+ ("(38)" ?㊳)
+ ("(39)" ?㊴)
+ ("(40)" ?㊵)
+ ("(41)" ?㊶)
+ ("(42)" ?㊷)
+ ("(43)" ?㊸)
+ ("(44)" ?㊹)
+ ("(45)" ?㊺)
+ ("(46)" ?㊻)
+ ("(47)" ?㊼)
+ ("(48)" ?㊽)
+ ("(49)" ?㊾)
+ ("(50)" ?㊿)
+ ("(ア)" ?㋐)
+ ("(イ)" ?㋑)
+ ("(ウ)" ?㋒)
+ ("(エ)" ?㋓)
+ ("(オ)" ?㋔)
+ ("(カ)" ?㋕)
+ ("(キ)" ?㋖)
+ ("(ク)" ?㋗)
+ ("(ケ)" ?㋘)
+ ("(コ)" ?㋙)
+ ("(サ)" ?㋚)
+ ("(シ)" ?㋛)
+ ("(ス)" ?㋜)
+ ("(セ)" ?㋝)
+ ("(ソ)" ?㋞)
+ ("(タ)" ?㋟)
+ ("(チ)" ?㋠)
+ ("(ツ)" ?㋡)
+ ("(テ)" ?㋢)
+ ("(ト)" ?㋣)
+ ("(ナ)" ?㋤)
+ ("(ニ)" ?㋥)
+ ("(ヌ)" ?㋦)
+ ("(ネ)" ?㋧)
+ ("(ノ)" ?㋨)
+ ("(ハ)" ?㋩)
+ ("(ヒ)" ?㋪)
+ ("(フ)" ?㋫)
+ ("(ヘ)" ?㋬)
+ ("(ホ)" ?㋭)
+ ("(マ)" ?㋮)
+ ("(ミ)" ?㋯)
+ ("(ム)" ?㋰)
+ ("(メ)" ?㋱)
+ ("(モ)" ?㋲)
+ ("(ヤ)" ?㋳)
+ ("(ユ)" ?㋴)
+ ("(ヨ)" ?㋵)
+ ("(ラ)" ?㋶)
+ ("(リ)" ?㋷)
+ ("(ル)" ?㋸)
+ ("(レ)" ?㋹)
+ ("(ロ)" ?㋺)
+ ("(ワ)" ?㋻)
+ ("(ヰ)" ?㋼)
+ ("(ヱ)" ?㋽)
+ ("(ヲ)" ?㋾)
+ ("ִי" ?יִ)
+ ("ַײ" ?ײַ)
+ ("ׁש" ?שׁ)
+ ("ׂש" ?שׂ)
+ ("ׁשּ" ?שּׁ)
+ ("ּׁש" ?שּׁ)
+ ("ׂשּ" ?שּׂ)
+ ("ּׂש" ?שּׂ)
+ ("ַא" ?אַ)
+ ("ָא" ?אָ)
+ ("ּא" ?אּ)
+ ("ּב" ?בּ)
+ ("ּג" ?גּ)
+ ("ּד" ?דּ)
+ ("ּה" ?הּ)
+ ("ּו" ?וּ)
+ ("ּז" ?זּ)
+ ("ּט" ?טּ)
+ ("ּי" ?יּ)
+ ("ּך" ?ךּ)
+ ("ּכ" ?כּ)
+ ("ּל" ?לּ)
+ ("ּמ" ?מּ)
+ ("ּנ" ?נּ)
+ ("ּס" ?סּ)
+ ("ּף" ?ףּ)
+ ("ּפ" ?פּ)
+ ("ּצ" ?צּ)
+ ("ּק" ?קּ)
+ ("ּר" ?רּ)
+ ("ּש" ?שּ)
+ ("ּת" ?תּ)
+ ("ֹו" ?וֹ)
+ ("ֿב" ?בֿ)
+ ("ֿכ" ?כֿ)
+ ("ֿפ" ?פֿ)
+ ("𝅗𝅥" ?𝅗𝅥)
+ ("𝅘𝅥" ?𝅘𝅥)
+ ("𝅘𝅥𝅮" ?𝅘𝅥𝅮)
+ ("𝅘𝅥𝅯" ?𝅘𝅥𝅯)
+ ("𝅘𝅥𝅰" ?𝅘𝅥𝅰)
+ ("𝅘𝅥𝅱" ?𝅘𝅥𝅱)
+ ("𝅘𝅥𝅲" ?𝅘𝅥𝅲)
+ ("𝆹𝅥" ?𝆹𝅥)
+ ("𝆺𝅥" ?𝆺𝅥)
+ ("𝆹𝅥𝅮" ?𝆹𝅥𝅮)
+ ("𝆺𝅥𝅮" ?𝆺𝅥𝅮)
+ ("𝆹𝅥𝅯" ?𝆹𝅥𝅯)
+ ("𝆺𝅥𝅯" ?𝆺𝅥𝅯)
+ (";S" ?Ș)
+ ("S;" ?Ș)
+ (";s" ?ș)
+ ("s;" ?ș)
+ (";T" ?Ț)
+ ("T;" ?Ț)
+ (";t" ?ț)
+ ("t;" ?ț)
+ ("``а" ["а̏"])
+ ("`а" ["а̀"])
+ ("´а" ["а́"])
+ ("'а" ["а́"])
+ ("¯а" ["а̄"])
+ ("_а" ["а̄"])
+ ("^а" ["а̂"])
+ ("``А" ["А̏"])
+ ("`А" ["А̀"])
+ ("´А" ["А́"])
+ ("'А" ["А́"])
+ ("¯А" ["А̄"])
+ ("_А" ["А̄"])
+ ("^А" ["А̂"])
+ ("``е" ["е̏"])
+ ("´е" ["е́"])
+ ("'е" ["е́"])
+ ("¯е" ["е̄"])
+ ("_е" ["е̄"])
+ ("^е" ["е̂"])
+ ("``Е" ["Е̏"])
+ ("´Е" ["Е́"])
+ ("'Е" ["Е́"])
+ ("¯Е" ["Е̄"])
+ ("_Е" ["Е̄"])
+ ("^Е" ["Е̂"])
+ ("``и" ["и̏"])
+ ("´и" ["и́"])
+ ("'и" ["и́"])
+ ("^и" ["и̂"])
+ ("``И" ["И̏"])
+ ("´И" ["И́"])
+ ("'И" ["И́"])
+ ("^И" ["И̂"])
+ ("``о" ["о̏"])
+ ("`о" ["о̀"])
+ ("´о" ["о́"])
+ ("'о" ["о́"])
+ ("¯о" ["о̄"])
+ ("_о" ["о̄"])
+ ("^о" ["о̂"])
+ ("``О" ["О̏"])
+ ("`О" ["О̀"])
+ ("´О" ["О́"])
+ ("'О" ["О́"])
+ ("¯О" ["О̄"])
+ ("_О" ["О̄"])
+ ("^О" ["О̂"])
+ ("``у" ["у̏"])
+ ("`у" ["у̀"])
+ ("´у" ["у́"])
+ ("'у" ["у́"])
+ ("^у" ["у̂"])
+ ("``У" ["У̏"])
+ ("`У" ["У̀"])
+ ("´У" ["У́"])
+ ("'У" ["У́"])
+ ("^У" ["У̂"])
+ ("``р" ["р̏"])
+ ("`р" ["р̀"])
+ ("´р" ["р́"])
+ ("'р" ["р́"])
+ ("¯р" ["р̄"])
+ ("_р" ["р̄"])
+ ("^р" ["р̂"])
+ ("``Р" ["Р̏"])
+ ("`Р" ["Р̀"])
+ ("´Р" ["Р́"])
+ ("'Р" ["Р́"])
+ ("¯Р" ["Р̄"])
+ ("_Р" ["Р̄"])
+ ("^Р" ["Р̂"])
+ ("v/" ?√)
+ ("/v" ?√)
+ ("88" ?∞)
+ ("=_" ?≡)
+ ("_≠" ?≢)
+ ("≠_" ?≢)
+ ("<_" ?≤)
+ ("_<" ?≤)
+ (">_" ?≥)
+ ("_>" ?≥)
+ ("_⊂" ?⊆)
+ ("⊂_" ?⊆)
+ ("_⊃" ?⊇)
+ ("⊃_" ?⊇)
+ ("○-" ?⊖)
+ ("-○" ?⊖)
+ ("○." ?⊙)
+ (".○" ?⊙)
+ ("<>" ?⋄)
+ ("><" ?⋄)
+ ("∧∨" ?⋄)
+ ("∨∧" ?⋄)
+ (":." ?∴)
+ (".:" ?∵)
+ ("⊥⊤" ?⌶)
+ ("⊤⊥" ?⌶)
+ ("[]" ?⌷)
+ ("][" ?⌷)
+ ("⎕=" ?⌸)
+ ("=⎕" ?⌸)
+ ("⎕÷" ?⌹)
+ ("÷⎕" ?⌹)
+ ("⎕⋄" ?⌺)
+ ("⋄⎕" ?⌺)
+ ("⎕∘" ?⌻)
+ ("∘⎕" ?⌻)
+ ("⎕○" ?⌼)
+ ("○⎕" ?⌼)
+ ("○|" ?⌽)
+ ("|○" ?⌽)
+ ("○∘" ?⌾)
+ ("∘○" ?⌾)
+ ("/-" ?⌿)
+ ("-/" ?⌿)
+ ("\\-" ?⍀)
+ ("-\\" ?⍀)
+ ("/⎕" ?⍁)
+ ("⎕/" ?⍁)
+ ("\\⎕" ?⍂)
+ ("⎕\\" ?⍂)
+ ("<⎕" ?⍃)
+ ("⎕<" ?⍃)
+ (">⎕" ?⍄)
+ ("⎕>" ?⍄)
+ ("←|" ?⍅)
+ ("|←" ?⍅)
+ ("→|" ?⍆)
+ ("|→" ?⍆)
+ ("←⎕" ?⍇)
+ ("⎕←" ?⍇)
+ ("→⎕" ?⍈)
+ ("⎕→" ?⍈)
+ ("○\\" ?⍉)
+ ("\\○" ?⍉)
+ ("_⊥" ?⍊)
+ ("⊥_" ?⍊)
+ ("∆|" ?⍋)
+ ("|∆" ?⍋)
+ ("∨⎕" ?⍌)
+ ("⎕∨" ?⍌)
+ ("∆⎕" ?⍍)
+ ("⎕∆" ?⍍)
+ ("∘⊥" ?⍎)
+ ("⊥∘" ?⍎)
+ ("↑-" ?⍏)
+ ("-↑" ?⍏)
+ ("↑⎕" ?⍐)
+ ("⎕↑" ?⍐)
+ ("¯⊤" ?⍑)
+ ("⊤¯" ?⍑)
+ ("∇|" ?⍒)
+ ("|∇" ?⍒)
+ ("∧⎕" ?⍓)
+ ("⎕∧" ?⍓)
+ ("∇⎕" ?⍔)
+ ("⎕∇" ?⍔)
+ ("∘⊤" ?⍕)
+ ("⊤∘" ?⍕)
+ ("↓-" ?⍖)
+ ("-↓" ?⍖)
+ ("↓⎕" ?⍗)
+ ("⎕↓" ?⍗)
+ ("_'" ?⍘)
+ ("∆_" ?⍙)
+ ("_∆" ?⍙)
+ ("⋄_" ?⍚)
+ ("_⋄" ?⍚)
+ ("∘_" ?⍛)
+ ("_∘" ?⍛)
+ ("○_" ?⍜)
+ ("_○" ?⍜)
+ ("∘∩" ?⍝)
+ ("∩∘" ?⍝)
+ ("⎕'" ?⍞)
+ ("'⎕" ?⍞)
+ ("○*" ?⍟)
+ ("*○" ?⍟)
+ (":⎕" ?⍠)
+ ("⎕:" ?⍠)
+ ("¨⊤" ?⍡)
+ ("⊤¨" ?⍡)
+ ("¨∇" ?⍢)
+ ("∇¨" ?⍢)
+ ("*¨" ?⍣)
+ ("¨*" ?⍣)
+ ("∘¨" ?⍤)
+ ("¨∘" ?⍤)
+ ("○¨" ?⍥)
+ ("¨○" ?⍥)
+ ("∪|" ?⍦)
+ ("|∪" ?⍦)
+ ("⊂|" ?⍧)
+ ("|⊂" ?⍧)
+ ("~¨" ?⍨)
+ ("¨>" ?⍩)
+ (">¨" ?⍩)
+ ("∇~" ?⍫)
+ ("~∇" ?⍫)
+ ("0~" ?⍬)
+ ("~0" ?⍬)
+ ("|~" ?⍭)
+ ("~|" ?⍭)
+ (";_" ?⍮)
+ ("≠⎕" ?⍯)
+ ("⎕≠" ?⍯)
+ ("?⎕" ?⍰)
+ ("⎕?" ?⍰)
+ ("∨~" ?⍱)
+ ("~∨" ?⍱)
+ ("∧~" ?⍲)
+ ("~∧" ?⍲)
+ ("⍺_" ?⍶)
+ ("_⍺" ?⍶)
+ ("∊_" ?⍷)
+ ("_∊" ?⍷)
+ ("⍳_" ?⍸)
+ ("_⍳" ?⍸)
+ ("⍵_" ?⍹)
+ ("_⍵" ?⍹)
+ )
+
+;; Quail package `iso-transl' is based on `C-x 8' key sequences.
+;; This input method supports the same key sequences as defined
+;; by the `C-x 8' keymap in iso-transl.el.
+
+(quail-define-package
+ "iso-transl" "UTF-8" "X8" t
+ "Use the same key sequences as in `C-x 8' keymap defined in iso-transl.el.
+Examples:
+ * E -> € 1 / 2 -> ½ ^ 3 -> ³"
+ '(("\t" . quail-completion))
+ t nil nil nil nil nil nil nil nil t)
+
+(eval-when-compile
+ (require 'iso-transl)
+ (defmacro iso-transl--define-rules ()
+ `(quail-define-rules
+ ,@(mapcar (lambda (rule)
+ (let ((from (car rule))
+ (to (cdr rule)))
+ (list from (if (stringp to)
+ (vector to)
+ to))))
+ iso-transl-char-map))))
+
+(iso-transl--define-rules)
+
+(provide 'compose)
+;;; compose.el ends here
diff --git a/lisp/leim/quail/croatian.el b/lisp/leim/quail/croatian.el
index 97bfb855fb3..08f1e47b6f3 100644
--- a/lisp/leim/quail/croatian.el
+++ b/lisp/leim/quail/croatian.el
@@ -1,6 +1,6 @@
-;;; croatian.el -- Quail package for inputting Croatian -*-coding: utf-8;-*-
+;;; croatian.el -- Quail package for inputting Croatian -*-coding: utf-8; lexical-binding:t -*-
-;; Copyright (C) 2003-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
;; Author: Hrvoje Nikšić <hrvoje.niksic@avl.com>
;; Keywords: i18n
diff --git a/lisp/leim/quail/cyril-jis.el b/lisp/leim/quail/cyril-jis.el
index 6109dfc0e08..689f738f5ee 100644
--- a/lisp/leim/quail/cyril-jis.el
+++ b/lisp/leim/quail/cyril-jis.el
@@ -1,6 +1,6 @@
-;;; cyril-jis.el --- Quail package for inputting JISX0208 Cyrillic letters
+;;; cyril-jis.el --- Quail package for inputting JISX0208 Cyrillic letters -*- lexical-binding: t -*-
-;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/leim/quail/cyrillic.el b/lisp/leim/quail/cyrillic.el
index 8845223e9a8..3654aca192c 100644
--- a/lisp/leim/quail/cyrillic.el
+++ b/lisp/leim/quail/cyrillic.el
@@ -1,6 +1,6 @@
-;;; cyrillic.el --- Quail package for inputting Cyrillic characters
+;;; cyrillic.el --- Quail package for inputting Cyrillic characters -*- lexical-binding: t -*-
-;; Copyright (C) 1997-1998, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/leim/quail/czech.el b/lisp/leim/quail/czech.el
index 7c208ef15e2..78b50117225 100644
--- a/lisp/leim/quail/czech.el
+++ b/lisp/leim/quail/czech.el
@@ -1,6 +1,6 @@
-;;; czech.el --- Quail package for inputting Czech -*-coding: utf-8;-*-
+;;; czech.el --- Quail package for inputting Czech -*-coding: utf-8; lexical-binding:t -*-
-;; Copyright (C) 1998, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2001-2021 Free Software Foundation, Inc.
;; Author: Milan Zamazal <pdm@zamazal.org>
;; Maintainer: Pavel Janík <Pavel@Janik.cz>
diff --git a/lisp/leim/quail/ethiopic.el b/lisp/leim/quail/ethiopic.el
index 8d19a233709..c8753effe0a 100644
--- a/lisp/leim/quail/ethiopic.el
+++ b/lisp/leim/quail/ethiopic.el
@@ -1,4 +1,4 @@
-;;; ethiopic.el --- Quail package for inputting Ethiopic characters -*-coding: utf-8-emacs;-*-
+;;; ethiopic.el --- Quail package for inputting Ethiopic characters -*-coding: utf-8-emacs; lexical-binding:t -*-
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010, 2011
diff --git a/lisp/leim/quail/georgian.el b/lisp/leim/quail/georgian.el
index b6da6befe12..2389d8138ae 100644
--- a/lisp/leim/quail/georgian.el
+++ b/lisp/leim/quail/georgian.el
@@ -1,6 +1,6 @@
-;;; georgian.el --- Quail package for inputting Georgian characters -*-coding: utf-8;-*-
+;;; georgian.el --- Quail package for inputting Georgian characters -*- coding: utf-8; lexical-binding:t -*-
-;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: i18n
diff --git a/lisp/leim/quail/greek.el b/lisp/leim/quail/greek.el
index 14bbacc4a39..89ebd447471 100644
--- a/lisp/leim/quail/greek.el
+++ b/lisp/leim/quail/greek.el
@@ -1,6 +1,6 @@
-;;; greek.el --- Quail package for inputting Greek -*-coding: utf-8-*-
+;;; greek.el --- Quail package for inputting Greek -*- coding: utf-8; lexical-binding:t -*-
-;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/leim/quail/hangul.el b/lisp/leim/quail/hangul.el
index b8562556eff..20762d36f07 100644
--- a/lisp/leim/quail/hangul.el
+++ b/lisp/leim/quail/hangul.el
@@ -1,6 +1,6 @@
;;; hangul.el --- Korean Hangul input method
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Jihyun Cho <jihyun.jo@gmail.com>
;; Keywords: multilingual, input method, Korean, Hangul
@@ -525,7 +525,7 @@ HELP-TEXT is a text set in `hangul-input-method-help-text'."
(quail-delete-overlays)
(if (eq (selected-window) (minibuffer-window))
(add-hook 'minibuffer-exit-hook 'quail-exit-from-minibuffer))
- (set (make-local-variable 'input-method-function) func))
+ (setq-local input-method-function func))
(defun hangul-input-method-deactivate ()
"Deactivate the current Hangul input method."
diff --git a/lisp/leim/quail/hanja-jis.el b/lisp/leim/quail/hanja-jis.el
index 6f753259456..c4eb4b57be8 100644
--- a/lisp/leim/quail/hanja-jis.el
+++ b/lisp/leim/quail/hanja-jis.el
@@ -1,4 +1,4 @@
-;;; hanja-jis.el --- Quail package for inputting Korean Hanja (JISX0208)
+;;; hanja-jis.el --- Quail package for inputting Korean Hanja (JISX0208) -*- lexical-binding: t -*-
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010, 2011
diff --git a/lisp/leim/quail/hanja.el b/lisp/leim/quail/hanja.el
index 455af12b0a9..7095bcf38ae 100644
--- a/lisp/leim/quail/hanja.el
+++ b/lisp/leim/quail/hanja.el
@@ -1,6 +1,6 @@
-;;; hanja.el --- Quail-package for Korean Hanja (KSC5601) -*-coding: utf-8;-*-
+;;; hanja.el --- Quail-package for Korean Hanja (KSC5601) -*-coding: utf-8; lexical-binding: t -*-
-;; Copyright (C) 1997, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/leim/quail/hanja3.el b/lisp/leim/quail/hanja3.el
index f318c01bea4..080ba0e0fde 100644
--- a/lisp/leim/quail/hanja3.el
+++ b/lisp/leim/quail/hanja3.el
@@ -1,6 +1,6 @@
-;;; hanja3.el --- Quail-package for Korean Hanja (KSC5601) -*-coding: utf-8;-*-
+;;; hanja3.el --- Quail-package for Korean Hanja (KSC5601) -*-coding: utf-8; lexical-binding: t -*-
-;; Copyright (C) 1997, 1999, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1999, 2001-2021 Free Software Foundation, Inc.
;; Author: Koaunghi Un <koaunghi.un@zdv.uni-tuebingen.de>
;; Keywords: mule, quail, multilingual, input method, Korean, Hanja
diff --git a/lisp/leim/quail/hebrew.el b/lisp/leim/quail/hebrew.el
index 772da70b5ce..fc6bb80596b 100644
--- a/lisp/leim/quail/hebrew.el
+++ b/lisp/leim/quail/hebrew.el
@@ -1,4 +1,4 @@
-;; hebrew.el --- Quail package for inputting Hebrew characters -*-coding: utf-8;-*-
+;; hebrew.el --- Quail package for inputting Hebrew characters -*- coding: utf-8; lexical-binding: t -*-
;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
;; 2008, 2009, 2010, 2011
diff --git a/lisp/leim/quail/indian.el b/lisp/leim/quail/indian.el
index 100ae63f6ac..6f5054e3f62 100644
--- a/lisp/leim/quail/indian.el
+++ b/lisp/leim/quail/indian.el
@@ -1,6 +1,6 @@
;;; indian.el --- Quail packages for inputting Indian
-;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;; Author: KAWABATA, Taichi <kawabata@m17n.org>
diff --git a/lisp/leim/quail/ipa-praat.el b/lisp/leim/quail/ipa-praat.el
index 4c241ccf8ea..0920bc79009 100644
--- a/lisp/leim/quail/ipa-praat.el
+++ b/lisp/leim/quail/ipa-praat.el
@@ -1,6 +1,6 @@
-;;; ipa-praat.el --- Inputting IPA characters with the conventions of Praat
+;;; ipa-praat.el --- Inputting IPA characters with the conventions of Praat -*- lexical-binding: t -*-
-;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
;; Author: Oliver Scholz <epameinondas@gmx.de>
;; Keywords: multilingual, input method, IPA
diff --git a/lisp/leim/quail/ipa.el b/lisp/leim/quail/ipa.el
index cbc555d1faa..d9f58885f20 100644
--- a/lisp/leim/quail/ipa.el
+++ b/lisp/leim/quail/ipa.el
@@ -1,6 +1,6 @@
;;; ipa.el --- Quail package for inputting IPA characters -*-coding: utf-8;-*-
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/leim/quail/japanese.el b/lisp/leim/quail/japanese.el
index 37479974265..d7249d286fb 100644
--- a/lisp/leim/quail/japanese.el
+++ b/lisp/leim/quail/japanese.el
@@ -1,6 +1,6 @@
;;; japanese.el --- Quail package for inputting Japanese
-;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/leim/quail/latin-alt.el b/lisp/leim/quail/latin-alt.el
index 06ab5e3d111..0db952b67c4 100644
--- a/lisp/leim/quail/latin-alt.el
+++ b/lisp/leim/quail/latin-alt.el
@@ -1,6 +1,6 @@
-;;; latin-alt.el --- Quail package for inputting various European characters -*-coding: utf-8;-*-
+;;; latin-alt.el --- Quail package for inputting various European characters -*-coding: utf-8; lexical-binding: t -*-
-;; Copyright (C) 1997-1998, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
;; 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/leim/quail/latin-ltx.el b/lisp/leim/quail/latin-ltx.el
index 6a2508ba31d..fd78253c4fb 100644
--- a/lisp/leim/quail/latin-ltx.el
+++ b/lisp/leim/quail/latin-ltx.el
@@ -1,6 +1,6 @@
;;; latin-ltx.el --- Quail package for TeX-style input -*-coding: utf-8;-*-
-;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
;; 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -8,7 +8,7 @@
;; Author: TAKAHASHI Naoto <ntakahas@m17n.org>
;; Dave Love <fx@gnu.org>
-;; Keywords: multilingual, input, Greek, i18n
+;; Keywords: multilingual, input method, i18n
;; This file is part of GNU Emacs.
diff --git a/lisp/leim/quail/latin-post.el b/lisp/leim/quail/latin-post.el
index 1d6aeddc060..8e21ed80130 100644
--- a/lisp/leim/quail/latin-post.el
+++ b/lisp/leim/quail/latin-post.el
@@ -1,6 +1,6 @@
-;;; latin-post.el --- Quail packages for inputting various European characters -*-coding: utf-8;-*-
+;;; latin-post.el --- Quail packages for inputting various European characters -*-coding: utf-8; lexical-binding: t -*-
-;; Copyright (C) 1997-1998, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/leim/quail/latin-pre.el b/lisp/leim/quail/latin-pre.el
index f421a7eb1d2..22006547c45 100644
--- a/lisp/leim/quail/latin-pre.el
+++ b/lisp/leim/quail/latin-pre.el
@@ -1,6 +1,6 @@
-;;; latin-pre.el --- Quail packages for inputting various European characters -*-coding: utf-8;-*-
+;;; latin-pre.el --- Quail packages for inputting various European characters -*-coding: utf-8; lexical-binding: t -*-
-;; Copyright (C) 1997-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/leim/quail/lrt.el b/lisp/leim/quail/lrt.el
index 5b0988693f4..e05bc1e6cb7 100644
--- a/lisp/leim/quail/lrt.el
+++ b/lisp/leim/quail/lrt.el
@@ -1,6 +1,6 @@
;;; lrt.el --- Quail package for inputting Lao characters by LRT method -*-coding: utf-8;-*-
-;; Copyright (C) 1998, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/leim/quail/persian.el b/lisp/leim/quail/persian.el
index f12abc1ac9d..4157f886704 100644
--- a/lisp/leim/quail/persian.el
+++ b/lisp/leim/quail/persian.el
@@ -1,6 +1,6 @@
-;;; persian.el --- Quail package for inputting Persian/Farsi keyboard -*- coding: utf-8;-*-
+;;; persian.el --- Quail package for inputting Persian/Farsi keyboard -*- coding: utf-8; lexical-binding: t -*-
-;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
;; Author: Mohsen BANAN <libre@mohsen.1.banan.byname.net>
;; X-URL: http://mohsen.1.banan.byname.net/contact
diff --git a/lisp/leim/quail/programmer-dvorak.el b/lisp/leim/quail/programmer-dvorak.el
index 0429df01de0..49f9d82bc0d 100644
--- a/lisp/leim/quail/programmer-dvorak.el
+++ b/lisp/leim/quail/programmer-dvorak.el
@@ -1,6 +1,6 @@
-;;; programmer-dvorak.el --- Quail package for the programmer Dvorak layout
+;;; programmer-dvorak.el --- Quail package for the programmer Dvorak layout -*- lexical-binding: t -*-
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Author: Joakim Jalap <joakim.jalap@fastmail.com>
diff --git a/lisp/leim/quail/py-punct.el b/lisp/leim/quail/py-punct.el
index 90fa474dd06..2a61795a135 100644
--- a/lisp/leim/quail/py-punct.el
+++ b/lisp/leim/quail/py-punct.el
@@ -1,6 +1,6 @@
-;;; py-punct.el --- Quail packages for Chinese (pinyin + extra symbols)
+;;; py-punct.el --- Quail packages for Chinese (pinyin + extra symbols) -*- lexical-binding: t -*-
-;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/leim/quail/pypunct-b5.el b/lisp/leim/quail/pypunct-b5.el
index 9f4e73c9f05..f9330bd24f9 100644
--- a/lisp/leim/quail/pypunct-b5.el
+++ b/lisp/leim/quail/pypunct-b5.el
@@ -1,4 +1,4 @@
-;;; pypunct-b5.el --- Quail packages for Chinese (pinyin + extra symbols)
+;;; pypunct-b5.el --- Quail packages for Chinese (pinyin + extra symbols) -*- lexical-binding: t -*-
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010, 2011
diff --git a/lisp/leim/quail/rfc1345.el b/lisp/leim/quail/rfc1345.el
index c2e7cd9fad3..a07208294f7 100644
--- a/lisp/leim/quail/rfc1345.el
+++ b/lisp/leim/quail/rfc1345.el
@@ -1,6 +1,6 @@
-;;; rfc1345.el --- Quail method for RFC 1345 mnemonics -*- coding: utf-8 -*-
+;;; rfc1345.el --- Quail method for RFC 1345 mnemonics -*- coding: utf-8; lexical-binding: t -*-
-;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: i18n
diff --git a/lisp/leim/quail/sami.el b/lisp/leim/quail/sami.el
index 66750c31406..6c9b2d99cc0 100644
--- a/lisp/leim/quail/sami.el
+++ b/lisp/leim/quail/sami.el
@@ -1,6 +1,6 @@
-;;; sami.el --- Quail package for inputting Sámi -*-coding: utf-8;-*-
+;;; sami.el --- Quail package for inputting Sámi -*-coding: utf-8; lexical-binding: t -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; Author: Wojciech S. Gac <wojciech.s.gac@gmail.com>
;; Keywords: i18n, multilingual, input method, Sámi
diff --git a/lisp/leim/quail/sgml-input.el b/lisp/leim/quail/sgml-input.el
index 5cc9f5e0ccc..68add78e29d 100644
--- a/lisp/leim/quail/sgml-input.el
+++ b/lisp/leim/quail/sgml-input.el
@@ -1,6 +1,6 @@
-;;; sgml-input.el --- Quail method for Unicode entered as SGML entities -*- coding: utf-8 -*-
+;;; sgml-input.el --- Quail method for Unicode entered as SGML entities -*- coding: utf-8; lexical-binding: t -*-
-;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: i18n
diff --git a/lisp/leim/quail/sisheng.el b/lisp/leim/quail/sisheng.el
index 7e25fbe12e3..8e7a500276a 100644
--- a/lisp/leim/quail/sisheng.el
+++ b/lisp/leim/quail/sisheng.el
@@ -1,6 +1,6 @@
;;; sisheng.el --- sisheng input method for Chinese pinyin transliteration
-;; Copyright (C) 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;; Author: Werner LEMBERG <wl@gnu.org>
diff --git a/lisp/leim/quail/slovak.el b/lisp/leim/quail/slovak.el
index 828d25a2e32..53780cfd4a5 100644
--- a/lisp/leim/quail/slovak.el
+++ b/lisp/leim/quail/slovak.el
@@ -1,6 +1,6 @@
-;;; slovak.el --- Quail package for inputting Slovak -*-coding: utf-8;-*-
+;;; slovak.el --- Quail package for inputting Slovak -*-coding: utf-8; lexical-binding: t -*-
-;; Copyright (C) 1998, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2001-2021 Free Software Foundation, Inc.
;; Authors: Tibor Šimko <tibor.simko@fmph.uniba.sk>
;; Milan Zamazal <pdm@zamazal.org>
diff --git a/lisp/leim/quail/symbol-ksc.el b/lisp/leim/quail/symbol-ksc.el
index ae33786c5ea..0583d64c2b6 100644
--- a/lisp/leim/quail/symbol-ksc.el
+++ b/lisp/leim/quail/symbol-ksc.el
@@ -1,6 +1,6 @@
-;;; symbol-ksc.el --- Quail-package for Korean Symbol (KSC5601) -*-coding: utf-8;-*-
+;;; symbol-ksc.el --- Quail-package for Korean Symbol (KSC5601) -*-coding: utf-8; lexical-binding: t -*-
-;; Copyright (C) 1997, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/leim/quail/tamil-dvorak.el b/lisp/leim/quail/tamil-dvorak.el
index 93ff0ccdac6..b2d48afa0a7 100644
--- a/lisp/leim/quail/tamil-dvorak.el
+++ b/lisp/leim/quail/tamil-dvorak.el
@@ -1,6 +1,6 @@
-;;; tamil-dvorak.el --- Quail package for Tamil input with Dvorak keyboard
+;;; tamil-dvorak.el --- Quail package for Tamil input with Dvorak keyboard -*- lexical-binding: t -*-
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Author: Shakthi Kannan <author@shakthimaan.com>
diff --git a/lisp/leim/quail/tibetan.el b/lisp/leim/quail/tibetan.el
index dad4950f6e3..a54763d56f6 100644
--- a/lisp/leim/quail/tibetan.el
+++ b/lisp/leim/quail/tibetan.el
@@ -1,6 +1,6 @@
;;; tibetan.el --- Quail package for inputting Tibetan characters -*-coding: utf-8-emacs;-*-
-;; Copyright (C) 1997, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/leim/quail/uni-input.el b/lisp/leim/quail/uni-input.el
index 6f1fbcc9e5a..c7cf6abe2aa 100644
--- a/lisp/leim/quail/uni-input.el
+++ b/lisp/leim/quail/uni-input.el
@@ -1,6 +1,6 @@
;;; uni-input.el --- Hex Unicode input method
-;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
@@ -105,8 +105,7 @@ While this input method is active, the variable
(quail-delete-overlays)
(if (eq (selected-window) (minibuffer-window))
(add-hook 'minibuffer-exit-hook 'quail-exit-from-minibuffer))
- (set (make-local-variable 'input-method-function)
- 'ucs-input-method)))
+ (setq-local input-method-function 'ucs-input-method)))
(defun ucs-input-deactivate ()
"Deactivate UCS input method."
diff --git a/lisp/leim/quail/vntelex.el b/lisp/leim/quail/vntelex.el
index 385bc910bba..22d23d47474 100644
--- a/lisp/leim/quail/vntelex.el
+++ b/lisp/leim/quail/vntelex.el
@@ -1,6 +1,6 @@
-;;; vntelex.el --- Quail package for Vietnamese by Telex method
+;;; vntelex.el --- Quail package for Vietnamese by Telex method -*- lexical-binding: t -*-
-;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Author: Werner Lemberg <wl@gnu.org>
;; Keywords: multilingual, input method, Vietnamese
diff --git a/lisp/leim/quail/vnvni.el b/lisp/leim/quail/vnvni.el
index 36cad8e9120..faccc0afc53 100644
--- a/lisp/leim/quail/vnvni.el
+++ b/lisp/leim/quail/vnvni.el
@@ -1,6 +1,6 @@
-;;; vnvni.el --- Quail package for Vietnamese by VNI method
+;;; vnvni.el --- Quail package for Vietnamese by VNI method -*- lexical-binding: t -*-
-;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Author: Werner Lemberg <wl@gnu.org>
;; Nguyen Thai Ngoc Duy <pclouds@gmail.com>
diff --git a/lisp/leim/quail/welsh.el b/lisp/leim/quail/welsh.el
index bc6e8ecd333..f521d1464e9 100644
--- a/lisp/leim/quail/welsh.el
+++ b/lisp/leim/quail/welsh.el
@@ -1,6 +1,6 @@
-;;; welsh.el --- Quail package for inputting Welsh characters -*-coding: utf-8;-*-
+;;; welsh.el --- Quail package for inputting Welsh characters -*- coding: utf-8; lexical-binding: t -*-
-;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: i18n
diff --git a/lisp/linum.el b/lisp/linum.el
index e8c364245ae..824f016271d 100644
--- a/lisp/linum.el
+++ b/lisp/linum.el
@@ -1,6 +1,6 @@
;;; linum.el --- display line numbers in the left margin -*- lexical-binding: t -*-
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Markus Triska <markus.triska@gmx.at>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/loadhist.el b/lisp/loadhist.el
index 8ac575e8e39..a60d6b29095 100644
--- a/lisp/loadhist.el
+++ b/lisp/loadhist.el
@@ -1,6 +1,6 @@
;;; loadhist.el --- lisp functions for working with feature groups
-;; Copyright (C) 1995, 1998, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1998, 2000-2021 Free Software Foundation, Inc.
;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/loadup.el b/lisp/loadup.el
index 568b9fe40df..9cee6a2fd83 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -1,6 +1,6 @@
;;; loadup.el --- load up standardly loaded Lisp files for Emacs
-;; Copyright (C) 1985-1986, 1992, 1994, 2001-2020 Free Software
+;; Copyright (C) 1985-1986, 1992, 1994, 2001-2021 Free Software
;; Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
@@ -57,7 +57,7 @@
;; bidi.c needs for its job.
(setq redisplay--inhibit-bidi t)
-(message "dump mode: %s" dump-mode)
+(message "Dump mode: %s" dump-mode)
;; Add subdirectories to the load-path for files that might get
;; autoloaded when bootstrapping or running Emacs normally.
@@ -351,6 +351,7 @@
(load "cus-start") ;Late to reduce customize-rogue (needs loaddefs.el anyway)
(if (not (eq system-type 'ms-dos))
(load "tooltip"))
+(load "international/iso-transl") ; Binds Alt-[ and friends.
;; This file doesn't exist when building a development version of Emacs
;; from the repository. It is generated just after temacs is built.
diff --git a/lisp/locate.el b/lisp/locate.el
index bc78e06eab2..c4dbe2af02b 100644
--- a/lisp/locate.el
+++ b/lisp/locate.el
@@ -1,6 +1,6 @@
;;; locate.el --- interface to the locate command -*- lexical-binding:t -*-
-;; Copyright (C) 1996, 1998, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1998, 2001-2021 Free Software Foundation, Inc.
;; Author: Peter Breton <pbreton@cs.umb.edu>
;; Keywords: unix files
@@ -319,9 +319,9 @@ then `locate-post-command-hook'."
(erase-buffer)
(setq locate-current-filter filter)
- (set (make-local-variable 'locate-local-search) search-string)
- (set (make-local-variable 'locate-local-filter) filter)
- (set (make-local-variable 'locate-local-prompt) run-locate-command)
+ (setq-local locate-local-search search-string)
+ (setq-local locate-local-filter filter)
+ (setq-local locate-local-prompt run-locate-command)
(if run-locate-command
(shell-command search-string locate-buffer-name)
@@ -467,8 +467,8 @@ do not work in subdirectories.
buffer-read-only t)
(add-to-invisibility-spec '(dired . t))
(dired-alist-add-1 default-directory (point-min-marker))
- (set (make-local-variable 'dired-directory) "/")
- (set (make-local-variable 'dired-subdir-switches) locate-ls-subdir-switches)
+ (setq-local dired-directory "/")
+ (setq-local dired-subdir-switches locate-ls-subdir-switches)
(setq dired-switches-alist nil)
;; This should support both Unix and Windoze style names
(setq-local directory-listing-before-filename-regexp
@@ -668,11 +668,11 @@ the database on the command line."
(or (file-exists-p database)
(error "Database file %s does not exist" database))
(let ((locate-make-command-line
- (function (lambda (string)
- (cons locate-command
- (list (concat "--database="
- (expand-file-name database))
- string))))))
+ (lambda (string)
+ (cons locate-command
+ (list (concat "--database="
+ (expand-file-name database))
+ string)))))
(locate search-string)))
(defun locate-do-redisplay (&optional arg test-for-subdir)
diff --git a/lisp/lpr.el b/lisp/lpr.el
index b45e9c733ec..012d2518929 100644
--- a/lisp/lpr.el
+++ b/lisp/lpr.el
@@ -1,6 +1,6 @@
;;; lpr.el --- print Emacs buffer on line printer
-;; Copyright (C) 1985, 1988, 1992, 1994, 2001-2020 Free Software
+;; Copyright (C) 1985, 1988, 1992, 1994, 2001-2021 Free Software
;; Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el
index e2646209313..3721e86475c 100644
--- a/lisp/ls-lisp.el
+++ b/lisp/ls-lisp.el
@@ -1,6 +1,6 @@
;;; ls-lisp.el --- emulate insert-directory completely in Emacs Lisp -*- lexical-binding: t -*-
-;; Copyright (C) 1992, 1994, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 1994, 2000-2021 Free Software Foundation, Inc.
;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>
;; Modified by: Francis J. Wright <F.J.Wright@maths.qmw.ac.uk>
diff --git a/lisp/macros.el b/lisp/macros.el
index f90ad429b29..faa1f0bd35d 100644
--- a/lisp/macros.el
+++ b/lisp/macros.el
@@ -1,6 +1,6 @@
;;; macros.el --- non-primitive commands for keyboard macros -*- lexical-binding:t -*-
-;; Copyright (C) 1985-1987, 1992, 1994-1995, 2001-2020 Free Software
+;; Copyright (C) 1985-1987, 1992, 1994-1995, 2001-2021 Free Software
;; Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/mail/binhex.el b/lisp/mail/binhex.el
index 035bb32fa12..edb52b65789 100644
--- a/lisp/mail/binhex.el
+++ b/lisp/mail/binhex.el
@@ -1,6 +1,6 @@
;;; binhex.el --- decode BinHex-encoded text -*- lexical-binding:t -*-
-;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
;; Keywords: binhex news
diff --git a/lisp/mail/blessmail.el b/lisp/mail/blessmail.el
index 242714db968..505ce5d4767 100644
--- a/lisp/mail/blessmail.el
+++ b/lisp/mail/blessmail.el
@@ -1,6 +1,6 @@
;;; blessmail.el --- decide whether movemail needs special privileges -*- no-byte-compile: t -*-
-;; Copyright (C) 1994, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 2001-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el
index d524b26f1b9..4e8009db864 100644
--- a/lisp/mail/emacsbug.el
+++ b/lisp/mail/emacsbug.el
@@ -1,6 +1,6 @@
;;; emacsbug.el --- command to report Emacs bugs to appropriate mailing list
-;; Copyright (C) 1985, 1994, 1997-1998, 2000-2020 Free Software
+;; Copyright (C) 1985, 1994, 1997-1998, 2000-2021 Free Software
;; Foundation, Inc.
;; Author: K. Shane Hartman
@@ -241,12 +241,12 @@ Already submitted bugs can be found in the Emacs bug tracker:
;; that report-emacs-bug-orig-text remains valid. (Bug#5178)
(message-sort-headers)
;; Stop message-mode stealing the properties we will add.
- (set (make-local-variable 'message-strip-special-text-properties) nil)
+ (setq-local message-strip-special-text-properties nil)
;; Make sure we default to the From: address as envelope when sending
;; through sendmail. FIXME: Why?
(when (and (not (message--sendmail-envelope-from))
(message-bogus-recipient-p (message-make-address)))
- (set (make-local-variable 'message-sendmail-envelope-from) 'header)))
+ (setq-local message-sendmail-envelope-from 'header)))
(rfc822-goto-eoh)
(forward-line 1)
;; Move the mail signature to the proper place.
@@ -381,9 +381,8 @@ usually do not have translators for other languages.\n\n")))
(add-hook report-emacs-bug-send-hook 'report-emacs-bug-hook nil t))
(goto-char (point-max))
(skip-chars-backward " \t\n")
- (make-local-variable 'report-emacs-bug-orig-text)
- (setq report-emacs-bug-orig-text
- (buffer-substring-no-properties (point-min) (point)))
+ (setq-local report-emacs-bug-orig-text
+ (buffer-substring-no-properties (point-min) (point)))
(goto-char user-point)))
(defun emacs-bug--system-description ()
diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el
index 6effe139864..2bcbdf4a223 100644
--- a/lisp/mail/feedmail.el
+++ b/lisp/mail/feedmail.el
@@ -622,22 +622,25 @@ to arrange for the message to get a From: line."
(defcustom feedmail-sendmail-f-doesnt-sell-me-out nil
- "Says whether the sendmail program issues a warning header if called with \"-f\".
+ "Whether sendmail should issue a warning header if called with \"-f\".
The sendmail program has a useful feature to let you set the envelope FROM
address via a command line option, \"-f\". Unfortunately, it also has a widely
disliked default behavior of selling you out if you do that by inserting
an unattractive warning in the headers. It looks something like this:
- X-Authentication-Warning: u1.example.com: niceguy set sender to niceguy@example.com using -f
-
-It is possible to configure sendmail to not do this, but such a reconfiguration
-is not an option for many users. As this is the default behavior of most
-sendmail installations, one can mostly only wish it were otherwise. If feedmail
-believes the sendmail program will sell you out this way, it won't use the \"-f\"
-option when calling sendmail. If it doesn't think sendmail will sell you out,
-it will use the \"-f\" \(since it is a handy feature). You control what
-feedmail thinks with this variable. The default is nil, meaning that feedmail
-will believe that sendmail will sell you out."
+ X-Authentication-Warning: u1.example.com: niceguy set
+ sender to niceguy@example.com using -f
+
+It is possible to configure sendmail to not do this, but such a
+reconfiguration is not an option for many users. As this is the
+default behavior of most sendmail installations, one can mostly
+only wish it were otherwise. If feedmail believes the sendmail
+program will sell you out this way, it won't use the \"-f\"
+option when calling sendmail. If it doesn't think sendmail will
+sell you out, it will use the \"-f\" \(since it is a handy
+feature). You control what feedmail thinks with this variable.
+The default is nil, meaning that feedmail will believe that
+sendmail will sell you out."
:version "24.1"
:group 'feedmail-headers
:type 'boolean
@@ -807,7 +810,8 @@ fiddle-plex.
feedmail will use this list of fiddle-plexes to manipulate user-specified
message header fields. It does this after it has completed all normal
-message header field manipulation and before calling `feedmail-last-chance-hook'.
+message header field manipulation and before calling
+`feedmail-last-chance-hook'.
For an explanation of fiddle-plexes, see the documentation for the
variable `feedmail-fiddle-plex-blurb'. In contrast to some other fiddle-plex
@@ -889,13 +893,14 @@ called and will consult `feedmail-spray-this-address' to find the
stripped envelope email address (no comments or angle brackets). The
function should return an embellished form of the address.
-The recipe for sending form letters is: (1) create a message with all
-addressees on Bcc: headers; (2) tell feedmail to remove Bcc: headers
-before sending the message; (3) create a function which will embellish
-stripped addresses, if desired; (4) define `feedmail-spray-address-fiddle-plex-list'
-appropriately; (5) send the message with `feedmail-enable-spray' set
-non-nil; (6) stand back and watch co-workers wonder at how efficient
-you are at accomplishing inherently inefficient things."
+The recipe for sending form letters is: (1) create a message with
+all addressees on Bcc: headers; (2) tell feedmail to remove Bcc:
+headers before sending the message; (3) create a function which
+will embellish stripped addresses, if desired; (4) define
+`feedmail-spray-address-fiddle-plex-list' appropriately; (5) send
+the message with `feedmail-enable-spray' set non-nil; (6) stand
+back and watch co-workers wonder at how efficient you are at
+accomplishing inherently inefficient things."
:group 'feedmail-spray
:type 'sexp ; too complex to be described accurately
)
@@ -1336,19 +1341,22 @@ variable, but may depend on its value as described here.")
(defun feedmail-mail-send-hook-splitter ()
"Facilitate dividing `mail-send-hook' things into queued and immediate cases.
-If you have `mail-send-hook' functions that should only be called for sending/
-queueing messages or only be called for the sending of queued messages, this is
-for you. Add this function to `mail-send-hook' with something like this:
+If you have `mail-send-hook' functions that should only be called
+for sending/ queueing messages or only be called for the sending
+of queued messages, this is for you. Add this function to
+`mail-send-hook' with something like this:
(add-hook \\='mail-send-hook \\='feedmail-mail-send-hook-splitter)
-Then add the functions you want called to either `feedmail-mail-send-hook-queued'
-or `feedmail-mail-send-hook', as appropriate. The distinction is that
-`feedmail-mail-send-hook' will be called when you send mail from a composition
-buffer (typically by typing C-c C-c), whether the message is sent immediately
-or placed in the queue or drafts directory. `feedmail-mail-send-hook-queued' is
-called when messages are being sent from the queue directory, typically via a
-call to `feedmail-run-the-queue'."
+Then add the functions you want called to either
+`feedmail-mail-send-hook-queued' or `feedmail-mail-send-hook', as
+appropriate. The distinction is that `feedmail-mail-send-hook'
+will be called when you send mail from a composition
+buffer (typically by typing C-c C-c), whether the message is sent
+immediately or placed in the queue or drafts directory.
+`feedmail-mail-send-hook-queued' is called when messages are
+being sent from the queue directory, typically via a call to
+`feedmail-run-the-queue'."
(feedmail-say-debug ">in-> feedmail-mail-send-hook-splitter %s" feedmail-queue-runner-is-active)
(if feedmail-queue-runner-is-active
(run-hooks 'feedmail-mail-send-hook-queued)
@@ -2067,10 +2075,10 @@ internally by feedmail):
after-run (the queue has just been run, possibly sending messages)
WHAT-EVENT is used as a key into the table `feedmail-queue-reminder-alist'. If
-the associated value is a function, it is called without arguments and is expected
-to perform the reminder activity. You can supply your own reminder functions
-by redefining `feedmail-queue-reminder-alist'. If you don't want any reminders,
-you can set `feedmail-queue-reminder-alist' to nil."
+the associated value is a function, it is called without arguments and is
+expected to perform the reminder activity. You can supply your own reminder
+functions by redefining `feedmail-queue-reminder-alist'. If you don't want any
+reminders, you can set `feedmail-queue-reminder-alist' to nil."
(interactive "p")
(feedmail-say-debug ">in-> feedmail-queue-reminder %s" what-event)
(let ((key (if (and what-event (symbolp what-event)) what-event 'on-demand)) entry reminder)
@@ -2965,7 +2973,8 @@ probably not appropriate for you."
(defun feedmail-fiddle-list-of-fiddle-plexes (list-of-fiddle-plexes)
- "Fiddling based on a list of fiddle-plexes. Values t, nil, and string are pointless."
+ "Fiddling based on a list of fiddle-plexes.
+Values t, nil, and string are pointless."
(feedmail-say-debug ">in-> feedmail-fiddle-list-of-fiddle-plexes")
;; default is to fall off the end of the list and do nothing
(let ((lofp list-of-fiddle-plexes) fp)
diff --git a/lisp/mail/flow-fill.el b/lisp/mail/flow-fill.el
index b357b3e2563..e93ba547a89 100644
--- a/lisp/mail/flow-fill.el
+++ b/lisp/mail/flow-fill.el
@@ -1,6 +1,6 @@
;;; flow-fill.el --- interpret RFC2646 "flowed" text -*- lexical-binding:t -*-
-;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;; Author: Simon Josefsson <jas@pdc.kth.se>
;; Keywords: mail
diff --git a/lisp/mail/footnote.el b/lisp/mail/footnote.el
index 67bfbf703bb..ea109eec12a 100644
--- a/lisp/mail/footnote.el
+++ b/lisp/mail/footnote.el
@@ -1,6 +1,6 @@
;;; footnote.el --- footnote support for message mode -*- lexical-binding:t -*-
-;; Copyright (C) 1997, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2000-2021 Free Software Foundation, Inc.
;; Author: Steven L Baur <steve@xemacs.org> (1997-2011)
;; Boruch Baum <boruch_baum@gmx.com> (2017-)
diff --git a/lisp/mail/hashcash.el b/lisp/mail/hashcash.el
index a2705d659a4..b4889eec46f 100644
--- a/lisp/mail/hashcash.el
+++ b/lisp/mail/hashcash.el
@@ -1,6 +1,6 @@
;;; hashcash.el --- Add hashcash payments to email -*- lexical-binding:t -*-
-;; Copyright (C) 2003-2005, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2005, 2007-2021 Free Software Foundation, Inc.
;; Written by: Paul Foley <mycroft@actrix.gen.nz> (1997-2002)
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/mail/ietf-drums.el b/lisp/mail/ietf-drums.el
index a136ccf14e7..795e37dced6 100644
--- a/lisp/mail/ietf-drums.el
+++ b/lisp/mail/ietf-drums.el
@@ -1,6 +1,6 @@
;;; ietf-drums.el --- Functions for parsing RFC 2822 headers -*- lexical-binding:t -*-
-;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el
index 49dfd2ee874..4e3bf78c807 100644
--- a/lisp/mail/mail-extr.el
+++ b/lisp/mail/mail-extr.el
@@ -1,6 +1,6 @@
;;; mail-extr.el --- extract full name and address from email header
-;; Copyright (C) 1991-1994, 1997, 2001-2020 Free Software Foundation,
+;; Copyright (C) 1991-1994, 1997, 2001-2021 Free Software Foundation,
;; Inc.
;; Author: Joe Wells <jbw@cs.bu.edu>
diff --git a/lisp/mail/mail-hist.el b/lisp/mail/mail-hist.el
index 34bef2cfb8a..37c8ad68860 100644
--- a/lisp/mail/mail-hist.el
+++ b/lisp/mail/mail-hist.el
@@ -1,6 +1,6 @@
;;; mail-hist.el --- headers and message body history for outgoing mail
-;; Copyright (C) 1994, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 2001-2021 Free Software Foundation, Inc.
;; Author: Karl Fogel <kfogel@red-bean.com>
;; Created: March, 1994
diff --git a/lisp/mail/mail-parse.el b/lisp/mail/mail-parse.el
index e0274c8a11b..e72ed828494 100644
--- a/lisp/mail/mail-parse.el
+++ b/lisp/mail/mail-parse.el
@@ -1,6 +1,6 @@
;;; mail-parse.el --- Interface functions for parsing mail -*- lexical-binding: t -*-
-;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
diff --git a/lisp/mail/mail-prsvr.el b/lisp/mail/mail-prsvr.el
index 7c67c49b0b4..a9b5a4422d4 100644
--- a/lisp/mail/mail-prsvr.el
+++ b/lisp/mail/mail-prsvr.el
@@ -1,6 +1,6 @@
;;; mail-prsvr.el --- Interface variables for parsing mail -*- lexical-binding: t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
diff --git a/lisp/mail/mail-utils.el b/lisp/mail/mail-utils.el
index 68b6fea0ede..ad2dee59c7c 100644
--- a/lisp/mail/mail-utils.el
+++ b/lisp/mail/mail-utils.el
@@ -1,6 +1,6 @@
;;; mail-utils.el --- utility functions used both by rmail and rnews
-;; Copyright (C) 1985, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 2001-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: mail, news
diff --git a/lisp/mail/mailabbrev.el b/lisp/mail/mailabbrev.el
index 09afad7aa47..2147049ab19 100644
--- a/lisp/mail/mailabbrev.el
+++ b/lisp/mail/mailabbrev.el
@@ -1,6 +1,6 @@
;;; mailabbrev.el --- abbrev-expansion of mail aliases
-;; Copyright (C) 1985-1987, 1992-1993, 1996-1997, 2000-2020 Free
+;; Copyright (C) 1985-1987, 1992-1993, 1996-1997, 2000-2021 Free
;; Software Foundation, Inc.
;; Author: Jamie Zawinski <jwz@lucid.com; now jwz@jwz.org>
@@ -377,11 +377,11 @@ double-quotes."
(setq result (cons (substring definition start end) result)
start (and end (match-end 0)))))
(setq definition
- (mapconcat (function (lambda (x)
+ (mapconcat (lambda (x)
(or (mail-resolve-all-aliases-1
- (intern-soft (downcase x) mail-abbrevs)
- (cons sym so-far))
- x)))
+ (intern-soft (downcase x) mail-abbrevs)
+ (cons sym so-far))
+ x))
(nreverse result)
mail-alias-separator-string))
(set sym definition))))
@@ -436,12 +436,12 @@ of a mail alias. The value is set up, buffer-local, when first needed.")
(_ (aref (standard-syntax-table) ?_))
(w (aref (standard-syntax-table) ?w)))
(map-char-table
- (function (lambda (key value)
- (if (null value)
- ;; Fetch the inherited value
- (setq value (aref tab key)))
- (if (equal value _)
- (set-char-table-range tab key w))))
+ (lambda (key value)
+ (if (null value)
+ ;; Fetch the inherited value
+ (setq value (aref tab key)))
+ (if (equal value _)
+ (set-char-table-range tab key w)))
tab)
(modify-syntax-entry ?@ "w" tab)
(modify-syntax-entry ?% "w" tab)
diff --git a/lisp/mail/mailalias.el b/lisp/mail/mailalias.el
index 2b76539e152..5a5488b2ec1 100644
--- a/lisp/mail/mailalias.el
+++ b/lisp/mail/mailalias.el
@@ -1,6 +1,6 @@
;;; mailalias.el --- expand and complete mailing address aliases -*- lexical-binding: t -*-
-;; Copyright (C) 1985, 1987, 1995-1997, 2001-2020 Free Software
+;; Copyright (C) 1985, 1987, 1995-1997, 2001-2021 Free Software
;; Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/mail/mailclient.el b/lisp/mail/mailclient.el
index 405ae17a12c..3cba6a60e8f 100644
--- a/lisp/mail/mailclient.el
+++ b/lisp/mail/mailclient.el
@@ -1,6 +1,6 @@
;;; mailclient.el --- mail sending via system's mail client.
-;; Copyright (C) 2005-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2005-2021 Free Software Foundation, Inc.
;; Author: David Reitter <david.reitter@gmail.com>
;; Keywords: mail
diff --git a/lisp/mail/mailheader.el b/lisp/mail/mailheader.el
index 801df100135..cbc01e4a442 100644
--- a/lisp/mail/mailheader.el
+++ b/lisp/mail/mailheader.el
@@ -1,6 +1,6 @@
;;; mailheader.el --- mail header parsing, merging, formatting
-;; Copyright (C) 1996, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 2001-2021 Free Software Foundation, Inc.
;; Author: Erik Naggum <erik@naggum.no>
;; Keywords: tools, mail, news
diff --git a/lisp/mail/mspools.el b/lisp/mail/mspools.el
index ab2649feb4b..970f52c3374 100644
--- a/lisp/mail/mspools.el
+++ b/lisp/mail/mspools.el
@@ -1,6 +1,6 @@
;;; mspools.el --- show mail spools waiting to be read -*- lexical-binding: t; -*-
-;; Copyright (C) 1997, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
;; Author: Stephen Eglen <stephen@gnu.org>
;; Created: 22 Jan 1997
diff --git a/lisp/mail/qp.el b/lisp/mail/qp.el
index 10ac696fecf..02a371a8448 100644
--- a/lisp/mail/qp.el
+++ b/lisp/mail/qp.el
@@ -1,6 +1,6 @@
;;; qp.el --- Quoted-Printable functions -*- lexical-binding:t -*-
-;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: mail, extensions
diff --git a/lisp/mail/reporter.el b/lisp/mail/reporter.el
index edfceb373f7..2e583a470d6 100644
--- a/lisp/mail/reporter.el
+++ b/lisp/mail/reporter.el
@@ -1,6 +1,6 @@
-;;; reporter.el --- customizable bug reporting of lisp programs
+;;; reporter.el --- customizable bug reporting of lisp programs -*- lexical-binding: t; -*-
-;; Copyright (C) 1993-1998, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1998, 2001-2021 Free Software Foundation, Inc.
;; Author: 1993-1998 Barry A. Warsaw
;; Maintainer: emacs-devel@gnu.org
@@ -51,7 +51,6 @@
;;(defun mypkg-submit-bug-report ()
;; "Submit via mail a bug report on mypkg"
;; (interactive)
-;; (require 'reporter)
;; (reporter-submit-bug-report
;; mypkg-maintainer-address
;; (concat "mypkg.el " mypkg-version)
@@ -159,7 +158,7 @@ composed.")
t)
(error indent-enclosing-p))))
-(defun reporter-lisp-indent (indent-point state)
+(defun reporter-lisp-indent (_indent-point state)
"A better lisp indentation style for bug reporting."
(save-excursion
(goto-char (1+ (nth 1 state)))
@@ -194,7 +193,7 @@ MAILBUF is the mail buffer being composed."
(<= maxwidth (current-column)))
(save-excursion
(let ((compact-p (not (memq varsym reporter-dont-compact-list)))
- (lisp-indent-function 'reporter-lisp-indent))
+ (lisp-indent-function #'reporter-lisp-indent))
(goto-char here)
(reporter-beautify-list maxwidth compact-p))))
(insert "\n"))
@@ -207,6 +206,11 @@ MAILBUF is the mail buffer being composed."
(error
(error ""))))
+(defun reporter--run-functions (funs)
+ (if (functionp funs)
+ (funcall funs)
+ (mapc #'funcall funs)))
+
(defun reporter-dump-state (pkgname varlist pre-hooks post-hooks)
"Dump the state of the mode specific variables.
PKGNAME contains the name of the mode as it will appear in the bug
@@ -231,44 +235,39 @@ properly.
PRE-HOOKS is run after the Emacs version and PKGNAME are inserted, but
before the VARLIST is dumped. POST-HOOKS is run after the VARLIST is
dumped."
- (let ((buffer (current-buffer)))
- (set-buffer buffer)
- (insert "Emacs : " (emacs-version) "\n")
- (and pkgname
- (insert "Package: " pkgname "\n"))
- (run-hooks 'pre-hooks)
- (if (not varlist)
- nil
- (insert "\ncurrent state:\n==============\n")
- ;; create an emacs-lisp-mode buffer to contain the output, which
- ;; we'll later insert into the mail buffer
- (condition-case fault
- (let ((mailbuf (current-buffer))
- (elbuf (get-buffer-create " *tmp-reporter-buffer*")))
- (with-current-buffer elbuf
- (emacs-lisp-mode)
- (erase-buffer)
- (insert "(setq\n")
- (lisp-indent-line)
- (mapc
- (function
- (lambda (varsym-or-cons-cell)
- (let ((varsym (or (car-safe varsym-or-cons-cell)
- varsym-or-cons-cell))
- (printer (or (cdr-safe varsym-or-cons-cell)
- 'reporter-dump-variable)))
- (funcall printer varsym mailbuf)
- )))
- varlist)
- (lisp-indent-line)
- (insert ")\n"))
- (insert-buffer-substring elbuf))
- (error
- (insert "State could not be dumped due to the following error:\n\n"
- (format "%s" fault)
- "\n\nYou should still send this bug report."))))
- (run-hooks 'post-hooks)
- ))
+ (insert "Emacs : " (emacs-version) "\n")
+ (and pkgname
+ (insert "Package: " pkgname "\n"))
+ (reporter--run-functions pre-hooks)
+ (if (not varlist)
+ nil
+ (insert "\ncurrent state:\n==============\n")
+ ;; create an emacs-lisp-mode buffer to contain the output, which
+ ;; we'll later insert into the mail buffer
+ (condition-case fault
+ (let ((mailbuf (current-buffer))
+ (elbuf (get-buffer-create " *tmp-reporter-buffer*")))
+ (with-current-buffer elbuf
+ (emacs-lisp-mode)
+ (erase-buffer)
+ (insert "(setq\n")
+ (lisp-indent-line)
+ (mapc
+ (lambda (varsym-or-cons-cell)
+ (let ((varsym (or (car-safe varsym-or-cons-cell)
+ varsym-or-cons-cell))
+ (printer (or (cdr-safe varsym-or-cons-cell)
+ 'reporter-dump-variable)))
+ (funcall printer varsym mailbuf)))
+ varlist)
+ (lisp-indent-line)
+ (insert ")\n"))
+ (insert-buffer-substring elbuf))
+ (error
+ (insert "State could not be dumped due to the following error:\n\n"
+ (format "%s" fault)
+ "\n\nYou should still send this bug report."))))
+ (reporter--run-functions post-hooks))
(defun reporter-compose-outgoing ()
@@ -368,7 +367,7 @@ mail-sending package is used for editing and sending the message."
(skip-chars-backward " \t\n")
(setq reporter-initial-text (buffer-substring after-sep-pos (point))))
(if (setq hookvar (get agent 'hookvar))
- (add-hook hookvar 'reporter-bug-hook nil t))
+ (add-hook hookvar #'reporter-bug-hook nil t))
;; compose the minibuf message and display this.
(let* ((sendkey-whereis (where-is-internal
diff --git a/lisp/mail/rfc2045.el b/lisp/mail/rfc2045.el
index dba9c04cc83..c0672f18a98 100644
--- a/lisp/mail/rfc2045.el
+++ b/lisp/mail/rfc2045.el
@@ -1,6 +1,6 @@
;;; rfc2045.el --- Functions for decoding rfc2045 headers -*- lexical-binding:t -*-
-;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
diff --git a/lisp/mail/rfc2047.el b/lisp/mail/rfc2047.el
index 4aa0c2809b2..5b08713949f 100644
--- a/lisp/mail/rfc2047.el
+++ b/lisp/mail/rfc2047.el
@@ -1,6 +1,6 @@
;;; rfc2047.el --- functions for encoding and decoding rfc2047 messages -*- lexical-binding:t -*-
-;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
diff --git a/lisp/mail/rfc2231.el b/lisp/mail/rfc2231.el
index 17da60e0bee..6fb4502b23b 100644
--- a/lisp/mail/rfc2231.el
+++ b/lisp/mail/rfc2231.el
@@ -1,6 +1,6 @@
;;; rfc2231.el --- Functions for decoding rfc2231 headers -*- lexical-binding:t -*-
-;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
diff --git a/lisp/mail/rfc2368.el b/lisp/mail/rfc2368.el
index afa30590059..553f3cc3a54 100644
--- a/lisp/mail/rfc2368.el
+++ b/lisp/mail/rfc2368.el
@@ -1,6 +1,6 @@
;;; rfc2368.el --- support for rfc2368 -*- lexical-binding:t -*-
-;; Copyright (C) 1998, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2000-2021 Free Software Foundation, Inc.
;; Author: Sen Nagata <sen@eccosys.com>
;; Keywords: mail
diff --git a/lisp/mail/rfc822.el b/lisp/mail/rfc822.el
index f2fe1cd8166..f07fcdfc9f1 100644
--- a/lisp/mail/rfc822.el
+++ b/lisp/mail/rfc822.el
@@ -1,6 +1,6 @@
;;; rfc822.el --- hairy RFC 822 (or later) parser for mail, news, etc.
-;; Copyright (C) 1986-1987, 1990, 2001-2020 Free Software Foundation,
+;; Copyright (C) 1986-1987, 1990, 2001-2021 Free Software Foundation,
;; Inc.
;; Author: Richard Mlynarik <mly@eddie.mit.edu>
@@ -226,11 +226,11 @@
((and (not (eobp)) (= (following-char) ?\@))
;; <@foo.bar,@baz:quux@abcd.efg>
(rfc822-snarf-frob-list "<...> address" ?\, ?\:
- (function (lambda ()
- (if (rfc822-looking-at ?\@)
- (rfc822-snarf-domain)
- (rfc822-bad-address
- "Gubbish in route-addr")))))
+ (lambda ()
+ (if (rfc822-looking-at ?\@)
+ (rfc822-snarf-domain)
+ (rfc822-bad-address
+ "Gubbish in route-addr"))))
(rfc822-snarf-words)
(or (rfc822-looking-at ?@)
(rfc822-bad-address "Malformed <..@..> address"))
@@ -279,8 +279,7 @@
(let ((buf (generate-new-buffer " rfc822")))
(unwind-protect
(with-current-buffer buf
- (make-local-variable 'case-fold-search)
- (setq case-fold-search nil) ;For speed(?)
+ (setq-local case-fold-search nil) ;For speed(?)
(insert header-text)
;; unfold continuation lines
(goto-char (point-min))
diff --git a/lisp/mail/rmail-spam-filter.el b/lisp/mail/rmail-spam-filter.el
index db518482591..dda472eb30e 100644
--- a/lisp/mail/rmail-spam-filter.el
+++ b/lisp/mail/rmail-spam-filter.el
@@ -1,6 +1,6 @@
;;; rmail-spam-filter.el --- spam filter for Rmail, the Emacs mail reader
-;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Keywords: email, spam, filter, rmail
;; Author: Eli Tziperman <eli AT deas.harvard.edu>
;; Package: rmail
@@ -214,6 +214,16 @@ the cdr is set to t. Else, the car is set to nil."
;; rule means this cannot be spam.
(setcar result nil)))))
+;; Don't spuriously advance to the next unseen message while
+;; prompting, because that causes it to then be missed while actually
+;; reading mail afterwards! Call this instead of
+;; rmail-first-unseen-message.
+(defun rsf--rmail-last-seen-message ()
+ (max 1
+ ;; 'rmail-first-unseen-message' can return nil in a completely
+ ;; empty buffer.
+ (1- (or (rmail-first-unseen-message) 1))))
+
(defun rmail-spam-filter (msg)
"Return nil if message number MSG is spam based on `rsf-definitions-alist'.
If spam, optionally output message to a file `rsf-file' and delete
@@ -327,8 +337,7 @@ it from rmail file. Called for each new message retrieved by
(if (and (car maybe-spam) (cdr maybe-spam))
;; Temporarily set rmail-current-message in order to output
;; and delete the spam msg if needed:
- (let ((rmail-current-message msg) ; FIXME does this do anything?
- (action (cdr (assq 'action
+ (let ((action (cdr (assq 'action
(nth num-element rsf-definitions-alist))))
(newfile (not (file-exists-p rsf-file))))
;; Check action item in rsf-definitions-alist and do it.
@@ -337,7 +346,7 @@ it from rmail file. Called for each new message retrieved by
;; Else the prompt to write a new file leaves the raw
;; mbox buffer visible.
(and newfile
- (rmail-show-message (rmail-first-unseen-message) t))
+ (rmail-show-message (rsf--rmail-last-seen-message) t))
(rmail-output rsf-file)
;; Swap back, else rmail-get-new-mail-1 gets confused.
(when newfile
@@ -377,7 +386,7 @@ This is called at the end of `rmail-get-new-mail-1' if there is new mail."
(sleep-for rsf-sleep-after-message))
(when (> nspam 0)
;; Otherwise sleep or expunge prompt leaves raw mbox buffer showing.
- (rmail-show-message (or (rmail-first-unseen-message) 1) t)
+ (rmail-show-message (or (rsf--rmail-last-seen-message) 1) t)
(unwind-protect
(progn
(if rsf-beep (ding t))
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index 86084b03f47..29460cc20f5 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -1,6 +1,6 @@
;;; rmail.el --- main code of "RMAIL" mail reader for Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1985-1988, 1993-1998, 2000-2020 Free Software
+;; Copyright (C) 1985-1988, 1993-1998, 2000-2021 Free Software
;; Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
@@ -161,13 +161,6 @@ its character representation and its display representation.")
:version "21.1")
;;;###autoload
-(put 'rmail-spool-directory 'standard-value
- '((cond ((file-exists-p "/var/mail") "/var/mail/")
- ((file-exists-p "/var/spool/mail") "/var/spool/mail/")
- ((memq system-type '(hpux usg-unix-v)) "/usr/mail/")
- (t "/usr/spool/mail/"))))
-
-;;;###autoload
(defcustom rmail-spool-directory
(purecopy
(cond ((file-exists-p "/var/mail")
@@ -181,12 +174,10 @@ its character representation and its display representation.")
(t "/usr/spool/mail/")))
"Name of directory used by system mailer for delivering new mail.
Its name should end with a slash."
- :initialize 'custom-initialize-delay
+ :initialize #'custom-initialize-delay
:type 'directory
:group 'rmail)
-;;;###autoload(custom-initialize-delay 'rmail-spool-directory nil)
-
(defcustom rmail-movemail-program nil
"If non-nil, the file name of the `movemail' program."
:group 'rmail-retrieve
@@ -1080,6 +1071,7 @@ The buffer is expected to be narrowed to just the header of the message."
(define-key map [?\S-\ ] 'scroll-down-command)
(define-key map "\177" 'scroll-down-command)
(define-key map "?" 'describe-mode)
+ (define-key map "\C-c\C-d" 'rmail-epa-decrypt)
(define-key map "\C-c\C-s\C-d" 'rmail-sort-by-date)
(define-key map "\C-c\C-s\C-s" 'rmail-sort-by-subject)
(define-key map "\C-c\C-s\C-a" 'rmail-sort-by-author)
@@ -1272,6 +1264,7 @@ Instead, these commands are available:
\\[rmail-undelete-previous-message] Undelete message. Tries current message, then earlier messages
till a deleted message is found.
\\[rmail-edit-current-message] Edit the current message. \\[rmail-cease-edit] to return to Rmail.
+\\[rmail-epa-decrypt] Decrypt the current message.
\\[rmail-expunge] Expunge deleted messages.
\\[rmail-expunge-and-save] Expunge and save the file.
\\[rmail-quit] Quit Rmail: expunge, save, then switch to another buffer.
@@ -1431,27 +1424,23 @@ If so restore the actual mbox message collection."
(defun rmail-perm-variables ()
(make-local-variable 'rmail-last-regexp)
(make-local-variable 'rmail-deleted-vector)
- (make-local-variable 'rmail-buffer)
- (make-local-variable 'rmail-was-converted)
- (setq rmail-was-converted nil)
- (make-local-variable 'rmail-seriously-modified)
- (setq rmail-seriously-modified nil)
- (setq rmail-buffer (current-buffer))
+ (setq-local rmail-was-converted nil)
+ (setq-local rmail-seriously-modified nil)
+ (setq-local rmail-buffer (current-buffer))
(set-buffer-multibyte nil)
(with-current-buffer (setq rmail-view-buffer (rmail-generate-viewer-buffer))
(setq buffer-undo-list t)
;; Note that this does not erase the buffer. Should it?
;; It depends on how this is called. If somehow called with the
;; rmail buffers swapped, it would erase the message collection.
- (set (make-local-variable 'rmail-overlay-list) nil)
+ (setq-local rmail-overlay-list nil)
(set-buffer-multibyte t)
;; Force C-x C-s write Unix EOLs.
(set-buffer-file-coding-system 'undecided-unix))
(make-local-variable 'rmail-summary-buffer)
(make-local-variable 'rmail-summary-vector)
(make-local-variable 'rmail-current-message)
- (make-local-variable 'rmail-total-messages)
- (setq rmail-total-messages 0)
+ (setq-local rmail-total-messages 0)
(make-local-variable 'rmail-message-vector)
(make-local-variable 'rmail-msgref-vector)
(make-local-variable 'rmail-inbox-list)
@@ -1466,40 +1455,30 @@ If so restore the actual mbox message collection."
;; FIXME expand-file-name?
(concat rmail-spool-directory
(user-login-name)))))))
- (set (make-local-variable 'tool-bar-map) rmail-tool-bar-map))
+ (setq-local tool-bar-map rmail-tool-bar-map))
;; Set up the non-permanent locals associated with Rmail mode.
(defun rmail-variables ()
;; Turn off undo. We turn it back on in rmail-edit.
(setq buffer-undo-list t)
;; Don't let a local variables list in a message cause confusion.
- (make-local-variable 'local-enable-local-variables)
- (setq local-enable-local-variables nil)
+ (setq-local local-enable-local-variables nil)
;; Don't turn off auto-saving based on the size of the buffer
;; because that code does not understand buffer-swapping.
- (make-local-variable 'auto-save-include-big-deletions)
- (setq auto-save-include-big-deletions t)
- (make-local-variable 'revert-buffer-function)
- (setq revert-buffer-function 'rmail-revert)
- (make-local-variable 'font-lock-defaults)
- (setq font-lock-defaults
- '(rmail-font-lock-keywords
- t t nil nil
- (font-lock-maximum-size . nil)
- (font-lock-dont-widen . t)
- (font-lock-inhibit-thing-lock . (lazy-lock-mode fast-lock-mode))))
- (make-local-variable 'require-final-newline)
- (setq require-final-newline nil)
- (make-local-variable 'version-control)
- (setq version-control 'never)
- (make-local-variable 'kill-buffer-hook)
- (add-hook 'kill-buffer-hook 'rmail-mode-kill-summary)
- (make-local-variable 'file-precious-flag)
- (setq file-precious-flag t)
- (make-local-variable 'desktop-save-buffer)
- (setq desktop-save-buffer t)
- (make-local-variable 'save-buffer-coding-system)
- (setq save-buffer-coding-system 'no-conversion)
+ (setq-local auto-save-include-big-deletions t)
+ (setq-local revert-buffer-function 'rmail-revert)
+ (setq-local font-lock-defaults
+ '(rmail-font-lock-keywords
+ t t nil nil
+ (font-lock-maximum-size . nil)
+ (font-lock-dont-widen . t)
+ (font-lock-inhibit-thing-lock . (lazy-lock-mode fast-lock-mode))))
+ (setq-local require-final-newline nil)
+ (setq-local version-control 'never)
+ (add-hook 'kill-buffer-hook #'rmail-mode-kill-summary nil t)
+ (setq-local file-precious-flag t)
+ (setq-local desktop-save-buffer t)
+ (setq-local save-buffer-coding-system 'no-conversion)
(setq next-error-move-function 'rmail-next-error-move))
;; Handle M-x revert-buffer done in an rmail-mode buffer.
@@ -2788,7 +2767,7 @@ The current mail message becomes the message displayed."
;; rmail-header-style based on the binding in effect when
;; this function is called; `rmail-toggle-header' can
;; inspect this value to determine how to toggle.
- (set (make-local-variable 'rmail-header-style) header-style)
+ (setq-local rmail-header-style header-style)
;; In case viewing the previous message sets the paragraph
;; direction non-nil, we reset it here to allow independent
;; dynamic determination of paragraph direction in every
@@ -2799,7 +2778,7 @@ The current mail message becomes the message displayed."
(re-search-forward "mime-version: 1.0" nil t))
(let ((rmail-buffer mbox-buf)
(rmail-view-buffer view-buf))
- (set (make-local-variable 'rmail-mime-decoded) t)
+ (setq-local rmail-mime-decoded t)
(funcall rmail-show-mime-function))
(setq body-start (search-forward "\n\n" nil t))
(narrow-to-region beg (point))
@@ -4624,11 +4603,10 @@ Argument MIME is non-nil if this is a mime message."
"> ")
(push (rmail-epa-decrypt-1 mime) decrypts))))
- (when (and decrypts (eq major-mode 'rmail-mode))
- (rmail-add-label "decrypt"))
-
(when (and decrypts (rmail-buffers-swapped-p))
(when (y-or-n-p "Replace the original message? ")
+ (when (eq major-mode 'rmail-mode)
+ (rmail-add-label "decrypt"))
(setq decrypts (nreverse decrypts))
(let ((beg (rmail-msgbeg rmail-current-message))
(end (rmail-msgend rmail-current-message)))
diff --git a/lisp/mail/rmailedit.el b/lisp/mail/rmailedit.el
index 3026283a082..2680ed7f3a3 100644
--- a/lisp/mail/rmailedit.el
+++ b/lisp/mail/rmailedit.el
@@ -1,6 +1,6 @@
;;; rmailedit.el --- "RMAIL edit mode" Edit the current message
-;; Copyright (C) 1985, 1994, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1994, 2001-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: mail
@@ -66,8 +66,7 @@ This function runs the hooks `text-mode-hook' and `rmail-edit-mode-hook'.
(setq mode-line-modified (default-value 'mode-line-modified))
;; Don't turn off auto-saving based on the size of the buffer
;; because that code does not understand buffer-swapping.
- (make-local-variable 'auto-save-include-big-deletions)
- (setq auto-save-include-big-deletions t)
+ (setq-local auto-save-include-big-deletions t)
;; If someone uses C-x C-s, don't clobber the rmail file (bug#2625).
(add-hook 'write-region-annotate-functions
'rmail-write-region-annotate nil t)
@@ -98,10 +97,9 @@ This function runs the hooks `text-mode-hook' and `rmail-edit-mode-hook'.
(if (zerop rmail-total-messages)
(error "No messages in this buffer"))
(rmail-modify-format)
- (make-local-variable 'rmail-old-pruned)
- (setq rmail-old-pruned (rmail-msg-is-pruned))
+ (setq-local rmail-old-pruned (rmail-msg-is-pruned))
(rmail-edit-mode)
- (set (make-local-variable 'rmail-old-mime-state)
+ (setq-local rmail-old-mime-state
(and rmail-enable-mime
;; If you use something else, you are on your own.
(eq rmail-mime-feature 'rmailmm)
@@ -125,13 +123,11 @@ This function runs the hooks `text-mode-hook' and `rmail-edit-mode-hook'.
(goto-char (point-min))
;; t = decoded; raw = raw.
(aref (aref (rmail-mime-entity-display entity) 0) 0)))))
- (make-local-variable 'rmail-old-text)
- (setq rmail-old-text
- (save-restriction
- (widen)
- (buffer-substring (point-min) (point-max))))
- (make-local-variable 'rmail-old-headers)
- (setq rmail-old-headers (rmail-edit-headers-alist t))
+ (setq-local rmail-old-text
+ (save-restriction
+ (widen)
+ (buffer-substring (point-min) (point-max))))
+ (setq-local rmail-old-headers (rmail-edit-headers-alist t))
(setq buffer-read-only nil)
(setq buffer-undo-list nil)
;; Whether the buffer is initially marked as modified or not
@@ -209,7 +205,7 @@ This function runs the hooks `text-mode-hook' and `rmail-edit-mode-hook'.
(kill-all-local-variables)
(rmail-mode-1)
(if (boundp 'tool-bar-map)
- (set (make-local-variable 'tool-bar-map) rmail-tool-bar-map))
+ (setq-local tool-bar-map rmail-tool-bar-map))
(setq buffer-undo-list t)
(rmail-variables))
;; If text has really changed, mark message as edited.
diff --git a/lisp/mail/rmailkwd.el b/lisp/mail/rmailkwd.el
index f5115ad06c2..657b3629bd1 100644
--- a/lisp/mail/rmailkwd.el
+++ b/lisp/mail/rmailkwd.el
@@ -1,6 +1,6 @@
;;; rmailkwd.el --- part of the "RMAIL" mail reader for Emacs
-;; Copyright (C) 1985, 1988, 1994, 2001-2020 Free Software Foundation,
+;; Copyright (C) 1985, 1988, 1994, 2001-2021 Free Software Foundation,
;; Inc.
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el
index 29c6dcf40e8..ab5b49aab92 100644
--- a/lisp/mail/rmailmm.el
+++ b/lisp/mail/rmailmm.el
@@ -1,6 +1,6 @@
;;; rmailmm.el --- MIME decoding and display stuff for RMAIL
-;; Copyright (C) 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2021 Free Software Foundation, Inc.
;; Author: Alexander Pohoyda
;; Alex Schroeder
diff --git a/lisp/mail/rmailmsc.el b/lisp/mail/rmailmsc.el
index 204f33db542..ef5f3c31bbc 100644
--- a/lisp/mail/rmailmsc.el
+++ b/lisp/mail/rmailmsc.el
@@ -1,6 +1,6 @@
;;; rmailmsc.el --- miscellaneous support functions for the RMAIL mail reader
-;; Copyright (C) 1985, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 2001-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: mail
diff --git a/lisp/mail/rmailout.el b/lisp/mail/rmailout.el
index 49531eab91e..9305a48b8d8 100644
--- a/lisp/mail/rmailout.el
+++ b/lisp/mail/rmailout.el
@@ -1,6 +1,6 @@
;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file
-;; Copyright (C) 1985, 1987, 1993-1994, 2001-2020 Free Software
+;; Copyright (C) 1985, 1987, 1993-1994, 2001-2021 Free Software
;; Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
@@ -579,7 +579,7 @@ from a non-Rmail buffer. In this case, COUNT is ignored."
(progn
(if rmail-delete-after-output
(rmail-delete-message))
- (if (> count 0)
+ (if (>= count 0)
(let ((msgnum rmail-current-message))
(rmail-next-message 1)
(eq rmail-current-message (1+ msgnum)))))
diff --git a/lisp/mail/rmailsort.el b/lisp/mail/rmailsort.el
index c2749be9d07..2c42e6c8598 100644
--- a/lisp/mail/rmailsort.el
+++ b/lisp/mail/rmailsort.el
@@ -1,6 +1,6 @@
;;; rmailsort.el --- Rmail: sort messages
-;; Copyright (C) 1990, 1993-1994, 2001-2020 Free Software Foundation,
+;; Copyright (C) 1990, 1993-1994, 2001-2021 Free Software Foundation,
;; Inc.
;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp>
diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el
index 521659b7eb6..d29115a9570 100644
--- a/lisp/mail/rmailsum.el
+++ b/lisp/mail/rmailsum.el
@@ -1,6 +1,6 @@
;;; rmailsum.el --- make summary buffers for the mail reader -*- lexical-binding:t -*-
-;; Copyright (C) 1985, 1993-1996, 2000-2020 Free Software Foundation,
+;; Copyright (C) 1985, 1993-1996, 2000-2021 Free Software Foundation,
;; Inc.
;; Maintainer: emacs-devel@gnu.org
@@ -51,10 +51,10 @@ Setting this option to nil might speed up the generation of summaries."
:group 'rmail-summary)
(defvar rmail-summary-font-lock-keywords
- '(("^.....D.*" . font-lock-string-face) ; Deleted.
- ("^.....-.*" . font-lock-type-face) ; Unread.
+ '(("^ *[0-9]+D.*" . font-lock-string-face) ; Deleted.
+ ("^ *[0-9]+-.*" . font-lock-type-face) ; Unread.
;; Neither of the below will be highlighted if either of the above are:
- ("^.....[^D-] \\(......\\)" 1 font-lock-keyword-face) ; Date.
+ ("^ *[0-9]+[^D-] \\(......\\)" 1 font-lock-keyword-face) ; Date.
("{ \\([^\n}]+\\) }" 1 font-lock-comment-face)) ; Labels.
"Additional expressions to highlight in Rmail Summary mode.")
@@ -121,6 +121,7 @@ Setting this option to nil might speed up the generation of summaries."
(define-key map [?\S-\ ] 'rmail-summary-scroll-msg-down)
(define-key map "\177" 'rmail-summary-scroll-msg-down)
(define-key map "?" 'describe-mode)
+ (define-key map "\C-c\C-d" 'rmail-summary-epa-decrypt)
(define-key map "\C-c\C-n" 'rmail-summary-next-same-subject)
(define-key map "\C-c\C-p" 'rmail-summary-previous-same-subject)
(define-key map "\C-c\C-s\C-d" 'rmail-summary-sort-by-date)
@@ -532,8 +533,7 @@ message."
;; Set up the rest of its state and local variables.
(setq buffer-read-only t)
(rmail-summary-mode)
- (make-local-variable 'minor-mode-alist)
- (setq minor-mode-alist (list (list t (concat ": " description))))
+ (setq-local minor-mode-alist (list (list t (concat ": " description))))
(setq rmail-buffer rbuf
rmail-summary-redo redo
rmail-total-messages total)))
@@ -786,6 +786,11 @@ the message being processed."
;; To: =?UTF-8?Q?=C5=A0t=C4=9Bp=C3=A1n_?= =?UTF-8?Q?N=C4=9Bmec?=
;; <stepnem@gmail.com>
(setq from (rfc2047-decode-string from))
+ ;; We cannot tolerate any leftover newlines in From,
+ ;; as that disrupts the rmail-summary display.
+ ;; Newlines can be left in From if it was malformed,
+ ;; e.g. had unbalanced quotes.
+ (setq from (replace-regexp-in-string "\n+" " " from))
(setq len (length from))
(setq mch (string-match "[@%]" from))
(format "%25s"
@@ -1089,13 +1094,10 @@ Commands for sorting the summary:
(set-syntax-table text-mode-syntax-table)
(make-local-variable 'rmail-buffer)
(make-local-variable 'rmail-total-messages)
- (make-local-variable 'rmail-current-message)
- (setq rmail-current-message nil)
- (make-local-variable 'rmail-summary-redo)
- (setq rmail-summary-redo nil)
+ (setq-local rmail-current-message nil)
+ (setq-local rmail-summary-redo nil)
(make-local-variable 'revert-buffer-function)
- (make-local-variable 'font-lock-defaults)
- (setq font-lock-defaults '(rmail-summary-font-lock-keywords t))
+ (setq-local font-lock-defaults '(rmail-summary-font-lock-keywords t))
(rmail-summary-enable))
;; Summary features need to be disabled during edit mode.
@@ -1288,8 +1290,7 @@ Returns non-nil if message N was found."
;; Make sure we have an overlay to use.
(or rmail-summary-overlay
(progn
- (make-local-variable 'rmail-summary-overlay)
- (setq rmail-summary-overlay (make-overlay (point) (point)))
+ (setq-local rmail-summary-overlay (make-overlay (point) (point)))
(overlay-put rmail-summary-overlay 'rmail-summary t)))
;; If this message is in the summary, use the overlay to highlight it.
;; Otherwise, don't highlight anything.
@@ -1487,6 +1488,12 @@ argument says to read a file name and use that file as the inbox."
(rmail-edit-current-message)
(use-local-map rmail-summary-edit-map))
+(defun rmail-summary-epa-decrypt ()
+ "Decrypt this message."
+ (interactive)
+ (rmail-pop-to-buffer rmail-buffer)
+ (rmail-epa-decrypt))
+
(defun rmail-summary-cease-edit ()
"Finish editing message, then go back to Rmail summary buffer."
(interactive)
diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el
index 7610939e575..9f6fd6de224 100644
--- a/lisp/mail/sendmail.el
+++ b/lisp/mail/sendmail.el
@@ -1,6 +1,6 @@
;;; sendmail.el --- mail sending commands for Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1985-1986, 1992-1996, 1998, 2000-2020 Free Software
+;; Copyright (C) 1985-1986, 1992-1996, 1998, 2000-2021 Free Software
;; Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
@@ -691,29 +691,25 @@ Turning on Mail mode runs the normal hooks `text-mode-hook' and
(make-local-variable 'mail-reply-action)
(make-local-variable 'mail-send-actions)
(make-local-variable 'mail-return-action)
- (make-local-variable 'mail-encode-mml)
- (setq mail-encode-mml nil)
+ (setq-local mail-encode-mml nil)
(setq buffer-offer-save t)
- (make-local-variable 'font-lock-defaults)
- (setq font-lock-defaults '(mail-font-lock-keywords t t))
+ (setq-local font-lock-defaults '(mail-font-lock-keywords t t))
(make-local-variable 'paragraph-separate)
(setq-local normal-auto-fill-function #'mail-mode-auto-fill)
(setq-local fill-paragraph-function #'mail-mode-fill-paragraph)
;; Allow using comment commands to add/remove quoting (this only does
;; anything if mail-yank-prefix is set to a non-nil value).
- (set (make-local-variable 'comment-start) mail-yank-prefix)
+ (setq-local comment-start mail-yank-prefix)
(if mail-yank-prefix
- (set (make-local-variable 'comment-start-skip)
- (concat "^" (regexp-quote mail-yank-prefix) "[ \t]*")))
- (make-local-variable 'adaptive-fill-regexp)
+ (setq-local comment-start-skip
+ (concat "^" (regexp-quote mail-yank-prefix) "[ \t]*")))
;; Also update the paragraph-separate entry if you change this.
- (setq adaptive-fill-regexp
- (concat "[ \t]*[-[:alnum:]]+>+[ \t]*\\|"
- adaptive-fill-regexp))
- (make-local-variable 'adaptive-fill-first-line-regexp)
- (setq adaptive-fill-first-line-regexp
- (concat "[ \t]*[-[:alnum:]]*>+[ \t]*\\|"
- adaptive-fill-first-line-regexp))
+ (setq-local adaptive-fill-regexp
+ (concat "[ \t]*[-[:alnum:]]+>+[ \t]*\\|"
+ adaptive-fill-regexp))
+ (setq-local adaptive-fill-first-line-regexp
+ (concat "[ \t]*[-[:alnum:]]*>+[ \t]*\\|"
+ adaptive-fill-first-line-regexp))
(add-hook 'completion-at-point-functions #'mail-completion-at-point-function
nil 'local)
;; `-- ' precedes the signature. `-----' appears at the start of the
diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el
index 63c8f14085a..5526f2fbe64 100644
--- a/lisp/mail/smtpmail.el
+++ b/lisp/mail/smtpmail.el
@@ -1,6 +1,6 @@
;;; smtpmail.el --- simple SMTP protocol (RFC 821) for sending mail -*- lexical-binding:t -*-
-;; Copyright (C) 1995-1996, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995-1996, 2001-2021 Free Software Foundation, Inc.
;; Author: Tomoji Kagatani <kagatani@rbc.ncl.omron.co.jp>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/mail/supercite.el b/lisp/mail/supercite.el
index 986d0cf4074..5766c791878 100644
--- a/lisp/mail/supercite.el
+++ b/lisp/mail/supercite.el
@@ -1,6 +1,6 @@
;;; supercite.el --- minor mode for citing mail and news replies
-;; Copyright (C) 1993, 1997, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1997, 2001-2021 Free Software Foundation, Inc.
;; Author: 1993 Barry A. Warsaw <bwarsaw@python.org>
;; Maintainer: emacs-devel@gnu.org
@@ -618,10 +618,7 @@ the list should be unique."
(lambda (elt) (char-to-string (cdr elt))) alist "/")
") "))
(p prompt)
- (event
- (if (fboundp 'allocate-event)
- (allocate-event)
- nil)))
+ event)
(while (stringp p)
(if (let ((cursor-in-echo-area t)
(inhibit-quit t))
@@ -630,8 +627,6 @@ the list should be unique."
(prog1 quit-flag (setq quit-flag nil)))
(progn
(message "%s%s" p (single-key-description event))
- (if (fboundp 'deallocate-event)
- (deallocate-event event))
(setq quit-flag nil)
(signal 'quit '())))
(let ((char event)
@@ -650,8 +645,6 @@ the list should be unique."
(discard-input)
(if (eq p prompt)
(setq p (concat "Try again. " prompt)))))))
- (if (fboundp 'deallocate-event)
- (deallocate-event event))
p))
(defun sc-scan-info-alist (alist)
@@ -1028,17 +1021,16 @@ supplied, is used instead of the line point is on in the current buffer."
(setq position (1+ position))
(let ((keep-p t))
(mapc
- (function
- (lambda (filter)
- (let ((regexp (car filter))
- (pos (cdr filter)))
- (if (and (string-match regexp name)
- (or (and (numberp pos)
- (= pos position))
- (and (eq pos 'last)
- (= position (1- elements)))
- (eq pos 'any)))
- (setq keep-p nil)))))
+ (lambda (filter)
+ (let ((regexp (car filter))
+ (pos (cdr filter)))
+ (if (and (string-match regexp name)
+ (or (and (numberp pos)
+ (= pos position))
+ (and (eq pos 'last)
+ (= position (1- elements)))
+ (eq pos 'any)))
+ (setq keep-p nil))))
sc-name-filter-alist)
(if keep-p
(setq keepers (cons position keepers)))))
diff --git a/lisp/mail/uce.el b/lisp/mail/uce.el
index 2a1e4f35538..a573c8a2673 100644
--- a/lisp/mail/uce.el
+++ b/lisp/mail/uce.el
@@ -1,6 +1,6 @@
;;; uce.el --- facilitate reply to unsolicited commercial email
-;; Copyright (C) 1996, 1998, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1998, 2000-2021 Free Software Foundation, Inc.
;; Author: stanislav shalunov <shalunov@mccme.ru>
;; Created: 10 Dec 1996
diff --git a/lisp/mail/undigest.el b/lisp/mail/undigest.el
index 9ac5f35988b..bf57ed6fa6f 100644
--- a/lisp/mail/undigest.el
+++ b/lisp/mail/undigest.el
@@ -1,6 +1,6 @@
;;; undigest.el --- digest-cracking support for the RMAIL mail reader -*- lexical-binding:t -*-
-;; Copyright (C) 1985-1986, 1994, 1996, 2001-2020 Free Software
+;; Copyright (C) 1985-1986, 1994, 1996, 2001-2021 Free Software
;; Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/mail/unrmail.el b/lisp/mail/unrmail.el
index e1f137819dc..34de416c959 100644
--- a/lisp/mail/unrmail.el
+++ b/lisp/mail/unrmail.el
@@ -1,6 +1,6 @@
;;; unrmail.el --- convert Rmail Babyl files to mbox files
-;; Copyright (C) 1992, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 2001-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: mail
diff --git a/lisp/mail/uudecode.el b/lisp/mail/uudecode.el
index bcbd571b539..fdd402e0fa0 100644
--- a/lisp/mail/uudecode.el
+++ b/lisp/mail/uudecode.el
@@ -1,6 +1,6 @@
;;; uudecode.el -- elisp native uudecode -*- lexical-binding:t -*-
-;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
;; Keywords: uudecode news
@@ -149,12 +149,10 @@ If FILE-NAME is non-nil, save the result to FILE-NAME."
(setq counter (1+ counter)
inputpos (1+ inputpos))
(cond ((= counter 4)
- (setq result (cons
- (concat
- (char-to-string (ash bits -16))
- (char-to-string (logand (ash bits -8) 255))
- (char-to-string (logand bits 255)))
- result))
+ (setq result (cons (logand bits 255)
+ (cons (logand (ash bits -8) 255)
+ (cons (ash bits -16)
+ result))))
(setq bits 0 counter 0))
(t (setq bits (ash bits 6)))))))
(cond
@@ -166,26 +164,26 @@ If FILE-NAME is non-nil, save the result to FILE-NAME."
;;(error "uucode ends unexpectedly")
(setq done t))
((= counter 3)
- (setq result (cons
- (concat
- (char-to-string (logand (ash bits -16) 255))
- (char-to-string (logand (ash bits -8) 255)))
- result)))
+ (setq result (cons (logand (ash bits -8) 255)
+ (cons (logand (ash bits -16) 255)
+ result))))
((= counter 2)
- (setq result (cons
- (char-to-string (logand (ash bits -10) 255))
- result))))
+ (setq result (cons (logand (ash bits -10) 255)
+ result))))
(skip-chars-forward non-data-chars end))
(if file-name
(with-temp-file file-name
(set-buffer-multibyte nil)
- (insert (apply #'concat (nreverse result))))
+ (apply #'insert (nreverse result)))
(or (markerp end) (setq end (set-marker (make-marker) end)))
(goto-char start)
- (if enable-multibyte-characters
- (dolist (x (nreverse result))
- (insert (decode-coding-string x 'binary)))
- (insert (apply #'concat (nreverse result))))
+ (apply #'insert
+ (nreverse
+ (if enable-multibyte-characters
+ (mapcar (lambda (ch)
+ (or (decode-char 'eight-bit ch) ch))
+ result)
+ result)))
(delete-region (point) end))))))
;;;###autoload
diff --git a/lisp/mail/yenc.el b/lisp/mail/yenc.el
index 58e2965940b..0ab6d85da8e 100644
--- a/lisp/mail/yenc.el
+++ b/lisp/mail/yenc.el
@@ -1,6 +1,6 @@
;;; yenc.el --- elisp native yenc decoder -*- lexical-binding:t -*-
-;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Author: Jesper Harder <harder@ifa.au.dk>
;; Keywords: yenc news
diff --git a/lisp/makesum.el b/lisp/makesum.el
index 673cb15d11e..a7e88dbaa2a 100644
--- a/lisp/makesum.el
+++ b/lisp/makesum.el
@@ -1,6 +1,6 @@
;;; makesum.el --- generate key binding summary for Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1985, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 2001-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: help
diff --git a/lisp/man.el b/lisp/man.el
index bd55d7eff06..ca50b3a2fa3 100644
--- a/lisp/man.el
+++ b/lisp/man.el
@@ -1,6 +1,6 @@
;;; man.el --- browse UNIX manual pages -*- lexical-binding: t -*-
-;; Copyright (C) 1993-1994, 1996-1997, 2001-2020 Free Software
+;; Copyright (C) 1993-1994, 1996-1997, 2001-2021 Free Software
;; Foundation, Inc.
;; Author: Barry A. Warsaw <bwarsaw@cen.com>
@@ -90,7 +90,6 @@
(require 'ansi-color)
(require 'cl-lib)
-(require 'button)
(defgroup man nil
"Browse UNIX manual pages."
@@ -1109,7 +1108,6 @@ Return the buffer in which the manpage will appear."
(buffer (get-buffer bufname)))
(if buffer
(Man-notify-when-ready buffer)
- (require 'env)
(message "Invoking %s %s in the background" manual-program man-args)
(setq buffer (generate-new-buffer bufname))
(with-current-buffer buffer
@@ -1585,10 +1583,10 @@ The following key bindings are currently in effect in the buffer:
(auto-fill-mode -1)
(setq imenu-generic-expression (list (list nil Man-heading-regexp 0)))
(imenu-add-to-menubar man-imenu-title)
- (set (make-local-variable 'outline-regexp) Man-heading-regexp)
- (set (make-local-variable 'outline-level) (lambda () 1))
- (set (make-local-variable 'bookmark-make-record-function)
- 'Man-bookmark-make-record)
+ (setq-local outline-regexp Man-heading-regexp)
+ (setq-local outline-level (lambda () 1))
+ (setq-local bookmark-make-record-function
+ #'Man-bookmark-make-record)
(add-hook 'window-state-change-functions #'Man--window-state-change nil t))
(defun Man-build-section-list ()
diff --git a/lisp/master.el b/lisp/master.el
index 32556a535f3..796f2189d66 100644
--- a/lisp/master.el
+++ b/lisp/master.el
@@ -1,6 +1,6 @@
;;; master.el --- make a buffer the master over another buffer
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Alex Schroeder <alex@gnu.org>
;; Old-Version: 1.0.2
@@ -96,8 +96,7 @@ yourself the value of `master-of' by calling `master-show-slave'."
"Makes BUFFER the slave of the current buffer.
Use \\[master-mode] to toggle control of the slave buffer."
(interactive "bSlave: ")
- (make-local-variable 'master-of)
- (setq master-of buffer)
+ (setq-local master-of buffer)
(run-hooks 'master-set-slave-hook))
(defun master-show-slave ()
diff --git a/lisp/mb-depth.el b/lisp/mb-depth.el
index 7ee7525d9f3..f9a24e34bf2 100644
--- a/lisp/mb-depth.el
+++ b/lisp/mb-depth.el
@@ -1,6 +1,6 @@
;;; mb-depth.el --- Indicate minibuffer-depth in prompt -*- lexical-binding: t -*-
;;
-;; Copyright (C) 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2021 Free Software Foundation, Inc.
;;
;; Author: Miles Bader <miles@gnu.org>
;; Keywords: convenience
@@ -35,6 +35,11 @@
It is called with one argument, the minibuffer depth,
and must return a string.")
+(defface minibuffer-depth-indicator '((t :inherit highlight))
+ "Face to use for minibuffer depth indicator."
+ :group 'minibuffer
+ :version "28.1")
+
;; An overlay covering the prompt. This is a buffer-local variable in
;; each affected minibuffer.
;;
@@ -52,7 +57,10 @@ The prompt should already have been inserted."
(overlay-put minibuffer-depth-overlay 'before-string
(if minibuffer-depth-indicator-function
(funcall minibuffer-depth-indicator-function depth)
- (propertize (format "[%d]" depth) 'face 'highlight)))
+ (concat (propertize (format "[%d]" depth)
+ 'face
+ 'minibuffer-depth-indicator)
+ " ")))
(overlay-put minibuffer-depth-overlay 'evaporate t))))
;;;###autoload
diff --git a/lisp/md4.el b/lisp/md4.el
index 11c91307afc..771d9f9f0d4 100644
--- a/lisp/md4.el
+++ b/lisp/md4.el
@@ -1,6 +1,6 @@
;;; md4.el --- MD4 Message Digest Algorithm. -*- lexical-binding: t -*-
-;; Copyright (C) 2001, 2004, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2004, 2007-2021 Free Software Foundation, Inc.
;; Author: Taro Kawagishi <tarok@transpulse.org>
;; Keywords: MD4
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index c6ced689a67..526491f0272 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -1,6 +1,6 @@
-;;; menu-bar.el --- define a default menu bar
+;;; menu-bar.el --- define a default menu bar -*- lexical-binding: t; -*-
-;; Copyright (C) 1993-1995, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1995, 2000-2021 Free Software Foundation, Inc.
;; Author: Richard M. Stallman
;; Maintainer: emacs-devel@gnu.org
@@ -229,7 +229,8 @@
(filename (car (find-file-read-args "Find file: " mustmatch))))
(if mustmatch
(find-file-existing filename)
- (find-file filename))))
+ (with-suppressed-warnings ((interactive-only find-file))
+ (find-file filename)))))
;; The "Edit->Search" submenu
(defvar menu-bar-last-search-type nil
diff --git a/lisp/mh-e/ChangeLog.1 b/lisp/mh-e/ChangeLog.1
index d30441f91a8..f1aeca65479 100644
--- a/lisp/mh-e/ChangeLog.1
+++ b/lisp/mh-e/ChangeLog.1
@@ -11419,7 +11419,7 @@
(dist): Leave release in current directory.
- Copyright (C) 2003-2020 Free Software Foundation, Inc.
+ Copyright (C) 2003-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/mh-e/ChangeLog.2 b/lisp/mh-e/ChangeLog.2
index 02a0c07a570..b6b16f7d79c 100644
--- a/lisp/mh-e/ChangeLog.2
+++ b/lisp/mh-e/ChangeLog.2
@@ -3673,7 +3673,7 @@
See ChangeLog.1 for earlier changes.
- Copyright (C) 2005-2020 Free Software Foundation, Inc.
+ Copyright (C) 2005-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/mh-e/mh-acros.el b/lisp/mh-e/mh-acros.el
index 8e610ec2740..af6f2f1ab02 100644
--- a/lisp/mh-e/mh-acros.el
+++ b/lisp/mh-e/mh-acros.el
@@ -1,6 +1,6 @@
;;; mh-acros.el --- macros used in MH-E
-;; Copyright (C) 2004, 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2004, 2006-2021 Free Software Foundation, Inc.
;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
;; Maintainer: Bill Wohler <wohler@newt.com>
diff --git a/lisp/mh-e/mh-alias.el b/lisp/mh-e/mh-alias.el
index cc437c3c49b..012725cab60 100644
--- a/lisp/mh-e/mh-alias.el
+++ b/lisp/mh-e/mh-alias.el
@@ -1,6 +1,6 @@
;;; mh-alias.el --- MH-E mail alias completion and expansion
-;; Copyright (C) 1994-1997, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1997, 2001-2021 Free Software Foundation, Inc.
;; Author: Peter S. Galbraith <psg@debian.org>
;; Maintainer: Bill Wohler <wohler@newt.com>
@@ -73,12 +73,11 @@ If ARG is non-nil, set timestamp with the current time."
(setq mh-alias-tstamp (list (nth 0 time) (nth 1 time))))
(let ((stamp))
(car (memq t (mapcar
- (function
- (lambda (file)
- (when (and file (file-exists-p file))
- (setq stamp (file-attribute-modification-time
- (file-attributes file)))
- (time-less-p mh-alias-tstamp stamp))))
+ (lambda (file)
+ (when (and file (file-exists-p file))
+ (setq stamp (file-attribute-modification-time
+ (file-attributes file)))
+ (time-less-p mh-alias-tstamp stamp)))
(mh-alias-filenames t)))))))
(defun mh-alias-filenames (arg)
@@ -93,11 +92,10 @@ appended."
(filelist (and filename (split-string filename "[ \t]+")))
(userlist
(mapcar
- (function
- (lambda (file)
- (if (and mh-user-path file
- (file-exists-p (expand-file-name file mh-user-path)))
- (expand-file-name file mh-user-path))))
+ (lambda (file)
+ (if (and mh-user-path file
+ (file-exists-p (expand-file-name file mh-user-path)))
+ (expand-file-name file mh-user-path)))
filelist)))
(if arg
(if (stringp mh-alias-system-aliases)
@@ -466,12 +464,11 @@ set `mh-alias-insert-file' or the \"Aliasfile:\" profile component"))
;; Double-check that we have an individual alias. This means that the
;; alias doesn't expand into a list (of which this address is part).
(car (delq nil (mapcar
- (function
- (lambda (alias)
- (let ((recurse (mh-alias-ali alias nil)))
- (if (string-match ".*,.*" recurse)
- nil
- alias))))
+ (lambda (alias)
+ (let ((recurse (mh-alias-ali alias nil)))
+ (if (string-match ".*,.*" recurse)
+ nil
+ alias)))
(split-string aliases ", +")))))))
;;;###mh-autoload
diff --git a/lisp/mh-e/mh-buffers.el b/lisp/mh-e/mh-buffers.el
index f1334b820fa..55f74b6585d 100644
--- a/lisp/mh-e/mh-buffers.el
+++ b/lisp/mh-e/mh-buffers.el
@@ -1,6 +1,6 @@
;;; mh-buffers.el --- MH-E buffer constants and utilities
-;; Copyright (C) 1993, 1995, 1997, 2000-2020 Free Software Foundation,
+;; Copyright (C) 1993, 1995, 1997, 2000-2021 Free Software Foundation,
;; Inc.
;; Author: Bill Wohler <wohler@newt.com>
diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el
index 8a69adbb756..0dedb7e0ad0 100644
--- a/lisp/mh-e/mh-comp.el
+++ b/lisp/mh-e/mh-comp.el
@@ -1,6 +1,6 @@
;;; mh-comp.el --- MH-E functions for composing and sending messages
-;; Copyright (C) 1993, 1995, 1997, 2000-2020 Free Software Foundation,
+;; Copyright (C) 1993, 1995, 1997, 2000-2021 Free Software Foundation,
;; Inc.
;; Author: Bill Wohler <wohler@newt.com>
@@ -435,43 +435,42 @@ See also `mh-send'."
(mh-insert-header-separator)
;; Merge in components
(mh-mapc
- (function
- (lambda (header-field)
- (let ((field (car header-field))
- (value (cdr header-field))
- (case-fold-search t))
- (cond
- ;; Address field
- ((string-match field "^To$\\|^Cc$\\|^From$")
- (cond
- ((not (mh-goto-header-field (concat field ":")))
- ;; Header field does not exist, add it
- (mh-goto-header-end 0)
- (insert field ": " value "\n"))
- ((string-equal value "")
- ;; Header field already exists and no value
- )
- (t
- ;; Header field exists and we have a value
- (let (address mailbox (alias (mh-alias-expand value)))
- (and alias
- (setq address (ietf-drums-parse-address alias))
- (setq mailbox (car address)))
- ;; XXX - Need to parse all addresses out of field
- (if (and
- (not (mh-regexp-in-field-p
- (concat "\\b" (regexp-quote value) "\\b") field))
- mailbox
- (not (mh-regexp-in-field-p
- (concat "\\b" (regexp-quote mailbox) "\\b") field)))
- (insert " " value ","))
- ))))
- ((string-match field "^Fcc$")
- ;; Folder reference
- (mh-modify-header-field field value))
- ;; Text field, that's an easy case
- (t
- (mh-modify-header-field field value))))))
+ (lambda (header-field)
+ (let ((field (car header-field))
+ (value (cdr header-field))
+ (case-fold-search t))
+ (cond
+ ;; Address field
+ ((string-match field "^To$\\|^Cc$\\|^From$")
+ (cond
+ ((not (mh-goto-header-field (concat field ":")))
+ ;; Header field does not exist, add it
+ (mh-goto-header-end 0)
+ (insert field ": " value "\n"))
+ ((string-equal value "")
+ ;; Header field already exists and no value
+ )
+ (t
+ ;; Header field exists and we have a value
+ (let (address mailbox (alias (mh-alias-expand value)))
+ (and alias
+ (setq address (ietf-drums-parse-address alias))
+ (setq mailbox (car address)))
+ ;; XXX - Need to parse all addresses out of field
+ (if (and
+ (not (mh-regexp-in-field-p
+ (concat "\\b" (regexp-quote value) "\\b") field))
+ mailbox
+ (not (mh-regexp-in-field-p
+ (concat "\\b" (regexp-quote mailbox) "\\b") field)))
+ (insert " " value ","))
+ ))))
+ ((string-match field "^Fcc$")
+ ;; Folder reference
+ (mh-modify-header-field field value))
+ ;; Text field, that's an easy case
+ (t
+ (mh-modify-header-field field value)))))
(mh-components-to-list components-file))
(delete-file components-file)
(goto-char (point-min))
@@ -700,25 +699,24 @@ message and scan line."
;; trumping anything in the distcomps file.
(let ((components-file (mh-bare-components mh-dist-formfile)))
(mh-mapc
- (function
- (lambda (header-field)
- (let ((field (car header-field))
- (value (cdr header-field))
- (case-fold-search t))
- (cond
- ((string-match field "^Resent-Fcc$")
- (setq comp-fcc value))
- ((string-match field "^Resent-From$")
- (or from
- (setq from value)))
- ((string-match field "^Resent-To$")
- (setq comp-to value))
- ((string-match field "^Resent-Cc$")
- (setq comp-cc value))
- ((string-match field "^Resent-Bcc$")
- (setq comp-bcc value))
- ((string-match field "^Resent-.*$")
- (mh-insert-fields field value))))))
+ (lambda (header-field)
+ (let ((field (car header-field))
+ (value (cdr header-field))
+ (case-fold-search t))
+ (cond
+ ((string-match field "^Resent-Fcc$")
+ (setq comp-fcc value))
+ ((string-match field "^Resent-From$")
+ (or from
+ (setq from value)))
+ ((string-match field "^Resent-To$")
+ (setq comp-to value))
+ ((string-match field "^Resent-Cc$")
+ (setq comp-cc value))
+ ((string-match field "^Resent-Bcc$")
+ (setq comp-bcc value))
+ ((string-match field "^Resent-.*$")
+ (mh-insert-fields field value)))))
(mh-components-to-list components-file))
(delete-file components-file))
(mh-insert-fields "Resent-To:" (mapconcat 'identity (list to comp-to) ", ")
diff --git a/lisp/mh-e/mh-compat.el b/lisp/mh-e/mh-compat.el
index c02b095b2ea..07bf03b30ee 100644
--- a/lisp/mh-e/mh-compat.el
+++ b/lisp/mh-e/mh-compat.el
@@ -1,6 +1,6 @@
;;; mh-compat.el --- make MH-E compatible with various versions of Emacs
-;; Copyright (C) 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2021 Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Keywords: mail
diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el
index 3ac5c8f7aed..9185c2a0645 100644
--- a/lisp/mh-e/mh-e.el
+++ b/lisp/mh-e/mh-e.el
@@ -1,6 +1,6 @@
;;; mh-e.el --- GNU Emacs interface to the MH mail system
-;; Copyright (C) 1985-1988, 1990, 1992-1995, 1997, 1999-2020 Free
+;; Copyright (C) 1985-1988, 1990, 1992-1995, 1997, 1999-2021 Free
;; Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
@@ -3182,7 +3182,7 @@ folder, which is also available in `mh-current-folder'."
:package-version '(MH-E . "8.0"))
(defcustom-mh mh-annotate-msg-hook nil
- "Hook run whenever a message is sent and after the scan lines and message are annotated.
+ "Hook run when a message is sent and after annotating the scan lines and message.
Hook functions can access the current folder name with
`mh-current-folder' and obtain the message numbers of the
annotated messages with `mh-annotate-list'."
diff --git a/lisp/mh-e/mh-folder.el b/lisp/mh-e/mh-folder.el
index 0a73ff45c2a..555d13d7235 100644
--- a/lisp/mh-e/mh-folder.el
+++ b/lisp/mh-e/mh-folder.el
@@ -1,6 +1,6 @@
;;; mh-folder.el --- MH-Folder mode
-;; Copyright (C) 2002-2003, 2005-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2003, 2005-2021 Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Keywords: mail
@@ -656,9 +656,10 @@ perform the operation on all messages in that region.
(mh-funcall-if-exists hl-line-mode 1)
(setq revert-buffer-function 'mh-undo-folder)
(add-to-list 'minor-mode-alist '(mh-showing-mode " Show"))
- (easy-menu-add mh-folder-sequence-menu)
- (easy-menu-add mh-folder-message-menu)
- (easy-menu-add mh-folder-folder-menu)
+ (mh-do-in-xemacs
+ (easy-menu-add mh-folder-sequence-menu)
+ (easy-menu-add mh-folder-message-menu)
+ (easy-menu-add mh-folder-folder-menu))
(mh-inc-spool-make)
(mh-set-help mh-folder-mode-help-messages)
(if (and (featurep 'xemacs)
diff --git a/lisp/mh-e/mh-funcs.el b/lisp/mh-e/mh-funcs.el
index 66cea013595..309bcb4b49f 100644
--- a/lisp/mh-e/mh-funcs.el
+++ b/lisp/mh-e/mh-funcs.el
@@ -1,6 +1,6 @@
;;; mh-funcs.el --- MH-E functions not everyone will use right away
-;; Copyright (C) 1993, 1995, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1995, 2001-2021 Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Keywords: mail
diff --git a/lisp/mh-e/mh-gnus.el b/lisp/mh-e/mh-gnus.el
index 12a0f624dda..6a9851662ab 100644
--- a/lisp/mh-e/mh-gnus.el
+++ b/lisp/mh-e/mh-gnus.el
@@ -1,6 +1,6 @@
;;; mh-gnus.el --- make MH-E compatible with various versions of Gnus
-;; Copyright (C) 2003-2004, 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2004, 2006-2021 Free Software Foundation, Inc.
;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
;; Maintainer: Bill Wohler <wohler@newt.com>
diff --git a/lisp/mh-e/mh-identity.el b/lisp/mh-e/mh-identity.el
index ebc7d2a4fcb..18443992177 100644
--- a/lisp/mh-e/mh-identity.el
+++ b/lisp/mh-e/mh-identity.el
@@ -1,6 +1,6 @@
;;; mh-identity.el --- multiple identify support for MH-E
-;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Author: Peter S. Galbraith <psg@debian.org>
;; Maintainer: Bill Wohler <wohler@newt.com>
@@ -71,10 +71,9 @@ See `mh-identity-add-menu'."
(mh-insert-auto-fields) mh-auto-fields-list]
"--")
- (mapcar (function
- (lambda (arg)
- `[,arg (mh-insert-identity ,arg) :style radio
- :selected (equal mh-identity-local ,arg)]))
+ (mapcar (lambda (arg)
+ `[,arg (mh-insert-identity ,arg) :style radio
+ :selected (equal mh-identity-local ,arg)])
(mapcar 'car mh-identity-list))
'(["None"
(mh-insert-identity "None") :style radio
@@ -92,7 +91,7 @@ See `mh-identity-add-menu'."
"Add the current Identity menu.
See `mh-identity-make-menu'."
(if mh-identity-menu
- (easy-menu-add mh-identity-menu)))
+ (mh-do-in-xemacs (easy-menu-add mh-identity-menu))))
(defvar mh-identity-local nil
"Buffer-local variable that holds the identity currently in use.")
diff --git a/lisp/mh-e/mh-inc.el b/lisp/mh-e/mh-inc.el
index bff99b76979..32f731799b9 100644
--- a/lisp/mh-e/mh-inc.el
+++ b/lisp/mh-e/mh-inc.el
@@ -1,6 +1,6 @@
;;; mh-inc.el --- MH-E "inc" and separate mail spool handling
-;; Copyright (C) 2003-2004, 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2004, 2006-2021 Free Software Foundation, Inc.
;; Author: Peter S. Galbraith <psg@debian.org>
;; Maintainer: Bill Wohler <wohler@newt.com>
diff --git a/lisp/mh-e/mh-junk.el b/lisp/mh-e/mh-junk.el
index ebc5038a194..b49c6322492 100644
--- a/lisp/mh-e/mh-junk.el
+++ b/lisp/mh-e/mh-junk.el
@@ -1,6 +1,6 @@
;;; mh-junk.el --- MH-E interface to anti-spam measures
-;; Copyright (C) 2003-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
;; Author: Satyaki Das <satyaki@theforce.stanford.edu>,
;; Bill Wohler <wohler@newt.com>
diff --git a/lisp/mh-e/mh-letter.el b/lisp/mh-e/mh-letter.el
index 5e1ce403188..f5ad73d800d 100644
--- a/lisp/mh-e/mh-letter.el
+++ b/lisp/mh-e/mh-letter.el
@@ -1,6 +1,6 @@
;;; mh-letter.el --- MH-Letter mode
-;; Copyright (C) 1993, 1995, 1997, 2000-2020 Free Software Foundation,
+;; Copyright (C) 1993, 1995, 1997, 2000-2021 Free Software Foundation,
;; Inc.
;; Author: Bill Wohler <wohler@newt.com>
@@ -330,7 +330,7 @@ order).
(t
;; ...or the header only
(setq font-lock-defaults '((mh-show-font-lock-keywords) t))))
- (easy-menu-add mh-letter-menu)
+ (mh-do-in-xemacs (easy-menu-add mh-letter-menu))
;; Maybe we want to use the existing Mail menu from mail-mode in
;; 9.0; in the mean time, let's remove it since the redundancy will
;; only produce confusion.
diff --git a/lisp/mh-e/mh-limit.el b/lisp/mh-e/mh-limit.el
index d4577807c92..036522f3ddd 100644
--- a/lisp/mh-e/mh-limit.el
+++ b/lisp/mh-e/mh-limit.el
@@ -1,6 +1,6 @@
;;; mh-limit.el --- MH-E display limits
-;; Copyright (C) 2001-2003, 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2003, 2006-2021 Free Software Foundation, Inc.
;; Author: Peter S. Galbraith <psg@debian.org>
;; Keywords: mail
diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el
index dc9d17aebad..7bdf743fc42 100644
--- a/lisp/mh-e/mh-mime.el
+++ b/lisp/mh-e/mh-mime.el
@@ -1,6 +1,6 @@
;;; mh-mime.el --- MH-E MIME support
-;; Copyright (C) 1993, 1995, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1995, 2001-2021 Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Keywords: mail
diff --git a/lisp/mh-e/mh-print.el b/lisp/mh-e/mh-print.el
index 7779ec0d90d..513a1bc953d 100644
--- a/lisp/mh-e/mh-print.el
+++ b/lisp/mh-e/mh-print.el
@@ -1,6 +1,6 @@
;;; mh-print.el --- MH-E printing support
-;; Copyright (C) 2003-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
;; Author: Jeffrey C Honig <jch@honig.net>
;; Maintainer: Bill Wohler <wohler@newt.com>
diff --git a/lisp/mh-e/mh-scan.el b/lisp/mh-e/mh-scan.el
index a0addcb77d5..cec331389b0 100644
--- a/lisp/mh-e/mh-scan.el
+++ b/lisp/mh-e/mh-scan.el
@@ -1,6 +1,6 @@
;;; mh-scan.el --- MH-E scan line constants and utilities
-;; Copyright (C) 1993, 1995, 1997, 2000-2020 Free Software Foundation,
+;; Copyright (C) 1993, 1995, 1997, 2000-2021 Free Software Foundation,
;; Inc.
;; Author: Bill Wohler <wohler@newt.com>
diff --git a/lisp/mh-e/mh-search.el b/lisp/mh-e/mh-search.el
index 6fb76beff27..05ba12d7617 100644
--- a/lisp/mh-e/mh-search.el
+++ b/lisp/mh-e/mh-search.el
@@ -1,6 +1,6 @@
;;; mh-search --- MH-Search mode
-;; Copyright (C) 1993, 1995, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1995, 2001-2021 Free Software Foundation, Inc.
;; Author: Indexed search by Satyaki Das <satyaki@theforce.stanford.edu>
;; Maintainer: Bill Wohler <wohler@newt.com>
@@ -618,7 +618,7 @@ The hook `mh-search-mode-hook' is called upon entry to this mode.
\\{mh-search-mode-map}"
- (easy-menu-add mh-pick-menu)
+ (mh-do-in-xemacs (easy-menu-add mh-pick-menu))
(mh-set-help mh-search-mode-help-messages))
diff --git a/lisp/mh-e/mh-seq.el b/lisp/mh-e/mh-seq.el
index 41c8489e16b..e8a03f6704b 100644
--- a/lisp/mh-e/mh-seq.el
+++ b/lisp/mh-e/mh-seq.el
@@ -1,6 +1,6 @@
;;; mh-seq.el --- MH-E sequences support
-;; Copyright (C) 1993, 1995, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1995, 2001-2021 Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Keywords: mail
@@ -794,9 +794,9 @@ If SAVE-REFILES is non-nil, then keep the sequences
that note messages to be refiled."
(let ((seqs ()))
(cond (save-refiles
- (mh-mapc (function (lambda (seq) ; Save the refiling sequences
- (if (mh-folder-name-p (mh-seq-name seq))
- (setq seqs (cons seq seqs)))))
+ (mh-mapc (lambda (seq) ; Save the refiling sequences
+ (if (mh-folder-name-p (mh-seq-name seq))
+ (setq seqs (cons seq seqs))))
mh-seq-list)))
(save-excursion
(if (eq 0 (mh-exec-cmd-quiet nil "mark" folder "-list"))
diff --git a/lisp/mh-e/mh-show.el b/lisp/mh-e/mh-show.el
index 7536f949e76..9ad843c3259 100644
--- a/lisp/mh-e/mh-show.el
+++ b/lisp/mh-e/mh-show.el
@@ -1,6 +1,6 @@
;;; mh-show.el --- MH-Show mode
-;; Copyright (C) 1993, 1995, 1997, 2000-2020 Free Software Foundation,
+;; Copyright (C) 1993, 1995, 1997, 2000-2021 Free Software Foundation,
;; Inc.
;; Author: Bill Wohler <wohler@newt.com>
@@ -863,9 +863,10 @@ See also `mh-folder-mode'.
(when mh-decode-mime-flag
(mh-make-local-hook 'kill-buffer-hook)
(add-hook 'kill-buffer-hook 'mh-mime-cleanup nil t))
- (easy-menu-add mh-show-sequence-menu)
- (easy-menu-add mh-show-message-menu)
- (easy-menu-add mh-show-folder-menu)
+ (mh-do-in-xemacs
+ (easy-menu-add mh-show-sequence-menu)
+ (easy-menu-add mh-show-message-menu)
+ (easy-menu-add mh-show-folder-menu))
(make-local-variable 'mh-show-folder-buffer)
(buffer-disable-undo)
(use-local-map mh-show-mode-map))
diff --git a/lisp/mh-e/mh-speed.el b/lisp/mh-e/mh-speed.el
index 0732a16dc7d..35d5884b16c 100644
--- a/lisp/mh-e/mh-speed.el
+++ b/lisp/mh-e/mh-speed.el
@@ -1,6 +1,6 @@
;;; mh-speed.el --- MH-E speedbar support
-;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
;; Maintainer: Bill Wohler <wohler@newt.com>
diff --git a/lisp/mh-e/mh-thread.el b/lisp/mh-e/mh-thread.el
index e6ee87b8411..365746259af 100644
--- a/lisp/mh-e/mh-thread.el
+++ b/lisp/mh-e/mh-thread.el
@@ -1,6 +1,6 @@
;;; mh-thread.el --- MH-E threading support
-;; Copyright (C) 2002-2004, 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2004, 2006-2021 Free Software Foundation, Inc.
;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
;; Maintainer: Bill Wohler <wohler@newt.com>
diff --git a/lisp/mh-e/mh-tool-bar.el b/lisp/mh-e/mh-tool-bar.el
index b1e417741b2..7dbddbc891b 100644
--- a/lisp/mh-e/mh-tool-bar.el
+++ b/lisp/mh-e/mh-tool-bar.el
@@ -1,6 +1,6 @@
;;; mh-tool-bar.el --- MH-E tool bar support
-;; Copyright (C) 2002-2003, 2005-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2003, 2005-2021 Free Software Foundation, Inc.
;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
;; Maintainer: Bill Wohler <wohler@newt.com>
diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el
index 44b4ef48795..d7c607df5c3 100644
--- a/lisp/mh-e/mh-utils.el
+++ b/lisp/mh-e/mh-utils.el
@@ -1,6 +1,6 @@
;;; mh-utils.el --- MH-E general utilities
-;; Copyright (C) 1993, 1995, 1997, 2000-2020 Free Software Foundation,
+;; Copyright (C) 1993, 1995, 1997, 2000-2021 Free Software Foundation,
;; Inc.
;; Author: Bill Wohler <wohler@newt.com>
@@ -270,9 +270,8 @@ and displayed in a help buffer."
(cdr (assoc nil (assoc major-mode mh-help-messages)))))
(text (substitute-command-keys (mapconcat 'identity help ""))))
(with-electric-help
- (function
- (lambda ()
- (insert text)))
+ (lambda ()
+ (insert text))
mh-help-buffer)))
;;;###mh-autoload
diff --git a/lisp/mh-e/mh-xface.el b/lisp/mh-e/mh-xface.el
index 909f1fe95d9..036575a8e64 100644
--- a/lisp/mh-e/mh-xface.el
+++ b/lisp/mh-e/mh-xface.el
@@ -1,6 +1,6 @@
;;; mh-xface.el --- MH-E X-Face and Face header field display
-;; Copyright (C) 2002-2003, 2005-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2003, 2005-2021 Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Keywords: mail
@@ -425,8 +425,7 @@ After the image is fetched, it is stored in CACHE-FILE. It will
be displayed in a buffer and position specified by MARKER. The
actual display is carried out by the SENTINEL function."
(if mh-wget-executable
- (let ((buffer (get-buffer-create (generate-new-buffer-name
- mh-temp-fetch-buffer)))
+ (let ((buffer (generate-new-buffer mh-temp-fetch-buffer))
(filename (or (mh-funcall-if-exists make-temp-file "mhe-fetch")
(expand-file-name (make-temp-name "~/mhe-fetch")))))
(with-current-buffer buffer
diff --git a/lisp/midnight.el b/lisp/midnight.el
index 69e6f0ce42b..8b798926c1c 100644
--- a/lisp/midnight.el
+++ b/lisp/midnight.el
@@ -1,6 +1,6 @@
;;; midnight.el --- run something every midnight, e.g., kill old buffers -*- lexical-binding:t -*-
-;; Copyright (C) 1998, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2001-2021 Free Software Foundation, Inc.
;; Author: Sam Steingold <sds@gnu.org>
;; Created: 1998-05-18
diff --git a/lisp/minibuf-eldef.el b/lisp/minibuf-eldef.el
index 363899d2656..30273fab1b8 100644
--- a/lisp/minibuf-eldef.el
+++ b/lisp/minibuf-eldef.el
@@ -1,6 +1,6 @@
;;; minibuf-eldef.el --- Only show defaults in prompts when applicable -*- lexical-binding: t -*-
;;
-;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;;
;; Author: Miles Bader <miles@gnu.org>
;; Keywords: convenience
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 5a41e2f30bd..315f2d369af 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1,6 +1,6 @@
;;; minibuffer.el --- Minibuffer completion functions -*- lexical-binding: t -*-
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Package: emacs
@@ -83,7 +83,6 @@
;; - add support for ** to pcm.
;; - Add vc-file-name-completion-table to read-file-name-internal.
-;; - A feature like completing-help.el.
;;; Code:
@@ -121,6 +120,11 @@ This metadata is an alist. Currently understood keys are:
- `annotation-function': function to add annotations in *Completions*.
Takes one argument (STRING), which is a possible completion and
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
+ 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*.
Takes one argument (COMPLETIONS) and should return a new list
of completions. Can operate destructively.
@@ -701,7 +705,7 @@ The text is displayed for `minibuffer-message-timeout' seconds,
or until the next input event arrives, whichever comes first.
Enclose MESSAGE in [...] if this is not yet the case.
If ARGS are provided, then pass MESSAGE through `format-message'."
- (if (not (minibufferp (current-buffer)))
+ (if (not (minibufferp (current-buffer) t))
(progn
(if args
(apply #'message message args)
@@ -952,6 +956,7 @@ styles for specific categories, such as files, buffers, etc."
;; A new style that combines substring and pcm might be better,
;; e.g. one that does not anchor to bos.
(project-file (styles . (substring)))
+ (xref-location (styles . (substring)))
(info-menu (styles . (basic substring))))
"Default settings for specific completion categories.
Each entry has the shape (CATEGORY . ALIST) where ALIST is
@@ -1131,6 +1136,7 @@ completion candidates than this number."
(defvar-local completion-all-sorted-completions nil)
(defvar-local completion--all-sorted-completions-location nil)
(defvar completion-cycling nil) ;Function that takes down the cycling map.
+(defvar completion-tab-width nil)
(defvar completion-fail-discreetly nil
"If non-nil, stay quiet when there is no match.")
@@ -1669,18 +1675,27 @@ Return nil if there is no valid completion, else t."
(#b000 nil)
(_ t))))
-(defface completions-annotations '((t :inherit italic))
+(defface completions-annotations '((t :inherit (italic shadow)))
"Face to use for annotations in the *Completions* buffer.")
(defcustom completions-format 'horizontal
"Define the appearance and sorting of completions.
If the value is `vertical', display completions sorted vertically
in columns in the *Completions* buffer.
-If the value is `horizontal', display completions sorted
-horizontally in alphabetical order, rather than down the screen."
- :type '(choice (const horizontal) (const vertical))
+If the value is `horizontal', display completions sorted in columns
+horizontally in alphabetical order, rather than down the screen.
+If the value is `one-column', display completions down the screen
+in one column."
+ :type '(choice (const horizontal) (const vertical) (const one-column))
:version "23.2")
+(defcustom completions-detailed nil
+ "When non-nil, display completions with details added as prefix/suffix.
+Some commands might provide a detailed view with more information prepended
+or appended to completions."
+ :type 'boolean
+ :version "28.1")
+
(defun completion--insert-strings (strings)
"Insert a list of STRINGS into the current buffer.
Uses columns to keep the listing readable but compact.
@@ -1689,8 +1704,7 @@ It also eliminates runs of equal strings."
(let* ((length (apply #'max
(mapcar (lambda (s)
(if (consp s)
- (+ (string-width (car s))
- (string-width (cadr s)))
+ (apply #'+ (mapcar #'string-width s))
(string-width s)))
strings)))
(window (get-buffer-window (current-buffer) 0))
@@ -1707,6 +1721,11 @@ It also eliminates runs of equal strings."
(row 0)
(first t)
(laststring nil))
+ (unless (or tab-stop-list (null completion-tab-width)
+ (zerop (mod colwidth completion-tab-width)))
+ ;; Align to tab positions for the case
+ ;; when the caller uses tabs inside prefix.
+ (setq colwidth (- colwidth (mod colwidth completion-tab-width))))
;; The insertion should be "sensible" no matter what choices were made
;; for the parameters above.
(dolist (str strings)
@@ -1715,10 +1734,12 @@ It also eliminates runs of equal strings."
;; FIXME: `string-width' doesn't pay attention to
;; `display' properties.
(let ((length (if (consp str)
- (+ (string-width (car str))
- (string-width (cadr str)))
+ (apply #'+ (mapcar #'string-width str))
(string-width str))))
(cond
+ ((eq completions-format 'one-column)
+ ;; Nothing special
+ )
((eq completions-format 'vertical)
;; Vertical format
(when (> row rows)
@@ -1745,23 +1766,46 @@ It also eliminates runs of equal strings."
;; already past the goal column, there is still
;; a space displayed.
(set-text-properties (1- (point)) (point)
- ;; We can't just set tab-width, because
- ;; completion-setup-function will kill
- ;; all local variables :-(
+ ;; We can set tab-width using
+ ;; completion-tab-width, but
+ ;; the caller can prefer using
+ ;; \t to align prefixes.
`(display (space :align-to ,column)))
nil))))
(setq first nil)
(if (not (consp str))
(put-text-property (point) (progn (insert str) (point))
'mouse-face 'highlight)
- (put-text-property (point) (progn (insert (car str)) (point))
- 'mouse-face 'highlight)
- (let ((beg (point))
- (end (progn (insert (cadr str)) (point))))
- (put-text-property beg end 'mouse-face nil)
- (font-lock-prepend-text-property beg end 'face
- 'completions-annotations)))
+ ;; If `str' is a list that has 2 elements,
+ ;; then the second element is a suffix annotation.
+ ;; If `str' has 3 elements, then the second element
+ ;; is a prefix, and the third element is a suffix.
+ (let* ((prefix (when (nth 2 str) (nth 1 str)))
+ (suffix (or (nth 2 str) (nth 1 str))))
+ (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 (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
+ (font-lock-prepend-text-property
+ beg end 'face 'completions-annotations)))))
(cond
+ ((eq completions-format 'one-column)
+ (insert "\n"))
((eq completions-format 'vertical)
;; Vertical format
(if (> column 0)
@@ -1880,6 +1924,13 @@ These include:
completion). The function can access the completion data via
`minibuffer-completion-table' and related variables.
+`: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
+ 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.
+
`:exit-function': Function to run after completion is performed.
The function must accept two arguments, STRING and STATUS.
@@ -1962,10 +2013,13 @@ variables.")
base-size md
minibuffer-completion-table
minibuffer-completion-predicate))
- (afun (or (completion-metadata-get all-md 'annotation-function)
- (plist-get completion-extra-properties
- :annotation-function)
- completion-annotate-function))
+ (ann-fun (or (completion-metadata-get all-md 'annotation-function)
+ (plist-get completion-extra-properties
+ :annotation-function)
+ completion-annotate-function))
+ (aff-fun (or (completion-metadata-get all-md 'affixation-function)
+ (plist-get completion-extra-properties
+ :affixation-function)))
(mainbuf (current-buffer))
;; If the *Completions* buffer is shown in a new
;; window, mark it as softly-dedicated, so bury-buffer in
@@ -2006,22 +2060,26 @@ variables.")
(if sort-fun
(funcall sort-fun completions)
(sort completions 'string-lessp))))
- (when afun
+ (cond
+ (aff-fun
+ (setq completions
+ (funcall aff-fun completions)))
+ (ann-fun
(setq completions
(mapcar (lambda (s)
- (let ((ann (funcall afun s)))
+ (let ((ann (funcall ann-fun s)))
(if ann (list s ann) s)))
- completions)))
+ completions))))
(with-current-buffer standard-output
- (set (make-local-variable 'completion-base-position)
+ (setq-local completion-base-position
(list (+ start base-size)
;; FIXME: We should pay attention to completion
;; boundaries here, but currently
;; completion-all-completions does not give us the
;; necessary information.
end))
- (set (make-local-variable 'completion-list-insert-choice-function)
+ (setq-local completion-list-insert-choice-function
(let ((ctable minibuffer-completion-table)
(cpred minibuffer-completion-predicate)
(cprops completion-extra-properties))
@@ -2067,8 +2125,10 @@ variables.")
;; A better solution would be to make deactivate-mark buffer-local
;; (or to turn it into a list of buffers, ...), but in the mean time,
;; this should do the trick in most cases.
- (setq deactivate-mark nil)
- (throw 'exit nil))
+ (when (innermost-minibuffer-p)
+ (setq deactivate-mark nil)
+ (throw 'exit nil))
+ (error "%s" "Not in most nested minibuffer"))
(defun self-insert-and-exit ()
"Terminate minibuffer input."
@@ -2336,7 +2396,7 @@ The completion method is determined by `completion-at-point-functions'."
;;; Key bindings.
(let ((map minibuffer-local-map))
- (define-key map "\C-g" 'abort-recursive-edit)
+ (define-key map "\C-g" 'abort-minibuffers)
(define-key map "\M-<" 'minibuffer-beginning-of-buffer)
(define-key map "\r" 'exit-minibuffer)
@@ -2813,7 +2873,7 @@ See `read-file-name' for the meaning of the arguments."
;; On the first request on `M-n' fill
;; `minibuffer-default' with a list of defaults
;; relevant for file-name reading.
- (set (make-local-variable 'minibuffer-default-add-function)
+ (setq-local minibuffer-default-add-function
(lambda ()
(with-current-buffer
(window-buffer (minibuffer-selected-window))
@@ -3034,19 +3094,6 @@ the commands start with a \"-\" or a SPC."
:version "24.1"
:type 'boolean)
-(defcustom minibuffer-default-prompt-format " (default %s)"
- "Format string used to output \"default\" values.
-When prompting for input, there will often be a default value,
-leading to prompts like \"Number of articles (default 50): \".
-The \"default\" part of that prompt is controlled by this
-variable, and can be set to, for instance, \" [%s]\" if you want
-a shorter displayed prompt, or \"\", if you don't want to display
-the default at all.
-
-This variable is used by the `format-prompt' function."
- :version "28.1"
- :type 'string)
-
(defun completion-pcm--pattern-trivial-p (pattern)
(and (stringp (car pattern))
;; It can be followed by `point' and "" and still be trivial.
@@ -3115,7 +3162,8 @@ or a symbol, see `completion-pcm--merge-completions'."
(let ((n '()))
(while p
(pcase p
- (`(,(or 'any 'any-delim) point . ,rest) (setq p `(point . ,rest)))
+ (`(,(or 'any 'any-delim) ,(or 'any 'point) . ,rest)
+ (setq p (cdr p)))
;; This is not just a performance improvement: it turns a
;; terminating `point' into an implicit `any', which affects
;; the final position of point (because `point' gets turned
@@ -3200,6 +3248,13 @@ than the latter (which has two \"holes\" and three
one-letter-long matches).")
(defun completion-pcm--hilit-commonality (pattern completions)
+ "Show where and how well PATTERN matches COMPLETIONS.
+PATTERN, a list of symbols and strings as seen
+`completion-pcm--merge-completions', is assumed to match every
+string in COMPLETIONS. Return a deep copy of COMPLETIONS where
+each string is propertized with `completion-score', a number
+between 0 and 1, and with faces `completions-common-part',
+`completions-first-difference' in the relevant segments."
(when completions
(let* ((re (completion-pcm--pattern->regex pattern 'group))
(point-idx (completion-pcm--pattern-point-idx pattern))
@@ -3211,12 +3266,12 @@ one-letter-long matches).")
(unless (string-match re str)
(error "Internal error: %s does not match %s" re str))
(let* ((pos (if point-idx (match-beginning point-idx) (match-end 0)))
- (md (match-data))
- (start (pop md))
- (end (pop md))
- (len (length str))
- ;; To understand how this works, consider these bad
- ;; ascii(tm) diagrams showing how the pattern "foo"
+ (match-end (match-end 0))
+ (md (cddr (match-data)))
+ (from 0)
+ (end (length str))
+ ;; To understand how this works, consider these simple
+ ;; ascii diagrams showing how the pattern "foo"
;; flex-matches "fabrobazo", "fbarbazoo" and
;; "barfoobaz":
@@ -3252,9 +3307,12 @@ one-letter-long matches).")
(score-numerator 0)
(score-denominator 0)
(last-b 0)
- (update-score
+ (update-score-and-face
(lambda (a b)
- "Update score variables given match range (A B)."
+ "Update score and face given match range (A B)."
+ (add-face-text-property a b
+ 'completions-common-part
+ nil str)
(setq
score-numerator (+ score-numerator (- b a)))
(unless (or (= a last-b)
@@ -3268,19 +3326,15 @@ one-letter-long matches).")
flex-score-match-tightness)))))
(setq
last-b b))))
- (funcall update-score start start)
(while md
- (funcall update-score start (car md))
- (add-face-text-property
- start (pop md)
- 'completions-common-part
- nil str)
- (setq start (pop md)))
- (funcall update-score len len)
- (add-face-text-property
- start end
- 'completions-common-part
- nil str)
+ (funcall update-score-and-face from (pop md))
+ (setq from (pop md)))
+ ;; If `pattern' doesn't have an explicit trailing any, the
+ ;; regex `re' won't produce match data representing the
+ ;; region after the match. We need to account to account
+ ;; for that extra bit of match (bug#42149).
+ (unless (= from match-end)
+ (funcall update-score-and-face from match-end))
(if (> (length str) pos)
(add-face-text-property
pos (1+ pos)
@@ -3289,7 +3343,7 @@ one-letter-long matches).")
(unless (zerop (length str))
(put-text-property
0 1 'completion-score
- (/ score-numerator (* len (1+ score-denominator)) 1.0) str)))
+ (/ score-numerator (* end (1+ score-denominator)) 1.0) str)))
str)
completions))))
@@ -3864,6 +3918,19 @@ the minibuffer was activated, and execute the forms."
(with-minibuffer-selected-window
(scroll-other-window-down arg)))
+(defcustom minibuffer-default-prompt-format " (default %s)"
+ "Format string used to output \"default\" values.
+When prompting for input, there will often be a default value,
+leading to prompts like \"Number of articles (default 50): \".
+The \"default\" part of that prompt is controlled by this
+variable, and can be set to, for instance, \" [%s]\" if you want
+a shorter displayed prompt, or \"\", if you don't want to display
+the default at all.
+
+This variable is used by the `format-prompt' function."
+ :version "28.1"
+ :type 'string)
+
(defun format-prompt (prompt default &rest format-args)
"Format PROMPT with DEFAULT according to `minibuffer-default-prompt-format'.
If FORMAT-ARGS is nil, PROMPT is used as a plain string. If
diff --git a/lisp/misc.el b/lisp/misc.el
index 03395781a51..09f6011f98d 100644
--- a/lisp/misc.el
+++ b/lisp/misc.el
@@ -1,6 +1,6 @@
;;; misc.el --- some nonstandard editing and utility commands for Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1989, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1989, 2001-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: convenience
diff --git a/lisp/misearch.el b/lisp/misearch.el
index 6ec10fe2c2e..668c711922a 100644
--- a/lisp/misearch.el
+++ b/lisp/misearch.el
@@ -1,6 +1,6 @@
;;; misearch.el --- isearch extensions for multi-buffer search
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Juri Linkov <juri@jurta.org>
;; Keywords: matching
diff --git a/lisp/mouse-copy.el b/lisp/mouse-copy.el
index a650bd6a499..e48722ef944 100644
--- a/lisp/mouse-copy.el
+++ b/lisp/mouse-copy.el
@@ -1,6 +1,6 @@
;;; mouse-copy.el --- one-click text copy and move
-;; Copyright (C) 1996, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 2001-2021 Free Software Foundation, Inc.
;; Author: John Heidemann <johnh@ISI.EDU>
;; Keywords: mouse
diff --git a/lisp/mouse-drag.el b/lisp/mouse-drag.el
index e80ebba28d5..907ef061594 100644
--- a/lisp/mouse-drag.el
+++ b/lisp/mouse-drag.el
@@ -1,6 +1,6 @@
;;; mouse-drag.el --- use mouse-2 to do a new style of scrolling
-;; Copyright (C) 1996-1997, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1997, 2001-2021 Free Software Foundation, Inc.
;; Author: John Heidemann <johnh@ISI.EDU>
;; Keywords: mouse
@@ -225,7 +225,7 @@ To test this function, evaluate:
;; Don't change the mouse pointer shape while we drag.
(setq track-mouse 'dragging)
(while (progn
- (setq event (read-event)
+ (setq event (read--potential-mouse-event)
end (event-end event)
row (cdr (posn-col-row end))
col (car (posn-col-row end)))
@@ -286,7 +286,7 @@ To test this function, evaluate:
window-last-col (- (window-width) 2))
(track-mouse
(while (progn
- (setq event (read-event)
+ (setq event (read--potential-mouse-event)
end (event-end event)
row (cdr (posn-col-row end))
col (car (posn-col-row end)))
diff --git a/lisp/mouse.el b/lisp/mouse.el
index 9d4492f1bde..8732fb80866 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -1,6 +1,6 @@
;;; mouse.el --- window system-independent mouse support -*- lexical-binding: t -*-
-;; Copyright (C) 1993-1995, 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1995, 1999-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: hardware, mouse
@@ -1792,7 +1792,7 @@ The function returns a non-nil value if it creates a secondary selection."
(let (event end end-point)
(track-mouse
(while (progn
- (setq event (read-event))
+ (setq event (read--potential-mouse-event))
(or (mouse-movement-p event)
(memq (car-safe event) '(switch-frame select-window))))
diff --git a/lisp/mpc.el b/lisp/mpc.el
index fade23e3cc2..827f8aacdd6 100644
--- a/lisp/mpc.el
+++ b/lisp/mpc.el
@@ -1,6 +1,6 @@
;;; mpc.el --- A client for the Music Player Daemon -*- lexical-binding: t -*-
-;; Copyright (C) 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2021 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: multimedia
diff --git a/lisp/msb.el b/lisp/msb.el
index 15aeaa2e73f..14209d9956d 100644
--- a/lisp/msb.el
+++ b/lisp/msb.el
@@ -1,6 +1,6 @@
;;; msb.el --- customizable buffer-selection with multiple menus
-;; Copyright (C) 1993-1995, 1997-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1995, 1997-2021 Free Software Foundation, Inc.
;; Author: Lars Lindberg <lars.lindberg@home.se>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/mwheel.el b/lisp/mwheel.el
index c6a7391df1a..adfeaccb29b 100644
--- a/lisp/mwheel.el
+++ b/lisp/mwheel.el
@@ -1,6 +1,6 @@
;;; mwheel.el --- Mouse wheel support -*- lexical-binding:t -*-
-;; Copyright (C) 1998, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2000-2021 Free Software Foundation, Inc.
;; Keywords: mouse
;; Package: emacs
@@ -37,7 +37,6 @@
;; 'mwheel-down', but I cannot find a way to do this very easily (or
;; portably), so for now I just live with it.
-(require 'custom)
(require 'timer)
(defvar mouse-wheel-mode)
@@ -146,6 +145,16 @@ face height."
:group 'mouse
:type 'boolean)
+(defcustom mouse-wheel-scroll-amount-horizontal 1
+ "Amount to scroll windows horizontally.
+Its value can be changed dynamically by using a numeric prefix argument
+before starting horizontal scrolling.
+It has effect when `mouse-wheel-scroll-amount' binds the value `hscroll'
+to one of modifiers (`Shift' by default)."
+ :group 'mouse
+ :type 'number
+ :version "28.1")
+
;;; For tilt-scroll
;;;
(defcustom mouse-wheel-tilt-scroll nil
@@ -243,11 +252,17 @@ active window."
frame nil t)))))
(mwheel-event-window event)))
-(defun mwheel-scroll (event)
+(defun mwheel-scroll (event &optional arg)
"Scroll up or down according to the EVENT.
This should be bound only to mouse buttons 4, 5, 6, and 7 on
-non-Windows systems."
- (interactive (list last-input-event))
+non-Windows systems.
+
+Optional argument ARG (interactively, prefix numeric argument) controls
+the step of horizontal scrolling.
+
+The variable `mouse-wheel-scroll-amount-horizontal' records the last
+value of ARG, and the command uses it in subsequent scrolls."
+ (interactive (list last-input-event current-prefix-arg))
(let* ((selected-window (selected-window))
(scroll-window (mouse-wheel--get-scroll-window event))
(old-point
@@ -275,9 +290,12 @@ non-Windows systems."
(unwind-protect
(let ((button (mwheel-event-button event)))
(cond ((and (eq amt 'hscroll) (eq button mouse-wheel-down-event))
+ (when (and (natnump arg) (> arg 0))
+ (setq mouse-wheel-scroll-amount-horizontal arg))
(funcall (if mouse-wheel-flip-direction
mwheel-scroll-left-function
- mwheel-scroll-right-function) 1))
+ mwheel-scroll-right-function)
+ mouse-wheel-scroll-amount-horizontal))
((eq button mouse-wheel-down-event)
(condition-case nil (funcall mwheel-scroll-down-function amt)
;; Make sure we do indeed scroll to the beginning of
@@ -294,9 +312,12 @@ non-Windows systems."
;; to only affect scroll-down. --Stef
(set-window-start (selected-window) (point-min))))))
((and (eq amt 'hscroll) (eq button mouse-wheel-up-event))
+ (when (and (natnump arg) (> arg 0))
+ (setq mouse-wheel-scroll-amount-horizontal arg))
(funcall (if mouse-wheel-flip-direction
mwheel-scroll-right-function
- mwheel-scroll-left-function) 1))
+ mwheel-scroll-left-function)
+ mouse-wheel-scroll-amount-horizontal))
((eq button mouse-wheel-up-event)
(condition-case nil (funcall mwheel-scroll-up-function amt)
;; Make sure we do indeed scroll to the end of the buffer.
diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index 0cb8d7cb837..9559b125135 100644
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -1,6 +1,6 @@
;;; ange-ftp.el --- transparent FTP support for GNU Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1989-1996, 1998, 2000-2020 Free Software Foundation,
+;; Copyright (C) 1989-1996, 1998, 2000-2021 Free Software Foundation,
;; Inc.
;; Author: Andy Norman (ange@hplb.hpl.hp.com)
@@ -1080,7 +1080,7 @@ All HOST values should be in lower case.")
(defvar ange-ftp-trample-marker)
;; New error symbols.
-(define-error 'ftp-error nil 'file-error) ;"FTP error"
+(define-error 'ftp-error nil '(remote-file-error file-error)) ;"FTP error"
;;; ------------------------------------------------------------
;;; Enhanced message support.
@@ -1556,7 +1556,7 @@ good, skip, fatal, or unknown."
;; This looks like an error, but we have to keep reading the output
;; to see if it was fixed or not. E.g. it may indicate that IPv6
;; failed, but maybe a subsequent IPv4 fallback succeeded.
- (set (make-local-variable 'ange-ftp-pending-error-line) line)
+ (setq-local ange-ftp-pending-error-line line)
t)
((string-match ange-ftp-fatal-msgs line)
(delete-process proc)
@@ -1970,30 +1970,24 @@ on the gateway machine to do the FTP instead."
"Major mode for interacting with the FTP process.
\\{comint-mode-map}"
- (make-local-variable 'ange-ftp-process-string)
- (setq ange-ftp-process-string "")
+ (setq-local ange-ftp-process-string "")
(make-local-variable 'ange-ftp-process-busy)
(make-local-variable 'ange-ftp-process-result)
(make-local-variable 'ange-ftp-process-msg)
(make-local-variable 'ange-ftp-process-multi-skip)
- (make-local-variable 'ange-ftp-process-result-line)
(make-local-variable 'ange-ftp-process-continue)
- (make-local-variable 'ange-ftp-hash-mark-count)
(make-local-variable 'ange-ftp-binary-hash-mark-size)
(make-local-variable 'ange-ftp-ascii-hash-mark-size)
(make-local-variable 'ange-ftp-hash-mark-unit)
- (make-local-variable 'ange-ftp-xfer-size)
(make-local-variable 'ange-ftp-last-percent)
- (setq ange-ftp-hash-mark-count 0)
- (setq ange-ftp-xfer-size 0)
- (setq ange-ftp-process-result-line "")
+ (setq-local ange-ftp-hash-mark-count 0)
+ (setq-local ange-ftp-xfer-size 0)
+ (setq-local ange-ftp-process-result-line "")
(setq comint-prompt-regexp "^ftp> ")
- (make-local-variable 'comint-password-prompt-regexp)
;; This is a regexp that can't match anything.
;; ange-ftp has its own ways of handling passwords.
- (setq comint-password-prompt-regexp regexp-unmatchable)
- (make-local-variable 'paragraph-start)
- (setq paragraph-start comint-prompt-regexp))
+ (setq-local comint-password-prompt-regexp regexp-unmatchable)
+ (setq-local paragraph-start comint-prompt-regexp))
(defcustom ange-ftp-raw-login nil
"Use raw FTP commands for login, if account password is not nil.
@@ -3427,8 +3421,7 @@ system TYPE.")
(and (file-directory-p name)
(file-readable-p name)))
-(defun ange-ftp-directory-files (directory &optional full match
- &rest v19-args)
+(defun ange-ftp-directory-files (directory &optional full match nosort count)
(setq directory (expand-file-name directory))
(if (ange-ftp-ftp-name directory)
(progn
@@ -3443,19 +3436,21 @@ system TYPE.")
(if (or (not match) (string-match-p match f))
(setq files
(cons (if full (concat directory f) f) files))))
+ (when (natnump count)
+ (setq files (last files count)))
(nreverse files)))
- (apply 'ange-ftp-real-directory-files directory full match v19-args)))
+ (apply 'ange-ftp-real-directory-files directory full match nosort count)))
(defun ange-ftp-directory-files-and-attributes
- (directory &optional full match nosort id-format)
+ (directory &optional full match nosort id-format count)
(setq directory (expand-file-name directory))
(if (ange-ftp-ftp-name directory)
(mapcar
(lambda (file)
(cons file (file-attributes (expand-file-name file directory))))
- (ange-ftp-directory-files directory full match nosort))
+ (ange-ftp-directory-files directory full match nosort count))
(ange-ftp-real-directory-files-and-attributes
- directory full match nosort id-format)))
+ directory full match nosort id-format count)))
(defun ange-ftp-file-attributes (file &optional id-format)
(setq file (expand-file-name file))
@@ -3535,20 +3530,22 @@ system TYPE.")
(setq file (expand-file-name file))
(let ((parsed (ange-ftp-ftp-name file)))
(if parsed
- (let* ((host (nth 0 parsed))
- (user (nth 1 parsed))
- (name (ange-ftp-quote-string (nth 2 parsed)))
- (abbr (ange-ftp-abbreviate-filename file))
- (result (ange-ftp-send-cmd host user
- (list 'delete name)
- (format "Deleting %s" abbr))))
- (or (car result)
- (signal 'ftp-error
- (list
- "Removing old name"
- (format "FTP Error: \"%s\"" (cdr result))
- file)))
- (ange-ftp-delete-file-entry file))
+ (if (and delete-by-moving-to-trash trash)
+ (move-file-to-trash file)
+ (let* ((host (nth 0 parsed))
+ (user (nth 1 parsed))
+ (name (ange-ftp-quote-string (nth 2 parsed)))
+ (abbr (ange-ftp-abbreviate-filename file))
+ (result (ange-ftp-send-cmd host user
+ (list 'delete name)
+ (format "Deleting %s" abbr))))
+ (or (car result)
+ (signal 'ftp-error
+ (list
+ "Removing old name"
+ (format "FTP Error: \"%s\"" (cdr result))
+ file)))
+ (ange-ftp-delete-file-entry file)))
(ange-ftp-real-delete-file file trash))))
(defun ange-ftp-file-modtime (file)
@@ -3659,7 +3656,7 @@ so return the size on the remote host exactly. See RFC 3659."
;; (set-process-sentinel proc 'ange-ftp-copy-file-locally-sentinel)
;; (set-process-query-on-exit-flag proc nil)
;; (with-current-buffer (process-buffer proc)
-;; (set (make-local-variable 'copy-cont) cont))))
+;; (setq-local copy-cont cont))))
;;
;; (defun ange-ftp-copy-file-locally-sentinel (proc status)
;; (with-current-buffer (process-buffer proc)
@@ -4162,45 +4159,55 @@ directory, so that Emacs will know its current contents."
(defun ange-ftp-delete-directory (dir &optional recursive trash)
(if (file-directory-p dir)
- (let ((parsed (ange-ftp-ftp-name dir)))
- (if recursive
- (mapc
- (lambda (file)
- (if (file-directory-p file)
- (ange-ftp-delete-directory file recursive trash)
- (delete-file file trash)))
- (directory-files dir 'full directory-files-no-dot-files-regexp)))
- (if parsed
- (let* ((host (nth 0 parsed))
- (user (nth 1 parsed))
- ;; Some ftp's on unix machines (at least on Suns)
- ;; insist that rmdir take a filename, and not a
- ;; directory-name name as an arg. Argh!! This is a bug.
- ;; Non-unix machines will probably always insist
- ;; that rmdir takes a directory-name as an arg
- ;; (as the ftp man page says it should).
- (name (ange-ftp-quote-string
- (if (eq (ange-ftp-host-type host) 'unix)
- (ange-ftp-real-directory-file-name
- (nth 2 parsed))
- (ange-ftp-real-file-name-as-directory
- (nth 2 parsed)))))
- (abbr (ange-ftp-abbreviate-filename dir))
- (result
- (progn
- ;; CWD must not in this directory.
- (ange-ftp-cd host user "/" 'noerror)
- (ange-ftp-send-cmd host user
- (list 'rmdir name)
- (format "Removing directory %s"
- abbr)))))
- (or (car result)
- (ange-ftp-error host user
- (format "Could not remove directory %s: %s"
- dir
- (cdr result))))
- (ange-ftp-delete-file-entry dir t))
- (ange-ftp-real-delete-directory dir recursive trash)))
+ ;; Trashing directories does not work yet, because
+ ;; `rename-file', called in `move-file-to-trash', does not
+ ;; handle directories.
+ (if nil ; (and delete-by-moving-to-trash trash)
+ ;; Move non-empty dir to trash only if recursive deletion was
+ ;; requested.
+ (if (not (or recursive (directory-empty-p dir)))
+ (signal 'ftp-error
+ (list "Directory is not empty, not moving to trash"))
+ (move-file-to-trash dir))
+ (let ((parsed (ange-ftp-ftp-name dir)))
+ (if recursive
+ (mapc
+ (lambda (file)
+ (if (file-directory-p file)
+ (ange-ftp-delete-directory file recursive)
+ (delete-file file)))
+ (directory-files dir 'full directory-files-no-dot-files-regexp)))
+ (if parsed
+ (let* ((host (nth 0 parsed))
+ (user (nth 1 parsed))
+ ;; Some ftp's on unix machines (at least on Suns)
+ ;; insist that rmdir take a filename, and not a
+ ;; directory-name name as an arg. Argh!! This is a bug.
+ ;; Non-unix machines will probably always insist
+ ;; that rmdir takes a directory-name as an arg
+ ;; (as the ftp man page says it should).
+ (name (ange-ftp-quote-string
+ (if (eq (ange-ftp-host-type host) 'unix)
+ (ange-ftp-real-directory-file-name
+ (nth 2 parsed))
+ (ange-ftp-real-file-name-as-directory
+ (nth 2 parsed)))))
+ (abbr (ange-ftp-abbreviate-filename dir))
+ (result
+ (progn
+ ;; CWD must not in this directory.
+ (ange-ftp-cd host user "/" 'noerror)
+ (ange-ftp-send-cmd host user
+ (list 'rmdir name)
+ (format "Removing directory %s"
+ abbr)))))
+ (or (car result)
+ (ange-ftp-error host user
+ (format "Could not remove directory %s: %s"
+ dir
+ (cdr result))))
+ (ange-ftp-delete-file-entry dir t))
+ (ange-ftp-real-delete-directory dir recursive trash))))
(error "Not a directory: %s" dir)))
;; Make a local copy of FILE and return its name.
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index 8b245b01066..7b72a713623 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -1,6 +1,6 @@
;;; browse-url.el --- pass a URL to a WWW browser -*- lexical-binding: t; -*-
-;; Copyright (C) 1995-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
;; Author: Denis Howe <dbh@doc.ic.ac.uk>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el
index 8b40808005b..7a7bbef5364 100644
--- a/lisp/net/dbus.el
+++ b/lisp/net/dbus.el
@@ -1,6 +1,6 @@
;;; dbus.el --- Elisp bindings for D-Bus. -*- lexical-binding: t -*-
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, hardware
diff --git a/lisp/net/dictionary-connection.el b/lisp/net/dictionary-connection.el
new file mode 100644
index 00000000000..d88c0b48f93
--- /dev/null
+++ b/lisp/net/dictionary-connection.el
@@ -0,0 +1,155 @@
+;;; dictionary-connection.el --- TCP-based client connection for dictionary -*- lexical-binding:t -*-
+
+;; Author: Torsten Hilbrich <torsten.hilbrich@gmx.net>
+;; Keywords: network
+
+;; 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
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; dictionary-connection allows to handle TCP-based connections in
+;; client mode where text-based information are exchanged. There is
+;; special support for handling CR LF (and the usual CR LF . CR LF
+;; terminater).
+
+;;; Code:
+
+(defsubst dictionary-connection-p (connection)
+ "Returns non-nil if CONNECTION is a connection object."
+ (get connection 'connection))
+
+(defsubst dictionary-connection-read-point (connection)
+ "Return the read point of the CONNECTION object."
+ (get connection 'dictionary-connection-read-point))
+
+(defsubst dictionary-connection-process (connection)
+ "Return the process of the CONNECTION object."
+ (get connection 'dictionary-connection-process))
+
+(defsubst dictionary-connection-buffer (connection)
+ "Return the buffer of the CONNECTION object."
+ (get connection 'dictionary-connection-buffer))
+
+(defsubst dictionary-connection-set-read-point (connection point)
+ "Set the read-point for CONNECTION to POINT."
+ (put connection 'dictionary-connection-read-point point))
+
+(defsubst dictionary-connection-set-process (connection process)
+ "Set the process for CONNECTION to PROCESS."
+ (put connection 'dictionary-connection-process process))
+
+(defsubst dictionary-connection-set-buffer (connection buffer)
+ "Set the buffer for CONNECTION to BUFFER."
+ (put connection 'dictionary-connection-buffer buffer))
+
+(defun dictionary-connection-create-data (buffer process point)
+ "Create a new connection data based on BUFFER, PROCESS, and POINT."
+ (let ((connection (make-symbol "connection")))
+ (put connection 'connection t)
+ (dictionary-connection-set-read-point connection point)
+ (dictionary-connection-set-process connection process)
+ (dictionary-connection-set-buffer connection buffer)
+ connection))
+
+(defun dictionary-connection-open (server port)
+ "Open a connection to SERVER at PORT.
+A data structure identifing the connection is returned"
+
+ (let ((process-buffer (generate-new-buffer (format " connection to %s:%s"
+ server
+ port)))
+ (process))
+ (with-current-buffer process-buffer
+ (setq process (open-network-stream "connection" process-buffer
+ server port))
+ (dictionary-connection-create-data process-buffer process (point-min)))))
+
+(defun dictionary-connection-status (connection)
+ "Return the status of the CONNECTION.
+Possible return values are the symbols:
+nil: argument is no connection object
+'none: argument has no connection
+'up: connection is open and buffer is existing
+'down: connection is closed
+'alone: connection is not associated with a buffer"
+ (when (dictionary-connection-p connection)
+ (let ((process (dictionary-connection-process connection))
+ (buffer (dictionary-connection-buffer connection)))
+ (if (not process)
+ 'none
+ (if (not (buffer-live-p buffer))
+ 'alone
+ (if (not (eq (process-status process) 'open))
+ 'down
+ 'up))))))
+
+(defun dictionary-connection-close (connection)
+ "Force closing of the CONNECTION."
+ (when (dictionary-connection-p connection)
+ (let ((buffer (dictionary-connection-buffer connection))
+ (process (dictionary-connection-process connection)))
+ (if process
+ (delete-process process))
+ (if buffer
+ (kill-buffer buffer))
+
+ (dictionary-connection-set-process connection nil)
+ (dictionary-connection-set-buffer connection nil))))
+
+(defun dictionary-connection-send (connection data)
+ "Send DATA to the process stored in CONNECTION."
+ (unless (eq (dictionary-connection-status connection) 'up)
+ (error "Connection is not up"))
+ (with-current-buffer (dictionary-connection-buffer connection)
+ (goto-char (point-max))
+ (dictionary-connection-set-read-point connection (point))
+ (process-send-string (dictionary-connection-process connection) data)))
+
+(defun dictionary-connection-send-crlf (connection data)
+ "Send DATA together with CRLF to the process found in CONNECTION."
+ (dictionary-connection-send connection (concat data "\r\n")))
+
+(defun dictionary-connection-read (connection delimiter)
+ "Read data from CONNECTION until DELIMITER is found inside the buffer."
+ (unless (eq (dictionary-connection-status connection) 'up)
+ (error "Connection is not up"))
+ (let ((case-fold-search nil)
+ match-end)
+ (with-current-buffer (dictionary-connection-buffer connection)
+ (goto-char (dictionary-connection-read-point connection))
+ ;; Wait until there is enough data
+ (while (not (search-forward-regexp delimiter nil t))
+ (accept-process-output (dictionary-connection-process connection) 3)
+ (goto-char (dictionary-connection-read-point connection)))
+ (setq match-end (point))
+ ;; Return the result
+ (let ((result (buffer-substring (dictionary-connection-read-point connection)
+ match-end)))
+ (dictionary-connection-set-read-point connection match-end)
+ result))))
+
+(defun dictionary-connection-read-crlf (connection)
+ "Read from CONNECTION until a line is completed with CRLF."
+ (dictionary-connection-read connection "\015?\012"))
+
+(defun dictionary-connection-read-to-point (connection)
+ "Read from CONNECTION until an end of entry is encountered.
+End of entry is a decimal point found on a line by itself.
+"
+ (dictionary-connection-read connection "\015?\012[.]\015?\012"))
+
+(provide 'dictionary-connection)
+;;; dictionary-connection.el ends here
diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el
new file mode 100644
index 00000000000..f8733429e94
--- /dev/null
+++ b/lisp/net/dictionary.el
@@ -0,0 +1,1355 @@
+;;; dictionary.el --- Client for rfc2229 dictionary servers -*- lexical-binding:t -*-
+
+;; Author: Torsten Hilbrich <torsten.hilbrich@gmx.net>
+;; Keywords: interface, dictionary
+
+;; 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
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; dictionary allows you to interact with dictionary servers.
+;; Use M-x customize-group dictionary to modify user settings.
+;;
+;; Main functions for interaction are:
+;; dictionary - opens a new dictionary buffer
+;; dictionary-search - search for the definition of a word
+;;
+;; You can find more information in the README file of the GitHub
+;; repository https://github.com/myrkr/dictionary-el
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'easymenu)
+(require 'custom)
+(require 'dictionary-connection)
+(require 'button)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Stuff for customizing.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar dictionary-current-server)
+(defun dictionary-set-server-var (name value)
+ "Customize helper for setting variable NAME to VALUE.
+The helper is used by customize to check for an active connection
+when setting a variable. The user has then the choice to close
+the existing connection."
+ (if (and (boundp 'dictionary-connection)
+ dictionary-connection
+ (eq (dictionary-connection-status dictionary-connection) 'up)
+ (y-or-n-p
+ (concat "Close existing connection to " dictionary-current-server "? ")))
+ (dictionary-connection-close dictionary-connection))
+ (set-default name value))
+
+(defgroup dictionary nil
+ "Client for accessing the dictd server based dictionaries"
+ :group 'hypermedia)
+
+(defgroup dictionary-proxy nil
+ "Proxy configuration options for the dictionary client"
+ :group 'dictionary)
+
+(defcustom dictionary-server
+ nil
+ "This server is contacted for searching the dictionary.
+
+You can specify here:
+
+- Automatic: First try localhost, then dict.org after confirmation
+- localhost: Only use localhost
+- dict.org: Only use dict.org
+- User-defined: You can specify your own server here
+"
+ :group 'dictionary
+ :set 'dictionary-set-server-var
+ :type '(choice (const :tag "Automatic" nil)
+ (const :tag "localhost" "localhost")
+ (const :tag "dict.org" "dict.org")
+ (string :tag "User-defined"))
+ :version "28.1")
+
+(defcustom dictionary-port
+ 2628
+ "The port of the dictionary server.
+ This port is propably always 2628 so there should be no need to modify it."
+ :group 'dictionary
+ :set 'dictionary-set-server-var
+ :type 'number
+ :version "28.1")
+
+(defcustom dictionary-identification
+ "dictionary.el emacs lisp dictionary client"
+ "This is the identification string that will be sent to the server."
+ :group 'dictionary
+ :type 'string
+ :version "28.1")
+
+(defcustom dictionary-default-dictionary
+ "*"
+ "The dictionary which is used for searching definitions and matching.
+ * and ! have a special meaning, * search all dictionaries, ! search until
+ one dictionary yields matches."
+ :group 'dictionary
+ :type 'string
+ :version "28.1")
+
+(defcustom dictionary-default-strategy
+ "."
+ "The default strategy for listing matching words."
+ :group 'dictionary
+ :type 'string
+ :version "28.1")
+
+(defcustom dictionary-default-popup-strategy
+ "exact"
+ "The default strategy for listing matching words within a popup window.
+
+The following algorithm (defined by the dictd server) are supported
+by the choice value:
+
+- Exact match
+
+ The found word exactly matches the searched word.
+
+- Similiar sounding
+
+ The found word sounds similiar to the searched word. For this match type
+ the soundex algorithm defined by Donald E. Knuth is used. It will only
+ works with english words and the algorithm is not very reliable (i.e.,
+ the soundex algorithm is quite simple).
+
+- Levenshtein distance one
+
+ The Levenshtein distance is defined as the number of insertions, deletions,
+ or replacements needed to get the searched word. This algorithm searches
+ for word where spelling mistakes are allowed. Levenshtein distance one
+ means there is either a deleted character, an inserted character, or a
+ modified one.
+
+- User choice
+
+ Here you can enter any matching algorithm supported by your
+ dictionary server.
+"
+ :group 'dictionary
+ :type '(choice (const :tag "Exact match" "exact")
+ (const :tag "Similiar sounding" "soundex")
+ (const :tag "Levenshtein distance one" "lev")
+ (string :tag "User choice"))
+ :version "28.1")
+
+(defcustom dictionary-create-buttons
+ t
+ "Create some clickable buttons on top of the window if non-nil."
+ :group 'dictionary
+ :type 'boolean
+ :version "28.1")
+
+(defcustom dictionary-mode-hook
+ nil
+ "Hook run in dictionary mode buffers."
+ :group 'dictionary
+ :type 'hook
+ :version "28.1")
+
+(defcustom dictionary-use-http-proxy
+ nil
+ "Connects via a HTTP proxy using the CONNECT command when not nil."
+ :group 'dictionary-proxy
+ :set 'dictionary-set-server-var
+ :type 'boolean
+ :version "28.1")
+
+(defcustom dictionary-proxy-server
+ "proxy"
+ "The name of the HTTP proxy to use when dictionary-use-http-proxy is set."
+ :group 'dictionary-proxy
+ :set 'dictionary-set-server-var
+ :type 'string
+ :version "28.1")
+
+(defcustom dictionary-proxy-port
+ 3128
+ "The port of the proxy server, used only when dictionary-use-http-proxy is set."
+ :group 'dictionary-proxy
+ :set 'dictionary-set-server-var
+ :type 'number
+ :version "28.1")
+
+(defcustom dictionary-use-single-buffer
+ nil
+ "Should the dictionary command reuse previous dictionary buffers?"
+ :group 'dictionary
+ :type 'boolean
+ :version "28.1")
+
+(defcustom dictionary-description-open-delimiter
+ ""
+ "The delimiter to display in front of the dictionaries description"
+ :group 'dictionary
+ :type 'string
+ :version "28.1")
+
+(defcustom dictionary-description-close-delimiter
+ ""
+ "The delimiter to display after of the dictionaries description"
+ :group 'dictionary
+ :type 'string
+ :version "28.1")
+
+;; Define only when coding-system-list is available
+(defcustom dictionary-coding-systems-for-dictionaries
+ '( ("mueller" . koi8-r))
+ "Mapping of dictionaries to coding systems.
+Each entry in this list defines the coding system to be used for that
+dictionary. The default coding system for all other dictionaries
+is utf-8"
+ :group 'dictionary
+ :type `(repeat (cons :tag "Association"
+ (string :tag "Dictionary name")
+ (choice :tag "Coding system"
+ :value 'utf-8
+ ,@(mapcar (lambda (x) (list 'const x))
+ (coding-system-list))
+ )))
+ :version "28.1")
+
+(defface dictionary-word-definition-face
+'((((supports (:family "DejaVu Serif")))
+ (:family "DejaVu Serif"))
+ (((type x))
+ (:font "Sans Serif"))
+ (t
+ (:font "default")))
+"The face that is used for displaying the definition of the word."
+:group 'dictionary
+:version "28.1")
+
+(defface dictionary-word-entry-face
+ '((((type x))
+ (:italic t))
+ (((type tty) (class color))
+ (:foreground "green"))
+ (t
+ (:inverse t)))
+ "The face that is used for displaying the initial word entry line."
+ :group 'dictionary
+ :version "28.1")
+
+(defface dictionary-button-face
+ '((t
+ (:bold t)))
+ "The face that is used for displaying buttons."
+ :group 'dictionary
+ :version "28.1")
+
+(defface dictionary-reference-face
+ '((((type x)
+ (class color)
+ (background dark))
+ (:foreground "yellow"))
+ (((type tty)
+ (class color)
+ (background dark))
+ (:foreground "cyan"))
+ (((class color)
+ (background light))
+ (:foreground "blue"))
+ (t
+ (:underline t)))
+
+ "The face that is used for displaying a reference word."
+ :group 'dictionary
+ :version "28.1")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Buffer local variables for storing the current state
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar dictionary-window-configuration
+ nil
+ "The window configuration to be restored upon closing the buffer")
+
+(defvar dictionary-selected-window
+ nil
+ "The currently selected window")
+
+(defvar dictionary-position-stack
+ nil
+ "The history buffer for point and window position")
+
+(defvar dictionary-data-stack
+ nil
+ "The history buffer for functions and arguments")
+
+(defvar dictionary-positions
+ nil
+ "The current positions")
+
+(defvar dictionary-current-data
+ nil
+ "The item that will be placed on stack next time")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Global variables
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defvar dictionary-mode-map
+ (let ((map (make-sparse-keymap)))
+ (suppress-keymap map)
+ (set-keymap-parent map button-buffer-map)
+
+ (define-key map "q" 'dictionary-close)
+ (define-key map "h" 'dictionary-help)
+ (define-key map "s" 'dictionary-search)
+ (define-key map "d" 'dictionary-lookup-definition)
+ (define-key map "D" 'dictionary-select-dictionary)
+ (define-key map "M" 'dictionary-select-strategy)
+ (define-key map "m" 'dictionary-match-words)
+ (define-key map "l" 'dictionary-previous)
+ (define-key map "n" 'forward-button)
+ (define-key map "p" 'backward-button)
+ (define-key map " " 'scroll-up)
+ (define-key map (read-kbd-macro "M-SPC") 'scroll-down)
+ map)
+ "Keymap for the dictionary mode.")
+
+(defvar dictionary-connection
+ nil
+ "The current network connection")
+
+(defvar dictionary-instances
+ 0
+ "The number of open dictionary buffers")
+
+(defvar dictionary-marker
+ nil
+ "Stores the point position while buffer display.")
+
+(defvar dictionary-color-support
+ (condition-case nil
+ (x-display-color-p)
+ (error nil))
+ "Determines if the Emacs has support to display color")
+
+(defvar dictionary-word-history
+ '()
+ "History list of searched word")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Basic function providing startup actions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;###autoload
+(defun dictionary-mode ()
+ "Mode for searching a dictionary.
+This is a mode for searching a dictionary server implementing the
+protocol defined in RFC 2229.
+
+This is a quick reference to this mode describing the default key bindings:
+
+* q close the dictionary buffer
+* h display this help information
+* s ask for a new word to search
+* d search the word at point
+* n or Tab place point to the next link
+* p or S-Tab place point to the prev link
+
+* m ask for a pattern and list all matching words.
+* D select the default dictionary
+* M select the default search strategy
+
+* Return or Button2 visit that link
+"
+
+ (unless (eq major-mode 'dictionary-mode)
+ (cl-incf dictionary-instances))
+
+ (kill-all-local-variables)
+ (buffer-disable-undo)
+ (use-local-map dictionary-mode-map)
+ (setq major-mode 'dictionary-mode)
+ (setq mode-name "Dictionary")
+
+ (setq-local dictionary-data-stack nil)
+ (setq-local dictionary-position-stack nil)
+
+ (make-local-variable 'dictionary-current-data)
+ (make-local-variable 'dictionary-positions)
+
+ (make-local-variable 'dictionary-default-dictionary)
+ (make-local-variable 'dictionary-default-strategy)
+
+ (add-hook 'kill-buffer-hook 'dictionary-close t t)
+ (run-hooks 'dictionary-mode-hook))
+
+;;;###autoload
+(defun dictionary ()
+ "Create a new dictonary buffer and install dictionary-mode."
+ (interactive)
+ (let ((buffer (or (and dictionary-use-single-buffer
+ (get-buffer "*Dictionary*"))
+ (generate-new-buffer "*Dictionary*")))
+ (window-configuration (current-window-configuration))
+ (selected-window (frame-selected-window)))
+
+ (switch-to-buffer-other-window buffer)
+ (dictionary-mode)
+
+ (setq-local dictionary-window-configuration window-configuration)
+ (setq-local dictionary-selected-window selected-window)
+ (dictionary-check-connection)
+ (dictionary-new-buffer)
+ (dictionary-store-positions)
+ (dictionary-store-state 'dictionary-new-buffer nil)))
+
+(defun dictionary-new-buffer ()
+ "Create a new and clean buffer."
+
+ (dictionary-pre-buffer)
+ (dictionary-post-buffer))
+
+(defsubst dictionary-reply-code (reply)
+ "Return the reply code stored in REPLY."
+ (get reply 'reply-code))
+
+(defsubst dictionary-reply (reply)
+ "Return the string reply stored in REPLY."
+ (get reply 'reply))
+
+(defsubst dictionary-reply-list (reply)
+ "Return the reply list stored in REPLY."
+ (get reply 'reply-list))
+
+(defun dictionary-open-server (server)
+ "Opens a new connection to SERVER.
+The connection takes the proxy setting in customization group
+`dictionary-proxy' into account."
+ (let ((wanted 'raw-text)
+ (coding-system nil))
+ (if (member wanted (coding-system-list))
+ (setq coding-system wanted))
+ (let ((coding-system-for-read coding-system)
+ (coding-system-for-write coding-system))
+ (setq dictionary-current-server server)
+ (message "Opening connection to %s:%s" server
+ dictionary-port)
+ (dictionary-connection-close dictionary-connection)
+ (setq dictionary-connection
+ (if dictionary-use-http-proxy
+ (dictionary-connection-open dictionary-proxy-server
+ dictionary-proxy-port)
+ (dictionary-connection-open server dictionary-port)))
+ (set-process-query-on-exit-flag
+ (dictionary-connection-process dictionary-connection)
+ nil)
+
+ (when dictionary-use-http-proxy
+ (message "Proxy CONNECT to %s:%d"
+ dictionary-proxy-server
+ dictionary-proxy-port)
+ (dictionary-send-command (format "CONNECT %s:%d HTTP/1.1"
+ server
+ dictionary-port))
+ ;; just a \r\n combination
+ (dictionary-send-command "")
+
+ ;; read first line of reply
+ (let* ((reply (dictionary-read-reply))
+ (reply-list (dictionary-split-string reply)))
+ ;; first item is protocol, second item is code
+ (unless (= (string-to-number (cadr reply-list)) 200)
+ (error "Bad reply from proxy server %s" reply))
+
+ ;; skip the following header lines until empty found
+ (while (not (equal reply ""))
+ (setq reply (dictionary-read-reply)))))
+
+ (dictionary-check-initial-reply)
+ (dictionary-send-command (concat "client " dictionary-identification))
+ (let ((reply (dictionary-read-reply-and-split)))
+ (message nil)
+ (unless (dictionary-check-reply reply 250)
+ (error "Unknown server answer: %s"
+ (dictionary-reply reply)))))))
+
+(defun dictionary-check-connection ()
+ "Check if there is already a connection open."
+ (if (not (and dictionary-connection
+ (eq (dictionary-connection-status dictionary-connection) 'up)))
+ (if dictionary-server
+ (dictionary-open-server dictionary-server)
+ (let ((server "localhost"))
+ (condition-case nil
+ (dictionary-open-server server)
+ (error
+ (if (y-or-n-p
+ (format "Failed to open server %s, continue with dict.org?"
+ server))
+ (dictionary-open-server "dict.org")
+ (error "Failed automatic server selection, please customize dictionary-server"))))))))
+
+(defun dictionary-mode-p ()
+ "Return non-nil if current buffer has dictionary-mode."
+ (eq major-mode 'dictionary-mode))
+
+(defun dictionary-ensure-buffer ()
+ "If current buffer is not a dictionary buffer, create a new one."
+ (unless (dictionary-mode-p)
+ (dictionary)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Dealing with closing the buffer
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun dictionary-close (&rest ignored)
+ "Close the current dictionary buffer and its connection."
+ (interactive)
+ (if (eq major-mode 'dictionary-mode)
+ (progn
+ (setq major-mode nil)
+ (if (<= (cl-decf dictionary-instances) 0)
+ (dictionary-connection-close dictionary-connection))
+ (let ((configuration dictionary-window-configuration)
+ (selected-window dictionary-selected-window))
+ (kill-buffer (current-buffer))
+ (set-window-configuration configuration)
+ (select-window selected-window)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Helpful functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun dictionary-send-command (string)
+ "Send the command `string' to the network connection."
+ (dictionary-check-connection)
+ ;;;; #####
+ (dictionary-connection-send-crlf dictionary-connection string))
+
+(defun dictionary-read-reply ()
+ "Read the reply line from the server."
+ (let ((answer (dictionary-connection-read-crlf dictionary-connection)))
+ (if (string-match "\r?\n" answer)
+ (substring answer 0 (match-beginning 0))
+ answer)))
+
+(defun dictionary-split-string (string)
+ "Split STRING constiting of space-separated words into elements.
+This function knows about the special meaning of quotes (\")"
+ (let ((list))
+ (while (and string (> (length string) 0))
+ (let ((search "\\(\\s-+\\)")
+ (start 0))
+ (if (= (aref string 0) ?\")
+ (setq search "\\(\"\\)\\s-*"
+ start 1))
+ (if (string-match search string start)
+ (progn
+ (setq list (cons (substring string start (- (match-end 1) 1)) list)
+ string (substring string (match-end 0))))
+ (setq list (cons string list)
+ string nil))))
+ (nreverse list)))
+
+(defun dictionary-read-reply-and-split ()
+ "Reads the reply, splits it into words and returns it."
+ (let ((answer (make-symbol "reply-data"))
+ (reply (dictionary-read-reply)))
+ (let ((reply-list (dictionary-split-string reply)))
+ (put answer 'reply reply)
+ (put answer 'reply-list reply-list)
+ (put answer 'reply-code (string-to-number (car reply-list)))
+ answer)))
+
+(defun dictionary-read-answer ()
+ "Read the complete answer.
+The answer is delimited by a decimal point (.) on a line by itself."
+ (let ((answer (dictionary-connection-read-to-point dictionary-connection))
+ (start 0))
+ (while (string-match "\r\n" answer start)
+ (setq answer (replace-match "\n" t t answer))
+ (setq start (1- (match-end 0))))
+ (setq start 0)
+ (if (string-match "\n\\.\n.*" answer start)
+ (setq answer (replace-match "" t t answer)))
+ answer))
+
+(defun dictionary-check-reply (reply code)
+ "Extract the reply code from REPLY and checks against CODE."
+ (let ((number (dictionary-reply-code reply)))
+ (and (numberp number)
+ (= number code))))
+
+(defun dictionary-coding-system (dictionary)
+ "Select coding system to use for DICTIONARY."
+ (let ((coding-system
+ (or (cdr (assoc dictionary
+ dictionary-coding-systems-for-dictionaries))
+ 'utf-8)))
+ (if (member coding-system (coding-system-list))
+ coding-system
+ nil)))
+
+(defun dictionary-decode-charset (text dictionary)
+ "Convert TEXT from the charset configured for DICTIONARY."
+ (let ((coding-system (dictionary-coding-system dictionary)))
+ (if coding-system
+ (decode-coding-string text coding-system)
+ text)))
+
+(defun dictionary-encode-charset (text dictionary)
+ "Convert TEXT to the charset defined for DICTIONARY."
+ (let ((coding-system (dictionary-coding-system dictionary)))
+ (if coding-system
+ (encode-coding-string text coding-system)
+ text)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Communication functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun dictionary-check-initial-reply ()
+ "Reads the first reply from server and checks it."
+ (let ((reply (dictionary-read-reply-and-split)))
+ (unless (dictionary-check-reply reply 220)
+ (dictionary-connection-close dictionary-connection)
+ (error "Server returned: %s" (dictionary-reply reply)))))
+
+;; Store the current state
+(defun dictionary-store-state (function data)
+ "Stores the current state of operation for later restore.
+The current state consist of a tuple of FUNCTION and DATA. This
+is basically an implementation of a history to return to a
+previous state."
+ (if dictionary-current-data
+ (progn
+ (push dictionary-current-data dictionary-data-stack)
+ (unless dictionary-positions
+ (error "dictionary-store-state called before dictionary-store-positions"))
+ (push dictionary-positions dictionary-position-stack)))
+ (setq dictionary-current-data
+ (cons function data)))
+
+(defun dictionary-store-positions ()
+ "Stores the current positions for later restore."
+
+ (setq dictionary-positions (cons (point) (window-start))))
+
+;; Restore the previous state
+(defun dictionary-restore-state (&rest ignored)
+ "Restore the state just before the last operation."
+ (let ((position (pop dictionary-position-stack))
+ (data (pop dictionary-data-stack)))
+ (unless position
+ (error "Already at begin of history"))
+ (apply (car data) (cdr data))
+ (set-window-start (selected-window) (cdr position))
+ (goto-char (car position))
+ (setq dictionary-current-data data)))
+
+;; The normal search
+
+(defun dictionary-new-search (args &optional all)
+ "Saves the current state and starts a new search based on ARGS.
+The parameter ARGS is a cons cell where car is the word to search
+and cdr is the dictionary where to search the word in."
+ (interactive)
+ (dictionary-store-positions)
+ (let ((word (car args))
+ (dictionary (cdr args)))
+
+ (if all
+ (setq dictionary dictionary-default-dictionary))
+ (dictionary-ensure-buffer)
+ (dictionary-new-search-internal word dictionary 'dictionary-display-search-result)
+ (dictionary-store-state 'dictionary-new-search-internal
+ (list word dictionary 'dictionary-display-search-result))))
+
+(defun dictionary-new-search-internal (word dictionary function)
+ "Starts a new search for WORD in DICTIONARY after preparing the buffer.
+FUNCTION is the callback which is called for each search result.
+"
+ (dictionary-pre-buffer)
+ (dictionary-do-search word dictionary function))
+
+(defun dictionary-do-search (word dictionary function &optional nomatching)
+ "Searches WORD in DICTIONARY and calls FUNCTION for each result.
+The parameter NOMATCHING controls whether to suppress the display
+of matching words."
+
+ (message "Searching for %s in %s" word dictionary)
+ (dictionary-send-command (concat "define "
+ (dictionary-encode-charset dictionary "")
+ " \""
+ (dictionary-encode-charset word dictionary)
+ "\""))
+
+ (message nil)
+ (let ((reply (dictionary-read-reply-and-split)))
+ (if (dictionary-check-reply reply 552)
+ (progn
+ (unless nomatching
+ (beep)
+ (insert "Word not found, maybe you are looking "
+ "for one of these words\n\n")
+ (dictionary-do-matching word
+ dictionary
+ "."
+ 'dictionary-display-only-match-result)
+ (dictionary-post-buffer)))
+ (if (dictionary-check-reply reply 550)
+ (error "Dictionary \"%s\" is unknown, please select an existing one."
+ dictionary)
+ (unless (dictionary-check-reply reply 150)
+ (error "Unknown server answer: %s" (dictionary-reply reply)))
+ (funcall function reply)))))
+
+(define-button-type 'dictionary-link
+ 'face 'dictionary-reference-face
+ 'action (lambda (button)
+ (let ((func (button-get button 'callback))
+ (data (button-get button 'data))
+ (list-data (button-get button 'list-data)))
+ (if list-data
+ (apply func list-data)
+ (funcall func data)))))
+
+(define-button-type 'dictionary-button
+ :supertype 'dictionary-link
+ 'face 'dictionary-button-face)
+
+(defun dictionary-pre-buffer ()
+ "These commands are executed at the begin of a new buffer."
+ (setq buffer-read-only nil)
+ (erase-buffer)
+ (if dictionary-create-buttons
+ (progn
+ (insert-button "[Back]" :type 'dictionary-button
+ 'callback 'dictionary-restore-state
+ 'help-echo (purecopy "Mouse-2 to go backwards in history"))
+ (insert " ")
+ (insert-button "[Search definition]" :type 'dictionary-button
+ 'callback 'dictionary-search
+ 'help-echo (purecopy "Mouse-2 to look up a new word"))
+ (insert " ")
+
+ (insert-button "[Matching words]" :type 'dictionary-button
+ 'callback 'dictionary-match-words
+ 'help-echo (purecopy "Mouse-2 to find matches for a pattern"))
+ (insert " ")
+
+ (insert-button "[Quit]" :type 'dictionary-button
+ 'callback 'dictionary-close
+ 'help-echo (purecopy "Mouse-2 to close this window"))
+
+ (insert "\n ")
+
+ (insert-button "[Select dictionary]" :type 'dictionary-button
+ 'callback 'dictionary-select-dictionary
+ 'help-echo (purecopy "Mouse-2 to select dictionary for future searches"))
+ (insert " ")
+ (insert-button "[Select match strategy]" :type 'dictionary-button
+ 'callback 'dictionary-select-strategy
+ 'help-echo (purecopy "Mouse-2 to select matching algorithm"))
+ (insert "\n\n")))
+ (setq dictionary-marker (point-marker)))
+
+(defun dictionary-post-buffer ()
+ "These commands are executed at the end of a new buffer."
+ (goto-char dictionary-marker)
+
+ (set-buffer-modified-p nil)
+ (setq buffer-read-only t))
+
+(defun dictionary-display-search-result (reply)
+ "This function starts displaying the result in REPLY."
+
+ (let ((number (nth 1 (dictionary-reply-list reply))))
+ (insert number (if (equal number "1")
+ " definition"
+ " definitions")
+ " found\n\n")
+ (setq reply (dictionary-read-reply-and-split))
+ (while (dictionary-check-reply reply 151)
+ (let* ((reply-list (dictionary-reply-list reply))
+ (dictionary (nth 2 reply-list))
+ (description (nth 3 reply-list))
+ (word (nth 1 reply-list)))
+ (dictionary-display-word-entry dictionary description)
+ (setq reply (dictionary-read-answer))
+ (dictionary-display-word-definition reply word dictionary)
+ (setq reply (dictionary-read-reply-and-split))))
+ (dictionary-post-buffer)))
+
+(defun dictionary-display-word-entry (dictionary description)
+ "Insert an explanation for DESCRIPTION from DICTIONARY.
+The DICTIONARY is only used for decoding the bytes to display the DESCRIPTION."
+ (let ((start (point)))
+ (insert "From "
+ dictionary-description-open-delimiter
+ (dictionary-decode-charset description dictionary)
+ dictionary-description-close-delimiter
+ " [" (dictionary-decode-charset dictionary dictionary) "]:")
+ (put-text-property start (point) 'face 'dictionary-word-entry-face)
+ (insert "\n\n")))
+
+(defun dictionary-display-word-definition (reply word dictionary)
+ "Insert the definition in REPLY for the current WORD from DICTIONARY.
+It will replace links which are found in the REPLY and replace
+them with buttons to perform a a new search.
+"
+ (let ((start (point)))
+ (insert (dictionary-decode-charset reply dictionary))
+ (insert "\n\n")
+ (put-text-property start (point) 'face 'dictionary-word-definition-face)
+ (let ((regexp "\\({+\\)\\([^ '\"][^}]*\\)\\(}+\\)"))
+ (goto-char start)
+ (while (< (point) (point-max))
+ (if (search-forward-regexp regexp nil t)
+ (let ((match-start (match-beginning 2))
+ (match-end (match-end 2)))
+ (if dictionary-color-support
+ ;; Compensate for the replacement
+ (let ((brace-match-length (- (match-end 1)
+ (match-beginning 1))))
+ (setq match-start (- (match-beginning 2)
+ brace-match-length))
+ (setq match-end (- (match-end 2)
+ brace-match-length))
+ (replace-match "\\2")))
+ (dictionary-mark-reference match-start match-end
+ 'dictionary-new-search
+ word dictionary))
+ (goto-char (point-max)))))))
+
+(defun dictionary-mark-reference (start end call displayed-word dictionary)
+ "Format the area from START to END as link calling CALL.
+The word is taken from the buffer, the DICTIONARY is given as argument."
+ (let ((word (buffer-substring-no-properties start end)))
+ (while (string-match "\n\\s-*" word)
+ (setq word (replace-match " " t t word)))
+ (while (string-match "[*\"]" word)
+ (setq word (replace-match "" t t word)))
+
+ (unless (equal word displayed-word)
+ (make-button start end :type 'dictionary-link
+ 'callback call
+ 'data (cons word dictionary)
+ 'help-echo (concat "Press Mouse-2 to lookup \""
+ word "\" in \"" dictionary "\"")))))
+
+(defun dictionary-select-dictionary (&rest ignored)
+ "Save the current state and start a dictionary selection."
+ (interactive)
+ (dictionary-ensure-buffer)
+ (dictionary-store-positions)
+ (dictionary-do-select-dictionary)
+ (dictionary-store-state 'dictionary-do-select-dictionary nil))
+
+(defun dictionary-do-select-dictionary (&rest ignored)
+ "The workhorse for doing the dictionary selection."
+
+ (message "Looking up databases and descriptions")
+ (dictionary-send-command "show db")
+
+ (let ((reply (dictionary-read-reply-and-split)))
+ (message nil)
+ (if (dictionary-check-reply reply 554)
+ (error "No dictionary present")
+ (unless (dictionary-check-reply reply 110)
+ (error "Unknown server answer: %s"
+ (dictionary-reply reply)))
+ (dictionary-display-dictionarys))))
+
+(defun dictionary-simple-split-string (string &optional pattern)
+ "Return a list of substrings of STRING which are separated by PATTERN.
+If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
+ (or pattern
+ (setq pattern "[ \f\t\n\r\v]+"))
+ ;; The FSF version of this function takes care not to cons in case
+ ;; of infloop. Maybe we should synch?
+ (let (parts (start 0))
+ (while (string-match pattern string start)
+ (setq parts (cons (substring string start (match-beginning 0)) parts)
+ start (match-end 0)))
+ (nreverse (cons (substring string start) parts))))
+
+(defun dictionary-display-dictionarys ()
+ "Handle the display of all dictionaries existing on the server."
+ (dictionary-pre-buffer)
+ (insert "Please select your default dictionary:\n\n")
+ (dictionary-display-dictionary-line "* \"All dictionaries\"")
+ (dictionary-display-dictionary-line "! \"The first matching dictionary\"")
+ (let* ((reply (dictionary-read-answer))
+ (list (dictionary-simple-split-string reply "\n+")))
+ (mapc 'dictionary-display-dictionary-line list))
+ (dictionary-post-buffer))
+
+(defun dictionary-display-dictionary-line (string)
+ "Display a single dictionary and its description read from STRING."
+ (let* ((list (dictionary-split-string string))
+ (dictionary (car list))
+ (description (cadr list))
+ (translated (dictionary-decode-charset description dictionary)))
+ (if dictionary
+ (if (equal dictionary "--exit--")
+ (insert "(end of default search list)\n")
+ (insert-button (concat dictionary ": " translated) :type 'dictionary-link
+ 'callback 'dictionary-set-dictionary
+ 'data (cons dictionary description)
+ 'help-echo (purecopy "Mouse-2 to select this dictionary"))
+ (unless (dictionary-special-dictionary dictionary)
+ (insert " ")
+ (insert-button "(Details)" :type 'dictionary-link
+ 'callback 'dictionary-set-dictionary
+ 'list-data (list (cons dictionary description) t)
+ 'help-echo (purecopy "Mouse-2 to get more information")))
+ (insert "\n")))))
+
+(defun dictionary-set-dictionary (param &optional more)
+ "Select the dictionary which is the car of PARAM as new default."
+
+ (if more
+ (dictionary-display-more-info param)
+ (let ((dictionary (car param)))
+ (setq dictionary-default-dictionary dictionary)
+ (dictionary-restore-state)
+ (message "Dictionary %s has been selected" dictionary))))
+
+(defun dictionary-special-dictionary (name)
+ "Checks whether the special * or ! dictionary are seen in NAME."
+ (or (equal name "*")
+ (equal name "!")))
+
+(defun dictionary-display-more-info (param)
+ "Display the available information on the dictionary found in PARAM."
+
+ (let ((dictionary (car param))
+ (description (cdr param)))
+ (unless (dictionary-special-dictionary dictionary)
+ (dictionary-store-positions)
+ (message "Requesting more information on %s" dictionary)
+ (dictionary-send-command
+ (concat "show info " (dictionary-encode-charset dictionary "")))
+ (let ((reply (dictionary-read-reply-and-split)))
+ (message nil)
+ (if (dictionary-check-reply reply 550)
+ (error "Dictionary \"%s\" does not exist" dictionary)
+ (unless (dictionary-check-reply reply 112)
+ (error "Unknown server answer: %s" (dictionary-reply reply)))
+ (dictionary-pre-buffer)
+ (insert "Information on dictionary: ")
+ (insert-button description :type 'dictionary-link
+ 'callback 'dictionary-set-dictionary
+ 'data (cons dictionary description)
+ 'help-echo (purecopy "Mouse-2 to select this dictionary"))
+ (insert "\n\n")
+ (setq reply (dictionary-read-answer))
+ (insert reply)
+ (dictionary-post-buffer)))
+
+ (dictionary-store-state 'dictionary-display-more-info dictionary))))
+
+(defun dictionary-select-strategy (&rest ignored)
+ "Save the current state and start a strategy selection."
+ (interactive)
+ (dictionary-ensure-buffer)
+ (dictionary-store-positions)
+ (dictionary-do-select-strategy)
+ (dictionary-store-state 'dictionary-do-select-strategy nil))
+
+(defun dictionary-do-select-strategy ()
+ "The workhorse for doing the strategy selection."
+
+ (message "Request existing matching algorithm")
+ (dictionary-send-command "show strat")
+
+ (let ((reply (dictionary-read-reply-and-split)))
+ (message nil)
+ (if (dictionary-check-reply reply 555)
+ (error "No strategies available")
+ (unless (dictionary-check-reply reply 111)
+ (error "Unknown server answer: %s"
+ (dictionary-reply reply)))
+ (dictionary-display-strategies))))
+
+(defun dictionary-display-strategies ()
+ "Handle the display of all strategies existing on the server."
+ (dictionary-pre-buffer)
+ (insert "Please select your default search strategy:\n\n")
+ (dictionary-display-strategy-line ". \"The servers default\"")
+ (let* ((reply (dictionary-read-answer))
+ (list (dictionary-simple-split-string reply "\n+")))
+ (mapc 'dictionary-display-strategy-line list))
+ (dictionary-post-buffer))
+
+(defun dictionary-display-strategy-line (string)
+ "Display a single strategy found in STRING."
+ (let* ((list (dictionary-split-string string))
+ (strategy (car list))
+ (description (cadr list)))
+ (if strategy
+ (progn
+ (insert-button description :type 'dictionary-link
+ 'callback 'dictionary-set-strategy
+ 'data strategy
+ 'help-echo (purecopy "Mouse-2 to select this matching algorithm"))
+ (insert "\n")))))
+
+(defun dictionary-set-strategy (strategy &rest ignored)
+ "Select this STRATEGY as new default"
+ (setq dictionary-default-strategy strategy)
+ (dictionary-restore-state)
+ (message "Strategy %s has been selected" strategy))
+
+(defun dictionary-new-matching (word)
+ "Run a new matching search on WORD."
+ (dictionary-ensure-buffer)
+ (dictionary-store-positions)
+ (dictionary-do-matching word dictionary-default-dictionary
+ dictionary-default-strategy
+ 'dictionary-display-match-result)
+ (dictionary-store-state 'dictionary-do-matching
+ (list word dictionary-default-dictionary
+ dictionary-default-strategy
+ 'dictionary-display-match-result)))
+
+(defun dictionary-do-matching (word dictionary strategy function)
+ "Find matches for WORD with STRATEGY in DICTIONARY and display them with FUNCTION."
+
+ (message "Lookup matching words for %s in %s using %s"
+ word dictionary strategy)
+ (dictionary-send-command
+ (concat "match " (dictionary-encode-charset dictionary "") " "
+ (dictionary-encode-charset strategy "") " \""
+ (dictionary-encode-charset word "") "\""))
+ (let ((reply (dictionary-read-reply-and-split)))
+ (message nil)
+ (if (dictionary-check-reply reply 550)
+ (error "Dictionary \"%s\" is invalid" dictionary))
+ (if (dictionary-check-reply reply 551)
+ (error "Strategy \"%s\" is invalid" strategy))
+ (if (dictionary-check-reply reply 552)
+ (error (concat
+ "No match for \"%s\" with strategy \"%s\" in "
+ "dictionary \"%s\".")
+ word strategy dictionary))
+ (unless (dictionary-check-reply reply 152)
+ (error "Unknown server answer: %s" (dictionary-reply reply)))
+ (funcall function reply)))
+
+(defun dictionary-display-only-match-result (reply)
+ "Display the results from the current matches in REPLY without the headers."
+
+ (let ((number (nth 1 (dictionary-reply-list reply)))
+ (list (dictionary-simple-split-string (dictionary-read-answer) "\n+")))
+ (insert number " matching word" (if (equal number "1") "" "s")
+ " found\n\n")
+ (let ((result nil))
+ (mapc (lambda (item)
+ (let* ((list (dictionary-split-string item))
+ (dictionary (car list))
+ (word (cadr list))
+ (hash (assoc dictionary result)))
+ (if dictionary
+ (if hash
+ (setcdr hash (cons word (cdr hash)))
+ (setq result (cons
+ (cons dictionary (list word))
+ result))))))
+ list)
+ (dictionary-display-match-lines (reverse result)))))
+
+(defun dictionary-display-match-result (reply)
+ "Display the results in REPLY from a match operation."
+ (dictionary-pre-buffer)
+
+ (let ((number (nth 1 (dictionary-reply-list reply)))
+ (list (dictionary-simple-split-string (dictionary-read-answer) "\n+")))
+ (insert number " matching word" (if (equal number "1") "" "s")
+ " found\n\n")
+ (let ((result nil))
+ (mapc (lambda (item)
+ (let* ((list (dictionary-split-string item))
+ (dictionary (car list))
+ (word (cadr list))
+ (hash (assoc dictionary result)))
+ (if dictionary
+ (if hash
+ (setcdr hash (cons word (cdr hash)))
+ (setq result (cons
+ (cons dictionary (list word))
+ result))))))
+ list)
+ (dictionary-display-match-lines (reverse result))))
+ (dictionary-post-buffer))
+
+(defun dictionary-display-match-lines (list)
+ "Display a line for each match found in LIST."
+ (mapc (lambda (item)
+ (let ((dictionary (car item))
+ (word-list (cdr item)))
+ (insert "Matches from " dictionary ":\n")
+ (mapc (lambda (word)
+ (setq word (dictionary-decode-charset word dictionary))
+ (insert " ")
+ (insert-button word :type 'dictionary-link
+ 'callback 'dictionary-new-search
+ 'data (cons word dictionary)
+ 'help-echo (purecopy "Mouse-2 to lookup word"))
+ (insert "\n")) (reverse word-list))
+ (insert "\n")))
+ list))
+
+;; Returns a sensible default for dictionary-search:
+;; - if region is active returns its contents
+;; - otherwise return the word near the point
+(defun dictionary-search-default ()
+ (if (use-region-p)
+ (buffer-substring-no-properties (region-beginning) (region-end))
+ (current-word t)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; User callable commands
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;###autoload
+(defun dictionary-search (word &optional dictionary)
+ "Search the WORD in DICTIONARY if given or in all if nil.
+It presents the selection or word at point as default input and
+allows editing it."
+ (interactive
+ (list (let ((default (dictionary-search-default)))
+ (read-string (if default
+ (format "Search word (%s): " default)
+ "Search word: ")
+ nil 'dictionary-word-history default))
+ (if current-prefix-arg
+ (read-string (if dictionary-default-dictionary
+ (format "Dictionary (%s): " dictionary-default-dictionary)
+ "Dictionary: ")
+ nil nil dictionary-default-dictionary)
+ dictionary-default-dictionary)))
+
+ ;; if called by pressing the button
+ (unless word
+ (setq word (read-string "Search word: " nil 'dictionary-word-history)))
+ ;; just in case non-interactivly called
+ (unless dictionary
+ (setq dictionary dictionary-default-dictionary))
+ (dictionary-new-search (cons word dictionary)))
+
+;;;###autoload
+(defun dictionary-lookup-definition ()
+ "Unconditionally lookup the word at point."
+ (interactive)
+ (dictionary-new-search (cons (current-word) dictionary-default-dictionary)))
+
+(defun dictionary-previous ()
+ "Go to the previous location in the current buffer."
+ (interactive)
+ (unless (dictionary-mode-p)
+ (error "Current buffer is no dictionary buffer"))
+ (dictionary-restore-state))
+
+(defun dictionary-help ()
+ "Display a little help."
+ (interactive)
+ (describe-function 'dictionary-mode))
+
+;;;###autoload
+(defun dictionary-match-words (&optional pattern &rest ignored)
+ "Search PATTERN in current default dictionary using default strategy."
+ (interactive)
+ ;; can't use interactive because of mouse events
+ (or pattern
+ (setq pattern (read-string "Search pattern: "
+ nil 'dictionary-word-history)))
+ (dictionary-new-matching pattern))
+
+;;;###autoload
+(defun dictionary-mouse-popup-matching-words (event)
+ "Display entries matching the word at the cursor retrieved using EVENT."
+ (interactive "e")
+ (let ((word (save-window-excursion
+ (save-excursion
+ (mouse-set-point event)
+ (current-word)))))
+ (selected-window)
+ (dictionary-popup-matching-words word)))
+
+;;;###autoload
+(defun dictionary-popup-matching-words (&optional word)
+ "Display entries matching WORD or the current word if not given."
+ (interactive)
+ (dictionary-do-matching (or word (current-word) (error "Nothing to search for"))
+ dictionary-default-dictionary
+ dictionary-default-popup-strategy
+ 'dictionary-process-popup-replies))
+
+(defun dictionary-process-popup-replies (&ignore)
+ (let ((list (dictionary-simple-split-string (dictionary-read-answer) "\n+")))
+
+ (let ((result (mapcar (lambda (item)
+ (let* ((list (dictionary-split-string item))
+ (dictionary (car list))
+ (word (dictionary-decode-charset
+ (cadr list) dictionary)))
+ (message word)
+ (if (equal word "")
+ [ "-" nil nil]
+ (vector (concat "[" dictionary "] " word)
+ `(dictionary-new-search
+ '(,word . ,dictionary))
+ t ))))
+
+ list)))
+ (easy-menu-define dictionary-mode-map-menu dictionary-mode-map
+ "Menu used for displaying dictionary popup"
+ (cons "Matching words"
+ `(,@result)))
+ (popup-menu dictionary-mode-map-menu))))
+
+;;; Tooltip support
+
+;; Add a mode indicater named "Dict"
+(defvar dictionary-tooltip-mode
+ nil
+ "Indicates wheather the dictionary tooltip mode is active.")
+(nconc minor-mode-alist '((dictionary-tooltip-mode " Dict")))
+
+(defcustom dictionary-tooltip-dictionary
+ nil
+ "This dictionary to lookup words for tooltips"
+ :group 'dictionary
+ :type '(choice (const :tag "None" nil) string)
+ :version "28.1")
+
+(defun dictionary-definition (word &optional dictionary)
+ (interactive)
+ (unwind-protect
+ (let ((dictionary (or dictionary dictionary-default-dictionary)))
+ (dictionary-do-search word dictionary 'dictionary-read-definition t))
+ nil))
+
+(defun dictionary-read-definition (&ignore)
+ (let ((list (dictionary-simple-split-string (dictionary-read-answer) "\n+")))
+ (mapconcat 'identity (cdr list) "\n")))
+
+;;; Tooltip support for GNU Emacs
+(defvar global-dictionary-tooltip-mode
+ nil)
+
+(defun dictionary-word-at-mouse-event (event)
+ (with-current-buffer (tooltip-event-buffer event)
+ (let ((point (posn-point (event-end event))))
+ (if (use-region-p)
+ (when (and (<= (region-beginning) point) (<= point (region-end)))
+ (buffer-substring (region-beginning) (region-end)))
+ (save-excursion
+ (goto-char point)
+ (current-word))))))
+
+(defvar dictionary-tooltip-mouse-event nil
+ "Event that triggered the tooltip mode.")
+
+(defun dictionary-display-tooltip (&ignore)
+ "Search the current word in the `dictionary-tooltip-dictionary'."
+ (interactive "e")
+ (if (and dictionary-tooltip-mode dictionary-tooltip-dictionary)
+ (let ((word (dictionary-word-at-mouse-event dictionary-tooltip-mouse-event)))
+ (if word
+ (let ((definition
+ (dictionary-definition word dictionary-tooltip-dictionary)))
+ (if definition
+ (tooltip-show (dictionary-decode-charset definition
+ dictionary-tooltip-dictionary)))))
+ t)
+ nil))
+
+(defun dictionary-tooltip-track-mouse (event)
+ "Called whenever a dictionary tooltip display is about to be triggered."
+ (interactive "e")
+ (tooltip-hide)
+ (when dictionary-tooltip-mode
+ (setq dictionary-tooltip-mouse-event (copy-sequence event))
+ (tooltip-start-delayed-tip)))
+
+(defun dictionary-switch-tooltip-mode (on)
+ "Turn off or on support for the dictionary tooltip mode.
+
+It is normally internally called with 1 to enable support for the
+tooltip mode. The hook function will check the value of the
+variable dictionary-tooltip-mode to decide if some action must be
+taken. When disabling the tooltip mode the value of this variable
+will be set to nil.
+"
+ (interactive)
+ (tooltip-mode on)
+ (if on
+ (add-hook 'tooltip-functions 'dictionary-display-tooltip)
+ (remove-hook 'tooltip-functions 'dictionary-display-tooltip)))
+
+;;;###autoload
+(defun dictionary-tooltip-mode (&optional arg)
+ "Display tooltips for the current word.
+
+This function can be used to enable or disable the tooltip mode
+for the current buffer (based on ARG). If global-tooltip-mode is
+active it will overwrite that mode for the current buffer.
+"
+
+ (interactive "P")
+ (require 'tooltip)
+ (let ((on (if arg
+ (> (prefix-numeric-value arg) 0)
+ (not dictionary-tooltip-mode))))
+ (setq-local dictionary-tooltip-mode on)
+ (setq-local track-mouse on)
+ (make-local-variable 'dictionary-tooltip-mouse-event)
+ (dictionary-switch-tooltip-mode 1)
+ (if on
+ (local-set-key [mouse-movement] 'dictionary-tooltip-track-mouse)
+ (local-set-key [mouse-movement] 'ignore))
+ on))
+
+;;;###autoload
+(defun global-dictionary-tooltip-mode (&optional arg)
+ "Enable/disable dictionary-tooltip-mode for all buffers.
+
+Internally it provides a default for the dictionary-tooltip-mode.
+It can be overwritten for each buffer using dictionary-tooltip-mode.
+
+Note: (global-dictionary-tooltip-mode 0) will not disable the mode
+any buffer where (dictionary-tooltip-mode 1) has been called.
+"
+ (interactive "P")
+ (require 'tooltip)
+ (let ((on (if arg (> (prefix-numeric-value arg) 0)
+ (not global-dictionary-tooltip-mode))))
+ (setq global-dictionary-tooltip-mode on)
+ (setq-default dictionary-tooltip-mode on)
+ (make-local-variable 'dictionary-tooltip-mouse-event)
+ (setq-default track-mouse on)
+ (dictionary-switch-tooltip-mode 1)
+ (if on
+ (global-set-key [mouse-movement] 'dictionary-tooltip-track-mouse)
+ (global-set-key [mouse-movement] 'ignore))
+ on))
+
+(provide 'dictionary)
+;;; dictionary.el ends here
diff --git a/lisp/net/dig.el b/lisp/net/dig.el
index f36999119f2..92dcf73250b 100644
--- a/lisp/net/dig.el
+++ b/lisp/net/dig.el
@@ -1,6 +1,6 @@
;;; dig.el --- Domain Name System dig interface -*- lexical-binding:t -*-
-;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
;; Keywords: DNS BIND dig comm
@@ -127,10 +127,8 @@ Buffer should contain output generated by `dig-invoke'."
"Major mode for displaying dig output."
(buffer-disable-undo)
(setq-local font-lock-defaults '(dig-font-lock-keywords t))
- (when (featurep 'font-lock)
- ;; FIXME: what is this for?? --Stef
- (font-lock-set-defaults))
- )
+ ;; FIXME: what is this for?? --Stef M
+ (font-lock-set-defaults))
(defun dig-exit ()
"Quit dig output buffer."
diff --git a/lisp/net/dns.el b/lisp/net/dns.el
index c368cd773c2..2045d4dfca1 100644
--- a/lisp/net/dns.el
+++ b/lisp/net/dns.el
@@ -1,6 +1,6 @@
;;; dns.el --- Domain Name Service lookups -*- lexical-binding:t -*-
-;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: network comm
diff --git a/lisp/net/eudc-bob.el b/lisp/net/eudc-bob.el
index bb6682520ae..456d70ee0fe 100644
--- a/lisp/net/eudc-bob.el
+++ b/lisp/net/eudc-bob.el
@@ -1,6 +1,6 @@
;;; eudc-bob.el --- Binary Objects Support for EUDC -*- lexical-binding: t; -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
;; Pavel Janík <Pavel@Janik.cz>
@@ -153,9 +153,7 @@ display a button."
'end-glyph (if inline glyph)
'duplicable t
'invisible inline
- 'start-open t
- 'end-open t
- 'object-data data))))
+ 'object-data data))))
((fboundp 'create-image)
(let* ((image (create-image data nil t))
(props (list 'object-data data 'eudc-image image)))
@@ -192,9 +190,7 @@ display a button."
eudc-bob-sound-keymap
eudc-bob-sound-menu
(list 'duplicable t
- 'start-open t
- 'end-open t
- 'object-data data)))
+ 'object-data data)))
(defun eudc-bob-display-generic-binary (data)
"Display a button for unidentified binary DATA."
@@ -202,9 +198,7 @@ display a button."
eudc-bob-generic-keymap
eudc-bob-generic-menu
(list 'duplicable t
- 'start-open t
- 'end-open t
- 'object-data data)))
+ 'object-data data)))
(defun eudc-bob-play-sound-at-point ()
"Play the sound data contained in the button at point."
diff --git a/lisp/net/eudc-export.el b/lisp/net/eudc-export.el
index ba86958142c..bac75e6555d 100644
--- a/lisp/net/eudc-export.el
+++ b/lisp/net/eudc-export.el
@@ -1,6 +1,6 @@
;;; eudc-export.el --- functions to export EUDC query results
-;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
;; Pavel Janík <Pavel@Janik.cz>
@@ -78,12 +78,11 @@ If SILENT is non-nil then the created BBDB record is not displayed."
record t)))
;; BBDB custom fields
(setq bbdb-notes (append (list (and bbdb-notes (cons 'notes bbdb-notes)))
- (mapcar (function
- (lambda (mapping)
- (if (and (not (memq (car mapping)
- '(name company net address phone notes)))
- (setq value (eudc-parse-spec (cdr mapping) record nil)))
- (cons (car mapping) value))))
+ (mapcar (lambda (mapping)
+ (if (and (not (memq (car mapping)
+ '(name company net address phone notes)))
+ (setq value (eudc-parse-spec (cdr mapping) record nil)))
+ (cons (car mapping) value)))
conversion-alist)))
(setq bbdb-notes (delq nil bbdb-notes))
(setq bbdb-record (bbdb-create-internal
diff --git a/lisp/net/eudc-hotlist.el b/lisp/net/eudc-hotlist.el
index f87f8f0fb03..e4b7e8ae71b 100644
--- a/lisp/net/eudc-hotlist.el
+++ b/lisp/net/eudc-hotlist.el
@@ -1,6 +1,6 @@
;;; eudc-hotlist.el --- hotlist management for EUDC
-;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
;; Pavel Janík <Pavel@Janik.cz>
diff --git a/lisp/net/eudc-vars.el b/lisp/net/eudc-vars.el
index bb1474b8b5b..b80801717f1 100644
--- a/lisp/net/eudc-vars.el
+++ b/lisp/net/eudc-vars.el
@@ -1,6 +1,6 @@
;;; eudc-vars.el --- Emacs Unified Directory Client -*- lexical-binding: t -*-
-;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
;; Pavel Janík <Pavel@Janik.cz>
@@ -27,8 +27,6 @@
;;; Code:
-(require 'custom)
-
;;{{{ EUDC Main Custom Group
(defgroup eudc nil
diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el
index 08cab4f0470..f61929c9ef8 100644
--- a/lisp/net/eudc.el
+++ b/lisp/net/eudc.el
@@ -1,6 +1,6 @@
;;; eudc.el --- Emacs Unified Directory Client -*- lexical-binding:t -*-
-;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
;; Pavel Janík <Pavel@Janik.cz>
@@ -414,10 +414,9 @@ if any, is called to print the value in cdr of FIELD."
(eval (list (cdr match) val))
(insert "\n"))
(mapc
- (function
- (lambda (val-elem)
- (indent-to col)
- (insert val-elem "\n")))
+ (lambda (val-elem)
+ (indent-to col)
+ (insert val-elem "\n"))
(cond
((listp val) val)
((stringp val) (split-string val "\n"))
@@ -464,37 +463,33 @@ otherwise they are formatted according to `eudc-user-attribute-names-alist'."
;; Replace field names with user names, compute max width
(setq precords
(mapcar
- (function
- (lambda (record)
- (mapcar
- (function
- (lambda (field)
- (setq attribute-name
- (if raw-attr-names
- (symbol-name (car field))
- (eudc-format-attribute-name-for-display (car field))))
- (if (> (length attribute-name) width)
- (setq width (length attribute-name)))
- (cons attribute-name (cdr field))))
- record)))
+ (lambda (record)
+ (mapcar
+ (lambda (field)
+ (setq attribute-name
+ (if raw-attr-names
+ (symbol-name (car field))
+ (eudc-format-attribute-name-for-display (car field))))
+ (if (> (length attribute-name) width)
+ (setq width (length attribute-name)))
+ (cons attribute-name (cdr field)))
+ record))
records))
;; Display the records
(setq first-record (point))
(mapc
- (function
- (lambda (record)
- (setq beg (point))
- ;; Map over the record fields to print the attribute/value pairs
- (mapc (function
- (lambda (field)
- (eudc-print-record-field field width)))
- record)
- ;; Store the record internal format in some convenient place
- (overlay-put (make-overlay beg (point))
- 'eudc-record
- (car records))
- (setq records (cdr records))
- (insert "\n")))
+ (lambda (record)
+ (setq beg (point))
+ ;; Map over the record fields to print the attribute/value pairs
+ (mapc (lambda (field)
+ (eudc-print-record-field field width))
+ record)
+ ;; Store the record internal format in some convenient place
+ (overlay-put (make-overlay beg (point))
+ 'eudc-record
+ (car records))
+ (setq records (cdr records))
+ (insert "\n"))
precords))
(insert "\n")
(widget-create 'push-button
@@ -518,12 +513,11 @@ otherwise they are formatted according to `eudc-user-attribute-names-alist'."
(if (not (and (boundp 'eudc-form-widget-list)
eudc-form-widget-list))
(error "Not in a directory query form buffer")
- (mapc (function
- (lambda (wid-field)
- (setq value (widget-value (cdr wid-field)))
- (if (not (string= value ""))
- (setq query-alist (cons (cons (car wid-field) value)
- query-alist)))))
+ (mapc (lambda (wid-field)
+ (setq value (widget-value (cdr wid-field)))
+ (if (not (string= value ""))
+ (setq query-alist (cons (cons (car wid-field) value)
+ query-alist))))
eudc-form-widget-list)
(kill-buffer (current-buffer))
(eudc-display-records (eudc-query query-alist) eudc-use-raw-directory-names))))
@@ -543,49 +537,47 @@ otherwise they are formatted according to `eudc-user-attribute-names-alist'."
(if (null (cdar rec))
(list record) ; No duplicate attrs in this record
- (mapc (function
- (lambda (field)
- (if (listp (cdr field))
- (setq duplicates (cons field duplicates))
- (setq unique (cons field unique)))))
+ (mapc (lambda (field)
+ (if (listp (cdr field))
+ (setq duplicates (cons field duplicates))
+ (setq unique (cons field unique))))
record)
(setq result (list unique))
;; Map over the record fields that have multiple values
(mapc
- (function
- (lambda (field)
- (let ((method (if (consp eudc-duplicate-attribute-handling-method)
- (cdr
- (assq
- (or
- (car
- (rassq
- (car field)
- (symbol-value
- eudc-protocol-attributes-translation-alist)))
- (car field))
- eudc-duplicate-attribute-handling-method))
- eudc-duplicate-attribute-handling-method)))
- (cond
- ((or (null method) (eq 'list method))
- (setq result
- (eudc-add-field-to-records field result)))
- ((eq 'first method)
- (setq result
- (eudc-add-field-to-records (cons (car field)
- (cadr field))
- result)))
- ((eq 'concat method)
- (setq result
- (eudc-add-field-to-records (cons (car field)
- (mapconcat
- #'identity
- (cdr field)
- "\n"))
- result)))
- ((eq 'duplicate method)
- (setq result
- (eudc-distribute-field-on-records field result)))))))
+ (lambda (field)
+ (let ((method (if (consp eudc-duplicate-attribute-handling-method)
+ (cdr
+ (assq
+ (or
+ (car
+ (rassq
+ (car field)
+ (symbol-value
+ eudc-protocol-attributes-translation-alist)))
+ (car field))
+ eudc-duplicate-attribute-handling-method))
+ eudc-duplicate-attribute-handling-method)))
+ (cond
+ ((or (null method) (eq 'list method))
+ (setq result
+ (eudc-add-field-to-records field result)))
+ ((eq 'first method)
+ (setq result
+ (eudc-add-field-to-records (cons (car field)
+ (cadr field))
+ result)))
+ ((eq 'concat method)
+ (setq result
+ (eudc-add-field-to-records (cons (car field)
+ (mapconcat
+ #'identity
+ (cdr field)
+ "\n"))
+ result)))
+ ((eq 'duplicate method)
+ (setq result
+ (eudc-distribute-field-on-records field result))))))
duplicates)
result)))
@@ -593,19 +585,17 @@ otherwise they are formatted according to `eudc-user-attribute-names-alist'."
"Eliminate records that do not contain all ATTRS from RECORDS."
(delq nil
(mapcar
- (function
- (lambda (rec)
- (if (cl-every (lambda (attr)
- (consp (assq attr rec)))
- attrs)
- rec)))
+ (lambda (rec)
+ (if (cl-every (lambda (attr)
+ (consp (assq attr rec)))
+ attrs)
+ rec))
records)))
(defun eudc-add-field-to-records (field records)
"Add FIELD to each individual record in RECORDS and return the resulting list."
- (mapcar (function
- (lambda (r)
- (cons field r)))
+ (mapcar (lambda (r)
+ (cons field r))
records))
(defun eudc-distribute-field-on-records (field records)
@@ -886,10 +876,9 @@ see `eudc-inline-expansion-servers'."
(let ((response-string
(apply #'format
(car eudc-inline-expansion-format)
- (mapcar (function
- (lambda (field)
- (or (cdr (assq field r))
- "")))
+ (mapcar (lambda (field)
+ (or (cdr (assq field r))
+ ""))
(eudc-translate-attribute-list
(cdr eudc-inline-expansion-format))))))
(if (> (length response-string) 0)
@@ -929,16 +918,14 @@ queries the server for the existing fields and displays a corresponding form."
;; Build the list of prompts
(setq prompts (if eudc-use-raw-directory-names
(mapcar #'symbol-name (eudc-translate-attribute-list fields))
- (mapcar (function
- (lambda (field)
- (or (cdr (assq field eudc-user-attribute-names-alist))
- (capitalize (symbol-name field)))))
+ (mapcar (lambda (field)
+ (or (cdr (assq field eudc-user-attribute-names-alist))
+ (capitalize (symbol-name field))))
fields)))
;; Loop over prompt strings to find the longest one
- (mapc (function
- (lambda (prompt)
- (if (> (length prompt) width)
- (setq width (length prompt)))))
+ (mapc (lambda (prompt)
+ (if (> (length prompt) width)
+ (setq width (length prompt))))
prompts)
;; Insert the first widget out of the mapcar to leave the cursor
;; in the first field
@@ -949,14 +936,13 @@ queries the server for the existing fields and displays a corresponding form."
eudc-form-widget-list))
(setq fields (cdr fields))
(setq prompts (cdr prompts))
- (mapc (function
- (lambda (field)
- (widget-insert "\n\n" (format (concat "%" (int-to-string width) "s: ") (car prompts)))
- (setq widget (widget-create 'editable-field
- :size 15))
- (setq eudc-form-widget-list (cons (cons field widget)
- eudc-form-widget-list))
- (setq prompts (cdr prompts))))
+ (mapc (lambda (field)
+ (widget-insert "\n\n" (format (concat "%" (int-to-string width) "s: ") (car prompts)))
+ (setq widget (widget-create 'editable-field
+ :size 15))
+ (setq eudc-form-widget-list (cons (cons field widget)
+ eudc-form-widget-list))
+ (setq prompts (cdr prompts)))
fields)
(widget-insert "\n\n")
(widget-create 'push-button
@@ -1118,27 +1104,26 @@ queries the server for the existing fields and displays a corresponding form."
(append
'("Server")
(mapcar
- (function
- (lambda (servspec)
- (let* ((server (car servspec))
- (protocol (cdr servspec))
- (proto-name (symbol-name protocol)))
- (setq command (intern (concat "eudc-set-server-"
- server
- "-"
- proto-name)))
- (if (not (fboundp command))
- (fset command
- `(lambda ()
- (interactive)
- (eudc-set-server ,server (quote ,protocol))
- (message "Selected directory server is now %s (%s)"
- ,server
- ,proto-name))))
- (vector (format "%s (%s)" server proto-name)
- command
- :style 'radio
- :selected `(equal eudc-server ,server)))))
+ (lambda (servspec)
+ (let* ((server (car servspec))
+ (protocol (cdr servspec))
+ (proto-name (symbol-name protocol)))
+ (setq command (intern (concat "eudc-set-server-"
+ server
+ "-"
+ proto-name)))
+ (if (not (fboundp command))
+ (fset command
+ `(lambda ()
+ (interactive)
+ (eudc-set-server ,server (quote ,protocol))
+ (message "Selected directory server is now %s (%s)"
+ ,server
+ ,proto-name))))
+ (vector (format "%s (%s)" server proto-name)
+ command
+ :style 'radio
+ :selected `(equal eudc-server ,server))))
eudc-server-hotlist)
eudc-server-menu))
eudc-tail-menu)))
diff --git a/lisp/net/eudcb-bbdb.el b/lisp/net/eudcb-bbdb.el
index 82e58c28336..e11458b29cb 100644
--- a/lisp/net/eudcb-bbdb.el
+++ b/lisp/net/eudcb-bbdb.el
@@ -1,6 +1,6 @@
;;; eudcb-bbdb.el --- Emacs Unified Directory Client - BBDB Backend
-;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
;; Pavel Janík <Pavel@Janik.cz>
@@ -137,18 +137,17 @@ BBDB < 3 used `net'; BBDB >= 3 uses `mail'."
(defun eudc-bbdb-extract-phones (record)
(require 'bbdb)
- (mapcar (function
- (lambda (phone)
- (if eudc-bbdb-use-locations-as-attribute-names
- (cons (intern (if (eudc--using-bbdb-3-or-newer-p)
- (bbdb-phone-label phone)
- (bbdb-phone-location phone)))
- (bbdb-phone-string phone))
- (cons 'phones (format "%s: %s"
- (if (eudc--using-bbdb-3-or-newer-p)
- (bbdb-phone-label phone)
- (bbdb-phone-location phone))
- (bbdb-phone-string phone))))))
+ (mapcar (lambda (phone)
+ (if eudc-bbdb-use-locations-as-attribute-names
+ (cons (intern (if (eudc--using-bbdb-3-or-newer-p)
+ (bbdb-phone-label phone)
+ (bbdb-phone-location phone)))
+ (bbdb-phone-string phone))
+ (cons 'phones (format "%s: %s"
+ (if (eudc--using-bbdb-3-or-newer-p)
+ (bbdb-phone-label phone)
+ (bbdb-phone-location phone))
+ (bbdb-phone-string phone)))))
(if (eudc--using-bbdb-3-or-newer-p)
(bbdb-record-phone record)
(bbdb-record-phones record))))
@@ -243,17 +242,15 @@ RETURN-ATTRS is a list of attributes to return, defaulting to
(if (car query-attrs)
(setq records (eval `(bbdb-search ,(quote records) ,@bbdb-attrs))))
(setq query-attrs (cdr query-attrs)))
- (mapc (function
- (lambda (record)
- (setq filtered (eudc-filter-duplicate-attributes record))
- ;; If there were duplicate attributes reverse the order of the
- ;; record so the unique attributes appear first
- (if (> (length filtered) 1)
- (setq filtered (mapcar (function
- (lambda (rec)
- (reverse rec)))
- filtered)))
- (setq result (append result filtered))))
+ (mapc (lambda (record)
+ (setq filtered (eudc-filter-duplicate-attributes record))
+ ;; If there were duplicate attributes reverse the order of the
+ ;; record so the unique attributes appear first
+ (if (> (length filtered) 1)
+ (setq filtered (mapcar (lambda (rec)
+ (reverse rec))
+ filtered)))
+ (setq result (append result filtered)))
(delq nil
(mapcar 'eudc-bbdb-format-record-as-result
(delq nil
diff --git a/lisp/net/eudcb-ldap.el b/lisp/net/eudcb-ldap.el
index 88c58f5729a..4623079ea9f 100644
--- a/lisp/net/eudcb-ldap.el
+++ b/lisp/net/eudcb-ldap.el
@@ -1,6 +1,6 @@
;;; eudcb-ldap.el --- Emacs Unified Directory Client - LDAP Backend
-;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
;; Pavel Janík <Pavel@Janik.cz>
@@ -76,12 +76,11 @@
"Do some cleanup in a RECORD to make it suitable for EUDC."
(declare (obsolete eudc-ldap-cleanup-record-filtering-addresses "25.1"))
(mapcar
- (function
- (lambda (field)
- (cons (intern (downcase (car field)))
- (if (cdr (cdr field))
- (cdr field)
- (car (cdr field))))))
+ (lambda (field)
+ (cons (intern (downcase (car field)))
+ (if (cdr (cdr field))
+ (cdr field)
+ (car (cdr field)))))
record))
(defun eudc-filter-$ (string)
@@ -138,10 +137,10 @@ RETURN-ATTRS is a list of attributes to return, defaulting to
;; Apply eudc-duplicate-attribute-handling-method
(if (not (eq 'list eudc-duplicate-attribute-handling-method))
(mapc
- (function (lambda (record)
- (setq final-result
- (append (eudc-filter-duplicate-attributes record)
- final-result))))
+ (lambda (record)
+ (setq final-result
+ (append (eudc-filter-duplicate-attributes record)
+ final-result)))
result))
final-result))
diff --git a/lisp/net/eudcb-mab.el b/lisp/net/eudcb-mab.el
index 5953c86b951..eb7032ac4c8 100644
--- a/lisp/net/eudcb-mab.el
+++ b/lisp/net/eudcb-mab.el
@@ -1,6 +1,6 @@
;;; eudcb-mab.el --- Emacs Unified Directory Client - AddressBook backend
-;; Copyright (C) 2003-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@newartisans.com>
;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org>
diff --git a/lisp/net/eudcb-macos-contacts.el b/lisp/net/eudcb-macos-contacts.el
index 3c0d88fc23f..66a684dfc59 100644
--- a/lisp/net/eudcb-macos-contacts.el
+++ b/lisp/net/eudcb-macos-contacts.el
@@ -1,6 +1,6 @@
;;; eudcb-macos-contacts.el --- EUDC - macOS Contacts backend
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; Author: Alexander Adolf
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index ebc75e0e8a7..d131b2bf8c9 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -1,6 +1,6 @@
;;; eww.el --- Emacs Web Wowser -*- lexical-binding:t -*-
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: html
@@ -56,6 +56,13 @@
:group 'eww
:type 'string)
+(defcustom eww-use-browse-url "\\`mailto:"
+ "eww will use `browse-url' when following links that match this regexp.
+The action to be taken can be further customized via
+`browse-url-handlers'."
+ :version "28.1"
+ :type 'regexp)
+
(defun erc--download-directory ()
"Return the name of the download directory.
If ~/Downloads/ exists, that will be used, and if not, the
@@ -420,7 +427,7 @@ killed after rendering."
(narrow-to-region start end)
(goto-char start)
(let ((case-fold-search t))
- (while (re-search-forward "<[^0-9a-z!/]" nil t)
+ (while (re-search-forward "<[^0-9a-z!?/]" nil t)
(goto-char (match-beginning 0))
(delete-region (point) (1+ (point)))
(insert "&lt;"))))))
@@ -811,14 +818,19 @@ Currently this means either text/html or application/xhtml+xml."
(declare-function mailcap-view-mime "mailcap" (type))
(defun eww-display-pdf ()
- (let ((data (buffer-substring (point) (point-max))))
- (pop-to-buffer-same-window (get-buffer-create "*eww pdf*"))
- (let ((coding-system-for-write 'raw-text)
- (inhibit-read-only t))
- (erase-buffer)
- (insert data)
- (mailcap-view-mime "application/pdf")))
- (goto-char (point-min)))
+ (let ((buf (current-buffer))
+ (pos (point)))
+ (with-current-buffer (get-buffer-create "*eww pdf*")
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (set-buffer-multibyte nil)
+ (insert-buffer-substring buf pos)
+ (mailcap-view-mime "application/pdf"))
+ (if (zerop (buffer-size))
+ ;; Buffer contents passed to shell command via temporary file.
+ (kill-buffer)
+ (goto-char (point-min))
+ (pop-to-buffer-same-window (current-buffer))))))
(defun eww-setup-buffer ()
(when (or (plist-get eww-data :url)
@@ -1726,7 +1738,7 @@ If EXTERNAL is double prefix, browse in new buffer."
(cond
((not url)
(message "No link under point"))
- ((string-match-p "\\`mailto:" url)
+ ((string-match-p eww-use-browse-url url)
;; This respects the user options `browse-url-handlers'
;; and `browse-url-mailto-function'.
(browse-url url))
@@ -1820,7 +1832,7 @@ Use link at point if there is one, else the current page's URL."
(suffix ""))
(when (string-match "\\`\\(.*\\)\\([.][^.]+\\)" file)
(setq stem (match-string 1 file)
- suffix (match-string 2)))
+ suffix (match-string 2 file)))
(while (file-exists-p (expand-file-name file directory))
(setq file (format "%s(%d)%s" stem count suffix))
(setq count (1+ count)))
diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el
index 8ad721964dd..ff58cbb035e 100644
--- a/lisp/net/gnutls.el
+++ b/lisp/net/gnutls.el
@@ -1,6 +1,6 @@
;;; gnutls.el --- Support SSL/TLS connections through GnuTLS
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Ted Zlatanov <tzz@lifelogs.com>
;; Keywords: comm, tls, ssl, encryption
diff --git a/lisp/net/goto-addr.el b/lisp/net/goto-addr.el
index 43bea76a6bc..d1926302470 100644
--- a/lisp/net/goto-addr.el
+++ b/lisp/net/goto-addr.el
@@ -1,6 +1,6 @@
;;; goto-addr.el --- click to browse URL or to send to e-mail address
-;; Copyright (C) 1995, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 2000-2021 Free Software Foundation, Inc.
;; Author: Eric Ding <ericding@alum.mit.edu>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/net/hmac-def.el b/lisp/net/hmac-def.el
index 944cc6cef6c..5ea8839699d 100644
--- a/lisp/net/hmac-def.el
+++ b/lisp/net/hmac-def.el
@@ -1,6 +1,6 @@
;;; hmac-def.el --- A macro for defining HMAC functions. -*- lexical-binding: t -*-
-;; Copyright (C) 1999, 2001, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2001, 2007-2021 Free Software Foundation, Inc.
;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
;; Keywords: HMAC, RFC2104
diff --git a/lisp/net/hmac-md5.el b/lisp/net/hmac-md5.el
index 974ee0d3691..85a8c51de23 100644
--- a/lisp/net/hmac-md5.el
+++ b/lisp/net/hmac-md5.el
@@ -1,6 +1,6 @@
;;; hmac-md5.el --- Compute HMAC-MD5. -*- lexical-binding:t -*-
-;; Copyright (C) 1999, 2001, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2001, 2007-2021 Free Software Foundation, Inc.
;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
;; Keywords: HMAC, RFC2104, HMAC-MD5, MD5, KEYED-MD5, CRAM-MD5
diff --git a/lisp/net/imap.el b/lisp/net/imap.el
index 22b59084004..052ef292957 100644
--- a/lisp/net/imap.el
+++ b/lisp/net/imap.el
@@ -1,6 +1,6 @@
;;; imap.el --- imap library -*- lexical-binding:t -*-
-;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
;; Keywords: mail
@@ -190,7 +190,7 @@ until a successful connection is made."
:type '(repeat string))
(defcustom imap-process-connection-type nil
- "Value for `process-connection-type' to use for Kerberos4, GSSAPI, shell, and SSL.
+ "Value for `process-connection-type' to use for Kerberos4, GSSAPI, shell and SSL.
The `process-connection-type' variable controls the type of device
used to communicate with subprocesses. Values are nil to use a
pipe, or t or `pty' to use a pty. The value has no effect if the
@@ -1033,8 +1033,7 @@ necessary. If nil, the buffer name is generated."
(when (funcall (nth 1 (assq stream imap-stream-alist)) buffer)
;; Stream changed?
(if (not (eq imap-default-stream stream))
- (with-current-buffer (get-buffer-create
- (generate-new-buffer-name " *temp*"))
+ (with-current-buffer (generate-new-buffer " *temp*")
(mapc 'make-local-variable imap-local-variables)
(set-buffer-multibyte nil)
(buffer-disable-undo)
@@ -1726,8 +1725,7 @@ See `imap-enable-exchange-bug-workaround'."
(string-match "The specified message set is invalid"
(cadr data)))
(with-current-buffer (or buffer (current-buffer))
- (set (make-local-variable 'imap-enable-exchange-bug-workaround)
- t)
+ (setq-local imap-enable-exchange-bug-workaround t)
(imap-fetch (cdr uids) props receive nouidfetch))
(signal (car data) (cdr data))))))
diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el
index 5639d52f815..0476835ebd9 100644
--- a/lisp/net/ldap.el
+++ b/lisp/net/ldap.el
@@ -1,6 +1,6 @@
;;; ldap.el --- client interface to LDAP for Emacs
-;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
;; Maintainer: emacs-devel@gnu.org
@@ -33,7 +33,6 @@
;;; Code:
-(require 'custom)
(require 'password-cache)
(autoload 'auth-source-search "auth-source")
diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el
index 94cd9e21566..455673b5e9f 100644
--- a/lisp/net/mailcap.el
+++ b/lisp/net/mailcap.el
@@ -1,6 +1,6 @@
;;; mailcap.el --- MIME media types configuration -*- lexical-binding: t -*-
-;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: William M. Perry <wmperry@aventail.com>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -175,11 +175,11 @@ is consulted."
(type . "application/zip")
("copiousoutput"))
("pdf"
- (viewer . pdf-view-mode)
+ (viewer . doc-view-mode)
(type . "application/pdf")
(test . window-system))
("pdf"
- (viewer . doc-view-mode)
+ (viewer . pdf-view-mode)
(type . "application/pdf")
(test . window-system))
("pdf"
@@ -330,7 +330,10 @@ Content-Type header as argument to return a boolean value for the
validity. Otherwise, if it is a non-function Lisp symbol or list
whose car is a symbol, it is `eval'uated to yield the validity. If it
is a string or list of strings, it represents a shell command to run
-to return a true or false shell value for the validity.")
+to return a true or false shell value for the validity.
+
+The last matching entry in this structure takes presedence over
+preceding entries.")
(put 'mailcap-mime-data 'risky-local-variable t)
(defvar mailcap--computed-mime-data nil
@@ -383,8 +386,7 @@ Gnus might fail to display all of it.")
(when
(save-window-excursion
(delete-other-windows)
- (let ((buffer (get-buffer-create (generate-new-buffer-name
- "*Warning*"))))
+ (let ((buffer (generate-new-buffer "*Warning*")))
(unwind-protect
(with-current-buffer buffer
(insert (substitute-command-keys
@@ -1128,20 +1130,30 @@ For instance, \"foo.png\" will result in \"image/png\"."
res)))
(nreverse res)))))
+(defun mailcap--async-shell (command file)
+ "Asynchronously call MIME viewer shell COMMAND.
+Replace %s in COMMAND with FILE, as per `mailcap-mime-data'.
+Delete FILE once COMMAND exits."
+ (let ((buf (get-buffer-create " *mailcap shell*")))
+ (async-shell-command (format command file) buf)
+ (add-function :after (process-sentinel (get-buffer-process buf))
+ (lambda (proc _msg)
+ (when (memq (process-status proc) '(exit signal))
+ (delete-file file))))))
+
(defun mailcap-view-mime (type)
"View the data in the current buffer that has MIME type TYPE.
-`mailcap--computed-mime-data' determines the method to use."
+The variable `mailcap--computed-mime-data' determines the method
+to use. If the method is a shell command string, erase the
+current buffer after passing its contents to the shell command."
(let ((method (mailcap-mime-info type)))
(if (stringp method)
- (let ((file (make-temp-file "emacs-mailcap" nil
- (cadr (split-string type "/")))))
- (unwind-protect
- (let ((coding-system-for-write 'binary))
- (write-region (point-min) (point-max) file nil 'silent)
- (delete-region (point-min) (point-max))
- (shell-command (format method file)))
- (when (file-exists-p file)
- (delete-file file))))
+ (let* ((ext (concat "." (cadr (split-string type "/"))))
+ (file (make-temp-file "emacs-mailcap" nil ext))
+ (coding-system-for-write 'binary))
+ (write-region nil nil file nil 'silent)
+ (delete-region (point-min) (point-max))
+ (mailcap--async-shell method file))
(funcall method))))
(provide 'mailcap)
diff --git a/lisp/net/mairix.el b/lisp/net/mairix.el
index 8218249ec18..08edb44275c 100644
--- a/lisp/net/mairix.el
+++ b/lisp/net/mairix.el
@@ -1,6 +1,6 @@
;;; mairix.el --- Mairix interface for Emacs
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: David Engster <dengste@eml.cc>
;; Keywords: mail searching
@@ -631,14 +631,13 @@ See %s for details" mairix-output-buffer)))
(when (member 'flags mairix-widget-other)
(setq flag
(mapconcat
- (function
- (lambda (flag)
- (setq temp
- (widget-value (cadr (assoc (car flag) mairix-widgets))))
- (if (string= "yes" temp)
- (cadr flag)
- (if (string= "no" temp)
- (concat "-" (cadr flag))))))
+ (lambda (flag)
+ (setq temp
+ (widget-value (cadr (assoc (car flag) mairix-widgets))))
+ (if (string= "yes" temp)
+ (cadr flag)
+ (if (string= "no" temp)
+ (concat "-" (cadr flag)))))
'(("seen" "s") ("replied" "r") ("flagged" "f")) ""))
(when (not (zerop (length flag)))
(push (concat "F:" flag) query)))
@@ -694,34 +693,33 @@ Fill in VALUES if based on an article."
VALUES may contain values for editable fields from current article."
(let ((ret))
(mapc
- (function
- (lambda (field)
- (setq field (car (cddr field)))
- (setq
- ret
- (nconc
- (list
- (list
- (concat "c" field)
- (widget-create 'checkbox
- :tag field
- :notify (lambda (widget &rest ignore)
- (mairix-widget-toggle-activate widget))
- nil)))
- (list
- (list
- (concat "e" field)
- (widget-create 'editable-field
- :size 60
- :format (concat " " field ":"
- (make-string
- (- 11 (length field)) ?\ )
- "%v")
- :value (or (cadr (assoc field values)) ""))))
- ret))
- (widget-insert "\n")
- ;; Deactivate editable field
- (widget-apply (cadr (nth 1 ret)) :deactivate)))
+ (lambda (field)
+ (setq field (car (cddr field)))
+ (setq
+ ret
+ (nconc
+ (list
+ (list
+ (concat "c" field)
+ (widget-create 'checkbox
+ :tag field
+ :notify (lambda (widget &rest ignore)
+ (mairix-widget-toggle-activate widget))
+ nil)))
+ (list
+ (list
+ (concat "e" field)
+ (widget-create 'editable-field
+ :size 60
+ :format (concat " " field ":"
+ (make-string
+ (- 11 (length field)) ?\ )
+ "%v")
+ :value (or (cadr (assoc field values)) ""))))
+ ret))
+ (widget-insert "\n")
+ ;; Deactivate editable field
+ (widget-apply (cadr (nth 1 ret)) :deactivate))
mairix-widget-fields-list)
ret))
@@ -936,13 +934,12 @@ Use cursor keys or C-n,C-p to select next/previous search.\n\n")
(save-excursion
(save-restriction
(mapcar
- (function
- (lambda (field)
- (list (car (cddr field))
- (if (car field)
- (mairix-replace-invalid-chars
- (funcall get-mail-header (car field)))
- nil))))
+ (lambda (field)
+ (list (car (cddr field))
+ (if (car field)
+ (mairix-replace-invalid-chars
+ (funcall get-mail-header (car field)))
+ nil)))
mairix-widget-fields-list)))
(error "No function for obtaining mail header specified"))))
diff --git a/lisp/net/net-utils.el b/lisp/net/net-utils.el
index 8c7d33a67d4..d5aad3a3f77 100644
--- a/lisp/net/net-utils.el
+++ b/lisp/net/net-utils.el
@@ -1,6 +1,6 @@
;;; net-utils.el --- network functions
-;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: Peter Breton <pbreton@cs.umb.edu>
;; Created: Sun Mar 16 1997
@@ -307,8 +307,8 @@ This variable is only used if the variable
(define-derived-mode net-utils-mode special-mode "NetworkUtil"
"Major mode for interacting with an external network utility."
- (set (make-local-variable 'font-lock-defaults)
- '((net-utils-font-lock-keywords)))
+ (setq-local font-lock-defaults
+ '((net-utils-font-lock-keywords)))
(setq-local revert-buffer-function #'net-utils--revert-function))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -624,9 +624,8 @@ This command uses `nslookup-program' to look up DNS records."
;; Using a derived mode gives us keymaps, hooks, etc.
(define-derived-mode nslookup-mode comint-mode "Nslookup"
"Major mode for interacting with the nslookup program."
- (set
- (make-local-variable 'font-lock-defaults)
- '((nslookup-font-lock-keywords)))
+ (setq-local font-lock-defaults
+ '((nslookup-font-lock-keywords)))
(setq comint-prompt-regexp nslookup-prompt-regexp)
(setq comint-input-autoexpand t))
@@ -971,10 +970,8 @@ The port is deduced from `network-connection-service-alist'."
"Major mode for interacting with the network-connection program.")
(defun network-connection-mode-setup (host service)
- (make-local-variable 'network-connection-host)
- (setq network-connection-host host)
- (make-local-variable 'network-connection-service)
- (setq network-connection-service service))
+ (setq-local network-connection-host host)
+ (setq-local network-connection-service service))
;;;###autoload
(defun network-connection-to-service (host service)
@@ -985,9 +982,8 @@ This command uses `network-connection-service-alist', which see."
(read-from-minibuffer "Host: " (net-utils-machine-at-point))
(completing-read "Service: "
(mapcar
- (function
- (lambda (elt)
- (list (symbol-name (car elt)))))
+ (lambda (elt)
+ (list (symbol-name (car elt))))
network-connection-service-alist))))
(network-connection
host
diff --git a/lisp/net/netrc.el b/lisp/net/netrc.el
index 01db97c29d4..9473c821a1a 100644
--- a/lisp/net/netrc.el
+++ b/lisp/net/netrc.el
@@ -1,6 +1,6 @@
;;; netrc.el --- .netrc parsing functionality -*- lexical-binding: t -*-
-;; Copyright (C) 1996-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el
index e86426d4664..b45cefcb442 100644
--- a/lisp/net/network-stream.el
+++ b/lisp/net/network-stream.el
@@ -1,6 +1,6 @@
;;; network-stream.el --- open network processes, possibly with encryption -*- lexical-binding: t -*-
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: network
diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el
index f45abf780f7..3b120be61f5 100644
--- a/lisp/net/newst-backend.el
+++ b/lisp/net/newst-backend.el
@@ -1,6 +1,6 @@
;;; newst-backend.el --- Retrieval backend for newsticker -*- lexical-binding:t -*-
-;; Copyright (C) 2003-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
;; Author: Ulf Jasper <ulf.jasper@web.de>
;; Filename: newst-backend.el
diff --git a/lisp/net/newst-plainview.el b/lisp/net/newst-plainview.el
index d4c53b13d87..44d2fd666ad 100644
--- a/lisp/net/newst-plainview.el
+++ b/lisp/net/newst-plainview.el
@@ -1,6 +1,6 @@
;;; newst-plainview.el --- Single buffer frontend for newsticker.
-;; Copyright (C) 2003-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
;; Author: Ulf Jasper <ulf.jasper@web.de>
;; Filename: newst-plainview.el
@@ -445,17 +445,17 @@ images."
"NewsTicker"
"Viewing news feeds in Emacs."
(if (boundp 'tool-bar-map)
- (set (make-local-variable 'tool-bar-map)
- newsticker--plainview-tool-bar-map))
- (set (make-local-variable 'imenu-sort-function) nil)
- (set (make-local-variable 'scroll-conservatively) 999)
+ (setq-local tool-bar-map
+ newsticker--plainview-tool-bar-map))
+ (setq-local imenu-sort-function nil)
+ (setq-local scroll-conservatively 999)
(setq imenu-create-index-function 'newsticker--imenu-create-index)
(setq imenu-default-goto-function 'newsticker--imenu-goto)
(setq buffer-read-only t)
(auto-fill-mode -1) ;; turn auto-fill off!
(font-lock-mode -1) ;; turn off font-lock!!
- (set (make-local-variable 'font-lock-defaults) nil)
- (set (make-local-variable 'line-move-ignore-invisible) t)
+ (setq-local font-lock-defaults nil)
+ (setq-local line-move-ignore-invisible t)
(setq mode-line-format
(list "-"
'mode-line-mule-info
@@ -533,7 +533,7 @@ Unless FORCE is t this is done only if necessary, i.e. when the
(set-buffer-file-coding-system 'utf-8)
(if newsticker-use-full-width
- (set (make-local-variable 'fill-column) (1- (window-width))))
+ (setq-local fill-column (1- (window-width))))
(newsticker--buffer-insert-all-items)
;; FIXME: needed for methods buffer in ecb
diff --git a/lisp/net/newst-reader.el b/lisp/net/newst-reader.el
index 7c3a919535d..b188bd4589e 100644
--- a/lisp/net/newst-reader.el
+++ b/lisp/net/newst-reader.el
@@ -1,6 +1,6 @@
;;; newst-reader.el --- Generic RSS reader functions.
-;; Copyright (C) 2003-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
;; Author: Ulf Jasper <ulf.jasper@web.de>
;; Filename: newst-reader.el
diff --git a/lisp/net/newst-ticker.el b/lisp/net/newst-ticker.el
index 8e60c1e7828..275c91a36ea 100644
--- a/lisp/net/newst-ticker.el
+++ b/lisp/net/newst-ticker.el
@@ -1,6 +1,6 @@
;; newst-ticker.el --- mode line ticker for newsticker.
-;; Copyright (C) 2003-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
;; Author: Ulf Jasper <ulf.jasper@web.de>
;; Filename: newst-ticker.el
diff --git a/lisp/net/newst-treeview.el b/lisp/net/newst-treeview.el
index ff8a447c7c1..cf55f66e780 100644
--- a/lisp/net/newst-treeview.el
+++ b/lisp/net/newst-treeview.el
@@ -1,6 +1,6 @@
;;; newst-treeview.el --- Treeview frontend for newsticker. -*- lexical-binding:t -*-
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Ulf Jasper <ulf.jasper@web.de>
;; Filename: newst-treeview.el
@@ -719,9 +719,8 @@ for the button."
(window-width (newsticker--treeview-item-window))
fill-column))))
(if newsticker-use-full-width
- (set (make-local-variable 'fill-column) wwidth))
- (set (make-local-variable 'fill-column) (min fill-column
- wwidth)))
+ (setq-local fill-column wwidth))
+ (setq-local fill-column (min fill-column wwidth)))
(let ((desc (newsticker--desc item)))
(insert "\n" (or desc "[No Description]")))
(set-marker marker1 (1+ (point-min)))
@@ -2024,8 +2023,8 @@ Return t if groups have changed, nil otherwise."
"Major mode for Newsticker Treeview.
\\{newsticker-treeview-mode-map}"
(if (boundp 'tool-bar-map)
- (set (make-local-variable 'tool-bar-map)
- newsticker-treeview-tool-bar-map))
+ (setq-local tool-bar-map
+ newsticker-treeview-tool-bar-map))
(setq buffer-read-only t
truncate-lines t))
diff --git a/lisp/net/newsticker.el b/lisp/net/newsticker.el
index 535122a31fb..34e94acd12c 100644
--- a/lisp/net/newsticker.el
+++ b/lisp/net/newsticker.el
@@ -1,6 +1,6 @@
;;; newsticker.el --- A Newsticker for Emacs. -*- lexical-binding: t -*-
-;; Copyright (C) 2003-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
;; Author: Ulf Jasper <ulf.jasper@web.de>
;; Filename: newsticker.el
@@ -78,14 +78,6 @@
;; Installation
;; ------------
-;; If you are using Newsticker as part of GNU Emacs there is no need to
-;; perform any installation steps in order to use Newsticker. Otherwise
-;; place Newsticker in a directory where Emacs can find it. Add the
-;; following line to your init file:
-;; (add-to-list 'load-path "/path/to/newsticker/")
-;; (autoload 'newsticker-start "newsticker" "Emacs Newsticker" t)
-;; (autoload 'newsticker-show-news "newsticker" "Emacs Newsticker" t)
-
;; If you are using `imenu', which allows for navigating with the help of a
;; menu, you should add the following to your Emacs startup file
;; (`~/.emacs').
diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el
index 2b300401650..0ce65a35ead 100644
--- a/lisp/net/nsm.el
+++ b/lisp/net/nsm.el
@@ -1,6 +1,6 @@
;;; nsm.el --- Network Security Manager -*- lexical-binding:t -*-
-;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: encryption, security, network
@@ -239,7 +239,7 @@ otherwise."
(mapc
(lambda (info)
(let ((local-ip (nth 1 info))
- (mask (nth 2 info)))
+ (mask (nth 3 info)))
(when
(nsm-network-same-subnet (substring local-ip 0 -1)
(substring mask 0 -1)
diff --git a/lisp/net/ntlm.el b/lisp/net/ntlm.el
index 6d1cf2da71f..0450c80c2ec 100644
--- a/lisp/net/ntlm.el
+++ b/lisp/net/ntlm.el
@@ -1,6 +1,6 @@
;;; ntlm.el --- NTLM (NT LanManager) authentication support -*- lexical-binding:t -*-
-;; Copyright (C) 2001, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2007-2021 Free Software Foundation, Inc.
;; Author: Taro Kawagishi <tarok@transpulse.org>
;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org>
diff --git a/lisp/net/pop3.el b/lisp/net/pop3.el
index 6f5898437ca..dcac36f2a4a 100644
--- a/lisp/net/pop3.el
+++ b/lisp/net/pop3.el
@@ -1,6 +1,6 @@
;;; pop3.el --- Post Office Protocol (RFC 1460) interface -*- lexical-binding:t -*-
-;; Copyright (C) 1996-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
;; Author: Richard L. Pieri <ratinox@peorth.gweep.net>
;; Maintainer: emacs-devel@gnu.org
@@ -463,7 +463,7 @@ Return non-nil if it is necessary to update the local UIDL file."
(when (cdr elt)
(insert "(\"" (pop elt) "\"\n ")
(while elt
- (insert (format "\"%s\" %s\n " (pop elt) (pop elt))))
+ (insert (format "%S %s\n " (pop elt) (pop elt))))
(delete-char -4)
(insert ")\n ")))
(delete-char -3)
diff --git a/lisp/net/puny.el b/lisp/net/puny.el
index 5c58fe02cbf..6b3663a5fb2 100644
--- a/lisp/net/puny.el
+++ b/lisp/net/puny.el
@@ -1,6 +1,6 @@
;;; puny.el --- translate non-ASCII domain names to ASCII -*- lexical-binding:t -*-
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: mail, net
diff --git a/lisp/net/quickurl.el b/lisp/net/quickurl.el
index 8609ea82945..ab1f43f552b 100644
--- a/lisp/net/quickurl.el
+++ b/lisp/net/quickurl.el
@@ -1,6 +1,6 @@
;;; quickurl.el --- insert a URL based on text at point in buffer
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Dave Pearson <davep@davep.org>
;; Created: 1999-05-28
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index 63e6eedb200..22348a1725c 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -1,6 +1,6 @@
;;; rcirc.el --- default, simple IRC client -*- lexical-binding: t; -*-
-;; Copyright (C) 2005-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2005-2021 Free Software Foundation, Inc.
;; Author: Ryan Yeske <rcyeske@gmail.com>
;; Maintainers: Ryan Yeske <rcyeske@gmail.com>,
@@ -416,6 +416,9 @@ will be killed."
(defvar rcirc-server-buffer nil
"The server buffer associated with this channel buffer.")
+(defvar rcirc-server-parameters nil
+ "List of parameters received from the server.")
+
(defvar rcirc-target nil
"The channel or user associated with this buffer.")
@@ -586,6 +589,7 @@ If ARG is non-nil, instead prompt for connection parameters."
(setq-local rcirc-user-disconnect nil)
(setq-local rcirc-user-authenticated nil)
(setq-local rcirc-connecting t)
+ (setq-local rcirc-server-parameters nil)
(add-hook 'auto-save-hook 'rcirc-log-write)
@@ -1503,7 +1507,7 @@ is found by looking up RESPONSE in `rcirc-response-formats'."
(make-variable-buffer-local 'rcirc-last-sender)
(defcustom rcirc-omit-threshold 100
- "Number of lines since last activity from a nick before `rcirc-omit-responses' are omitted."
+ "Lines since last activity from a nick before `rcirc-omit-responses' are omitted."
:type 'integer)
(defcustom rcirc-log-process-buffers nil
@@ -2873,9 +2877,28 @@ Not in rfc1459.txt"
(defun rcirc-handler-433 (process sender args text)
"ERR_NICKNAMEINUSE"
(rcirc-handler-generic process "433" sender args text)
- (let* ((new-nick (concat (cadr args) "`")))
- (with-rcirc-process-buffer process
- (rcirc-cmd-nick new-nick nil process))))
+ (with-rcirc-process-buffer process
+ (let* ((length (string-to-number
+ (or (rcirc-server-parameter-value 'nicklen)
+ "16"))))
+ (rcirc-cmd-nick (rcirc--make-new-nick (cadr args) length) nil process))))
+
+(defun rcirc--make-new-nick (nick length)
+ ;; If we already have some ` chars at the end, then shorten the
+ ;; non-` bit of the name.
+ (when (= (length nick) length)
+ (setq nick (replace-regexp-in-string "[^`]\\(`+\\)\\'" "\\1" nick)))
+ (concat
+ (if (>= (length nick) length)
+ (substring nick 0 (1- length))
+ nick)
+ "`"))
+
+(defun rcirc-handler-005 (process sender args text)
+ "ERR_NICKNAMEINUSE"
+ (rcirc-handler-generic process "005" sender args text)
+ (with-rcirc-process-buffer process
+ (setq rcirc-server-parameters (append rcirc-server-parameters args))))
(defun rcirc-authenticate ()
"Send authentication to process associated with current buffer.
@@ -3072,6 +3095,13 @@ Passwords are stored in `rcirc-authinfo' (which see)."
(>= (point) rcirc-prompt-end-marker))
+(defun rcirc-server-parameter-value (parameter)
+ (cl-loop for elem in rcirc-server-parameters
+ for setting = (split-string elem "=")
+ when (and (= (length setting) 2)
+ (string-equal (downcase (car setting)) parameter))
+ return (cadr setting)))
+
(provide 'rcirc)
;;; rcirc.el ends here
diff --git a/lisp/net/rfc2104.el b/lisp/net/rfc2104.el
index 50d54761b12..c03ac5a87bc 100644
--- a/lisp/net/rfc2104.el
+++ b/lisp/net/rfc2104.el
@@ -1,6 +1,6 @@
;;; rfc2104.el --- RFC2104 Hashed Message Authentication Codes -*- lexical-binding:t -*-
-;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: Simon Josefsson <jas@pdc.kth.se>
;; Keywords: mail
@@ -26,11 +26,9 @@
;;
;; Example:
;;
-;; (require 'md5)
;; (rfc2104-hash 'md5 64 16 "Jefe" "what do ya want for nothing?")
;; "750c783e6ab0b503eaa86e310a5db738"
;;
-;; (require 'sha1)
;; (rfc2104-hash 'sha1 64 20 "Jefe" "what do ya want for nothing?")
;; "effcdf6ae5eb2fa2d27416d5f184df9c259a7c79"
;;
diff --git a/lisp/net/rlogin.el b/lisp/net/rlogin.el
index 766d6449a31..3136e53b80b 100644
--- a/lisp/net/rlogin.el
+++ b/lisp/net/rlogin.el
@@ -1,6 +1,6 @@
;;; rlogin.el --- remote login interface -*- lexical-binding:t -*-
-;; Copyright (C) 1992-1995, 1997-1998, 2001-2020 Free Software
+;; Copyright (C) 1992-1995, 1997-1998, 2001-2021 Free Software
;; Foundation, Inc.
;; Author: Noah Friedman <friedman@splode.com>
@@ -208,10 +208,8 @@ variable."
(unless (comint-check-proc buffer-name)
(comint-exec buffer buffer-name rlogin-program nil args)
(rlogin-mode)
- (make-local-variable 'rlogin-host)
- (setq rlogin-host host)
- (make-local-variable 'rlogin-remote-user)
- (setq rlogin-remote-user user)
+ (setq-local rlogin-host host)
+ (setq-local rlogin-remote-user user)
(ignore-errors
(cond ((eq rlogin-directory-tracking-mode t)
;; Do this here, rather than calling the tracking mode
diff --git a/lisp/net/sasl-cram.el b/lisp/net/sasl-cram.el
index 3810572a942..bc2612d9452 100644
--- a/lisp/net/sasl-cram.el
+++ b/lisp/net/sasl-cram.el
@@ -1,6 +1,6 @@
;;; sasl-cram.el --- CRAM-MD5 module for the SASL client framework
-;; Copyright (C) 2000, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2007-2021 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@gnu.org>
;; Kenichi OKADA <okada@opaopa.org>
diff --git a/lisp/net/sasl-digest.el b/lisp/net/sasl-digest.el
index ea0b82c7f21..efc8f82890c 100644
--- a/lisp/net/sasl-digest.el
+++ b/lisp/net/sasl-digest.el
@@ -1,6 +1,6 @@
;;; sasl-digest.el --- DIGEST-MD5 module for the SASL client framework
-;; Copyright (C) 2000, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2007-2021 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Kenichi OKADA <okada@opaopa.org>
diff --git a/lisp/net/sasl-ntlm.el b/lisp/net/sasl-ntlm.el
index 6882c23d789..66582265615 100644
--- a/lisp/net/sasl-ntlm.el
+++ b/lisp/net/sasl-ntlm.el
@@ -1,6 +1,6 @@
;;; sasl-ntlm.el --- NTLM (NT Lan Manager) module for the SASL client framework
-;; Copyright (C) 2000, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2007-2021 Free Software Foundation, Inc.
;; Author: Taro Kawagishi <tarok@transpulse.org>
;; Keywords: SASL, NTLM
diff --git a/lisp/net/sasl-scram-rfc.el b/lisp/net/sasl-scram-rfc.el
index 8de52de2c4d..91d76663ef2 100644
--- a/lisp/net/sasl-scram-rfc.el
+++ b/lisp/net/sasl-scram-rfc.el
@@ -1,6 +1,6 @@
;;; sasl-scram-rfc.el --- SCRAM-SHA-1 module for the SASL client framework -*- lexical-binding: t; -*-
-;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2021 Free Software Foundation, Inc.
;; Author: Magnus Henoch <magnus.henoch@gmail.com>
;; Package: sasl
diff --git a/lisp/net/sasl-scram-sha256.el b/lisp/net/sasl-scram-sha256.el
index e50a032c233..c1df988a369 100644
--- a/lisp/net/sasl-scram-sha256.el
+++ b/lisp/net/sasl-scram-sha256.el
@@ -1,6 +1,6 @@
;;; sasl-scram-sha256.el --- SCRAM-SHA-256 module for the SASL client framework -*- lexical-binding: t; -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
;; Package: sasl
diff --git a/lisp/net/sasl.el b/lisp/net/sasl.el
index ab118e1f982..7f0431afb60 100644
--- a/lisp/net/sasl.el
+++ b/lisp/net/sasl.el
@@ -1,6 +1,6 @@
;;; sasl.el --- SASL client framework
-;; Copyright (C) 2000, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2007-2021 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@gnu.org>
;; Keywords: SASL
diff --git a/lisp/net/secrets.el b/lisp/net/secrets.el
index dc1b468a118..ad271679618 100644
--- a/lisp/net/secrets.el
+++ b/lisp/net/secrets.el
@@ -1,6 +1,6 @@
;;; secrets.el --- Client interface to gnome-keyring and kwallet. -*- lexical-binding: t -*-
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm password passphrase
@@ -792,11 +792,11 @@ In this mode, widgets represent the search results.
\\{secrets-mode-map}"
(setq buffer-undo-list t)
- (set (make-local-variable 'revert-buffer-function)
- #'secrets-show-collections)
+ (setq-local revert-buffer-function
+ #'secrets-show-collections)
;; When we toggle, we must set temporary widgets.
- (set (make-local-variable 'tree-widget-after-toggle-functions)
- '(secrets-tree-widget-after-toggle-function)))
+ (add-hook 'tree-widget-after-toggle-functions
+ #'secrets-tree-widget-after-toggle-function nil t))
;; It doesn't make sense to call it interactively.
(put 'secrets-mode 'disabled t)
diff --git a/lisp/net/shr-color.el b/lisp/net/shr-color.el
index ce55ca68411..ac1f701fd37 100644
--- a/lisp/net/shr-color.el
+++ b/lisp/net/shr-color.el
@@ -1,6 +1,6 @@
;;; shr-color.el --- Simple HTML Renderer color management -*- lexical-binding:t -*-
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Julien Danjou <julien@danjou.info>
;; Keywords: html
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 2e5dd5ffa50..9c3740fccc9 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -1,6 +1,6 @@
;;; shr.el --- Simple HTML Renderer -*- lexical-binding: t -*-
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: html
@@ -1516,8 +1516,9 @@ ones, in case fg and bg are nil."
plist)))
(defun shr-tag-base (dom)
- (when-let* ((base (dom-attr dom 'href)))
- (setq shr-base (shr-parse-base base)))
+ (let ((base (dom-attr dom 'href)))
+ (when (> (length base) 0)
+ (setq shr-base (shr-parse-base base))))
(shr-generic dom))
(defun shr-tag-a (dom)
diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el
index f9224b2f096..c4d6ec4b6cc 100644
--- a/lisp/net/sieve-manage.el
+++ b/lisp/net/sieve-manage.el
@@ -1,6 +1,6 @@
;;; sieve-manage.el --- Implementation of the managesieve protocol in elisp -*- lexical-binding:t -*-
-;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
;; Albert Krewinkel <tarleb@moltkeplatz.de>
diff --git a/lisp/net/sieve-mode.el b/lisp/net/sieve-mode.el
index 7475a7b59d5..fbc4e75fae5 100644
--- a/lisp/net/sieve-mode.el
+++ b/lisp/net/sieve-mode.el
@@ -1,6 +1,6 @@
;;; sieve-mode.el --- Sieve code editing commands for Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
@@ -26,11 +26,6 @@
;; sieve-style #-comments and a lightly hacked syntax table. It was
;; strongly influenced by awk-mode.el.
;;
-;; Put something similar to the following in your .emacs to use this file:
-;;
-;; (load "~/lisp/sieve")
-;; (setq auto-mode-alist (cons '("\\.siv\\'" . sieve-mode) auto-mode-alist))
-;;
;; References:
;;
;; RFC 3028,
@@ -48,8 +43,6 @@
(autoload 'sieve-manage "sieve")
(autoload 'sieve-upload "sieve")
-(eval-when-compile
- (require 'font-lock))
(defgroup sieve nil
"Sieve."
@@ -192,16 +185,15 @@ 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'."
- (set (make-local-variable 'paragraph-start) (concat "$\\|" page-delimiter))
- (set (make-local-variable 'paragraph-separate) paragraph-start)
- (set (make-local-variable 'comment-start) "#")
- (set (make-local-variable 'comment-end) "")
- ;;(set (make-local-variable 'comment-start-skip) "\\(^\\|\\s-\\);?#+ *")
- (set (make-local-variable 'comment-start-skip) "#+ *")
- (set (make-local-variable 'syntax-propertize-function)
- #'sieve-syntax-propertize)
- (set (make-local-variable 'font-lock-defaults)
- '(sieve-font-lock-keywords nil nil ((?_ . "w"))))
+ (setq-local paragraph-start (concat "$\\|" page-delimiter))
+ (setq-local paragraph-separate paragraph-start)
+ (setq-local comment-start "#")
+ (setq-local comment-end "")
+ ;; (setq-local comment-start-skip "\\(^\\|\\s-\\);?#+ *")
+ (setq-local comment-start-skip "#+ *")
+ (setq-local syntax-propertize-function #'sieve-syntax-propertize)
+ (setq-local font-lock-defaults
+ '(sieve-font-lock-keywords nil nil ((?_ . "w"))))
(easy-menu-add-item nil nil sieve-mode-menu))
(provide 'sieve-mode)
diff --git a/lisp/net/sieve.el b/lisp/net/sieve.el
index 08367c698f2..ca100267f67 100644
--- a/lisp/net/sieve.el
+++ b/lisp/net/sieve.el
@@ -1,6 +1,6 @@
;;; sieve.el --- Utilities to manage sieve scripts
-;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
@@ -143,8 +143,7 @@ require \"fileinto\";
(define-derived-mode sieve-manage-mode special-mode "Sieve-manage"
"Mode used for sieve script management."
(buffer-disable-undo (current-buffer))
- (setq truncate-lines t)
- (easy-menu-add sieve-manage-mode-menu sieve-manage-mode-map))
+ (setq truncate-lines t))
;; Commands used in sieve-manage mode:
@@ -273,8 +272,7 @@ Used to bracket operations which move point in the sieve-buffer."
(let* ((port (or port sieve-manage-default-port))
(header (format "Server : %s:%s\n\n" server port)))
(insert header))
- (set (make-local-variable 'sieve-buffer-header-end)
- (point-max)))
+ (setq-local sieve-buffer-header-end (point-max)))
(defun sieve-script-at-point (&optional pos)
"Return name of sieve script at point POS, or nil."
@@ -305,8 +303,8 @@ Used to bracket operations which move point in the sieve-buffer."
"Open SERVER (on PORT) and authenticate."
(with-current-buffer
(or ;; open server
- (set (make-local-variable 'sieve-manage-buffer)
- (sieve-manage-open server port))
+ (setq-local sieve-manage-buffer
+ (sieve-manage-open server port))
(error "Error opening server %s" server))
(sieve-manage-authenticate)))
@@ -362,8 +360,8 @@ Used to bracket operations which move point in the sieve-buffer."
(if (not (sieve-manage-ok-p err))
(message "Sieve upload failed: %s" (nth 2 err))
(message "Sieve upload done. Use %s to manage scripts."
- (substitute-command-keys "\\[sieve-manage]"))
- (set-buffer-modified-p nil))))))
+ (substitute-command-keys "\\[sieve-manage]"))))
+ (set-buffer-modified-p nil))))
;;;###autoload
(defun sieve-upload-and-bury (&optional name)
diff --git a/lisp/net/snmp-mode.el b/lisp/net/snmp-mode.el
index 76d9ced58a6..983e6d92ee0 100644
--- a/lisp/net/snmp-mode.el
+++ b/lisp/net/snmp-mode.el
@@ -1,6 +1,6 @@
;;; snmp-mode.el --- SNMP & SNMPv2 MIB major mode
-;; Copyright (C) 1995, 1998, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1998, 2001-2021 Free Software Foundation, Inc.
;; Author: Paul D. Smith <psmith@BayNetworks.com>
;; Keywords: data
@@ -304,46 +304,34 @@ This is used during Tempo template completion."
(setq local-abbrev-table abbrev)
;; Set up paragraphs (?)
- (make-local-variable 'paragraph-start)
- (setq paragraph-start (concat "$\\|" page-delimiter))
- (make-local-variable 'paragraph-separate)
- (setq paragraph-separate paragraph-start)
- (make-local-variable 'paragraph-ignore-fill-prefix)
- (setq paragraph-ignore-fill-prefix t)
+ (setq-local paragraph-start (concat "$\\|" page-delimiter))
+ (setq-local paragraph-separate paragraph-start)
+ (setq-local paragraph-ignore-fill-prefix t)
;; Set up comments
- (make-local-variable 'comment-start)
- (setq comment-start "-- ")
- (make-local-variable 'comment-start-skip)
- (setq comment-start-skip "--+[ \t]*")
- (make-local-variable 'comment-column)
- (setq comment-column 40)
- (make-local-variable 'parse-sexp-ignore-comments)
- (setq parse-sexp-ignore-comments t)
+ (setq-local comment-start "-- ")
+ (setq-local comment-start-skip "--+[ \t]*")
+ (setq-local comment-column 40)
+ (setq-local parse-sexp-ignore-comments t)
;; Set up indentation
(if snmp-special-indent
- (set (make-local-variable 'indent-line-function) 'snmp-indent-line))
- (set (make-local-variable 'tab-always-indent) snmp-tab-always-indent)
+ (setq-local indent-line-function 'snmp-indent-line))
+ (setq-local tab-always-indent snmp-tab-always-indent)
;; Font Lock
- (make-local-variable 'font-lock-defaults)
- (setq font-lock-defaults (cons font-keywords '(nil nil ((?- . "w 1234")))))
+ (setq-local font-lock-defaults (cons font-keywords '(nil nil ((?- . "w 1234")))))
;; Imenu
- (make-local-variable 'imenu-create-index-function)
- (setq imenu-create-index-function imenu-index)
+ (setq-local imenu-create-index-function imenu-index)
;; Tempo
(tempo-use-tag-list tempo-tags)
- (make-local-variable 'tempo-match-finder)
- (setq tempo-match-finder "\\b\\(.+\\)\\=")
- (make-local-variable 'tempo-interactive)
- (setq tempo-interactive t)
+ (setq-local tempo-match-finder "\\b\\(.+\\)\\=")
+ (setq-local tempo-interactive t)
;; Miscellaneous customization
- (make-local-variable 'require-final-newline)
- (setq require-final-newline mode-require-final-newline))
+ (setq-local require-final-newline mode-require-final-newline))
;; SNMPv1 MIB Editing Mode.
@@ -370,14 +358,11 @@ Turning on snmp-mode runs the hooks in `snmp-common-mode-hook', then
'snmp-tempo-tags)
;; Completion lists
- (make-local-variable 'snmp-mode-syntax-list)
- (setq snmp-mode-syntax-list (append snmp-rfc1155-types
- snmp-rfc1213-types
- snmp-mode-syntax-list))
- (make-local-variable 'snmp-mode-access-list)
- (setq snmp-mode-access-list snmp-rfc1155-access)
- (make-local-variable 'snmp-mode-status-list)
- (setq snmp-mode-status-list snmp-rfc1212-status)
+ (setq-local snmp-mode-syntax-list (append snmp-rfc1155-types
+ snmp-rfc1213-types
+ snmp-mode-syntax-list))
+ (setq-local snmp-mode-access-list snmp-rfc1155-access)
+ (setq-local snmp-mode-status-list snmp-rfc1212-status)
;; Run hooks
(run-mode-hooks 'snmp-common-mode-hook 'snmp-mode-hook))
@@ -405,14 +390,11 @@ then `snmpv2-mode-hook'."
'snmpv2-tempo-tags)
;; Completion lists
- (make-local-variable 'snmp-mode-syntax-list)
- (setq snmp-mode-syntax-list (append snmp-rfc1902-types
- snmp-rfc1903-types
- snmp-mode-syntax-list))
- (make-local-variable 'snmp-mode-access-list)
- (setq snmp-mode-access-list snmp-rfc1902-access)
- (make-local-variable 'snmp-mode-status-list)
- (setq snmp-mode-status-list snmp-rfc1902-status)
+ (setq-local snmp-mode-syntax-list (append snmp-rfc1902-types
+ snmp-rfc1903-types
+ snmp-mode-syntax-list))
+ (setq-local snmp-mode-access-list snmp-rfc1902-access)
+ (setq-local snmp-mode-status-list snmp-rfc1902-status)
;; Run hooks
(run-mode-hooks 'snmp-common-mode-hook 'snmpv2-mode-hook))
diff --git a/lisp/net/soap-client.el b/lisp/net/soap-client.el
index 241ce9efcb3..3cc5569b55c 100644
--- a/lisp/net/soap-client.el
+++ b/lisp/net/soap-client.el
@@ -1,6 +1,6 @@
;;; soap-client.el --- Access SOAP web services -*- lexical-binding: t -*-
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Alexandru Harsanyi <AlexHarsanyi@gmail.com>
;; Author: Thomas Fitzsimmons <fitzsim@fitzsim.org>
diff --git a/lisp/net/soap-inspect.el b/lisp/net/soap-inspect.el
index 54d196bf525..604e35c07cf 100644
--- a/lisp/net/soap-inspect.el
+++ b/lisp/net/soap-inspect.el
@@ -1,6 +1,6 @@
;;; soap-inspect.el --- Interactive WSDL inspector -*- lexical-binding: t -*-
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Alexandru Harsanyi <AlexHarsanyi@gmail.com>
;; Created: October 2010
diff --git a/lisp/net/socks.el b/lisp/net/socks.el
index 84fc5dccace..96fafc826b8 100644
--- a/lisp/net/socks.el
+++ b/lisp/net/socks.el
@@ -1,6 +1,6 @@
;;; socks.el --- A Socks v5 Client for Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1996-2000, 2002, 2007-2020 Free Software Foundation,
+;; Copyright (C) 1996-2000, 2002, 2007-2021 Free Software Foundation,
;; Inc.
;; Author: William M. Perry <wmperry@gnu.org>
@@ -235,11 +235,10 @@
(let ((num 0)
(retval ""))
(mapc
- (function
- (lambda (x)
- (if (fboundp (cdr (cdr x)))
- (setq retval (format "%s%c" retval (car x))
- num (1+ num)))))
+ (lambda (x)
+ (if (fboundp (cdr (cdr x)))
+ (setq retval (format "%s%c" retval (car x))
+ num (1+ num))))
(reverse socks-authentication-methods))
(format "%c%s" num retval)))
@@ -261,7 +260,7 @@
(setq state (process-get proc 'socks-state))
(cond
((= state socks-state-waiting-for-auth)
- (cl-callf (lambda (s) (setq string (concat string s)))
+ (cl-callf (lambda (s) (setq string (concat s string)))
(process-get proc 'socks-scratch))
(if (< (length string) 2)
nil ; We need to spin some more
@@ -273,7 +272,7 @@
((= state socks-state-authenticated)
)
((= state socks-state-waiting)
- (cl-callf (lambda (s) (setq string (concat string s)))
+ (cl-callf (lambda (s) (setq string (concat s string)))
(process-get proc 'socks-scratch))
(setq version (process-get proc 'socks-server-protocol))
(cond
@@ -386,6 +385,7 @@
)
)
(process-put proc 'socks-state socks-state-authenticated)
+ (process-put proc 'socks-scratch "")
(set-process-filter proc #'socks-filter)))
proc)))
@@ -543,7 +543,7 @@
service))
(process-put proc 'socks-buffer buffer)
(process-put proc 'socks-host host)
- (process-put proc 'socks-service host)
+ (process-put proc 'socks-service service)
(set-process-filter proc nil)
(set-process-buffer proc (if buffer (get-buffer-create buffer)))
proc))))
diff --git a/lisp/net/telnet.el b/lisp/net/telnet.el
index 29c415e6a65..67f844428a7 100644
--- a/lisp/net/telnet.el
+++ b/lisp/net/telnet.el
@@ -1,6 +1,6 @@
;;; telnet.el --- run a telnet session from within an Emacs buffer
-;; Copyright (C) 1985, 1988, 1992, 1994, 2001-2020 Free Software
+;; Copyright (C) 1985, 1988, 1992, 1994, 2001-2021 Free Software
;; Foundation, Inc.
;; Author: William F. Schelter
@@ -253,9 +253,9 @@ There is a variable `telnet-interrupt-string' which is the character
sent to try to stop execution of a job on the remote host.
Data is sent to the remote host when RET is typed."
(setq-local revert-buffer-function 'telnet-revert-buffer)
- (set (make-local-variable 'window-point-insertion-type) t)
- (set (make-local-variable 'comint-prompt-regexp) telnet-prompt-pattern)
- (set (make-local-variable 'comint-use-prompt-regexp) t))
+ (setq-local window-point-insertion-type t)
+ (setq-local comint-prompt-regexp telnet-prompt-pattern)
+ (setq-local comint-use-prompt-regexp t))
;;;###autoload
(defun rsh (host)
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 3d3b955e8c2..2c4ef2acaef 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -1,6 +1,6 @@
;;; tramp-adb.el --- Functions for calling Android Debug Bridge from Tramp -*- lexical-binding:t -*-
-;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
;; Author: Jürgen Hötzel <juergen@archlinux.org>
;; Keywords: comm, processes
@@ -98,6 +98,7 @@ It is used for TCP/IP devices."
`(,tramp-adb-method
(tramp-login-program ,tramp-adb-program)
(tramp-login-args (("shell")))
+ (tramp-direct-async t)
(tramp-tmpdir "/data/local/tmp")
(tramp-default-port 5555)))
@@ -217,7 +218,7 @@ ARGUMENTS to pass to the OPERATION."
(lambda (line)
(when (string-match "^\\(\\S-+\\)[[:space:]]+device$" line)
;; Replace ":" by "#".
- `(nil ,(replace-regexp-in-string
+ `(nil ,(tramp-compat-string-replace
":" tramp-prefix-port-format (match-string 1 line)))))
(tramp-process-lines nil tramp-adb-program "devices"))))
@@ -301,7 +302,7 @@ ARGUMENTS to pass to the OPERATION."
file-properties)))
(defun tramp-adb-handle-directory-files-and-attributes
- (directory &optional full match nosort id-format)
+ (directory &optional full match nosort id-format count)
"Like `directory-files-and-attributes' for Tramp files."
(unless (file-exists-p directory)
(tramp-error
@@ -311,8 +312,8 @@ ARGUMENTS to pass to the OPERATION."
(with-parsed-tramp-file-name (expand-file-name directory) nil
(copy-tree
(with-tramp-file-property
- v localname (format "directory-files-and-attributes-%s-%s-%s-%s"
- full match id-format nosort)
+ v localname (format "directory-files-and-attributes-%s-%s-%s-%s-%s"
+ full match id-format nosort count)
(with-current-buffer (tramp-get-buffer v)
(when (tramp-adb-send-command-and-check
v (format "%s -a -l %s"
@@ -342,11 +343,17 @@ ARGUMENTS to pass to the OPERATION."
(unless nosort
(setq result
(sort result (lambda (x y) (string< (car x) (car y))))))
- (delq nil
- (mapcar (lambda (x)
- (if (or (not match) (string-match-p match (car x)))
- x))
- result)))))))))
+
+ (setq result (delq nil
+ (mapcar
+ (lambda (x) (if (or (not match)
+ (string-match-p
+ match (car x)))
+ x))
+ result)))
+ (when (and (natnump count) (> count 0))
+ (setq result (nbutlast result (- (length result) count))))
+ result)))))))
(defun tramp-adb-get-ls-command (vec)
"Determine `ls' command and its arguments."
@@ -357,7 +364,8 @@ ARGUMENTS to pass to the OPERATION."
;; by GNU Coreutils. Force "ls" to print one column and set
;; time-style to imitate other "ls" flavors.
((tramp-adb-send-command-and-check
- vec "ls --time-style=long-iso /dev/null")
+ vec (concat "ls --time-style=long-iso "
+ (tramp-get-remote-null-device vec)))
"ls -1 --time-style=long-iso")
;; Can't disable coloring explicitly for toybox ls command. We
;; also must force "ls" to print just one column.
@@ -365,7 +373,8 @@ ARGUMENTS to pass to the OPERATION."
;; On CyanogenMod based system BusyBox is used and "ls" output
;; coloring is enabled by default. So we try to disable it when
;; possible.
- ((tramp-adb-send-command-and-check vec "ls --color=never -al /dev/null")
+ ((tramp-adb-send-command-and-check
+ vec (concat "ls --color=never -al " (tramp-get-remote-null-device vec)))
"ls --color=never")
(t "ls"))))
@@ -569,8 +578,9 @@ But handle the case, if the \"test\" command is not available."
;; Set file modification time.
(when (or (eq visit t) (stringp visit))
(set-visited-file-modtime
- (tramp-compat-file-attribute-modification-time
- (file-attributes filename))))
+ (or (tramp-compat-file-attribute-modification-time
+ (file-attributes filename))
+ (current-time))))
;; The end.
(when (and (null noninteractive)
@@ -604,13 +614,13 @@ But handle the case, if the \"test\" command is not available."
;; (introduced in POSIX.1-2008) fails.
(tramp-adb-send-command-and-check
v (format
- (concat "touch -d %s %s %s 2>/dev/null || "
- "touch -d %s %s %s 2>/dev/null || "
+ (concat "touch -d %s %s %s 2>%s || "
+ "touch -d %s %s %s 2>%s || "
"touch -t %s %s %s")
(format-time-string "%Y-%m-%dT%H:%M:%S.%NZ" time t)
- nofollow quoted-name
+ nofollow quoted-name (tramp-get-remote-null-device v)
(format-time-string "%Y-%m-%dT%H:%M:%S" time t)
- nofollow quoted-name
+ nofollow quoted-name (tramp-get-remote-null-device v)
(format-time-string "%Y%m%d%H%M.%S" time t)
nofollow quoted-name)))))
@@ -784,7 +794,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(cons program args) " "))
;; Determine input.
(if (null infile)
- (setq input "/dev/null")
+ (setq input (tramp-get-remote-null-device v))
(setq infile (expand-file-name infile))
(if (tramp-equal-remote default-directory infile)
;; INFILE is on the same remote host.
@@ -826,7 +836,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
tmpstderr (tramp-make-tramp-file-name v stderr))))
;; stderr to be discarded.
((null (cadr destination))
- (setq stderr "/dev/null"))))
+ (setq stderr (tramp-get-remote-null-device v)))))
;; 't
(destination
(setq outbuf (current-buffer))))
@@ -886,8 +896,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
;; terminated.
(defun tramp-adb-handle-make-process (&rest args)
"Like `make-process' for Tramp files.
-If connection property \"direct-async-process\" is non-nil, an
-alternative implementation will be used."
+If method parameter `tramp-direct-async' and connection property
+\"direct-async-process\" are non-nil, an alternative
+implementation will be used."
(if (tramp-direct-async-process-p args)
(apply #'tramp-handle-make-process args)
(when args
@@ -920,7 +931,7 @@ alternative implementation will be used."
(unless (or (null sentinel) (functionp sentinel))
(signal 'wrong-type-argument (list #'functionp sentinel)))
(unless (or (null stderr) (bufferp stderr) (stringp stderr))
- (signal 'wrong-type-argument (list #'stringp stderr)))
+ (signal 'wrong-type-argument (list #'bufferp stderr)))
(when (and (stringp stderr) (tramp-tramp-file-p stderr)
(not (tramp-equal-remote default-directory stderr)))
(signal 'file-error (list "Wrong stderr" stderr)))
@@ -972,7 +983,11 @@ alternative implementation will be used."
;; otherwise we might be interrupted by
;; `verify-visited-file-modtime'.
(let ((buffer-undo-list t)
- (inhibit-read-only t))
+ (inhibit-read-only t)
+ (coding-system-for-write
+ (if (symbolp coding) coding (car coding)))
+ (coding-system-for-read
+ (if (symbolp coding) coding (cdr coding))))
(clear-visited-file-modtime)
(narrow-to-region (point-max) (point-max))
;; We call `tramp-adb-maybe-open-connection',
@@ -1065,7 +1080,7 @@ E.g. a host name \"192.168.1.1#5555\" returns \"192.168.1.1:5555\"
(let* ((host (tramp-file-name-host vec))
(port (tramp-file-name-port-or-default vec))
(devices (mapcar #'cadr (tramp-adb-parse-device-names nil))))
- (replace-regexp-in-string
+ (tramp-compat-string-replace
tramp-prefix-port-format ":"
(cond ((member host devices) host)
;; This is the case when the host is connected to the default port.
@@ -1081,7 +1096,7 @@ E.g. a host name \"192.168.1.1#5555\" returns \"192.168.1.1:5555\"
(not (zerop (length host)))
(tramp-adb-execute-adb-command
vec "connect"
- (replace-regexp-in-string
+ (tramp-compat-string-replace
tramp-prefix-port-format ":" host)))
;; When new device connected, running other adb command (e.g.
;; adb shell) immediately will fail. To get around this
@@ -1118,6 +1133,13 @@ This happens for Android >= 4.0."
(if (string-match-p "[[:multibyte:]]" command)
;; Multibyte codepoints with four bytes are not supported at
;; least by toybox.
+
+ ;; <https://android.stackexchange.com/questions/226638/how-to-use-multibyte-file-names-in-adb-shell/232379#232379>
+ ;; mksh uses UTF-8 internally, but is currently limited to the
+ ;; BMP (basic multilingua plane), which means U+0000 to
+ ;; U+FFFD. If you want to use SMP codepoints (U-00010000 to
+ ;; U-0010FFFD) on the input line, you currently have to disable
+ ;; the UTF-8 mode (sorry).
(tramp-adb-execute-adb-command vec "shell" command)
(unless neveropen (tramp-adb-maybe-open-connection vec))
@@ -1251,6 +1273,9 @@ connection if a previous connection has died for some reason."
(process-put p 'adjust-window-size-function #'ignore)
(set-process-query-on-exit-flag p nil)
+ ;; Set connection-local variables.
+ (tramp-set-connection-local-variables vec)
+
;; Change prompt.
(tramp-set-connection-property
p "prompt" (regexp-quote (format "///%s#$" prompt)))
@@ -1303,29 +1328,27 @@ connection if a previous connection has died for some reason."
(tramp-error
vec 'file-error "Cannot switch to user `%s'" user)))
- ;; Set connection-local variables.
- (tramp-set-connection-local-variables vec)
-
;; Mark it as connected.
(tramp-set-connection-property p "connected" t)))))))
-;; Default settings for connection-local variables.
-(defconst tramp-adb-connection-local-default-profile
+;;; Default connection-local variables for Tramp:
+;; `connection-local-set-profile-variables' and
+;; `connection-local-set-profiles' exists since Emacs 26.1.
+(defconst tramp-adb-connection-local-default-shell-variables
'((shell-file-name . "/system/bin/sh")
(shell-command-switch . "-c"))
- "Default connection-local variables for remote adb connections.")
+ "Default connection-local shell variables for remote adb connections.")
+
+(tramp-compat-funcall
+ 'connection-local-set-profile-variables
+ 'tramp-adb-connection-local-default-shell-profile
+ tramp-adb-connection-local-default-shell-variables)
-;; `connection-local-set-profile-variables' and
-;; `connection-local-set-profiles' exists since Emacs 26.1.
(with-eval-after-load 'shell
(tramp-compat-funcall
- 'connection-local-set-profile-variables
- 'tramp-adb-connection-local-default-profile
- tramp-adb-connection-local-default-profile)
- (tramp-compat-funcall
'connection-local-set-profiles
`(:application tramp :protocol ,tramp-adb-method)
- 'tramp-adb-connection-local-default-profile))
+ 'tramp-adb-connection-local-default-shell-profile))
(add-hook 'tramp-unload-hook
(lambda ()
diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el
index 931a9717310..0bbd9271b18 100644
--- a/lisp/net/tramp-archive.el
+++ b/lisp/net/tramp-archive.el
@@ -1,6 +1,6 @@
;;; tramp-archive.el --- Tramp archive manager -*- lexical-binding:t -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index 970e2eea0ac..2b0a4d9cd05 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -1,6 +1,6 @@
;;; tramp-cache.el --- file information caching for Tramp -*- lexical-binding:t -*-
-;; Copyright (C) 2000, 2005-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2005-2021 Free Software Foundation, Inc.
;; Author: Daniel Pittman <daniel@inanna.danann.net>
;; Michael Albinus <michael.albinus@gmx.de>
diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el
index 827d5f60a2b..097f25ea85e 100644
--- a/lisp/net/tramp-cmds.el
+++ b/lisp/net/tramp-cmds.el
@@ -1,6 +1,6 @@
;;; tramp-cmds.el --- Interactive commands for Tramp -*- lexical-binding:t -*-
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
@@ -159,9 +159,6 @@ When called interactively, a Tramp connection has to be selected."
This includes password cache, file cache, connection cache, buffers."
(interactive)
- ;; Unlock Tramp.
- (setq tramp-locked nil)
-
;; Flush password cache.
(password-reset)
@@ -387,8 +384,7 @@ ESC or `q' to quit without changing further buffers,
(switch-to-buffer buffer)
(let* ((bfn (buffer-file-name))
(new-bfn (and (stringp bfn)
- (replace-regexp-in-string
- (regexp-quote source) target bfn)))
+ (tramp-compat-string-replace source target bfn)))
(prompt (format-message
"Set visited file name to `%s' [Type yn!eq or %s] "
new-bfn (key-description (vector help-char)))))
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index c554a8d0c2d..87e5378e807 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -1,6 +1,6 @@
;;; tramp-compat.el --- Tramp compatibility functions -*- lexical-binding:t -*-
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
@@ -43,6 +43,7 @@
;; `temporary-file-directory' as function is introduced with Emacs 26.1.
(declare-function tramp-handle-temporary-file-directory "tramp")
+(declare-function tramp-tramp-file-p "tramp")
(defvar tramp-temp-name-prefix)
(defconst tramp-compat-emacs-compiled-version (eval-when-compile emacs-version)
@@ -309,6 +310,44 @@ A nil value for either argument stands for the current time."
(lambda (filename &optional timestamp _flag)
(set-file-times filename timestamp))))
+;; `directory-files' and `directory-files-and-attributes' got argument
+;; COUNT in Emacs 28.1.
+(defalias 'tramp-compat-directory-files
+ (if (equal (tramp-compat-funcall 'func-arity #'directory-files) '(1 . 5))
+ #'directory-files
+ (lambda (directory &optional full match nosort _count)
+ (directory-files directory full match nosort))))
+
+(defalias 'tramp-compat-directory-files-and-attributes
+ (if (equal (tramp-compat-funcall 'func-arity #'directory-files-and-attributes)
+ '(1 . 6))
+ #'directory-files-and-attributes
+ (lambda (directory &optional full match nosort id-format _count)
+ (directory-files-and-attributes directory full match nosort id-format))))
+
+;; `directory-empty-p' is new in Emacs 28.1.
+(defalias 'tramp-compat-directory-empty-p
+ (if (fboundp 'directory-empty-p)
+ #'directory-empty-p
+ (lambda (dir)
+ (and (file-directory-p dir)
+ (null (tramp-compat-directory-files
+ dir nil directory-files-no-dot-files-regexp t 1))))))
+
+;; Function `null-device' is new in Emacs 28.1.
+(defalias 'tramp-compat-null-device
+ (if (fboundp 'null-device)
+ #'null-device
+ (lambda ()
+ (if (tramp-tramp-file-p default-directory) "/dev/null" null-device))))
+
+;; Function `string-replace' is new in Emacs 28.1.
+(defalias 'tramp-compat-string-replace
+ (if (fboundp 'string-replace)
+ #'string-replace
+ (lambda (fromstring tostring instring)
+ (replace-regexp-in-string (regexp-quote fromstring) tostring instring))))
+
(add-hook 'tramp-unload-hook
(lambda ()
(unload-feature 'tramp-loaddefs 'force)
@@ -322,5 +361,8 @@ A nil value for either argument stands for the current time."
;;
;; * Starting with Emacs 27.1, there's no need to escape open
;; parentheses with a backslash in docstrings anymore.
+;;
+;; * Starting with Emacs 27.1, there's `make-empty-file'. Could be
+;; used instead of `write-region'.
;;; tramp-compat.el ends here
diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el
index 286b60a48c2..dfe54623dbc 100644
--- a/lisp/net/tramp-crypt.el
+++ b/lisp/net/tramp-crypt.el
@@ -1,6 +1,6 @@
;;; tramp-crypt.el --- Tramp crypt utilities -*- lexical-binding:t -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
@@ -668,7 +668,8 @@ absolute file names."
(let (tramp-crypt-enabled)
(delete-file (tramp-crypt-encrypt-file-name filename)))))
-(defun tramp-crypt-handle-directory-files (directory &optional full match nosort)
+(defun tramp-crypt-handle-directory-files
+ (directory &optional full match nosort count)
"Like `directory-files' for Tramp files."
(unless (file-exists-p directory)
(tramp-error
@@ -697,7 +698,11 @@ absolute file names."
(replace-regexp-in-string
(concat "^" (regexp-quote directory)) "" x))
result)))
- (if nosort result (sort result #'string<)))))
+ (unless nosort
+ (setq result (sort result #'string<)))
+ (when (and (natnump count) (> count 0))
+ (setq result (nbutlast result (- (length result) count))))
+ result)))
(defun tramp-crypt-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files."
diff --git a/lisp/net/tramp-ftp.el b/lisp/net/tramp-ftp.el
index 996a92454f1..fa2df89e495 100644
--- a/lisp/net/tramp-ftp.el
+++ b/lisp/net/tramp-ftp.el
@@ -1,6 +1,6 @@
;;; tramp-ftp.el --- Tramp convenience functions for Ange-FTP -*- lexical-binding:t -*-
-;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
@@ -31,7 +31,6 @@
(require 'tramp)
;; Pacify byte-compiler.
-(eval-when-compile (require 'custom))
(defvar ange-ftp-ftp-name-arg)
(defvar ange-ftp-ftp-name-res)
(defvar ange-ftp-name-format)
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index bf55777e335..f882636a8fc 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -1,6 +1,6 @@
;;; tramp-gvfs.el --- Tramp access functions for GVFS daemon -*- lexical-binding:t -*-
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
@@ -49,12 +49,12 @@
;; The user option `tramp-gvfs-methods' contains the list of supported
;; connection methods. Per default, these are "afp", "dav", "davs",
-;; "gdrive", "media", "nextcloud" and "sftp".
+;; "gdrive", "mtp", "nextcloud" and "sftp".
;; "gdrive" and "nextcloud" connection methods require a respective
;; account in GNOME Online Accounts, with enabled "Files" service.
-;; The "media" connection method is responsible for media devices,
+;; The "mtp" connection method is responsible for media devices,
;; like cell phones, tablets, cameras etc. The device must already be
;; connected via USB, before accessing it.
@@ -108,8 +108,6 @@
(require 'url-util)
;; Pacify byte-compiler.
-(eval-when-compile (require 'custom))
-
(declare-function zeroconf-init "zeroconf")
(declare-function zeroconf-list-service-types "zeroconf")
(declare-function zeroconf-list-services "zeroconf")
@@ -133,7 +131,7 @@
;;;###tramp-autoload
(defcustom tramp-gvfs-methods
- '("afp" "dav" "davs" "gdrive" "media" "nextcloud" "sftp")
+ '("afp" "dav" "davs" "gdrive" "mtp" "nextcloud" "sftp")
"List of methods for remote files, accessed with GVFS."
:group 'tramp
:version "28.1"
@@ -144,7 +142,7 @@
(const "gdrive")
(const "http")
(const "https")
- (const "media")
+ (const "mtp")
(const "nextcloud")
(const "sftp")
(const "smb"))))
@@ -161,7 +159,7 @@
;;;###tramp-autoload
(defvar tramp-media-methods '("afc" "gphoto2" "mtp")
- "List of GVFS methods which are covered by the \"media\" method.
+ "List of GVFS methods which are covered by the \"mtp\" method.
They are checked during start up via
`tramp-gvfs-interface-remotevolumemonitor'.")
@@ -689,7 +687,6 @@ It has been changed in GVFS 1.14.")
("gvfs-monitor-file" . "monitor")
("gvfs-mount" . "mount")
("gvfs-move" . "move")
- ("gvfs-rename" . "rename")
("gvfs-rm" . "remove")
("gvfs-set-attribute" . "set"))
"List of cons cells, mapping \"gvfs-<command>\" to \"gio <command>\".")
@@ -985,15 +982,12 @@ file names."
(copy-directory filename newname keep-date t)
(when (eq op 'rename) (delete-directory filename 'recursive)))
- (let* ((t1 (tramp-tramp-file-p filename))
- (t2 (tramp-tramp-file-p newname))
- (equal-remote (tramp-equal-remote filename newname))
- (gvfs-operation
- (cond
- ((eq op 'copy) "gvfs-copy")
- (equal-remote "gvfs-rename")
- (t "gvfs-move")))
- (msg-operation (if (eq op 'copy) "Copying" "Renaming")))
+ (let ((t1 (tramp-tramp-file-p filename))
+ (t2 (tramp-tramp-file-p newname))
+ (equal-remote (tramp-equal-remote filename newname))
+ ;; "gvfs-rename" is not trustworthy.
+ (gvfs-operation (if (eq op 'copy) "gvfs-copy" "gvfs-move"))
+ (msg-operation (if (eq op 'copy) "Copying" "Renaming")))
(with-parsed-tramp-file-name (if t1 filename newname) nil
(unless (file-exists-p filename)
@@ -1024,14 +1018,23 @@ file names."
(with-tramp-progress-reporter
v 0 (format "%s %s to %s" msg-operation filename newname)
(unless
- (apply
- #'tramp-gvfs-send-command v gvfs-operation
- (append
- (and (eq op 'copy) (or keep-date preserve-uid-gid)
- '("--preserve"))
- (list
- (tramp-gvfs-url-file-name filename)
- (tramp-gvfs-url-file-name newname))))
+ (and (apply
+ #'tramp-gvfs-send-command v gvfs-operation
+ (append
+ (and (eq op 'copy) (or keep-date preserve-uid-gid)
+ '("--preserve"))
+ (list
+ (tramp-gvfs-url-file-name filename)
+ (tramp-gvfs-url-file-name newname))))
+ ;; Some backends do not return a proper error
+ ;; code in case of direct copy/move. Apply sanity checks.
+ (or (not equal-remote)
+ (tramp-gvfs-send-command
+ v "gvfs-info" (tramp-gvfs-url-file-name newname))
+ (eq op 'copy)
+ (not (tramp-gvfs-send-command
+ v "gvfs-info"
+ (tramp-gvfs-url-file-name filename)))))
(if (or (not equal-remote)
(and equal-remote
@@ -1088,7 +1091,7 @@ file names."
(delete-file file)))
(directory-files
directory 'full directory-files-no-dot-files-regexp))
- (when (directory-files directory nil directory-files-no-dot-files-regexp)
+ (unless (tramp-compat-directory-empty-p directory)
(tramp-error
v 'file-error "Couldn't delete non-empty %s" directory)))
@@ -1431,6 +1434,9 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(unless (process-live-p p)
(tramp-error
p 'file-notify-error "Monitoring not supported for `%s'" file-name))
+ ;; Set "gio-file-monitor" property. We believe, that "gio
+ ;; monitor" uses polling when applied for mounted files.
+ (tramp-set-connection-property p "gio-file-monitor" 'GPollFileMonitor)
p))))
(defun tramp-gvfs-monitor-process-filter (proc string)
@@ -1445,11 +1451,11 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(tramp-message proc 6 "%S\n%s" proc string)
(setq string (concat rest-string string)
;; Fix action names.
- string (replace-regexp-in-string
+ string (tramp-compat-string-replace
"attributes changed" "attribute-changed" string)
- string (replace-regexp-in-string
+ string (tramp-compat-string-replace
"changes done" "changes-done-hint" string)
- string (replace-regexp-in-string
+ string (tramp-compat-string-replace
"renamed to" "moved" string))
;; https://bugs.launchpad.net/bugs/1742946
(when
@@ -1633,7 +1639,7 @@ ID-FORMAT valid values are `string' and `integer'."
(if (tramp-tramp-file-p filename)
(with-parsed-tramp-file-name filename nil
;; Ensure that media devices are cached.
- (when (string-equal method "media")
+ (when (string-equal method "mtp")
(tramp-get-media-device v))
(with-tramp-connection-property v "activation-uri"
(setq localname "/")
@@ -1643,7 +1649,7 @@ ID-FORMAT valid values are `string' and `integer'."
(setq method "davs"
localname
(concat (tramp-gvfs-get-remote-prefix v) localname)))
- (when (string-equal "media" method)
+ (when (string-equal "mtp" method)
(when-let
((media (tramp-get-connection-property v "media-device" nil)))
(setq method (tramp-media-device-method media)
@@ -2052,9 +2058,9 @@ and \"org.gtk.Private.RemoteVolumeMonitor.VolumeRemoved\" signals."
(uri (url-generic-parse-url (nth 5 volume)))
(method (url-type uri))
(vec (make-tramp-file-name
- :method "media"
+ :method "mtp"
;; A host name cannot contain spaces.
- :host (replace-regexp-in-string " " "_" (nth 1 volume))))
+ :host (tramp-compat-string-replace " " "_" (nth 1 volume))))
(media (make-tramp-media-device
:method method
:host (tramp-gvfs-url-host (nth 5 volume))
@@ -2109,7 +2115,10 @@ connection if a previous connection has died for some reason."
:buffer (tramp-get-connection-buffer vec)
:server t :host 'local :service t :noquery t)))
(process-put p 'vector vec)
- (set-process-query-on-exit-flag p nil)))
+ (set-process-query-on-exit-flag p nil)
+
+ ;; Set connection-local variables.
+ (tramp-set-connection-local-variables vec)))
(unless (tramp-gvfs-connection-mounted-p vec)
(let ((method (tramp-file-name-method vec))
@@ -2213,9 +2222,6 @@ connection if a previous connection has died for some reason."
(and (functionp tramp-password-save-function)
(funcall tramp-password-save-function)))
- ;; Set connection-local variables.
- (tramp-set-connection-local-variables vec)
-
;; Mark it as connected.
(tramp-set-connection-property
(tramp-get-connection-process vec) "connected" t)))))
@@ -2357,9 +2363,9 @@ VEC is used only for traces."
tramp-gvfs-interface-remotevolumemonitor "List")))
(let* ((uri (url-generic-parse-url (nth 5 volume)))
(vec (make-tramp-file-name
- :method "media"
+ :method "mtp"
;; A host name cannot contain spaces.
- :host (replace-regexp-in-string " " "_" (nth 1 volume))))
+ :host (tramp-compat-string-replace " " "_" (nth 1 volume))))
(media (make-tramp-media-device
:method method
:host (tramp-gvfs-url-host (nth 5 volume))
@@ -2370,12 +2376,12 @@ VEC is used only for traces."
(tramp-set-connection-property vec "media-device" media)
(tramp-set-connection-property media "vector" vec))))
- ;; Adapt default host name, supporting /media:: when possible.
+ ;; Adapt default host name, supporting /mtp:: when possible.
(setq tramp-default-host-alist
(append
- `(("media" nil ,(if (= (length devices) 1) (car devices) "")))
+ `(("mtp" nil ,(if (= (length devices) 1) (car devices) "")))
(delete
- (assoc "media" tramp-default-host-alist)
+ (assoc "mtp" tramp-default-host-alist)
tramp-default-host-alist)))))
(defun tramp-parse-media-names (service)
@@ -2439,7 +2445,10 @@ This uses \"avahi-browse\" in case D-Bus is not enabled in Avahi."
(when tramp-gvfs-enabled
;; Suppress D-Bus error messages and Tramp traces.
- (let ((tramp-verbose 0)
+ (let (;; Sometimes, it fails with "Variable binding depth exceeds
+ ;; max-specpdl-size". Shall be fixed in Emacs 27.
+ (max-specpdl-size (* 2 max-specpdl-size))
+ (tramp-verbose 0)
tramp-gvfs-dbus-event-vector fun)
;; Add completion functions for services announced by DNS-SD.
;; See <http://www.dns-sd.org/ServiceTypes.html> for valid service types.
@@ -2489,7 +2498,7 @@ This uses \"avahi-browse\" in case D-Bus is not enabled in Avahi."
;; Add completion functions for media devices.
(tramp-get-media-devices nil)
(tramp-set-completion-function
- "media"
+ "mtp"
(mapcar
(lambda (method) `(tramp-parse-media-names ,(format "_%s._tcp" method)))
tramp-media-methods))))
diff --git a/lisp/net/tramp-integration.el b/lisp/net/tramp-integration.el
index 7e4a9bf05e5..64b5b48e7d4 100644
--- a/lisp/net/tramp-integration.el
+++ b/lisp/net/tramp-integration.el
@@ -1,6 +1,6 @@
;;; tramp-integration.el --- Tramp integration into other packages -*- lexical-binding:t -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
@@ -262,23 +262,39 @@ NAME must be equal to `tramp-current-connection'."
(info-lookup->topic-cache 'symbol))))))))
;;; Default connection-local variables for Tramp:
+;; `connection-local-set-profile-variables' and
+;; `connection-local-set-profiles' exists since Emacs 26.1.
+
+(defconst tramp-connection-local-default-system-variables
+ '((path-separator . ":")
+ (null-device . "/dev/null"))
+ "Default connection-local system variables for remote connections.")
+
+(tramp-compat-funcall
+ 'connection-local-set-profile-variables
+ 'tramp-connection-local-default-system-profile
+ tramp-connection-local-default-system-variables)
+
+(tramp-compat-funcall
+ 'connection-local-set-profiles
+ `(:application tramp)
+ 'tramp-connection-local-default-system-profile)
-(defconst tramp-connection-local-default-profile
+(defconst tramp-connection-local-default-shell-variables
'((shell-file-name . "/bin/sh")
(shell-command-switch . "-c"))
- "Default connection-local variables for remote connections.")
+ "Default connection-local shell variables for remote connections.")
+
+(tramp-compat-funcall
+ 'connection-local-set-profile-variables
+ 'tramp-connection-local-default-shell-profile
+ tramp-connection-local-default-shell-variables)
-;; `connection-local-set-profile-variables' and
-;; `connection-local-set-profiles' exists since Emacs 26.1.
(with-eval-after-load 'shell
(tramp-compat-funcall
- 'connection-local-set-profile-variables
- 'tramp-connection-local-default-profile
- tramp-connection-local-default-profile)
- (tramp-compat-funcall
'connection-local-set-profiles
`(:application tramp)
- 'tramp-connection-local-default-profile))
+ 'tramp-connection-local-default-shell-profile))
(add-hook 'tramp-unload-hook
(lambda () (unload-feature 'tramp-integration 'force)))
diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el
index 3701bfc22c9..8638bb477f8 100644
--- a/lisp/net/tramp-rclone.el
+++ b/lisp/net/tramp-rclone.el
@@ -1,6 +1,6 @@
;;; tramp-rclone.el --- Tramp access functions to cloud storages -*- lexical-binding:t -*-
-;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2018-2021 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
@@ -289,19 +289,19 @@ file names."
(directory &optional recursive trash)
"Like `delete-directory' for Tramp files."
(with-parsed-tramp-file-name (expand-file-name directory) nil
- (delete-directory (tramp-rclone-local-file-name directory) recursive trash)
(tramp-flush-directory-properties v localname)
- (tramp-rclone-flush-directory-cache v)))
+ (tramp-rclone-flush-directory-cache v)
+ (delete-directory (tramp-rclone-local-file-name directory) recursive trash)))
(defun tramp-rclone-handle-delete-file (filename &optional trash)
"Like `delete-file' for Tramp files."
(with-parsed-tramp-file-name (expand-file-name filename) nil
+ (tramp-rclone-flush-directory-cache v)
(delete-file (tramp-rclone-local-file-name filename) trash)
- (tramp-flush-file-properties v localname)
- (tramp-rclone-flush-directory-cache v)))
+ (tramp-flush-file-properties v localname)))
(defun tramp-rclone-handle-directory-files
- (directory &optional full match nosort)
+ (directory &optional full match nosort count)
"Like `directory-files' for Tramp files."
(unless (file-exists-p directory)
(tramp-error
@@ -311,8 +311,8 @@ file names."
(setq directory (file-name-as-directory (expand-file-name directory)))
(with-parsed-tramp-file-name directory nil
(let ((result
- (directory-files
- (tramp-rclone-local-file-name directory) full match)))
+ (tramp-compat-directory-files
+ (tramp-rclone-local-file-name directory) full match nosort count)))
;; Massage the result.
(when full
(let ((local (concat "^" (regexp-quote (tramp-rclone-mount-point v))))
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 860641b2589..618a9fb9d02 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -1,6 +1,6 @@
;;; tramp-sh.el --- Tramp access functions for (s)sh-like connections -*- lexical-binding:t -*-
-;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; (copyright statements below in code to be updated with the above notice)
@@ -58,8 +58,7 @@ If it is nil, no compression at all will be applied."
;;;###tramp-autoload
(defcustom tramp-copy-size-limit 10240
- "The maximum file size where inline copying is preferred over an \
-out-of-the-band copy.
+ "Maximum file size where inline copying is preferred to an out-of-the-band copy.
If it is nil, out-of-the-band copy will be used without a check."
:group 'tramp
:type '(choice (const nil) integer))
@@ -169,6 +168,7 @@ The string is used in `tramp-methods'.")
(tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
("-e" "none") ("%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"))
@@ -184,6 +184,7 @@ The string is used in `tramp-methods'.")
("-e" "none") ("-t" "-t") ("%h")
("%l")))
(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"))
@@ -198,6 +199,7 @@ The string is used in `tramp-methods'.")
(tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
("-e" "none") ("%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"))
@@ -228,6 +230,7 @@ The string is used in `tramp-methods'.")
(tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
("-e" "none") ("%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,20 +241,21 @@ The string is used in `tramp-methods'.")
("-e" "none") ("-t" "-t") ("%h")
("%l")))
(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"))))
(add-to-list 'tramp-methods
`("telnet"
(tramp-login-program "telnet")
- (tramp-login-args (("%h") ("%p") ("2>/dev/null")))
+ (tramp-login-args (("%h") ("%p") ("%n")))
(tramp-remote-shell ,tramp-default-remote-shell)
(tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))))
(add-to-list 'tramp-methods
`("nc"
(tramp-login-program "telnet")
- (tramp-login-args (("%h") ("%p") ("2>/dev/null")))
+ (tramp-login-args (("%h") ("%p") ("%n")))
(tramp-remote-shell ,tramp-default-remote-shell)
(tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))
@@ -262,8 +266,7 @@ The string is used in `tramp-methods'.")
;; We use "-p" as required for newer busyboxes. For older
;; busybox/nc versions, the value must be (("-l") ("%r")). This
;; can be achieved by tweaking `tramp-connection-properties'.
- (tramp-remote-copy-args (("-l") ("-p" "%r")
- ("2>/dev/null")))))
+ (tramp-remote-copy-args (("-l") ("-p" "%r") ("%n")))))
(add-to-list 'tramp-methods
`("su"
(tramp-login-program "su")
@@ -481,7 +484,7 @@ The string is used in `tramp-methods'.")
;; Solaris: /usr/xpg4/bin:/usr/ccs/bin:/usr/bin:/opt/SUNWspro/bin
;; GNU/Linux (Debian, Suse, RHEL): /bin:/usr/bin
;; FreeBSD, DragonFly: /usr/bin:/bin:/usr/sbin:/sbin: - beware trailing ":"!
-;; Darwin: /usr/bin:/bin:/usr/sbin:/sbin
+;; FreeBSD 12.1, Darwin: /usr/bin:/bin:/usr/sbin:/sbin
;; IRIX64: /usr/bin
;; QNAP QTS: ---
;; Hydra: /run/current-system/sw/bin:/bin:/usr/bin
@@ -596,10 +599,12 @@ rm -f %t"
"Shell function to implement `uudecode' to standard output.
Many systems support `uudecode -o /dev/stdout' or `uudecode -o -'
for this or `uudecode -p', but some systems don't, and for them
-we have this shell function.")
+we have this shell function.
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
(defconst tramp-perl-file-truename
- "%s -e '
+ "%p -e '
use File::Spec;
use Cwd \"realpath\";
@@ -634,14 +639,14 @@ if (!$result) {
$result =~ s/\"/\\\\\"/g;
print \"\\\"$result\\\"\\n\";
-' \"$1\" 2>/dev/null"
+' \"$1\" %n"
"Perl script to produce output suitable for use with `file-truename'
on the remote file system.
-Escape sequence %s is replaced with name of Perl binary.
-This string is passed to `format', so percent characters need to be doubled.")
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
(defconst tramp-perl-file-name-all-completions
- "%s -e '
+ "%p -e '
opendir(d, $ARGV[0]) || die(\"$ARGV[0]: $!\\nfail\\n\");
@files = readdir(d); closedir(d);
foreach $f (@files) {
@@ -653,11 +658,11 @@ foreach $f (@files) {
}
}
print \"ok\\n\"
-' \"$1\" 2>/dev/null"
+' \"$1\" %n"
"Perl script to produce output suitable for use with
-`file-name-all-completions' on the remote file system. Escape
-sequence %s is replaced with name of Perl binary. This string is
-passed to `format', so percent characters need to be doubled.")
+`file-name-all-completions' on the remote file system.
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
;; Perl script to implement `file-attributes' in a Lisp `read'able
;; output. If you are hacking on this, note that you get *no* output
@@ -666,7 +671,7 @@ passed to `format', so percent characters need to be doubled.")
;; The device number is returned as "-1", because there will be a virtual
;; device number set in `tramp-sh-handle-file-attributes'.
(defconst tramp-perl-file-attributes
- "%s -e '
+ "%p -e '
@stat = lstat($ARGV[0]);
if (!@stat) {
print \"nil\\n\";
@@ -703,14 +708,14 @@ printf(
$stat[7],
$stat[2],
$stat[1]
-);' \"$1\" \"$2\" 2>/dev/null"
+);' \"$1\" \"$2\" %n"
"Perl script to produce output suitable for use with `file-attributes'
on the remote file system.
-Escape sequence %s is replaced with name of Perl binary.
-This string is passed to `format', so percent characters need to be doubled.")
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
(defconst tramp-perl-directory-files-and-attributes
- "%s -e '
+ "%p -e '
chdir($ARGV[0]) or printf(\"\\\"Cannot change to $ARGV[0]: $''!''\\\"\\n\"), exit();
opendir(DIR,\".\") or printf(\"\\\"Cannot open directory $ARGV[0]: $''!''\\\"\\n\"), exit();
@list = readdir(DIR);
@@ -755,33 +760,33 @@ for($i = 0; $i < $n; $i++)
$stat[2],
$stat[1]);
}
-printf(\")\\n\");' \"$1\" \"$2\" 2>/dev/null"
+printf(\")\\n\");' \"$1\" \"$2\" %n"
"Perl script implementing `directory-files-and-attributes' as Lisp `read'able
output.
-Escape sequence %s is replaced with name of Perl binary.
-This string is passed to `format', so percent characters need to be doubled.")
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
;; These two use base64 encoding.
(defconst tramp-perl-encode-with-module
- "%s -MMIME::Base64 -0777 -ne 'print encode_base64($_)' 2>/dev/null"
+ "%p -MMIME::Base64 -0777 -ne 'print encode_base64($_)' %n"
"Perl program to use for encoding a file.
-Escape sequence %s is replaced with name of Perl binary.
-This string is passed to `format', so percent characters need to be doubled.
This implementation requires the MIME::Base64 Perl module to be installed
-on the remote host.")
+on the remote host.
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
(defconst tramp-perl-decode-with-module
- "%s -MMIME::Base64 -0777 -ne 'print decode_base64($_)' 2>/dev/null"
+ "%p -MMIME::Base64 -0777 -ne 'print decode_base64($_)' %n"
"Perl program to use for decoding a file.
-Escape sequence %s is replaced with name of Perl binary.
-This string is passed to `format', so percent characters need to be doubled.
This implementation requires the MIME::Base64 Perl module to be installed
-on the remote host.")
+on the remote host.
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
(defconst tramp-perl-encode
- "%s -e '
+ "%p -e '
# This script contributed by Juanma Barranquero <lektu@terra.es>.
-# Copyright (C) 2002-2020 Free Software Foundation, Inc.
+# Copyright (C) 2002-2021 Free Software Foundation, Inc.
use strict;
my %%trans = do {
@@ -812,15 +817,15 @@ while (read STDIN, $data, 54) {
(substr(unpack(q(B*), $data) . q(00000), 0, 432) =~ /....../g)),
$pad,
qq(\\n);
-}' 2>/dev/null"
+}' %n"
"Perl program to use for encoding a file.
-Escape sequence %s is replaced with name of Perl binary.
-This string is passed to `format', so percent characters need to be doubled.")
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
(defconst tramp-perl-decode
- "%s -e '
+ "%p -e '
# This script contributed by Juanma Barranquero <lektu@terra.es>.
-# Copyright (C) 2002-2020 Free Software Foundation, Inc.
+# Copyright (C) 2002-2021 Free Software Foundation, Inc.
use strict;
my %%trans = do {
@@ -856,24 +861,27 @@ while (my $data = <STDIN>) {
((join q(), map {$trans{$_} || q()} split //, $chunk) =~ /......../g);
last if $finished;
-}' 2>/dev/null"
+}' %n"
"Perl program to use for decoding a file.
-Escape sequence %s is replaced with name of Perl binary.
-This string is passed to `format', so percent characters need to be doubled.")
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
(defconst tramp-perl-pack
- "%s -e 'binmode STDIN; binmode STDOUT; print pack(q{u*}, join q{}, <>)'"
+ "%p -e 'binmode STDIN; binmode STDOUT; print pack(q{u*}, join q{}, <>)' %n"
"Perl program to use for encoding a file.
-Escape sequence %s is replaced with name of Perl binary.")
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
(defconst tramp-perl-unpack
- "%s -e 'binmode STDIN; binmode STDOUT; print unpack(q{u*}, join q{}, <>)'"
+ "%p -e 'binmode STDIN; binmode STDOUT; print unpack(q{u*}, join q{}, <>)' %n"
"Perl program to use for decoding a file.
-Escape sequence %s is replaced with name of Perl binary.")
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
(defconst tramp-hexdump-encode "%h -v -e '16/1 \" %%02x\" \"\\n\"'"
"`hexdump' program to use for encoding a file.
-This string is passed to `format', so percent characters need to be doubled.")
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
(defconst tramp-awk-encode
"%a '\\
@@ -907,21 +915,24 @@ END {
printf tail
}'"
"`awk' program to use for encoding a file.
-This string is passed to `format', so percent characters need to be doubled.")
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
(defconst tramp-hexdump-awk-encode
(format "%s | %s" tramp-hexdump-encode tramp-awk-encode)
"`hexdump' / `awk' pipe to use for encoding a file.
-This string is passed to `format', so percent characters need to be doubled.")
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
(defconst tramp-od-encode "%o -v -t x1 -A n"
"`od' program to use for encoding a file.
-This string is passed to `format', so percent characters need to be doubled.")
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
-(defconst tramp-od-awk-encode
- (format "%s | %s" tramp-od-encode tramp-awk-encode)
+(defconst tramp-od-awk-encode (format "%s | %s" tramp-od-encode tramp-awk-encode)
"`od' / `awk' pipe to use for encoding a file.
-This string is passed to `format', so percent characters need to be doubled.")
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
(defconst tramp-awk-decode
"%a '\\
@@ -938,7 +949,7 @@ BEGIN {
if (o) {
printf \"%%c\", o
} else {
- system(\"dd if=/dev/zero bs=1 count=1 2>/dev/null\")
+ system(\"dd if=/dev/zero bs=1 count=1 %n\")
}
obc=0; o=0
}
@@ -947,7 +958,8 @@ BEGIN {
}
}'"
"Awk program to use for decoding a file.
-This string is passed to `format', so percent characters need to be doubled.")
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
(defconst tramp-vc-registered-read-file-names
"echo \"(\"
@@ -969,7 +981,8 @@ echo \")\""
It must be send formatted with two strings; the tests for file
existence, and file readability. Input shall be read via
here-document, otherwise the command could exceed maximum length
-of command line.")
+of command line.
+Format specifiers \"%s\" are replaced before the script is used.")
;; New handlers should be added here.
;;;###tramp-autoload
@@ -1703,7 +1716,7 @@ ID-FORMAT valid values are `string' and `integer'."
;; Directory listings.
(defun tramp-sh-handle-directory-files-and-attributes
- (directory &optional full match nosort id-format)
+ (directory &optional full match nosort id-format count)
"Like `directory-files-and-attributes' for Tramp files."
(unless id-format (setq id-format 'integer))
(unless (file-exists-p directory)
@@ -1738,13 +1751,18 @@ ID-FORMAT valid values are `string' and `integer'."
(setcar item (expand-file-name (car item) directory)))
(push item result)))
- (or (if nosort
- result
- (sort result (lambda (x y) (string< (car x) (car y)))))
+ (unless nosort
+ (setq result (sort result (lambda (x y) (string< (car x) (car y))))))
+
+ (when (and (natnump count) (> count 0))
+ (setq result (nbutlast result (- (length result) count))))
+
+ (or result
;; The scripts could fail, for example with huge file size.
(tramp-handle-directory-files-and-attributes
- directory full match nosort id-format)))))
+ directory full match nosort id-format count)))))
+;; FIXME: Fix function to work with count parameter.
(defun tramp-do-directory-files-and-attributes-with-perl
(vec localname &optional id-format)
"Implement `directory-files-and-attributes' for Tramp files using a Perl script."
@@ -1760,6 +1778,7 @@ ID-FORMAT valid values are `string' and `integer'."
(when (stringp object) (tramp-error vec 'file-error object))
object))
+;; FIXME: Fix function to work with count parameter.
(defun tramp-do-directory-files-and-attributes-with-stat
(vec localname &optional id-format)
"Implement `directory-files-and-attributes' for Tramp files using stat(1) command."
@@ -1779,7 +1798,7 @@ ID-FORMAT valid values are `string' and `integer'."
"cd %s && echo \"(\"; (%s %s -a | tr '\\n\\r' '\\000\\000' | "
"xargs -0 %s -c "
"'(%s%%n%s (%s%%N%s) %%h %s %s %%X %%Y %%Z %%s %s%%A%s t %%i -1)' "
- "-- 2>/dev/null | sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g'); echo \")\"")
+ "-- 2>%s | sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g'); echo \")\"")
(tramp-shell-quote-argument localname)
(tramp-get-ls-command vec)
;; On systems which have no quoting style, file names with special
@@ -1795,6 +1814,7 @@ ID-FORMAT valid values are `string' and `integer'."
"%g"
(eval-when-compile (concat tramp-stat-marker "%G" tramp-stat-marker)))
tramp-stat-marker tramp-stat-marker
+ (tramp-get-remote-null-device vec)
tramp-stat-quoted-marker)))
;; This function should return "foo/" for directories and "bar" for
@@ -1821,14 +1841,16 @@ ID-FORMAT valid values are `string' and `integer'."
(tramp-shell-quote-argument localname)))
(format (concat
- "(cd %s 2>&1 && %s -a 2>/dev/null"
+ "(cd %s 2>&1 && %s -a 2>%s"
" | while IFS= read f; do"
- " if %s -d \"$f\" 2>/dev/null;"
+ " if %s -d \"$f\" 2>%s;"
" then \\echo \"$f/\"; else \\echo \"$f\"; fi; done"
" && \\echo ok) || \\echo fail")
(tramp-shell-quote-argument localname)
(tramp-get-ls-command v)
- (tramp-get-test-command v))))
+ (tramp-get-remote-null-device v)
+ (tramp-get-test-command v)
+ (tramp-get-remote-null-device v))))
;; Now grab the output.
(with-current-buffer (tramp-get-buffer v)
@@ -2217,7 +2239,7 @@ the uid and gid from FILENAME."
(file-writable-p (concat prefix localname2))))
(tramp-do-copy-or-rename-file-directly
op (concat prefix localname1) (concat prefix localname2)
- ok-if-already-exists keep-date t)
+ ok-if-already-exists keep-date preserve-uid-gid)
;; We must change the ownership to the local user.
(tramp-set-file-uid-gid
(concat prefix localname2)
@@ -2356,7 +2378,8 @@ The method used must be an out-of-band method."
options (format-spec (tramp-ssh-controlmaster-options v) spec)
spec (format-spec-make
?h host ?u user ?p port ?r listener ?c options
- ?k (if keep-date " " ""))
+ ?k (if keep-date " " "")
+ ?n (concat "2>" (tramp-get-remote-null-device v)))
copy-program (tramp-get-method-parameter v 'tramp-copy-program)
copy-keep-date (tramp-get-method-parameter
v 'tramp-copy-keep-date)
@@ -2583,14 +2606,13 @@ The method used must be an out-of-band method."
(t nil)))))))))
(defun tramp-sh-handle-insert-directory
- (filename switches &optional wildcard full-directory-p)
+ (filename switches &optional wildcard full-directory-p)
"Like `insert-directory' for Tramp files."
- (setq filename (expand-file-name filename))
(unless switches (setq switches ""))
;; Check, whether directory is accessible.
(unless wildcard
(access-file filename "Reading directory"))
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(if (and (featurep 'ls-lisp)
(not (symbol-value 'ls-lisp-use-insert-directory-program)))
(tramp-handle-insert-directory
@@ -2618,61 +2640,63 @@ The method used must be an out-of-band method."
v 4 "Inserting directory `ls %s %s', wildcard %s, fulldir %s"
switches filename (if wildcard "yes" "no")
(if full-directory-p "yes" "no"))
- ;; If `full-directory-p', we just say `ls -l FILENAME'.
- ;; Else we chdir to the parent directory, then say `ls -ld BASENAME'.
+ ;; If `full-directory-p', we just say `ls -l FILENAME'. Else we
+ ;; chdir to the parent directory, then say `ls -ld BASENAME'.
(if full-directory-p
(tramp-send-command
- v
- (format "%s %s %s 2>/dev/null"
- (tramp-get-ls-command v)
- switches
- (if wildcard
- localname
- (tramp-shell-quote-argument (concat localname ".")))))
+ v (format "%s %s %s 2>%s"
+ (tramp-get-ls-command v)
+ switches
+ (if wildcard
+ localname
+ (tramp-shell-quote-argument (concat localname ".")))
+ (tramp-get-remote-null-device v)))
(tramp-barf-unless-okay
- v
- (format "cd %s" (tramp-shell-quote-argument
- (tramp-run-real-handler
- #'file-name-directory (list localname))))
+ v (format "cd %s" (tramp-shell-quote-argument
+ (tramp-run-real-handler
+ #'file-name-directory (list localname))))
"Couldn't `cd %s'"
(tramp-shell-quote-argument
(tramp-run-real-handler #'file-name-directory (list localname))))
(tramp-send-command
- v
- (format "%s %s %s 2>/dev/null"
- (tramp-get-ls-command v)
- switches
- (if (or wildcard
- (zerop (length
- (tramp-run-real-handler
- #'file-name-nondirectory (list localname)))))
- ""
- (tramp-shell-quote-argument
- (tramp-run-real-handler
- #'file-name-nondirectory (list localname)))))))
-
- (save-restriction
- (let ((beg (point)))
- (narrow-to-region (point) (point))
- ;; We cannot use `insert-buffer-substring' because the Tramp
- ;; buffer changes its contents before insertion due to calling
- ;; `expand-file-name' and alike.
- (insert
- (with-current-buffer (tramp-get-buffer v)
- (buffer-string)))
-
+ v (format "%s %s %s 2>%s"
+ (tramp-get-ls-command v)
+ switches
+ (if (or wildcard
+ (zerop (length
+ (tramp-run-real-handler
+ #'file-name-nondirectory (list localname)))))
+ ""
+ (tramp-shell-quote-argument
+ (tramp-run-real-handler
+ #'file-name-nondirectory (list localname))))
+ (tramp-get-remote-null-device v))))
+
+ (let ((beg-marker (copy-marker (point) nil))
+ (end-marker (copy-marker (point) t))
+ (emc enable-multibyte-characters))
+ ;; We cannot use `insert-buffer-substring' because the Tramp
+ ;; buffer changes its contents before insertion due to calling
+ ;; `expand-file-name' and alike.
+ (insert (with-current-buffer (tramp-get-buffer v) (buffer-string)))
+
+ ;; We must enable unibyte strings, because the "--dired"
+ ;; output counts in bytes.
+ (set-buffer-multibyte nil)
+ (save-restriction
+ (narrow-to-region beg-marker end-marker)
;; Check for "--dired" output.
(forward-line -2)
(when (looking-at-p "//SUBDIRED//")
(forward-line -1))
(when (looking-at "//DIRED//\\s-+")
- (let ((databeg (match-end 0))
+ (let ((beg (match-end 0))
(end (point-at-eol)))
;; Now read the numeric positions of file names.
- (goto-char databeg)
+ (goto-char beg)
(while (< (point) end)
- (let ((start (+ beg (read (current-buffer))))
- (end (+ beg (read (current-buffer)))))
+ (let ((start (+ (point-min) (read (current-buffer))))
+ (end (+ (point-min) (read (current-buffer)))))
(if (memq (char-after end) '(?\n ?\ ))
;; End is followed by \n or by " -> ".
(put-text-property start end 'dired-filename t))))))
@@ -2680,31 +2704,58 @@ The method used must be an out-of-band method."
(goto-char (point-at-bol))
(while (looking-at "//")
(forward-line 1)
- (delete-region (match-beginning 0) (point)))
+ (delete-region (match-beginning 0) (point))))
+ ;; Reset multibyte if needed.
+ (set-buffer-multibyte emc)
+ (save-restriction
+ (narrow-to-region beg-marker end-marker)
;; Some busyboxes are reluctant to discard colors.
(unless
(string-match-p "color" (tramp-get-connection-property v "ls" ""))
- (goto-char beg)
- (while
- (re-search-forward tramp-display-escape-sequence-regexp nil t)
+ (goto-char (point-min))
+ (while (re-search-forward tramp-display-escape-sequence-regexp nil t)
(replace-match "")))
- ;; Decode the output, it could be multibyte.
- (decode-coding-region
- beg (point-max)
- (or file-name-coding-system default-file-name-coding-system))
+ ;; Now decode what read if necessary. Stolen from `insert-directory'.
+ (let ((coding (or coding-system-for-read
+ file-name-coding-system
+ default-file-name-coding-system
+ 'undecided))
+ coding-no-eol
+ val pos)
+ (when (and enable-multibyte-characters
+ (not (memq (coding-system-base coding)
+ '(raw-text no-conversion))))
+ ;; If no coding system is specified or detection is
+ ;; requested, detect the coding.
+ (if (eq (coding-system-base coding) 'undecided)
+ (setq coding (detect-coding-region (point-min) (point) t)))
+ (unless (eq (coding-system-base coding) 'undecided)
+ (setq coding-no-eol
+ (coding-system-change-eol-conversion coding 'unix))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (setq pos (point)
+ val (get-text-property (point) 'dired-filename))
+ (goto-char (next-single-property-change
+ (point) 'dired-filename nil (point-max)))
+ ;; Force no eol conversion on a file name, so that
+ ;; CR is preserved.
+ (decode-coding-region
+ pos (point) (if val coding-no-eol coding))
+ (if val (put-text-property pos (point) 'dired-filename t))))))
;; The inserted file could be from somewhere else.
(when (and (not wildcard) (not full-directory-p))
(goto-char (point-max))
(when (file-symlink-p filename)
- (goto-char (search-backward "->" beg 'noerror)))
+ (goto-char (search-backward "->" (point-min) 'noerror)))
(search-backward
(if (directory-name-p filename)
"."
(file-name-nondirectory filename))
- beg 'noerror)
+ (point-min) 'noerror)
(replace-match (file-relative-name filename) t))
;; Try to insert the amount of free space.
@@ -2715,9 +2766,11 @@ The method used must be an out-of-band method."
;; Replace "total" with "total used", to avoid confusion.
(replace-match "\\1 used in directory")
(end-of-line)
- (insert " available " available)))
+ (insert " available " available))))
- (goto-char (point-max)))))))
+ (prog1 (goto-char end-marker)
+ (set-marker beg-marker nil)
+ (set-marker end-marker nil))))))
;; Canonicalization of file names.
@@ -2786,9 +2839,9 @@ the result will be a local, non-Tramp, file name."
;; terminated.
(defun tramp-sh-handle-make-process (&rest args)
"Like `make-process' for Tramp files.
-STDERR can also be a file name. If connection property
-\"direct-async-process\" is non-nil, an alternative
-implementation will be used."
+STDERR can also be a file name. If method parameter `tramp-direct-async'
+and connection property \"direct-async-process\" are non-nil, an
+alternative implementation will be used."
(if (tramp-direct-async-process-p args)
(apply #'tramp-handle-make-process args)
(when args
@@ -2821,7 +2874,7 @@ implementation will be used."
(unless (or (null sentinel) (functionp sentinel))
(signal 'wrong-type-argument (list #'functionp sentinel)))
(unless (or (null stderr) (bufferp stderr) (stringp stderr))
- (signal 'wrong-type-argument (list #'stringp stderr)))
+ (signal 'wrong-type-argument (list #'bufferp stderr)))
(when (and (stringp stderr) (tramp-tramp-file-p stderr)
(not (tramp-equal-remote default-directory stderr)))
(signal 'file-error (list "Wrong stderr" stderr)))
@@ -2894,7 +2947,8 @@ implementation will be used."
(mapconcat
#'tramp-shell-quote-argument uenv " "))
"")
- (if heredoc (format "<<'%s'" tramp-end-of-heredoc) "")
+ (if heredoc
+ (format "<<'%s'" tramp-end-of-heredoc) "")
(if tmpstderr (format "2>'%s'" tmpstderr) "")
(mapconcat #'tramp-shell-quote-argument env " ")
(if heredoc
@@ -2934,7 +2988,11 @@ implementation will be used."
;; `verify-visited-file-modtime'.
(let ((buffer-undo-list t)
(inhibit-read-only t)
- (mark (point-max)))
+ (mark (point-max))
+ (coding-system-for-write
+ (if (symbolp coding) coding (car coding)))
+ (coding-system-for-read
+ (if (symbolp coding) coding (cdr coding))))
(clear-visited-file-modtime)
(narrow-to-region (point-max) (point-max))
;; We call `tramp-maybe-open-connection', in
@@ -3111,7 +3169,7 @@ implementation will be used."
(mapconcat #'tramp-shell-quote-argument uenv " ") command)))
;; Determine input.
(if (null infile)
- (setq input "/dev/null")
+ (setq input (tramp-get-remote-null-device v))
(setq infile (expand-file-name infile))
(if (tramp-equal-remote default-directory infile)
;; INFILE is on the same remote host.
@@ -3153,7 +3211,7 @@ implementation will be used."
tmpstderr (tramp-make-tramp-file-name v stderr 'nohop))))
;; stderr to be discarded.
((null (cadr destination))
- (setq stderr "/dev/null"))))
+ (setq stderr (tramp-get-remote-null-device v)))))
;; 't
(destination
(setq outbuf (current-buffer))))
@@ -3256,7 +3314,9 @@ implementation will be used."
;; correctly. Unset `file-name-handler-alist'.
;; Otherwise, epa-file gets confused.
(let (file-name-handler-alist
- (coding-system-for-write 'binary))
+ (coding-system-for-write 'binary)
+ (default-directory
+ (tramp-compat-temporary-file-directory)))
(with-temp-file tmpfile
(set-buffer-multibyte nil)
(insert-buffer-substring (tramp-get-buffer v))
@@ -3510,7 +3570,7 @@ implementation will be used."
;; Make `last-coding-system-used' have the right value.
(when coding-system-used
- (set 'last-coding-system-used coding-system-used))))
+ (setq last-coding-system-used coding-system-used))))
(tramp-flush-file-properties v localname)
@@ -3524,7 +3584,8 @@ implementation will be used."
;; We must pass modtime explicitly, because FILENAME can
;; be different from (buffer-file-name), f.e. if
;; `file-precious-flag' is set.
- (tramp-compat-file-attribute-modification-time file-attr))
+ (or (tramp-compat-file-attribute-modification-time file-attr)
+ (current-time)))
(when (and (= (tramp-compat-file-attribute-user-id file-attr) uid)
(= (tramp-compat-file-attribute-group-id file-attr) gid))
(setq need-chown nil))))
@@ -3723,7 +3784,7 @@ Fall back to normal file name handler if no Tramp handler exists."
;; Make events a list of symbols.
events
(mapcar
- (lambda (x) (intern-soft (replace-regexp-in-string "_" "-" x)))
+ (lambda (x) (intern-soft (tramp-compat-string-replace "_" "-" x)))
(split-string events "," 'omit))))
;; "gio monitor".
((setq command (tramp-get-remote-gio-monitor v))
@@ -3781,6 +3842,10 @@ Fall back to normal file name handler if no Tramp handler exists."
(unless (process-live-p p)
(tramp-error
p 'file-notify-error "Monitoring not supported for `%s'" file-name))
+ ;; Set "gio-file-monitor" property if needed.
+ (when (string-equal (file-name-nondirectory command) "gio")
+ (tramp-set-connection-property
+ p "gio-file-monitor" (tramp-get-remote-gio-file-monitor v)))
p))))
(defun tramp-sh-gio-monitor-process-filter (proc string)
@@ -3795,11 +3860,11 @@ Fall back to normal file name handler if no Tramp handler exists."
(tramp-message proc 6 "%S\n%s" proc string)
(setq string (concat rest-string string)
;; Fix action names.
- string (replace-regexp-in-string
+ string (tramp-compat-string-replace
"attributes changed" "attribute-changed" string)
- string (replace-regexp-in-string
+ string (tramp-compat-string-replace
"changes done" "changes-done-hint" string)
- string (replace-regexp-in-string
+ string (tramp-compat-string-replace
"renamed to" "moved" string))
;; https://bugs.launchpad.net/bugs/1742946
(when
@@ -3807,7 +3872,7 @@ Fall back to normal file name handler if no Tramp handler exists."
(delete-process proc))
;; Delete empty lines.
- (setq string (replace-regexp-in-string "\n\n" "\n" string))
+ (setq string (tramp-compat-string-replace "\n\n" "\n" string))
(while (string-match
(eval-when-compile
@@ -3855,7 +3920,7 @@ Fall back to normal file name handler if no Tramp handler exists."
(tramp-message proc 6 "%S\n%s" proc string)
(setq string (concat rest-string string)
;; Attribute change is returned in unused wording.
- string (replace-regexp-in-string
+ string (tramp-compat-string-replace
"ATTRIB CHANGED" "ATTRIBUTE_CHANGED" string))
(while (string-match
@@ -3872,7 +3937,7 @@ Fall back to normal file name handler if no Tramp handler exists."
proc
(list
(intern-soft
- (replace-regexp-in-string
+ (tramp-compat-string-replace
"_" "-" (downcase (match-string 4 string)))))
;; File names are returned as absolute paths. We must
;; add the remote prefix.
@@ -3911,7 +3976,7 @@ Fall back to normal file name handler if no Tramp handler exists."
(mapcar
(lambda (x)
(intern-soft
- (replace-regexp-in-string "_" "-" (downcase x))))
+ (tramp-compat-string-replace "_" "-" (downcase x))))
(split-string (match-string 1 line) "," 'omit))
(or (match-string 3 line)
(file-name-nondirectory (process-get proc 'watch-name))))))
@@ -3953,6 +4018,51 @@ Fall back to normal file name handler if no Tramp handler exists."
;;; Internal Functions:
+(defun tramp-expand-script (vec script)
+ "Expand SCRIPT with remote files or commands.
+\"%a\", \"%h\", \"%o\" and \"%p\" format specifiers are replaced
+by the respective `awk', `hexdump', `od' and `perl' commands.
+\"%n\" is replaced by \"2>/dev/null\", and \"%t\" is replaced by
+a temporary file name.
+If VEC is nil, the respective local commands are used.
+If there is a format specifier which cannot be expanded, this
+function returns nil."
+ (if (not (string-match-p "\\(^\\|[^%]\\)%[ahnopt]" script))
+ script
+ (catch 'wont-work
+ (let ((awk (when (string-match-p "\\(^\\|[^%]\\)%a" script)
+ (or
+ (if vec (tramp-get-remote-awk vec) (executable-find "awk"))
+ (throw 'wont-work nil))))
+ (hdmp (when (string-match-p "\\(^\\|[^%]\\)%h" script)
+ (or
+ (if vec (tramp-get-remote-hexdump vec)
+ (executable-find "hexdump"))
+ (throw 'wont-work nil))))
+ (dev (when (string-match-p "\\(^\\|[^%]\\)%n" script)
+ (or
+ (if vec (concat "2>" (tramp-get-remote-null-device vec))
+ (if (eq system-type 'windows-nt) ""
+ (concat "2>" null-device)))
+ (throw 'wont-work nil))))
+ (od (when (string-match-p "\\(^\\|[^%]\\)%o" script)
+ (or (if vec (tramp-get-remote-od vec) (executable-find "od"))
+ (throw 'wont-work nil))))
+ (perl (when (string-match-p "\\(^\\|[^%]\\)%p" script)
+ (or
+ (if vec
+ (tramp-get-remote-perl vec) (executable-find "perl"))
+ (throw 'wont-work nil))))
+ (tmp (when (string-match-p "\\(^\\|[^%]\\)%t" script)
+ (or
+ (if vec
+ (tramp-file-local-name (tramp-make-tramp-temp-name vec))
+ (tramp-compat-make-temp-name))
+ (throw 'wont-work nil)))))
+ (format-spec
+ script
+ (format-spec-make ?a awk ?h hdmp ?n dev ?o od ?p perl ?t tmp))))))
+
(defun tramp-maybe-send-script (vec script name)
"Define in remote shell function NAME implemented as SCRIPT.
Only send the definition if it has not already been done."
@@ -3965,16 +4075,17 @@ Only send the definition if it has not already been done."
vec 5 (format-message "Sending script `%s'" name)
;; In bash, leading TABs like in `tramp-vc-registered-read-file-names'
;; could result in unwanted command expansion. Avoid this.
- (setq script (replace-regexp-in-string
+ (setq script (tramp-compat-string-replace
(make-string 1 ?\t) (make-string 8 ? ) script))
- ;; The script could contain a call of Perl. This is masked with `%s'.
- (when (and (string-match-p "%s" script)
- (not (tramp-get-remote-perl vec)))
- (tramp-error vec 'file-error "No Perl available on remote host"))
+ ;; Expand format specifiers.
+ (unless (setq script (tramp-expand-script vec script))
+ (tramp-error
+ vec 'file-error
+ (format "Script %s is not applicable on remote host" name)))
+ ;; Send it.
(tramp-barf-unless-okay
vec
- (format "%s () {\n%s\n}"
- name (format script (tramp-get-remote-perl vec)))
+ (format "%s () {\n%s\n}" name script)
"Script %s sending failed" name)
(tramp-set-connection-property
(tramp-get-connection-process vec) "scripts" (cons name scripts))))))
@@ -4081,7 +4192,10 @@ variable PATH."
(pipe-buf
(with-tramp-connection-property vec "pipe-buf"
(tramp-send-command-and-read
- vec "getconf PIPE_BUF / 2>/dev/null || echo 4096" 'noerror)))
+ vec
+ (format "getconf PIPE_BUF / 2>%s || echo 4096"
+ (tramp-get-remote-null-device vec))
+ 'noerror)))
tmpfile chunk chunksize)
(tramp-message vec 5 "Setting $PATH environment variable")
(if (< (length command) pipe-buf)
@@ -4191,11 +4305,14 @@ file exists and nonzero exit status otherwise."
;; ensure they have the correct values when the shell starts, not
;; just processes run within the shell. (Which processes include
;; our initial probes to ensure the remote shell is usable.)
+ ;; For the time being, we assume that all shells interpret -i as
+ ;; interactive shell. Must be the last argument, because (for
+ ;; example) bash expects long options first.
(tramp-send-command
vec (format
(concat
"exec env TERM='%s' INSIDE_EMACS='%s,tramp:%s' "
- "ENV=%s %s PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s")
+ "ENV=%s %s PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s -i")
tramp-terminal-type
(or (getenv "INSIDE_EMACS") emacs-version) tramp-version
(or (getenv-internal "ENV" tramp-remote-process-environment) "")
@@ -4403,7 +4520,12 @@ process to set up. VEC specifies the connection."
(tramp-find-shell vec)
;; Disable unexpected output.
- (tramp-send-command vec "mesg n 2>/dev/null; biff n 2>/dev/null" t)
+ (tramp-send-command
+ vec
+ (format "mesg n 2>%s; biff n 2>%s"
+ (tramp-get-remote-null-device vec)
+ (tramp-get-remote-null-device vec))
+ t)
;; IRIX64 bash expands "!" even when in single quotes. This
;; destroys our shell functions, we must disable it. See
@@ -4418,7 +4540,8 @@ process to set up. VEC specifies the connection."
;; Set utf8 encoding. Needed for macOS, for example. This is
;; non-POSIX, so we must expect errors on some systems.
- (tramp-send-command vec "stty iutf8 2>/dev/null" t)
+ (tramp-send-command
+ vec (concat "stty iutf8 2>" (tramp-get-remote-null-device vec)) t)
;; Set `remote-tty' process property.
(let ((tty (tramp-send-command-and-read vec "echo \\\"`tty`\\\"" 'noerror)))
@@ -4473,7 +4596,7 @@ process to set up. VEC specifies the connection."
(defconst tramp-local-coding-commands
`((b64 base64-encode-region base64-decode-region)
(uu tramp-uuencode-region uudecode-decode-region)
- (pack ,(format tramp-perl-pack "perl") ,(format tramp-perl-unpack "perl")))
+ (pack ,tramp-perl-pack ,tramp-perl-unpack))
"List of local coding commands for inline transfer.
Each item is a list that looks like this:
@@ -4534,7 +4657,8 @@ program will be transferred to the remote host, and it is
available as shell function with the same name. A \"%t\" format
specifier in the variable value denotes a temporary file.
\"%a\", \"%h\" and \"%o\" format specifiers are replaced by the
-respective `awk', `hexdump' and `od' commands.
+respective `awk', `hexdump' and `od' commands. \"%n\" is
+replaced by \"2>/dev/null\".
The optional TEST command can be used for further tests, whether
ENCODING and DECODING are applicable.")
@@ -4562,6 +4686,8 @@ Goes through the list `tramp-local-coding-commands' and
vec 5 "Checking local encoding function `%s'" loc-enc)
(tramp-message
vec 5 "Checking local encoding command `%s' for sanity" loc-enc)
+ (unless (stringp (setq loc-enc (tramp-expand-script nil loc-enc)))
+ (throw 'wont-work-local nil))
(unless (zerop (tramp-call-local-coding-command loc-enc nil nil))
(throw 'wont-work-local nil)))
(if (not (stringp loc-dec))
@@ -4569,6 +4695,8 @@ Goes through the list `tramp-local-coding-commands' and
vec 5 "Checking local decoding function `%s'" loc-dec)
(tramp-message
vec 5 "Checking local decoding command `%s' for sanity" loc-dec)
+ (unless (stringp (setq loc-dec (tramp-expand-script nil loc-dec)))
+ (throw 'wont-work-local nil))
(unless (zerop (tramp-call-local-coding-command loc-dec nil nil))
(throw 'wont-work-local nil)))
;; Search for remote coding commands with the same format
@@ -4596,64 +4724,25 @@ Goes through the list `tramp-local-coding-commands' and
(unless (stringp rem-enc)
(let ((name (symbol-name rem-enc))
(value (symbol-value rem-enc)))
- ;; Check if remote perl exists when necessary.
- (and (string-match-p "perl" name)
- (not (tramp-get-remote-perl vec))
- (throw 'wont-work-remote nil))
- ;; Check if remote awk exists when necessary.
- (and (string-match-p "\\(^\\|[^%]\\)%a" value)
- (not (tramp-get-remote-awk vec))
- (throw 'wont-work-remote nil))
- ;; Check if remote hexdump exists when necessary.
- (and (string-match-p "\\(^\\|[^%]\\)%h" value)
- (not (tramp-get-remote-hexdump vec))
- (throw 'wont-work-remote nil))
- ;; Check if remote od exists when necessary.
- (and (string-match-p "\\(^\\|[^%]\\)%o" value)
- (not (tramp-get-remote-od vec))
- (throw 'wont-work-remote nil))
(while (string-match "-" name)
(setq name (replace-match "_" nil t name)))
- (when (string-match-p "\\(^\\|[^%]\\)%[aho]" value)
- (setq value
- (format-spec
- value
- (format-spec-make
- ?a (tramp-get-remote-awk vec)
- ?h (tramp-get-remote-hexdump vec)
- ?o (tramp-get-remote-od vec)))
- value (replace-regexp-in-string "%" "%%" value)))
(tramp-maybe-send-script vec value name)
(setq rem-enc name)))
(tramp-message
vec 5
"Checking remote encoding command `%s' for sanity" rem-enc)
(unless (tramp-send-command-and-check
- vec (format "%s </dev/null" rem-enc) t)
+ vec
+ (format
+ "%s <%s" rem-enc (tramp-get-remote-null-device vec))
+ t)
(throw 'wont-work-remote nil))
(unless (stringp rem-dec)
(let ((name (symbol-name rem-dec))
- (value (symbol-value rem-dec))
- tmpfile)
+ (value (symbol-value rem-dec)))
(while (string-match "-" name)
(setq name (replace-match "_" nil t name)))
- (when (string-match-p "\\(^\\|[^%]\\)%[aho]" value)
- (setq value
- (format-spec
- value
- (format-spec-make
- ?a (tramp-get-remote-awk vec)
- ?h (tramp-get-remote-hexdump vec)
- ?o (tramp-get-remote-od vec)))
- value (replace-regexp-in-string "%" "%%" value)))
- (when (string-match-p "\\(^\\|[^%]\\)%t" value)
- (setq tmpfile (tramp-make-tramp-temp-name vec)
- value
- (format-spec
- value
- (format-spec-make
- ?t (tramp-file-local-name tmpfile)))))
(tramp-maybe-send-script vec value name)
(setq rem-dec name)))
(tramp-message
@@ -4691,7 +4780,7 @@ Goes through the list `tramp-local-coding-commands' and
"Call the local encoding or decoding command.
If CMD contains \"%s\", provide input file INPUT there in command.
Otherwise, INPUT is passed via standard input.
-INPUT can also be nil which means `/dev/null'.
+INPUT can also be nil which means `null-device'.
OUTPUT can be a string (which specifies a file name), or t (which
means standard output and thus the current buffer), or nil (which
means discard it)."
@@ -4836,7 +4925,8 @@ Goes through the list `tramp-inline-compress-commands'."
(defun tramp-timeout-session (vec)
"Close the connection VEC after a session timeout.
If there is just some editing, retry it after 5 seconds."
- (if (and tramp-locked tramp-locker
+ (if (and (tramp-get-connection-property
+ (tramp-get-connection-process vec) "locked" nil)
(tramp-file-name-equal-p vec (car tramp-current-connection)))
(progn
(tramp-message
@@ -4921,7 +5011,7 @@ connection if a previous connection has died for some reason."
(setenv "PS1" tramp-initial-end-of-output)
(unless (stringp tramp-encoding-shell)
(tramp-error vec 'file-error "`tramp-encoding-shell' not set"))
- (let* ((current-host (system-name))
+ (let* ((current-host tramp-system-name)
(target-alist (tramp-compute-multi-hops vec))
;; We will apply `tramp-ssh-controlmaster-options'
;; only for the first hop.
@@ -4956,6 +5046,9 @@ connection if a previous connection has died for some reason."
(tramp-message vec 6 "%s" (string-join (process-command p) " "))
+ ;; Set connection-local variables.
+ (tramp-set-connection-local-variables vec)
+
;; Check whether process is alive.
(tramp-barf-if-no-shell-prompt
p 10
@@ -5065,9 +5158,6 @@ connection if a previous connection has died for some reason."
(setq options ""
target-alist (cdr target-alist)))
- ;; Set connection-local variables.
- (tramp-set-connection-local-variables vec)
-
;; Activate session timeout.
(when (tramp-get-connection-property p "session-timeout" nil)
(run-at-time
@@ -5163,14 +5253,17 @@ status is 0, and nil otherwise.
If the optional argument SUBSHELL is non-nil, the command is
executed in a subshell, ie surrounded by parentheses. If
-DONT-SUPPRESS-ERR is non-nil, stderr won't be sent to /dev/null.
+DONT-SUPPRESS-ERR is non-nil, stderr won't be sent to \"/dev/null\".
Optional argument EXIT-STATUS, if non-nil, triggers the return of
the exit status."
(tramp-send-command
vec
(concat (if subshell "( " "")
command
- (if command (if dont-suppress-err "; " " 2>/dev/null; ") "")
+ (if command
+ (if dont-suppress-err
+ "; " (format " 2>%s; " (tramp-get-remote-null-device vec)))
+ "")
"echo tramp_exit_status $?"
(if subshell " )" "")))
(with-current-buffer (tramp-get-connection-buffer vec)
@@ -5380,7 +5473,11 @@ Nonexistent directories are removed from spec."
(when elt1
(or
(tramp-send-command-and-read
- vec "echo \\\"`getconf PATH 2>/dev/null`\\\"" 'noerror)
+ vec
+ (format
+ "echo \\\"`getconf PATH 2>%s`\\\""
+ (tramp-get-remote-null-device vec))
+ 'noerror)
;; Default if "getconf" is not available.
(progn
(tramp-message
@@ -5484,7 +5581,8 @@ Nonexistent directories are removed from spec."
vec (format "%s -lnd /" result))
(when (tramp-send-command-and-check
vec (format
- "%s --color=never -al /dev/null" result))
+ "%s --color=never -al %s"
+ result (tramp-get-remote-null-device vec)))
(setq result (concat result " --color=never")))
(throw 'ls-found result))
(setq dl (cdr dl))))))
@@ -5505,7 +5603,9 @@ Nonexistent directories are removed from spec."
(format
"%s --help 2>&1 | grep -iq busybox" (tramp-get-ls-command vec))))
(tramp-send-command-and-check
- vec (format "%s %s -al /dev/null" (tramp-get-ls-command vec) option))
+ vec (format
+ "%s %s -al %s"
+ (tramp-get-ls-command vec) option (tramp-get-remote-null-device vec)))
option)))
(defun tramp-get-test-command (vec)
@@ -5669,6 +5769,30 @@ This command is returned only if `delete-by-moving-to-trash' is non-nil."
(tramp-message vec 5 "Finding a suitable `gio-monitor' command")
(tramp-find-executable vec "gio" (tramp-get-remote-path vec) t t)))
+(defun tramp-get-remote-gio-file-monitor (vec)
+ "Determine remote GFileMonitor."
+ (with-tramp-connection-property vec "gio-file-monitor"
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (tramp-message vec 5 "Finding the used GFileMonitor")
+ (when-let ((gio (tramp-get-remote-gio-monitor vec)))
+ ;; Search for the used FileMonitor. There is no known way to
+ ;; get this information directly from gio, so we check for
+ ;; linked libraries of libgio.
+ (when (tramp-send-command-and-check vec (concat "ldd " gio))
+ (goto-char (point-min))
+ (when (re-search-forward "\\S-+/libgio\\S-+")
+ (when (tramp-send-command-and-check
+ vec (concat "strings " (match-string 0)))
+ (goto-char (point-min))
+ (re-search-forward
+ (format
+ "^%s$"
+ (regexp-opt
+ '("GFamFileMonitor" "GFenFileMonitor"
+ "GInotifyFileMonitor" "GKqueueFileMonitor")))
+ nil 'noerror)
+ (intern (match-string 0)))))))))
+
(defun tramp-get-remote-gvfs-monitor-dir (vec)
"Determine remote `gvfs-monitor-dir' command."
(with-tramp-connection-property vec "gvfs-monitor-dir"
@@ -5784,7 +5908,7 @@ This command is returned only if `delete-by-moving-to-trash' is non-nil."
(command (format "%s %s" busybox "awk")))
(and busybox
(tramp-send-command-and-check
- vec (concat command " {} </dev/null"))
+ vec (concat command " {} <" (tramp-get-remote-null-device vec)))
command)))))
(defun tramp-get-remote-hexdump (vec)
@@ -5795,7 +5919,8 @@ This command is returned only if `delete-by-moving-to-trash' is non-nil."
(let* ((busybox (tramp-get-remote-busybox vec))
(command (format "%s %s" busybox "hexdump")))
(and busybox
- (tramp-send-command-and-check vec (concat command " </dev/null"))
+ (tramp-send-command-and-check
+ vec (concat command " <" (tramp-get-remote-null-device vec)))
command)))))
(defun tramp-get-remote-od (vec)
@@ -5807,7 +5932,8 @@ This command is returned only if `delete-by-moving-to-trash' is non-nil."
(command (format "%s %s" busybox "od")))
(and busybox
(tramp-send-command-and-check
- vec (concat command " -A n </dev/null"))
+ vec
+ (concat command " -A n <" (tramp-get-remote-null-device vec)))
command)))))
(defun tramp-get-remote-chmod-h (vec)
@@ -5829,7 +5955,9 @@ This command is returned only if `delete-by-moving-to-trash' is non-nil."
(tramp-message vec 5 "Checking, whether `env -u' works")
;; Option "-u" is a GNU extension.
(tramp-send-command-and-check
- vec "env FOO=foo env -u FOO 2>/dev/null | grep -qv FOO" t)))
+ vec (format "env FOO=foo env -u FOO 2>%s | grep -qv FOO"
+ (tramp-get-remote-null-device vec))
+ t)))
;; Some predefined connection properties.
(defun tramp-get-inline-compress (vec prop size)
@@ -6021,4 +6149,9 @@ function cell is returned to be applied on a buffer."
;;
;; * Implement `:stderr' of `make-process' as pipe process.
+;; * One interesting solution (with other applications as well) would
+;; be to stipulate, as a directory or connection-local variable, an
+;; additional rc file on the remote machine that is sourced every
+;; time Tramp connects. <https://emacs.stackexchange.com/questions/62306>
+
;;; tramp-sh.el ends here
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index c236e1cb65f..1604e8962c0 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -1,6 +1,6 @@
;;; tramp-smb.el --- Tramp access functions for SMB servers -*- lexical-binding:t -*-
-;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
@@ -74,7 +74,7 @@
:version "24.4")
;;;###tramp-autoload
-(defcustom tramp-smb-conf "/dev/null"
+(defcustom tramp-smb-conf null-device
"Path of the \"smb.conf\" file.
If it is nil, no \"smb.conf\" will be added to the `tramp-smb-program'
call, letting the SMB client use the default one."
@@ -464,8 +464,8 @@ pass to the OPERATION."
(let* ((share (tramp-smb-get-share v))
(localname (file-name-as-directory
- (replace-regexp-in-string
- "\\\\" "/" (tramp-smb-get-localname v))))
+ (tramp-compat-string-replace
+ "\\" "/" (tramp-smb-get-localname v))))
(tmpdir (tramp-compat-make-temp-name))
(args (list (concat "//" host "/" share) "-E"))
(options tramp-smb-options))
@@ -689,7 +689,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(tramp-error v 'file-error "%s `%s'" (match-string 0) filename)))))))
(defun tramp-smb-handle-directory-files
- (directory &optional full match nosort)
+ (directory &optional full match nosort count)
"Like `directory-files' for Tramp files."
(unless (file-exists-p directory)
(tramp-error
@@ -703,14 +703,22 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(delete nil
(mapcar (lambda (x) (when (string-match-p match x) x))
result))))
+
+ ;; Sort them if necessary.
+ (unless nosort
+ (setq result (sort result #'string-lessp)))
+
+ ;; Return count number of results.
+ (when (and (natnump count) (> count 0))
+ (setq result (nbutlast result (- (length result) count))))
+
;; Prepend directory.
(when full
(setq result
(mapcar
(lambda (x) (format "%s/%s" (directory-file-name directory) x))
result)))
- ;; Sort them if necessary.
- (unless nosort (setq result (sort result #'string-lessp)))
+
result))
(defun tramp-smb-handle-expand-file-name (name &optional dir)
@@ -769,8 +777,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(with-tramp-file-property v localname "file-acl"
(when (executable-find tramp-smb-acl-program)
(let* ((share (tramp-smb-get-share v))
- (localname (replace-regexp-in-string
- "\\\\" "/" (tramp-smb-get-localname v)))
+ (localname (tramp-compat-string-replace
+ "\\" "/" (tramp-smb-get-localname v)))
(args (list (concat "//" host "/" share) "-E"))
(options tramp-smb-options))
@@ -789,7 +797,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(setq
args
(append args (list (tramp-unquote-shell-quote-argument localname)
- "2>/dev/null")))
+ (concat "2>" (tramp-get-remote-null-device v)))))
(unwind-protect
(with-temp-buffer
@@ -1437,10 +1445,10 @@ component is used as the target of the symlink."
(when (and (stringp acl-string) (executable-find tramp-smb-acl-program))
(let* ((share (tramp-smb-get-share v))
- (localname (replace-regexp-in-string
- "\\\\" "/" (tramp-smb-get-localname v)))
+ (localname (tramp-compat-string-replace
+ "\\" "/" (tramp-smb-get-localname v)))
(args (list (concat "//" host "/" share) "-E" "-S"
- (replace-regexp-in-string
+ (tramp-compat-string-replace
"\n" "," acl-string)))
(options tramp-smb-options))
@@ -1622,8 +1630,9 @@ errors for shares like \"C$/\", which are common in Microsoft Windows."
;; Set file modification time.
(when (or (eq visit t) (stringp visit))
(set-visited-file-modtime
- (tramp-compat-file-attribute-modification-time
- (file-attributes filename))))
+ (or (tramp-compat-file-attribute-modification-time
+ (file-attributes filename))
+ (current-time))))
;; The end.
(when (and (null noninteractive)
@@ -2031,6 +2040,9 @@ If ARGUMENT is non-nil, use it as argument for
(process-put p 'adjust-window-size-function #'ignore)
(set-process-query-on-exit-flag p nil)
+ ;; Set connection-local variables.
+ (tramp-set-connection-local-variables vec)
+
(condition-case err
(let ((inhibit-message t))
;; Play login scenario.
@@ -2064,9 +2076,6 @@ If ARGUMENT is non-nil, use it as argument for
(tramp-set-connection-property p "smb-share" share)
(tramp-set-connection-property p "chunksize" 1)
- ;; Set connection-local variables.
- (tramp-set-connection-local-variables vec)
-
;; Mark it as connected.
(tramp-set-connection-property p "connected" t))
@@ -2138,8 +2147,7 @@ Removes smb prompt. Returns nil if an error message has appeared."
"%s %s"
tramp-smb-winexe-shell-command tramp-smb-winexe-shell-command-switch))
- (set (make-local-variable 'kill-buffer-hook)
- '(tramp-smb-kill-winexe-function))
+ (add-hook 'kill-buffer-hook #'tramp-smb-kill-winexe-function nil t)
;; Suppress "^M". Shouldn't we specify utf8?
(set-process-coding-system (tramp-get-connection-process vec) 'raw-text-dos)
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index 558a57b2ead..5bb1546d08b 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -1,6 +1,6 @@
;;; tramp-sudoedit.el --- Functions for accessing under root permissions -*- lexical-binding:t -*-
-;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2018-2021 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
diff --git a/lisp/net/tramp-uu.el b/lisp/net/tramp-uu.el
index f368f72a8dc..5171b9d1819 100644
--- a/lisp/net/tramp-uu.el
+++ b/lisp/net/tramp-uu.el
@@ -1,6 +1,6 @@
;;; tramp-uu.el --- uuencode in Lisp -*- lexical-binding:t -*-
-;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Author: Kai Großjohann <kai.grossjohann@gmx.net>
;; Maintainer: Michael Albinus <michael.albinus@gmx.de>
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index f3966479dbf..2816c58fe7f 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -1,16 +1,12 @@
;;; tramp.el --- Transparent Remote Access, Multiple Protocol -*- lexical-binding:t -*-
-;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: Kai Großjohann <kai.grossjohann@gmx.net>
;; Michael Albinus <michael.albinus@gmx.de>
;; Maintainer: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
;; Package: tramp
-;; Version: 2.5.0-pre
-;; Package-Requires: ((emacs "25.1"))
-;; Package-Type: multi
-;; URL: https://savannah.gnu.org/projects/tramp
;; This file is part of GNU Emacs.
@@ -112,6 +108,13 @@ Any level x includes messages for all levels 1 .. x-1. The levels are
10 traces (huge)."
:type 'integer)
+(defcustom tramp-debug-to-file nil
+ "Whether Tramp debug messages shall be saved to file.
+The debug file has the same name as the debug buffer, written to
+`temporary-file-directory'."
+ :version "28.1"
+ :type 'boolean)
+
(defcustom tramp-backup-directory-alist nil
"Alist of filename patterns and backup directory names.
Each element looks like (REGEXP . DIRECTORY), with the same meaning like
@@ -175,6 +178,12 @@ See the variable `tramp-encoding-shell' for more information."
:version "24.1"
:type '(choice (const nil) string))
+;; Since Emacs 26.1, `system-name' can return `nil' at build time if
+;; Emacs is compiled with "--no-build-details". We do expect it to be
+;; a string. (Bug#44481)
+(defconst tramp-system-name (or (system-name) "")
+ "The system name Tramp is running locally.")
+
(defvar tramp-methods nil
"Alist of methods for remote files.
This is a list of entries of the form (NAME PARAM1 PARAM2 ...).
@@ -238,6 +247,7 @@ pair of the form (KEY VALUE). The following KEYs are defined:
- \"%k\" indicates the keep-date parameter of a program, if exists.
- \"%c\" adds additional `tramp-ssh-controlmaster-options'
options for the first hop.
+ - \"%n\" expands to \"2>/dev/null\".
The existence of `tramp-login-args', combined with the
absence of `tramp-copy-args', is an indication that the
@@ -249,9 +259,9 @@ pair of the form (KEY VALUE). The following KEYs are defined:
parameters to suppress diagnostic messages, in order not to
tamper the process output.
- * `tramp-direct-async-args'
- An additional argument when a direct asynchronous process is
- started. Used so far only in the \"mock\" method of tramp-tests.el.
+ * `tramp-direct-async'
+ Whether the method supports direct asynchronous processes.
+ Until now, just \"ssh\"-based and \"adb\"-based methods do.
* `tramp-copy-program'
This specifies the name of the program to use for remotely copying
@@ -416,7 +426,7 @@ empty string for the method name."
(choice :tag " Host regexp" regexp sexp)
(choice :tag " User name" string (const nil)))))
-(defcustom tramp-default-host (system-name)
+(defcustom tramp-default-host tramp-system-name
"Default host to use for transferring files.
Useful for su and sudo methods mostly."
:type 'string)
@@ -471,8 +481,8 @@ interpreted as a regular expression which always matches."
(defcustom tramp-restricted-shell-hosts-alist
(when (memq system-type '(windows-nt))
(list (format "\\`\\(%s\\|%s\\)\\'"
- (regexp-quote (downcase (system-name)))
- (regexp-quote (upcase (system-name))))))
+ (regexp-quote (downcase tramp-system-name))
+ (regexp-quote (upcase tramp-system-name)))))
"List of hosts, which run a restricted shell.
This is a list of regular expressions, which denote hosts running
a restricted shell like \"rbash\". Those hosts can be used as
@@ -485,7 +495,7 @@ host runs a restricted shell, it shall be added to this list, too."
(concat
"\\`"
(regexp-opt
- (list "localhost" "localhost6" (system-name) "127.0.0.1" "::1") t)
+ (list "localhost" "localhost6" tramp-system-name "127.0.0.1" "::1") t)
"\\'")
"Host names which are regarded as local host.
If the local host runs a chrooted environment, set this to nil."
@@ -1008,8 +1018,8 @@ See `tramp-file-name-structure'."
5 6 7 8 1))
(defvar tramp-file-name-structure nil ;Initialized when defining `tramp-syntax'!
- "List of six elements (REGEXP METHOD USER HOST FILE HOP), detailing \
-the Tramp file name structure.
+ "List detailing the Tramp file name structure.
+This is a list of six elements (REGEXP METHOD USER HOST FILE HOP).
The first element REGEXP is a regular expression matching a Tramp file
name. The regex should contain parentheses around the method name,
@@ -1715,8 +1725,7 @@ The outline level is equal to the verbosity of the Tramp message."
(defun tramp-get-debug-buffer (vec)
"Get the debug buffer for VEC."
- (with-current-buffer
- (get-buffer-create (tramp-debug-buffer-name vec))
+ (with-current-buffer (get-buffer-create (tramp-debug-buffer-name vec))
(when (bobp)
(setq buffer-undo-list t)
;; Activate `outline-mode'. This runs `text-mode-hook' and
@@ -1725,67 +1734,84 @@ The outline level is equal to the verbosity of the Tramp message."
;; `(custom-declare-variable outline-minor-mode-prefix ...)'
;; raises on error in `(outline-mode)', we don't want to see it
;; in the traces.
- (let ((default-directory (tramp-compat-temporary-file-directory))
- signal-hook-function)
+ (let ((default-directory (tramp-compat-temporary-file-directory)))
(outline-mode))
- (set (make-local-variable 'outline-level) 'tramp-debug-outline-level)
- (set (make-local-variable 'font-lock-keywords)
- `(t (eval ,tramp-debug-font-lock-keywords)
- ,(eval tramp-debug-font-lock-keywords)))
+ (setq-local outline-level 'tramp-debug-outline-level)
+ (setq-local font-lock-keywords
+ `(t (eval ,tramp-debug-font-lock-keywords)
+ ,(eval tramp-debug-font-lock-keywords)))
;; Do not edit the debug buffer.
(use-local-map special-mode-map))
(current-buffer)))
+(defun tramp-get-debug-file-name (vec)
+ "Get the debug buffer for VEC."
+ (expand-file-name
+ (tramp-compat-string-replace "/" " " (tramp-debug-buffer-name vec))
+ (tramp-compat-temporary-file-directory)))
+
(defsubst tramp-debug-message (vec fmt-string &rest arguments)
"Append message to debug buffer of VEC.
Message is formatted with FMT-STRING as control string and the remaining
ARGUMENTS to actually emit the message (if applicable)."
- (with-current-buffer (tramp-get-debug-buffer vec)
- (goto-char (point-max))
- ;; Headline.
- (when (bobp)
- (insert
- (format
- ";; Emacs: %s Tramp: %s -*- mode: outline; -*-"
- emacs-version tramp-version))
- (when (>= tramp-verbose 10)
- (let ((tramp-verbose 0))
+ (let ((inhibit-message t)
+ create-lockfiles file-name-handler-alist message-log-max
+ signal-hook-function)
+ (with-current-buffer (tramp-get-debug-buffer vec)
+ (goto-char (point-max))
+ (let ((point (point)))
+ ;; Headline.
+ (when (bobp)
(insert
(format
- "\n;; Location: %s Git: %s/%s"
- (locate-library "tramp")
- (or tramp-repository-branch "")
- (or tramp-repository-version ""))))))
- (unless (bolp)
- (insert "\n"))
- ;; Timestamp.
- (let ((now (current-time)))
- (insert (format-time-string "%T." now))
- (insert (format "%06d " (nth 2 now))))
- ;; Calling Tramp function. We suppress compat and trace functions
- ;; from being displayed.
- (let ((btn 1) btf fn)
- (while (not fn)
- (setq btf (nth 1 (backtrace-frame btn)))
- (if (not btf)
- (setq fn "")
- (and (symbolp btf) (setq fn (symbol-name btf))
- (or (not (string-match-p "^tramp" fn))
- (get btf 'tramp-suppress-trace))
- (setq fn nil))
- (setq btn (1+ btn))))
- ;; The following code inserts filename and line number. Should
- ;; be inactive by default, because it is time consuming.
-; (let ((ffn (find-function-noselect (intern fn))))
-; (insert
-; (format
-; "%s:%d: "
-; (file-name-nondirectory (buffer-file-name (car ffn)))
-; (with-current-buffer (car ffn)
-; (1+ (count-lines (point-min) (cdr ffn)))))))
- (insert (format "%s " fn)))
- ;; The message.
- (insert (apply #'format-message fmt-string arguments))))
+ ";; Emacs: %s Tramp: %s -*- mode: outline; -*-"
+ emacs-version tramp-version))
+ (when (>= tramp-verbose 10)
+ (let ((tramp-verbose 0))
+ (insert
+ (format
+ "\n;; Location: %s Git: %s/%s"
+ (locate-library "tramp")
+ (or tramp-repository-branch "")
+ (or tramp-repository-version "")))))
+ ;; Delete debug file.
+ (when (and tramp-debug-to-file (tramp-get-debug-file-name vec))
+ (ignore-errors (delete-file (tramp-get-debug-file-name vec)))))
+ (unless (bolp)
+ (insert "\n"))
+ ;; Timestamp.
+ (let ((now (current-time)))
+ (insert (format-time-string "%T." now))
+ (insert (format "%06d " (nth 2 now))))
+ ;; Calling Tramp function. We suppress compat and trace
+ ;; functions from being displayed.
+ (let ((btn 1) btf fn)
+ (while (not fn)
+ (setq btf (nth 1 (backtrace-frame btn)))
+ (if (not btf)
+ (setq fn "")
+ (and (symbolp btf) (setq fn (symbol-name btf))
+ (or (not (string-match-p "^tramp" fn))
+ (get btf 'tramp-suppress-trace))
+ (setq fn nil))
+ (setq btn (1+ btn))))
+ ;; The following code inserts filename and line number.
+ ;; Should be inactive by default, because it is time consuming.
+ ;; (let ((ffn (find-function-noselect (intern fn))))
+ ;; (insert
+ ;; (format
+ ;; "%s:%d: "
+ ;; (file-name-nondirectory (buffer-file-name (car ffn)))
+ ;; (with-current-buffer (car ffn)
+ ;; (1+ (count-lines (point-min) (cdr ffn)))))))
+ (insert (format "%s " fn)))
+ ;; The message.
+ (insert (apply #'format-message fmt-string arguments))
+ ;; Write message to debug file.
+ (when tramp-debug-to-file
+ (ignore-errors
+ (write-region
+ point (point-max) (tramp-get-debug-file-name vec) 'append)))))))
(put #'tramp-debug-message 'tramp-suppress-trace t)
@@ -1957,6 +1983,13 @@ the resulting error message."
(put #'tramp-with-demoted-errors 'tramp-suppress-trace t)
+(defun tramp-test-message (fmt-string &rest arguments)
+ "Emit a Tramp message according `default-directory'."
+ (if (tramp-tramp-file-p default-directory)
+ (apply #'tramp-message
+ (tramp-dissect-file-name default-directory) 0 fmt-string arguments)
+ (apply #'message fmt-string arguments)))
+
;; This function provides traces in case of errors not triggered by
;; Tramp functions.
(defun tramp-signal-hook-function (error-symbol data)
@@ -2320,33 +2353,6 @@ Must be handled by the callers."
res (cdr elt))))
res)))
-;; In Emacs, there is some concurrency due to timers. If a timer
-;; interrupts Tramp and wishes to use the same connection buffer as
-;; the "main" Emacs, then garbage might occur in the connection
-;; buffer. Therefore, we need to make sure that a timer does not use
-;; the same connection buffer as the "main" Emacs. We implement a
-;; cheap global lock, instead of locking each connection buffer
-;; separately. The global lock is based on two variables,
-;; `tramp-locked' and `tramp-locker'. `tramp-locked' is set to true
-;; (with setq) to indicate a lock. But Tramp also calls itself during
-;; processing of a single file operation, so we need to allow
-;; recursive calls. That's where the `tramp-locker' variable comes in
-;; -- it is let-bound to t during the execution of the current
-;; handler. So if `tramp-locked' is t and `tramp-locker' is also t,
-;; then we should just proceed because we have been called
-;; recursively. But if `tramp-locker' is nil, then we are a timer
-;; interrupting the "main" Emacs, and then we signal an error.
-
-(defvar tramp-locked nil
- "If non-nil, then Tramp is currently busy.
-Together with `tramp-locker', this implements a locking mechanism
-preventing reentrant calls of Tramp.")
-
-(defvar tramp-locker nil
- "If non-nil, then a caller has locked Tramp.
-Together with `tramp-locked', this implements a locking mechanism
-preventing reentrant calls of Tramp.")
-
;; Main function.
(defun tramp-file-name-handler (operation &rest args)
"Invoke Tramp file name handler for OPERATION and ARGS.
@@ -2400,17 +2406,7 @@ Fall back to normal file name handler if no Tramp file name handler exists."
(setq result
(catch 'non-essential
(catch 'suppress
- (when (and tramp-locked (not tramp-locker))
- (setq tramp-locked nil)
- (tramp-error
- v 'file-error
- "Forbidden reentrant call of Tramp"))
- (let ((tl tramp-locked))
- (setq tramp-locked t)
- (unwind-protect
- (let ((tramp-locker t))
- (apply foreign operation args))
- (setq tramp-locked tl))))))
+ (apply foreign operation args))))
;; (tramp-message
;; v 4 "Running `%s'...`%s'" (cons operation args) result)
(cond
@@ -3116,7 +3112,7 @@ User is always nil."
(setq directory (substring directory 0 -1)))
directory)
-(defun tramp-handle-directory-files (directory &optional full match nosort)
+(defun tramp-handle-directory-files (directory &optional full match nosort count)
"Like `directory-files' for Tramp files."
(unless (file-exists-p directory)
(tramp-error
@@ -3132,16 +3128,20 @@ User is always nil."
(when (or (null match) (string-match-p match item))
(push (if full (concat directory item) item)
result)))
- (if nosort result (sort result #'string<)))))
+ (unless nosort
+ (setq result (sort result #'string<)))
+ (when (and (natnump count) (> count 0))
+ (setq result (nbutlast result (- (length result) count))))
+ result)))
(defun tramp-handle-directory-files-and-attributes
- (directory &optional full match nosort id-format)
+ (directory &optional full match nosort id-format count)
"Like `directory-files-and-attributes' for Tramp files."
(mapcar
(lambda (x)
(cons x (file-attributes
(if full x (expand-file-name x directory)) id-format)))
- (directory-files directory full match nosort)))
+ (tramp-compat-directory-files directory full match nosort count)))
(defun tramp-handle-dired-uncache (dir)
"Like `dired-uncache' for Tramp files."
@@ -3749,7 +3749,9 @@ User is always nil."
(let ((v (tramp-dissect-file-name default-directory))
(buffer (plist-get args :buffer))
(stderr (plist-get args :stderr)))
- (and ;; It has been indicated.
+ (and ;; The method supports it.
+ (tramp-get-method-parameter v 'tramp-direct-async)
+ ;; It has been indicated.
(tramp-get-connection-property v "direct-async-process" nil)
;; There's no multi-hop.
(or (not (tramp-multi-hop-p v))
@@ -3792,16 +3794,33 @@ It does not support `:stderr'."
(unless (or (null sentinel) (functionp sentinel))
(signal 'wrong-type-argument (list #'functionp sentinel)))
(unless (or (null stderr) (bufferp stderr))
- (signal 'wrong-type-argument (list #'stringp stderr)))
+ (signal 'wrong-type-argument (list #'bufferp stderr)))
(let* ((buffer
(if buffer
(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))
+ (env (setenv-internal
+ env "INSIDE_EMACS"
+ (concat (or (getenv "INSIDE_EMACS") emacs-version)
+ ",tramp:" tramp-version)
+ 'keep))
+ (env (mapcar #'tramp-shell-quote-argument (delq nil env)))
+ ;; Quote command.
+ (command (mapconcat #'tramp-shell-quote-argument command " "))
+ ;; Set cwd and environment variables.
(command
- (mapconcat
- #'identity (append `("cd" ,localname "&&") command) " ")))
+ (append `("cd" ,localname "&&" "(" "env") env `(,command ")"))))
;; Check for `tramp-sh-file-name-handler', because something
;; is different between tramp-adb.el and tramp-sh.el.
@@ -3812,8 +3831,6 @@ It does not support `:stderr'."
(tramp-get-method-parameter v 'tramp-login-args))
(async-args
(tramp-get-method-parameter v 'tramp-async-args))
- (direct-async-args
- (tramp-get-method-parameter v 'tramp-direct-async-args))
;; We don't create the temporary file. In fact, it
;; is just a prefix for the ControlPath option of
;; ssh; the real temporary file has another name, and
@@ -3841,7 +3858,7 @@ It does not support `:stderr'."
?h (or host "") ?u (or user "") ?p (or port "")
?c options ?l "")
;; Add arguments for asynchronous processes.
- login-args (append async-args direct-async-args login-args)
+ login-args (append async-args login-args)
;; Expand format spec.
login-args
(tramp-compat-flatten-tree
@@ -3856,7 +3873,7 @@ It does not support `:stderr'."
(mapcar (lambda (x) (split-string x " ")) login-args))
p (make-process
:name name :buffer buffer
- :command (append `(,login-program) login-args `(,command))
+ :command (append `(,login-program) login-args command)
:coding coding :noquery noquery :connection-type connection-type
:filter filter :sentinel sentinel :stderr stderr))
@@ -4177,8 +4194,9 @@ of."
;; Set file modification time.
(when (or (eq visit t) (stringp visit))
(set-visited-file-modtime
- (tramp-compat-file-attribute-modification-time
- (file-attributes filename))))
+ (or (tramp-compat-file-attribute-modification-time
+ (file-attributes filename))
+ (current-time))))
;; Set the ownership.
(tramp-set-file-uid-gid filename uid gid))
@@ -4465,6 +4483,32 @@ performed successfully. Any other value means an error."
;;; Utility functions:
+;; In Emacs, there is some concurrency due to timers. If a timer
+;; interrupts Tramp and wishes to use the same connection buffer as
+;; the "main" Emacs, then garbage might occur in the connection
+;; buffer. Therefore, we need to make sure that a timer does not use
+;; the same connection buffer as the "main" Emacs. We lock each
+;; connection process separately by a connection property.
+
+(defmacro with-tramp-locked-connection (proc &rest body)
+ "Lock PROC for other communication, and run BODY.
+Mostly useful to protect BODY from being interrupted by timers."
+ (declare (indent 1) (debug t))
+ `(if (tramp-get-connection-property ,proc "locked" nil)
+ ;; Be kind for older Emacsen.
+ (if (member 'remote-file-error debug-ignored-errors)
+ (throw 'non-essential 'non-essential)
+ (tramp-error
+ ,proc 'remote-file-error "Forbidden reentrant call of Tramp"))
+ (unwind-protect
+ (progn
+ (tramp-set-connection-property ,proc "locked" t)
+ ,@body)
+ (tramp-flush-connection-property ,proc "locked"))))
+
+(font-lock-add-keywords
+ 'emacs-lisp-mode '("\\<with-tramp-locked-connection\\>"))
+
(defun tramp-accept-process-output (proc &optional timeout)
"Like `accept-process-output' for Tramp processes.
This is needed in order to hide `last-coding-system-used', which is set
@@ -4474,15 +4518,17 @@ If the user quits via `C-g', it is propagated up to `tramp-file-name-handler'."
(let ((inhibit-read-only t)
last-coding-system-used
result)
- ;; JUST-THIS-ONE is set due to Bug#12145. `with-local-quit'
- ;; returns t in order to report success.
- (if (with-local-quit
- (setq result (accept-process-output proc timeout nil t)) t)
- (tramp-message
- proc 10 "%s %s %s %s\n%s"
- proc timeout (process-status proc) result (buffer-string))
- ;; Propagate quit.
- (keyboard-quit))
+ ;; This must be protected by the "locked" property.
+ (with-tramp-locked-connection proc
+ ;; JUST-THIS-ONE is set due to Bug#12145. `with-local-quit'
+ ;; returns t in order to report success.
+ (if (with-local-quit
+ (setq result (accept-process-output proc timeout nil t)) t)
+ (tramp-message
+ proc 10 "%s %s %s %s\n%s"
+ proc timeout (process-status proc) result (buffer-string))
+ ;; Propagate quit.
+ (keyboard-quit)))
result)))
(defun tramp-search-regexp (regexp)
@@ -4599,19 +4645,21 @@ the remote host use line-endings as defined in the variable
(unless (or (string-empty-p string)
(string-equal (substring string -1) tramp-rsh-end-of-line))
(setq string (concat string tramp-rsh-end-of-line)))
- ;; Send the string.
- (with-local-quit
- (if (and chunksize (not (zerop chunksize)))
- (let ((pos 0)
- (end (length string)))
- (while (< pos end)
- (tramp-message
- vec 10 "Sending chunk from %s to %s"
- pos (min (+ pos chunksize) end))
- (process-send-string
- p (substring string pos (min (+ pos chunksize) end)))
- (setq pos (+ pos chunksize))))
- (process-send-string p string))))))
+ ;; This must be protected by the "locked" property.
+ (with-tramp-locked-connection p
+ ;; Send the string.
+ (with-local-quit
+ (if (and chunksize (not (zerop chunksize)))
+ (let ((pos 0)
+ (end (length string)))
+ (while (< pos end)
+ (tramp-message
+ vec 10 "Sending chunk from %s to %s"
+ pos (min (+ pos chunksize) end))
+ (process-send-string
+ p (substring string pos (min (+ pos chunksize) end)))
+ (setq pos (+ pos chunksize))))
+ (process-send-string p string)))))))
(defun tramp-process-sentinel (proc event)
"Flush file caches and remove shell prompt."
@@ -5176,6 +5224,8 @@ Invokes `password-read' if available, `read-passwd' else."
(tramp-check-for-regexp proc tramp-password-prompt-regexp)
(format "%s for %s " (capitalize (match-string 1)) key))))
(auth-source-creation-prompts `((secret . ,pw-prompt)))
+ ;; Use connection-local value.
+ (auth-sources (with-current-buffer (process-buffer proc) auth-sources))
;; We suspend the timers while reading the password.
(stimers (with-timeout-suspend))
auth-info auth-passwd)
@@ -5216,7 +5266,7 @@ Invokes `password-read' if available, `read-passwd' else."
(setq auth-passwd (funcall auth-passwd)))
auth-passwd)
- ;; Try the password cache.
+ ;; Try the password cache. Exists since Emacs 26.1.
(progn
(setq auth-passwd (password-read pw-prompt key)
tramp-password-save-function
@@ -5320,7 +5370,9 @@ name of a process or buffer, or nil to default to the current buffer."
(tramp-compat-funcall
'tramp-send-command
(process-get proc 'vector)
- (format "(\\kill -2 -%d || \\kill -2 %d) 2>/dev/null" pid pid))
+ (format "(\\kill -2 -%d || \\kill -2 %d) 2>%s"
+ pid pid
+ (tramp-get-remote-null-device (process-get proc 'vector))))
;; Wait, until the process has disappeared. If it doesn't,
;; fall back to the default implementation.
(while (tramp-accept-process-output proc 0))
@@ -5334,6 +5386,15 @@ name of a process or buffer, or nil to default to the current buffer."
(lambda ()
(remove-hook 'interrupt-process-functions #'tramp-interrupt-process))))
+(defun tramp-get-remote-null-device (vec)
+ "Return null device on the remote host identified by VEC.
+If VEC is nil, return local null device."
+ (if (null vec)
+ null-device
+ (with-tramp-connection-property vec "null-device"
+ (let ((default-directory (tramp-make-tramp-file-name vec)))
+ (tramp-compat-null-device)))))
+
(defmacro tramp-skeleton-delete-directory (directory recursive trash &rest body)
"Skeleton for `tramp-*-handle-delete-directory'.
BODY is the backend specific code."
@@ -5342,9 +5403,7 @@ BODY is the backend specific code."
(if (and delete-by-moving-to-trash ,trash)
;; Move non-empty dir to trash only if recursive deletion was
;; requested.
- (if (and (not ,recursive)
- (directory-files
- ,directory nil directory-files-no-dot-files-regexp))
+ (if (not (or ,recursive (tramp-compat-directory-empty-p ,directory)))
(tramp-error
v 'file-error "Directory is not empty, not moving to trash")
(move-file-to-trash ,directory))
diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el
index 8d21133b3b1..ced3e93fc09 100644
--- a/lisp/net/trampver.el
+++ b/lisp/net/trampver.el
@@ -1,12 +1,16 @@
;;; trampver.el --- Transparent Remote Access, Multiple Protocol -*- lexical-binding:t -*-
;;; lisp/trampver.el. Generated from trampver.el.in by configure.
-;; Copyright (C) 2003-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
;; Author: Kai Großjohann <kai.grossjohann@gmx.net>
;; Maintainer: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
;; Package: tramp
+;; Version: 2.5.1-pre
+;; Package-Requires: ((emacs "25.1"))
+;; Package-Type: multi
+;; URL: https://www.gnu.org/software/tramp/
;; This file is part of GNU Emacs.
@@ -30,13 +34,13 @@
;;; Code:
-;; In the Tramp GIT, the version number is auto-frobbed from tramp.el,
-;; and the bug report address is auto-frobbed from configure.ac.
-;; Emacs version check is defined in macro AC_EMACS_INFO of
-;; aclocal.m4; should be changed only there.
+;; In the Tramp GIT repository, the version number, the bug report
+;; address and the required Emacs version are auto-frobbed from
+;; configure.ac, so you should edit that file and run "autoconf &&
+;; ./configure" to change them.
;;;###tramp-autoload
-(defconst tramp-version "2.5.0-pre"
+(defconst tramp-version "2.5.1-pre"
"This version of Tramp.")
;;;###tramp-autoload
@@ -72,7 +76,7 @@
;; Check for Emacs version.
(let ((x (if (not (string-lessp emacs-version "25.1"))
"ok"
- (format "Tramp 2.5.0-pre is not fit for %s"
+ (format "Tramp 2.5.1-pre is not fit for %s"
(replace-regexp-in-string "\n" "" (emacs-version))))))
(unless (string-equal "ok" x) (error "%s" x)))
@@ -92,7 +96,7 @@
("2.2.13.25.2" . "25.3")
("2.3.3" . "26.1") ("2.3.3.26.1" . "26.1") ("2.3.5.26.2" . "26.2")
("2.3.5.26.3" . "26.3")
- ("2.4.3.27.1" . "27.1")))
+ ("2.4.3.27.1" . "27.1") ("2.4.5.27.2" . "27.2")))
(add-hook 'tramp-unload-hook
(lambda ()
diff --git a/lisp/net/webjump.el b/lisp/net/webjump.el
index 8bb156199c5..9bcf1d37345 100644
--- a/lisp/net/webjump.el
+++ b/lisp/net/webjump.el
@@ -1,6 +1,6 @@
;;; webjump.el --- programmable Web hotlist -*- lexical-binding: t; -*-
-;; Copyright (C) 1996-1997, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1997, 2001-2021 Free Software Foundation, Inc.
;; Author: Neil W. Van Dyke <nwv@acm.org>
;; Created: 09-Aug-1996
@@ -40,7 +40,6 @@
;; You may wish to add something like the following to your init file:
;;
-;; (require 'webjump)
;; (global-set-key "\C-cj" 'webjump)
;; (setq webjump-sites
;; (append '(
diff --git a/lisp/net/zeroconf.el b/lisp/net/zeroconf.el
index cb3c0f2a7ee..d5da73bd857 100644
--- a/lisp/net/zeroconf.el
+++ b/lisp/net/zeroconf.el
@@ -1,6 +1,6 @@
;;; zeroconf.el --- Service browser using Avahi. -*- lexical-binding:t -*-
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, hardware
diff --git a/lisp/newcomment.el b/lisp/newcomment.el
index e111ae8e225..5d0d1053f4b 100644
--- a/lisp/newcomment.el
+++ b/lisp/newcomment.el
@@ -1,6 +1,6 @@
;;; newcomment.el --- (un)comment regions of buffers -*- lexical-binding: t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: code extracted from Emacs-20's simple.el
;; Maintainer: Stefan Monnier <monnier@gnu.org>
@@ -304,7 +304,7 @@ This is useful when style-conventions require a certain minimal offset.
Python's PEP8 for example recommends two spaces, so you could do:
\(add-hook \\='python-mode-hook
- (lambda () (set (make-local-variable \\='comment-inline-offset) 2)))
+ (lambda () (setq-local comment-inline-offset 2)))
See `comment-padding' for whole-line comments."
:version "24.3"
@@ -361,21 +361,21 @@ function should first call this function explicitly."
(let ((cs (read-string "No comment syntax is defined. Use: ")))
(if (zerop (length cs))
(error "No comment syntax defined")
- (set (make-local-variable 'comment-start) cs)
- (set (make-local-variable 'comment-start-skip) cs))))
+ (setq-local comment-start cs)
+ (setq-local comment-start-skip cs))))
;; comment-use-syntax
(when (eq comment-use-syntax 'undecided)
- (set (make-local-variable 'comment-use-syntax)
- (let ((st (syntax-table))
- (cs comment-start)
- (ce (if (string= "" comment-end) "\n" comment-end)))
- ;; Try to skip over a comment using forward-comment
- ;; to see if the syntax tables properly recognize it.
- (with-temp-buffer
- (set-syntax-table st)
- (insert cs " hello " ce)
- (goto-char (point-min))
- (and (forward-comment 1) (eobp))))))
+ (setq-local comment-use-syntax
+ (let ((st (syntax-table))
+ (cs comment-start)
+ (ce (if (string= "" comment-end) "\n" comment-end)))
+ ;; Try to skip over a comment using forward-comment
+ ;; to see if the syntax tables properly recognize it.
+ (with-temp-buffer
+ (set-syntax-table st)
+ (insert cs " hello " ce)
+ (goto-char (point-min))
+ (and (forward-comment 1) (eobp))))))
;; comment-padding
(unless comment-padding (setq comment-padding 0))
(when (integerp comment-padding)
@@ -385,9 +385,9 @@ function should first call this function explicitly."
;;(setq comment-end (comment-string-strip comment-end nil t))
;; comment-continue
(unless (or comment-continue (string= comment-end ""))
- (set (make-local-variable 'comment-continue)
- (concat (if (string-match "\\S-\\S-" comment-start) " " "|")
- (substring comment-start 1)))
+ (setq-local comment-continue
+ (concat (if (string-match "\\S-\\S-" comment-start) " " "|")
+ (substring comment-start 1)))
;; Hasn't been necessary yet.
;; (unless (string-match comment-start-skip comment-continue)
;; (kill-local-variable 'comment-continue))
@@ -396,29 +396,29 @@ function should first call this function explicitly."
(unless (and comment-start-skip
;; In case comment-start has changed since last time.
(string-match comment-start-skip comment-start))
- (set (make-local-variable 'comment-start-skip)
- (concat (unless (eq comment-use-syntax t)
- ;; `syntax-ppss' will detect escaping.
- "\\(\\(^\\|[^\\\n]\\)\\(\\\\\\\\\\)*\\)")
- "\\(?:\\s<+\\|"
- (regexp-quote (comment-string-strip comment-start t t))
- ;; Let's not allow any \s- but only [ \t] since \n
- ;; might be both a comment-end marker and \s-.
- "+\\)[ \t]*")))
+ (setq-local comment-start-skip
+ (concat (unless (eq comment-use-syntax t)
+ ;; `syntax-ppss' will detect escaping.
+ "\\(\\(^\\|[^\\\n]\\)\\(\\\\\\\\\\)*\\)")
+ "\\(?:\\s<+\\|"
+ (regexp-quote (comment-string-strip comment-start t t))
+ ;; Let's not allow any \s- but only [ \t] since \n
+ ;; might be both a comment-end marker and \s-.
+ "+\\)[ \t]*")))
(unless (and comment-end-skip
;; In case comment-end has changed since last time.
(string-match comment-end-skip
(if (string= "" comment-end) "\n" comment-end)))
(let ((ce (if (string= "" comment-end) "\n"
(comment-string-strip comment-end t t))))
- (set (make-local-variable 'comment-end-skip)
- ;; We use [ \t] rather than \s- because we don't want to
- ;; remove ^L in C mode when uncommenting.
- (concat "[ \t]*\\(\\s>" (if comment-quote-nested "" "+")
- "\\|" (regexp-quote (substring ce 0 1))
- (if (and comment-quote-nested (<= (length ce) 1)) "" "+")
- (regexp-quote (substring ce 1))
- "\\)"))))))
+ (setq-local comment-end-skip
+ ;; We use [ \t] rather than \s- because we don't want to
+ ;; remove ^L in C mode when uncommenting.
+ (concat "[ \t]*\\(\\s>" (if comment-quote-nested "" "+")
+ "\\|" (regexp-quote (substring ce 0 1))
+ (if (and comment-quote-nested (<= (length ce) 1)) "" "+")
+ (regexp-quote (substring ce 1))
+ "\\)"))))))
(defun comment-quote-re (str unp)
(concat (regexp-quote (substring str 0 1))
@@ -1292,7 +1292,15 @@ changed with `comment-style'."
(defun comment-region-default (beg end &optional arg)
(if comment-combine-change-calls
- (combine-change-calls beg end (comment-region-default-1 beg end arg))
+ (combine-change-calls beg
+ ;; A new line might get inserted and whitespace deleted
+ ;; after END for line comments. Ensure the next argument is
+ ;; after any and all changes.
+ (save-excursion
+ (goto-char end)
+ (forward-line)
+ (point))
+ (comment-region-default-1 beg end arg))
(comment-region-default-1 beg end arg)))
;;;###autoload
diff --git a/lisp/notifications.el b/lisp/notifications.el
index f83898622ec..2241afa9050 100644
--- a/lisp/notifications.el
+++ b/lisp/notifications.el
@@ -1,6 +1,6 @@
;;; notifications.el --- Client interface to desktop notifications.
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Julien Danjou <julien@danjou.info>
;; Keywords: comm desktop notifications
diff --git a/lisp/novice.el b/lisp/novice.el
index 4771d8dbaed..22eca21784c 100644
--- a/lisp/novice.el
+++ b/lisp/novice.el
@@ -1,6 +1,6 @@
;;; novice.el --- handling of disabled commands ("novice mode") for Emacs
-;; Copyright (C) 1985-1987, 1994, 2001-2020 Free Software Foundation,
+;; Copyright (C) 1985-1987, 1994, 2001-2021 Free Software Foundation,
;; Inc.
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/nxml/nxml-enc.el b/lisp/nxml/nxml-enc.el
index 3221d80ca44..abdc2e4ab25 100644
--- a/lisp/nxml/nxml-enc.el
+++ b/lisp/nxml/nxml-enc.el
@@ -1,6 +1,6 @@
;;; nxml-enc.el --- XML encoding auto-detection -*- lexical-binding:t -*-
-;; Copyright (C) 2003, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2021 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: wp, hypermedia, languages, XML
diff --git a/lisp/nxml/nxml-maint.el b/lisp/nxml/nxml-maint.el
index a838eb60ba2..24a3c5c6dbc 100644
--- a/lisp/nxml/nxml-maint.el
+++ b/lisp/nxml/nxml-maint.el
@@ -1,6 +1,6 @@
;;; nxml-maint.el --- commands for maintainers of nxml-*.el -*- lexical-binding:t -*-
-;; Copyright (C) 2003, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2021 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: wp, hypermedia, languages, XML
diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el
index 5bb904e6915..0602943db20 100644
--- a/lisp/nxml/nxml-mode.el
+++ b/lisp/nxml/nxml-mode.el
@@ -1,6 +1,6 @@
;;; nxml-mode.el --- a new XML mode -*- lexical-binding:t -*-
-;; Copyright (C) 2003-2004, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2004, 2007-2021 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: wp, hypermedia, languages, XML
@@ -54,26 +54,30 @@
"Non-nil means display glyph following character reference.
The glyph is displayed in face `nxml-glyph'."
:group 'nxml
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
(defcustom nxml-sexp-element-flag t
"Non-nil means sexp commands treat an element as a single expression."
:version "27.1" ; nil -> t
:group 'nxml
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
(defcustom nxml-slash-auto-complete-flag nil
"Non-nil means typing a slash automatically completes the end-tag.
This is used by `nxml-electric-slash'."
:group 'nxml
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
(defcustom nxml-child-indent 2
"Indentation for the children of an element relative to the start-tag.
This only applies when the line or lines containing the start-tag contains
nothing else other than that start-tag."
:group 'nxml
- :type 'integer)
+ :type 'integer
+ :safe #'integerp)
(defcustom nxml-attribute-indent 4
"Indentation for the attributes of an element relative to the start-tag.
@@ -81,12 +85,14 @@ This only applies when the first attribute of a tag starts a line.
In other cases, the first attribute on one line is indented the same
as the first attribute on the previous line."
:group 'nxml
- :type 'integer)
+ :type 'integer
+ :safe #'integerp)
(defcustom nxml-bind-meta-tab-to-complete-flag t
"Non-nil means to use nXML completion in \\[completion-at-point]."
:group 'nxml
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
(defcustom nxml-prefer-utf-16-to-utf-8-flag nil
"Non-nil means prefer UTF-16 to UTF-8 when saving a buffer.
@@ -94,7 +100,8 @@ This is used only when a buffer does not contain an encoding declaration
and when its current `buffer-file-coding-system' specifies neither UTF-16
nor UTF-8."
:group 'nxml
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
(defcustom nxml-prefer-utf-16-little-to-big-endian-flag (eq system-type
'windows-nt)
@@ -103,20 +110,25 @@ This is used only for saving a buffer; when reading the byte-order is
auto-detected. It may be relevant both when there is no encoding declaration
and when the encoding declaration specifies `UTF-16'."
:group 'nxml
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
(defcustom nxml-default-buffer-file-coding-system nil
"Default value for `buffer-file-coding-system' for a buffer for a new file.
-A value of nil means use the default value of `buffer-file-coding-system' as normal.
-A buffer's `buffer-file-coding-system' affects what \\[nxml-insert-xml-declaration] inserts."
+A value of nil means use the default value of
+`buffer-file-coding-system' as normal.
+A buffer's `buffer-file-coding-system' affects what
+\\[nxml-insert-xml-declaration] inserts."
:group 'nxml
- :type 'coding-system)
+ :type 'coding-system
+ :safe #'coding-system-p)
(defcustom nxml-auto-insert-xml-declaration-flag nil
"Non-nil means automatically insert an XML declaration in a new file.
The XML declaration is inserted using `nxml-insert-xml-declaration'."
:group 'nxml
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
(defface nxml-delimited-data
'((t (:inherit font-lock-doc-face)))
diff --git a/lisp/nxml/nxml-ns.el b/lisp/nxml/nxml-ns.el
index 9f6598ecc28..e33140c0a48 100644
--- a/lisp/nxml/nxml-ns.el
+++ b/lisp/nxml/nxml-ns.el
@@ -1,6 +1,6 @@
;;; nxml-ns.el --- XML namespace processing -*- lexical-binding:t -*-
-;; Copyright (C) 2003, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2021 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: wp, hypermedia, languages, XML
diff --git a/lisp/nxml/nxml-outln.el b/lisp/nxml/nxml-outln.el
index 8fab612c7ff..6dca34a80f2 100644
--- a/lisp/nxml/nxml-outln.el
+++ b/lisp/nxml/nxml-outln.el
@@ -1,6 +1,6 @@
;;; nxml-outln.el --- outline support for nXML mode -*- lexical-binding:t -*-
-;; Copyright (C) 2004, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2004, 2007-2021 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: wp, hypermedia, languages, XML
diff --git a/lisp/nxml/nxml-parse.el b/lisp/nxml/nxml-parse.el
index e5c785e42ef..d2eb4f1feb9 100644
--- a/lisp/nxml/nxml-parse.el
+++ b/lisp/nxml/nxml-parse.el
@@ -1,6 +1,6 @@
;;; nxml-parse.el --- XML parser, sharing infrastructure with nxml-mode -*- lexical-binding:t -*-
-;; Copyright (C) 2003, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2021 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: wp, hypermedia, languages, XML
diff --git a/lisp/nxml/nxml-rap.el b/lisp/nxml/nxml-rap.el
index 0d7d95acff1..6f742746e9e 100644
--- a/lisp/nxml/nxml-rap.el
+++ b/lisp/nxml/nxml-rap.el
@@ -1,6 +1,6 @@
;;; nxml-rap.el --- low-level support for random access parsing for nXML mode -*- lexical-binding:t -*-
-;; Copyright (C) 2003-2004, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2004, 2007-2021 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: wp, hypermedia, languages, XML
diff --git a/lisp/nxml/nxml-util.el b/lisp/nxml/nxml-util.el
index 33c2e67c4dc..022d6c5f29d 100644
--- a/lisp/nxml/nxml-util.el
+++ b/lisp/nxml/nxml-util.el
@@ -1,6 +1,6 @@
;;; nxml-util.el --- utility functions for nxml-*.el -*- lexical-binding:t -*-
-;; Copyright (C) 2003, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2021 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: wp, hypermedia, languages, XML
diff --git a/lisp/nxml/rng-cmpct.el b/lisp/nxml/rng-cmpct.el
index 296cc260663..dcbd7ed1dd7 100644
--- a/lisp/nxml/rng-cmpct.el
+++ b/lisp/nxml/rng-cmpct.el
@@ -1,6 +1,6 @@
;;; rng-cmpct.el --- parsing of RELAX NG Compact Syntax schemas -*- lexical-binding:t -*-
-;; Copyright (C) 2003, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2021 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: wp, hypermedia, languages, XML, RelaxNG
diff --git a/lisp/nxml/rng-dt.el b/lisp/nxml/rng-dt.el
index 4aba09a68c5..25d838ce445 100644
--- a/lisp/nxml/rng-dt.el
+++ b/lisp/nxml/rng-dt.el
@@ -1,6 +1,6 @@
;;; rng-dt.el --- datatype library interface for RELAX NG -*- lexical-binding:t -*-
-;; Copyright (C) 2003, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2021 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: wp, hypermedia, languages, XML, RelaxNG
diff --git a/lisp/nxml/rng-loc.el b/lisp/nxml/rng-loc.el
index 00b2aa7c267..d5a608d6ff2 100644
--- a/lisp/nxml/rng-loc.el
+++ b/lisp/nxml/rng-loc.el
@@ -1,6 +1,6 @@
;;; rng-loc.el --- Locate the schema to use for validation -*- lexical-binding:t -*-
-;; Copyright (C) 2003, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2021 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: wp, hypermedia, languages, XML, RelaxNG
diff --git a/lisp/nxml/rng-maint.el b/lisp/nxml/rng-maint.el
index 67c7c59117d..82d716d95c1 100644
--- a/lisp/nxml/rng-maint.el
+++ b/lisp/nxml/rng-maint.el
@@ -1,6 +1,6 @@
;;; rng-maint.el --- commands for RELAX NG maintainers -*- lexical-binding:t -*-
-;; Copyright (C) 2003, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2021 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: wp, hypermedia, languages, XML, RelaxNG
diff --git a/lisp/nxml/rng-match.el b/lisp/nxml/rng-match.el
index 928808c849b..4fc6727d0e6 100644
--- a/lisp/nxml/rng-match.el
+++ b/lisp/nxml/rng-match.el
@@ -1,6 +1,6 @@
;;; rng-match.el --- matching of RELAX NG patterns against XML events -*- lexical-binding:t -*-
-;; Copyright (C) 2003, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2021 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: wp, hypermedia, languages, XML, RelaxNG
diff --git a/lisp/nxml/rng-nxml.el b/lisp/nxml/rng-nxml.el
index d0ebdf15589..7d74fd3c8a7 100644
--- a/lisp/nxml/rng-nxml.el
+++ b/lisp/nxml/rng-nxml.el
@@ -1,6 +1,6 @@
;;; rng-nxml.el --- make nxml-mode take advantage of rng-validate-mode -*- lexical-binding:t -*-
-;; Copyright (C) 2003, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2021 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: wp, hypermedia, languages, XML, RelaxNG
diff --git a/lisp/nxml/rng-parse.el b/lisp/nxml/rng-parse.el
index 8d21aa39e79..f72f33282ee 100644
--- a/lisp/nxml/rng-parse.el
+++ b/lisp/nxml/rng-parse.el
@@ -1,6 +1,6 @@
;;; rng-parse.el --- parse an XML file and validate it against a schema -*- lexical-binding:t -*-
-;; Copyright (C) 2003, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2021 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: wp, hypermedia, languages, XML, RelaxNG
diff --git a/lisp/nxml/rng-pttrn.el b/lisp/nxml/rng-pttrn.el
index faaee349418..12ffa578200 100644
--- a/lisp/nxml/rng-pttrn.el
+++ b/lisp/nxml/rng-pttrn.el
@@ -1,6 +1,6 @@
;;; rng-pttrn.el --- RELAX NG patterns -*- lexical-binding:t -*-
-;; Copyright (C) 2003, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2021 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: wp, hypermedia, languages, XML, RelaxNG
diff --git a/lisp/nxml/rng-uri.el b/lisp/nxml/rng-uri.el
index a44a5dd7e63..fda481fa281 100644
--- a/lisp/nxml/rng-uri.el
+++ b/lisp/nxml/rng-uri.el
@@ -1,6 +1,6 @@
;;; rng-uri.el --- URI parsing and manipulation -*- lexical-binding:t -*-
-;; Copyright (C) 2003, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2021 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: wp, hypermedia, languages, XML
diff --git a/lisp/nxml/rng-util.el b/lisp/nxml/rng-util.el
index 2b820fdc0c6..59465c371eb 100644
--- a/lisp/nxml/rng-util.el
+++ b/lisp/nxml/rng-util.el
@@ -1,6 +1,6 @@
;;; rng-util.el --- utility functions for RELAX NG library
-;; Copyright (C) 2003, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2021 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: wp, hypermedia, languages, XML, RelaxNG
diff --git a/lisp/nxml/rng-valid.el b/lisp/nxml/rng-valid.el
index 803e68b3de0..6ea893404cb 100644
--- a/lisp/nxml/rng-valid.el
+++ b/lisp/nxml/rng-valid.el
@@ -1,6 +1,6 @@
;;; rng-valid.el --- real-time validation of XML using RELAX NG -*- lexical-binding:t -*-
-;; Copyright (C) 2003, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2021 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: wp, hypermedia, languages, XML, RelaxNG
diff --git a/lisp/nxml/rng-xsd.el b/lisp/nxml/rng-xsd.el
index 02b0cecdca4..81314b85ca9 100644
--- a/lisp/nxml/rng-xsd.el
+++ b/lisp/nxml/rng-xsd.el
@@ -1,6 +1,6 @@
;;; rng-xsd.el --- W3C XML Schema datatypes library for RELAX NG -*- lexical-binding:t -*-
-;; Copyright (C) 2003, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2021 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: wp, hypermedia, languages, XML, RelaxNG
diff --git a/lisp/nxml/xmltok.el b/lisp/nxml/xmltok.el
index 9815f4c9ce0..8f89598a5ad 100644
--- a/lisp/nxml/xmltok.el
+++ b/lisp/nxml/xmltok.el
@@ -1,6 +1,6 @@
;;; xmltok.el --- XML tokenization -*- lexical-binding:t -*-
-;; Copyright (C) 2003, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2021 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: wp, hypermedia, languages, XML
diff --git a/lisp/nxml/xsd-regexp.el b/lisp/nxml/xsd-regexp.el
index 622ba911995..f07ca6657ed 100644
--- a/lisp/nxml/xsd-regexp.el
+++ b/lisp/nxml/xsd-regexp.el
@@ -1,6 +1,6 @@
;;; xsd-regexp.el --- translate W3C XML Schema regexps to Emacs regexps -*- lexical-binding:t -*-
-;; Copyright (C) 2003, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2021 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: wp, hypermedia, languages, XML, regexp
@@ -387,9 +387,15 @@ consisting of a single char alternative delimited with []."
((eq first ?-)
(setq hyphen t)
(setq first (1+ first)))
+ ((eq last ?-)
+ (setq hyphen t)
+ (setq last (1- last)))
((eq first ?\])
(setq close-bracket t)
- (setq first (1+ first))))
+ (setq first (1+ first)))
+ ((eq last ?\])
+ (setq close-bracket t)
+ (setq last (1- last))))
(<= first last)))
(when (<= first last)
(setq chars
diff --git a/lisp/obarray.el b/lisp/obarray.el
index dcd4ca5e837..ef2ddb3989e 100644
--- a/lisp/obarray.el
+++ b/lisp/obarray.el
@@ -1,6 +1,6 @@
;;; obarray.el --- obarray functions -*- lexical-binding: t -*-
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: obarray functions
diff --git a/lisp/obsolete/abbrevlist.el b/lisp/obsolete/abbrevlist.el
index bfe0f277d49..1d517dbd116 100644
--- a/lisp/obsolete/abbrevlist.el
+++ b/lisp/obsolete/abbrevlist.el
@@ -1,6 +1,6 @@
;;; abbrevlist.el --- list one abbrev table alphabetically ordered
-;; Copyright (C) 1986, 1992, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1986, 1992, 2001-2021 Free Software Foundation, Inc.
;; Suggested by a previous version by Gildea.
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/obsolete/assoc.el b/lisp/obsolete/assoc.el
index 58b1a9534a2..cb5809b7174 100644
--- a/lisp/obsolete/assoc.el
+++ b/lisp/obsolete/assoc.el
@@ -1,6 +1,6 @@
;;; assoc.el --- insert/delete functions on association lists -*- lexical-binding: t -*-
-;; Copyright (C) 1996, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 2001-2021 Free Software Foundation, Inc.
;; Author: Barry A. Warsaw <bwarsaw@cen.com>
;; Keywords: extensions
diff --git a/lisp/obsolete/bruce.el b/lisp/obsolete/bruce.el
index 475eb980f7c..398f315c5d4 100644
--- a/lisp/obsolete/bruce.el
+++ b/lisp/obsolete/bruce.el
@@ -1,7 +1,7 @@
;;; bruce.el --- bruce phrase utility for overloading the Communications
;;; Decency Act snoops, if any.
-;; Copyright (C) 1988, 1993, 1997, 2001-2020 Free Software Foundation,
+;; Copyright (C) 1988, 1993, 1997, 2001-2021 Free Software Foundation,
;; Inc.
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/obsolete/cc-compat.el b/lisp/obsolete/cc-compat.el
index ae6447a97d9..96b036e892c 100644
--- a/lisp/obsolete/cc-compat.el
+++ b/lisp/obsolete/cc-compat.el
@@ -1,6 +1,6 @@
;;; cc-compat.el --- cc-mode compatibility with c-mode.el confusion
-;; Copyright (C) 1985, 1987, 1992-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc.
;; Authors: 1998- Martin Stjernholm
;; 1994-1999 Barry A. Warsaw
diff --git a/lisp/obsolete/cl-compat.el b/lisp/obsolete/cl-compat.el
index b2471523d14..4abedf3e627 100644
--- a/lisp/obsolete/cl-compat.el
+++ b/lisp/obsolete/cl-compat.el
@@ -1,6 +1,6 @@
;;; cl-compat.el --- Common Lisp extensions for GNU Emacs Lisp (compatibility)
-;; Copyright (C) 1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 2001-2021 Free Software Foundation, Inc.
;; Author: Dave Gillespie <daveg@synaptics.com>
;; Version: 2.02
@@ -111,8 +111,9 @@
(defun build-klist (arglist keys &optional allow-others)
(let ((res (Multiple-value-call 'mapcar* 'cons (unzip-lists arglist))))
(or allow-others
- (let ((bad (set-difference (mapcar 'car res) keys)))
- (if bad (error "Bad keywords: %s not in %s" bad keys))))
+ (with-suppressed-warnings ((obsolete set-difference))
+ (let ((bad (set-difference (mapcar 'car res) keys)))
+ (if bad (error "Bad keywords: %s not in %s" bad keys)))))
res))
(defun extract-from-klist (klist key &optional def)
@@ -130,16 +131,18 @@
(funcall (or test 'eql) item elt))))
(defun safe-idiv (a b)
- (let* ((q (/ (abs a) (abs b)))
- (s (* (signum a) (signum b))))
- (Values q (- a (* s q b)) s)))
+ (with-suppressed-warnings ((obsolete signum))
+ (let* ((q (/ (abs a) (abs b)))
+ (s (* (signum a) (signum b))))
+ (Values q (- a (* s q b)) s))))
;; Internal routines.
(defun pair-with-newsyms (oldforms)
- (let ((newsyms (mapcar (lambda (x) (make-symbol "--cl-var--")) oldforms)))
- (Values (mapcar* 'list newsyms oldforms) newsyms)))
+ (with-suppressed-warnings ((obsolete mapcar*))
+ (let ((newsyms (mapcar (lambda (x) (make-symbol "--cl-var--")) oldforms)))
+ (Values (mapcar* 'list newsyms oldforms) newsyms))))
(defun zip-lists (evens odds)
(cl-mapcan 'list evens odds))
diff --git a/lisp/obsolete/cl.el b/lisp/obsolete/cl.el
index 20bffffd781..95af29bb87f 100644
--- a/lisp/obsolete/cl.el
+++ b/lisp/obsolete/cl.el
@@ -1,6 +1,6 @@
;;; cl.el --- Compatibility aliases for the old CL library. -*- lexical-binding: t -*-
-;; Copyright (C) 2012-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Deprecated-since: 27.1
@@ -113,7 +113,7 @@
most-positive-float
;; custom-print-functions
))
- (defvaralias var (intern (format "cl-%s" var))))
+ (define-obsolete-variable-alias var (intern (format "cl-%s" var)) "27.1"))
(dolist (fun '(
(get* . cl-get)
@@ -291,7 +291,7 @@
))
(let ((new (if (consp fun) (prog1 (cdr fun) (setq fun (car fun)))
(intern (format "cl-%s" fun)))))
- (defalias fun new)))
+ (define-obsolete-function-alias fun new "27.1")))
(defun cl--wrap-in-nil-block (fun &rest args)
`(cl-block nil ,(apply fun args)))
diff --git a/lisp/obsolete/complete.el b/lisp/obsolete/complete.el
index b1448e72e86..735e1e0b6a6 100644
--- a/lisp/obsolete/complete.el
+++ b/lisp/obsolete/complete.el
@@ -1,6 +1,6 @@
;;; complete.el --- partial completion mechanism plus other goodies
-;; Copyright (C) 1990-1993, 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 1999-2021 Free Software Foundation, Inc.
;; Author: Dave Gillespie <daveg@synaptics.com>
;; Keywords: abbrev convenience
diff --git a/lisp/obsolete/crisp.el b/lisp/obsolete/crisp.el
index 18eb0f34e63..91ff899c84d 100644
--- a/lisp/obsolete/crisp.el
+++ b/lisp/obsolete/crisp.el
@@ -1,6 +1,6 @@
;;; crisp.el --- CRiSP/Brief Emacs emulator
-;; Copyright (C) 1997-1999, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1999, 2001-2021 Free Software Foundation, Inc.
;; Author: Gary D. Foster <Gary.Foster@Corp.Sun.COM>
;; Keywords: emulations brief crisp
diff --git a/lisp/obsolete/cust-print.el b/lisp/obsolete/cust-print.el
index 40532ea5b9d..c7342b61ae7 100644
--- a/lisp/obsolete/cust-print.el
+++ b/lisp/obsolete/cust-print.el
@@ -1,6 +1,6 @@
;;; cust-print.el --- handles print-level and print-circle
-;; Copyright (C) 1992, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 2001-2021 Free Software Foundation, Inc.
;; Author: Daniel LaLiberte <liberte@holonexus.org>
;; Adapted-By: ESR
diff --git a/lisp/obsolete/erc-compat.el b/lisp/obsolete/erc-compat.el
index 7ef30d822ff..203ef079c14 100644
--- a/lisp/obsolete/erc-compat.el
+++ b/lisp/obsolete/erc-compat.el
@@ -1,6 +1,6 @@
;;; erc-compat.el --- ERC compatibility code for XEmacs
-;; Copyright (C) 2002-2003, 2005-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2003, 2005-2021 Free Software Foundation, Inc.
;; Author: Alex Schroeder <alex@gnu.org>
;; Maintainer: Amin Bandali <bandali@gnu.org>
diff --git a/lisp/obsolete/erc-hecomplete.el b/lisp/obsolete/erc-hecomplete.el
index cd26edeaa24..fce79f7f34f 100644
--- a/lisp/obsolete/erc-hecomplete.el
+++ b/lisp/obsolete/erc-hecomplete.el
@@ -1,6 +1,6 @@
;;; erc-hecomplete.el --- Provides Nick name completion for ERC
-;; Copyright (C) 2001-2002, 2004, 2006-2020 Free Software Foundation,
+;; Copyright (C) 2001-2002, 2004, 2006-2021 Free Software Foundation,
;; Inc.
;; Author: Alex Schroeder <alex@gnu.org>
diff --git a/lisp/obsolete/eudcb-ph.el b/lisp/obsolete/eudcb-ph.el
index 9f7518b1f37..c7212e3fdb7 100644
--- a/lisp/obsolete/eudcb-ph.el
+++ b/lisp/obsolete/eudcb-ph.el
@@ -1,6 +1,6 @@
;;; eudcb-ph.el --- Emacs Unified Directory Client - CCSO PH/QI Backend
-;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
;; Pavel Janík <Pavel@Janik.cz>
diff --git a/lisp/obsolete/fast-lock.el b/lisp/obsolete/fast-lock.el
index 9e0198dd596..8848c89c62f 100644
--- a/lisp/obsolete/fast-lock.el
+++ b/lisp/obsolete/fast-lock.el
@@ -1,6 +1,6 @@
;;; fast-lock.el --- automagic text properties caching for fast Font Lock mode
-;; Copyright (C) 1994-1998, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1998, 2001-2021 Free Software Foundation, Inc.
;; Author: Simon Marshall <simon@gnu.org>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/obsolete/gs.el b/lisp/obsolete/gs.el
index 4658f2eba7e..6ab3fc59380 100644
--- a/lisp/obsolete/gs.el
+++ b/lisp/obsolete/gs.el
@@ -1,6 +1,6 @@
;;; gs.el --- interface to Ghostscript
-;; Copyright (C) 1998, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2001-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
diff --git a/lisp/obsolete/gulp.el b/lisp/obsolete/gulp.el
index 08ab3884d41..0fbaa1cc4f8 100644
--- a/lisp/obsolete/gulp.el
+++ b/lisp/obsolete/gulp.el
@@ -1,6 +1,6 @@
;;; gulp.el --- ask for updates for Lisp packages
-;; Copyright (C) 1996, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 2001-2021 Free Software Foundation, Inc.
;; Author: Sam Shteingold <shteingd@math.ucla.edu>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/obsolete/html2text.el b/lisp/obsolete/html2text.el
index bc2c8d18f81..f01561bd12c 100644
--- a/lisp/obsolete/html2text.el
+++ b/lisp/obsolete/html2text.el
@@ -1,6 +1,6 @@
;;; html2text.el --- a simple html to plain text converter -*- coding: utf-8 -*-
-;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Author: Joakim Hove <hove@phys.ntnu.no>
;; Obsolete-since: 26.1
diff --git a/lisp/obsolete/info-edit.el b/lisp/obsolete/info-edit.el
index ee8f7c17dd0..c8a187c08ee 100644
--- a/lisp/obsolete/info-edit.el
+++ b/lisp/obsolete/info-edit.el
@@ -1,6 +1,6 @@
;; info-edit.el --- Editing info files -*- lexical-binding:t -*-
-;; Copyright (C) 1985-1986, 1992-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1986, 1992-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: help
diff --git a/lisp/obsolete/iswitchb.el b/lisp/obsolete/iswitchb.el
index 96b063be701..58cada13747 100644
--- a/lisp/obsolete/iswitchb.el
+++ b/lisp/obsolete/iswitchb.el
@@ -1,6 +1,6 @@
;;; iswitchb.el --- switch between buffers using substrings
-;; Copyright (C) 1996-1997, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1997, 2000-2021 Free Software Foundation, Inc.
;; Author: Stephen Eglen <stephen@gnu.org>
;; Keywords: completion convenience
diff --git a/lisp/obsolete/landmark.el b/lisp/obsolete/landmark.el
index df3c5d6cc9e..ae15109beaa 100644
--- a/lisp/obsolete/landmark.el
+++ b/lisp/obsolete/landmark.el
@@ -1,6 +1,6 @@
;;; landmark.el --- Neural-network robot that learns landmarks -*- lexical-binding:t -*-
-;; Copyright (C) 1996-1997, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1997, 2000-2021 Free Software Foundation, Inc.
;; Author: Terrence Brannon <metaperl@gmail.com>
;; Created: December 16, 1996 - first release to usenet
@@ -1278,7 +1278,8 @@ Used to move the robot when he is stuck in a rut for some reason."
:group 'landmark)
(defcustom landmark-max-stall-time 2
"The maximum number of cycles that the robot can remain stuck in a place.
-After this limit is reached, landmark-random-move is called to push him out of it."
+After this limit is reached, landmark-random-move is called to
+push him out of it."
:type 'integer
:group 'landmark)
diff --git a/lisp/obsolete/lazy-lock.el b/lisp/obsolete/lazy-lock.el
index 694188ff234..e1a01913bea 100644
--- a/lisp/obsolete/lazy-lock.el
+++ b/lisp/obsolete/lazy-lock.el
@@ -1,6 +1,6 @@
;;; lazy-lock.el --- lazy demand-driven fontification for fast Font Lock mode
-;; Copyright (C) 1994-1998, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1998, 2001-2021 Free Software Foundation, Inc.
;; Author: Simon Marshall <simon@gnu.org>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/obsolete/longlines.el b/lisp/obsolete/longlines.el
index cbe453aa6bf..f274dfb926d 100644
--- a/lisp/obsolete/longlines.el
+++ b/lisp/obsolete/longlines.el
@@ -1,6 +1,6 @@
;;; longlines.el --- automatically wrap long lines -*- coding:utf-8 -*-
-;; Copyright (C) 2000-2001, 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2001, 2004-2021 Free Software Foundation, Inc.
;; Authors: Kai Grossjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
;; Alex Schroeder <alex@gnu.org>
@@ -407,7 +407,8 @@ Hard newlines are left intact."
(defun longlines-auto-wrap (&optional arg)
"Toggle automatic line wrapping.
-With optional argument ARG, turn on line wrapping if and only if ARG is positive.
+With optional argument ARG, turn on line wrapping if and only if
+ARG is positive.
If automatic line wrapping is turned on, wrap the entire buffer."
(interactive "P")
(setq arg (if arg
diff --git a/lisp/obsolete/mantemp.el b/lisp/obsolete/mantemp.el
index 9c0e553feca..287a5a732ca 100644
--- a/lisp/obsolete/mantemp.el
+++ b/lisp/obsolete/mantemp.el
@@ -1,6 +1,6 @@
;;; mantemp.el --- create manual template instantiations from g++ 2.7.2 output
-;; Copyright (C) 1996, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 2001-2021 Free Software Foundation, Inc.
;; Author: Tom Houlder <thoulder@icor.fr>
;; Created: 10 Dec 1996
diff --git a/lisp/obsolete/messcompat.el b/lisp/obsolete/messcompat.el
index 71ae9e4595d..fa73dc7a0fd 100644
--- a/lisp/obsolete/messcompat.el
+++ b/lisp/obsolete/messcompat.el
@@ -1,6 +1,6 @@
;;; messcompat.el --- making message mode compatible with mail mode
-;; Copyright (C) 1996-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: mail, news
diff --git a/lisp/obsolete/metamail.el b/lisp/obsolete/metamail.el
index d6ab4a3d0cf..ef97e8aa55c 100644
--- a/lisp/obsolete/metamail.el
+++ b/lisp/obsolete/metamail.el
@@ -1,6 +1,6 @@
;;; metamail.el --- Metamail interface for GNU Emacs
-;; Copyright (C) 1993, 1996, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1996, 2001-2021 Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp>
;; Keywords: mail, news, mime, multimedia
diff --git a/lisp/obsolete/mouse-sel.el b/lisp/obsolete/mouse-sel.el
index aabbfcfa3ea..608596e882b 100644
--- a/lisp/obsolete/mouse-sel.el
+++ b/lisp/obsolete/mouse-sel.el
@@ -1,6 +1,6 @@
;;; mouse-sel.el --- multi-click selection support
-;; Copyright (C) 1993-1995, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1995, 2001-2021 Free Software Foundation, Inc.
;; Author: Mike Williams <mdub@bigfoot.com>
;; Keywords: mouse
diff --git a/lisp/gnus/nnir.el b/lisp/obsolete/nnir.el
index 20f82e5cbdf..0b7d1e454c3 100644
--- a/lisp/gnus/nnir.el
+++ b/lisp/obsolete/nnir.el
@@ -1,6 +1,6 @@
;;; nnir.el --- Search mail with various search engines -*- lexical-binding:t -*-
-;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: Kai Großjohann <grossjohann@ls6.cs.uni-dortmund.de>
;; Swish-e and Swish++ backends by:
@@ -12,6 +12,7 @@
;; Justus Piater <Justus <at> Piater.name>
;; Mostly rewritten by Andrew Cohen <cohen@bu.edu> from 2010
;; Keywords: news mail searching ir
+;; Obsolete-since: 28.1
;; This file is part of GNU Emacs.
@@ -503,7 +504,6 @@ 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
@@ -873,9 +873,9 @@ Windows NT 4.0."
;; Sort by score
(apply #'vector
(sort artlist
- (function (lambda (x y)
- (> (nnir-artitem-rsv x)
- (nnir-artitem-rsv y)))))))))
+ (lambda (x y)
+ (> (nnir-artitem-rsv x)
+ (nnir-artitem-rsv y))))))))
;; Swish-E interface.
(defun nnir-run-swish-e (query server &optional _group)
@@ -968,9 +968,9 @@ Tested with swish-e-2.0.1 on Windows NT 4.0."
;; Sort by score
(apply #'vector
(sort artlist
- (function (lambda (x y)
- (> (nnir-artitem-rsv x)
- (nnir-artitem-rsv y)))))))))
+ (lambda (x y)
+ (> (nnir-artitem-rsv x)
+ (nnir-artitem-rsv y))))))))
;; HyREX interface
(defun nnir-run-hyrex (query server &optional group)
@@ -1036,12 +1036,12 @@ Tested with swish-e-2.0.1 on Windows NT 4.0."
(message "Massaging hyrex-search output...done.")
(apply #'vector
(sort artlist
- (function (lambda (x y)
- (if (string-lessp (nnir-artitem-group x)
- (nnir-artitem-group y))
- t
- (< (nnir-artitem-number x)
- (nnir-artitem-number y)))))))
+ (lambda (x y)
+ (if (string-lessp (nnir-artitem-group x)
+ (nnir-artitem-group y))
+ t
+ (< (nnir-artitem-number x)
+ (nnir-artitem-number y))))))
)))
;; Namazu interface
@@ -1111,9 +1111,9 @@ Tested with Namazu 2.0.6 on a GNU/Linux system."
;; sort artlist by score
(apply #'vector
(sort artlist
- (function (lambda (x y)
- (> (nnir-artitem-rsv x)
- (nnir-artitem-rsv y)))))))))
+ (lambda (x y)
+ (> (nnir-artitem-rsv x)
+ (nnir-artitem-rsv y))))))))
(defun nnir-run-notmuch (query server &optional groups)
"Run QUERY with GROUPS from SERVER against notmuch.
diff --git a/lisp/obsolete/old-emacs-lock.el b/lisp/obsolete/old-emacs-lock.el
index 0e178231833..07bccd90711 100644
--- a/lisp/obsolete/old-emacs-lock.el
+++ b/lisp/obsolete/old-emacs-lock.el
@@ -1,6 +1,6 @@
;;; emacs-lock.el --- prevents you from exiting Emacs if a buffer is locked
-;; Copyright (C) 1994, 1997, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 1997, 2001-2021 Free Software Foundation, Inc.
;; Author: Tom Wurgler <twurgler@goodyear.com>
;; Created: 12/8/94
diff --git a/lisp/obsolete/otodo-mode.el b/lisp/obsolete/otodo-mode.el
index 2a4af290b6b..58c385adad4 100644
--- a/lisp/obsolete/otodo-mode.el
+++ b/lisp/obsolete/otodo-mode.el
@@ -1,6 +1,6 @@
;;; todo-mode.el --- major mode for editing TODO list files
-;; Copyright (C) 1997, 1999, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1999, 2001-2021 Free Software Foundation, Inc.
;; Author: Oliver Seidel <privat@os10000.net>
;; Maintainer: Stephen Berman <stephen.berman@gmx.net>
@@ -923,7 +923,8 @@ If INCLUDE-SEP is non-nil, return point after the separator."
;;;###autoload
(define-derived-mode todo-mode nil "TODO"
"Major mode for editing TODO lists."
- (easy-menu-add todo-menu))
+ (when (featurep 'xemacs)
+ (easy-menu-add todo-menu)))
(with-suppressed-warnings ((lexical date entry))
(defvar date)
diff --git a/lisp/obsolete/pc-mode.el b/lisp/obsolete/pc-mode.el
index 0c69f898a07..d4c90c2b298 100644
--- a/lisp/obsolete/pc-mode.el
+++ b/lisp/obsolete/pc-mode.el
@@ -1,6 +1,6 @@
;;; pc-mode.el --- emulate certain key bindings used on PCs
-;; Copyright (C) 1995, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 2001-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: emulations
diff --git a/lisp/obsolete/pc-select.el b/lisp/obsolete/pc-select.el
index 73ded272c5d..3f184881096 100644
--- a/lisp/obsolete/pc-select.el
+++ b/lisp/obsolete/pc-select.el
@@ -2,7 +2,7 @@
;;; (or MAC GUI or MS-windoze (bah)) look-and-feel
;;; including key bindings.
-;; Copyright (C) 1995-1997, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995-1997, 2000-2021 Free Software Foundation, Inc.
;; Author: Michael Staats <michael@thp.Uni-Duisburg.DE>
;; Keywords: convenience emulations
diff --git a/lisp/obsolete/pgg-def.el b/lisp/obsolete/pgg-def.el
index a3575feb1a9..425093832f8 100644
--- a/lisp/obsolete/pgg-def.el
+++ b/lisp/obsolete/pgg-def.el
@@ -1,6 +1,6 @@
;;; pgg-def.el --- functions/macros for defining PGG functions
-;; Copyright (C) 1999, 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2002-2021 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Created: 1999/11/02
diff --git a/lisp/obsolete/pgg-gpg.el b/lisp/obsolete/pgg-gpg.el
index 6e4cec97a67..90255fe2f7d 100644
--- a/lisp/obsolete/pgg-gpg.el
+++ b/lisp/obsolete/pgg-gpg.el
@@ -1,6 +1,6 @@
;;; pgg-gpg.el --- GnuPG support for PGG.
-;; Copyright (C) 1999-2000, 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2000, 2002-2021 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Symmetric encryption and gpg-agent support added by:
diff --git a/lisp/obsolete/pgg-parse.el b/lisp/obsolete/pgg-parse.el
index 79d5cbb3f3b..edb5d4f6775 100644
--- a/lisp/obsolete/pgg-parse.el
+++ b/lisp/obsolete/pgg-parse.el
@@ -1,6 +1,6 @@
;;; pgg-parse.el --- OpenPGP packet parsing
-;; Copyright (C) 1999, 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2002-2021 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Created: 1999/10/28
diff --git a/lisp/obsolete/pgg-pgp.el b/lisp/obsolete/pgg-pgp.el
index cbcb1b33e72..e02032a6a57 100644
--- a/lisp/obsolete/pgg-pgp.el
+++ b/lisp/obsolete/pgg-pgp.el
@@ -1,6 +1,6 @@
;;; pgg-pgp.el --- PGP 2.* and 6.* support for PGG.
-;; Copyright (C) 1999-2000, 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2000, 2002-2021 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Created: 1999/11/02
diff --git a/lisp/obsolete/pgg-pgp5.el b/lisp/obsolete/pgg-pgp5.el
index 892874e3af8..42ff1ca2bd6 100644
--- a/lisp/obsolete/pgg-pgp5.el
+++ b/lisp/obsolete/pgg-pgp5.el
@@ -1,6 +1,6 @@
;;; pgg-pgp5.el --- PGP 5.* support for PGG.
-;; Copyright (C) 1999-2000, 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2000, 2002-2021 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Created: 1999/11/02
diff --git a/lisp/obsolete/pgg.el b/lisp/obsolete/pgg.el
index f0f7081665a..ec93eeb93f8 100644
--- a/lisp/obsolete/pgg.el
+++ b/lisp/obsolete/pgg.el
@@ -1,6 +1,6 @@
;;; pgg.el --- glue for the various PGP implementations.
-;; Copyright (C) 1999-2000, 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2000, 2002-2021 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Symmetric encryption added by: Sascha Wilde <wilde@sha-bang.de>
diff --git a/lisp/obsolete/rcompile.el b/lisp/obsolete/rcompile.el
index 6d95b7136b1..29931d9bda4 100644
--- a/lisp/obsolete/rcompile.el
+++ b/lisp/obsolete/rcompile.el
@@ -1,6 +1,6 @@
;;; rcompile.el --- run a compilation on a remote machine
-;; Copyright (C) 1993-1994, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2001-2021 Free Software Foundation, Inc.
;; Author: Alon Albert <alon@milcse.rtsg.mot.com>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/obsolete/s-region.el b/lisp/obsolete/s-region.el
index 2b55f91a7d5..bcb5279d115 100644
--- a/lisp/obsolete/s-region.el
+++ b/lisp/obsolete/s-region.el
@@ -1,6 +1,6 @@
;;; s-region.el --- set region using shift key
-;; Copyright (C) 1994-1995, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1995, 2001-2021 Free Software Foundation, Inc.
;; Author: Morten Welinder <terra@diku.dk>
;; Keywords: terminals
diff --git a/lisp/obsolete/sb-image.el b/lisp/obsolete/sb-image.el
index fd8884738d4..53ecfb7f268 100644
--- a/lisp/obsolete/sb-image.el
+++ b/lisp/obsolete/sb-image.el
@@ -1,6 +1,7 @@
;;; sb-image --- Image management for speedbar
-;; Copyright (C) 1999-2003, 2005-2019 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2003, 2005-2019, 2021 Free Software Foundation,
+;; Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: file, tags, tools
diff --git a/lisp/obsolete/sregex.el b/lisp/obsolete/sregex.el
index ad3671cef84..ac5f62dd67e 100644
--- a/lisp/obsolete/sregex.el
+++ b/lisp/obsolete/sregex.el
@@ -1,6 +1,6 @@
;;; sregex.el --- symbolic regular expressions
-;; Copyright (C) 1997-1998, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2000-2021 Free Software Foundation, Inc.
;; Author: Bob Glickstein <bobg+sregex@zanshin.com>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/obsolete/starttls.el b/lisp/obsolete/starttls.el
index df1a251dbe4..451c7eb2ffc 100644
--- a/lisp/obsolete/starttls.el
+++ b/lisp/obsolete/starttls.el
@@ -1,6 +1,6 @@
;;; starttls.el --- STARTTLS functions
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Author: Simon Josefsson <simon@josefsson.org>
diff --git a/lisp/obsolete/sup-mouse.el b/lisp/obsolete/sup-mouse.el
index 1852e20c199..f3db27f567e 100644
--- a/lisp/obsolete/sup-mouse.el
+++ b/lisp/obsolete/sup-mouse.el
@@ -1,6 +1,6 @@
;;; sup-mouse.el --- supdup mouse support for lisp machines
-;; Copyright (C) 1985-1986, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1986, 2001-2021 Free Software Foundation, Inc.
;; Author: Wolfgang Rupprecht
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/obsolete/terminal.el b/lisp/obsolete/terminal.el
index 6ee53af6483..bde656dfa6a 100644
--- a/lisp/obsolete/terminal.el
+++ b/lisp/obsolete/terminal.el
@@ -1,6 +1,6 @@
;;; terminal.el --- terminal emulator for GNU Emacs
-;; Copyright (C) 1986-1989, 1993-1994, 2001-2020 Free Software
+;; Copyright (C) 1986-1989, 1993-1994, 2001-2021 Free Software
;; Foundation, Inc.
;; Author: Richard Mlynarik <mly@eddie.mit.edu>
@@ -44,6 +44,7 @@
;;>> more-processing enabled.
(require 'ehelp)
+(require 'shell)
(defgroup terminal nil
"Terminal emulator for Emacs."
@@ -1056,12 +1057,6 @@ move to start of new line, clear to end of line."
;; This used to have `new' in it, but that loses outside BSD
;; and it's apparently not needed in BSD.
-(defcustom explicit-shell-file-name nil
- "If non-nil, is file name to use for explicitly requested inferior shell."
- :type '(choice (const :tag "None" nil)
- file)
- :group 'terminal)
-
;;;###autoload
(defun terminal-emulator (buffer program args &optional width height)
"Under a display-terminal emulator in BUFFER, run PROGRAM on arguments ARGS.
diff --git a/lisp/obsolete/tls.el b/lisp/obsolete/tls.el
index d1b215cbfb8..67a497f9412 100644
--- a/lisp/obsolete/tls.el
+++ b/lisp/obsolete/tls.el
@@ -1,6 +1,6 @@
;;; tls.el --- TLS/SSL support via wrapper around GnuTLS
-;; Copyright (C) 1996-1999, 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2002-2021 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
;; Keywords: comm, tls, gnutls, ssl
@@ -130,8 +130,10 @@ the external program knows about the root certificates you
consider trustworthy, e.g.:
\(setq tls-program
- \\='(\"gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt -p %p %h\"
- \"gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt -p %p %h --protocols ssl3\"))"
+ \\='(\"gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt \\
+-p %p %h\"
+ \"gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt \\
+-p %p %h --protocols ssl3\"))"
:type '(choice (const :tag "Always" t)
(const :tag "Never" nil)
(const :tag "Ask" ask))
diff --git a/lisp/obsolete/tpu-edt.el b/lisp/obsolete/tpu-edt.el
index 0de7aa096d6..78d88cf3774 100644
--- a/lisp/obsolete/tpu-edt.el
+++ b/lisp/obsolete/tpu-edt.el
@@ -1,6 +1,6 @@
;;; tpu-edt.el --- Emacs emulating TPU emulating EDT
-;; Copyright (C) 1993-1995, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1995, 2000-2021 Free Software Foundation, Inc.
;; Author: Rob Riepel <riepel@networking.stanford.edu>
;; Version: 4.5
diff --git a/lisp/obsolete/tpu-extras.el b/lisp/obsolete/tpu-extras.el
index f3b59ddd3c1..10b9c893721 100644
--- a/lisp/obsolete/tpu-extras.el
+++ b/lisp/obsolete/tpu-extras.el
@@ -1,6 +1,6 @@
;;; tpu-extras.el --- scroll margins and free cursor mode for TPU-edt
-;; Copyright (C) 1993-1995, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1995, 2000-2021 Free Software Foundation, Inc.
;; Author: Rob Riepel <riepel@networking.stanford.edu>
;; Keywords: emulations
diff --git a/lisp/obsolete/tpu-mapper.el b/lisp/obsolete/tpu-mapper.el
index f1c0bb8a848..2735820ae49 100644
--- a/lisp/obsolete/tpu-mapper.el
+++ b/lisp/obsolete/tpu-mapper.el
@@ -1,6 +1,6 @@
;;; tpu-mapper.el --- create a TPU-edt X-windows keymap file
-;; Copyright (C) 1993-1995, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1995, 2001-2021 Free Software Foundation, Inc.
;; Author: Rob Riepel <riepel@networking.stanford.edu>
;; Keywords: emulations
diff --git a/lisp/obsolete/url-ns.el b/lisp/obsolete/url-ns.el
index 848710571b4..fff3be95453 100644
--- a/lisp/obsolete/url-ns.el
+++ b/lisp/obsolete/url-ns.el
@@ -1,6 +1,6 @@
;;; url-ns.el --- Various netscape-ish functions for proxy definitions
-;; Copyright (C) 1997-1999, 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1999, 2004-2021 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
;; Obsolete-since: 27.1
diff --git a/lisp/obsolete/vc-arch.el b/lisp/obsolete/vc-arch.el
index 93bd991eb3a..80a2094d804 100644
--- a/lisp/obsolete/vc-arch.el
+++ b/lisp/obsolete/vc-arch.el
@@ -1,6 +1,6 @@
;;; vc-arch.el --- VC backend for the Arch version-control system -*- lexical-binding: t -*-
-;; Copyright (C) 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;; Author: FSF (see vc.el for full credits)
;; Maintainer: Stefan Monnier <monnier@gnu.org>
diff --git a/lisp/obsolete/vip.el b/lisp/obsolete/vip.el
index 37defd1c5a4..08085e51d74 100644
--- a/lisp/obsolete/vip.el
+++ b/lisp/obsolete/vip.el
@@ -1,6 +1,6 @@
;;; vip.el --- a VI Package for GNU Emacs
-;; Copyright (C) 1986-1988, 1992-1993, 1998, 2001-2020 Free Software
+;; Copyright (C) 1986-1988, 1992-1993, 1998, 2001-2021 Free Software
;; Foundation, Inc.
;; Author: Masahiko Sato <ms@sail.stanford.edu>
diff --git a/lisp/obsolete/ws-mode.el b/lisp/obsolete/ws-mode.el
index 086983202b8..d1ced86c468 100644
--- a/lisp/obsolete/ws-mode.el
+++ b/lisp/obsolete/ws-mode.el
@@ -1,6 +1,6 @@
;;; ws-mode.el --- WordStar emulation mode for GNU Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1991, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1991, 2001-2021 Free Software Foundation, Inc.
;; Author: Juergen Nickelsen <nickel@cs.tu-berlin.de>
;; Version: 0.7
diff --git a/lisp/obsolete/yow.el b/lisp/obsolete/yow.el
index 5efd63c90e7..76485f989c1 100644
--- a/lisp/obsolete/yow.el
+++ b/lisp/obsolete/yow.el
@@ -1,6 +1,6 @@
;;; yow.el --- quote random zippyisms
-;; Copyright (C) 1993-1995, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1995, 2000-2021 Free Software Foundation, Inc.
;; Author: Richard Mlynarik
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/org/ChangeLog.1 b/lisp/org/ChangeLog.1
index ef62ae7356c..d350a3117b0 100644
--- a/lisp/org/ChangeLog.1
+++ b/lisp/org/ChangeLog.1
@@ -32833,7 +32833,7 @@
;; add-log-time-zone-rule: t
;; End:
- Copyright (C) 2008-2020 Free Software Foundation, Inc.
+ Copyright (C) 2008-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/org/ob-C.el b/lisp/org/ob-C.el
index 3a26bc014b2..6e339017931 100644
--- a/lisp/org/ob-C.el
+++ b/lisp/org/ob-C.el
@@ -1,6 +1,6 @@
;;; ob-C.el --- Babel Functions for C and Similar Languages -*- lexical-binding: t; -*-
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Thierry Banel
@@ -182,7 +182,7 @@ or `org-babel-execute:C++' or `org-babel-execute:D'."
cmdline)))
"")))
(when results
- (setq results (org-trim (org-remove-indentation results)))
+ (setq results (org-remove-indentation results))
(org-babel-reassemble-table
(org-babel-result-cond (cdr (assq :result-params params))
(org-babel-read results t)
@@ -232,7 +232,13 @@ its header arguments."
(list
;; includes
(mapconcat
- (lambda (inc) (format "#include %s" inc))
+ (lambda (inc)
+ ;; :includes '(<foo> <bar>) gives us a list of
+ ;; symbols; convert those to strings.
+ (when (symbolp inc) (setq inc (symbol-name inc)))
+ (if (string-prefix-p "<" inc)
+ (format "#include %s" inc)
+ (format "#include \"%s\"" inc)))
includes "\n")
;; defines
(mapconcat
diff --git a/lisp/org/ob-J.el b/lisp/org/ob-J.el
index c0145211bd3..0c5591d5b71 100644
--- a/lisp/org/ob-J.el
+++ b/lisp/org/ob-J.el
@@ -1,8 +1,9 @@
;;; ob-J.el --- Babel Functions for J -*- lexical-binding: t; -*-
-;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
;; Author: Oleh Krehel
+;; Maintainer: Joseph Novakovich <josephnovakovich@gmail.com>
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
@@ -76,6 +77,8 @@ This function is called by `org-babel-execute-src-block'."
(message "executing J source code block")
(let* ((processed-params (org-babel-process-params params))
(sessionp (cdr (assq :session params)))
+ (sit-time (let ((sit (assq :sit params)))
+ (if sit (cdr sit) .1)))
(full-body (org-babel-expand-body:J
body params processed-params))
(tmp-script-file (org-babel-temp-file "J-src")))
@@ -86,9 +89,9 @@ This function is called by `org-babel-execute-src-block'."
(with-temp-file tmp-script-file
(insert full-body))
(org-babel-eval (format "%s < %s" org-babel-J-command tmp-script-file) ""))
- (org-babel-J-eval-string full-body)))))
+ (org-babel-J-eval-string full-body sit-time)))))
-(defun org-babel-J-eval-string (str)
+(defun org-babel-J-eval-string (str sit-time)
"Sends STR to the `j-console-cmd' session and executes it."
(let ((session (j-console-ensure-session)))
(with-current-buffer (process-buffer session)
@@ -96,7 +99,7 @@ This function is called by `org-babel-execute-src-block'."
(insert (format "\n%s\n" str))
(let ((beg (point)))
(comint-send-input)
- (sit-for .1)
+ (sit-for sit-time)
(buffer-substring-no-properties
beg (point-max))))))
diff --git a/lisp/org/ob-R.el b/lisp/org/ob-R.el
index b52c7591ad2..309a0acf7e7 100644
--- a/lisp/org/ob-R.el
+++ b/lisp/org/ob-R.el
@@ -1,6 +1,6 @@
;;; ob-R.el --- Babel Functions for R -*- lexical-binding: t; -*-
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Dan Davison
@@ -193,7 +193,8 @@ This function is called by `org-babel-execute-src-block'."
(org-babel-comint-in-buffer session
(mapc (lambda (var)
(end-of-line 1) (insert var) (comint-send-input nil t)
- (org-babel-comint-wait-for-output session)) var-lines))
+ (org-babel-comint-wait-for-output session))
+ var-lines))
session))
(defun org-babel-load-session:R (session body params)
@@ -360,7 +361,7 @@ Each member of this list is a list with three members:
)
}
}(object=%s,transfer.file=\"%s\")"
- "A template for an R command to evaluate a block of code and write the result to a file.
+ "Template for an R command to evaluate a block of code and write result to file.
Has four %s escapes to be filled in:
1. Row names, \"TRUE\" or \"FALSE\"
@@ -459,11 +460,11 @@ last statement in BODY, as elisp."
"R-specific processing of return value.
Insert hline if column names in output have been requested."
(if column-names-p
- (cons (car result) (cons 'hline (cdr result)))
+ (condition-case nil
+ (cons (car result) (cons 'hline (cdr result)))
+ (error "Could not parse R result"))
result))
(provide 'ob-R)
-
-
;;; ob-R.el ends here
diff --git a/lisp/org/ob-abc.el b/lisp/org/ob-abc.el
index d473118639a..404e39fc27c 100644
--- a/lisp/org/ob-abc.el
+++ b/lisp/org/ob-abc.el
@@ -1,11 +1,10 @@
;;; ob-abc.el --- Org Babel Functions for ABC -*- lexical-binding: t; -*-
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; Author: William Waites
;; Keywords: literate programming, music
-;; Homepage: http://www.tardis.ed.ac.uk/wwaites
-;; Version: 0.01
+;; Homepage: https://www.tardis.ed.ac.uk/~wwaites
;; This file is part of GNU Emacs.
@@ -87,4 +86,5 @@
(error "ABC does not support sessions"))
(provide 'ob-abc)
+
;;; ob-abc.el ends here
diff --git a/lisp/org/ob-asymptote.el b/lisp/org/ob-asymptote.el
index bdc74b84920..bfb5b79145e 100644
--- a/lisp/org/ob-asymptote.el
+++ b/lisp/org/ob-asymptote.el
@@ -1,6 +1,6 @@
;;; ob-asymptote.el --- Babel Functions for Asymptote -*- lexical-binding: t; -*-
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -134,6 +134,4 @@ Otherwise, it is either `real', if some elements are floats, or
(provide 'ob-asymptote)
-
-
;;; ob-asymptote.el ends here
diff --git a/lisp/org/ob-awk.el b/lisp/org/ob-awk.el
index 74bbc4c2be1..b41d70f12ca 100644
--- a/lisp/org/ob-awk.el
+++ b/lisp/org/ob-awk.el
@@ -1,6 +1,6 @@
;;; ob-awk.el --- Babel Functions for Awk -*- lexical-binding: t; -*-
-;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -106,6 +106,4 @@ This function is called by `org-babel-execute-src-block'."
(provide 'ob-awk)
-
-
;;; ob-awk.el ends here
diff --git a/lisp/org/ob-calc.el b/lisp/org/ob-calc.el
index 85bcf1d4132..39ebce10020 100644
--- a/lisp/org/ob-calc.el
+++ b/lisp/org/ob-calc.el
@@ -1,6 +1,6 @@
;;; ob-calc.el --- Babel Functions for Calc -*- lexical-binding: t; -*-
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -105,6 +105,4 @@
(provide 'ob-calc)
-
-
;;; ob-calc.el ends here
diff --git a/lisp/org/ob-clojure.el b/lisp/org/ob-clojure.el
index 0d6d1c0a84a..df2d691f68b 100644
--- a/lisp/org/ob-clojure.el
+++ b/lisp/org/ob-clojure.el
@@ -1,6 +1,6 @@
;;; ob-clojure.el --- Babel Functions for Clojure -*- lexical-binding: t; -*-
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Joel Boehland, Eric Schulte, Oleh Krehel, Frederick Giasson
;;
@@ -30,80 +30,70 @@
;; - clojure (at least 1.2.0)
;; - clojure-mode
-;; - either cider or SLIME
+;; - inf-clojure, cider or SLIME
-;; For Cider, see https://github.com/clojure-emacs/cider
+;; For clojure-mode, see https://github.com/clojure-emacs/clojure-mode
+;; For cider, see https://github.com/clojure-emacs/cider
+;; For inf-clojure, see https://github.com/clojure-emacs/cider
;; For SLIME, the best way to install these components is by following
;; the directions as set out by Phil Hagelberg (Technomancy) on the
;; web page: http://technomancy.us/126
;;; Code:
-(require 'cl-lib)
(require 'ob)
-(require 'org-macs)
-(declare-function cider-jack-in "ext:cider" (&optional prompt-project cljs-too))
(declare-function cider-current-connection "ext:cider-client" (&optional type))
(declare-function cider-current-ns "ext:cider-client" ())
-(declare-function cider-repls "ext:cider-connection" (&optional type ensure))
-(declare-function nrepl--merge "ext:nrepl-client" (dict1 dict2))
+(declare-function inf-clojure "ext:inf-clojure" (cmd))
+(declare-function inf-clojure-cmd "ext:inf-clojure" (project-type))
+(declare-function inf-clojure-eval-string "ext:inf-clojure" (code))
+(declare-function inf-clojure-project-type "ext:inf-clojure" ())
(declare-function nrepl-dict-get "ext:nrepl-client" (dict key))
-(declare-function nrepl-dict-put "ext:nrepl-client" (dict key value))
-(declare-function nrepl-request:eval "ext:nrepl-client" (input callback connection &optional ns line column additional-params tooling))
(declare-function nrepl-sync-request:eval "ext:nrepl-client" (input connection &optional ns tooling))
+(declare-function sesman-start-session "ext:sesman" (system))
(declare-function slime-eval "ext:slime" (sexp &optional package))
-(defvar nrepl-sync-request-timeout)
(defvar cider-buffer-ns)
-(defvar sesman-system)
-(defvar cider-version)
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("clojure" . "clj"))
+(add-to-list 'org-babel-tangle-lang-exts '("clojurescript" . "cljs"))
(defvar org-babel-default-header-args:clojure '())
-(defvar org-babel-header-args:clojure '((ns . :any)
- (package . :any)))
+(defvar org-babel-header-args:clojure '((ns . :any) (package . :any)))
+(defvar org-babel-default-header-args:clojurescript '())
+(defvar org-babel-header-args:clojurescript '((package . :any)))
-(defcustom org-babel-clojure-sync-nrepl-timeout 10
- "Timeout value, in seconds, of a Clojure sync call.
-If the value is nil, timeout is disabled."
- :group 'org-babel
- :type 'integer
- :version "26.1"
- :package-version '(Org . "9.1")
- :safe #'wholenump)
-
-(defcustom org-babel-clojure-backend
- (cond ((featurep 'cider) 'cider)
- (t 'slime))
+(defcustom org-babel-clojure-backend nil
"Backend used to evaluate Clojure code blocks."
:group 'org-babel
:type '(choice
+ (const :tag "inf-clojure" inf-clojure)
(const :tag "cider" cider)
- (const :tag "SLIME" slime)))
+ (const :tag "slime" slime)
+ (const :tag "Not configured yet" nil)))
(defcustom org-babel-clojure-default-ns "user"
"Default Clojure namespace for source block when finding ns failed."
:type 'string
:group 'org-babel)
-(defun org-babel-clojure-cider-current-ns ()
- "Like `cider-current-ns' except `cider-find-ns'."
- (or cider-buffer-ns
- (let ((repl-buf (cider-current-connection)))
- (and repl-buf (buffer-local-value 'cider-buffer-ns repl-buf)))
- org-babel-clojure-default-ns))
-
(defun org-babel-expand-body:clojure (body params)
"Expand BODY according to PARAMS, return the expanded body."
(let* ((vars (org-babel--get-vars params))
(ns (or (cdr (assq :ns params))
- (org-babel-clojure-cider-current-ns)))
+ (if (eq org-babel-clojure-backend 'cider)
+ (or cider-buffer-ns
+ (let ((repl-buf (cider-current-connection)))
+ (and repl-buf (buffer-local-value
+ 'cider-buffer-ns repl-buf))))
+ org-babel-clojure-default-ns)))
(result-params (cdr (assq :result-params params)))
(print-level nil)
(print-length nil)
+ ;; Remove comments, they break (let [...] ...) bindings
+ (body (replace-regexp-in-string "^[ ]*;+.*$" "" body))
(body (org-trim
(concat
;; Source block specified namespace :ns.
@@ -113,7 +103,7 @@ If the value is nil, timeout is disabled."
(format "(let [%s]\n%s)"
(mapconcat
(lambda (var)
- (format "%S (quote %S)" (car var) (cdr var)))
+ (format "%S %S" (car var) (cdr var)))
vars
"\n ")
body))))))
@@ -122,161 +112,141 @@ If the value is nil, timeout is disabled."
(format "(clojure.pprint/pprint (do %s))" body)
body)))
+(defvar ob-clojure-inf-clojure-filter-out)
+(defvar ob-clojure-inf-clojure-tmp-output)
+(defun ob-clojure-inf-clojure-output (s)
+ "Store a trimmed version of S in a variable and return S."
+ (let ((s0 (org-trim
+ (replace-regexp-in-string
+ ob-clojure-inf-clojure-filter-out "" s))))
+ (push s0 ob-clojure-inf-clojure-tmp-output))
+ s)
+
+(defmacro ob-clojure-with-temp-expanded (expanded params &rest body)
+ "Run BODY on EXPANDED code block with PARAMS."
+ (declare (debug (body)) (indent 2))
+ `(with-temp-buffer
+ (insert ,expanded)
+ (goto-char (point-min))
+ (while (not (looking-at "\\s-*\\'"))
+ (let* ((beg (point))
+ (end (progn (forward-sexp) (point)))
+ (exp (org-babel-expand-body:clojure
+ (buffer-substring beg end) ,params)))
+ (sit-for .1)
+ ,@body))))
+
+(defsubst ob-clojure-string-or-list (l)
+ "Convert list L into a string or a list of list."
+ (if (and (listp l) (= (length l) 1))
+ (car l)
+ (mapcar #'list l)))
+
+(defvar inf-clojure-buffer)
+(defvar comint-prompt-regexp)
+(defvar inf-clojure-comint-prompt-regexp)
+(defun ob-clojure-eval-with-inf-clojure (expanded params)
+ "Evaluate EXPANDED code block with PARAMS using inf-clojure."
+ (condition-case nil (require 'inf-clojure)
+ (user-error "inf-clojure not available"))
+ ;; Maybe initiate the inf-clojure session
+ (unless (and inf-clojure-buffer
+ (buffer-live-p (get-buffer inf-clojure-buffer)))
+ (save-window-excursion
+ (let* ((alias (cdr (assq :alias params)))
+ (cmd0 (inf-clojure-cmd (inf-clojure-project-type)))
+ (cmd (if alias (replace-regexp-in-string
+ "clojure" (format "clojure -A%s" alias)
+ cmd0)
+ cmd0)))
+ (setq comint-prompt-regexp inf-clojure-comint-prompt-regexp)
+ (funcall-interactively #'inf-clojure cmd)
+ (goto-char (point-max))))
+ (sit-for 1))
+ ;; Now evaluate the code
+ (setq ob-clojure-inf-clojure-filter-out
+ (concat "^nil\\|nil$\\|\\s-*"
+ (or (cdr (assq :ns params))
+ org-babel-clojure-default-ns)
+ "=>\\s-*"))
+ (add-hook 'comint-preoutput-filter-functions
+ #'ob-clojure-inf-clojure-output)
+ (setq ob-clojure-inf-clojure-tmp-output nil)
+ (ob-clojure-with-temp-expanded expanded nil
+ (inf-clojure-eval-string exp))
+ (sit-for .5)
+ (remove-hook 'comint-preoutput-filter-functions
+ #'ob-clojure-inf-clojure-output)
+ ;; And return the result
+ (ob-clojure-string-or-list
+ (delete nil
+ (mapcar
+ (lambda (s)
+ (unless (or (equal "" s)
+ (string-match-p "^Clojure" s))
+ s))
+ (reverse ob-clojure-inf-clojure-tmp-output)))))
+
+(defun ob-clojure-eval-with-cider (expanded params)
+ "Evaluate EXPANDED code block with PARAMS using cider."
+ (condition-case nil (require 'cider)
+ (user-error "cider not available"))
+ (let ((connection (cider-current-connection (cdr (assq :target params))))
+ (result-params (cdr (assq :result-params params)))
+ result0)
+ (unless connection (sesman-start-session 'CIDER))
+ (if (not connection)
+ ;; Display in the result instead of using `user-error'
+ (setq result0 "Please reevaluate when nREPL is connected")
+ (ob-clojure-with-temp-expanded expanded params
+ (let ((response (nrepl-sync-request:eval exp connection)))
+ (push (or (nrepl-dict-get response "root-ex")
+ (nrepl-dict-get response "ex")
+ (nrepl-dict-get
+ response (if (or (member "output" result-params)
+ (member "pp" result-params))
+ "out"
+ "value")))
+ result0)))
+ (ob-clojure-string-or-list
+ (reverse (delete "" (mapcar (lambda (r)
+ (replace-regexp-in-string "nil" "" r))
+ result0)))))))
+
+(defun ob-clojure-eval-with-slime (expanded params)
+ "Evaluate EXPANDED code block with PARAMS using slime."
+ (condition-case nil (require 'slime)
+ (user-error "slime not available"))
+ (with-temp-buffer
+ (insert expanded)
+ (slime-eval
+ `(swank:eval-and-grab-output
+ ,(buffer-substring-no-properties (point-min) (point-max)))
+ (cdr (assq :package params)))))
+
(defun org-babel-execute:clojure (body params)
- "Execute a block of Clojure code with Babel.
-The underlying process performed by the code block can be output
-using the :show-process parameter."
+ "Execute a block of Clojure code with Babel."
+ (unless org-babel-clojure-backend
+ (user-error "You need to customize org-babel-clojure-backend"))
(let* ((expanded (org-babel-expand-body:clojure body params))
- (response (list 'dict))
- result)
- (cl-case org-babel-clojure-backend
- (cider
- (require 'cider)
- (let ((result-params (cdr (assq :result-params params)))
- (show (cdr (assq :show-process params))))
- (if (member show '(nil "no"))
- ;; Run code without showing the process.
- (progn
- (setq response
- (let ((nrepl-sync-request-timeout
- org-babel-clojure-sync-nrepl-timeout))
- (nrepl-sync-request:eval expanded
- (cider-current-connection))))
- (setq result
- (concat
- (nrepl-dict-get response
- (if (or (member "output" result-params)
- (member "pp" result-params))
- "out"
- "value"))
- (nrepl-dict-get response "ex")
- (nrepl-dict-get response "root-ex")
- (nrepl-dict-get response "err"))))
- ;; Show the process in an output buffer/window.
- (let ((process-buffer (switch-to-buffer-other-window
- "*Clojure Show Process Sub Buffer*"))
- status)
- ;; Run the Clojure code in nREPL.
- (nrepl-request:eval
- expanded
- (lambda (resp)
- (when (member "out" resp)
- ;; Print the output of the nREPL in the output buffer.
- (princ (nrepl-dict-get resp "out") process-buffer))
- (when (member "ex" resp)
- ;; In case there is an exception, then add it to the
- ;; output buffer as well.
- (princ (nrepl-dict-get resp "ex") process-buffer)
- (princ (nrepl-dict-get resp "root-ex") process-buffer))
- (when (member "err" resp)
- ;; In case there is an error, then add it to the
- ;; output buffer as well.
- (princ (nrepl-dict-get resp "err") process-buffer))
- (nrepl--merge response resp)
- ;; Update the status of the nREPL output session.
- (setq status (nrepl-dict-get response "status")))
- (cider-current-connection))
-
- ;; Wait until the nREPL code finished to be processed.
- (while (not (member "done" status))
- (nrepl-dict-put response "status" (remove "need-input" status))
- (accept-process-output nil 0.01)
- (redisplay))
-
- ;; Delete the show buffer & window when the processing is
- ;; finalized.
- (mapc #'delete-window
- (get-buffer-window-list process-buffer nil t))
- (kill-buffer process-buffer)
-
- ;; Put the output or the value in the result section of
- ;; the code block.
- (setq result
- (concat
- (nrepl-dict-get response
- (if (or (member "output" result-params)
- (member "pp" result-params))
- "out"
- "value"))
- (nrepl-dict-get response "ex")
- (nrepl-dict-get response "root-ex")
- (nrepl-dict-get response "err")))))))
- (slime
- (require 'slime)
- (with-temp-buffer
- (insert expanded)
- (setq result
- (slime-eval
- `(swank:eval-and-grab-output
- ,(buffer-substring-no-properties (point-min) (point-max)))
- (cdr (assq :package params)))))))
- (org-babel-result-cond (cdr (assq :result-params params))
+ (result-params (cdr (assq :result-params params)))
+ result)
+ (setq result
+ (cond
+ ((eq org-babel-clojure-backend 'inf-clojure)
+ (ob-clojure-eval-with-inf-clojure expanded params))
+ ((eq org-babel-clojure-backend 'cider)
+ (ob-clojure-eval-with-cider expanded params))
+ ((eq org-babel-clojure-backend 'slime)
+ (ob-clojure-eval-with-slime expanded params))))
+ (org-babel-result-cond result-params
result
(condition-case nil (org-babel-script-escape result)
(error result)))))
-(defun org-babel-clojure-initiate-session (&optional session _params)
- "Initiate a session named SESSION according to PARAMS."
- (when (and session (not (string= session "none")))
- (save-window-excursion
- (cond
- ((org-babel-comint-buffer-livep session) nil)
- ;; CIDER jack-in to the Clojure project directory.
- ((eq org-babel-clojure-backend 'cider)
- (require 'cider)
- (let ((session-buffer
- (save-window-excursion
- (if (version< cider-version "0.18.0")
- ;; Older CIDER (without sesman) still need to use
- ;; old way.
- (cider-jack-in nil) ;jack-in without project
- ;; New CIDER (with sesman to manage sessions).
- (unless (cider-repls)
- (let ((sesman-system 'CIDER))
- (call-interactively 'sesman-link-with-directory))))
- (current-buffer))))
- (when (org-babel-comint-buffer-livep session-buffer)
- (sit-for .25)
- session-buffer)))
- ((eq org-babel-clojure-backend 'slime)
- (error "Session evaluation with SLIME is not supported"))
- (t
- (error "Session initiate failed")))
- (get-buffer session))))
-
-(defun org-babel-prep-session:clojure (session params)
- "Prepare SESSION according to the header arguments specified in PARAMS."
- (let ((session (org-babel-clojure-initiate-session session))
- (var-lines (org-babel-variable-assignments:clojure params)))
- (when session
- (org-babel-comint-in-buffer session
- (dolist (var var-lines)
- (insert var)
- (comint-send-input nil t)
- (org-babel-comint-wait-for-output session)
- (sit-for .1)
- (goto-char (point-max)))))
- session))
-
-(defun org-babel-clojure-var-to-clojure (var)
- "Convert src block's VAR to Clojure variable."
- (cond
- ((listp var)
- (replace-regexp-in-string "(" "'(" var))
- ((stringp var)
- ;; Wrap Babel passed-in header argument value with quotes in Clojure.
- (format "\"%s\"" var))
- (t
- (format "%S" var))))
-
-(defun org-babel-variable-assignments:clojure (params)
- "Return a list of Clojure statements assigning the block's variables in PARAMS."
- (mapcar
- (lambda (pair)
- (format "(def %s %s)"
- (car pair)
- (org-babel-clojure-var-to-clojure (cdr pair))))
- (org-babel--get-vars params)))
+(defun org-babel-execute:clojurescript (body params)
+ "Evaluate BODY with PARAMS as ClojureScript code."
+ (org-babel-execute:clojure body (cons '(:target . "cljs") params)))
(provide 'ob-clojure)
diff --git a/lisp/org/ob-comint.el b/lisp/org/ob-comint.el
index 552b7a037cf..18d4f3c9388 100644
--- a/lisp/org/ob-comint.el
+++ b/lisp/org/ob-comint.el
@@ -1,6 +1,6 @@
;;; ob-comint.el --- Babel Functions for Interaction with Comint Buffers -*- lexical-binding: t; -*-
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, comint
@@ -151,6 +151,4 @@ FILE exists at end of evaluation."
(provide 'ob-comint)
-
-
;;; ob-comint.el ends here
diff --git a/lisp/org/ob-coq.el b/lisp/org/ob-coq.el
index d04a40dd3b3..c77e8c9af69 100644
--- a/lisp/org/ob-coq.el
+++ b/lisp/org/ob-coq.el
@@ -1,6 +1,6 @@
;;; ob-coq.el --- Babel Functions for Coq -*- lexical-binding: t; -*-
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -76,3 +76,5 @@ create one. Return the initialized session."
(get-buffer org-babel-coq-buffer))
(provide 'ob-coq)
+
+;;; ob-coq.el ends here
diff --git a/lisp/org/ob-core.el b/lisp/org/ob-core.el
index fe9af1ce602..1343410792a 100644
--- a/lisp/org/ob-core.el
+++ b/lisp/org/ob-core.el
@@ -1,6 +1,6 @@
;;; ob-core.el --- Working with Code Blocks -*- lexical-binding: t; -*-
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Authors: Eric Schulte
;; Dan Davison
@@ -38,6 +38,7 @@
(defvar org-link-file-path-type)
(defvar org-src-lang-modes)
(defvar org-src-preserve-indentation)
+(defvar org-babel-tangle-uncomment-comments)
(declare-function org-at-item-p "org-list" ())
(declare-function org-at-table-p "org" (&optional table-type))
@@ -59,6 +60,7 @@
(declare-function org-element-type "org-element" (element))
(declare-function org-entry-get "org" (pom property &optional inherit literal-nil))
(declare-function org-escape-code-in-region "org-src" (beg end))
+(declare-function org-forward-heading-same-level "org" (arg &optional invisible-ok))
(declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
(declare-function org-indent-line "org" ())
(declare-function org-list-get-list-end "org-list" (item struct prevs))
@@ -67,7 +69,6 @@
(declare-function org-list-to-generic "org-list" (LIST PARAMS))
(declare-function org-list-to-lisp "org-list" (&optional delete))
(declare-function org-macro-escape-arguments "org-macro" (&rest args))
-(declare-function org-make-options-regexp "org" (kwds &optional extra))
(declare-function org-mark-ring-push "org" (&optional pos buffer))
(declare-function org-narrow-to-subtree "org" ())
(declare-function org-next-block "org" (arg &optional backward block-regexp))
@@ -78,6 +79,7 @@
(declare-function org-src-coderef-regexp "org-src" (fmt &optional label))
(declare-function org-src-get-lang-mode "org-src" (lang))
(declare-function org-table-align "org-table" ())
+(declare-function org-table-convert-region "org-table" (beg0 end0 &optional separator))
(declare-function org-table-end "org-table" (&optional table-type))
(declare-function org-table-import "org-table" (file arg))
(declare-function org-table-to-lisp "org-table" (&optional txt))
@@ -164,7 +166,6 @@ This string must include a \"%s\" which will be replaced by the results."
"Non-nil means show the time the code block was evaluated in the result hash."
:group 'org-babel
:type 'boolean
- :version "26.1"
:package-version '(Org . "9.0")
:safe #'booleanp)
@@ -238,7 +239,8 @@ should be asked whether to allow evaluation."
(if (functionp org-confirm-babel-evaluate)
(funcall org-confirm-babel-evaluate
;; Language, code block body.
- (nth 0 info) (nth 1 info))
+ (nth 0 info)
+ (org-babel--expand-body info))
org-confirm-babel-evaluate))))
(cond
(noeval nil)
@@ -400,6 +402,7 @@ then run `org-babel-switch-to-session'."
(file . :any)
(file-desc . :any)
(file-ext . :any)
+ (file-mode . ((#o755 #o555 #o444 :any)))
(hlines . ((no yes)))
(mkdirp . ((yes no)))
(no-expand)
@@ -487,11 +490,21 @@ For the format of SAFE-LIST, see `org-babel-safe-header-args'."
"Regexp matching a NAME keyword.")
(defconst org-babel-result-regexp
- (format "^[ \t]*#\\+%s\\(?:\\[\\(?:%s \\)?\\([[:alnum:]]+\\)\\]\\)?:[ \t]*"
- org-babel-results-keyword
- ;; <%Y-%m-%d %H:%M:%S>
- "<\\(?:[0-9]\\{4\\}-[0-1][0-9]-[0-3][0-9] \
-[0-2][0-9]\\(?::[0-5][0-9]\\)\\{2\\}\\)>")
+ (rx (seq bol
+ (zero-or-more (any "\t "))
+ "#+results"
+ (opt "["
+ ;; Time stamp part.
+ (opt "("
+ (= 4 digit) (= 2 "-" (= 2 digit))
+ " "
+ (= 2 digit) (= 2 ":" (= 2 digit))
+ ") ")
+ ;; SHA1 hash.
+ (group (one-or-more hex-digit))
+ "]")
+ ":"
+ (zero-or-more (any "\t "))))
"Regular expression used to match result lines.
If the results are associated with a hash key then the hash will
be saved in match group 1.")
@@ -622,6 +635,17 @@ a list with the following pattern:
(setf (nth 2 info) (org-babel-generate-file-param name (nth 2 info)))
info))))
+(defun org-babel--expand-body (info)
+ "Expand noweb references in body and remove any coderefs."
+ (let ((coderef (nth 6 info))
+ (expand
+ (if (org-babel-noweb-p (nth 2 info) :eval)
+ (org-babel-expand-noweb-references info)
+ (nth 1 info))))
+ (if (not coderef) expand
+ (replace-regexp-in-string
+ (org-src-coderef-regexp coderef) "" expand nil nil 1))))
+
;;;###autoload
(defun org-babel-execute-src-block (&optional arg info params)
"Execute the current source code block.
@@ -667,17 +691,7 @@ block."
((org-babel-confirm-evaluate info)
(let* ((lang (nth 0 info))
(result-params (cdr (assq :result-params params)))
- ;; Expand noweb references in BODY and remove any
- ;; coderef.
- (body
- (let ((coderef (nth 6 info))
- (expand
- (if (org-babel-noweb-p params :eval)
- (org-babel-expand-noweb-references info)
- (nth 1 info))))
- (if (not coderef) expand
- (replace-regexp-in-string
- (org-src-coderef-regexp coderef) "" expand nil nil 1))))
+ (body (org-babel--expand-body info))
(dir (cdr (assq :dir params)))
(mkdirp (cdr (assq :mkdirp params)))
(default-directory
@@ -721,7 +735,11 @@ block."
(with-temp-file file
(insert (org-babel-format-result
result
- (cdr (assq :sep params))))))
+ (cdr (assq :sep params)))))
+ ;; Set file permissions if header argument
+ ;; `:file-mode' is provided.
+ (when (assq :file-mode params)
+ (set-file-modes file (cdr (assq :file-mode params)))))
(setq result file))
;; Possibly perform post process provided its
;; appropriate. Dynamically bind "*this*" to the
@@ -1301,10 +1319,9 @@ CONTEXT specifies the context of evaluation. It can be `:eval',
"Return the current in-buffer hash."
(let ((result (org-babel-where-is-src-block-result nil info)))
(when result
- (org-with-wide-buffer
- (goto-char result)
- (looking-at org-babel-result-regexp)
- (match-string-no-properties 1)))))
+ (org-with-point-at result
+ (let ((case-fold-search t)) (looking-at org-babel-result-regexp))
+ (match-string-no-properties 1)))))
(defun org-babel-hide-hash ()
"Hide the hash in the current results line.
@@ -1312,7 +1329,8 @@ Only the initial `org-babel-hash-show' characters of the hash
will remain visible."
(add-to-invisibility-spec '(org-babel-hide-hash . t))
(save-excursion
- (when (and (re-search-forward org-babel-result-regexp nil t)
+ (when (and (let ((case-fold-search t))
+ (re-search-forward org-babel-result-regexp nil t))
(match-string 1))
(let* ((start (match-beginning 1))
(hide-start (+ org-babel-hash-show start))
@@ -1330,11 +1348,12 @@ Only the initial `org-babel-hash-show' characters of each hash
will remain visible. This function should be called as part of
the `org-mode-hook'."
(save-excursion
- (while (and (not org-babel-hash-show-time)
- (re-search-forward org-babel-result-regexp nil t))
- (goto-char (match-beginning 0))
- (org-babel-hide-hash)
- (goto-char (match-end 0)))))
+ (let ((case-fold-search t))
+ (while (and (not org-babel-hash-show-time)
+ (re-search-forward org-babel-result-regexp nil t))
+ (goto-char (match-beginning 0))
+ (org-babel-hide-hash)
+ (goto-char (match-end 0))))))
(add-hook 'org-mode-hook 'org-babel-hide-all-hashes)
(defun org-babel-hash-at-point (&optional point)
@@ -1363,9 +1382,10 @@ portions of results lines."
(interactive)
(org-babel-show-result-all)
(save-excursion
- (while (re-search-forward org-babel-result-regexp nil t)
- (save-excursion (goto-char (match-beginning 0))
- (org-babel-hide-result-toggle-maybe)))))
+ (let ((case-fold-search t))
+ (while (re-search-forward org-babel-result-regexp nil t)
+ (save-excursion (goto-char (match-beginning 0))
+ (org-babel-hide-result-toggle-maybe))))))
(defun org-babel-show-result-all ()
"Unfold all results in the current buffer."
@@ -1377,52 +1397,50 @@ portions of results lines."
"Toggle visibility of result at point."
(interactive)
(let ((case-fold-search t))
- (if (save-excursion
- (beginning-of-line 1)
- (looking-at org-babel-result-regexp))
- (progn (org-babel-hide-result-toggle)
- t) ;; to signal that we took action
- nil))) ;; to signal that we did not
+ (and (org-match-line org-babel-result-regexp)
+ (progn (org-babel-hide-result-toggle) t))))
(defun org-babel-hide-result-toggle (&optional force)
"Toggle the visibility of the current result."
(interactive)
(save-excursion
(beginning-of-line)
- (if (re-search-forward org-babel-result-regexp nil t)
- (let ((start (progn (beginning-of-line 2) (- (point) 1)))
- (end (progn
- (while (looking-at org-babel-multi-line-header-regexp)
- (forward-line 1))
- (goto-char (- (org-babel-result-end) 1)) (point)))
- ov)
- (if (memq t (mapcar (lambda (overlay)
- (eq (overlay-get overlay 'invisible)
- 'org-babel-hide-result))
- (overlays-at start)))
- (when (or (not force) (eq force 'off))
- (mapc (lambda (ov)
- (when (member ov org-babel-hide-result-overlays)
- (setq org-babel-hide-result-overlays
- (delq ov org-babel-hide-result-overlays)))
- (when (eq (overlay-get ov 'invisible)
- 'org-babel-hide-result)
- (delete-overlay ov)))
- (overlays-at start)))
- (setq ov (make-overlay start end))
- (overlay-put ov 'invisible 'org-babel-hide-result)
- ;; make the block accessible to isearch
- (overlay-put
- ov 'isearch-open-invisible
- (lambda (ov)
- (when (member ov org-babel-hide-result-overlays)
- (setq org-babel-hide-result-overlays
- (delq ov org-babel-hide-result-overlays)))
- (when (eq (overlay-get ov 'invisible)
- 'org-babel-hide-result)
- (delete-overlay ov))))
- (push ov org-babel-hide-result-overlays)))
- (error "Not looking at a result line"))))
+ (let ((case-fold-search t))
+ (unless (re-search-forward org-babel-result-regexp nil t)
+ (error "Not looking at a result line")))
+ (let ((start (progn (beginning-of-line 2) (1- (point))))
+ (end (progn
+ (while (looking-at org-babel-multi-line-header-regexp)
+ (forward-line 1))
+ (goto-char (1- (org-babel-result-end)))
+ (point)))
+ ov)
+ (if (memq t (mapcar (lambda (overlay)
+ (eq (overlay-get overlay 'invisible)
+ 'org-babel-hide-result))
+ (overlays-at start)))
+ (when (or (not force) (eq force 'off))
+ (mapc (lambda (ov)
+ (when (member ov org-babel-hide-result-overlays)
+ (setq org-babel-hide-result-overlays
+ (delq ov org-babel-hide-result-overlays)))
+ (when (eq (overlay-get ov 'invisible)
+ 'org-babel-hide-result)
+ (delete-overlay ov)))
+ (overlays-at start)))
+ (setq ov (make-overlay start end))
+ (overlay-put ov 'invisible 'org-babel-hide-result)
+ ;; make the block accessible to isearch
+ (overlay-put
+ ov 'isearch-open-invisible
+ (lambda (ov)
+ (when (member ov org-babel-hide-result-overlays)
+ (setq org-babel-hide-result-overlays
+ (delq ov org-babel-hide-result-overlays)))
+ (when (eq (overlay-get ov 'invisible)
+ 'org-babel-hide-result)
+ (delete-overlay ov))))
+ (push ov org-babel-hide-result-overlays)))))
;; org-tab-after-check-for-cycling-hook
(add-hook 'org-tab-first-hook 'org-babel-hide-result-toggle-maybe)
@@ -1654,7 +1672,8 @@ Note: this function removes any hlines in TABLE."
(mapcar (lambda (row)
(if (listp row)
(cons (or (pop rownames) "") row)
- row)) table)
+ row))
+ table)
table))
(defun org-babel-pick-name (names selector)
@@ -1879,9 +1898,9 @@ region is not active then the point is demarcated."
(block (and start (match-string 0)))
(headers (and start (match-string 4)))
(stars (concat (make-string (or (org-current-level) 1) ?*) " "))
- (lower-case-p (and block
+ (upper-case-p (and block
(let (case-fold-search)
- (string-match-p "#\\+begin_src" block)))))
+ (string-match-p "#\\+BEGIN_SRC" block)))))
(if info
(mapc
(lambda (place)
@@ -1895,9 +1914,9 @@ region is not active then the point is demarcated."
(delete-region (point-at-bol) (point-at-eol)))
(insert (concat
(if (looking-at "^") "" "\n")
- indent (funcall (if lower-case-p 'downcase 'upcase) "#+end_src\n")
+ indent (if upper-case-p "#+END_SRC\n" "#+end_src\n")
(if arg stars indent) "\n"
- indent (funcall (if lower-case-p 'downcase 'upcase) "#+begin_src ")
+ indent (if upper-case-p "#+BEGIN_SRC " "#+begin_src ")
lang
(if (> (length headers) 1)
(concat " " headers) headers)
@@ -1918,14 +1937,16 @@ region is not active then the point is demarcated."
(if (org-region-active-p) (mark) (point)) (point))))
(insert (concat (if (looking-at "^") "" "\n")
(if arg (concat stars "\n") "")
- (funcall (if lower-case-p 'downcase 'upcase) "#+begin_src ")
- lang "\n"
- body
+ (if upper-case-p "#+BEGIN_SRC " "#+begin_src ")
+ lang "\n" body
(if (or (= (length body) 0)
(string-suffix-p "\r" body)
- (string-suffix-p "\n" body)) "" "\n")
- (funcall (if lower-case-p 'downcase 'upcase) "#+end_src\n")))
- (goto-char start) (move-end-of-line 1)))))
+ (string-suffix-p "\n" body))
+ ""
+ "\n")
+ (if upper-case-p "#+END_SRC\n" "#+end_src\n")))
+ (goto-char start)
+ (move-end-of-line 1)))))
(defun org-babel--insert-results-keyword (name hash)
"Insert RESULTS keyword with NAME value at point.
@@ -1938,7 +1959,7 @@ the results hash, or nil. Leave point before the keyword."
(cond ((not hash) nil)
(org-babel-hash-show-time
(format "[%s %s]"
- (format-time-string "<%F %T>")
+ (format-time-string "(%F %T)")
hash))
(t (format "[%s]" hash)))
":"
@@ -1964,7 +1985,7 @@ point, along with related contents. Do nothing if HASH is nil.
Return a non-nil value if results were cleared. In this case,
leave point where new results should be inserted."
(when hash
- (looking-at org-babel-result-regexp)
+ (let ((case-fold-search t)) (looking-at org-babel-result-regexp))
(unless (string= (match-string 1) hash)
(let* ((e (org-element-at-point))
(post (copy-marker (org-element-property :post-affiliated e))))
@@ -2371,13 +2392,58 @@ INFO may provide the values of these header arguments (in the
(org-babel-chomp result "\n"))))
(t (goto-char beg) (insert result)))
(setq end (copy-marker (point) t))
- ;; possibly wrap result
+ ;; Possibly wrap result.
(cond
((assq :wrap (nth 2 info))
- (let ((name (or (cdr (assq :wrap (nth 2 info))) "results")))
- (funcall wrap (concat "#+begin_" name)
- (concat "#+end_" (car (split-string name)))
- nil nil (concat "{{{results(@@" name ":") "@@)}}}")))
+ (let* ((full (or (cdr (assq :wrap (nth 2 info))) "results"))
+ (split (split-string full))
+ (type (car split))
+ (opening-line (concat "#+begin_" full))
+ (closing-line (concat "#+end_" type)))
+ (cond
+ ;; Escape contents from "export" wrap. Wrap
+ ;; inline results within an export snippet with
+ ;; appropriate value.
+ ((eq t (compare-strings type nil nil "export" nil nil t))
+ (let ((backend (pcase split
+ (`(,_) "none")
+ (`(,_ ,b . ,_) b))))
+ (funcall wrap
+ opening-line closing-line
+ nil nil
+ (format "{{{results(@@%s:"
+ backend) "@@)}}}")))
+ ;; Escape contents from "example" wrap. Mark
+ ;; inline results as verbatim.
+ ((eq t (compare-strings type nil nil "example" nil nil t))
+ (funcall wrap
+ opening-line closing-line
+ nil nil
+ "{{{results(=" "=)}}}"))
+ ;; Escape contents from "src" wrap. Mark
+ ;; inline results as inline source code.
+ ((eq t (compare-strings type nil nil "src" nil nil t))
+ (let ((inline-open
+ (pcase split
+ (`(,_)
+ "{{{results(src_none{")
+ (`(,_ ,language)
+ (format "{{{results(src_%s{" language))
+ (`(,_ ,language . ,rest)
+ (let ((r (mapconcat #'identity rest " ")))
+ (format "{{{results(src_%s[%s]{"
+ language r))))))
+ (funcall wrap
+ opening-line closing-line
+ nil nil
+ inline-open "})}}}")))
+ ;; Do not escape contents in non-verbatim
+ ;; blocks. Return plain inline results.
+ (t
+ (funcall wrap
+ opening-line closing-line
+ t nil
+ "{{{results(" ")}}}")))))
((member "html" result-params)
(funcall wrap "#+begin_export html" "#+end_export" nil nil
"{{{results(@@html:" "@@)}}}"))
@@ -2433,7 +2499,8 @@ INFO may provide the values of these header arguments (in the
(defun org-babel-remove-result (&optional info keep-keyword)
"Remove the result of the current source block."
(interactive)
- (let ((location (org-babel-where-is-src-block-result nil info)))
+ (let ((location (org-babel-where-is-src-block-result nil info))
+ (case-fold-search t))
(when location
(save-excursion
(goto-char location)
@@ -2488,7 +2555,7 @@ in the buffer."
(if (memq (org-element-type element)
;; Possible results types.
'(drawer example-block export-block fixed-width item
- plain-list src-block table))
+ plain-list special-block src-block table))
(save-excursion
(goto-char (min (point-max) ;for narrowed buffers
(org-element-property :end element)))
@@ -2502,16 +2569,19 @@ If the `default-directory' is different from the containing
file's directory then expand relative links."
(when (stringp result)
(let ((same-directory?
- (and buffer-file-name
+ (and (buffer-file-name (buffer-base-buffer))
(not (string= (expand-file-name default-directory)
- (expand-file-name
- (file-name-directory buffer-file-name)))))))
+ (expand-file-name
+ (file-name-directory
+ (buffer-file-name (buffer-base-buffer)))))))))
(format "[[file:%s]%s]"
- (if (and default-directory buffer-file-name same-directory?)
+ (if (and default-directory
+ (buffer-file-name (buffer-base-buffer)) same-directory?)
(if (eq org-link-file-path-type 'adaptive)
(file-relative-name
(expand-file-name result default-directory)
- (file-name-directory (buffer-file-name)))
+ (file-name-directory
+ (buffer-file-name (buffer-base-buffer))))
(expand-file-name result default-directory))
result)
(if description (concat "[" description "]") "")))))
@@ -2707,117 +2777,110 @@ would set the value of argument \"a\" equal to \"9\". Note that
these arguments are not evaluated in the current source-code
block but are passed literally to the \"example-block\"."
(let* ((parent-buffer (or parent-buffer (current-buffer)))
- (info (or info (org-babel-get-src-block-info 'light)))
+ (info (or info (org-babel-get-src-block-info 'light)))
(lang (nth 0 info))
(body (nth 1 info))
- (ob-nww-start org-babel-noweb-wrap-start)
- (ob-nww-end org-babel-noweb-wrap-end)
- (new-body "")
- (nb-add (lambda (text) (setq new-body (concat new-body text))))
- index source-name evaluate prefix)
- (with-temp-buffer
- (setq-local org-babel-noweb-wrap-start ob-nww-start)
- (setq-local org-babel-noweb-wrap-end ob-nww-end)
- (insert body) (goto-char (point-min))
- (setq index (point))
- (while (and (re-search-forward (org-babel-noweb-wrap) nil t))
- (save-match-data (setf source-name (match-string 1)))
- (save-match-data (setq evaluate (string-match "(.*)" source-name)))
- (save-match-data
- (setq prefix
- (buffer-substring (match-beginning 0)
- (save-excursion
- (beginning-of-line 1) (point)))))
- ;; add interval to new-body (removing noweb reference)
- (goto-char (match-beginning 0))
- (funcall nb-add (buffer-substring index (point)))
- (goto-char (match-end 0))
- (setq index (point))
- (funcall
- nb-add
- (with-current-buffer parent-buffer
- (save-restriction
- (widen)
- (mapconcat ;; Interpose PREFIX between every line.
- #'identity
- (split-string
- (if evaluate
- (let ((raw (org-babel-ref-resolve source-name)))
- (if (stringp raw) raw (format "%S" raw)))
- (or
- ;; Retrieve from the Library of Babel.
- (nth 2 (assoc-string source-name org-babel-library-of-babel))
- ;; Return the contents of headlines literally.
- (save-excursion
- (when (org-babel-ref-goto-headline-id source-name)
- (org-babel-ref-headline-body)))
- ;; Find the expansion of reference in this buffer.
- (save-excursion
- (goto-char (point-min))
- (let* ((name-regexp
- (org-babel-named-src-block-regexp-for-name
- source-name))
- (comment
- (string= "noweb"
- (cdr (assq :comments (nth 2 info)))))
- (c-wrap
- (lambda (s)
- ;; Comment, according to LANG mode,
- ;; string S. Return new string.
- (with-temp-buffer
- (funcall (org-src-get-lang-mode lang))
- (comment-region (point)
- (progn (insert s) (point)))
- (org-trim (buffer-string)))))
- (expand-body
- (lambda (i)
- ;; Expand body of code blocked
- ;; represented by block info I.
- (let ((b (if (org-babel-noweb-p (nth 2 i) :eval)
- (org-babel-expand-noweb-references i)
- (nth 1 i))))
- (if (not comment) b
- (let ((cs (org-babel-tangle-comment-links i)))
- (concat (funcall c-wrap (car cs)) "\n"
- b "\n"
- (funcall c-wrap (cadr cs)))))))))
- (if (and (re-search-forward name-regexp nil t)
- (not (org-in-commented-heading-p)))
- ;; Found a source block named SOURCE-NAME.
- ;; Assume it is unique; do not look after
- ;; `:noweb-ref' header argument.
- (funcall expand-body
- (org-babel-get-src-block-info 'light))
- ;; Though luck. We go into the long process
- ;; of checking each source block and expand
- ;; those with a matching Noweb reference.
- (let ((expansion nil))
- (org-babel-map-src-blocks nil
- (unless (org-in-commented-heading-p)
- (let* ((info
- (org-babel-get-src-block-info 'light))
- (parameters (nth 2 info)))
- (when (equal source-name
- (cdr (assq :noweb-ref parameters)))
- (push (funcall expand-body info) expansion)
- (push (or (cdr (assq :noweb-sep parameters))
- "\n")
- expansion)))))
- (when expansion
- (mapconcat #'identity
- (nreverse (cdr expansion))
- ""))))))
- ;; Possibly raise an error if named block doesn't exist.
- (if (or org-babel-noweb-error-all-langs
- (member lang org-babel-noweb-error-langs))
- (error "%s could not be resolved (see \
-`org-babel-noweb-error-langs')"
- (org-babel-noweb-wrap source-name))
- "")))
- "[\n\r]")
- (concat "\n" prefix))))))
- (funcall nb-add (buffer-substring index (point-max))))
- new-body))
+ (comment (string= "noweb" (cdr (assq :comments (nth 2 info)))))
+ (noweb-re (format "\\(.*?\\)\\(%s\\)"
+ (with-current-buffer parent-buffer
+ (org-babel-noweb-wrap))))
+ (cache nil)
+ (c-wrap
+ (lambda (s)
+ ;; Comment string S, according to LANG mode. Return new
+ ;; string.
+ (unless org-babel-tangle-uncomment-comments
+ (with-temp-buffer
+ (funcall (org-src-get-lang-mode lang))
+ (comment-region (point)
+ (progn (insert s) (point)))
+ (org-trim (buffer-string))))))
+ (expand-body
+ (lambda (i)
+ ;; Expand body of code represented by block info I.
+ (let ((b (if (org-babel-noweb-p (nth 2 i) :eval)
+ (org-babel-expand-noweb-references i)
+ (nth 1 i))))
+ (if (not comment) b
+ (let ((cs (org-babel-tangle-comment-links i)))
+ (concat (funcall c-wrap (car cs)) "\n"
+ b "\n"
+ (funcall c-wrap (cadr cs))))))))
+ (expand-references
+ (lambda (ref cache)
+ (pcase (gethash ref cache)
+ (`(,last . ,previous)
+ ;; Ignore separator for last block.
+ (let ((strings (list (funcall expand-body last))))
+ (dolist (i previous)
+ (let ((parameters (nth 2 i)))
+ ;; Since we're operating in reverse order, first
+ ;; push separator, then body.
+ (push (or (cdr (assq :noweb-sep parameters)) "\n")
+ strings)
+ (push (funcall expand-body i) strings)))
+ (mapconcat #'identity strings "")))
+ ;; Raise an error about missing reference, or return the
+ ;; empty string.
+ ((guard (or org-babel-noweb-error-all-langs
+ (member lang org-babel-noweb-error-langs)))
+ (error "Cannot resolve %s (see `org-babel-noweb-error-langs')"
+ (org-babel-noweb-wrap ref)))
+ (_ "")))))
+ (replace-regexp-in-string
+ noweb-re
+ (lambda (m)
+ (with-current-buffer parent-buffer
+ (save-match-data
+ (let* ((prefix (match-string 1 m))
+ (id (match-string 3 m))
+ (evaluate (string-match-p "(.*)" id))
+ (expansion
+ (cond
+ (evaluate
+ ;; Evaluation can potentially modify the buffer
+ ;; and invalidate the cache: reset it.
+ (setq cache nil)
+ (let ((raw (org-babel-ref-resolve id)))
+ (if (stringp raw) raw (format "%S" raw))))
+ ;; Retrieve from the Library of Babel.
+ ((nth 2 (assoc-string id org-babel-library-of-babel)))
+ ;; Return the contents of headlines literally.
+ ((org-babel-ref-goto-headline-id id)
+ (org-babel-ref-headline-body))
+ ;; Look for a source block named SOURCE-NAME. If
+ ;; found, assume it is unique; do not look after
+ ;; `:noweb-ref' header argument.
+ ((org-with-point-at 1
+ (let ((r (org-babel-named-src-block-regexp-for-name id)))
+ (and (re-search-forward r nil t)
+ (not (org-in-commented-heading-p))
+ (funcall expand-body
+ (org-babel-get-src-block-info t))))))
+ ;; All Noweb references were cached in a previous
+ ;; run. Extract the information from the cache.
+ ((hash-table-p cache)
+ (funcall expand-references id cache))
+ ;; Though luck. We go into the long process of
+ ;; checking each source block and expand those
+ ;; with a matching Noweb reference. Since we're
+ ;; going to visit all source blocks in the
+ ;; document, cache information about them as well.
+ (t
+ (setq cache (make-hash-table :test #'equal))
+ (org-with-wide-buffer
+ (org-babel-map-src-blocks nil
+ (if (org-in-commented-heading-p)
+ (org-forward-heading-same-level nil t)
+ (let* ((info (org-babel-get-src-block-info t))
+ (ref (cdr (assq :noweb-ref (nth 2 info)))))
+ (push info (gethash ref cache))))))
+ (funcall expand-references id cache)))))
+ ;; Interpose PREFIX between every line.
+ (mapconcat #'identity
+ (split-string expansion "[\n\r]")
+ (concat "\n" prefix))))))
+ body t t 2)))
(defun org-babel--script-escape-inner (str)
(let (in-single in-double backslash out)
@@ -2931,30 +2994,41 @@ situations in which is it not appropriate."
(defun org-babel--string-to-number (string)
"If STRING represents a number return its value.
Otherwise return nil."
- (and (string-match-p "\\`-?\\([0-9]\\|\\([1-9]\\|[0-9]*\\.\\)[0-9]*\\)\\'" string)
- (string-to-number string)))
+ (unless (or (string-match-p "\\s-" (org-trim string))
+ (not (string-match-p "^[0-9e.+ -]+$" string)))
+ (let ((interned-string (ignore-errors (read string))))
+ (when (numberp interned-string)
+ interned-string))))
(defun org-babel-import-elisp-from-file (file-name &optional separator)
"Read the results located at FILE-NAME into an elisp table.
If the table is trivial, then return it as a scalar."
- (save-window-excursion
- (let ((result
- (with-temp-buffer
- (condition-case err
- (progn
- (org-table-import file-name separator)
- (delete-file file-name)
- (delq nil
- (mapcar (lambda (row)
- (and (not (eq row 'hline))
- (mapcar #'org-babel-string-read row)))
- (org-table-to-lisp))))
- (error (message "Error reading results: %s" err) nil)))))
- (pcase result
- (`((,scalar)) scalar)
- (`((,_ ,_ . ,_)) result)
- (`(,scalar) scalar)
- (_ result)))))
+ (let ((result
+ (with-temp-buffer
+ (condition-case err
+ (progn
+ (insert-file-contents file-name)
+ (delete-file file-name)
+ (let ((pmax (point-max)))
+ ;; If the file was empty, don't bother trying to
+ ;; convert the table.
+ (when (> pmax 1)
+ (org-table-convert-region (point-min) pmax separator)
+ (delq nil
+ (mapcar (lambda (row)
+ (and (not (eq row 'hline))
+ (mapcar #'org-babel-string-read row)))
+ (org-table-to-lisp))))))
+ (error
+ (display-warning 'org-babel
+ (format "Error reading results: %S" err)
+ :error)
+ nil)))))
+ (pcase result
+ (`((,scalar)) scalar)
+ (`((,_ ,_ . ,_)) result)
+ (`(,scalar) scalar)
+ (_ result))))
(defun org-babel-string-read (cell)
"Strip nested \"s from around strings."
@@ -3054,7 +3128,7 @@ of `org-babel-temporary-directory'."
(delete-directory file)
(delete-file file)))
(directory-files org-babel-temporary-directory 'full
- directory-files-no-dot-files-regexp))
+ directory-files-no-dot-files-regexp))
(delete-directory org-babel-temporary-directory))
(error
(message "Failed to remove temporary Org-babel directory %s"
diff --git a/lisp/org/ob-css.el b/lisp/org/ob-css.el
index b03e8fac180..8ad70d44d06 100644
--- a/lisp/org/ob-css.el
+++ b/lisp/org/ob-css.el
@@ -1,6 +1,6 @@
;;; ob-css.el --- Babel Functions for CSS -*- lexical-binding: t; -*-
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -43,6 +43,4 @@ CSS does not support sessions."
(provide 'ob-css)
-
-
;;; ob-css.el ends here
diff --git a/lisp/org/ob-ditaa.el b/lisp/org/ob-ditaa.el
index 369a080b987..249c8c899eb 100644
--- a/lisp/org/ob-ditaa.el
+++ b/lisp/org/ob-ditaa.el
@@ -1,6 +1,6 @@
;;; ob-ditaa.el --- Babel Functions for ditaa -*- lexical-binding: t; -*-
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -119,6 +119,4 @@ This function is called by `org-babel-execute-src-block'."
(provide 'ob-ditaa)
-
-
;;; ob-ditaa.el ends here
diff --git a/lisp/org/ob-dot.el b/lisp/org/ob-dot.el
index df83068b494..d13261b340e 100644
--- a/lisp/org/ob-dot.el
+++ b/lisp/org/ob-dot.el
@@ -1,6 +1,6 @@
;;; ob-dot.el --- Babel Functions for dot -*- lexical-binding: t; -*-
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -87,6 +87,4 @@ This function is called by `org-babel-execute-src-block'."
(provide 'ob-dot)
-
-
;;; ob-dot.el ends here
diff --git a/lisp/org/ob-ebnf.el b/lisp/org/ob-ebnf.el
index 65151bf291c..58666a4ded0 100644
--- a/lisp/org/ob-ebnf.el
+++ b/lisp/org/ob-ebnf.el
@@ -1,11 +1,10 @@
;;; ob-ebnf.el --- Babel Functions for EBNF -*- lexical-binding: t; -*-
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; Author: Michael Gauland
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
-;; Version: 1.00
;; This file is part of GNU Emacs.
@@ -24,18 +23,18 @@
;;; Commentary:
-;;; Org-Babel support for using ebnf2ps to generate encapsulated postscript
-;;; railroad diagrams. It recognizes these arguments:
-;;;
-;;; :file is required; it must include the extension '.eps.' All the rules
-;;; in the block will be drawn in the same file. This is done by
-;;; inserting a '[<file>' comment at the start of the block (see the
-;;; documentation for ebnf-eps-buffer for more information).
-;;;
-;;; :style specifies a value in ebnf-style-database. This provides the
-;;; ability to customize the output. The style can also specify the
-;;; grammar syntax (by setting ebnf-syntax); note that only ebnf,
-;;; iso-ebnf, and yacc are supported by this file.
+;; Org-Babel support for using ebnf2ps to generate encapsulated postscript
+;; railroad diagrams. It recognizes these arguments:
+;;
+;; :file is required; it must include the extension '.eps.' All the rules
+;; in the block will be drawn in the same file. This is done by
+;; inserting a '[<file>' comment at the start of the block (see the
+;; documentation for ebnf-eps-buffer for more information).
+;;
+;; :style specifies a value in ebnf-style-database. This provides the
+;; ability to customize the output. The style can also specify the
+;; grammar syntax (by setting ebnf-syntax); note that only ebnf,
+;; iso-ebnf, and yacc are supported by this file.
;;; Requirements:
@@ -78,4 +77,5 @@ This function is called by `org-babel-execute-src-block'."
result)))
(provide 'ob-ebnf)
+
;;; ob-ebnf.el ends here
diff --git a/lisp/org/ob-emacs-lisp.el b/lisp/org/ob-emacs-lisp.el
index 095fbdb4f54..d03151f13ea 100644
--- a/lisp/org/ob-emacs-lisp.el
+++ b/lisp/org/ob-emacs-lisp.el
@@ -1,6 +1,6 @@
;;; ob-emacs-lisp.el --- Babel Functions for Emacs-lisp Code -*- lexical-binding: t; -*-
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -61,31 +61,30 @@ by `org-edit-src-code'.")
(defun org-babel-execute:emacs-lisp (body params)
"Execute a block of emacs-lisp code with Babel."
- (save-window-excursion
- (let* ((lexical (cdr (assq :lexical params)))
- (result-params (cdr (assq :result-params params)))
- (body (format (if (member "output" result-params)
- "(with-output-to-string %s\n)"
- "(progn %s\n)")
- (org-babel-expand-body:emacs-lisp body params)))
- (result (eval (read (if (or (member "code" result-params)
- (member "pp" result-params))
- (concat "(pp " body ")")
- body))
- (org-babel-emacs-lisp-lexical lexical))))
- (org-babel-result-cond result-params
- (let ((print-level nil)
- (print-length nil))
- (if (or (member "scalar" result-params)
- (member "verbatim" result-params))
- (format "%S" result)
- (format "%s" result)))
- (org-babel-reassemble-table
- result
- (org-babel-pick-name (cdr (assq :colname-names params))
- (cdr (assq :colnames params)))
- (org-babel-pick-name (cdr (assq :rowname-names params))
- (cdr (assq :rownames params))))))))
+ (let* ((lexical (cdr (assq :lexical params)))
+ (result-params (cdr (assq :result-params params)))
+ (body (format (if (member "output" result-params)
+ "(with-output-to-string %s\n)"
+ "(progn %s\n)")
+ (org-babel-expand-body:emacs-lisp body params)))
+ (result (eval (read (if (or (member "code" result-params)
+ (member "pp" result-params))
+ (concat "(pp " body ")")
+ body))
+ (org-babel-emacs-lisp-lexical lexical))))
+ (org-babel-result-cond result-params
+ (let ((print-level nil)
+ (print-length nil))
+ (if (or (member "scalar" result-params)
+ (member "verbatim" result-params))
+ (format "%S" result)
+ (format "%s" result)))
+ (org-babel-reassemble-table
+ result
+ (org-babel-pick-name (cdr (assq :colname-names params))
+ (cdr (assq :colnames params)))
+ (org-babel-pick-name (cdr (assq :rowname-names params))
+ (cdr (assq :rownames params)))))))
(defun org-babel-emacs-lisp-lexical (lexical)
"Interpret :lexical source block argument.
@@ -108,6 +107,4 @@ corresponding :lexical source block argument."
(provide 'ob-emacs-lisp)
-
-
;;; ob-emacs-lisp.el ends here
diff --git a/lisp/org/ob-eshell.el b/lisp/org/ob-eshell.el
index 4edd3cf641e..6ae0fc613dd 100644
--- a/lisp/org/ob-eshell.el
+++ b/lisp/org/ob-eshell.el
@@ -1,6 +1,6 @@
;;; ob-eshell.el --- Babel Functions for Eshell -*- lexical-binding: t; -*-
-;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2018-2021 Free Software Foundation, Inc.
;; Author: stardiviner <numbchild@gmail.com>
;; Keywords: literate programming, reproducible research
diff --git a/lisp/org/ob-eval.el b/lisp/org/ob-eval.el
index a939d934d94..b0fca7bd95b 100644
--- a/lisp/org/ob-eval.el
+++ b/lisp/org/ob-eval.el
@@ -1,6 +1,6 @@
;;; ob-eval.el --- Babel Functions for External Code Evaluation -*- lexical-binding: t; -*-
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, comint
@@ -144,6 +144,4 @@ This buffer is named by `org-babel-error-buffer-name'."
(provide 'ob-eval)
-
-
;;; ob-eval.el ends here
diff --git a/lisp/org/ob-exp.el b/lisp/org/ob-exp.el
index bbf9b55a300..e851ff624a7 100644
--- a/lisp/org/ob-exp.el
+++ b/lisp/org/ob-exp.el
@@ -1,6 +1,6 @@
;;; ob-exp.el --- Exportation of Babel Source Blocks -*- lexical-binding: t; -*-
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Authors: Eric Schulte
;; Dan Davison
@@ -33,6 +33,7 @@
(declare-function org-escape-code-in-string "org-src" (s))
(declare-function org-export-copy-buffer "ox" ())
(declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
+(declare-function org-in-archived-heading-p "org" (&optional no-inheritance))
(defvar org-src-preserve-indentation)
@@ -157,7 +158,8 @@ this template."
;; encountered.
(goto-char (point-min))
(while (re-search-forward regexp nil t)
- (unless (save-match-data (org-in-commented-heading-p))
+ (unless (save-match-data (or (org-in-commented-heading-p)
+ (org-in-archived-heading-p)))
(let* ((object? (match-end 1))
(element (save-match-data
(if object? (org-element-context)
@@ -403,9 +405,7 @@ inhibit insertion of results into the buffer."
(`lob
(save-excursion
(goto-char (nth 5 info))
- (let (org-confirm-babel-evaluate)
- (org-babel-execute-src-block nil info)))))))))
-
+ (org-babel-execute-src-block nil info))))))))
(provide 'ob-exp)
diff --git a/lisp/org/ob-forth.el b/lisp/org/ob-forth.el
index aef6784ca48..3b521bc4d95 100644
--- a/lisp/org/ob-forth.el
+++ b/lisp/org/ob-forth.el
@@ -1,6 +1,6 @@
;;; ob-forth.el --- Babel Functions for Forth -*- lexical-binding: t; -*-
-;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2021 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, forth
@@ -76,7 +76,8 @@ This function is called by `org-babel-execute-src-block'."
;; Report errors.
(org-babel-eval-error-notify 1
(buffer-substring
- (+ (match-beginning 0) 1) (point-max))) nil))))
+ (+ (match-beginning 0) 1) (point-max)))
+ nil))))
(split-string (org-trim
(org-babel-expand-body:generic body params))
"\n"
diff --git a/lisp/org/ob-fortran.el b/lisp/org/ob-fortran.el
index 149058f05f4..99afa0d963d 100644
--- a/lisp/org/ob-fortran.el
+++ b/lisp/org/ob-fortran.el
@@ -1,6 +1,6 @@
;;; ob-fortran.el --- Babel Functions for Fortran -*- lexical-binding: t; -*-
-;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
;; Authors: Sergey Litvinov
;; Eric Schulte
@@ -101,7 +101,8 @@ its header arguments."
(concat
;; variables
(mapconcat 'org-babel-fortran-var-to-fortran vars "\n")
- body) params)
+ body)
+ params)
body) "\n") "\n")))
(defun org-babel-fortran-ensure-main-wrap (body params)
diff --git a/lisp/org/ob-gnuplot.el b/lisp/org/ob-gnuplot.el
index d11c55f7590..6489c23f570 100644
--- a/lisp/org/ob-gnuplot.el
+++ b/lisp/org/ob-gnuplot.el
@@ -1,6 +1,6 @@
;;; ob-gnuplot.el --- Babel Functions for Gnuplot -*- lexical-binding: t; -*-
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -35,7 +35,7 @@
;; - gnuplot :: http://www.gnuplot.info/
;;
-;; - gnuplot-mode :: http://cars9.uchicago.edu/~ravel/software/gnuplot-mode.html
+;; - gnuplot-mode :: you can search the web for the latest active one.
;;; Code:
(require 'ob)
@@ -278,6 +278,4 @@ Pass PARAMS through to `orgtbl-to-generic' when exporting TABLE."
(provide 'ob-gnuplot)
-
-
;;; ob-gnuplot.el ends here
diff --git a/lisp/org/ob-groovy.el b/lisp/org/ob-groovy.el
index 38e2a169cee..fa847dd0a2b 100644
--- a/lisp/org/ob-groovy.el
+++ b/lisp/org/ob-groovy.el
@@ -1,6 +1,6 @@
;;; ob-groovy.el --- Babel Functions for Groovy -*- lexical-binding: t; -*-
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; Author: Miro Bezjak
;; Keywords: literate programming, reproducible research
@@ -65,7 +65,6 @@ This function is called by `org-babel-execute-src-block'."
(cdr (assq :rowname-names params)) (cdr (assq :rownames params))))))
(defvar org-babel-groovy-wrapper-method
-
"class Runner extends Script {
def out = new PrintWriter(new ByteArrayOutputStream())
def run() { %s }
@@ -74,7 +73,6 @@ This function is called by `org-babel-execute-src-block'."
println(new Runner().run())
")
-
(defun org-babel-groovy-evaluate
(session body &optional result-type result-params)
"Evaluate BODY in external Groovy process.
@@ -111,6 +109,4 @@ supported in Groovy."
(provide 'ob-groovy)
-
-
;;; ob-groovy.el ends here
diff --git a/lisp/org/ob-haskell.el b/lisp/org/ob-haskell.el
index e004a3405e4..d7ac1b04b36 100644
--- a/lisp/org/ob-haskell.el
+++ b/lisp/org/ob-haskell.el
@@ -1,6 +1,6 @@
;;; ob-haskell.el --- Babel Functions for Haskell -*- lexical-binding: t; -*-
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -23,20 +23,19 @@
;;; Commentary:
-;; Org-Babel support for evaluating haskell source code. This one will
-;; be sort of tricky because haskell programs must be compiled before
+;; Org Babel support for evaluating Haskell source code.
+;; Haskell programs must be compiled before
;; they can be run, but haskell code can also be run through an
;; interactive interpreter.
;;
-;; For now lets only allow evaluation using the haskell interpreter.
+;; By default we evaluate using the Haskell interpreter.
+;; To use the compiler, specify :compile yes in the header.
;;; Requirements:
-;; - haskell-mode :: http://www.iro.umontreal.ca/~monnier/elisp/#haskell-mode
-;;
-;; - inf-haskell :: http://www.iro.umontreal.ca/~monnier/elisp/#haskell-mode
-;;
-;; - (optionally) lhs2tex :: http://people.cs.uu.nl/andres/lhs2tex/
+;; - haskell-mode: http://www.iro.umontreal.ca/~monnier/elisp/#haskell-mode
+;; - inf-haskell: http://www.iro.umontreal.ca/~monnier/elisp/#haskell-mode
+;; - (optionally) lhs2tex: http://people.cs.uu.nl/andres/lhs2tex/
;;; Code:
(require 'ob)
@@ -47,6 +46,7 @@
(declare-function run-haskell "ext:inf-haskell" (&optional arg))
(declare-function inferior-haskell-load-file
"ext:inf-haskell" (&optional reload))
+(declare-function org-entry-get "org" (pom property &optional inherit literal-nil))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("haskell" . "hs"))
@@ -60,8 +60,63 @@
(defvar haskell-prompt-regexp)
-(defun org-babel-execute:haskell (body params)
- "Execute a block of Haskell code."
+(defcustom org-babel-haskell-compiler "ghc"
+ "Command used to compile a Haskell source code file into an executable.
+May be either a command in the path, like \"ghc\" or an absolute
+path name, like \"/usr/local/bin/ghc\". The command can include
+a parameter, such as \"ghc -v\"."
+ :group 'org-babel
+ :package-version '(Org "9.4")
+ :type 'string)
+
+(defconst org-babel-header-args:haskell '(compile . :any)
+ "Haskell-specific header arguments.")
+
+(defun org-babel-haskell-execute (body params)
+ "This function should only be called by `org-babel-execute:haskell'"
+ (let* ((tmp-src-file (org-babel-temp-file "Haskell-src-" ".hs"))
+ (tmp-bin-file
+ (org-babel-process-file-name
+ (org-babel-temp-file "Haskell-bin-" org-babel-exeext)))
+ (cmdline (cdr (assq :cmdline params)))
+ (cmdline (if cmdline (concat " " cmdline) ""))
+ (flags (cdr (assq :flags params)))
+ (flags (mapconcat #'identity
+ (if (listp flags)
+ flags
+ (list flags))
+ " "))
+ (libs (org-babel-read
+ (or (cdr (assq :libs params))
+ (org-entry-get nil "libs" t))
+ nil))
+ (libs (mapconcat #'identity
+ (if (listp libs) libs (list libs))
+ " ")))
+ (with-temp-file tmp-src-file (insert body))
+ (org-babel-eval
+ (format "%s -o %s %s %s %s"
+ org-babel-haskell-compiler
+ tmp-bin-file
+ flags
+ (org-babel-process-file-name tmp-src-file)
+ libs)
+ "")
+ (let ((results (org-babel-eval (concat tmp-bin-file cmdline) "")))
+ (when results
+ (setq results (org-trim (org-remove-indentation results)))
+ (org-babel-reassemble-table
+ (org-babel-result-cond (cdr (assq :result-params params))
+ (org-babel-read results t)
+ (let ((tmp-file (org-babel-temp-file "Haskell-")))
+ (with-temp-file tmp-file (insert results))
+ (org-babel-import-elisp-from-file tmp-file)))
+ (org-babel-pick-name
+ (cdr (assq :colname-names params)) (cdr (assq :colnames params)))
+ (org-babel-pick-name
+ (cdr (assq :rowname-names params)) (cdr (assq :rownames params))))))))
+
+(defun org-babel-interpret-haskell (body params)
(require 'inf-haskell)
(add-hook 'inferior-haskell-hook
(lambda ()
@@ -87,7 +142,7 @@
(org-babel-reassemble-table
(let ((result
(pcase result-type
- (`output (mapconcat #'identity (reverse (cdr results)) "\n"))
+ (`output (mapconcat #'identity (reverse results) "\n"))
(`value (car results)))))
(org-babel-result-cond (cdr (assq :result-params params))
result (org-babel-script-escape result)))
@@ -96,6 +151,13 @@
(org-babel-pick-name (cdr (assq :rowname-names params))
(cdr (assq :rowname-names params))))))
+(defun org-babel-execute:haskell (body params)
+ "Execute a block of Haskell code."
+ (let ((compile (string= "yes" (cdr (assq :compile params)))))
+ (if (not compile)
+ (org-babel-interpret-haskell body params)
+ (org-babel-haskell-execute body params))))
+
(defun org-babel-haskell-initiate-session (&optional _session _params)
"Initiate a haskell session.
If there is not a current inferior-process-buffer in SESSION
@@ -215,6 +277,4 @@ constructs (header arguments, no-web syntax etc...) are ignored."
(provide 'ob-haskell)
-
-
;;; ob-haskell.el ends here
diff --git a/lisp/org/ob-hledger.el b/lisp/org/ob-hledger.el
index 06d03b6754d..3d2f46cdce2 100644
--- a/lisp/org/ob-hledger.el
+++ b/lisp/org/ob-hledger.el
@@ -1,6 +1,6 @@
;; ob-hledger.el --- Babel Functions for hledger -*- lexical-binding: t; -*-
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Simon Michael
;; Keywords: literate programming, reproducible research, plain text accounting
@@ -30,6 +30,8 @@
;; probably ~/.hledger.journal (it may not notice your $LEDGER_FILE env var).
;; So make ~/.hledger.journal a symbolic link to the real file if necessary.
+;; TODO Unit tests are more than welcome, too.
+
;;; Code:
(require 'ob)
@@ -64,7 +66,4 @@ This function is called by `org-babel-execute-src-block'."
(provide 'ob-hledger)
-
-
;;; ob-hledger.el ends here
-;; TODO Unit tests are more than welcome, too.
diff --git a/lisp/org/ob-io.el b/lisp/org/ob-io.el
index 4d1f15429d2..63d2b6cf35e 100644
--- a/lisp/org/ob-io.el
+++ b/lisp/org/ob-io.el
@@ -1,6 +1,6 @@
;;; ob-io.el --- Babel Functions for Io -*- lexical-binding: t; -*-
-;; Copyright (C) 2012-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
;; Author: Andrzej Lichnerowicz
;; Keywords: literate programming, reproducible research
@@ -90,7 +90,6 @@ in BODY as elisp."
raw
(org-babel-script-escape raw)))))))
-
(defun org-babel-prep-session:io (_session _params)
"Prepare SESSION according to the header arguments specified in PARAMS."
(error "Sessions are not (yet) supported for Io"))
@@ -103,6 +102,4 @@ supported in Io."
(provide 'ob-io)
-
-
;;; ob-io.el ends here
diff --git a/lisp/org/ob-java.el b/lisp/org/ob-java.el
index 4b3d454898b..b1d517e94aa 100644
--- a/lisp/org/ob-java.el
+++ b/lisp/org/ob-java.el
@@ -1,6 +1,6 @@
;;; ob-java.el --- Babel Functions for Java -*- lexical-binding: t; -*-
-;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -58,6 +58,7 @@ parameters may be used, like javac -verbose"
(src-file (concat classname ".java"))
(cmpflag (or (cdr (assq :cmpflag params)) ""))
(cmdline (or (cdr (assq :cmdline params)) ""))
+ (cmdargs (or (cdr (assq :cmdargs params)) ""))
(full-body (org-babel-expand-body:generic body params)))
(with-temp-file src-file (insert full-body))
(org-babel-eval
@@ -66,10 +67,10 @@ parameters may be used, like javac -verbose"
(unless (or (not packagename) (file-exists-p packagename))
(make-directory packagename 'parents))
(let ((results (org-babel-eval (concat org-babel-java-command
- " " cmdline " " classname) "")))
+ " " cmdline " " classname " " cmdargs) "")))
(org-babel-reassemble-table
(org-babel-result-cond (cdr (assq :result-params params))
- (org-babel-read results)
+ (org-babel-read results t)
(let ((tmp-file (org-babel-temp-file "c-")))
(with-temp-file tmp-file (insert results))
(org-babel-import-elisp-from-file tmp-file)))
@@ -80,6 +81,4 @@ parameters may be used, like javac -verbose"
(provide 'ob-java)
-
-
;;; ob-java.el ends here
diff --git a/lisp/org/ob-js.el b/lisp/org/ob-js.el
index 655e253d925..b2a971e2a59 100644
--- a/lisp/org/ob-js.el
+++ b/lisp/org/ob-js.el
@@ -1,6 +1,6 @@
;;; ob-js.el --- Babel Functions for Javascript -*- lexical-binding: t; -*-
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, js
@@ -65,7 +65,7 @@
:safe #'stringp)
(defvar org-babel-js-function-wrapper
- "require('sys').print(require('sys').inspect(function(){\n%s\n}()));"
+ "require('process').stdout.write(require('util').inspect(function(){%s}()));"
"Javascript code to print value of body.")
(defun org-babel-execute:js (body params)
@@ -201,6 +201,4 @@ then create. Return the initialized session."
(provide 'ob-js)
-
-
;;; ob-js.el ends here
diff --git a/lisp/org/ob-latex.el b/lisp/org/ob-latex.el
index e0cc1033beb..138f4749525 100644
--- a/lisp/org/ob-latex.el
+++ b/lisp/org/ob-latex.el
@@ -1,6 +1,6 @@
;;; ob-latex.el --- Babel Functions for LaTeX -*- lexical-binding: t; -*-
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -84,7 +84,8 @@
(regexp-quote (format "%S" (car pair)))
(if (stringp (cdr pair))
(cdr pair) (format "%S" (cdr pair)))
- body))) (org-babel--get-vars params))
+ body)))
+ (org-babel--get-vars params))
(org-trim body))
(defun org-babel-execute:latex (body params)
@@ -108,8 +109,11 @@ This function is called by `org-babel-execute-src-block'."
(append (cdr (assq :packages params)) org-latex-packages-alist)))
(cond
((and (string-suffix-p ".png" out-file) (not imagemagick))
- (org-create-formula-image
- body out-file org-format-latex-options in-buffer))
+ (let ((org-format-latex-header
+ (concat org-format-latex-header "\n"
+ (mapconcat #'identity headers "\n"))))
+ (org-create-formula-image
+ body out-file org-format-latex-options in-buffer)))
((string-suffix-p ".tikz" out-file)
(when (file-exists-p out-file) (delete-file out-file))
(with-temp-file out-file
@@ -221,6 +225,6 @@ This function is called by `org-babel-execute-src-block'."
"Return an error because LaTeX doesn't support sessions."
(error "LaTeX does not support sessions"))
-
(provide 'ob-latex)
+
;;; ob-latex.el ends here
diff --git a/lisp/org/ob-ledger.el b/lisp/org/ob-ledger.el
index e63e10608c3..a117f854e48 100644
--- a/lisp/org/ob-ledger.el
+++ b/lisp/org/ob-ledger.el
@@ -1,6 +1,6 @@
;;; ob-ledger.el --- Babel Functions for Ledger -*- lexical-binding: t; -*-
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Eric S Fraga
;; Keywords: literate programming, reproducible research, accounting
@@ -65,6 +65,4 @@ called by `org-babel-execute-src-block'."
(provide 'ob-ledger)
-
-
;;; ob-ledger.el ends here
diff --git a/lisp/org/ob-lilypond.el b/lisp/org/ob-lilypond.el
index eb3372fa7bf..fbdd905a5fe 100644
--- a/lisp/org/ob-lilypond.el
+++ b/lisp/org/ob-lilypond.el
@@ -1,6 +1,6 @@
;;; ob-lilypond.el --- Babel Functions for Lilypond -*- lexical-binding: t; -*-
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Martyn Jago
;; Keywords: babel language, literate programming
@@ -67,12 +67,15 @@ the midi file is not automatically played. Default value is t")
(defvar org-babel-lilypond-ly-command ""
"Command to execute lilypond on your system.
Do not set it directly. Customize `org-babel-lilypond-commands' instead.")
+
(defvar org-babel-lilypond-pdf-command ""
"Command to show a PDF file on your system.
Do not set it directly. Customize `org-babel-lilypond-commands' instead.")
+
(defvar org-babel-lilypond-midi-command ""
"Command to play a MIDI file on your system.
Do not set it directly. Customize `org-babel-lilypond-commands' instead.")
+
(defcustom org-babel-lilypond-commands
(cond
((eq system-type 'darwin)
@@ -94,7 +97,8 @@ you can leave the string empty on this case."
:version "24.4"
:package-version '(Org . "8.2.7")
:set
- (lambda (_symbol value)
+ (lambda (symbol value)
+ (set symbol value)
(setq
org-babel-lilypond-ly-command (nth 0 value)
org-babel-lilypond-pdf-command (nth 1 value)
@@ -201,7 +205,7 @@ If error in compilation, attempt to mark the error in lilypond org file."
(delete-file org-babel-lilypond-temp-file))
(rename-file org-babel-lilypond-tangled-file
org-babel-lilypond-temp-file))
- (switch-to-buffer-other-window "*lilypond*")
+ (org-switch-to-buffer-other-window "*lilypond*")
(erase-buffer)
(org-babel-lilypond-compile-lilyfile org-babel-lilypond-temp-file)
(goto-char (point-min))
@@ -258,7 +262,7 @@ FILE-NAME is full path to lilypond file."
"Mark the erroneous lines in the lilypond org buffer.
FILE-NAME is full path to lilypond file.
LINE is the erroneous line."
- (switch-to-buffer-other-window
+ (org-switch-to-buffer-other-window
(concat (file-name-nondirectory
(org-babel-lilypond-switch-extension file-name ".org"))))
(let ((temp (point)))
@@ -387,7 +391,8 @@ If TEST is non-nil, the shell command is returned and is not run."
(defun org-babel-lilypond-switch-extension (file-name ext)
"Utility command to swap current FILE-NAME extension with EXT."
(concat (file-name-sans-extension
- file-name) ext))
+ file-name)
+ ext))
(defun org-babel-lilypond-get-header-args (mode)
"Default arguments to use when evaluating a lilypond source block.
diff --git a/lisp/org/ob-lisp.el b/lisp/org/ob-lisp.el
index f0e1ff63572..87b9241e758 100644
--- a/lisp/org/ob-lisp.el
+++ b/lisp/org/ob-lisp.el
@@ -1,6 +1,6 @@
;;; ob-lisp.el --- Babel Functions for Common Lisp -*- lexical-binding: t; -*-
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Authors: Joel Boehland
;; Eric Schulte
@@ -122,6 +122,4 @@ a property list containing the parameters of the block."
(provide 'ob-lisp)
-
-
;;; ob-lisp.el ends here
diff --git a/lisp/org/ob-lob.el b/lisp/org/ob-lob.el
index 8c341e6756d..903dabfbd59 100644
--- a/lisp/org/ob-lob.el
+++ b/lisp/org/ob-lob.el
@@ -1,6 +1,6 @@
;;; ob-lob.el --- Functions Supporting the Library of Babel -*- lexical-binding: t; -*-
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Authors: Eric Schulte
;; Dan Davison
diff --git a/lisp/org/ob-lua.el b/lisp/org/ob-lua.el
index b046b54b1d7..11503e47470 100644
--- a/lisp/org/ob-lua.el
+++ b/lisp/org/ob-lua.el
@@ -1,6 +1,6 @@
;;; ob-lua.el --- Org Babel functions for Lua evaluation -*- lexical-binding: t; -*-
-;; Copyright (C) 2014, 2016-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2014, 2016-2021 Free Software Foundation, Inc.
;; Authors: Dieter Schoen
;; Keywords: literate programming, reproducible research
@@ -107,7 +107,8 @@ VARS contains resolved variable references."
(org-babel-comint-in-buffer session
(mapc (lambda (var)
(end-of-line 1) (insert var) (comint-send-input)
- (org-babel-comint-wait-for-output session)) var-lines))
+ (org-babel-comint-wait-for-output session))
+ var-lines))
session))
(defun org-babel-load-session:lua (session body params)
@@ -397,6 +398,4 @@ fd:close()"
(provide 'ob-lua)
-
-
;;; ob-lua.el ends here
diff --git a/lisp/org/ob-makefile.el b/lisp/org/ob-makefile.el
index 15bf6ee8308..69ab6fe9eaa 100644
--- a/lisp/org/ob-makefile.el
+++ b/lisp/org/ob-makefile.el
@@ -1,6 +1,6 @@
;;; ob-makefile.el --- Babel Functions for Makefile -*- lexical-binding: t; -*-
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Thomas S. Dye
@@ -43,6 +43,4 @@ does not support sessions."
(provide 'ob-makefile)
-
-
;;; ob-makefile.el ends here
diff --git a/lisp/org/ob-matlab.el b/lisp/org/ob-matlab.el
index 958357f328b..45ec5c5437b 100644
--- a/lisp/org/ob-matlab.el
+++ b/lisp/org/ob-matlab.el
@@ -1,6 +1,6 @@
;;; ob-matlab.el --- Babel support for Matlab -*- lexical-binding: t; -*-
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Dan Davison
;; Keywords: literate programming, reproducible research
@@ -42,6 +42,4 @@
(provide 'ob-matlab)
-
-
;;; ob-matlab.el ends here
diff --git a/lisp/org/ob-maxima.el b/lisp/org/ob-maxima.el
index 5d38cc301ad..7b49bb07a0e 100644
--- a/lisp/org/ob-maxima.el
+++ b/lisp/org/ob-maxima.el
@@ -1,6 +1,6 @@
;;; ob-maxima.el --- Babel Functions for Maxima -*- lexical-binding: t; -*-
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric S Fraga
;; Eric Schulte
@@ -27,9 +27,7 @@
;; Org-Babel support for evaluating maxima entries.
;;
;; This differs from most standard languages in that
-;;
;; 1) there is no such thing as a "session" in maxima
-;;
;; 2) we are adding the "cmdline" header argument
;;; Code:
@@ -125,9 +123,6 @@ of the same value."
(concat "[" (mapconcat #'org-babel-maxima-elisp-to-maxima val ", ") "]")
(format "%s" val)))
-
(provide 'ob-maxima)
-
-
;;; ob-maxima.el ends here
diff --git a/lisp/org/ob-mscgen.el b/lisp/org/ob-mscgen.el
index fa4d3e3ac34..999d4f4140b 100644
--- a/lisp/org/ob-mscgen.el
+++ b/lisp/org/ob-mscgen.el
@@ -1,6 +1,6 @@
;;; ob-msc.el --- Babel Functions for Mscgen -*- lexical-binding: t; -*-
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Juan Pechiar
;; Keywords: literate programming, reproducible research
@@ -68,8 +68,7 @@ mscgen supported formats."
(let* ((out-file (or (cdr (assq :file params)) "output.png" ))
(filetype (or (cdr (assq :filetype params)) "png" )))
(unless (cdr (assq :file params))
- (error "
-ERROR: no output file specified. Add \":file name.png\" to the src header"))
+ (error "ERROR: no output file specified. Add \":file name.png\" to the src header"))
(org-babel-eval (concat "mscgen -T " filetype " -o " out-file) body)
nil)) ;; signal that output has already been written to file
@@ -79,6 +78,4 @@ ERROR: no output file specified. Add \":file name.png\" to the src header"))
(provide 'ob-mscgen)
-
-
;;; ob-msc.el ends here
diff --git a/lisp/org/ob-ocaml.el b/lisp/org/ob-ocaml.el
index 6972dae2195..0aa91afdb24 100644
--- a/lisp/org/ob-ocaml.el
+++ b/lisp/org/ob-ocaml.el
@@ -1,6 +1,6 @@
;;; ob-ocaml.el --- Babel Functions for Ocaml -*- lexical-binding: t; -*-
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -166,6 +166,4 @@ Emacs-lisp table, otherwise return the results as a string."
(provide 'ob-ocaml)
-
-
;;; ob-ocaml.el ends here
diff --git a/lisp/org/ob-octave.el b/lisp/org/ob-octave.el
index fbfc9b97356..166cd596a53 100644
--- a/lisp/org/ob-octave.el
+++ b/lisp/org/ob-octave.el
@@ -1,6 +1,6 @@
;;; ob-octave.el --- Babel Functions for Octave and Matlab -*- lexical-binding: t; -*-
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Dan Davison
;; Keywords: literate programming, reproducible research
@@ -136,7 +136,8 @@ specifying a variable of the same value."
(org-babel-comint-in-buffer session
(mapc (lambda (var)
(end-of-line 1) (insert var) (comint-send-input nil t)
- (org-babel-comint-wait-for-output session)) var-lines))
+ (org-babel-comint-wait-for-output session))
+ var-lines))
session))
(defun org-babel-matlab-initiate-session (&optional session params)
@@ -230,7 +231,8 @@ value of the last statement in BODY, as elisp."
org-babel-octave-eoe-indicator
org-babel-octave-eoe-output)
t full-body)
- (insert full-body) (comint-send-input nil t)))) results)
+ (insert full-body) (comint-send-input nil t))))
+ results)
(pcase result-type
(`value
(org-babel-octave-import-elisp-from-file tmp-file))
@@ -259,6 +261,4 @@ This removes initial blank and comment lines and then calls
(provide 'ob-octave)
-
-
;;; ob-octave.el ends here
diff --git a/lisp/org/ob-org.el b/lisp/org/ob-org.el
index 63165019a9a..e29cbb5b76f 100644
--- a/lisp/org/ob-org.el
+++ b/lisp/org/ob-org.el
@@ -1,6 +1,6 @@
;;; ob-org.el --- Babel Functions for Org Code Blocks -*- lexical-binding: t; -*-
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -67,6 +67,4 @@ This function is called by `org-babel-execute-src-block'."
(provide 'ob-org)
-
-
;;; ob-org.el ends here
diff --git a/lisp/org/ob-perl.el b/lisp/org/ob-perl.el
index 2daf5774195..0cfac850078 100644
--- a/lisp/org/ob-perl.el
+++ b/lisp/org/ob-perl.el
@@ -1,6 +1,6 @@
;;; ob-perl.el --- Babel Functions for Perl -*- lexical-binding: t; -*-
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Authors: Dan Davison
;; Eric Schulte
@@ -152,6 +152,4 @@ return the value of the last statement in BODY, as elisp."
(provide 'ob-perl)
-
-
;;; ob-perl.el ends here
diff --git a/lisp/org/ob-picolisp.el b/lisp/org/ob-picolisp.el
index ec2a228456a..b1587f2b86d 100644
--- a/lisp/org/ob-picolisp.el
+++ b/lisp/org/ob-picolisp.el
@@ -1,6 +1,6 @@
;;; ob-picolisp.el --- Babel Functions for Picolisp -*- lexical-binding: t; -*-
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Authors: Thorsten Jolitz
;; Eric Schulte
@@ -111,11 +111,11 @@ This function is called by `org-babel-execute-src-block'."
(cond
((or (member "code" result-params)
(member "pp" result-params))
- (format "(pretty (out \"/dev/null\" %s))" full-body))
+ (format "(pretty (out \"%s\" %s))" null-device full-body))
((and (member "value" result-params) (not session))
- (format "(print (out \"/dev/null\" %s))" full-body))
+ (format "(print (out \"%s\" %s))" null-device full-body))
((member "value" result-params)
- (format "(out \"/dev/null\" %s)" full-body))
+ (format "(out \"%s\" %s)" null-device full-body))
(t full-body)))
(result
(if (not (string= session-name "none"))
@@ -182,6 +182,4 @@ then create. Return the initialized session."
(provide 'ob-picolisp)
-
-
;;; ob-picolisp.el ends here
diff --git a/lisp/org/ob-plantuml.el b/lisp/org/ob-plantuml.el
index 49886e292e5..93c653870c2 100644
--- a/lisp/org/ob-plantuml.el
+++ b/lisp/org/ob-plantuml.el
@@ -1,6 +1,6 @@
;;; ob-plantuml.el --- Babel Functions for Plantuml -*- lexical-binding: t; -*-
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Zhang Weize
;; Keywords: literate programming, reproducible research
@@ -31,7 +31,7 @@
;;; Requirements:
;; plantuml | http://plantuml.sourceforge.net/
-;; plantuml.jar | `org-plantuml-jar-path' should point to the jar file
+;; plantuml.jar | `org-plantuml-jar-path' should point to the jar file (when exec mode is `jar')
;;; Code:
(require 'ob)
@@ -46,6 +46,31 @@
:version "24.1"
:type 'string)
+(defcustom org-plantuml-exec-mode 'jar
+ "Method to use for PlantUML diagram generation.
+`jar' means to use java together with the JAR.
+The JAR can be configured via `org-plantuml-jar-path'.
+
+`plantuml' means to use the PlantUML executable.
+The executable can be configured via `org-plantuml-executable-path'.
+You can also configure extra arguments via `org-plantuml-executable-args'."
+ :group 'org-babel
+ :package-version '(Org . "9.4")
+ :type 'symbol
+ :options '(jar plantuml))
+
+(defcustom org-plantuml-executable-path "plantuml"
+ "File name of the PlantUML executable."
+ :group 'org-babel
+ :package-version '(Org . "9.4")
+ :type 'string)
+
+(defcustom org-plantuml-executable-args (list "-headless")
+ "The arguments passed to plantuml executable when executing PlantUML."
+ :group 'org-babel
+ :package-version '(Org . "9.4")
+ :type '(repeat string))
+
(defun org-babel-variable-assignments:plantuml (params)
"Return a list of PlantUML statements assigning the block's variables.
PARAMS is a property list of source block parameters, which may
@@ -69,10 +94,11 @@ function to convert variables to PlantUML assignments.
If BODY does not contain @startXXX ... @endXXX clauses, @startuml
... @enduml will be added."
- (let ((assignments (org-babel-variable-assignments:plantuml params)))
- (if (string-prefix-p "@start" body t) assignments
- (format "@startuml\n%s\n@enduml"
- (org-babel-expand-body:generic body params assignments)))))
+ (let ((full-body
+ (org-babel-expand-body:generic
+ body params (org-babel-variable-assignments:plantuml params))))
+ (if (string-prefix-p "@start" body t) full-body
+ (format "@startuml\n%s\n@enduml" full-body))))
(defun org-babel-execute:plantuml (body params)
"Execute a block of plantuml code with org-babel.
@@ -82,40 +108,41 @@ This function is called by `org-babel-execute-src-block'."
(cmdline (cdr (assq :cmdline params)))
(in-file (org-babel-temp-file "plantuml-"))
(java (or (cdr (assq :java params)) ""))
+ (executable (cond ((eq org-plantuml-exec-mode 'plantuml) org-plantuml-executable-path)
+ (t "java")))
+ (executable-args (cond ((eq org-plantuml-exec-mode 'plantuml) org-plantuml-executable-args)
+ ((string= "" org-plantuml-jar-path)
+ (error "`org-plantuml-jar-path' is not set"))
+ ((not (file-exists-p org-plantuml-jar-path))
+ (error "Could not find plantuml.jar at %s" org-plantuml-jar-path))
+ (t (list java
+ "-jar"
+ (shell-quote-argument (expand-file-name org-plantuml-jar-path))))))
(full-body (org-babel-plantuml-make-body body params))
- (cmd (if (string= "" org-plantuml-jar-path)
- (error "`org-plantuml-jar-path' is not set")
- (concat "java " java " -jar "
- (shell-quote-argument
- (expand-file-name org-plantuml-jar-path))
- (if (string= (file-name-extension out-file) "png")
- " -tpng" "")
- (if (string= (file-name-extension out-file) "svg")
- " -tsvg" "")
- (if (string= (file-name-extension out-file) "eps")
- " -teps" "")
- (if (string= (file-name-extension out-file) "pdf")
- " -tpdf" "")
- (if (string= (file-name-extension out-file) "tex")
- " -tlatex" "")
- (if (string= (file-name-extension out-file) "vdx")
- " -tvdx" "")
- (if (string= (file-name-extension out-file) "xmi")
- " -txmi" "")
- (if (string= (file-name-extension out-file) "scxml")
- " -tscxml" "")
- (if (string= (file-name-extension out-file) "html")
- " -thtml" "")
- (if (string= (file-name-extension out-file) "txt")
- " -ttxt" "")
- (if (string= (file-name-extension out-file) "utxt")
- " -utxt" "")
- " -p " cmdline " < "
- (org-babel-process-file-name in-file)
- " > "
- (org-babel-process-file-name out-file)))))
- (unless (file-exists-p org-plantuml-jar-path)
- (error "Could not find plantuml.jar at %s" org-plantuml-jar-path))
+ (cmd (mapconcat #'identity
+ (append
+ (list executable)
+ executable-args
+ (pcase (file-name-extension out-file)
+ ("png" '("-tpng"))
+ ("svg" '("-tsvg"))
+ ("eps" '("-teps"))
+ ("pdf" '("-tpdf"))
+ ("tex" '("-tlatex"))
+ ("vdx" '("-tvdx"))
+ ("xmi" '("-txmi"))
+ ("scxml" '("-tscxml"))
+ ("html" '("-thtml"))
+ ("txt" '("-ttxt"))
+ ("utxt" '("-utxt")))
+ (list
+ "-p"
+ cmdline
+ "<"
+ (org-babel-process-file-name in-file)
+ ">"
+ (org-babel-process-file-name out-file)))
+ " ")))
(with-temp-file in-file (insert full-body))
(message "%s" cmd) (org-babel-eval cmd "")
nil)) ;; signal that output has already been written to file
@@ -126,6 +153,4 @@ This function is called by `org-babel-execute-src-block'."
(provide 'ob-plantuml)
-
-
;;; ob-plantuml.el ends here
diff --git a/lisp/org/ob-processing.el b/lisp/org/ob-processing.el
index fc1beadfc62..9e6572a5fdd 100644
--- a/lisp/org/ob-processing.el
+++ b/lisp/org/ob-processing.el
@@ -1,6 +1,6 @@
;;; ob-processing.el --- Babel functions for processing -*- lexical-binding: t; -*-
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Author: Jarmo Hurri (adapted from ob-asymptote.el written by Eric Schulte)
;; Keywords: literate programming, reproducible research
diff --git a/lisp/org/ob-python.el b/lisp/org/ob-python.el
index 823f6e63d57..7911205d08d 100644
--- a/lisp/org/ob-python.el
+++ b/lisp/org/ob-python.el
@@ -1,9 +1,10 @@
;;; ob-python.el --- Babel Functions for Python -*- lexical-binding: t; -*-
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Authors: Eric Schulte
;; Dan Davison
+;; Maintainer: Jack Kamm <jackkamm@gmail.com>
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org
@@ -29,10 +30,11 @@
;;; Code:
(require 'ob)
(require 'org-macs)
+(require 'python)
-(declare-function py-shell "ext:python-mode" (&optional argprompt))
+(declare-function py-shell "ext:python-mode" (&rest args))
(declare-function py-toggle-shells "ext:python-mode" (arg))
-(declare-function run-python "ext:python" (&optional cmd dedicated show))
+(declare-function py-shell-send-string "ext:python-mode" (strg &optional process))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("python" . "py"))
@@ -104,7 +106,8 @@ VARS contains resolved variable references."
(org-babel-comint-in-buffer session
(mapc (lambda (var)
(end-of-line 1) (insert var) (comint-send-input)
- (org-babel-comint-wait-for-output session)) var-lines))
+ (org-babel-comint-wait-for-output session))
+ var-lines))
session))
(defun org-babel-load-session:python (session body params)
@@ -177,42 +180,40 @@ Emacs-lisp table, otherwise return the results as a string."
"Initiate a python session.
If there is not a current inferior-process-buffer in SESSION
then create. Return the initialized session."
- (require org-babel-python-mode)
(save-window-excursion
(let* ((session (if session (intern session) :default))
- (python-buffer (org-babel-python-session-buffer session))
+ (py-buffer (org-babel-python-session-buffer session))
(cmd (if (member system-type '(cygwin windows-nt ms-dos))
(concat org-babel-python-command " -i")
org-babel-python-command)))
(cond
- ((and (eq 'python org-babel-python-mode)
- (fboundp 'run-python)) ; python.el
- (if (not (version< "24.1" emacs-version))
- (run-python cmd)
- (unless python-buffer
- (setq python-buffer (org-babel-python-with-earmuffs session)))
- (let ((python-shell-buffer-name
- (org-babel-python-without-earmuffs python-buffer)))
- (run-python cmd))))
+ ((eq 'python org-babel-python-mode) ; python.el
+ (unless py-buffer
+ (setq py-buffer (org-babel-python-with-earmuffs session)))
+ (let ((python-shell-buffer-name
+ (org-babel-python-without-earmuffs py-buffer)))
+ (run-python cmd)
+ (sleep-for 0 10)))
((and (eq 'python-mode org-babel-python-mode)
(fboundp 'py-shell)) ; python-mode.el
+ (require 'python-mode)
;; Make sure that py-which-bufname is initialized, as otherwise
;; it will be overwritten the first time a Python buffer is
;; created.
(py-toggle-shells py-default-interpreter)
;; `py-shell' creates a buffer whose name is the value of
;; `py-which-bufname' with '*'s at the beginning and end
- (let* ((bufname (if (and python-buffer (buffer-live-p python-buffer))
+ (let* ((bufname (if (and py-buffer (buffer-live-p py-buffer))
(replace-regexp-in-string ;; zap surrounding *
- "^\\*\\([^*]+\\)\\*$" "\\1" python-buffer)
+ "^\\*\\([^*]+\\)\\*$" "\\1" py-buffer)
(concat "Python-" (symbol-name session))))
(py-which-bufname bufname))
- (py-shell)
- (setq python-buffer (org-babel-python-with-earmuffs bufname))))
+ (setq py-buffer (org-babel-python-with-earmuffs bufname))
+ (py-shell nil nil t org-babel-python-command py-buffer nil nil t nil)))
(t
(error "No function available for running an inferior Python")))
(setq org-babel-python-buffers
- (cons (cons session python-buffer)
+ (cons (cons session py-buffer)
(assq-delete-all session org-babel-python-buffers)))
session)))
@@ -222,8 +223,9 @@ then create. Return the initialized session."
(org-babel-python-session-buffer
(org-babel-python-initiate-session-by-key session))))
-(defvar org-babel-python-eoe-indicator "'org_babel_python_eoe'"
+(defvar org-babel-python-eoe-indicator "org_babel_python_eoe"
"A string to indicate that evaluation has completed.")
+
(defconst org-babel-python-wrapper-method
"
def main():
@@ -238,14 +240,39 @@ def main():
open('%s', 'w').write( pprint.pformat(main()) )")
-(defconst org-babel-python--exec-tmpfile
- (concat
- "__org_babel_python_fname = '%s'; "
- "__org_babel_python_fh = open(__org_babel_python_fname); "
- "exec(compile("
- "__org_babel_python_fh.read(), __org_babel_python_fname, 'exec'"
- ")); "
- "__org_babel_python_fh.close()"))
+(defconst org-babel-python--exec-tmpfile "\
+with open('%s') as __org_babel_python_tmpfile:
+ exec(compile(__org_babel_python_tmpfile.read(), __org_babel_python_tmpfile.name, 'exec'))"
+ "Template for Python session command with output results.
+
+Has a single %s escape, the tempfile containing the source code
+to evaluate.")
+
+(defun org-babel-python-format-session-value
+ (src-file result-file result-params)
+ "Return Python code to evaluate SRC-FILE and write result to RESULT-FILE."
+ (format "\
+import ast
+with open('%s') as __org_babel_python_tmpfile:
+ __org_babel_python_ast = ast.parse(__org_babel_python_tmpfile.read())
+__org_babel_python_final = __org_babel_python_ast.body[-1]
+if isinstance(__org_babel_python_final, ast.Expr):
+ __org_babel_python_ast.body = __org_babel_python_ast.body[:-1]
+ exec(compile(__org_babel_python_ast, '<string>', 'exec'))
+ __org_babel_python_final = eval(compile(ast.Expression(
+ __org_babel_python_final.value), '<string>', 'eval'))
+ with open('%s', 'w') as __org_babel_python_tmpfile:
+ if %s:
+ import pprint
+ __org_babel_python_tmpfile.write(pprint.pformat(__org_babel_python_final))
+ else:
+ __org_babel_python_tmpfile.write(str(__org_babel_python_final))
+else:
+ exec(compile(__org_babel_python_ast, '<string>', 'exec'))
+ __org_babel_python_final = None"
+ (org-babel-process-file-name src-file 'noquote)
+ (org-babel-process-file-name result-file 'noquote)
+ (if (member "pp" result-params) "True" "False")))
(defun org-babel-python-evaluate
(session body &optional result-type result-params preamble)
@@ -256,6 +283,19 @@ open('%s', 'w').write( pprint.pformat(main()) )")
(org-babel-python-evaluate-external-process
body result-type result-params preamble)))
+(defun org-babel-python--shift-right (body &optional count)
+ (with-temp-buffer
+ (python-mode)
+ (insert body)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (unless (python-syntax-context 'string)
+ (python-indent-shift-right (line-beginning-position)
+ (line-end-position)
+ count))
+ (forward-line 1))
+ (buffer-string)))
+
(defun org-babel-python-evaluate-external-process
(body &optional result-type result-params preamble)
"Evaluate BODY in external python process.
@@ -276,89 +316,70 @@ last statement in BODY, as elisp."
(if (member "pp" result-params)
org-babel-python-pp-wrapper-method
org-babel-python-wrapper-method)
- (mapconcat
- (lambda (line) (format "\t%s" line))
- (split-string (org-remove-indentation (org-trim body))
- "[\r\n]")
- "\n")
+ (org-babel-python--shift-right body)
(org-babel-process-file-name tmp-file 'noquote))))
(org-babel-eval-read-file tmp-file))))))
(org-babel-result-cond result-params
raw
(org-babel-python-table-or-string (org-trim raw)))))
+(defun org-babel-python--send-string (session body)
+ "Pass BODY to the Python process in SESSION.
+Return output."
+ (with-current-buffer session
+ (let* ((string-buffer "")
+ (comint-output-filter-functions
+ (cons (lambda (text) (setq string-buffer
+ (concat string-buffer text)))
+ comint-output-filter-functions))
+ (body (format "\
+try:
+%s
+except:
+ raise
+finally:
+ print('%s')"
+ (org-babel-python--shift-right body 4)
+ org-babel-python-eoe-indicator)))
+ (if (not (eq 'python-mode org-babel-python-mode))
+ (let ((python-shell-buffer-name
+ (org-babel-python-without-earmuffs session)))
+ (python-shell-send-string body))
+ (require 'python-mode)
+ (py-shell-send-string body (get-buffer-process session)))
+ ;; same as `python-shell-comint-end-of-output-p' in emacs-25.1+
+ (while (not (string-match
+ org-babel-python-eoe-indicator
+ string-buffer))
+ (accept-process-output (get-buffer-process (current-buffer))))
+ (org-babel-chomp (substring string-buffer 0 (match-beginning 0))))))
+
(defun org-babel-python-evaluate-session
(session body &optional result-type result-params)
"Pass BODY to the Python process in SESSION.
If RESULT-TYPE equals `output' then return standard output as a
string. If RESULT-TYPE equals `value' then return the value of the
last statement in BODY, as elisp."
- (let* ((send-wait (lambda () (comint-send-input nil t) (sleep-for 0 5)))
- (dump-last-value
- (lambda
- (tmp-file pp)
- (mapc
- (lambda (statement) (insert statement) (funcall send-wait))
- (if pp
- (list
- "import pprint"
- (format "open('%s', 'w').write(pprint.pformat(_))"
- (org-babel-process-file-name tmp-file 'noquote)))
- (list (format "open('%s', 'w').write(str(_))"
- (org-babel-process-file-name tmp-file
- 'noquote)))))))
- (last-indent 0)
- (input-body (lambda (body)
- (dolist (line (split-string body "[\r\n]"))
- ;; Insert a blank line to end an indent
- ;; block.
- (let ((curr-indent (string-match "\\S-" line)))
- (if curr-indent
- (progn
- (when (< curr-indent last-indent)
- (insert "")
- (funcall send-wait))
- (setq last-indent curr-indent))
- (setq last-indent 0)))
- (insert line)
- (funcall send-wait))
- (funcall send-wait)))
+ (let* ((tmp-src-file (org-babel-temp-file "python-"))
(results
- (pcase result-type
- (`output
- (let ((body (if (string-match-p ".\n+." body) ; Multiline
- (let ((tmp-src-file (org-babel-temp-file
- "python-")))
- (with-temp-file tmp-src-file (insert body))
- (format org-babel-python--exec-tmpfile
- tmp-src-file))
- body)))
- (mapconcat
- #'org-trim
- (butlast
- (org-babel-comint-with-output
- (session org-babel-python-eoe-indicator t body)
- (funcall input-body body)
- (funcall send-wait) (funcall send-wait)
- (insert org-babel-python-eoe-indicator)
- (funcall send-wait))
- 2) "\n")))
- (`value
- (let ((tmp-file (org-babel-temp-file "python-")))
- (org-babel-comint-with-output
- (session org-babel-python-eoe-indicator nil body)
- (let ((comint-process-echoes nil))
- (funcall input-body body)
- (funcall dump-last-value tmp-file
- (member "pp" result-params))
- (funcall send-wait) (funcall send-wait)
- (insert org-babel-python-eoe-indicator)
- (funcall send-wait)))
- (org-babel-eval-read-file tmp-file))))))
- (unless (string= (substring org-babel-python-eoe-indicator 1 -1) results)
- (org-babel-result-cond result-params
- results
- (org-babel-python-table-or-string results)))))
+ (progn
+ (with-temp-file tmp-src-file (insert body))
+ (pcase result-type
+ (`output
+ (let ((body (format org-babel-python--exec-tmpfile
+ (org-babel-process-file-name
+ tmp-src-file 'noquote))))
+ (org-babel-python--send-string session body)))
+ (`value
+ (let* ((tmp-results-file (org-babel-temp-file "python-"))
+ (body (org-babel-python-format-session-value
+ tmp-src-file tmp-results-file result-params)))
+ (org-babel-python--send-string session body)
+ (sleep-for 0 10)
+ (org-babel-eval-read-file tmp-results-file)))))))
+ (org-babel-result-cond result-params
+ results
+ (org-babel-python-table-or-string results))))
(defun org-babel-python-read-string (string)
"Strip \\='s from around Python string."
@@ -369,6 +390,4 @@ last statement in BODY, as elisp."
(provide 'ob-python)
-
-
;;; ob-python.el ends here
diff --git a/lisp/org/ob-ref.el b/lisp/org/ob-ref.el
index 19905bf6b97..a7ab299b274 100644
--- a/lisp/org/ob-ref.el
+++ b/lisp/org/ob-ref.el
@@ -1,6 +1,6 @@
;;; ob-ref.el --- Babel Functions for Referencing External Data -*- lexical-binding: t; -*-
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Authors: Eric Schulte
;; Dan Davison
@@ -143,7 +143,8 @@ Emacs Lisp representation of the value of the variable."
(org-babel-ref-split-args new-referent))))
(when (> (length new-header-args) 0)
(setq args (append (org-babel-parse-header-arguments
- new-header-args) args)))
+ new-header-args)
+ args)))
(setq ref new-refere)))
(when (string-match "^\\(.+\\):\\(.+\\)$" ref)
(setq split-file (match-string 1 ref))
@@ -240,7 +241,6 @@ to \"0:-1\"."
"Split ARG-STRING into top-level arguments of balanced parenthesis."
(mapcar #'org-trim (org-babel-balanced-split arg-string 44)))
-
(provide 'ob-ref)
;;; ob-ref.el ends here
diff --git a/lisp/org/ob-ruby.el b/lisp/org/ob-ruby.el
index 1b8088eaee4..ccc746e8df2 100644
--- a/lisp/org/ob-ruby.el
+++ b/lisp/org/ob-ruby.el
@@ -1,6 +1,6 @@
;;; ob-ruby.el --- Babel Functions for Ruby -*- lexical-binding: t; -*-
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -39,7 +39,8 @@
(require 'ob)
(require 'org-macs)
-(declare-function run-ruby "ext:inf-ruby" (&optional command name))
+(declare-function run-ruby-or-pop-to-buffer "ext:inf-ruby" (command &optional name buffer))
+(declare-function inf-ruby-buffer "ext:inf-ruby" ())
(declare-function xmp "ext:rcodetools" (&optional option))
(defvar inf-ruby-default-implementation)
@@ -51,7 +52,8 @@
(defvar org-babel-default-header-args:ruby '())
(defvar org-babel-ruby-command "ruby"
- "Name of command to use for executing ruby code.")
+ "Name of command to use for executing ruby code.
+It's possible to override it by using a header argument `:ruby'")
(defcustom org-babel-ruby-hline-to "nil"
"Replace hlines in incoming tables with this when translating to ruby."
@@ -71,9 +73,12 @@
"Execute a block of Ruby code with Babel.
This function is called by `org-babel-execute-src-block'."
(let* ((session (org-babel-ruby-initiate-session
- (cdr (assq :session params))))
+ (cdr (assq :session params)) params))
(result-params (cdr (assq :result-params params)))
(result-type (cdr (assq :result-type params)))
+ (org-babel-ruby-command
+ (or (cdr (assq :ruby params))
+ org-babel-ruby-command))
(full-body (org-babel-expand-body:generic
body params (org-babel-variable-assignments:ruby params)))
(result (if (member "xmp" result-params)
@@ -103,7 +108,8 @@ This function is called by `org-babel-execute-src-block'."
(mapc (lambda (var)
(insert var) (comint-send-input nil t)
(org-babel-comint-wait-for-output session)
- (sit-for .1) (goto-char (point-max))) var-lines))
+ (sit-for .1) (goto-char (point-max)))
+ var-lines))
session))
(defun org-babel-load-session:ruby (session body params)
@@ -147,17 +153,24 @@ Emacs-lisp table, otherwise return the results as a string."
res)
res)))
-(defun org-babel-ruby-initiate-session (&optional session _params)
+(defun org-babel-ruby-initiate-session (&optional session params)
"Initiate a ruby session.
If there is not a current inferior-process-buffer in SESSION
then create one. Return the initialized session."
(unless (string= session "none")
(require 'inf-ruby)
- (let* ((cmd (cdr (assoc inf-ruby-default-implementation
- inf-ruby-implementations)))
+ (let* ((command (cdr (or (assq :ruby params)
+ (assoc inf-ruby-default-implementation
+ inf-ruby-implementations))))
(buffer (get-buffer (format "*%s*" session)))
(session-buffer (or buffer (save-window-excursion
- (run-ruby cmd session)
+ (run-ruby-or-pop-to-buffer
+ (if (functionp command)
+ (funcall command)
+ command)
+ (or session "ruby")
+ (unless session
+ (inf-ruby-buffer)))
(current-buffer)))))
(if (org-babel-comint-buffer-livep session-buffer)
(progn (sit-for .25) session-buffer)
@@ -263,6 +276,4 @@ return the value of the last statement in BODY, as elisp."
(provide 'ob-ruby)
-
-
;;; ob-ruby.el ends here
diff --git a/lisp/org/ob-sass.el b/lisp/org/ob-sass.el
index c101574696c..76cdfd8063a 100644
--- a/lisp/org/ob-sass.el
+++ b/lisp/org/ob-sass.el
@@ -1,6 +1,6 @@
;;; ob-sass.el --- Babel Functions for the Sass CSS generation language -*- lexical-binding: t; -*-
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -65,6 +65,4 @@ This function is called by `org-babel-execute-src-block'."
(provide 'ob-sass)
-
-
;;; ob-sass.el ends here
diff --git a/lisp/org/ob-scheme.el b/lisp/org/ob-scheme.el
index bfd53d5d8bb..a18bfb51817 100644
--- a/lisp/org/ob-scheme.el
+++ b/lisp/org/ob-scheme.el
@@ -1,6 +1,6 @@
;;; ob-scheme.el --- Babel Functions for Scheme -*- lexical-binding: t; -*-
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Authors: Eric Schulte
;; Michael Gauland
@@ -43,6 +43,7 @@
(require 'geiser-impl nil t)
(defvar geiser-repl--repl) ; Defined in geiser-repl.el
(defvar geiser-impl--implementation) ; Defined in geiser-impl.el
+(defvar geiser-scheme-implementation) ; Defined in geiser-impl.el
(defvar geiser-default-implementation) ; Defined in geiser-impl.el
(defvar geiser-active-implementations) ; Defined in geiser-impl.el
(defvar geiser-debug-show-debug-p) ; Defined in geiser-debug.el
@@ -71,7 +72,8 @@
(defun org-babel-expand-body:scheme (body params)
"Expand BODY according to PARAMS, return the expanded body."
(let ((vars (org-babel--get-vars params))
- (prepends (cdr (assq :prologue params))))
+ (prepends (cdr (assq :prologue params)))
+ (postpends (cdr (assq :epilogue params))))
(concat (and prepends (concat prepends "\n"))
(if (null vars) body
(format "(let (%s)\n%s\n)"
@@ -80,7 +82,8 @@
(format "%S" (print `(,(car var) ',(cdr var)))))
vars
"\n ")
- body)))))
+ body))
+ (and postpends (concat "\n" postpends)))))
(defvar org-babel-scheme-repl-map (make-hash-table :test #'equal)
@@ -175,7 +178,8 @@ is true; otherwise returns the last value."
(geiser-debug-show-debug-p nil))
(let ((ret (geiser-eval-region (point-min) (point-max))))
(setq result (if output
- (geiser-eval--retort-output ret)
+ (or (geiser-eval--retort-output ret)
+ "Geiser Interpreter produced no output")
(geiser-eval--retort-result-str ret "")))))
(when (not repl)
(save-current-buffer (set-buffer repl-buffer)
@@ -208,6 +212,7 @@ This function is called by `org-babel-execute-src-block'."
(let* ((result-type (cdr (assq :result-type params)))
(impl (or (when (cdr (assq :scheme params))
(intern (cdr (assq :scheme params))))
+ geiser-scheme-implementation
geiser-default-implementation
(car geiser-active-implementations)))
(session (org-babel-scheme-make-session-name
diff --git a/lisp/org/ob-screen.el b/lisp/org/ob-screen.el
index 837c18f8407..c3388c3d3de 100644
--- a/lisp/org/ob-screen.el
+++ b/lisp/org/ob-screen.el
@@ -1,6 +1,6 @@
;;; ob-screen.el --- Babel Support for Interactive Terminal -*- lexical-binding: t; -*-
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Benjamin Andresen
;; Keywords: literate programming, interactive shell
@@ -40,7 +40,8 @@
In case you want to use a different screen than one selected by your $PATH")
(defvar org-babel-default-header-args:screen
- '((:results . "silent") (:session . "default") (:cmd . "sh") (:terminal . "xterm"))
+ `((:results . "silent") (:session . "default") (:cmd . "sh")
+ (:terminal . "xterm") (:screenrc . ,null-device))
"Default arguments to use when running screen source blocks.")
(defun org-babel-execute:screen (body params)
@@ -59,11 +60,11 @@ In case you want to use a different screen than one selected by your $PATH")
(let* ((session (cdr (assq :session params)))
(cmd (cdr (assq :cmd params)))
(terminal (cdr (assq :terminal params)))
+ (screenrc (cdr (assq :screenrc params)))
(process-name (concat "org-babel: terminal (" session ")")))
(apply 'start-process process-name "*Messages*"
terminal `("-T" ,(concat "org-babel: " session) "-e" ,org-babel-screen-location
- "-c" "/dev/null" "-mS" ,(concat "org-babel-session-" session)
- ,cmd))
+ "-c" ,screenrc "-mS" ,session ,cmd))
;; XXX: Is there a better way than the following?
(while (not (org-babel-screen-session-socketname session))
;; wait until screen session is available before returning
@@ -97,9 +98,8 @@ In case you want to use a different screen than one selected by your $PATH")
nil
(mapcar
(lambda (x)
- (when (string-match
- (concat "org-babel-session-" session) x)
- x))
+ (and (string-match-p (regexp-quote session) x)
+ x))
sockets)))))
(when match-socket (car (split-string match-socket)))))
@@ -108,6 +108,7 @@ In case you want to use a different screen than one selected by your $PATH")
(let ((tmpfile (org-babel-temp-file "screen-")))
(with-temp-file tmpfile
(insert body)
+ (insert "\n")
;; org-babel has superfluous spaces
(goto-char (point-min))
@@ -138,6 +139,4 @@ The terminal should shortly flicker."
(provide 'ob-screen)
-
-
;;; ob-screen.el ends here
diff --git a/lisp/org/ob-sed.el b/lisp/org/ob-sed.el
index f926da890fc..b95f411858d 100644
--- a/lisp/org/ob-sed.el
+++ b/lisp/org/ob-sed.el
@@ -1,10 +1,9 @@
;;; ob-sed.el --- Babel Functions for Sed Scripts -*- lexical-binding: t; -*-
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Author: Bjarte Johansen
;; Keywords: literate programming, reproducible research
-;; Version: 0.1.1
;; This file is part of GNU Emacs.
@@ -68,7 +67,8 @@ function is called by `org-babel-execute-src-block'."
(in-file (cdr (assq :in-file params)))
(code-file (let ((file (org-babel-temp-file "sed-")))
(with-temp-file file
- (insert body)) file))
+ (insert body))
+ file))
(stdin (let ((stdin (cdr (assq :stdin params))))
(when stdin
(let ((tmp (org-babel-temp-file "sed-stdin-"))
@@ -102,4 +102,5 @@ function is called by `org-babel-execute-src-block'."
(cdr (assq :rowname-names params)) (cdr (assq :rownames params))))))
(provide 'ob-sed)
+
;;; ob-sed.el ends here
diff --git a/lisp/org/ob-shell.el b/lisp/org/ob-shell.el
index 1383f42f259..3eed0c1640a 100644
--- a/lisp/org/ob-shell.el
+++ b/lisp/org/ob-shell.el
@@ -1,6 +1,6 @@
;;; ob-shell.el --- Babel Functions for Shell Evaluation -*- lexical-binding: t; -*-
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -71,6 +71,19 @@ outside the Customize interface."
(set-default symbol value)
(org-babel-shell-initialize)))
+(defcustom org-babel-shell-results-defaults-to-output t
+ "Let shell execution defaults to \":results output\".
+
+When set to t, use \":results output\" when no :results setting
+is set. This is especially useful for inline source blocks.
+
+When set to nil, stick to the convention of using :results value
+as the default setting when no :results is set, the \"value\" of
+a shell execution being its exit code."
+ :group 'org-babel
+ :type 'boolean
+ :package-version '(Org . "9.4"))
+
(defun org-babel-execute:shell (body params)
"Execute a block of Shell commands with Babel.
This function is called by `org-babel-execute-src-block'."
@@ -79,9 +92,17 @@ This function is called by `org-babel-execute-src-block'."
(stdin (let ((stdin (cdr (assq :stdin params))))
(when stdin (org-babel-sh-var-to-string
(org-babel-ref-resolve stdin)))))
+ (results-params (cdr (assq :result-params params)))
+ (value-is-exit-status
+ (or (and
+ (equal '("replace") results-params)
+ (not org-babel-shell-results-defaults-to-output))
+ (member "value" results-params)))
(cmdline (cdr (assq :cmdline params)))
- (full-body (org-babel-expand-body:generic
- body params (org-babel-variable-assignments:shell params))))
+ (full-body (concat
+ (org-babel-expand-body:generic
+ body params (org-babel-variable-assignments:shell params))
+ (when value-is-exit-status "\necho $?"))))
(org-babel-reassemble-table
(org-babel-sh-evaluate session full-body params stdin cmdline)
(org-babel-pick-name
@@ -96,7 +117,8 @@ This function is called by `org-babel-execute-src-block'."
(org-babel-comint-in-buffer session
(mapc (lambda (var)
(insert var) (comint-send-input nil t)
- (org-babel-comint-wait-for-output session)) var-lines))
+ (org-babel-comint-wait-for-output session))
+ var-lines))
session))
(defun org-babel-load-session:shell (session body params)
@@ -129,15 +151,15 @@ This function is called by `org-babel-execute-src-block'."
(varname values &optional sep hline)
"Return a list of statements declaring the values as bash associative array."
(format "unset %s\ndeclare -A %s\n%s"
- varname varname
- (mapconcat
- (lambda (items)
- (format "%s[%s]=%s"
- varname
- (org-babel-sh-var-to-sh (car items) sep hline)
- (org-babel-sh-var-to-sh (cdr items) sep hline)))
- values
- "\n")))
+ varname varname
+ (mapconcat
+ (lambda (items)
+ (format "%s[%s]=%s"
+ varname
+ (org-babel-sh-var-to-sh (car items) sep hline)
+ (org-babel-sh-var-to-sh (cdr items) sep hline)))
+ values
+ "\n")))
(defun org-babel--variable-assignments:bash (varname values &optional sep hline)
"Represent the parameters as useful Bash shell variables."
@@ -208,6 +230,12 @@ If RESULT-TYPE equals `output' then return a list of the outputs
of the statements in BODY, if RESULT-TYPE equals `value' then
return the value of the last statement in BODY."
(let* ((shebang (cdr (assq :shebang params)))
+ (results-params (cdr (assq :result-params params)))
+ (value-is-exit-status
+ (or (and
+ (equal '("replace") results-params)
+ (not org-babel-shell-results-defaults-to-output))
+ (member "value" results-params)))
(results
(cond
((or stdin cmdline) ; external shell script w/STDIN
@@ -259,8 +287,9 @@ return the value of the last statement in BODY."
(insert body))
(set-file-modes script-file #o755)
(org-babel-eval script-file "")))
- (t
- (org-babel-eval shell-file-name (org-trim body))))))
+ (t (org-babel-eval shell-file-name (org-trim body))))))
+ (when value-is-exit-status
+ (setq results (car (reverse (split-string results "\n" t)))))
(when results
(let ((result-params (cdr (assq :result-params params))))
(org-babel-result-cond result-params
@@ -277,6 +306,4 @@ return the value of the last statement in BODY."
(provide 'ob-shell)
-
-
;;; ob-shell.el ends here
diff --git a/lisp/org/ob-shen.el b/lisp/org/ob-shen.el
index 1ce7113294c..6803b0bf68b 100644
--- a/lisp/org/ob-shen.el
+++ b/lisp/org/ob-shen.el
@@ -1,6 +1,6 @@
;;; ob-shen.el --- Babel Functions for Shen -*- lexical-binding: t; -*-
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, shen
@@ -75,4 +75,5 @@ This function is called by `org-babel-execute-src-block'."
(error results))))))
(provide 'ob-shen)
+
;;; ob-shen.el ends here
diff --git a/lisp/org/ob-sql.el b/lisp/org/ob-sql.el
index 59cf19568ed..947acef1b27 100644
--- a/lisp/org/ob-sql.el
+++ b/lisp/org/ob-sql.el
@@ -1,6 +1,6 @@
;;; ob-sql.el --- Babel Functions for SQL -*- lexical-binding: t; -*-
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -55,7 +55,7 @@
;; - dbi
;; - mssql
;; - sqsh
-;; - postgresql
+;; - postgresql (postgres)
;; - oracle
;; - vertica
;;
@@ -73,6 +73,7 @@
(declare-function orgtbl-to-csv "org-table" (table params))
(declare-function org-table-to-lisp "org-table" (&optional txt))
(declare-function cygwin-convert-file-name-to-windows "cygw32.c" (file &optional absolute-p))
+(declare-function sql-set-product "sql" (product))
(defvar sql-connection-alist)
(defvar org-babel-default-header-args:sql '())
@@ -92,6 +93,13 @@
(org-babel-sql-expand-vars
body (org-babel--get-vars params)))
+(defun org-babel-edit-prep:sql (info)
+ "Set `sql-product' in Org edit buffer.
+Set `sql-product' in Org edit buffer according to the
+corresponding :engine source block header argument."
+ (let ((product (cdr (assq :engine (nth 2 info)))))
+ (sql-set-product product)))
+
(defun org-babel-sql-dbstring-mysql (host port user password database)
"Make MySQL cmd line args for database connection. Pass nil to omit that arg."
(combine-and-quote-strings
@@ -156,7 +164,8 @@ SQL Server on Windows and Linux platform."
" "))
(defun org-babel-sql-dbstring-vertica (host port user password database)
- "Make Vertica command line args for database connection. Pass nil to omit that arg."
+ "Make Vertica command line args for database connection.
+Pass nil to omit that arg."
(mapconcat #'identity
(delq nil
(list (when host (format "-h %s" host))
@@ -211,64 +220,64 @@ This function is called by `org-babel-execute-src-block'."
(out-file (or (cdr (assq :out-file params))
(org-babel-temp-file "sql-out-")))
(header-delim "")
- (command (pcase (intern engine)
- (`dbi (format "dbish --batch %s < %s | sed '%s' > %s"
- (or cmdline "")
- (org-babel-process-file-name in-file)
- "/^+/d;s/^|//;s/(NULL)/ /g;$d"
- (org-babel-process-file-name out-file)))
- (`monetdb (format "mclient -f tab %s < %s > %s"
- (or cmdline "")
- (org-babel-process-file-name in-file)
- (org-babel-process-file-name out-file)))
- (`mssql (format "sqlcmd %s -s \"\t\" %s -i %s -o %s"
- (or cmdline "")
- (org-babel-sql-dbstring-mssql
- dbhost dbuser dbpassword database)
- (org-babel-sql-convert-standard-filename
- (org-babel-process-file-name in-file))
- (org-babel-sql-convert-standard-filename
- (org-babel-process-file-name out-file))))
- (`mysql (format "mysql %s %s %s < %s > %s"
- (org-babel-sql-dbstring-mysql
- dbhost dbport dbuser dbpassword database)
- (if colnames-p "" "-N")
- (or cmdline "")
- (org-babel-process-file-name in-file)
- (org-babel-process-file-name out-file)))
- (`postgresql (format
- "%spsql --set=\"ON_ERROR_STOP=1\" %s -A -P \
-footer=off -F \"\t\" %s -f %s -o %s %s"
- (if dbpassword
- (format "PGPASSWORD=%s " dbpassword)
- "")
- (if colnames-p "" "-t")
- (org-babel-sql-dbstring-postgresql
- dbhost dbport dbuser database)
- (org-babel-process-file-name in-file)
- (org-babel-process-file-name out-file)
- (or cmdline "")))
- (`sqsh (format "sqsh %s %s -i %s -o %s -m csv"
+ (command (cl-case (intern engine)
+ (dbi (format "dbish --batch %s < %s | sed '%s' > %s"
+ (or cmdline "")
+ (org-babel-process-file-name in-file)
+ "/^+/d;s/^|//;s/(NULL)/ /g;$d"
+ (org-babel-process-file-name out-file)))
+ (monetdb (format "mclient -f tab %s < %s > %s"
+ (or cmdline "")
+ (org-babel-process-file-name in-file)
+ (org-babel-process-file-name out-file)))
+ (mssql (format "sqlcmd %s -s \"\t\" %s -i %s -o %s"
(or cmdline "")
- (org-babel-sql-dbstring-sqsh
+ (org-babel-sql-dbstring-mssql
dbhost dbuser dbpassword database)
(org-babel-sql-convert-standard-filename
(org-babel-process-file-name in-file))
(org-babel-sql-convert-standard-filename
(org-babel-process-file-name out-file))))
- (`vertica (format "vsql %s -f %s -o %s %s"
- (org-babel-sql-dbstring-vertica
- dbhost dbport dbuser dbpassword database)
- (org-babel-process-file-name in-file)
- (org-babel-process-file-name out-file)
- (or cmdline "")))
- (`oracle (format
- "sqlplus -s %s < %s > %s"
- (org-babel-sql-dbstring-oracle
- dbhost dbport dbuser dbpassword database)
- (org-babel-process-file-name in-file)
- (org-babel-process-file-name out-file)))
- (_ (error "No support for the %s SQL engine" engine)))))
+ (mysql (format "mysql %s %s %s < %s > %s"
+ (org-babel-sql-dbstring-mysql
+ dbhost dbport dbuser dbpassword database)
+ (if colnames-p "" "-N")
+ (or cmdline "")
+ (org-babel-process-file-name in-file)
+ (org-babel-process-file-name out-file)))
+ ((postgresql postgres) (format
+ "%spsql --set=\"ON_ERROR_STOP=1\" %s -A -P \
+footer=off -F \"\t\" %s -f %s -o %s %s"
+ (if dbpassword
+ (format "PGPASSWORD=%s " dbpassword)
+ "")
+ (if colnames-p "" "-t")
+ (org-babel-sql-dbstring-postgresql
+ dbhost dbport dbuser database)
+ (org-babel-process-file-name in-file)
+ (org-babel-process-file-name out-file)
+ (or cmdline "")))
+ (sqsh (format "sqsh %s %s -i %s -o %s -m csv"
+ (or cmdline "")
+ (org-babel-sql-dbstring-sqsh
+ dbhost dbuser dbpassword database)
+ (org-babel-sql-convert-standard-filename
+ (org-babel-process-file-name in-file))
+ (org-babel-sql-convert-standard-filename
+ (org-babel-process-file-name out-file))))
+ (vertica (format "vsql %s -f %s -o %s %s"
+ (org-babel-sql-dbstring-vertica
+ dbhost dbport dbuser dbpassword database)
+ (org-babel-process-file-name in-file)
+ (org-babel-process-file-name out-file)
+ (or cmdline "")))
+ (oracle (format
+ "sqlplus -s %s < %s > %s"
+ (org-babel-sql-dbstring-oracle
+ dbhost dbport dbuser dbpassword database)
+ (org-babel-process-file-name in-file)
+ (org-babel-process-file-name out-file)))
+ (t (user-error "No support for the %s SQL engine" engine)))))
(with-temp-file in-file
(insert
(pcase (intern engine)
@@ -301,7 +310,7 @@ SET COLSEP '|'
(progn (insert-file-contents-literally out-file) (buffer-string)))
(with-temp-buffer
(cond
- ((memq (intern engine) '(dbi mysql postgresql sqsh vertica))
+ ((memq (intern engine) '(dbi mysql postgresql postgres sqsh vertica))
;; Add header row delimiter after column-names header in first line
(cond
(colnames-p
@@ -365,6 +374,4 @@ SET COLSEP '|'
(provide 'ob-sql)
-
-
;;; ob-sql.el ends here
diff --git a/lisp/org/ob-sqlite.el b/lisp/org/ob-sqlite.el
index 957ee653479..6e21fa9fd9a 100644
--- a/lisp/org/ob-sqlite.el
+++ b/lisp/org/ob-sqlite.el
@@ -1,6 +1,6 @@
;;; ob-sqlite.el --- Babel Functions for SQLite Databases -*- lexical-binding: t; -*-
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -133,11 +133,12 @@ This function is called by `org-babel-execute-src-block'."
"If RESULT looks like a trivial table, then unwrap it."
(if (and (equal 1 (length result))
(equal 1 (length (car result))))
- (org-babel-read (caar result))
+ (org-babel-read (caar result) t)
(mapcar (lambda (row)
(if (eq 'hline row)
'hline
- (mapcar #'org-babel-string-read row))) result)))
+ (mapcar #'org-babel-string-read row)))
+ result)))
(defun org-babel-sqlite-offset-colnames (table headers-p)
"If HEADERS-P is non-nil then offset the first row as column names."
@@ -152,6 +153,4 @@ Prepare SESSION according to the header arguments specified in PARAMS."
(provide 'ob-sqlite)
-
-
;;; ob-sqlite.el ends here
diff --git a/lisp/org/ob-stan.el b/lisp/org/ob-stan.el
index 678047c8008..1f2afdeeda7 100644
--- a/lisp/org/ob-stan.el
+++ b/lisp/org/ob-stan.el
@@ -1,6 +1,6 @@
;;; ob-stan.el --- Babel Functions for Stan -*- lexical-binding: t; -*-
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Author: Kyle Meyer
;; Keywords: literate programming, reproducible research
@@ -82,4 +82,5 @@ Otherwise, write the Stan code directly to the named file."
(user-error "Stan does not support sessions"))
(provide 'ob-stan)
+
;;; ob-stan.el ends here
diff --git a/lisp/org/ob-table.el b/lisp/org/ob-table.el
index 3132965c702..39a14a25d6c 100644
--- a/lisp/org/ob-table.el
+++ b/lisp/org/ob-table.el
@@ -1,6 +1,6 @@
;;; ob-table.el --- Support for Calling Babel Functions from Tables -*- lexical-binding: t; -*-
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -62,7 +62,8 @@ If STRING ends in a newline character, then remove the newline
character and replace it with ellipses."
(if (and (stringp string) (string-match "[\n\r]\\(.\\)?" string))
(concat (substring string 0 (match-beginning 0))
- (when (match-string 1 string) "...")) string))
+ (when (match-string 1 string) "..."))
+ string))
(defmacro org-sbe (source-block &rest variables)
"Return the results of calling SOURCE-BLOCK with VARIABLES.
@@ -147,6 +148,4 @@ as shown in the example below.
(provide 'ob-table)
-
-
;;; ob-table.el ends here
diff --git a/lisp/org/ob-tangle.el b/lisp/org/ob-tangle.el
index 946039869fb..3c3943c8fa9 100644
--- a/lisp/org/ob-tangle.el
+++ b/lisp/org/ob-tangle.el
@@ -1,6 +1,6 @@
;;; ob-tangle.el --- Extract Source Code From Org Files -*- lexical-binding: t; -*-
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -41,6 +41,7 @@
(declare-function org-element-type "org-element" (element))
(declare-function org-heading-components "org" ())
(declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
+(declare-function org-in-archived-heading-p "org" (&optional no-inheritance))
(declare-function outline-previous-heading "outline" ())
(defcustom org-babel-tangle-lang-exts
@@ -166,13 +167,14 @@ evaluating BODY."
(def-edebug-spec org-babel-with-temp-filebuffer (form body))
;;;###autoload
-(defun org-babel-tangle-file (file &optional target-file lang)
+(defun org-babel-tangle-file (file &optional target-file lang-re)
"Extract the bodies of source code blocks in FILE.
Source code blocks are extracted with `org-babel-tangle'.
Optional argument TARGET-FILE can be used to specify a default
-export file for all source blocks. Optional argument LANG can be
-used to limit the exported source code blocks by language.
-Return a list whose CAR is the tangled file name."
+export file for all source blocks. Optional argument LANG-RE can
+be used to limit the exported source code blocks by languages
+matching a regular expression. Return a list whose CAR is the
+tangled file name."
(interactive "fFile to tangle: \nP")
(let ((visited-p (find-buffer-visiting (expand-file-name file)))
to-be-removed)
@@ -180,7 +182,7 @@ Return a list whose CAR is the tangled file name."
(save-window-excursion
(find-file file)
(setq to-be-removed (current-buffer))
- (mapcar #'expand-file-name (org-babel-tangle nil target-file lang)))
+ (mapcar #'expand-file-name (org-babel-tangle nil target-file lang-re)))
(unless visited-p
(kill-buffer to-be-removed)))))
@@ -192,7 +194,7 @@ Return a list whose CAR is the tangled file name."
(mapc (lambda (el) (copy-file el pub-dir t)) (org-babel-tangle-file filename)))
;;;###autoload
-(defun org-babel-tangle (&optional arg target-file lang)
+(defun org-babel-tangle (&optional arg target-file lang-re)
"Write code blocks to source-specific files.
Extract the bodies of all source code blocks from the current
file into their own source-specific files.
@@ -200,8 +202,9 @@ With one universal prefix argument, only tangle the block at point.
When two universal prefix arguments, only tangle blocks for the
tangle file of the block at point.
Optional argument TARGET-FILE can be used to specify a default
-export file for all source blocks. Optional argument LANG can be
-used to limit the exported source code blocks by language."
+export file for all source blocks. Optional argument LANG-RE can
+be used to limit the exported source code blocks by languages
+matching a regular expression."
(interactive "P")
(run-hooks 'org-babel-pre-tangle-hook)
;; Possibly Restrict the buffer to the current code block
@@ -286,7 +289,7 @@ used to limit the exported source code blocks by language."
specs)))
(if (equal arg '(4))
(org-babel-tangle-single-block 1 t)
- (org-babel-tangle-collect-blocks lang tangle-file)))
+ (org-babel-tangle-collect-blocks lang-re tangle-file)))
(message "Tangled %d code block%s from %s" block-counter
(if (= block-counter 1) "" "s")
(file-name-nondirectory
@@ -364,13 +367,14 @@ that the appropriate major-mode is set. SPEC has the form:
(org-fill-template
org-babel-tangle-comment-format-end link-data)))))
-(defun org-babel-tangle-collect-blocks (&optional language tangle-file)
+(defun org-babel-tangle-collect-blocks (&optional lang-re tangle-file)
"Collect source blocks in the current Org file.
Return an association list of source-code block specifications of
the form used by `org-babel-spec-to-string' grouped by language.
-Optional argument LANGUAGE can be used to limit the collected
-source code blocks by language. Optional argument TANGLE-FILE
-can be used to limit the collected code blocks by target file."
+Optional argument LANG-RE can be used to limit the collected
+source code blocks by languages matching a regular expression.
+Optional argument TANGLE-FILE can be used to limit the collected
+code blocks by target file."
(let ((counter 0) last-heading-pos blocks)
(org-babel-map-src-blocks (buffer-file-name)
(let ((current-heading-pos
@@ -379,13 +383,14 @@ can be used to limit the collected code blocks by target file."
(if (eq last-heading-pos current-heading-pos) (cl-incf counter)
(setq counter 1)
(setq last-heading-pos current-heading-pos)))
- (unless (org-in-commented-heading-p)
+ (unless (or (org-in-commented-heading-p)
+ (org-in-archived-heading-p))
(let* ((info (org-babel-get-src-block-info 'light))
(src-lang (nth 0 info))
(src-tfile (cdr (assq :tangle (nth 2 info)))))
(unless (or (string= src-tfile "no")
(and tangle-file (not (equal tangle-file src-tfile)))
- (and language (not (string= language src-lang))))
+ (and lang-re (not (string-match-p lang-re src-lang))))
;; Add the spec for this block to blocks under its
;; language.
(let ((by-lang (assoc src-lang blocks))
@@ -471,9 +476,9 @@ non-nil, return the full association list to be used by
file)
(if (and org-babel-tangle-use-relative-file-links
(string-match org-link-types-re link)
- (string= (match-string 0 link) "file"))
+ (string= (match-string 1 link) "file"))
(concat "file:"
- (file-relative-name (match-string 1 link)
+ (file-relative-name (substring link (match-end 0))
(file-name-directory
(cdr (assq :tangle params)))))
link)
@@ -513,14 +518,16 @@ which enable the original code blocks to be found."
(goto-char (point-min))
(let ((counter 0) new-body end)
(while (re-search-forward org-link-bracket-re nil t)
- (when (re-search-forward
- (concat " " (regexp-quote (match-string 2)) " ends here"))
- (setq end (match-end 0))
- (forward-line -1)
- (save-excursion
- (when (setq new-body (org-babel-tangle-jump-to-org))
- (org-babel-update-block-body new-body)))
- (setq counter (+ 1 counter)))
+ (if (and (match-string 2)
+ (re-search-forward
+ (concat " " (regexp-quote (match-string 2)) " ends here") nil t))
+ (progn (setq end (match-end 0))
+ (forward-line -1)
+ (save-excursion
+ (when (setq new-body (org-babel-tangle-jump-to-org))
+ (org-babel-update-block-body new-body)))
+ (setq counter (+ 1 counter)))
+ (setq end (point)))
(goto-char end))
(prog1 counter (message "Detangled %d code blocks" counter)))))
@@ -541,7 +548,8 @@ which enable the original code blocks to be found."
(save-match-data
(re-search-forward
(concat " " (regexp-quote block-name)
- " ends here") nil t)
+ " ends here")
+ nil t)
(setq end (line-beginning-position))))))))
(unless (and start (< start mid) (< mid end))
(error "Not in tangled code"))
diff --git a/lisp/org/ob-vala.el b/lisp/org/ob-vala.el
index b1c22756226..6c3068a8b47 100644
--- a/lisp/org/ob-vala.el
+++ b/lisp/org/ob-vala.el
@@ -1,6 +1,6 @@
;;; ob-vala.el --- Babel functions for Vala evaluation -*- lexical-binding: t; -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; Author: Christian Garbs <mitch@cgarbs.de>
;; Keywords: literate programming, reproducible research
diff --git a/lisp/org/ob.el b/lisp/org/ob.el
index 7347baba11b..1e89b02aed1 100644
--- a/lisp/org/ob.el
+++ b/lisp/org/ob.el
@@ -1,6 +1,6 @@
;;; ob.el --- Working with Code Blocks in Org -*- lexical-binding: t; -*-
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Authors: Eric Schulte
;; Keywords: literate programming, reproducible research
diff --git a/lisp/org/ol-bbdb.el b/lisp/org/ol-bbdb.el
index 9f522ce5bdc..01a1fe93255 100644
--- a/lisp/org/ol-bbdb.el
+++ b/lisp/org/ol-bbdb.el
@@ -1,6 +1,6 @@
;;; ol-bbdb.el --- Links to BBDB entries -*- lexical-binding: t; -*-
-;; Copyright (C) 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;; Authors: Carsten Dominik <carsten at orgmode dot org>
;; Thomas Baumann <thomas dot baumann at ch dot tum dot de>
@@ -98,7 +98,7 @@
(require 'org-macs)
(require 'ol)
-;; Declare functions and variables
+;;; Declare functions and variables
(declare-function bbdb "ext:bbdb-com" (string elidep))
(declare-function bbdb-company "ext:bbdb-com" (string elidep))
@@ -126,9 +126,9 @@
(declare-function diary-ordinal-suffix "diary-lib" (n))
-(with-no-warnings (defvar date)) ;unprefixed, from calendar.el
+(with-no-warnings (defvar date)) ; unprefixed, from calendar.el
-;; Customization
+;;; Customization
(defgroup org-bbdb-anniversaries nil
"Customizations for including anniversaries from BBDB into Agenda."
@@ -162,13 +162,13 @@ used."
'(("birthday" .
(lambda (name years suffix)
(concat "Birthday: [[bbdb:" name "][" name " ("
- (format "%s" years) ; handles numbers as well as strings
- suffix ")]]")))
+ (format "%s" years) ; handles numbers as well as strings
+ suffix ")]]")))
("wedding" .
(lambda (name years suffix)
(concat "[[bbdb:" name "][" name "'s "
- (format "%s" years)
- suffix " wedding anniversary]]"))))
+ (format "%s" years)
+ suffix " wedding anniversary]]"))))
"How different types of anniversaries should be formatted.
An alist of elements (STRING . FORMAT) where STRING is the name of an
anniversary class and format is either:
@@ -221,7 +221,8 @@ date year)."
:complete #'org-bbdb-complete-link
:store #'org-bbdb-store-link)
-;; Implementation
+;;; Implementation
+
(defun org-bbdb-store-link ()
"Store a link to a BBDB database entry."
(when (eq major-mode 'bbdb-mode)
@@ -236,7 +237,7 @@ date year)."
:link link :description name)
link)))
-(defun org-bbdb-export (path desc format)
+(defun org-bbdb-export (path desc format _)
"Create the export version of a BBDB link specified by PATH or DESC.
If exporting to either HTML or LaTeX FORMAT the link will be
italicized, in all other cases it is left unchanged."
@@ -249,7 +250,7 @@ italicized, in all other cases it is left unchanged."
(format "<text:span text:style-name=\"Emphasis\">%s</text:span>" desc))
(t desc)))
-(defun org-bbdb-open (name)
+(defun org-bbdb-open (name _)
"Follow a BBDB link to NAME."
(require 'bbdb-com)
(let ((inhibit-redisplay (not debug-on-error)))
@@ -362,7 +363,9 @@ This is used by Org to re-create the anniversary hash table."
;;;###autoload
(defun org-bbdb-anniversaries ()
- "Extract anniversaries from BBDB for display in the agenda."
+ "Extract anniversaries from BBDB for display in the agenda.
+When called programmatically, this function expects the `date'
+variable to be globally bound."
(require 'bbdb)
(require 'diary-lib)
(unless (hash-table-p org-bbdb-anniv-hash)
@@ -380,7 +383,7 @@ This is used by Org to re-create the anniversary hash table."
(text ())
rec recs)
- ;; we don't want to miss people born on Feb. 29th
+ ;; We don't want to miss people born on Feb. 29th
(when (and (= m 3) (= d 1)
(not (null (gethash (list 2 29) org-bbdb-anniv-hash)))
(not (calendar-leap-year-p y)))
@@ -415,8 +418,9 @@ This is used by Org to re-create the anniversary hash table."
))
text))
-;;; Return list of anniversaries for today and the next n-1 (default: n=7) days.
-;;; This is meant to be used in an org file instead of org-bbdb-anniversaries:
+;;; Return the list of anniversaries for today and the next n-1
+;;; (default: n=7) days. This is meant to be used in an org file
+;;; instead of org-bbdb-anniversaries:
;;;
;;; %%(org-bbdb-anniversaries-future)
;;;
@@ -427,7 +431,7 @@ This is used by Org to re-create the anniversary hash table."
;;; to override the 7-day default.
(defun org-bbdb-date-list (d n)
- "Return a list of dates in (m d y) format from the given date D to n-1 days hence."
+ "Return list of dates in (m d y) format from the given date D to n-1 days hence."
(let ((abs (calendar-absolute-from-gregorian d)))
(mapcar (lambda (i) (calendar-gregorian-from-absolute (+ abs i)))
(number-sequence 0 (1- n)))))
@@ -442,15 +446,14 @@ for the same event depending on if it occurs in the next few days
or far away in the future."
(let ((delta (- (calendar-absolute-from-gregorian anniv-date)
(calendar-absolute-from-gregorian agenda-date))))
-
(cond
((= delta 0) " -- today\\&")
((= delta 1) " -- tomorrow\\&")
- ((< delta org-bbdb-general-anniversary-description-after) (format " -- in %d days\\&" delta))
+ ((< delta org-bbdb-general-anniversary-description-after)
+ (format " -- in %d days\\&" delta))
((pcase-let ((`(,month ,day ,year) anniv-date))
(format " -- %d-%02d-%02d\\&" year month day))))))
-
(defun org-bbdb-anniversaries-future (&optional n)
"Return list of anniversaries for today and the next n-1 days (default n=7)."
(let ((n (or n 7)))
diff --git a/lisp/org/ol-bibtex.el b/lisp/org/ol-bibtex.el
index f139d645dad..6b591218c82 100644
--- a/lisp/org/ol-bibtex.el
+++ b/lisp/org/ol-bibtex.el
@@ -1,6 +1,6 @@
;;; ol-bibtex.el --- Links to BibTeX entries -*- lexical-binding: t; -*-
;;
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;;
;; Authors: Bastien Guerry <bzg@gnu.org>
;; Carsten Dominik <carsten dot dominik at gmail dot com>
@@ -95,7 +95,7 @@
;; The link creation part has been part of Org for a long time.
;;
;; Creating better capture template information was inspired by a request
-;; of Austin Frank: http://article.gmane.org/gmane.emacs.orgmode/4112
+;; of Austin Frank: https://orgmode.org/list/m0myu03vbx.fsf@gmail.com
;; and then implemented by Bastien Guerry.
;;
;; Eric Schulte eventually added the functions for translating between
@@ -134,10 +134,11 @@
(declare-function org-insert-heading "org" (&optional arg invisible-ok top))
(declare-function org-map-entries "org" (func &optional match scope &rest skip))
(declare-function org-narrow-to-subtree "org" ())
-(declare-function org-open-file "org" (path &optional in-emacs line search))
(declare-function org-set-property "org" (property value))
(declare-function org-toggle-tag "org" (tag &optional onoff))
+(declare-function org-search-view "org-agenda" (&optional todo-only string edit-at))
+
;;; Bibtex data
(defvar org-bibtex-types
@@ -483,12 +484,11 @@ With optional argument OPTIONAL, also prompt for optional fields."
:follow #'org-bibtex-open
:store #'org-bibtex-store-link)
-(defun org-bibtex-open (path)
- "Visit the bibliography entry on PATH."
- (let* ((search (when (string-match "::\\(.+\\)\\'" path)
- (match-string 1 path)))
- (path (substring path 0 (match-beginning 0))))
- (org-open-file path t nil search)))
+(defun org-bibtex-open (path arg)
+ "Visit the bibliography entry on PATH.
+ARG, when non-nil, is a universal prefix argument. See
+`org-open-file' for details."
+ (org-link-open-as-file path arg))
(defun org-bibtex-store-link ()
"Store a link to a BibTeX entry."
@@ -556,7 +556,8 @@ With optional argument OPTIONAL, also prompt for optional fields."
;; We construct a regexp that searches for "@entrytype{" followed by the key
(goto-char (point-min))
(and (re-search-forward (concat "@[a-zA-Z]+[ \t\n]*{[ \t\n]*"
- (regexp-quote s) "[ \t\n]*,") nil t)
+ (regexp-quote s) "[ \t\n]*,")
+ nil t)
(goto-char (match-beginning 0)))
(if (and (match-beginning 0) (equal current-prefix-arg '(16)))
;; Use double prefix to indicate that any web link should be browsed
@@ -596,7 +597,8 @@ Headlines are exported using `org-bibtex-headline'."
(with-temp-file filename
(insert (mapconcat #'identity bibtex-entries "\n")))
(message "Successfully exported %d BibTeX entries to %s"
- (length bibtex-entries) filename) nil))))
+ (length bibtex-entries) filename)
+ nil))))
(when error-point
(goto-char error-point)
(message "Bibtex error at %S" (nth 4 (org-heading-components))))))
@@ -661,7 +663,8 @@ This uses `bibtex-parse-entry'."
(when (and (> (length str) 1)
(= (aref str 0) (car pair))
(= (aref str (1- (length str))) (cdr pair)))
- (setf str (substring str 1 (1- (length str)))))) str)))
+ (setf str (substring str 1 (1- (length str))))))
+ str)))
(push (mapcar
(lambda (pair)
(cons (let ((field (funcall keyword (car pair))))
diff --git a/lisp/org/ol-docview.el b/lisp/org/ol-docview.el
index 22b630299bf..7ab67de8091 100644
--- a/lisp/org/ol-docview.el
+++ b/lisp/org/ol-docview.el
@@ -1,6 +1,6 @@
;;; ol-docview.el --- Links to Docview mode buffers -*- lexical-binding: t; -*-
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Jan Böcker <jan.boecker at jboecker dot de>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -68,7 +68,7 @@
((eq format 'ascii) (format "%s (%s)" desc path))
(t path)))))
-(defun org-docview-open (link)
+(defun org-docview-open (link _)
(string-match "\\(.*?\\)\\(?:::\\([0-9]+\\)\\)?$" link)
(let ((path (match-string 1 link))
(page (and (match-beginning 2)
@@ -98,7 +98,6 @@ and append it."
"::"
(read-from-minibuffer "Page:" "1")))
-
(provide 'ol-docview)
;;; ol-docview.el ends here
diff --git a/lisp/org/ol-eshell.el b/lisp/org/ol-eshell.el
index 7e742f8892a..769e7ee5225 100644
--- a/lisp/org/ol-eshell.el
+++ b/lisp/org/ol-eshell.el
@@ -1,6 +1,6 @@
;;; ol-eshell.el - Links to Working Directories in Eshell -*- lexical-binding: t; -*-
-;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
;; Author: Konrad Hinsen <konrad.hinsen AT fastmail.net>
@@ -33,7 +33,7 @@
:follow #'org-eshell-open
:store #'org-eshell-store-link)
-(defun org-eshell-open (link)
+(defun org-eshell-open (link _)
"Switch to an eshell buffer and execute a command line.
The link can be just a command line (executed in the default
eshell buffer) or a command line prefixed by a buffer name
diff --git a/lisp/org/ol-eww.el b/lisp/org/ol-eww.el
index f32c06b6c89..e9ffee6e560 100644
--- a/lisp/org/ol-eww.el
+++ b/lisp/org/ol-eww.el
@@ -1,6 +1,6 @@
;;; ol-eww.el --- Store URL and kill from Eww mode -*- lexical-binding: t -*-
-;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2021 Free Software Foundation, Inc.
;; Author: Marco Wahl <marcowahlsoft>a<gmailcom>
;; Keywords: link, eww
@@ -46,17 +46,22 @@
;;; Code:
(require 'ol)
(require 'cl-lib)
+(require 'eww)
+;; For Emacsen < 25.
(defvar eww-current-title)
(defvar eww-current-url)
-(defvar eww-data)
-(defvar eww-mode-map)
-
-(declare-function eww-current-url "eww")
;; Store Org link in Eww mode buffer
-(org-link-set-parameters "eww" :follow #'eww :store #'org-eww-store-link)
+(org-link-set-parameters "eww"
+ :follow #'org-eww-open
+ :store #'org-eww-store-link)
+
+(defun org-eww-open (url _)
+ "Open URL with Eww in the current buffer."
+ (eww url))
+
(defun org-eww-store-link ()
"Store a link to the url of an EWW buffer."
(when (eq major-mode 'eww-mode)
diff --git a/lisp/org/ol-gnus.el b/lisp/org/ol-gnus.el
index 71d55cd7c8d..71051bc6830 100644
--- a/lisp/org/ol-gnus.el
+++ b/lisp/org/ol-gnus.el
@@ -1,6 +1,6 @@
;;; ol-gnus.el --- Links to Gnus Groups and Messages -*- lexical-binding: t; -*-
-;; Copyright (C) 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Tassilo Horn <tassilo at member dot fsf dot org>
@@ -34,7 +34,8 @@
(require 'gnus-sum)
(require 'gnus-util)
(require 'nnheader)
-(require 'nnselect)
+(or (require 'nnselect nil t) ; Emacs >= 28
+ (require 'nnir nil t)) ; Emacs < 28
(require 'ol)
@@ -61,7 +62,7 @@
;;; Customization variables
(defcustom org-gnus-prefer-web-links nil
- "If non-nil, `org-store-link' creates web links to Google groups or Gmane.
+ "If non-nil, `org-store-link' creates web links to Google groups.
\\<org-mode-map>When nil, Gnus will be used for such links.
Using a prefix argument to the command `\\[org-store-link]' (`org-store-link')
negates this setting for the duration of the command."
@@ -87,8 +88,8 @@ negates this setting for the duration of the command."
(defun org-gnus-group-link (group)
"Create a link to the Gnus group GROUP.
If GROUP is a newsgroup and `org-gnus-prefer-web-links' is
-non-nil, create a link to groups.google.com or gmane.org.
-Otherwise create a link to the group inside Gnus.
+non-nil, create a link to groups.google.com. Otherwise create a
+link to the group inside Gnus.
If `org-store-link' was called with a prefix arg the meaning of
`org-gnus-prefer-web-links' is reversed."
@@ -96,10 +97,7 @@ If `org-store-link' was called with a prefix arg the meaning of
(if (and (string-prefix-p "nntp" group) ;; Only for nntp groups
(org-xor current-prefix-arg
org-gnus-prefer-web-links))
- (concat (if (string-match "gmane" unprefixed-group)
- "http://news.gmane.org/"
- "http://groups.google.com/group/")
- unprefixed-group)
+ (concat "https://groups.google.com/group/" unprefixed-group)
(concat "gnus:" group))))
(defun org-gnus-article-link (group newsgroups message-id x-no-archive)
@@ -110,7 +108,7 @@ parameters are the Gnus GROUP, the NEWSGROUPS the article was
posted to and the X-NO-ARCHIVE header value of that article.
If GROUP is a newsgroup and `org-gnus-prefer-web-links' is
-non-nil, create a link to groups.google.com or gmane.org.
+non-nil, create a link to groups.google.com.
Otherwise create a link to the article inside Gnus.
If `org-store-link' was called with a prefix arg the meaning of
@@ -118,9 +116,7 @@ If `org-store-link' was called with a prefix arg the meaning of
(if (and (org-xor current-prefix-arg org-gnus-prefer-web-links)
newsgroups ;make web links only for nntp groups
(not x-no-archive)) ;and if X-No-Archive isn't set
- (format (if (string-match-p "gmane\\." newsgroups)
- "http://mid.gmane.org/%s"
- "http://groups.google.com/groups/search?as_umsgid=%s")
+ (format "https://groups.google.com/groups/search?as_umsgid=%s"
(url-encode-url message-id))
(concat "gnus:" group "#" message-id)))
@@ -140,9 +136,15 @@ If `org-store-link' was called with a prefix arg the meaning of
(`(nnvirtual . ,_)
(save-excursion
(car (nnvirtual-map-article (gnus-summary-article-number)))))
- (`(nnselect . ,_)
+ (`(,(or `nnselect `nnir) . ,_) ; nnir is for Emacs < 28.
(save-excursion
- (nnselect-article-group (gnus-summary-article-number))))
+ (cond
+ ((fboundp 'nnselect-article-group)
+ (nnselect-article-group (gnus-summary-article-number)))
+ ((fboundp 'nnir-article-group)
+ (nnir-article-group (gnus-summary-article-number)))
+ (t
+ (error "No article-group variant bound")))))
(_ gnus-newsgroup-name)))
(header (if (eq major-mode 'gnus-article-mode)
;; When in an article, first move to summary
@@ -215,7 +217,7 @@ If `org-store-link' was called with a prefix arg the meaning of
(format "nntp+%s:%s" (or (cdr server) (car server)) group)
article)))
-(defun org-gnus-open (path)
+(defun org-gnus-open (path _)
"Follow the Gnus message or folder link specified by PATH."
(unless (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)
(error "Error in Gnus link %S" path))
diff --git a/lisp/org/ol-info.el b/lisp/org/ol-info.el
index 58d45a7f7ee..8b1e5da5168 100644
--- a/lisp/org/ol-info.el
+++ b/lisp/org/ol-info.el
@@ -1,6 +1,6 @@
;;; ol-info.el --- Links to Info Nodes -*- lexical-binding: t; -*-
-;; Copyright (C) 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -59,7 +59,7 @@
:link link :desc desc)
link)))
-(defun org-info-open (path)
+(defun org-info-open (path _)
"Follow an Info file and node link specified by PATH."
(org-info-follow-link path))
diff --git a/lisp/org/ol-irc.el b/lisp/org/ol-irc.el
index 3a347791eec..e3d7651c1a1 100644
--- a/lisp/org/ol-irc.el
+++ b/lisp/org/ol-irc.el
@@ -1,6 +1,6 @@
;;; ol-irc.el --- Links to IRC Sessions -*- lexical-binding: t; -*-
;;
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;;
;; Author: Philip Jackson <emacs@shellarchive.co.uk>
;; Keywords: erc, irc, link, org
@@ -78,7 +78,7 @@
:store #'org-irc-store-link
:export #'org-irc-export)
-(defun org-irc-visit (link)
+(defun org-irc-visit (link _)
"Parse LINK and dispatch to the correct function based on the client found."
(let ((link (org-irc-parse-link link)))
(cond
diff --git a/lisp/org/ol-mhe.el b/lisp/org/ol-mhe.el
index 099882db1c5..37147a33aca 100644
--- a/lisp/org/ol-mhe.el
+++ b/lisp/org/ol-mhe.el
@@ -1,6 +1,6 @@
;;; ol-mhe.el --- Links to MH-E Messages -*- lexical-binding: t; -*-
-;; Copyright (C) 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;; Author: Thomas Baumann <thomas dot baumann at ch dot tum dot de>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -96,7 +96,7 @@ supported by MH-E."
(org-link-add-props :link link :description desc)
link))))
-(defun org-mhe-open (path)
+(defun org-mhe-open (path _)
"Follow an MH-E message link specified by PATH."
(let (folder article)
(if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
diff --git a/lisp/org/ol-rmail.el b/lisp/org/ol-rmail.el
index cad8eaa169a..a73060b50fa 100644
--- a/lisp/org/ol-rmail.el
+++ b/lisp/org/ol-rmail.el
@@ -1,6 +1,6 @@
;;; ol-rmail.el --- Links to Rmail Messages -*- lexical-binding: t; -*-
-;; Copyright (C) 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -43,7 +43,9 @@
(defvar rmail-file-name) ; From rmail.el
;; Install the link type
-(org-link-set-parameters "rmail" :follow #'org-rmail-open :store #'org-rmail-store-link)
+(org-link-set-parameters "rmail"
+ :follow #'org-rmail-open
+ :store #'org-rmail-store-link)
;; Implementation
(defun org-rmail-store-link ()
@@ -75,7 +77,7 @@
(rmail-show-message rmail-current-message)
link)))))
-(defun org-rmail-open (path)
+(defun org-rmail-open (path _)
"Follow an Rmail message link to the specified PATH."
(let (folder article)
(if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
diff --git a/lisp/org/ol-w3m.el b/lisp/org/ol-w3m.el
index 5b03b8d3cae..f1f3afd764d 100644
--- a/lisp/org/ol-w3m.el
+++ b/lisp/org/ol-w3m.el
@@ -1,6 +1,6 @@
;;; ol-w3m.el --- Copy and Paste From W3M -*- lexical-binding: t; -*-
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Andy Stewart <lazycat dot manatee at gmail dot com>
;; Keywords: outlines, hypermedia, calendar, wp
diff --git a/lisp/org/ol.el b/lisp/org/ol.el
index c9e4da598ff..d1db1683bbe 100644
--- a/lisp/org/ol.el
+++ b/lisp/org/ol.el
@@ -1,6 +1,6 @@
;;; ol.el --- Org links library -*- lexical-binding: t; -*-
-;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2018-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -45,6 +45,7 @@
(declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep))
(declare-function org-at-heading-p "org" (&optional _))
(declare-function org-back-to-heading "org" (&optional invisible-ok))
+(declare-function org-before-first-heading-p "org" ())
(declare-function org-do-occur "org" (regexp &optional cleanup))
(declare-function org-element-at-point "org-element" ())
(declare-function org-element-cache-refresh "org-element" (pos))
@@ -57,16 +58,17 @@
(declare-function org-entry-get "org" (pom property &optional inherit literal-nil))
(declare-function org-find-property "org" (property &optional value))
(declare-function org-get-heading "org" (&optional no-tags no-todo no-priority no-comment))
-(declare-function org-heading-components "org" ())
(declare-function org-id-find-id-file "org-id" (id))
(declare-function org-id-store-link "org-id" ())
(declare-function org-insert-heading "org" (&optional arg invisible-ok top))
(declare-function org-load-modules-maybe "org" (&optional force))
(declare-function org-mark-ring-push "org" (&optional pos buffer))
+(declare-function org-mode "org" ())
(declare-function org-occur "org" (regexp &optional keep-previous callback))
(declare-function org-open-file "org" (path &optional in-emacs line search))
(declare-function org-overview "org" ())
(declare-function org-restart-font-lock "org" ())
+(declare-function org-run-like-in-org-mode "org" (cmd))
(declare-function org-show-context "org" (&optional key))
(declare-function org-src-coderef-format "org-src" (&optional element))
(declare-function org-src-coderef-regexp "org-src" (fmt &optional label))
@@ -85,42 +87,94 @@
:group 'org)
(defcustom org-link-parameters nil
- "An alist of properties that defines all the links in Org mode.
+ "Alist of properties that defines all the links in Org mode.
+
The key in each association is a string of the link type.
-Subsequent optional elements make up a plist of link properties.
+Subsequent optional elements make up a property list for that
+type.
+
+All properties are optional. However, the most important ones
+are, in this order, `:follow', `:export', and `:store', described
+below.
+
+`:follow'
+
+ Function used to follow the link, when the `org-open-at-point'
+ command runs on it. It is called with two arguments: the path,
+ as a string, and a universal prefix argument.
+
+ Here, you may use `org-link-open-as-file' helper function for
+ types similar to \"file\".
+
+`:export'
+
+ Function that accepts four arguments:
+ - the path, as a string,
+ - the description as a string, or nil,
+ - the export back-end,
+ - the export communication channel, as a plist.
+
+ When nil, export for that type of link is delegated to the
+ back-end.
+
+`:store'
+
+ Function responsible for storing the link. See the function
+ `org-store-link-functions' for a description of the expected
+ arguments.
+
+Additional properties provide more specific control over the
+link.
+
+`:activate-func'
+
+ Function to run at the end of Font Lock activation. It must
+ accept four arguments:
+ - the buffer position at the start of the link,
+ - the buffer position at its end,
+ - the path, as a string,
+ - a boolean, non-nil when the link has brackets.
-:follow - A function that takes the link path as an argument.
+`:complete'
-:export - A function that takes the link path, description and
-export-backend as arguments.
+ Function that inserts a link with completion. The function
+ takes one optional prefix argument.
-:store - A function responsible for storing the link. See the
-function `org-store-link-functions'.
+`:display'
-:complete - A function that inserts a link with completion. The
-function takes one optional prefix argument.
+ Value for `invisible' text property on the hidden parts of the
+ link. The most useful value is `full', which will not fold the
+ link in descriptive display. Default is `org-link'.
-:face - A face for the link, or a function that returns a face.
-The function takes one argument which is the link path. The
-default face is `org-link'.
+`:face'
-:mouse-face - The mouse-face. The default is `highlight'.
+ Face for the link, or a function returning a face. The
+ function takes one argument, which is the path.
-:display - `full' will not fold the link in descriptive
-display. Default is `org-link'.
+ The default face is `org-link'.
-:help-echo - A string or function that takes (window object position)
-as arguments and returns a string.
+`:help-echo'
-:keymap - A keymap that is active on the link. The default is
-`org-mouse-map'.
+ String or function used as a value for the `help-echo' text
+ property. The function is called with one argument, the help
+ string to display, and should return a string.
-:htmlize-link - A function for the htmlize-link. Defaults
-to (list :uri \"type:path\")
+`:htmlize-link'
-:activate-func - A function to run at the end of font-lock
-activation. The function must accept (link-start link-end path bracketp)
-as arguments."
+ Function or plist for the `htmlize-link' text property. The
+ function takes no argument.
+
+ Default is (:uri \"type:path\")
+
+`:keymap'
+
+ Active keymap when point is on the link. Default is
+ `org-mouse-map'.
+
+`:mouse-face'
+
+ Face used when hovering over the link. Default is
+ `highlight'."
:group 'org-link
:package-version '(Org . "9.1")
:type '(alist :tag "Link display parameters"
@@ -408,7 +462,7 @@ This is for example useful to limit the length of the subject.
Examples: \"%f on: %.30s\", \"Email from %f\", \"Email %c\""
:group 'org-link-store
- :package-version '(Org . 9.3)
+ :package-version '(Org . "9.3")
:type 'string
:safe #'stringp)
@@ -674,6 +728,44 @@ White spaces are not significant."
(goto-char origin)
(user-error "No match for radio target: %s" target))))
+(defun org-link--context-from-region ()
+ "Return context string from active region, or nil."
+ (when (org-region-active-p)
+ (let ((context (buffer-substring (region-beginning) (region-end))))
+ (when (and (wholenump org-link-context-for-files)
+ (> org-link-context-for-files 0))
+ (let ((lines (org-split-string context "\n")))
+ (setq context
+ (mapconcat #'identity
+ (cl-subseq lines 0 org-link-context-for-files)
+ "\n"))))
+ context)))
+
+(defun org-link--normalize-string (string &optional context)
+ "Remove ignored contents from STRING string and return it.
+This function removes contiguous white spaces and statistics
+cookies. When optional argument CONTEXT is non-nil, it assumes
+STRING is a context string, and also removes special search
+syntax around the string."
+ (let ((string
+ (org-trim
+ (replace-regexp-in-string
+ (rx (one-or-more (any " \t")))
+ " "
+ (replace-regexp-in-string
+ ;; Statistics cookie regexp.
+ (rx (seq "[" (0+ digit) (or "%" (seq "/" (0+ digit))) "]"))
+ " "
+ string)))))
+ (when context
+ (while (cond ((and (string-prefix-p "(" string)
+ (string-suffix-p ")" string))
+ (setq string (org-trim (substring string 1 -1))))
+ ((string-match "\\`[#*]+[ \t]*" string)
+ (setq string (substring string (match-end 0))))
+ (t nil))))
+ string))
+
;;; Public API
@@ -692,6 +784,8 @@ TYPE is a string and KEY is a plist keyword. See
"Set link TYPE properties to PARAMETERS.
PARAMETERS should be keyword value pairs. See
`org-link-parameters' for supported keys."
+ (when (member type '("coderef" "custom-id" "fuzzy" "radio"))
+ (error "Cannot override reserved link type: %S" type))
(let ((data (assoc type org-link-parameters)))
(if data (setcdr data (org-combine-plists (cdr data) parameters))
(push (cons type parameters) org-link-parameters)
@@ -716,12 +810,10 @@ This should be called after the variable `org-link-parameters' has changed."
(rx (seq "[["
;; URI part: match group 1.
(group
- ;; Allow an even number of backslashes right
- ;; before the closing bracket.
- (or (one-or-more "\\\\")
- (and (*? anything)
- (not (any "\\"))
- (zero-or-more "\\\\"))))
+ (one-or-more
+ (or (not (any "[]\\"))
+ (and "\\" (zero-or-more "\\\\") (any "[]"))
+ (and (one-or-more "\\") (not (any "[]"))))))
"]"
;; Description (optional): match group 2.
(opt "[" (group (+? anything)) "]")
@@ -838,37 +930,26 @@ E.g. \"%C3%B6\" becomes the german o-Umlaut."
(defun org-link-escape (link)
"Backslash-escape sensitive characters in string LINK."
- ;; Escape closing square brackets followed by another square bracket
- ;; or at the end of the link. Also escape final backslashes so that
- ;; we do not escape inadvertently URI's closing bracket.
- (with-temp-buffer
- (insert link)
- (insert (make-string (- (skip-chars-backward "\\\\"))
- ?\\))
- (while (search-backward "]" nil t)
- (when (looking-at-p "]\\(?:[][]\\|\\'\\)")
- (insert (make-string (1+ (- (skip-chars-backward "\\\\")))
- ?\\))))
- (buffer-string)))
+ (replace-regexp-in-string
+ (rx (seq (group (zero-or-more "\\")) (group (or string-end (any "[]")))))
+ (lambda (m)
+ (concat (match-string 1 m)
+ (match-string 1 m)
+ (and (/= (match-beginning 2) (match-end 2)) "\\")))
+ link nil t 1))
(defun org-link-unescape (link)
"Remove escaping backslash characters from string LINK."
- (with-temp-buffer
- (save-excursion (insert link))
- (while (re-search-forward "\\(\\\\+\\)\\]\\(?:[][]\\|\\'\\)" nil t)
- (replace-match (make-string (/ (- (match-end 1) (match-beginning 1)) 2)
- ?\\)
- nil t nil 1))
- (goto-char (point-max))
- (delete-char (/ (- (skip-chars-backward "\\\\")) 2))
- (buffer-string)))
+ (replace-regexp-in-string
+ (rx (group (one-or-more "\\")) (or string-end (any "[]")))
+ (lambda (_)
+ (concat (make-string (/ (- (match-end 1) (match-beginning 1)) 2) ?\\)))
+ link nil t 1))
(defun org-link-make-string (link &optional description)
"Make a bracket link, consisting of LINK and DESCRIPTION.
LINK is escaped with backslashes for inclusion in buffer."
- (unless (org-string-nw-p link) (error "Empty link"))
- (let* ((uri (org-link-escape link))
- (zero-width-space (string ?\x200B))
+ (let* ((zero-width-space (string ?\x200B))
(description
(and (org-string-nw-p description)
;; Description cannot contain two consecutive square
@@ -881,9 +962,10 @@ LINK is escaped with backslashes for inclusion in buffer."
(replace-regexp-in-string "]\\'"
(concat "\\&" zero-width-space)
(org-trim description))))))
- (format "[[%s]%s]"
- uri
- (if description (format "[%s]" description) ""))))
+ (if (not (org-string-nw-p link)) description
+ (format "[[%s]%s]"
+ (org-link-escape link)
+ (if description (format "[%s]" description) "")))))
(defun org-store-link-functions ()
"List of functions that are called to create and store a link.
@@ -930,7 +1012,8 @@ Abbreviations are defined in `org-link-abbrev-alist'."
((string-match "%(\\([^)]+\\))" rpl)
(replace-match
(save-match-data
- (funcall (intern-soft (match-string 1 rpl)) tag)) t t rpl))
+ (funcall (intern-soft (match-string 1 rpl)) tag))
+ t t rpl))
((string-match "%s" rpl) (replace-match (or tag "") t t rpl))
((string-match "%h" rpl)
(replace-match (url-hexify-string (or tag "")) t t rpl))
@@ -938,63 +1021,60 @@ Abbreviations are defined in `org-link-abbrev-alist'."
(defun org-link-open (link &optional arg)
"Open a link object LINK.
-Optional argument is passed to `org-open-file' when S is
-a \"file\" link."
+
+ARG is an optional prefix argument. Some link types may handle
+it. For example, it determines what application to run when
+opening a \"file\" link.
+
+Functions responsible for opening the link are either hard-coded
+for internal and \"file\" links, or stored as a parameter in
+`org-link-parameters', which see."
(let ((type (org-element-property :type link))
(path (org-element-property :path link)))
- (cond
- ((equal type "file")
- (if (string-match "[*?{]" (file-name-nondirectory path))
- (dired path)
- ;; Look into `org-link-parameters' in order to find
- ;; a DEDICATED-FUNCTION to open file. The function will be
- ;; applied on raw link instead of parsed link due to the
- ;; limitation in `org-add-link-type' ("open" function called
- ;; with a single argument). If no such function is found,
- ;; fallback to `org-open-file'.
- (let* ((option (org-element-property :search-option link))
- (app (org-element-property :application link))
- (dedicated-function
- (org-link-get-parameter (if app (concat type "+" app) type)
- :follow)))
- (if dedicated-function
- (funcall dedicated-function
- (concat path
- (and option (concat "::" option))))
- (apply #'org-open-file
- path
- (cond (arg)
- ((equal app "emacs") 'emacs)
- ((equal app "sys") 'system))
- (cond ((not option) nil)
- ((string-match-p "\\`[0-9]+\\'" option)
- (list (string-to-number option)))
- (t (list nil option))))))))
- ((functionp (org-link-get-parameter type :follow))
- (funcall (org-link-get-parameter type :follow) path))
- ((member type '("coderef" "custom-id" "fuzzy" "radio"))
- (unless (run-hook-with-args-until-success 'org-open-link-functions path)
- (if (not arg) (org-mark-ring-push)
- (switch-to-buffer-other-window (org-link--buffer-for-internals)))
- (let ((destination
- (org-with-wide-buffer
- (if (equal type "radio")
- (org-link--search-radio-target
- (org-element-property :path link))
- (org-link-search
- (pcase type
- ("custom-id" (concat "#" path))
- ("coderef" (format "(%s)" path))
- (_ path))
- ;; Prevent fuzzy links from matching themselves.
- (and (equal type "fuzzy")
- (+ 2 (org-element-property :begin link)))))
- (point))))
- (unless (and (<= (point-min) destination)
- (>= (point-max) destination))
- (widen))
- (goto-char destination))))
- (t (browse-url-at-point)))))
+ (pcase type
+ ;; Opening a "file" link requires special treatment since we
+ ;; first need to integrate search option, if any.
+ ("file"
+ (let* ((option (org-element-property :search-option link))
+ (path (if option (concat path "::" option) path)))
+ (org-link-open-as-file path
+ (pcase (org-element-property :application link)
+ ((guard arg) arg)
+ ("emacs" 'emacs)
+ ("sys" 'system)))))
+ ;; Internal links.
+ ((or "coderef" "custom-id" "fuzzy" "radio")
+ (unless (run-hook-with-args-until-success 'org-open-link-functions path)
+ (if (not arg) (org-mark-ring-push)
+ (switch-to-buffer-other-window (org-link--buffer-for-internals)))
+ (let ((destination
+ (org-with-wide-buffer
+ (if (equal type "radio")
+ (org-link--search-radio-target path)
+ (org-link-search
+ (pcase type
+ ("custom-id" (concat "#" path))
+ ("coderef" (format "(%s)" path))
+ (_ path))
+ ;; Prevent fuzzy links from matching themselves.
+ (and (equal type "fuzzy")
+ (+ 2 (org-element-property :begin link)))))
+ (point))))
+ (unless (and (<= (point-min) destination)
+ (>= (point-max) destination))
+ (widen))
+ (goto-char destination))))
+ (_
+ ;; Look for a dedicated "follow" function in custom links.
+ (let ((f (org-link-get-parameter type :follow)))
+ (when (functionp f)
+ ;; Function defined in `:follow' parameter may use a single
+ ;; argument, as it was mandatory before Org 9.4. This is
+ ;; deprecated, but support it for now.
+ (condition-case nil
+ (funcall (org-link-get-parameter type :follow) path arg)
+ (wrong-number-of-arguments
+ (funcall (org-link-get-parameter type :follow) path)))))))))
(defun org-link-open-from-string (s &optional arg)
"Open a link in the string S, as if it was in Org mode.
@@ -1095,10 +1175,9 @@ of matched result, which is either `dedicated' or `fuzzy'."
(catch :name-match
(goto-char (point-min))
(while (re-search-forward name nil t)
- (let ((element (org-element-at-point)))
- (when (equal words
- (split-string
- (org-element-property :name element)))
+ (let* ((element (org-element-at-point))
+ (name (org-element-property :name element)))
+ (when (and name (equal words (split-string name)))
(setq type 'dedicated)
(beginning-of-line)
(throw :name-match t))))
@@ -1111,18 +1190,14 @@ of matched result, which is either `dedicated' or `fuzzy'."
(format "%s.*\\(?:%s[ \t]\\)?.*%s"
org-outline-regexp-bol
org-comment-string
- (mapconcat #'regexp-quote words ".+")))
- (cookie-re "\\[[0-9]*\\(?:%\\|/[0-9]*\\)\\]")
- (comment-re (format "\\`%s[ \t]+" org-comment-string)))
+ (mapconcat #'regexp-quote words ".+"))))
(goto-char (point-min))
(catch :found
(while (re-search-forward title-re nil t)
(when (equal words
(split-string
- (replace-regexp-in-string
- cookie-re ""
- (replace-regexp-in-string
- comment-re "" (org-get-heading t t t)))))
+ (org-link--normalize-string
+ (org-get-heading t t t t))))
(throw :found t)))
nil)))
(beginning-of-line)
@@ -1173,24 +1248,40 @@ of matched result, which is either `dedicated' or `fuzzy'."
type))
(defun org-link-heading-search-string (&optional string)
- "Make search string for the current headline or STRING."
- (let ((s (or string
- (and (derived-mode-p 'org-mode)
- (save-excursion
- (org-back-to-heading t)
- (org-element-property :raw-value
- (org-element-at-point))))))
- (lines org-link-context-for-files))
- (unless string (setq s (concat "*" s))) ;Add * for headlines
- (setq s (replace-regexp-in-string "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" s))
- (when (and string (integerp lines) (> lines 0))
- (let ((slines (org-split-string s "\n")))
- (when (< lines (length slines))
- (setq s (mapconcat
- #'identity
- (reverse (nthcdr (- (length slines) lines)
- (reverse slines))) "\n")))))
- (mapconcat #'identity (split-string s) " ")))
+ "Make search string for the current headline or STRING.
+
+Search string starts with an asterisk. COMMENT keyword and
+statistics cookies are removed, and contiguous spaces are packed
+into a single one.
+
+When optional argument STRING is non-nil, assume it a headline,
+without any asterisk, TODO or COMMENT keyword, and without any
+priority cookie or tag."
+ (concat "*"
+ (org-link--normalize-string
+ (or string (org-get-heading t t t t)))))
+
+(defun org-link-open-as-file (path arg)
+ "Pretend PATH is a file name and open it.
+
+According to \"file\"-link syntax, PATH may include additional
+search options, separated from the file name with \"::\".
+
+This function is meant to be used as a possible tool for
+`:follow' property in `org-link-parameters'."
+ (let* ((option (and (string-match "::\\(.*\\)\\'" path)
+ (match-string 1 path)))
+ (file-name (if (not option) path
+ (substring path 0 (match-beginning 0)))))
+ (if (string-match "[*?{]" (file-name-nondirectory file-name))
+ (dired file-name)
+ (apply #'org-open-file
+ file-name
+ arg
+ (cond ((not option) nil)
+ ((string-match-p "\\`[0-9]+\\'" option)
+ (list (string-to-number option)))
+ (t (list nil option)))))))
(defun org-link-display-format (s)
"Replace links in string S with their description.
@@ -1211,15 +1302,15 @@ If there is no description, use the link target."
;;; Built-in link types
;;;; "doi" link type
-(defun org-link--open-doi (path)
+(defun org-link--open-doi (path arg)
"Open a \"doi\" type link.
PATH is a the path to search for, as a string."
- (browse-url (url-encode-url (concat org-link-doi-server-url path))))
+ (browse-url (url-encode-url (concat org-link-doi-server-url path)) arg))
(org-link-set-parameters "doi" :follow #'org-link--open-doi)
;;;; "elisp" link type
-(defun org-link--open-elisp (path)
+(defun org-link--open-elisp (path _)
"Open a \"elisp\" type link.
PATH is the sexp to evaluate, as a string."
(if (or (and (org-string-nw-p org-link-elisp-skip-confirm-regexp)
@@ -1240,7 +1331,7 @@ PATH is the sexp to evaluate, as a string."
(org-link-set-parameters "file" :complete #'org-link-complete-file)
;;;; "help" link type
-(defun org-link--open-help (path)
+(defun org-link--open-help (path _)
"Open a \"help\" type link.
PATH is a symbol name, as a string."
(pcase (intern path)
@@ -1254,10 +1345,11 @@ PATH is a symbol name, as a string."
(dolist (scheme '("ftp" "http" "https" "mailto" "news"))
(org-link-set-parameters scheme
:follow
- (lambda (url) (browse-url (concat scheme ":" url)))))
+ (lambda (url arg)
+ (browse-url (concat scheme ":" url) arg))))
;;;; "shell" link type
-(defun org-link--open-shell (path)
+(defun org-link--open-shell (path _)
"Open a \"shell\" type link.
PATH is the command to execute, as a string."
(if (or (and (org-string-nw-p org-link-shell-skip-confirm-regexp)
@@ -1375,7 +1467,7 @@ non-nil."
(move-beginning-of-line 2)
(set-mark (point)))))
(setq org-store-link-plist nil)
- (let (link cpltxt desc description search txt custom-id agenda-link)
+ (let (link cpltxt desc description search custom-id agenda-link)
(cond
;; Store a link using an external link type, if any function is
;; available. If more than one can generate a link from current
@@ -1465,10 +1557,16 @@ non-nil."
(org-link-store-props :type "calendar" :date cd)))
((eq major-mode 'help-mode)
- (setq link (concat "help:" (save-excursion
- (goto-char (point-min))
- (looking-at "^[^ ]+")
- (match-string 0))))
+ (let ((symbol (replace-regexp-in-string
+ ;; Help mode escapes backquotes and backslashes
+ ;; before displaying them. E.g., "`" appears
+ ;; as "\'" for reasons. Work around this.
+ (rx "\\" (group (or "`" "\\"))) "\\1"
+ (save-excursion
+ (goto-char (point-min))
+ (looking-at "^[^ ]+")
+ (match-string 0)))))
+ (setq link (concat "help:" symbol)))
(org-link-store-props :type "help"))
((eq major-mode 'w3-mode)
@@ -1534,30 +1632,35 @@ non-nil."
(abbreviate-file-name
(buffer-file-name (buffer-base-buffer))))))))
(t
- ;; Just link to current headline
+ ;; Just link to current headline.
(setq cpltxt (concat "file:"
(abbreviate-file-name
(buffer-file-name (buffer-base-buffer)))))
- ;; Add a context search string
+ ;; Add a context search string.
(when (org-xor org-link-context-for-files (equal arg '(4)))
(let* ((element (org-element-at-point))
- (name (org-element-property :name element)))
- (setq txt (cond
- ((org-at-heading-p) nil)
- (name)
- ((org-region-active-p)
- (buffer-substring (region-beginning) (region-end)))))
- (when (or (null txt) (string-match "\\S-" txt))
- (setq cpltxt
- (concat cpltxt "::"
- (condition-case nil
- (org-link-heading-search-string txt)
- (error "")))
- desc (or name
- (nth 4 (ignore-errors (org-heading-components)))
- "NONE")))))
- (when (string-match "::\\'" cpltxt)
- (setq cpltxt (substring cpltxt 0 -2)))
+ (name (org-element-property :name element))
+ (context
+ (cond
+ ((let ((region (org-link--context-from-region)))
+ (and region (org-link--normalize-string region t))))
+ (name)
+ ((org-before-first-heading-p)
+ (org-link--normalize-string (org-current-line-string) t))
+ (t (org-link-heading-search-string)))))
+ (when (org-string-nw-p context)
+ (setq cpltxt (format "%s::%s" cpltxt context))
+ (setq desc
+ (or name
+ ;; Although description is not a search
+ ;; string, use `org-link--normalize-string'
+ ;; to prettify it (contiguous white spaces)
+ ;; and remove volatile contents (statistics
+ ;; cookies).
+ (and (not (org-before-first-heading-p))
+ (org-link--normalize-string
+ (org-get-heading t t t t)))
+ "NONE")))))
(setq link cpltxt)))))
((buffer-file-name (buffer-base-buffer))
@@ -1565,16 +1668,16 @@ non-nil."
(setq cpltxt (concat "file:"
(abbreviate-file-name
(buffer-file-name (buffer-base-buffer)))))
- ;; Add a context string.
+ ;; Add a context search string.
(when (org-xor org-link-context-for-files (equal arg '(4)))
- (setq txt (if (org-region-active-p)
- (buffer-substring (region-beginning) (region-end))
- (buffer-substring (point-at-bol) (point-at-eol))))
- ;; Only use search option if there is some text.
- (when (string-match "\\S-" txt)
- (setq cpltxt
- (concat cpltxt "::" (org-link-heading-search-string txt))
- desc "NONE")))
+ (let ((context (org-link--normalize-string
+ (or (org-link--context-from-region)
+ (org-current-line-string))
+ t)))
+ ;; Only use search option if there is some text.
+ (when (org-string-nw-p context)
+ (setq cpltxt (format "%s::%s" cpltxt context))
+ (setq desc "NONE"))))
(setq link cpltxt))
(interactive?
@@ -1589,15 +1692,19 @@ non-nil."
(cond ((not desc))
((equal desc "NONE") (setq desc nil))
(t (setq desc (org-link-display-format desc))))
- ;; Return the link
+ ;; Store and return the link
(if (not (and interactive? link))
(or agenda-link (and link (org-link-make-string link desc)))
- (push (list link desc) org-stored-links)
- (message "Stored: %s" (or desc link))
- (when custom-id
- (setq link (concat "file:" (abbreviate-file-name
- (buffer-file-name)) "::#" custom-id))
- (push (list link desc) org-stored-links))
+ (if (member (list link desc) org-stored-links)
+ (message "This link already exists")
+ (push (list link desc) org-stored-links)
+ (message "Stored: %s" (or desc link))
+ (when custom-id
+ (setq link (concat "file:"
+ (abbreviate-file-name
+ (buffer-file-name (buffer-base-buffer)))
+ "::#" custom-id))
+ (push (list link desc) org-stored-links)))
(car org-stored-links)))))
;;;###autoload
@@ -1737,13 +1844,14 @@ Use TAB to complete link prefixes, then RET for type-specific completion support
;; Check if we are linking to the current file with a search
;; option If yes, simplify the link by using only the search
;; option.
- (when (and buffer-file-name
+ (when (and (buffer-file-name (buffer-base-buffer))
(let ((case-fold-search nil))
(string-match "\\`file:\\(.+?\\)::" link)))
(let ((path (match-string-no-properties 1 link))
(search (substring-no-properties link (match-end 0))))
(save-match-data
- (when (equal (file-truename buffer-file-name) (file-truename path))
+ (when (equal (file-truename (buffer-file-name (buffer-base-buffer)))
+ (file-truename path))
;; We are linking to this same file, with a search option
(setq link search)))))
@@ -1903,7 +2011,10 @@ Also refresh fontification if needed."
(org-link-make-regexps)
-
(provide 'ol)
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
;;; ol.el ends here
diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el
index 689d134627e..99e5464c2b9 100644
--- a/lisp/org/org-agenda.el
+++ b/lisp/org/org-agenda.el
@@ -1,6 +1,6 @@
;;; org-agenda.el --- Dynamic task and appointment lists for Org
-;; Copyright (C) 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -49,6 +49,7 @@
(require 'ol)
(require 'org)
(require 'org-macs)
+(require 'org-refile)
(declare-function diary-add-to-list "diary-lib"
(date string specifier &optional marker globcolor literal))
@@ -83,6 +84,7 @@
(declare-function org-agenda-columns "org-colview" ())
(declare-function org-add-archive-files "org-archive" (files))
(declare-function org-capture "org-capture" (&optional goto keys))
+(declare-function org-clock-modify-effort-estimate "org-clock" (&optional value))
(defvar calendar-mode-map)
(defvar org-clock-current-task)
@@ -185,7 +187,7 @@ and `org-agenda-entry-text-maxlines'."
"Non-nil means export org-links as descriptive links in agenda added text.
This variable applies to the text added to the agenda when
`org-agenda-add-entry-text-maxlines' is larger than 0.
-When this variable nil, the URL will (also) be shown."
+When this variable is nil, the URL will (also) be shown."
:group 'org-agenda
:type 'boolean)
@@ -1012,6 +1014,12 @@ headlines as the agenda display heavily relies on them."
:group 'org-agenda-startup
:type 'hook)
+(defcustom org-agenda-filter-hook nil
+ "Hook run just after filtering with `org-agenda-filter'."
+ :group 'org-agenda-startup
+ :package-version '(Org . "9.4")
+ :type 'hook)
+
(defcustom org-agenda-mouse-1-follows-link nil
"Non-nil means mouse-1 on a link will follow the link in the agenda.
A longer mouse click will still set point. Needs to be set
@@ -1092,14 +1100,21 @@ reorganize-frame Show only two windows on the current frame, the current
window and the agenda.
other-frame Use `switch-to-buffer-other-frame' to display agenda.
Also, when exiting the agenda, kill that frame.
+other-tab Use `switch-to-buffer-other-tab' to display the
+ agenda, making use of the `tab-bar-mode' introduced
+ in Emacs version 27.1. Also, kill that tab when
+ exiting the agenda view.
+
See also the variable `org-agenda-restore-windows-after-quit'."
:group 'org-agenda-windows
:type '(choice
(const current-window)
(const other-frame)
+ (const other-tab)
(const other-window)
(const only-window)
- (const reorganize-frame)))
+ (const reorganize-frame))
+ :package-version '(Org . "9.4"))
(defcustom org-agenda-window-frame-fractions '(0.5 . 0.75)
"The min and max height of the agenda window as a fraction of frame height.
@@ -1110,11 +1125,11 @@ It only matters if `org-agenda-window-setup' is `reorganize-frame'."
(defcustom org-agenda-restore-windows-after-quit nil
"Non-nil means restore window configuration upon exiting agenda.
-Before the window configuration is changed for displaying the agenda,
-the current status is recorded. When the agenda is exited with
-`q' or `x' and this option is set, the old state is restored. If
-`org-agenda-window-setup' is `other-frame', the value of this
-option will be ignored."
+Before the window configuration is changed for displaying the
+agenda, the current status is recorded. When the agenda is
+exited with `q' or `x' and this option is set, the old state is
+restored. If `org-agenda-window-setup' is `other-frame' or
+`other-tab', the value of this option will be ignored."
:group 'org-agenda-windows
:type 'boolean)
@@ -1156,6 +1171,11 @@ argument, a calendar-style date list like (month day year)."
(string :tag "Format string")
(function :tag "Function")))
+(defun org-agenda-end-of-line ()
+ "Go to the end of visible line."
+ (interactive)
+ (goto-char (line-end-position)))
+
(defun org-agenda-format-date-aligned (date)
"Format a DATE string for display in the daily/weekly agenda.
This function makes sure that dates are aligned for easy reading."
@@ -1238,6 +1258,16 @@ in the past."
:version "24.1"
:type 'boolean)
+(defcustom org-agenda-diary-file 'diary-file
+ "File to which to add new entries with the `i' key in agenda and calendar.
+When this is the symbol `diary-file', the functionality in the Emacs
+calendar will be used to add entries to the `diary-file'. But when this
+points to a file, `org-agenda-diary-entry' will be used instead."
+ :group 'org-agenda
+ :type '(choice
+ (const :tag "The standard Emacs diary file" diary-file)
+ (file :tag "Special Org file diary entries")))
+
(defcustom org-agenda-include-diary nil
"If non-nil, include in the agenda entries from the Emacs Calendar's diary.
Custom commands can set this variable in the options section."
@@ -1619,7 +1649,7 @@ part of an agenda sorting strategy."
:group 'org-agenda-sorting
:type 'symbol)
-(defcustom org-sort-agenda-notime-is-late t
+(defcustom org-agenda-sort-notime-is-late t
"Non-nil means items without time are considered late.
This is only relevant for sorting. When t, items which have no explicit
time like 15:30 will be considered as 99:01, i.e. later than any items which
@@ -1629,7 +1659,7 @@ agenda entries."
:group 'org-agenda-sorting
:type 'boolean)
-(defcustom org-sort-agenda-noeffort-is-high t
+(defcustom org-agenda-sort-noeffort-is-high t
"Non-nil means items without effort estimate are sorted as high effort.
This also applies when filtering an agenda view with respect to the
< or > effort operator. Then, tasks with no effort defined will be treated
@@ -1923,8 +1953,8 @@ However, settings in `org-priority-faces' will overrule these faces.
When this variable is the symbol `cookies', only fontify the
cookies, not the entire task.
This may also be an association list of priority faces, whose
-keys are the character values of `org-highest-priority',
-`org-default-priority', and `org-lowest-priority' (the default values
+keys are the character values of `org-priority-highest',
+`org-priority-default', and `org-priority-lowest' (the default values
are ?A, ?B, and ?C, respectively). The face may be a named face, a
color as a string, or a list like `(:background \"Red\")'.
If it is a color, the variable `org-faces-easy-properties'
@@ -1985,7 +2015,7 @@ category, you can use:
(string :tag "File or data")
(symbol :tag "Type")
(boolean :tag "Data?")
- (repeat :tag "Extra image properties" :inline t symbol))
+ (repeat :tag "Extra image properties" :inline t sexp))
(list :tag "Display properties" sexp))))
(defgroup org-agenda-column-view nil
@@ -2101,6 +2131,8 @@ evaluate to a string."
(defvar org-agenda-mode-map (make-sparse-keymap)
"Keymap for `org-agenda-mode'.")
+(org-remap org-agenda-mode-map 'move-end-of-line 'org-agenda-end-of-line)
+
(defvar org-agenda-menu) ; defined later in this file.
(defvar org-agenda-restrict nil) ; defined later in this file.
(defvar org-agenda-follow-mode nil)
@@ -2197,6 +2229,7 @@ The following commands are available:
\\{org-agenda-mode-map}"
(interactive)
+ (ignore-errors (require 'face-remap))
(let ((agenda-local-vars-to-keep
'(text-scale-mode-amount
text-scale-mode
@@ -2209,8 +2242,8 @@ The following commands are available:
(dolist (elem save)
(pcase elem
(`(,var . ,val) ;ignore unbound variables
- (when (and val (memq var var-set))
- (set var val)))))))
+ (when (and val (memq var var-set))
+ (set var val)))))))
(cond (org-agenda-doing-sticky-redo
;; Refreshing sticky agenda-buffer
;;
@@ -2236,7 +2269,6 @@ The following commands are available:
(setq mode-name "Org-Agenda")
(setq indent-tabs-mode nil)
(use-local-map org-agenda-mode-map)
- (easy-menu-add org-agenda-menu)
(when org-startup-truncated (setq truncate-lines t))
(setq-local line-move-visual nil)
(add-hook 'post-command-hook 'org-agenda-update-agenda-type nil 'local)
@@ -2274,155 +2306,152 @@ The following commands are available:
(if (fboundp 'run-mode-hooks) 'run-mode-hooks 'run-hooks)
(list 'org-agenda-mode-hook)))
-(substitute-key-definition 'undo 'org-agenda-undo
+(substitute-key-definition #'undo #'org-agenda-undo
org-agenda-mode-map global-map)
-(org-defkey org-agenda-mode-map "\C-i" 'org-agenda-goto)
-(org-defkey org-agenda-mode-map [(tab)] 'org-agenda-goto)
-(org-defkey org-agenda-mode-map "\C-m" 'org-agenda-switch-to)
-(org-defkey org-agenda-mode-map "\C-k" 'org-agenda-kill)
-(org-defkey org-agenda-mode-map "\C-c\C-w" 'org-agenda-refile)
-(org-defkey org-agenda-mode-map [(meta down)] 'org-agenda-drag-line-forward)
-(org-defkey org-agenda-mode-map [(meta up)] 'org-agenda-drag-line-backward)
-(org-defkey org-agenda-mode-map "m" 'org-agenda-bulk-mark)
-(org-defkey org-agenda-mode-map "\M-m" 'org-agenda-bulk-toggle)
-(org-defkey org-agenda-mode-map "*" 'org-agenda-bulk-mark-all)
-(org-defkey org-agenda-mode-map "\M-*" 'org-agenda-bulk-toggle-all)
-(org-defkey org-agenda-mode-map "#" 'org-agenda-dim-blocked-tasks)
-(org-defkey org-agenda-mode-map "%" 'org-agenda-bulk-mark-regexp)
-(org-defkey org-agenda-mode-map "u" 'org-agenda-bulk-unmark)
-(org-defkey org-agenda-mode-map "U" 'org-agenda-bulk-unmark-all)
-(org-defkey org-agenda-mode-map "B" 'org-agenda-bulk-action)
-(org-defkey org-agenda-mode-map "k" 'org-agenda-capture)
-(org-defkey org-agenda-mode-map "A" 'org-agenda-append-agenda)
-(org-defkey org-agenda-mode-map "\C-c\C-x!" 'org-reload)
-(org-defkey org-agenda-mode-map "\C-c\C-x\C-a" 'org-agenda-archive-default)
-(org-defkey org-agenda-mode-map "\C-c\C-xa" 'org-agenda-toggle-archive-tag)
-(org-defkey org-agenda-mode-map "\C-c\C-xA" 'org-agenda-archive-to-archive-sibling)
-(org-defkey org-agenda-mode-map "\C-c\C-x\C-s" 'org-agenda-archive)
-(org-defkey org-agenda-mode-map "\C-c$" 'org-agenda-archive)
-(org-defkey org-agenda-mode-map "$" 'org-agenda-archive)
-(org-defkey org-agenda-mode-map "\C-c\C-o" 'org-agenda-open-link)
-(org-defkey org-agenda-mode-map " " 'org-agenda-show-and-scroll-up)
-(org-defkey org-agenda-mode-map [backspace] 'org-agenda-show-scroll-down)
-(org-defkey org-agenda-mode-map "\d" 'org-agenda-show-scroll-down)
-(org-defkey org-agenda-mode-map [(control shift right)] 'org-agenda-todo-nextset)
-(org-defkey org-agenda-mode-map [(control shift left)] 'org-agenda-todo-previousset)
-(org-defkey org-agenda-mode-map "\C-c\C-xb" 'org-agenda-tree-to-indirect-buffer)
-(org-defkey org-agenda-mode-map "o" 'delete-other-windows)
-(org-defkey org-agenda-mode-map "L" 'org-agenda-recenter)
-(org-defkey org-agenda-mode-map "\C-c\C-t" 'org-agenda-todo)
-(org-defkey org-agenda-mode-map "t" 'org-agenda-todo)
-(org-defkey org-agenda-mode-map "a" 'org-agenda-archive-default-with-confirmation)
-(org-defkey org-agenda-mode-map ":" 'org-agenda-set-tags)
-(org-defkey org-agenda-mode-map "\C-c\C-q" 'org-agenda-set-tags)
-(org-defkey org-agenda-mode-map "." 'org-agenda-goto-today)
-(org-defkey org-agenda-mode-map "j" 'org-agenda-goto-date)
-(org-defkey org-agenda-mode-map "d" 'org-agenda-day-view)
-(org-defkey org-agenda-mode-map "w" 'org-agenda-week-view)
-(org-defkey org-agenda-mode-map "y" 'org-agenda-year-view)
-(org-defkey org-agenda-mode-map "\C-c\C-z" 'org-agenda-add-note)
-(org-defkey org-agenda-mode-map "z" 'org-agenda-add-note)
-(org-defkey org-agenda-mode-map [(shift right)] 'org-agenda-do-date-later)
-(org-defkey org-agenda-mode-map [(shift left)] 'org-agenda-do-date-earlier)
-(org-defkey org-agenda-mode-map [?\C-c ?\C-x (right)] 'org-agenda-do-date-later)
-(org-defkey org-agenda-mode-map [?\C-c ?\C-x (left)] 'org-agenda-do-date-earlier)
-
-(org-defkey org-agenda-mode-map ">" 'org-agenda-date-prompt)
-(org-defkey org-agenda-mode-map "\C-c\C-s" 'org-agenda-schedule)
-(org-defkey org-agenda-mode-map "\C-c\C-d" 'org-agenda-deadline)
+(org-defkey org-agenda-mode-map "\C-i" #'org-agenda-goto)
+(org-defkey org-agenda-mode-map [(tab)] #'org-agenda-goto)
+(org-defkey org-agenda-mode-map "\C-m" #'org-agenda-switch-to)
+(org-defkey org-agenda-mode-map "\C-k" #'org-agenda-kill)
+(org-defkey org-agenda-mode-map "\C-c\C-w" #'org-agenda-refile)
+(org-defkey org-agenda-mode-map [(meta down)] #'org-agenda-drag-line-forward)
+(org-defkey org-agenda-mode-map [(meta up)] #'org-agenda-drag-line-backward)
+(org-defkey org-agenda-mode-map "m" #'org-agenda-bulk-mark)
+(org-defkey org-agenda-mode-map "\M-m" #'org-agenda-bulk-toggle)
+(org-defkey org-agenda-mode-map "*" #'org-agenda-bulk-mark-all)
+(org-defkey org-agenda-mode-map "\M-*" #'org-agenda-bulk-toggle-all)
+(org-defkey org-agenda-mode-map "#" #'org-agenda-dim-blocked-tasks)
+(org-defkey org-agenda-mode-map "%" #'org-agenda-bulk-mark-regexp)
+(org-defkey org-agenda-mode-map "u" #'org-agenda-bulk-unmark)
+(org-defkey org-agenda-mode-map "U" #'org-agenda-bulk-unmark-all)
+(org-defkey org-agenda-mode-map "B" #'org-agenda-bulk-action)
+(org-defkey org-agenda-mode-map "k" #'org-agenda-capture)
+(org-defkey org-agenda-mode-map "A" #'org-agenda-append-agenda)
+(org-defkey org-agenda-mode-map "\C-c\C-x!" #'org-reload)
+(org-defkey org-agenda-mode-map "\C-c\C-x\C-a" #'org-agenda-archive-default)
+(org-defkey org-agenda-mode-map "\C-c\C-xa" #'org-agenda-toggle-archive-tag)
+(org-defkey org-agenda-mode-map "\C-c\C-xA" #'org-agenda-archive-to-archive-sibling)
+(org-defkey org-agenda-mode-map "\C-c\C-x\C-s" #'org-agenda-archive)
+(org-defkey org-agenda-mode-map "\C-c$" #'org-agenda-archive)
+(org-defkey org-agenda-mode-map "$" #'org-agenda-archive)
+(org-defkey org-agenda-mode-map "\C-c\C-o" #'org-agenda-open-link)
+(org-defkey org-agenda-mode-map " " #'org-agenda-show-and-scroll-up)
+(org-defkey org-agenda-mode-map [backspace] #'org-agenda-show-scroll-down)
+(org-defkey org-agenda-mode-map "\d" #'org-agenda-show-scroll-down)
+(org-defkey org-agenda-mode-map [(control shift right)] #'org-agenda-todo-nextset)
+(org-defkey org-agenda-mode-map [(control shift left)] #'org-agenda-todo-previousset)
+(org-defkey org-agenda-mode-map "\C-c\C-xb" #'org-agenda-tree-to-indirect-buffer)
+(org-defkey org-agenda-mode-map "o" #'delete-other-windows)
+(org-defkey org-agenda-mode-map "L" #'org-agenda-recenter)
+(org-defkey org-agenda-mode-map "\C-c\C-t" #'org-agenda-todo)
+(org-defkey org-agenda-mode-map "t" #'org-agenda-todo)
+(org-defkey org-agenda-mode-map "a" #'org-agenda-archive-default-with-confirmation)
+(org-defkey org-agenda-mode-map ":" #'org-agenda-set-tags)
+(org-defkey org-agenda-mode-map "\C-c\C-q" #'org-agenda-set-tags)
+(org-defkey org-agenda-mode-map "." #'org-agenda-goto-today)
+(org-defkey org-agenda-mode-map "j" #'org-agenda-goto-date)
+(org-defkey org-agenda-mode-map "d" #'org-agenda-day-view)
+(org-defkey org-agenda-mode-map "w" #'org-agenda-week-view)
+(org-defkey org-agenda-mode-map "y" #'org-agenda-year-view)
+(org-defkey org-agenda-mode-map "\C-c\C-z" #'org-agenda-add-note)
+(org-defkey org-agenda-mode-map "z" #'org-agenda-add-note)
+(org-defkey org-agenda-mode-map [(shift right)] #'org-agenda-do-date-later)
+(org-defkey org-agenda-mode-map [(shift left)] #'org-agenda-do-date-earlier)
+(org-defkey org-agenda-mode-map [?\C-c ?\C-x (right)] #'org-agenda-do-date-later)
+(org-defkey org-agenda-mode-map [?\C-c ?\C-x (left)] #'org-agenda-do-date-earlier)
+(org-defkey org-agenda-mode-map ">" #'org-agenda-date-prompt)
+(org-defkey org-agenda-mode-map "\C-c\C-s" #'org-agenda-schedule)
+(org-defkey org-agenda-mode-map "\C-c\C-d" #'org-agenda-deadline)
(let ((l '(1 2 3 4 5 6 7 8 9 0)))
(while l (org-defkey org-agenda-mode-map
- (int-to-string (pop l)) 'digit-argument)))
-
-(org-defkey org-agenda-mode-map "F" 'org-agenda-follow-mode)
-(org-defkey org-agenda-mode-map "R" 'org-agenda-clockreport-mode)
-(org-defkey org-agenda-mode-map "E" 'org-agenda-entry-text-mode)
-(org-defkey org-agenda-mode-map "l" 'org-agenda-log-mode)
-(org-defkey org-agenda-mode-map "v" 'org-agenda-view-mode-dispatch)
-(org-defkey org-agenda-mode-map "D" 'org-agenda-toggle-diary)
-(org-defkey org-agenda-mode-map "!" 'org-agenda-toggle-deadlines)
-(org-defkey org-agenda-mode-map "G" 'org-agenda-toggle-time-grid)
-(org-defkey org-agenda-mode-map "r" 'org-agenda-redo)
-(org-defkey org-agenda-mode-map "g" 'org-agenda-redo-all)
-(org-defkey org-agenda-mode-map "e" 'org-agenda-set-effort)
-(org-defkey org-agenda-mode-map "\C-c\C-xe" 'org-agenda-set-effort)
+ (number-to-string (pop l)) #'digit-argument)))
+(org-defkey org-agenda-mode-map "F" #'org-agenda-follow-mode)
+(org-defkey org-agenda-mode-map "R" #'org-agenda-clockreport-mode)
+(org-defkey org-agenda-mode-map "E" #'org-agenda-entry-text-mode)
+(org-defkey org-agenda-mode-map "l" #'org-agenda-log-mode)
+(org-defkey org-agenda-mode-map "v" #'org-agenda-view-mode-dispatch)
+(org-defkey org-agenda-mode-map "D" #'org-agenda-toggle-diary)
+(org-defkey org-agenda-mode-map "!" #'org-agenda-toggle-deadlines)
+(org-defkey org-agenda-mode-map "G" #'org-agenda-toggle-time-grid)
+(org-defkey org-agenda-mode-map "r" #'org-agenda-redo)
+(org-defkey org-agenda-mode-map "g" #'org-agenda-redo-all)
+(org-defkey org-agenda-mode-map "e" #'org-agenda-set-effort)
+(org-defkey org-agenda-mode-map "\C-c\C-xe" #'org-agenda-set-effort)
(org-defkey org-agenda-mode-map "\C-c\C-x\C-e"
- 'org-clock-modify-effort-estimate)
-(org-defkey org-agenda-mode-map "\C-c\C-xp" 'org-agenda-set-property)
-(org-defkey org-agenda-mode-map "q" 'org-agenda-quit)
-(org-defkey org-agenda-mode-map "Q" 'org-agenda-Quit)
-(org-defkey org-agenda-mode-map "x" 'org-agenda-exit)
-(org-defkey org-agenda-mode-map "\C-x\C-w" 'org-agenda-write)
-(org-defkey org-agenda-mode-map "\C-x\C-s" 'org-save-all-org-buffers)
-(org-defkey org-agenda-mode-map "s" 'org-save-all-org-buffers)
-(org-defkey org-agenda-mode-map "T" 'org-agenda-show-tags)
-(org-defkey org-agenda-mode-map "n" 'org-agenda-next-line)
-(org-defkey org-agenda-mode-map "p" 'org-agenda-previous-line)
-(org-defkey org-agenda-mode-map "N" 'org-agenda-next-item)
-(org-defkey org-agenda-mode-map "P" 'org-agenda-previous-item)
-(substitute-key-definition 'next-line 'org-agenda-next-line
+ #'org-clock-modify-effort-estimate)
+(org-defkey org-agenda-mode-map "\C-c\C-xp" #'org-agenda-set-property)
+(org-defkey org-agenda-mode-map "q" #'org-agenda-quit)
+(org-defkey org-agenda-mode-map "Q" #'org-agenda-Quit)
+(org-defkey org-agenda-mode-map "x" #'org-agenda-exit)
+(org-defkey org-agenda-mode-map "\C-x\C-w" #'org-agenda-write)
+(org-defkey org-agenda-mode-map "\C-x\C-s" #'org-save-all-org-buffers)
+(org-defkey org-agenda-mode-map "s" #'org-save-all-org-buffers)
+(org-defkey org-agenda-mode-map "T" #'org-agenda-show-tags)
+(org-defkey org-agenda-mode-map "n" #'org-agenda-next-line)
+(org-defkey org-agenda-mode-map "p" #'org-agenda-previous-line)
+(org-defkey org-agenda-mode-map "N" #'org-agenda-next-item)
+(org-defkey org-agenda-mode-map "P" #'org-agenda-previous-item)
+(substitute-key-definition #'next-line #'org-agenda-next-line
org-agenda-mode-map global-map)
-(substitute-key-definition 'previous-line 'org-agenda-previous-line
+(substitute-key-definition #'previous-line #'org-agenda-previous-line
org-agenda-mode-map global-map)
-(org-defkey org-agenda-mode-map "\C-c\C-a" 'org-attach)
-(org-defkey org-agenda-mode-map "\C-c\C-n" 'org-agenda-next-date-line)
-(org-defkey org-agenda-mode-map "\C-c\C-p" 'org-agenda-previous-date-line)
-(org-defkey org-agenda-mode-map "\C-c," 'org-agenda-priority)
-(org-defkey org-agenda-mode-map "," 'org-agenda-priority)
-(org-defkey org-agenda-mode-map "i" 'org-agenda-diary-entry)
-(org-defkey org-agenda-mode-map "c" 'org-agenda-goto-calendar)
-(org-defkey org-agenda-mode-map "C" 'org-agenda-convert-date)
-(org-defkey org-agenda-mode-map "M" 'org-agenda-phases-of-moon)
-(org-defkey org-agenda-mode-map "S" 'org-agenda-sunrise-sunset)
-(org-defkey org-agenda-mode-map "h" 'org-agenda-holidays)
-(org-defkey org-agenda-mode-map "H" 'org-agenda-holidays)
-(org-defkey org-agenda-mode-map "\C-c\C-x\C-i" 'org-agenda-clock-in)
-(org-defkey org-agenda-mode-map "I" 'org-agenda-clock-in)
-(org-defkey org-agenda-mode-map "\C-c\C-x\C-o" 'org-agenda-clock-out)
-(org-defkey org-agenda-mode-map "O" 'org-agenda-clock-out)
-(org-defkey org-agenda-mode-map "\C-c\C-x\C-x" 'org-agenda-clock-cancel)
-(org-defkey org-agenda-mode-map "X" 'org-agenda-clock-cancel)
-(org-defkey org-agenda-mode-map "\C-c\C-x\C-j" 'org-clock-goto)
-(org-defkey org-agenda-mode-map "J" 'org-agenda-clock-goto)
-(org-defkey org-agenda-mode-map "+" 'org-agenda-priority-up)
-(org-defkey org-agenda-mode-map "-" 'org-agenda-priority-down)
-(org-defkey org-agenda-mode-map [(shift up)] 'org-agenda-priority-up)
-(org-defkey org-agenda-mode-map [(shift down)] 'org-agenda-priority-down)
-(org-defkey org-agenda-mode-map [?\C-c ?\C-x (up)] 'org-agenda-priority-up)
-(org-defkey org-agenda-mode-map [?\C-c ?\C-x (down)] 'org-agenda-priority-down)
-(org-defkey org-agenda-mode-map "f" 'org-agenda-later)
-(org-defkey org-agenda-mode-map "b" 'org-agenda-earlier)
-(org-defkey org-agenda-mode-map "\C-c\C-x\C-c" 'org-agenda-columns)
-(org-defkey org-agenda-mode-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock)
-(org-defkey org-agenda-mode-map "\C-c\C-x<" 'org-agenda-set-restriction-lock-from-agenda)
-
-(org-defkey org-agenda-mode-map "[" 'org-agenda-manipulate-query-add)
-(org-defkey org-agenda-mode-map "]" 'org-agenda-manipulate-query-subtract)
-(org-defkey org-agenda-mode-map "{" 'org-agenda-manipulate-query-add-re)
-(org-defkey org-agenda-mode-map "}" 'org-agenda-manipulate-query-subtract-re)
-(org-defkey org-agenda-mode-map "\\" 'org-agenda-filter-by-tag)
-(org-defkey org-agenda-mode-map "_" 'org-agenda-filter-by-effort)
-(org-defkey org-agenda-mode-map "=" 'org-agenda-filter-by-regexp)
-(org-defkey org-agenda-mode-map "/" 'org-agenda-filter)
-(org-defkey org-agenda-mode-map "|" 'org-agenda-filter-remove-all)
-(org-defkey org-agenda-mode-map "~" 'org-agenda-limit-interactively)
-(org-defkey org-agenda-mode-map "<" 'org-agenda-filter-by-category)
-(org-defkey org-agenda-mode-map "^" 'org-agenda-filter-by-top-headline)
-(org-defkey org-agenda-mode-map ";" 'org-timer-set-timer)
-(org-defkey org-agenda-mode-map "\C-c\C-x_" 'org-timer-stop)
-(define-key org-agenda-mode-map "?" 'org-agenda-show-the-flagging-note)
-(org-defkey org-agenda-mode-map "\C-c\C-x\C-mg" 'org-mobile-pull)
-(org-defkey org-agenda-mode-map "\C-c\C-x\C-mp" 'org-mobile-push)
-(org-defkey org-agenda-mode-map "\C-c\C-xI" 'org-info-find-node)
-
-(org-defkey org-agenda-mode-map [mouse-2] 'org-agenda-goto-mouse)
-(org-defkey org-agenda-mode-map [mouse-3] 'org-agenda-show-mouse)
-
-(define-key org-agenda-mode-map [remap forward-paragraph] 'org-agenda-forward-block)
-(define-key org-agenda-mode-map [remap backward-paragraph] 'org-agenda-backward-block)
+(org-defkey org-agenda-mode-map "\C-c\C-a" #'org-attach)
+(org-defkey org-agenda-mode-map "\C-c\C-n" #'org-agenda-next-date-line)
+(org-defkey org-agenda-mode-map "\C-c\C-p" #'org-agenda-previous-date-line)
+(org-defkey org-agenda-mode-map "\C-c," #'org-agenda-priority)
+(org-defkey org-agenda-mode-map "," #'org-agenda-priority)
+(org-defkey org-agenda-mode-map "i" #'org-agenda-diary-entry)
+(org-defkey org-agenda-mode-map "c" #'org-agenda-goto-calendar)
+(org-defkey org-agenda-mode-map "C" #'org-agenda-convert-date)
+(org-defkey org-agenda-mode-map "M" #'org-agenda-phases-of-moon)
+(org-defkey org-agenda-mode-map "S" #'org-agenda-sunrise-sunset)
+(org-defkey org-agenda-mode-map "h" #'org-agenda-holidays)
+(org-defkey org-agenda-mode-map "H" #'org-agenda-holidays)
+(org-defkey org-agenda-mode-map "\C-c\C-x\C-i" #'org-agenda-clock-in)
+(org-defkey org-agenda-mode-map "I" #'org-agenda-clock-in)
+(org-defkey org-agenda-mode-map "\C-c\C-x\C-o" #'org-agenda-clock-out)
+(org-defkey org-agenda-mode-map "O" #'org-agenda-clock-out)
+(org-defkey org-agenda-mode-map "\C-c\C-x\C-x" #'org-agenda-clock-cancel)
+(org-defkey org-agenda-mode-map "X" #'org-agenda-clock-cancel)
+(org-defkey org-agenda-mode-map "\C-c\C-x\C-j" #'org-clock-goto)
+(org-defkey org-agenda-mode-map "J" #'org-agenda-clock-goto)
+(org-defkey org-agenda-mode-map "+" #'org-agenda-priority-up)
+(org-defkey org-agenda-mode-map "-" #'org-agenda-priority-down)
+(org-defkey org-agenda-mode-map [(shift up)] #'org-agenda-priority-up)
+(org-defkey org-agenda-mode-map [(shift down)] #'org-agenda-priority-down)
+(org-defkey org-agenda-mode-map [?\C-c ?\C-x (up)] #'org-agenda-priority-up)
+(org-defkey org-agenda-mode-map [?\C-c ?\C-x (down)] #'org-agenda-priority-down)
+(org-defkey org-agenda-mode-map "f" #'org-agenda-later)
+(org-defkey org-agenda-mode-map "b" #'org-agenda-earlier)
+(org-defkey org-agenda-mode-map "\C-c\C-x\C-c" #'org-agenda-columns)
+(org-defkey org-agenda-mode-map "\C-c\C-x>" #'org-agenda-remove-restriction-lock)
+(org-defkey org-agenda-mode-map "\C-c\C-x<" #'org-agenda-set-restriction-lock-from-agenda)
+(org-defkey org-agenda-mode-map "[" #'org-agenda-manipulate-query-add)
+(org-defkey org-agenda-mode-map "]" #'org-agenda-manipulate-query-subtract)
+(org-defkey org-agenda-mode-map "{" #'org-agenda-manipulate-query-add-re)
+(org-defkey org-agenda-mode-map "}" #'org-agenda-manipulate-query-subtract-re)
+(org-defkey org-agenda-mode-map "\\" #'org-agenda-filter-by-tag)
+(org-defkey org-agenda-mode-map "_" #'org-agenda-filter-by-effort)
+(org-defkey org-agenda-mode-map "=" #'org-agenda-filter-by-regexp)
+(org-defkey org-agenda-mode-map "/" #'org-agenda-filter)
+(org-defkey org-agenda-mode-map "|" #'org-agenda-filter-remove-all)
+(org-defkey org-agenda-mode-map "~" #'org-agenda-limit-interactively)
+(org-defkey org-agenda-mode-map "<" #'org-agenda-filter-by-category)
+(org-defkey org-agenda-mode-map "^" #'org-agenda-filter-by-top-headline)
+(org-defkey org-agenda-mode-map ";" #'org-timer-set-timer)
+(org-defkey org-agenda-mode-map "\C-c\C-x_" #'org-timer-stop)
+(org-defkey org-agenda-mode-map "?" #'org-agenda-show-the-flagging-note)
+(org-defkey org-agenda-mode-map "\C-c\C-x\C-mg" #'org-mobile-pull)
+(org-defkey org-agenda-mode-map "\C-c\C-x\C-mp" #'org-mobile-push)
+(org-defkey org-agenda-mode-map "\C-c\C-xI" #'org-info-find-node)
+(org-defkey org-agenda-mode-map [mouse-2] #'org-agenda-goto-mouse)
+(org-defkey org-agenda-mode-map [mouse-3] #'org-agenda-show-mouse)
+(org-defkey org-agenda-mode-map [remap forward-paragraph] #'org-agenda-forward-block)
+(org-defkey org-agenda-mode-map [remap backward-paragraph] #'org-agenda-backward-block)
+(org-defkey org-agenda-mode-map "\C-c\C-c" #'org-agenda-ctrl-c-ctrl-c)
(when org-agenda-mouse-1-follows-link
(org-defkey org-agenda-mode-map [follow-link] 'mouse-face))
+
(easy-menu-define org-agenda-menu org-agenda-mode-map "Agenda menu"
'("Agenda"
("Agenda Files")
@@ -2563,7 +2592,7 @@ The following commands are available:
["Set Priority" org-agenda-priority t]
["Increase Priority" org-agenda-priority-up t]
["Decrease Priority" org-agenda-priority-down t]
- ["Show Priority" org-show-priority t])
+ ["Show Priority" org-priority-show t])
("Calendar/Diary"
["New Diary Entry" org-agenda-diary-entry (org-agenda-check-type nil 'agenda)]
["Goto Calendar" org-agenda-goto-calendar (org-agenda-check-type nil 'agenda)]
@@ -3113,7 +3142,7 @@ s Search for keywords M Like m, but only TODO entries
;; Hint to navigation if window too small for all information
(setq header-line-format
(when (not (pos-visible-in-window-p (point-max)))
- "Use SPC, DEL, C-n or C-p to navigate."))
+ "Use C-v, M-v, C-n or C-p to navigate."))
;; Ask for selection
(cl-loop
@@ -3127,24 +3156,8 @@ s Search for keywords M Like m, but only TODO entries
" (unrestricted)"))
""))
(setq c (read-char-exclusive)))
- until (not (memq c '(14 16 ?\s ?\d)))
- do (cl-case c
- (14 (if (not (pos-visible-in-window-p (point-max)))
- (ignore-errors (scroll-up 1))
- (message "End of buffer")
- (sit-for 1)))
- (16 (if (not (pos-visible-in-window-p (point-min)))
- (ignore-errors (scroll-down 1))
- (message "Beginning of buffer")
- (sit-for 1)))
- (?\s (if (not (pos-visible-in-window-p (point-max)))
- (scroll-up nil)
- (message "End of buffer")
- (sit-for 1)))
- (?\d (if (not (pos-visible-in-window-p (point-min)))
- (scroll-down nil)
- (message "Beginning of buffer")
- (sit-for 1)))))
+ until (not (memq c '(14 16 22 134217846)))
+ do (org-scroll c))
(message "")
(cond
@@ -3591,8 +3604,7 @@ removed from the entry content. Currently only `planning' is allowed here."
(when org-agenda-add-entry-text-descriptive-links
(goto-char (point-min))
(while (org-activate-links (point-max))
- (add-text-properties (match-beginning 0) (match-end 0)
- '(face org-link))))
+ (goto-char (match-end 0))))
(goto-char (point-min))
(while (re-search-forward org-link-bracket-re (point-max) t)
(set-text-properties (match-beginning 0) (match-end 0)
@@ -3747,6 +3759,14 @@ generating a new one."
;; does not have org variables local
org-agenda-this-buffer-is-sticky))))
+(defvar org-agenda-buffer-tmp-name nil)
+
+(defun org-agenda--get-buffer-name (sticky-name)
+ (or org-agenda-buffer-tmp-name
+ (and org-agenda-doing-sticky-redo org-agenda-buffer-name)
+ sticky-name
+ "*Org Agenda*"))
+
(defun org-agenda-prepare-window (abuf filter-alist)
"Setup agenda buffer in the window.
ABUF is the buffer for the agenda window.
@@ -3763,6 +3783,10 @@ FILTER-ALIST is an alist of filters we need to apply when
(org-switch-to-buffer-other-window abuf))
((eq org-agenda-window-setup 'other-frame)
(switch-to-buffer-other-frame abuf))
+ ((eq org-agenda-window-setup 'other-tab)
+ (if (fboundp 'switch-to-buffer-other-tab)
+ (switch-to-buffer-other-tab abuf)
+ (user-error "Your version of Emacs does not have tab bar support")))
((eq org-agenda-window-setup 'only-window)
(delete-other-windows)
(pop-to-buffer-same-window abuf))
@@ -3847,15 +3871,17 @@ FILTER-ALIST is an alist of filters we need to apply when
(defvar org-overriding-columns-format)
(defvar org-local-columns-format)
(defun org-agenda-finalize ()
- "Finishing touch for the agenda buffer, called just before displaying it."
+ "Finishing touch for the agenda buffer.
+This function is called just before displaying the agenda. If
+you want to add your own functions to the finalization of the
+agenda display, configure `org-agenda-finalize-hook'."
(unless org-agenda-multi
- (save-excursion
- (let ((inhibit-read-only t))
+ (let ((inhibit-read-only t))
+ (save-excursion
(goto-char (point-min))
(save-excursion
(while (org-activate-links (point-max))
- (add-text-properties (match-beginning 0) (match-end 0)
- '(face org-link))))
+ (goto-char (match-end 0))))
(unless (eq org-agenda-remove-tags t)
(org-agenda-align-tags))
(unless org-agenda-with-colors
@@ -3894,7 +3920,6 @@ FILTER-ALIST is an alist of filters we need to apply when
'tags
(org-with-point-at mrk
(mapcar #'downcase (org-get-tags)))))))))
- (run-hooks 'org-agenda-finalize-hook)
(setq org-agenda-represented-tags nil
org-agenda-represented-categories nil)
(when org-agenda-top-headline-filter
@@ -3920,12 +3945,13 @@ FILTER-ALIST is an alist of filters we need to apply when
(when (get 'org-agenda-effort-filter :preset-filter)
(org-agenda-filter-apply
(get 'org-agenda-effort-filter :preset-filter) 'effort))
- (add-hook 'kill-buffer-hook 'org-agenda-reset-markers 'append 'local)))))
+ (add-hook 'kill-buffer-hook 'org-agenda-reset-markers 'append 'local))
+ (run-hooks 'org-agenda-finalize-hook))))
(defun org-agenda-mark-clocking-task ()
"Mark the current clock entry in the agenda if it is present."
;; We need to widen when `org-agenda-finalize' is called from
- ;; `org-agenda-change-all-lines' (e.g. in `org-agenda-clock-in')
+ ;; `org-agenda-change-all-lines' (e.g. in `org-agenda-clock-in').
(when (bound-and-true-p org-clock-current-task)
(save-restriction
(widen)
@@ -3960,15 +3986,15 @@ FILTER-ALIST is an alist of filters we need to apply when
(save-excursion
(let (b e p ov h l)
(goto-char (point-min))
- (while (re-search-forward "\\[#\\(.\\)\\]" nil t)
- (setq h (or (get-char-property (point) 'org-highest-priority)
- org-highest-priority)
- l (or (get-char-property (point) 'org-lowest-priority)
- org-lowest-priority)
- p (string-to-char (match-string 1))
- b (match-beginning 0)
+ (while (re-search-forward org-priority-regexp nil t)
+ (setq h (or (get-char-property (point) 'org-priority-highest)
+ org-priority-highest)
+ l (or (get-char-property (point) 'org-priority-lowest)
+ org-priority-lowest)
+ p (string-to-char (match-string 2))
+ b (match-beginning 1)
e (if (eq org-agenda-fontify-priorities 'cookies)
- (match-end 0)
+ (1+ (match-end 2))
(point-at-eol))
ov (make-overlay b e))
(overlay-put
@@ -3996,7 +4022,7 @@ dimming them."
(when (called-interactively-p 'interactive)
(message "Dim or hide blocked tasks..."))
(dolist (o (overlays-in (point-min) (point-max)))
- (when (eq (overlay-get o 'org-type) 'org-blocked-todo)
+ (when (eq (overlay-get o 'face) 'org-agenda-dimmed-todo-face)
(delete-overlay o)))
(save-excursion
(let ((inhibit-read-only t))
@@ -4004,22 +4030,26 @@ dimming them."
(while (let ((pos (text-property-not-all
(point) (point-max) 'org-todo-blocked nil)))
(when pos (goto-char pos)))
- (let* ((invisible (eq (org-get-at-bol 'org-todo-blocked) 'invisible))
+ (let* ((invisible
+ (eq (org-get-at-bol 'org-todo-blocked) 'invisible))
+ (todo-blocked
+ (eq (org-get-at-bol 'org-filter-type) 'todo-blocked))
(ov (make-overlay (if invisible
(line-end-position 0)
(line-beginning-position))
(line-end-position))))
- (if invisible
- (overlay-put ov 'invisible t)
+ (when todo-blocked
(overlay-put ov 'face 'org-agenda-dimmed-todo-face))
- (overlay-put ov 'org-type 'org-blocked-todo))
- (forward-line))))
+ (when invisible
+ (org-agenda-filter-hide-line 'todo-blocked)))
+ (move-beginning-of-line 2))))
(when (called-interactively-p 'interactive)
(message "Dim or hide blocked tasks...done")))
(defun org-agenda--mark-blocked-entry (entry)
- "For ENTRY a string with the text property `org-hd-marker', if
-the header at `org-hd-marker' is blocked according to
+ "If ENTRY is blocked, mark it for fontification or invisibility.
+
+If the header at `org-hd-marker' is blocked according to
`org-entry-blocked-p', then if `org-agenda-dim-blocked-tasks' is
'invisible and the header is not blocked by checkboxes, set the
text property `org-todo-blocked' to `invisible', otherwise set it
@@ -4043,7 +4073,9 @@ to t."
(put-text-property
0 (length entry) 'org-todo-blocked
(if really-invisible 'invisible t)
- entry)))))))
+ entry)
+ (put-text-property
+ 0 (length entry) 'org-filter-type 'todo-blocked entry)))))))
entry)
(defvar org-agenda-skip-function nil
@@ -4067,8 +4099,10 @@ continue from there."
(when (or
(save-excursion (goto-char p) (looking-at comment-start-skip))
(and org-agenda-skip-archived-trees (not org-agenda-archives-mode)
- (get-text-property p :org-archived)
- (org-end-of-subtree t))
+ (or (and (get-text-property p :org-archived)
+ (org-end-of-subtree t))
+ (and (member org-archive-tag org-file-tags)
+ (goto-char (point-max)))))
(and org-agenda-skip-comment-trees
(get-text-property p :org-comment)
(org-end-of-subtree t))
@@ -4100,8 +4134,8 @@ functions do."
(defun org-agenda-new-marker (&optional pos)
"Return a new agenda marker.
-Maker is at point, or at POS if non-nil. Org mode keeps a list of
-these markers and resets them when they are no longer in use."
+Marker is at point, or at POS if non-nil. Org mode keeps a list
+of these markers and resets them when they are no longer in use."
(let ((m (copy-marker (or pos (point)) t)))
(setq org-agenda-last-marker-time (float-time))
(if org-agenda-buffer
@@ -4183,7 +4217,6 @@ See the docstring of `org-read-date' for details.")
(defvar org-starting-day nil) ; local variable in the agenda buffer
(defvar org-arg-loc nil) ; local variable
-(defvar org-agenda-buffer-tmp-name nil)
;;;###autoload
(defun org-agenda-list (&optional arg start-day span with-hour)
"Produce a daily/weekly view from all files in variable `org-agenda-files'.
@@ -4211,15 +4244,13 @@ items if they have an hour specification like [h]h:mm."
(user-error "Agenda creation impossible for this span(=%d days)." span)))
(catch 'exit
(setq org-agenda-buffer-name
- (or org-agenda-buffer-tmp-name
- (and org-agenda-doing-sticky-redo org-agenda-buffer-name)
- (when org-agenda-sticky
+ (org-agenda--get-buffer-name
+ (and org-agenda-sticky
(cond ((and org-keys (stringp org-match))
(format "*Org Agenda(%s:%s)*" org-keys org-match))
(org-keys
(format "*Org Agenda(%s)*" org-keys))
- (t "*Org Agenda(a)*")))
- "*Org Agenda*"))
+ (t "*Org Agenda(a)*")))))
(org-agenda-prepare "Day/Week")
(setq start-day (or start-day org-agenda-start-day))
(when (stringp start-day)
@@ -4366,7 +4397,7 @@ items if they have an hour specification like [h]h:mm."
(insert tbl)))
(goto-char (point-min))
(or org-agenda-multi (org-agenda-fit-window-to-buffer))
- (unless (or (not (get-buffer-window))
+ (unless (or (not (get-buffer-window org-agenda-buffer-name))
(and (pos-visible-in-window-p (point-min))
(pos-visible-in-window-p (point-max))))
(goto-char (1- (point-max)))
@@ -4509,12 +4540,15 @@ is active."
(edit-at string))
'org-agenda-search-history)))
(catch 'exit
- (when org-agenda-sticky
- (setq org-agenda-buffer-name
- (if (stringp string)
- (format "*Org Agenda(%s:%s)*"
- (or org-keys (or (and todo-only "S") "s")) string)
- (format "*Org Agenda(%s)*" (or (and todo-only "S") "s")))))
+ (setq org-agenda-buffer-name
+ (org-agenda--get-buffer-name
+ (and org-agenda-sticky
+ (if (stringp string)
+ (format "*Org Agenda(%s:%s)*"
+ (or org-keys (or (and todo-only "S") "s"))
+ string)
+ (format "*Org Agenda(%s)*"
+ (or (and todo-only "S") "s"))))))
(org-agenda-prepare "SEARCH")
(org-compile-prefix-format 'search)
(org-set-sorting-strategy 'search)
@@ -4761,12 +4795,13 @@ for a keyword. A numeric prefix directly selects the Nth keyword in
(completion-ignore-case t)
kwds org-select-this-todo-keyword rtn rtnall files file pos)
(catch 'exit
- (when org-agenda-sticky
- (setq org-agenda-buffer-name
- (if (stringp org-select-this-todo-keyword)
- (format "*Org Agenda(%s:%s)*" (or org-keys "t")
- org-select-this-todo-keyword)
- (format "*Org Agenda(%s)*" (or org-keys "t")))))
+ (setq org-agenda-buffer-name
+ (org-agenda--get-buffer-name
+ (and org-agenda-sticky
+ (if (stringp org-select-this-todo-keyword)
+ (format "*Org Agenda(%s:%s)*" (or org-keys "t")
+ org-select-this-todo-keyword)
+ (format "*Org Agenda(%s)*" (or org-keys "t"))))))
(org-agenda-prepare "TODO")
(setq kwds org-todo-keywords-for-agenda
org-select-this-todo-keyword (if (stringp arg) arg
@@ -4775,8 +4810,12 @@ for a keyword. A numeric prefix directly selects the Nth keyword in
(nth (1- arg) kwds))))
(when (equal arg '(4))
(setq org-select-this-todo-keyword
- (completing-read "Keyword (or KWD1|K2D2|...): "
- (mapcar #'list kwds) nil nil)))
+ (mapconcat #'identity
+ (let ((crm-separator "|"))
+ (completing-read-multiple
+ "Keyword (or KWD1|KWD2|...): "
+ (mapcar #'list kwds) nil nil))
+ "|")))
(and (equal 0 arg) (setq org-select-this-todo-keyword nil))
(org-compile-prefix-format 'todo)
(org-set-sorting-strategy 'todo)
@@ -4849,13 +4888,15 @@ The prefix arg TODO-ONLY limits the search to TODO entries."
(when (and (stringp match) (not (string-match "\\S-" match)))
(setq match nil))
(catch 'exit
- ;; TODO: this code is repeated a lot...
- (when org-agenda-sticky
- (setq org-agenda-buffer-name
- (if (stringp match)
- (format "*Org Agenda(%s:%s)*"
- (or org-keys (or (and todo-only "M") "m")) match)
- (format "*Org Agenda(%s)*" (or (and todo-only "M") "m")))))
+ (setq org-agenda-buffer-name
+ (org-agenda--get-buffer-name
+ (and org-agenda-sticky
+ (if (stringp match)
+ (format "*Org Agenda(%s:%s)*"
+ (or org-keys (or (and todo-only "M") "m"))
+ match)
+ (format "*Org Agenda(%s)*"
+ (or (and todo-only "M") "m"))))))
(setq matcher (org-make-tags-matcher match))
;; Prepare agendas (and `org-tag-alist-for-agenda') before
;; expanding tags within `org-make-tags-matcher'
@@ -5136,6 +5177,7 @@ of what a project is and how to check if it stuck, customize the variable
(cons 'org-diary-default-entry diary-list-entries-hook))
(diary-file-name-prefix nil) ; turn this feature off
(diary-modify-entry-list-string-function 'org-modify-diary-entry-string)
+ (diary-time-regexp (concat "^" diary-time-regexp))
entries
(org-disable-agenda-to-diary t))
(save-excursion
@@ -5285,7 +5327,8 @@ function from a program - use `org-agenda-get-day-entries' instead."
(when results
(setq results
(mapcar (lambda (i) (replace-regexp-in-string
- org-link-bracket-re "\\2" i)) results))
+ org-link-bracket-re "\\2" i))
+ results))
(concat (org-agenda-finalize-entries results) "\n"))))
;;; Agenda entry finders
@@ -5504,10 +5547,12 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(cond
((eq org-agenda-todo-ignore-scheduled 'future)
(> (org-time-stamp-to-now
- (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0))
+ (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds)
+ 0))
((eq org-agenda-todo-ignore-scheduled 'past)
(<= (org-time-stamp-to-now
- (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0))
+ (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds)
+ 0))
((numberp org-agenda-todo-ignore-scheduled)
(org-agenda-todo-custom-ignore-p
(match-string 1) org-agenda-todo-ignore-scheduled))
@@ -5520,10 +5565,12 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(not (org-deadline-close-p (match-string 1))))
((eq org-agenda-todo-ignore-deadlines 'future)
(> (org-time-stamp-to-now
- (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0))
+ (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds)
+ 0))
((eq org-agenda-todo-ignore-deadlines 'past)
(<= (org-time-stamp-to-now
- (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0))
+ (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds)
+ 0))
((numberp org-agenda-todo-ignore-deadlines)
(org-agenda-todo-custom-ignore-p
(match-string 1) org-agenda-todo-ignore-deadlines))
@@ -5547,10 +5594,12 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(cond
((eq org-agenda-todo-ignore-timestamp 'future)
(> (org-time-stamp-to-now
- (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0))
+ (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds)
+ 0))
((eq org-agenda-todo-ignore-timestamp 'past)
(<= (org-time-stamp-to-now
- (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0))
+ (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds)
+ 0))
((numberp org-agenda-todo-ignore-timestamp)
(org-agenda-todo-custom-ignore-p
(match-string 1) org-agenda-todo-ignore-timestamp))
@@ -6458,7 +6507,6 @@ scheduled items with an hour specification like [h]h:mm."
(and (eq org-agenda-show-inherited-tags t)
(or (eq org-agenda-use-tag-inheritance t)
(memq 'agenda org-agenda-use-tag-inheritance))))
-
tags (org-get-tags nil (not inherited-tags)))
(setq level (make-string (org-reduced-level (org-outline-level)) ? ))
(looking-at "\\*+[ \t]+\\(.*\\)")
@@ -6476,12 +6524,19 @@ scheduled items with an hour specification like [h]h:mm."
org-agenda-timerange-leaders)
(1+ (- d0 d1)) (1+ (- d2 d1)))
head level category tags
- (cond ((and (= d1 d0) (= d2 d0))
- (concat "<" start-time ">--<" end-time ">"))
- ((= d1 d0)
- (concat "<" start-time ">"))
- ((= d2 d0)
- (concat "<" end-time ">")))
+ (save-match-data
+ (let ((hhmm1 (and (string-match org-ts-regexp1 s1)
+ (match-string 6 s1)))
+ (hhmm2 (and (string-match org-ts-regexp1 s2)
+ (match-string 6 s2))))
+ (cond ((string= hhmm1 hhmm2)
+ (concat "<" start-time ">--<" end-time ">"))
+ ((and (= d1 d0) (= d2 d0))
+ (concat "<" start-time ">--<" end-time ">"))
+ ((= d1 d0)
+ (concat "<" start-time ">"))
+ ((= d2 d0)
+ (concat "<" end-time ">")))))
remove-re))))
(org-add-props txt props
'org-marker marker 'org-hd-marker hdmarker
@@ -6677,8 +6732,8 @@ Any match of REMOVE-RE will be removed from TXT."
(org-add-props rtn nil
'org-category category
'tags (mapcar 'org-downcase-keep-props tags)
- 'org-highest-priority org-highest-priority
- 'org-lowest-priority org-lowest-priority
+ 'org-priority-highest org-priority-highest
+ 'org-priority-lowest org-priority-lowest
'time-of-day time-of-day
'duration duration
'breadcrumbs breadcrumbs
@@ -6873,7 +6928,7 @@ HH:MM."
(< t0 1000)) "0" "")
(if (< t0 100) "0" "")
(if (< t0 10) "0" "")
- (int-to-string t0))))
+ (number-to-string t0))))
(if string (concat (substring t1 -4 -2) ":" (substring t1 -2)) t0)))))
(defvar org-agenda-before-sorting-filter-function nil
@@ -6921,7 +6976,7 @@ The optional argument TYPE tells the agenda type."
(when max-effort
(setq list (org-agenda-limit-entries
list 'effort-minutes max-effort
- (lambda (e) (or e (if org-sort-agenda-noeffort-is-high
+ (lambda (e) (or e (if org-agenda-sort-noeffort-is-high
32767 -1))))))
(when max-todo
(setq list (org-agenda-limit-entries list 'todo-state max-todo)))
@@ -7007,7 +7062,8 @@ The optional argument TYPE tells the agenda type."
;; that isn't there.
pl
(equal (string-match (concat "\\(\\.*\\)" re "\\( +\\)")
- x pl) pl))
+ x pl)
+ pl))
(add-text-properties
(or (match-end 1) (match-end 0)) (match-end 0)
(list 'face (org-get-todo-face (match-string 2 x)))
@@ -7034,7 +7090,7 @@ The optional argument TYPE tells the agenda type."
(defsubst org-cmp-effort (a b)
"Compare the effort values of string A and B."
- (let* ((def (if org-sort-agenda-noeffort-is-high 32767 -1))
+ (let* ((def (if org-agenda-sort-noeffort-is-high 32767 -1))
;; `effort-minutes' property is not directly accessible from
;; the strings, but is stored as a property in `txt'.
(ea (or (get-text-property
@@ -7084,12 +7140,14 @@ The optional argument TYPE tells the agenda type."
(case-fold-search nil))
(when pla
(when (string-match (concat "\\`[ \t]*" (or (get-text-property 0 'org-todo-regexp a) "")
- "\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *") ta)
+ "\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *")
+ ta)
(setq ta (substring ta (match-end 0))))
(setq ta (downcase ta)))
(when plb
(when (string-match (concat "\\`[ \t]*" (or (get-text-property 0 'org-todo-regexp b) "")
- "\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *") tb)
+ "\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *")
+ tb)
(setq tb (substring tb (match-end 0))))
(setq tb (downcase tb)))
(cond ((not (or ta tb)) nil)
@@ -7110,7 +7168,7 @@ The optional argument TYPE tells the agenda type."
(defsubst org-cmp-time (a b)
"Compare the time-of-day values of strings A and B."
- (let* ((def (if org-sort-agenda-notime-is-late 9901 -1))
+ (let* ((def (if org-agenda-sort-notime-is-late 9901 -1))
(ta (or (get-text-property 1 'time-of-day a) def))
(tb (or (get-text-property 1 'time-of-day b) def)))
(cond ((< ta tb) -1)
@@ -7122,7 +7180,7 @@ When TYPE is \"scheduled\", \"deadline\", \"timestamp\" or
\"timestamp_ia\", compare within each of these type. When TYPE
is the empty string, compare all timestamps without respect of
their type."
- (let* ((def (and (not org-sort-agenda-notime-is-late) -1))
+ (let* ((def (and (not org-agenda-sort-notime-is-late) -1))
(ta (or (and (string-match type (or (get-text-property 1 'type a) ""))
(get-text-property 1 'ts-date a))
def))
@@ -7352,6 +7410,10 @@ agenda."
(cond
((eq org-agenda-window-setup 'other-frame)
(delete-frame))
+ ((eq org-agenda-window-setup 'other-tab)
+ (if (fboundp 'tab-bar-close-tab)
+ (tab-bar-close-tab)
+ (user-error "Your version of Emacs does not have tab bar mode support")))
((and org-agenda-restore-windows-after-quit
wconf)
;; Maybe restore the pre-agenda window configuration. Reset
@@ -7471,7 +7533,7 @@ in the agenda."
(and top-hl-filter (org-agenda-filter-top-headline-apply top-hl-filter))
(and cols (called-interactively-p 'any) (org-agenda-columns))
(org-goto-line line)
- (recenter window-line)))
+ (when (called-interactively-p 'any) (recenter window-line))))
(defun org-agenda-redo-all (&optional exhaustive)
"Rebuild all agenda views in the current buffer.
@@ -7496,7 +7558,8 @@ With a prefix argument, do so in all agenda buffers."
"Filter lines in the agenda buffer that have a specific category.
The category is that of the current line.
With a `\\[universal-argument]' prefix argument, exclude the lines of that category.
-When there is already a category filter in place, this command removes the filter."
+When there is already a category filter in place, this command removes the
+filter."
(interactive "P")
(if (and org-agenda-filtered-by-category
org-agenda-category-filter)
@@ -7509,7 +7572,8 @@ When there is already a category filter in place, this command removes the filte
(cat
(org-agenda-filter-apply
(setq org-agenda-category-filter
- (list (concat "+" cat))) 'category))
+ (list (concat "+" cat)))
+ 'category))
(t (error "No category at point"))))))
(defun org-find-top-headline (&optional pos)
@@ -7521,7 +7585,10 @@ search from."
(when pos (goto-char pos))
;; Skip up to the topmost parent.
(while (org-up-heading-safe))
- (ignore-errors (nth 4 (org-heading-components))))))
+ (ignore-errors
+ (replace-regexp-in-string
+ "^\\[[0-9]+/[0-9]+\\] *\\|^\\[%[0-9]+\\] *" ""
+ (nth 4 (org-heading-components)))))))
(defvar org-agenda-filtered-by-top-headline nil)
(defun org-agenda-filter-by-top-headline (strip)
@@ -7573,8 +7640,9 @@ This last option is in practice not very useful, but it is available for
consistency with the other filter commands."
(interactive "P")
(let* ((efforts (split-string
- (or (cdr (assoc (concat org-effort-property "_ALL")
- org-global-properties))
+ (or (cdr (assoc-string (concat org-effort-property "_ALL")
+ org-global-properties
+ t))
"0 0:10 0:30 1:00 2:00 3:00 4:00 5:00 6:00 7:00")))
;; XXX: the following handles only up to 10 different
;; effort values.
@@ -7615,7 +7683,6 @@ consistency with the other filter commands."
(if keep current nil)))
(org-agenda-filter-apply org-agenda-effort-filter 'effort)))))
-
(defun org-agenda-filter (&optional strip-or-accumulate)
"Prompt for a general filter string and apply it to the agenda.
@@ -7666,11 +7733,18 @@ the variable `org-agenda-auto-exclude-function'."
(let* ((tag-list (org-agenda-get-represented-tags))
(category-list (org-agenda-get-represented-categories))
(negate (equal strip-or-accumulate '(4)))
+ (cf (mapconcat #'identity org-agenda-category-filter ""))
+ (tf (mapconcat #'identity org-agenda-tag-filter ""))
+ (rpl-fn (lambda (c) (replace-regexp-in-string "^\\+" "" (or (car c) ""))))
+ (ef (replace-regexp-in-string "^\\+" "" (or (car org-agenda-effort-filter) "")))
+ (rf (replace-regexp-in-string "^\\+" "" (or (car org-agenda-regexp-filter) "")))
+ (ff (concat cf tf ef (when (not (equal rf "")) (concat "/" rf "/"))))
(f-string (completing-read
(concat
(if negate "Negative filter" "Filter")
" [+cat-tag<0:10-/regexp/]: ")
- 'org-agenda-filter-completion-function))
+ 'org-agenda-filter-completion-function
+ nil nil ff))
(keep (or (if (string-match "^\\+[+-]" f-string)
(progn (setq f-string (substring f-string 1)) t))
(equal strip-or-accumulate '(16))))
@@ -7679,6 +7753,11 @@ the variable `org-agenda-auto-exclude-function'."
(fe (if keep org-agenda-effort-filter))
(fr (if keep org-agenda-regexp-filter))
pm s)
+ ;; If the filter contains a double-quoted string, replace a
+ ;; single hyphen by the arbitrary and temporary string "~~~"
+ ;; to disambiguate such hyphens from syntactic ones.
+ (setq f-string (replace-regexp-in-string
+ "\"\\([^\"]*\\)-\\([^\"]*\\)\"" "\"\\1~~~\\2\"" f-string))
(while (string-match "^[ \t]*\\([-+]\\)?\\(\\([^-+<>=/ \t]+\\)\\|\\([<>=][0-9:]+\\)\\|\\(/\\([^/]+\\)/?\\)\\)" f-string)
(setq pm (if (match-beginning 1) (match-string 1 f-string) "+"))
(when negate
@@ -7686,12 +7765,15 @@ the variable `org-agenda-auto-exclude-function'."
(cond
((match-beginning 3)
;; category or tag
- (setq s (match-string 3 f-string))
+ (setq s (replace-regexp-in-string ; Remove the temporary special string.
+ "~~~" "-" (match-string 3 f-string)))
(cond
((member s tag-list)
(add-to-list 'ft (concat pm s) 'append 'equal))
((member s category-list)
- (add-to-list 'fc (concat pm s) 'append 'equal))
+ (add-to-list 'fc (concat pm ; Remove temporary double quotes.
+ (replace-regexp-in-string "\"\\(.*\\)\"" "\\1" s))
+ 'append 'equal))
(t (message
"`%s%s' filter ignored because tag/category is not represented"
pm s))))
@@ -7706,15 +7788,15 @@ the variable `org-agenda-auto-exclude-function'."
(and fc (org-agenda-filter-apply
(setq org-agenda-category-filter fc) 'category))
(and ft (org-agenda-filter-apply
- (setq org-agenda-tag-filter ft) 'tag))
+ (setq org-agenda-tag-filter ft) 'tag 'expand))
(and fe (org-agenda-filter-apply
(setq org-agenda-effort-filter fe) 'effort))
(and fr (org-agenda-filter-apply
(setq org-agenda-regexp-filter fr) 'regexp))
- )))
+ (run-hooks 'org-agenda-filter-hook))))
(defun org-agenda-filter-completion-function (string _predicate &optional flag)
- "Complete a complex filter string
+ "Complete a complex filter string.
FLAG specifies the type of completion operation to perform. This
function is passed as a collection function to `completing-read',
which see."
@@ -7733,8 +7815,9 @@ which see."
(org-agenda-get-represented-tags))))
((member operator '("<" ">" "="))
(setq table (split-string
- (or (cdr (assoc (concat org-effort-property "_ALL")
- org-global-properties))
+ (or (cdr (assoc-string (concat org-effort-property "_ALL")
+ org-global-properties
+ t))
"0 0:10 0:30 1:00 2:00 3:00 4:00 5:00 6:00 7:00")
" +")))
(t (setq table nil)))
@@ -7761,7 +7844,9 @@ which see."
(org-agenda-filter-show-all-top-filter))
(when org-agenda-effort-filter
(org-agenda-filter-show-all-effort))
- (org-agenda-finalize))
+ (org-agenda-finalize)
+ (when (called-interactively-p 'interactive)
+ (message "All agenda filters removed")))
(defun org-agenda-filter-by-tag (strip-or-accumulate &optional char exclude)
"Keep only those lines in the agenda buffer that have a specific tag.
@@ -7861,8 +7946,12 @@ also press `-' or `+' to switch between filtering and excluding."
pos 'org-category nil (point-max))))
(push (get-text-property pos 'org-category) categories))
(setq org-agenda-represented-categories
- (nreverse (org-uniquify (delq nil categories))))))))
+ ;; Enclose category names with a hyphen in double
+ ;; quotes to process them specially in `org-agenda-filter'.
+ (mapcar (lambda (s) (if (string-match-p "-" s) (format "\"%s\"" s) s))
+ (nreverse (org-uniquify (delq nil categories)))))))))
+(defvar org-tag-groups-alist-for-agenda)
(defun org-agenda-get-represented-tags ()
"Return a list of all tags used in this agenda buffer.
These will be lower-case, for filtering."
@@ -7874,15 +7963,27 @@ These will be lower-case, for filtering."
pos 'tags nil (point-max))))
(setq tt (get-text-property pos 'tags))
(if tt (push tt tags-lists)))
- (setq org-agenda-represented-tags
+ (setq tags-lists
(nreverse (org-uniquify
- (delq nil (apply 'append tags-lists)))))))))
+ (delq nil (apply 'append tags-lists)))))
+ (dolist (tag tags-lists)
+ (mapc
+ (lambda (group)
+ (when (member tag (mapcar #'downcase group))
+ (push (downcase (car group)) tags-lists)))
+ org-tag-groups-alist-for-agenda))
+ (setq org-agenda-represented-tags tags-lists)))))
(defun org-agenda-filter-make-matcher (filter type &optional expand)
"Create the form that tests a line for agenda filter. Optional
argument EXPAND can be used for the TYPE tag and will expand the
tags in the FILTER if any of the tags in FILTER are grouptags."
- (let (f f1)
+ (let ((multi-pos-cats
+ (and (eq type 'category)
+ (string-match-p "\\+.*\\+"
+ (mapconcat (lambda (cat) (substring cat 0 1))
+ filter ""))))
+ f f1)
(cond
;; Tag filter
((eq type 'tag)
@@ -7926,7 +8027,7 @@ tags in the FILTER if any of the tags in FILTER are grouptags."
filter)))
(dolist (x filter)
(push (org-agenda-filter-effort-form x) f))))
- (cons 'and (nreverse f))))
+ (cons (if multi-pos-cats 'or 'and) (nreverse f))))
(defun org-agenda-filter-make-matcher-tag-exp (tags op)
"Return a form associated to tag-expression TAGS.
@@ -7966,12 +8067,13 @@ If the line does not have an effort defined, return nil."
;; current line but is stored as a property in `txt'.
(let ((effort (get-text-property 0 'effort-minutes (org-get-at-bol 'txt))))
(funcall op
- (or effort (if org-sort-agenda-noeffort-is-high 32767 -1))
+ (or effort (if org-agenda-sort-noeffort-is-high 32767 -1))
value)))
(defun org-agenda-filter-expand-tags (filter &optional no-operator)
"Expand group tags in FILTER for the agenda.
-When NO-OPERATOR is non-nil, do not add the + operator to returned tags."
+When NO-OPERATOR is non-nil, do not add the + operator to
+returned tags."
(if org-group-tags
(let ((case-fold-search t) rtn)
(mapc
@@ -7988,34 +8090,33 @@ When NO-OPERATOR is non-nil, do not add the + operator to returned tags."
filter))
(defun org-agenda-filter-apply (filter type &optional expand)
- "Set FILTER as the new agenda filter and apply it. Optional
-argument EXPAND can be used for the TYPE tag and will expand the
-tags in the FILTER if any of the tags in FILTER are grouptags."
+ "Set FILTER as the new agenda filter and apply it.
+Optional argument EXPAND can be used for the TYPE tag and will
+expand the tags in the FILTER if any of the tags in FILTER are
+grouptags."
;; Deactivate `org-agenda-entry-text-mode' when filtering
(when org-agenda-entry-text-mode (org-agenda-entry-text-mode))
- (let (tags cat txt)
- (setq org-agenda-filter-form (org-agenda-filter-make-matcher
- filter type expand))
- ;; Only set `org-agenda-filtered-by-category' to t when a unique
- ;; category is used as the filter:
- (setq org-agenda-filtered-by-category
- (and (eq type 'category)
- (not (equal (substring (car filter) 0 1) "-"))))
- (org-agenda-set-mode-name)
- (save-excursion
- (goto-char (point-min))
- (while (not (eobp))
- (if (org-get-at-bol 'org-hd-marker)
- (progn
- (setq tags (org-get-at-bol 'tags)
- cat (org-agenda-get-category)
- txt (org-get-at-bol 'txt))
- (unless (eval org-agenda-filter-form)
- (org-agenda-filter-hide-line type))
- (beginning-of-line 2))
- (beginning-of-line 2))))
- (when (get-char-property (point) 'invisible)
- (ignore-errors (org-agenda-previous-line)))))
+ (setq org-agenda-filter-form (org-agenda-filter-make-matcher
+ filter type expand))
+ ;; Only set `org-agenda-filtered-by-category' to t when a unique
+ ;; category is used as the filter:
+ (setq org-agenda-filtered-by-category
+ (and (eq type 'category)
+ (not (equal (substring (car filter) 0 1) "-"))))
+ (org-agenda-set-mode-name)
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (when (or (org-get-at-bol 'org-hd-marker)
+ (org-get-at-bol 'org-marker))
+ (let ((tags (org-get-at-bol 'tags))
+ (cat (org-agenda-get-category))
+ (txt (or (org-get-at-bol 'txt) "")))
+ (unless (eval org-agenda-filter-form)
+ (org-agenda-filter-hide-line type))))
+ (beginning-of-line 2)))
+ (when (get-char-property (point) 'invisible)
+ (ignore-errors (org-agenda-previous-line))))
(defun org-agenda-filter-top-headline-apply (hl &optional negative)
"Filter by top headline HL."
@@ -8035,16 +8136,17 @@ tags in the FILTER if any of the tags in FILTER are grouptags."
org-agenda-filtered-by-top-headline t))
(defun org-agenda-filter-hide-line (type)
- "Hide lines with TYPE in the agenda buffer."
- (let* ((b (max (point-min) (1- (point-at-bol))))
- (e (point-at-eol)))
+ "If current line is TYPE, hide it in the agenda buffer."
+ (let* (buffer-invisibility-spec
+ (beg (max (point-min) (1- (point-at-bol))))
+ (end (point-at-eol)))
(let ((inhibit-read-only t))
(add-text-properties
- b e `(invisible org-filtered org-filter-type ,type)))))
+ beg end `(invisible org-filtered org-filter-type ,type)))))
(defun org-agenda-remove-filter (type)
- (interactive)
"Remove filter of type TYPE from the agenda buffer."
+ (interactive)
(save-excursion
(goto-char (point-min))
(let ((inhibit-read-only t) pos)
@@ -8518,7 +8620,10 @@ log items, nothing else."
When called with a prefix argument, include all archive files as well."
(interactive "P")
(setq org-agenda-archives-mode
- (if with-files t (if org-agenda-archives-mode nil 'trees)))
+ (cond ((and with-files (eq org-agenda-archives-mode t)) nil)
+ (with-files t)
+ (org-agenda-archives-mode nil)
+ (t 'trees)))
(org-agenda-set-mode-name)
(org-agenda-redo)
(message
@@ -8585,14 +8690,14 @@ When called with a prefix argument, include all archive files as well."
(if (or org-agenda-category-filter
(get 'org-agenda-category-filter :preset-filter))
'(:eval (propertize
- (concat "["
+ (concat "["
(mapconcat
'identity
(append
(get 'org-agenda-category-filter :preset-filter)
org-agenda-category-filter)
"")
- "]")
+ "]")
'face 'org-agenda-filter-category
'help-echo "Category used in filtering")) "")
(if (or org-agenda-tag-filter
@@ -8704,6 +8809,7 @@ When called with a prefix argument, include all archive files as well."
(org-agenda-error)))
(buffer (marker-buffer marker))
(pos (marker-position marker)))
+ ;; FIXME: use `org-switch-to-buffer-other-window'?
(switch-to-buffer-other-window buffer)
(widen)
(push-mark)
@@ -8722,92 +8828,143 @@ When called with a prefix argument, include all archive files as well."
"Normal hook run after an item has been shown from the agenda.
Point is in the buffer where the item originated.")
+;; Defined later in org-agenda.el
+(defvar org-agenda-loop-over-headlines-in-active-region nil)
+
+(defun org-agenda-do-in-region (beg end cmd &optional arg force-arg delete)
+ "Between region BEG and END, call agenda command CMD.
+When optional argument ARG is non-nil or FORCE-ARG is `t', pass
+ARG to CMD. When optional argument DELETE is non-nil, assume CMD
+deletes the agenda entry and don't move to the next entry."
+ (save-excursion
+ (goto-char beg)
+ (let ((mend (move-marker (make-marker) end))
+ (all (eq org-agenda-loop-over-headlines-in-active-region t))
+ (match (and (stringp org-agenda-loop-over-headlines-in-active-region)
+ org-agenda-loop-over-headlines-in-active-region))
+ (level (and (eq org-agenda-loop-over-headlines-in-active-region 'start-level)
+ (org-get-at-bol 'level))))
+ (while (< (point) mend)
+ (let ((ov (make-overlay (point) (point-at-eol))))
+ (if (not (or all
+ (and match (looking-at-p match))
+ (eq level (org-get-at-bol 'level))))
+ (org-agenda-next-item 1)
+ (overlay-put ov 'face 'region)
+ (if (or arg force-arg) (funcall cmd arg) (funcall cmd))
+ (when (not delete) (org-agenda-next-item 1))
+ (delete-overlay ov)))))))
+
+;; org-agenda-[schedule,deadline,date-prompt,todo,[toggle]archive*,
+;; kill,set-property,set-effort] commands may loop over agenda
+;; entries. Commands `org-agenda-set-tags' and `org-agenda-bulk-mark'
+;; use their own mechanisms on active regions.
+(defmacro org-agenda-maybe-loop (cmd arg force-arg delete &rest body)
+ "Maybe loop over agenda entries and perform CMD.
+Pass ARG, FORCE-ARG, DELETE and BODY to `org-agenda-do-in-region'."
+ (declare (debug t))
+ `(if (and (called-interactively-p 'any)
+ org-agenda-loop-over-headlines-in-active-region
+ (org-region-active-p))
+ (org-agenda-do-in-region
+ (region-beginning) (region-end) ,cmd ,arg ,force-arg ,delete)
+ ,@body))
+
(defun org-agenda-kill ()
"Kill the entry or subtree belonging to the current agenda entry."
(interactive)
- (or (eq major-mode 'org-agenda-mode) (error "Not in agenda"))
- (let* ((bufname-orig (buffer-name))
- (marker (or (org-get-at-bol 'org-marker)
- (org-agenda-error)))
- (buffer (marker-buffer marker))
- (pos (marker-position marker))
- (type (org-get-at-bol 'type))
- dbeg dend (n 0))
- (org-with-remote-undo buffer
- (with-current-buffer buffer
- (save-excursion
- (goto-char pos)
- (if (and (derived-mode-p 'org-mode) (not (member type '("sexp"))))
- (setq dbeg (progn (org-back-to-heading t) (point))
- dend (org-end-of-subtree t t))
- (setq dbeg (point-at-bol)
- dend (min (point-max) (1+ (point-at-eol)))))
- (goto-char dbeg)
- (while (re-search-forward "^[ \t]*\\S-" dend t) (setq n (1+ n)))))
- (when (or (eq t org-agenda-confirm-kill)
- (and (numberp org-agenda-confirm-kill)
- (> n org-agenda-confirm-kill)))
- (let ((win-conf (current-window-configuration)))
- (unwind-protect
- (and
- (prog2
- (org-agenda-tree-to-indirect-buffer nil)
- (not (y-or-n-p
- (format "Delete entry with %d lines in buffer \"%s\"? "
- n (buffer-name buffer))))
- (kill-buffer org-last-indirect-buffer))
- (error "Abort"))
- (set-window-configuration win-conf))))
- (let ((org-agenda-buffer-name bufname-orig))
- (org-remove-subtree-entries-from-agenda buffer dbeg dend))
- (with-current-buffer buffer (delete-region dbeg dend))
- (message "Agenda item and source killed"))))
+ (or (eq major-mode 'org-agenda-mode) (user-error "Not in agenda"))
+ (org-agenda-maybe-loop
+ #'org-agenda-kill nil nil t
+ (let* ((bufname-orig (buffer-name))
+ (marker (or (org-get-at-bol 'org-marker)
+ (org-agenda-error)))
+ (buffer (marker-buffer marker))
+ (pos (marker-position marker))
+ (type (org-get-at-bol 'type))
+ dbeg dend (n 0))
+ (org-with-remote-undo buffer
+ (with-current-buffer buffer
+ (save-excursion
+ (goto-char pos)
+ (if (and (derived-mode-p 'org-mode) (not (member type '("sexp"))))
+ (setq dbeg (progn (org-back-to-heading t) (point))
+ dend (org-end-of-subtree t t))
+ (setq dbeg (point-at-bol)
+ dend (min (point-max) (1+ (point-at-eol)))))
+ (goto-char dbeg)
+ (while (re-search-forward "^[ \t]*\\S-" dend t) (setq n (1+ n)))))
+ (when (or (eq t org-agenda-confirm-kill)
+ (and (numberp org-agenda-confirm-kill)
+ (> n org-agenda-confirm-kill)))
+ (let ((win-conf (current-window-configuration)))
+ (unwind-protect
+ (and
+ (prog2
+ (org-agenda-tree-to-indirect-buffer nil)
+ (not (y-or-n-p
+ (format "Delete entry with %d lines in buffer \"%s\"? "
+ n (buffer-name buffer))))
+ (kill-buffer org-last-indirect-buffer))
+ (error "Abort"))
+ (set-window-configuration win-conf))))
+ (let ((org-agenda-buffer-name bufname-orig))
+ (org-remove-subtree-entries-from-agenda buffer dbeg dend))
+ (with-current-buffer buffer (delete-region dbeg dend))
+ (message "Agenda item and source killed")))))
(defvar org-archive-default-command) ; defined in org-archive.el
(defun org-agenda-archive-default ()
"Archive the entry or subtree belonging to the current agenda entry."
(interactive)
(require 'org-archive)
- (org-agenda-archive-with org-archive-default-command))
+ (funcall-interactively
+ #'org-agenda-archive-with org-archive-default-command))
(defun org-agenda-archive-default-with-confirmation ()
"Archive the entry or subtree belonging to the current agenda entry."
(interactive)
(require 'org-archive)
- (org-agenda-archive-with org-archive-default-command 'confirm))
+ (funcall-interactively
+ #'org-agenda-archive-with org-archive-default-command 'confirm))
(defun org-agenda-archive ()
"Archive the entry or subtree belonging to the current agenda entry."
(interactive)
- (org-agenda-archive-with 'org-archive-subtree))
+ (funcall-interactively
+ #'org-agenda-archive-with 'org-archive-subtree))
(defun org-agenda-archive-to-archive-sibling ()
"Move the entry to the archive sibling."
(interactive)
- (org-agenda-archive-with 'org-archive-to-archive-sibling))
+ (funcall-interactively
+ #'org-agenda-archive-with 'org-archive-to-archive-sibling))
(defun org-agenda-archive-with (cmd &optional confirm)
"Move the entry to the archive sibling."
(interactive)
- (or (eq major-mode 'org-agenda-mode) (error "Not in agenda"))
- (let* ((bufname-orig (buffer-name))
- (marker (or (org-get-at-bol 'org-marker)
- (org-agenda-error)))
- (buffer (marker-buffer marker))
- (pos (marker-position marker)))
- (org-with-remote-undo buffer
- (with-current-buffer buffer
- (if (derived-mode-p 'org-mode)
- (if (and confirm
- (not (y-or-n-p "Archive this subtree or entry? ")))
- (error "Abort")
- (save-window-excursion
- (goto-char pos)
- (let ((org-agenda-buffer-name bufname-orig))
- (org-remove-subtree-entries-from-agenda))
- (org-back-to-heading t)
- (funcall cmd)))
- (error "Archiving works only in Org files"))))))
+ (or (eq major-mode 'org-agenda-mode) (user-error "Not in agenda"))
+ (org-agenda-maybe-loop
+ #'org-agenda-archive-with cmd nil t
+ (let* ((bufname-orig (buffer-name))
+ (marker (or (org-get-at-bol 'org-marker)
+ (org-agenda-error)))
+ (buffer (marker-buffer marker))
+ (pos (marker-position marker)))
+ (org-with-remote-undo buffer
+ (with-current-buffer buffer
+ (if (derived-mode-p 'org-mode)
+ (if (and confirm
+ (not (y-or-n-p "Archive this subtree or entry? ")))
+ (error "Abort")
+ (save-window-excursion
+ (goto-char pos)
+ (let ((org-agenda-buffer-name bufname-orig))
+ (org-remove-subtree-entries-from-agenda))
+ (org-back-to-heading t)
+ (let ((org-archive-from-agenda t))
+ (funcall cmd))))
+ (error "Archiving works only in Org files")))))))
(defun org-remove-subtree-entries-from-agenda (&optional buf beg end)
"Remove all lines in the agenda that correspond to a given subtree.
@@ -8894,12 +9051,16 @@ It also looks at the text of the entry itself."
(setq trg (and (string-match org-link-bracket-re l)
(match-string 1 l)))
(if (or (not trg) (string-match org-link-any-re trg))
- (org-with-wide-buffer
- (goto-char marker)
- (when (search-forward l nil lkend)
- (goto-char (match-beginning 0))
- (org-open-at-point)))
+ ;; Don't use `org-with-wide-buffer' here as
+ ;; opening the link may result in moving the point
+ (save-restriction
+ (widen)
+ (goto-char marker)
+ (when (search-forward l nil lkend)
+ (goto-char (match-beginning 0))
+ (org-open-at-point)))
;; This is an internal link, widen the buffer
+ ;; FIXME: use `org-switch-to-buffer-other-window'?
(switch-to-buffer-other-window buffer)
(widen)
(goto-char marker)
@@ -9002,8 +9163,7 @@ The prefix arg selects the amount of information to display:
1 just show the entry according to defaults.
2 show the children view
3 show the subtree view
-4 show the entire subtree and any LOGBOOK drawers
-5 show the entire subtree and any drawers
+4 show the entire subtree and any drawers
With prefix argument FULL-ENTRY, make the entire entry visible
if it was hidden in the outline."
(interactive "p")
@@ -9033,13 +9193,7 @@ if it was hidden in the outline."
(org-back-to-heading)
(run-hook-with-args 'org-cycle-hook 'subtree))
(message "Remote: SUBTREE"))
- ((= more 4)
- (outline-show-subtree)
- (save-excursion
- (org-back-to-heading)
- (org-cycle-hide-drawers 'subtree '("LOGBOOK")))
- (message "Remote: SUBTREE AND LOGBOOK"))
- ((> more 4)
+ ((> more 3)
(outline-show-subtree)
(message "Remote: SUBTREE AND ALL DRAWERS")))
(select-window win)))
@@ -9154,44 +9308,46 @@ This changes the line at point, all other lines in the agenda referring to
the same tree node, and the headline of the tree node in the Org file."
(interactive "P")
(org-agenda-check-no-diary)
- (let* ((col (current-column))
- (marker (or (org-get-at-bol 'org-marker)
- (org-agenda-error)))
- (buffer (marker-buffer marker))
- (pos (marker-position marker))
- (hdmarker (org-get-at-bol 'org-hd-marker))
- (todayp (org-agenda-today-p (org-get-at-bol 'day)))
- (inhibit-read-only t)
- org-loop-over-headlines-in-active-region
- org-agenda-headline-snapshot-before-repeat newhead just-one)
- (org-with-remote-undo buffer
- (with-current-buffer buffer
- (widen)
- (goto-char pos)
- (org-show-context 'agenda)
- (let ((current-prefix-arg arg))
- (call-interactively 'org-todo))
- (and (bolp) (forward-char 1))
- (setq newhead (org-get-heading))
- (when (and (bound-and-true-p
- org-agenda-headline-snapshot-before-repeat)
- (not (equal org-agenda-headline-snapshot-before-repeat
- newhead))
- todayp)
- (setq newhead org-agenda-headline-snapshot-before-repeat
- just-one t))
- (save-excursion
- (org-back-to-heading)
- (move-marker org-last-heading-marker (point))))
- (beginning-of-line 1)
- (save-window-excursion
- (org-agenda-change-all-lines newhead hdmarker 'fixface just-one))
- (when (bound-and-true-p org-clock-out-when-done)
- (string-match (concat "^" (regexp-opt org-done-keywords-for-agenda))
- newhead)
- (org-agenda-unmark-clocking-task))
- (org-move-to-column col)
- (org-agenda-mark-clocking-task))))
+ (org-agenda-maybe-loop
+ #'org-agenda-todo arg nil nil
+ (let* ((col (current-column))
+ (marker (or (org-get-at-bol 'org-marker)
+ (org-agenda-error)))
+ (buffer (marker-buffer marker))
+ (pos (marker-position marker))
+ (hdmarker (org-get-at-bol 'org-hd-marker))
+ (todayp (org-agenda-today-p (org-get-at-bol 'day)))
+ (inhibit-read-only t)
+ org-loop-over-headlines-in-active-region
+ org-agenda-headline-snapshot-before-repeat newhead just-one)
+ (org-with-remote-undo buffer
+ (with-current-buffer buffer
+ (widen)
+ (goto-char pos)
+ (org-show-context 'agenda)
+ (let ((current-prefix-arg arg))
+ (call-interactively 'org-todo))
+ (and (bolp) (forward-char 1))
+ (setq newhead (org-get-heading))
+ (when (and (bound-and-true-p
+ org-agenda-headline-snapshot-before-repeat)
+ (not (equal org-agenda-headline-snapshot-before-repeat
+ newhead))
+ todayp)
+ (setq newhead org-agenda-headline-snapshot-before-repeat
+ just-one t))
+ (save-excursion
+ (org-back-to-heading)
+ (move-marker org-last-heading-marker (point))))
+ (beginning-of-line 1)
+ (save-window-excursion
+ (org-agenda-change-all-lines newhead hdmarker 'fixface just-one))
+ (when (bound-and-true-p org-clock-out-when-done)
+ (string-match (concat "^" (regexp-opt org-done-keywords-for-agenda))
+ newhead)
+ (org-agenda-unmark-clocking-task))
+ (org-move-to-column col)
+ (org-agenda-mark-clocking-task)))))
(defun org-agenda-add-note (&optional arg)
"Add a time-stamped note to the entry at point."
@@ -9330,9 +9486,9 @@ the same tree node, and the headline of the tree node in the Org file.
Called with a universal prefix arg, show the priority instead of setting it."
(interactive "P")
(if (equal force-direction '(4))
- (org-show-priority)
- (unless org-enable-priority-commands
- (error "Priority commands are disabled"))
+ (org-priority-show)
+ (unless org-priority-enable-commands
+ (user-error "Priority commands are disabled"))
(org-agenda-check-no-diary)
(let* ((col (current-column))
(marker (or (org-get-at-bol 'org-marker)
@@ -9383,59 +9539,65 @@ Called with a universal prefix arg, show the priority instead of setting it."
"Set a property for the current headline."
(interactive)
(org-agenda-check-no-diary)
- (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
- (org-agenda-error)))
- (buffer (marker-buffer hdmarker))
- (pos (marker-position hdmarker))
- (inhibit-read-only t)
- newhead)
- (org-with-remote-undo buffer
- (with-current-buffer buffer
- (widen)
- (goto-char pos)
- (org-show-context 'agenda)
- (call-interactively 'org-set-property)))))
+ (org-agenda-maybe-loop
+ #'org-agenda-set-property nil nil nil
+ (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
+ (org-agenda-error)))
+ (buffer (marker-buffer hdmarker))
+ (pos (marker-position hdmarker))
+ (inhibit-read-only t)
+ newhead)
+ (org-with-remote-undo buffer
+ (with-current-buffer buffer
+ (widen)
+ (goto-char pos)
+ (org-show-context 'agenda)
+ (call-interactively 'org-set-property))))))
(defun org-agenda-set-effort ()
"Set the effort property for the current headline."
(interactive)
(org-agenda-check-no-diary)
- (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
- (org-agenda-error)))
- (buffer (marker-buffer hdmarker))
- (pos (marker-position hdmarker))
- (inhibit-read-only t)
- newhead)
- (org-with-remote-undo buffer
- (with-current-buffer buffer
- (widen)
- (goto-char pos)
- (org-show-context 'agenda)
- (call-interactively 'org-set-effort)
- (end-of-line 1)
- (setq newhead (org-get-heading)))
- (org-agenda-change-all-lines newhead hdmarker))))
+ (org-agenda-maybe-loop
+ #'org-agenda-set-effort nil nil nil
+ (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
+ (org-agenda-error)))
+ (buffer (marker-buffer hdmarker))
+ (pos (marker-position hdmarker))
+ (inhibit-read-only t)
+ newhead)
+ (org-with-remote-undo buffer
+ (with-current-buffer buffer
+ (widen)
+ (goto-char pos)
+ (org-show-context 'agenda)
+ (call-interactively 'org-set-effort)
+ (end-of-line 1)
+ (setq newhead (org-get-heading)))
+ (org-agenda-change-all-lines newhead hdmarker)))))
(defun org-agenda-toggle-archive-tag ()
"Toggle the archive tag for the current entry."
(interactive)
(org-agenda-check-no-diary)
- (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
- (org-agenda-error)))
- (buffer (marker-buffer hdmarker))
- (pos (marker-position hdmarker))
- (inhibit-read-only t)
- newhead)
- (org-with-remote-undo buffer
- (with-current-buffer buffer
- (widen)
- (goto-char pos)
- (org-show-context 'agenda)
- (call-interactively 'org-toggle-archive-tag)
- (end-of-line 1)
- (setq newhead (org-get-heading)))
- (org-agenda-change-all-lines newhead hdmarker)
- (beginning-of-line 1))))
+ (org-agenda-maybe-loop
+ #'org-agenda-toggle-archive-tag nil nil nil
+ (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
+ (org-agenda-error)))
+ (buffer (marker-buffer hdmarker))
+ (pos (marker-position hdmarker))
+ (inhibit-read-only t)
+ newhead)
+ (org-with-remote-undo buffer
+ (with-current-buffer buffer
+ (widen)
+ (goto-char pos)
+ (org-show-context 'agenda)
+ (call-interactively 'org-toggle-archive-tag)
+ (end-of-line 1)
+ (setq newhead (org-get-heading)))
+ (org-agenda-change-all-lines newhead hdmarker)
+ (beginning-of-line 1)))))
(defun org-agenda-do-date-later (arg)
(interactive "P")
@@ -9541,8 +9703,11 @@ Called with a universal prefix arg, show the priority instead of setting it."
(goto-char (point-max))
(while (not (bobp))
(when (equal marker (org-get-at-bol 'org-marker))
- (remove-text-properties (point-at-bol) (point-at-eol) '(display nil))
- (org-move-to-column (- (window-width) (length stamp)) t)
+ (remove-text-properties (line-beginning-position)
+ (line-end-position)
+ '(display nil))
+ (org-move-to-column
+ (- (/ (window-width nil t) (window-font-width)) (length stamp)) t)
(add-text-properties
(1- (point)) (point-at-eol)
(list 'display (org-add-props stamp nil
@@ -9557,18 +9722,20 @@ be used to request time specification in the time stamp."
(interactive "P")
(org-agenda-check-type t 'agenda)
(org-agenda-check-no-diary)
- (let* ((marker (or (org-get-at-bol 'org-marker)
- (org-agenda-error)))
- (buffer (marker-buffer marker))
- (pos (marker-position marker)))
- (org-with-remote-undo buffer
- (with-current-buffer buffer
- (widen)
- (goto-char pos)
- (unless (org-at-timestamp-p 'lax) (error "Cannot find time stamp"))
- (org-time-stamp arg (equal (char-after (match-beginning 0)) ?\[)))
- (org-agenda-show-new-time marker org-last-changed-timestamp))
- (message "Time stamp changed to %s" org-last-changed-timestamp)))
+ (org-agenda-maybe-loop
+ #'org-agenda-date-prompt arg t nil
+ (let* ((marker (or (org-get-at-bol 'org-marker)
+ (org-agenda-error)))
+ (buffer (marker-buffer marker))
+ (pos (marker-position marker)))
+ (org-with-remote-undo buffer
+ (with-current-buffer buffer
+ (widen)
+ (goto-char pos)
+ (unless (org-at-timestamp-p 'lax) (error "Cannot find time stamp"))
+ (org-time-stamp arg (equal (char-after (match-beginning 0)) ?\[)))
+ (org-agenda-show-new-time marker org-last-changed-timestamp))
+ (message "Time stamp changed to %s" org-last-changed-timestamp))))
(defun org-agenda-schedule (arg &optional time)
"Schedule the item at point.
@@ -9576,20 +9743,22 @@ ARG is passed through to `org-schedule'."
(interactive "P")
(org-agenda-check-type t 'agenda 'todo 'tags 'search)
(org-agenda-check-no-diary)
- (let* ((marker (or (org-get-at-bol 'org-marker)
- (org-agenda-error)))
- (type (marker-insertion-type marker))
- (buffer (marker-buffer marker))
- (pos (marker-position marker))
- ts)
- (set-marker-insertion-type marker t)
- (org-with-remote-undo buffer
- (with-current-buffer buffer
- (widen)
- (goto-char pos)
- (setq ts (org-schedule arg time)))
- (org-agenda-show-new-time marker ts " S"))
- (message "%s" ts)))
+ (org-agenda-maybe-loop
+ #'org-agenda-schedule arg t nil
+ (let* ((marker (or (org-get-at-bol 'org-marker)
+ (org-agenda-error)))
+ (type (marker-insertion-type marker))
+ (buffer (marker-buffer marker))
+ (pos (marker-position marker))
+ ts)
+ (set-marker-insertion-type marker t)
+ (org-with-remote-undo buffer
+ (with-current-buffer buffer
+ (widen)
+ (goto-char pos)
+ (setq ts (org-schedule arg time)))
+ (org-agenda-show-new-time marker ts " S"))
+ (message "%s" ts))))
(defun org-agenda-deadline (arg &optional time)
"Schedule the item at point.
@@ -9597,18 +9766,20 @@ ARG is passed through to `org-deadline'."
(interactive "P")
(org-agenda-check-type t 'agenda 'todo 'tags 'search)
(org-agenda-check-no-diary)
- (let* ((marker (or (org-get-at-bol 'org-marker)
- (org-agenda-error)))
- (buffer (marker-buffer marker))
- (pos (marker-position marker))
- ts)
- (org-with-remote-undo buffer
- (with-current-buffer buffer
- (widen)
- (goto-char pos)
- (setq ts (org-deadline arg time)))
- (org-agenda-show-new-time marker ts " D"))
- (message "%s" ts)))
+ (org-agenda-maybe-loop
+ #'org-agenda-deadline arg t nil
+ (let* ((marker (or (org-get-at-bol 'org-marker)
+ (org-agenda-error)))
+ (buffer (marker-buffer marker))
+ (pos (marker-position marker))
+ ts)
+ (org-with-remote-undo buffer
+ (with-current-buffer buffer
+ (widen)
+ (goto-char pos)
+ (setq ts (org-deadline arg time)))
+ (org-agenda-show-new-time marker ts " D"))
+ (message "%s" ts))))
(defun org-agenda-clock-in (&optional arg)
"Start the clock on the currently selected item."
@@ -9636,7 +9807,7 @@ ARG is passed through to `org-deadline'."
"Stop the currently running clock."
(interactive)
(unless (marker-buffer org-clock-marker)
- (error "No running clock"))
+ (user-error "No running clock"))
(let ((marker (make-marker)) (col (current-column)) newhead)
(org-with-remote-undo (marker-buffer org-clock-marker)
(with-current-buffer (marker-buffer org-clock-marker)
@@ -9792,13 +9963,13 @@ the resulting entry will not be shown. When TEXT is empty, switch to
(org-agenda-insert-diary-make-new-entry text))
(org-insert-time-stamp (org-time-from-absolute
(calendar-absolute-from-gregorian d1))
- nil nil nil nil time2))
+ nil nil nil nil time2))
(end-of-line 0))
((block) ;; Wrap this in (strictly unnecessary) parens because
;; otherwise the indentation gets confused by the
;; special meaning of 'block
(when (> (calendar-absolute-from-gregorian d1)
- (calendar-absolute-from-gregorian d2))
+ (calendar-absolute-from-gregorian d2))
(setq d1 (prog1 d2 (setq d2 d1))))
(if (eq org-agenda-insert-diary-strategy 'top-level)
(org-agenda-insert-diary-as-top-level text)
@@ -10062,13 +10233,13 @@ When ARG is greater than one mark ARG lines."
(goto-char (point-min))
(goto-char (next-single-property-change (point) 'org-hd-marker))
(while (and (re-search-forward regexp nil t)
- (setq txt-at-point (get-text-property (point) 'txt)))
+ (setq txt-at-point
+ (get-text-property (match-beginning 0) 'txt)))
(if (get-char-property (point) 'invisible)
(beginning-of-line 2)
- (when (string-match regexp txt-at-point)
+ (when (string-match-p regexp txt-at-point)
(setq entries-marked (1+ entries-marked))
(call-interactively 'org-agenda-bulk-mark)))))
-
(unless entries-marked
(message "No entry matching this regexp."))))
@@ -10138,6 +10309,33 @@ bulk action."
:version "24.1"
:type 'boolean)
+(defcustom org-agenda-loop-over-headlines-in-active-region t
+ "Shall some commands act upon headlines in the active region?
+
+When set to t, some commands will be performed in all headlines
+within the active region.
+
+When set to `start-level', some commands will be performed in all
+headlines within the active region, provided that these headlines
+are of the same level than the first one.
+
+When set to a regular expression, those commands will be
+performed on the matching headlines within the active region.
+
+The list of commands is: `org-agenda-schedule',
+`org-agenda-deadline', `org-agenda-date-prompt',
+`org-agenda-todo', `org-agenda-archive*', `org-agenda-kill'.
+
+See `org-loop-over-headlines-in-active-region' for the equivalent
+option for Org buffers."
+ :type '(choice (const :tag "Don't loop" nil)
+ (const :tag "All headlines in active region" t)
+ (const :tag "In active region, headlines at the same level than the first one" start-level)
+ (regexp :tag "Regular expression matcher"))
+ :version "27.1"
+ :package-version '(Org . "9.4")
+ :group 'org-agenda)
+
(defun org-agenda-bulk-action (&optional arg)
"Execute an remote-editing action on all marked entries.
The prefix arg is passed through to the command if possible."
@@ -10547,6 +10745,11 @@ when defining today."
(org-extend-today-until (1+ hour)))
(org-agenda-todo arg)))
+(defun org-agenda-ctrl-c-ctrl-c ()
+ "Set tags in agenda buffer."
+ (interactive)
+ (org-agenda-set-tags))
+
(provide 'org-agenda)
;;; org-agenda.el ends here
diff --git a/lisp/org/org-archive.el b/lisp/org/org-archive.el
index b33025be0f8..73cd83ebf33 100644
--- a/lisp/org/org-archive.el
+++ b/lisp/org/org-archive.el
@@ -1,6 +1,6 @@
;;; org-archive.el --- Archiving for Org -*- lexical-binding: t; -*-
-;; Copyright (C) 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -24,7 +24,7 @@
;;
;;; Commentary:
-;; This file contains the face definitions for Org.
+;; This file contains the archive functionality for Org.
;;; Code:
@@ -91,6 +91,25 @@ When a string, a %s formatter will be replaced by the file name."
(const :tag "When archiving a subtree to the same file" infile)
(const :tag "Always" t)))
+(defcustom org-archive-subtree-save-file-p 'from-org
+ "Conditionally save the archive file after archiving a subtree.
+This variable can be any of the following symbols:
+
+t saves in all cases.
+`from-org' prevents saving from an agenda-view.
+`from-agenda' saves only when the archive is initiated from an agenda-view.
+nil prevents saving in all cases.
+
+Note that, regardless of this value, the archive buffer is never
+saved when archiving into a location in the current buffer."
+ :group 'org-archive
+ :package-version '(Org . "9.4")
+ :type '(choice
+ (const :tag "Save archive buffer" t)
+ (const :tag "Save when archiving from agenda" from-agenda)
+ (const :tag "Save when archiving from an Org buffer" from-org)
+ (const :tag "Do not save")))
+
(defcustom org-archive-save-context-info '(time file olpath category todo itags)
"Parts of context info that should be stored as properties when archiving.
When a subtree is moved to an archive file, it loses information given by
@@ -230,12 +249,20 @@ direct children of this heading."
((find-buffer-visiting afile))
((find-file-noselect afile))
(t (error "Cannot access file \"%s\"" afile))))
+ (org-odd-levels-only
+ (if (local-variable-p 'org-odd-levels-only (current-buffer))
+ org-odd-levels-only
+ tr-org-odd-levels-only))
level datetree-date datetree-subheading-p)
- (when (string-match "\\`datetree/" heading)
- ;; Replace with ***, to represent the 3 levels of headings the
- ;; datetree has.
- (setq heading (replace-regexp-in-string "\\`datetree/" "***" heading))
- (setq datetree-subheading-p (> (length heading) 3))
+ (when (string-match "\\`datetree/\\(\\**\\)" heading)
+ ;; "datetree/" corresponds to 3 levels of headings.
+ (let ((nsub (length (match-string 1 heading))))
+ (setq heading (concat (make-string
+ (+ (if org-odd-levels-only 5 3)
+ (* (org-level-increment) nsub))
+ ?*)
+ (substring heading (match-end 0))))
+ (setq datetree-subheading-p (> nsub 0)))
(setq datetree-date (org-date-to-gregorian
(or (org-entry-get nil "CLOSED" t) time))))
(if (and (> (length heading) 0)
@@ -290,11 +317,7 @@ direct children of this heading."
(org-todo-kwd-alist tr-org-todo-kwd-alist)
(org-done-keywords tr-org-done-keywords)
(org-todo-regexp tr-org-todo-regexp)
- (org-todo-line-regexp tr-org-todo-line-regexp)
- (org-odd-levels-only
- (if (local-variable-p 'org-odd-levels-only (current-buffer))
- org-odd-levels-only
- tr-org-odd-levels-only)))
+ (org-todo-line-regexp tr-org-todo-line-regexp))
(goto-char (point-min))
(org-show-all '(headings blocks))
(if (and heading (not (and datetree-date (not datetree-subheading-p))))
@@ -361,6 +384,15 @@ direct children of this heading."
(point)
(concat "ARCHIVE_" (upcase (symbol-name item)))
value))))
+ ;; Save the buffer, if it is not the same buffer and
+ ;; depending on `org-archive-subtree-save-file-p'.
+ (unless (eq this-buffer buffer)
+ (when (or (eq org-archive-subtree-save-file-p t)
+ (eq org-archive-subtree-save-file-p
+ (if (boundp 'org-archive-from-agenda)
+ 'from-agenda
+ 'from-org)))
+ (save-buffer)))
(widen))))
;; Here we are back in the original buffer. Everything seems
;; to have worked. So now run hooks, cut the tree and finish
diff --git a/lisp/org/org-attach-git.el b/lisp/org/org-attach-git.el
index 31945ff205e..2091cbc610c 100644
--- a/lisp/org/org-attach-git.el
+++ b/lisp/org/org-attach-git.el
@@ -1,6 +1,6 @@
;;; org-attach-git.el --- Automatic git commit extension to org-attach -*- lexical-binding: t; -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; Original Author: John Wiegley <johnw@newartisans.com>
;; Restructurer: Gustav Wikström <gustav@whil.se>
diff --git a/lisp/org/org-attach.el b/lisp/org/org-attach.el
index 1ed305c9ff3..46decacca03 100644
--- a/lisp/org/org-attach.el
+++ b/lisp/org/org-attach.el
@@ -1,10 +1,9 @@
;;; org-attach.el --- Manage file attachments to Org outlines -*- lexical-binding: t; -*-
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@newartisans.com>
;; Keywords: org data attachment
-
;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software: you can redistribute it and/or modify
@@ -41,6 +40,8 @@
(require 'org-id)
(declare-function dired-dwim-target-directory "dired-aux")
+(declare-function org-element-property "org-element" (property element))
+(declare-function org-element-type "org-element" (element))
(defgroup org-attach nil
"Options concerning attachments in Org mode."
@@ -129,8 +130,7 @@ Selective means to respect the inheritance setting in
:type '(choice
(const :tag "Don't use inheritance" nil)
(const :tag "Inherit parent node attachments" t)
- (const :tag "Respect org-use-property-inheritance" selective))
- :type 'boolean)
+ (const :tag "Respect org-use-property-inheritance" selective)))
(defcustom org-attach-store-link-p nil
"Non-nil means store a link to a file when attaching it."
@@ -139,7 +139,8 @@ Selective means to respect the inheritance setting in
:type '(choice
(const :tag "Don't store link" nil)
(const :tag "Link to origin location" t)
- (const :tag "Link to the attach-dir location" attached)))
+ (const :tag "Attachment link to the attach-dir location" attached)
+ (const :tag "File link to the attach-dir location" file)))
(defcustom org-attach-archive-delete nil
"Non-nil means attachments are deleted upon archiving a subtree.
@@ -181,7 +182,7 @@ attachment folders based on ID."
:type '(repeat (function :tag "Function with ID as input")))
(defvar org-attach-after-change-hook nil
- "Hook to be called when files have been added or removed to the attachment folder.")
+ "Hook called when files have been added or removed to the attachment folder.")
(defvar org-attach-open-hook nil
"Hook that is invoked by `org-attach-open'.
@@ -254,16 +255,16 @@ Shows a list of commands and prompts for another key to execute a command."
(get-text-property (point) 'org-marker)))
(unless marker
(error "No item in current line")))
- (save-excursion
- (when marker
- (set-buffer (marker-buffer marker))
- (goto-char marker))
- (org-back-to-heading t)
+ (org-with-point-at marker
+ (org-back-to-heading-or-point-min t)
(save-excursion
(save-window-excursion
(unless org-attach-expert
- (with-output-to-temp-buffer "*Org Attach*"
- (princ
+ (org-switch-to-buffer-other-window "*Org Attach*")
+ (erase-buffer)
+ (setq cursor-type nil
+ header-line-format "Use C-v, M-v, C-n or C-p to navigate.")
+ (insert
(concat "Attachment folder:\n"
(or dir
"Can't find an existing attachment-folder")
@@ -286,11 +287,14 @@ Shows a list of commands and prompts for another key to execute a command."
"Invalid `org-attach-commands' item: %S"
entry))))
org-attach-commands
- "\n"))))))
+ "\n")))))
(org-fit-window-to-buffer (get-buffer-window "*Org Attach*"))
- (message "Select command: [%s]"
- (concat (mapcar #'caar org-attach-commands)))
- (setq c (read-char-exclusive))
+ (let ((msg (format "Select command: [%s]"
+ (concat (mapcar #'caar org-attach-commands)))))
+ (message msg)
+ (while (and (setq c (read-char-exclusive))
+ (memq c '(14 16 22 134217846)))
+ (org-scroll c t)))
(and (get-buffer "*Org Attach*") (kill-buffer "*Org Attach*"))))
(let ((command (cl-some (lambda (entry)
(and (memq c (nth 0 entry)) (nth 1 entry)))
@@ -457,14 +461,6 @@ DIR-property exists (that is different from the unset one)."
"Turn the autotag off."
(org-attach-tag 'off))
-(defun org-attach-store-link (file)
- "Add a link to `org-stored-link' when attaching a file.
-Only do this when `org-attach-store-link-p' is non-nil."
- (setq org-stored-links
- (cons (list (org-attach-expand-link file)
- (file-name-nondirectory file))
- org-stored-links)))
-
(defun org-attach-url (url)
(interactive "MURL of the file to attach: \n")
(let ((org-attach-method 'url))
@@ -491,7 +487,7 @@ METHOD may be `cp', `mv', `ln', `lns' or `url' default taken from
`org-attach-method'."
(interactive
(list
- (read-file-name "File to keep as an attachment:"
+ (read-file-name "File to keep as an attachment: "
(or (progn
(require 'dired-aux)
(dired-dwim-target-directory))
@@ -501,22 +497,30 @@ METHOD may be `cp', `mv', `ln', `lns' or `url' default taken from
(setq method (or method org-attach-method))
(let ((basename (file-name-nondirectory file)))
(let* ((attach-dir (org-attach-dir 'get-create))
- (fname (expand-file-name basename attach-dir)))
+ (attach-file (expand-file-name basename attach-dir)))
(cond
- ((eq method 'mv) (rename-file file fname))
- ((eq method 'cp) (copy-file file fname))
- ((eq method 'ln) (add-name-to-file file fname))
- ((eq method 'lns) (make-symbolic-link file fname))
- ((eq method 'url) (url-copy-file file fname)))
+ ((eq method 'mv) (rename-file file attach-file))
+ ((eq method 'cp) (copy-file file attach-file))
+ ((eq method 'ln) (add-name-to-file file attach-file))
+ ((eq method 'lns) (make-symbolic-link file attach-file))
+ ((eq method 'url) (url-copy-file file attach-file)))
(run-hook-with-args 'org-attach-after-change-hook attach-dir)
(org-attach-tag)
(cond ((eq org-attach-store-link-p 'attached)
- (org-attach-store-link fname))
+ (push (list (concat "attachment:" (file-name-nondirectory attach-file))
+ (file-name-nondirectory attach-file))
+ org-stored-links))
((eq org-attach-store-link-p t)
- (org-attach-store-link file)))
+ (push (list (concat "file:" file)
+ (file-name-nondirectory file))
+ org-stored-links))
+ ((eq org-attach-store-link-p 'file)
+ (push (list (concat "file:" attach-file)
+ (file-name-nondirectory attach-file))
+ org-stored-links)))
(if visit-dir
(dired attach-dir)
- (message "File %S is now an attachment." basename)))))
+ (message "File %S is now an attachment" basename)))))
(defun org-attach-attach-cp ()
"Attach a file by copying it."
@@ -569,13 +573,18 @@ The attachment is created as an Emacs buffer."
(defun org-attach-delete-all (&optional force)
"Delete all attachments from the current outline node.
This actually deletes the entire attachment directory.
-A safer way is to open the directory in dired and delete from there."
+A safer way is to open the directory in dired and delete from there.
+
+With prefix argument FORCE, directory will be recursively deleted
+with no prompts."
(interactive "P")
(let ((attach-dir (org-attach-dir)))
(when (and attach-dir
(or force
(yes-or-no-p "Really remove all attachments of this entry? ")))
- (delete-directory attach-dir (yes-or-no-p "Recursive?") t)
+ (delete-directory attach-dir
+ (or force (yes-or-no-p "Recursive?"))
+ t)
(message "Attachment directory removed")
(run-hook-with-args 'org-attach-after-change-hook attach-dir)
(org-attach-untag))))
@@ -642,37 +651,37 @@ See `org-attach-open'."
Basically, this adds the path to the attachment directory."
(expand-file-name file (org-attach-dir)))
-(defun org-attach-expand-link (file)
- "Return a file link pointing to the current entry's attachment file FILE.
-Basically, this adds the path to the attachment directory, and a \"file:\"
-prefix."
- (concat "file:" (org-attach-expand file)))
+(defun org-attach-expand-links (_)
+ "Expand links in current buffer.
+It is meant to be added to `org-export-before-parsing-hook'."
+ (save-excursion
+ (while (re-search-forward "attachment:" nil t)
+ (let ((link (org-element-context)))
+ (when (and (eq 'link (org-element-type link))
+ (string-equal "attachment"
+ (org-element-property :type link)))
+ (let* ((description (and (org-element-property :contents-begin link)
+ (buffer-substring-no-properties
+ (org-element-property :contents-begin link)
+ (org-element-property :contents-end link))))
+ (file (org-element-property :path link))
+ (new-link (org-link-make-string
+ (concat "file:" (org-attach-expand file))
+ description)))
+ (goto-char (org-element-property :end link))
+ (skip-chars-backward " \t")
+ (delete-region (org-element-property :begin link) (point))
+ (insert new-link)))))))
+
+(defun org-attach-follow (file arg)
+ "Open FILE attachment.
+See `org-open-file' for details about ARG."
+ (org-link-open-as-file (org-attach-expand file) arg))
(org-link-set-parameters "attachment"
- :follow #'org-attach-open-link
- :export #'org-attach-export-link
+ :follow #'org-attach-follow
:complete #'org-attach-complete-link)
-(defun org-attach-open-link (link &optional in-emacs)
- "Attachment link type LINK is expanded with the attached directory and opened.
-
-With optional prefix argument IN-EMACS, Emacs will visit the file.
-With a double \\[universal-argument] \\[universal-argument] \
-prefix arg, Org tries to avoid opening in Emacs
-and to use an external application to visit the file."
- (interactive "P")
- (let (line search)
- (cond
- ((string-match "::\\([0-9]+\\)\\'" link)
- (setq line (string-to-number (match-string 1 link))
- link (substring link 0 (match-beginning 0))))
- ((string-match "::\\(.+\\)\\'" link)
- (setq search (match-string 1 link)
- link (substring link 0 (match-beginning 0)))))
- (if (string-match "[*?{]" (file-name-nondirectory link))
- (dired (org-attach-expand link))
- (org-open-file (org-attach-expand link) in-emacs line search))))
-
(defun org-attach-complete-link ()
"Advise the user with the available files in the attachment directory."
(let ((attach-dir (org-attach-dir)))
@@ -691,26 +700,6 @@ and to use an external application to visit the file."
(t (concat "attachment:" file))))
(error "No attachment directory exist"))))
-(defun org-attach-export-link (link description format)
- "Translate attachment LINK from Org mode format to exported FORMAT.
-Also includes the DESCRIPTION of the link in the export."
- (save-excursion
- (let (path desc)
- (cond
- ((string-match "::\\([0-9]+\\)\\'" link)
- (setq link (substring link 0 (match-beginning 0))))
- ((string-match "::\\(.+\\)\\'" link)
- (setq link (substring link 0 (match-beginning 0)))))
- (setq path (file-relative-name (org-attach-expand link))
- desc (or description link))
- (pcase format
- (`html (format "<a target=\"_blank\" href=\"%s\">%s</a>" path desc))
- (`latex (format "\\href{%s}{%s}" path desc))
- (`texinfo (format "@uref{%s,%s}" path desc))
- (`ascii (format "%s (%s)" desc path))
- (`md (format "[%s](%s)" desc path))
- (_ path)))))
-
(defun org-attach-archive-delete-maybe ()
"Maybe delete subtree attachments when archiving.
This function is called by `org-archive-hook'. The option
@@ -758,6 +747,7 @@ Idea taken from `gnus-dired-attach'."
(add-hook 'org-archive-hook 'org-attach-archive-delete-maybe)
+(add-hook 'org-export-before-parsing-hook 'org-attach-expand-links)
(provide 'org-attach)
diff --git a/lisp/org/org-capture.el b/lisp/org/org-capture.el
index ace51270175..f40f2b335ef 100644
--- a/lisp/org/org-capture.el
+++ b/lisp/org/org-capture.el
@@ -1,6 +1,6 @@
;;; org-capture.el --- Fast note taking in Org -*- lexical-binding: t; -*-
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -49,11 +49,13 @@
(require 'cl-lib)
(require 'org)
+(require 'org-refile)
(declare-function org-at-encrypted-entry-p "org-crypt" ())
(declare-function org-at-table-p "org-table" (&optional table-type))
(declare-function org-clock-update-mode-line "org-clock" (&optional refresh))
(declare-function org-datetree-find-date-create "org-datetree" (date &optional keep-restriction))
+(declare-function org-datetree-find-month-create (d &optional keep-restriction))
(declare-function org-decrypt-entry "org-crypt" ())
(declare-function org-element-at-point "org-element" ())
(declare-function org-element-lineage "org-element" (datum &optional types with-self))
@@ -68,6 +70,7 @@
(defvar dired-buffers)
(defvar org-end-time-was-given)
+(defvar org-keyword-properties)
(defvar org-remember-default-headline)
(defvar org-remember-templates)
(defvar org-store-link-plist)
@@ -156,14 +159,20 @@ description A short string describing the template, will be shown during
type The type of entry. Valid types are:
entry an Org node, with a headline. Will be filed
as the child of the target entry or as a
- top-level entry.
+ top-level entry. Its default template is:
+ \"* %?\n %a\"
item a plain list item, will be placed in the
- first plain list at the target
- location.
+ first plain list at the target location.
+ Its default template is:
+ \"- %?\"
checkitem a checkbox item. This differs from the
plain list item only in so far as it uses a
- different default template.
+ different default template. Its default
+ template is:
+ \"- [ ] %?\"
table-line a new line in the first table at target location.
+ Its default template is:
+ \"| %? |\"
plain text to be inserted as it is.
target Specification of where the captured item should be placed.
@@ -211,9 +220,10 @@ target Specification of where the captured item should be placed.
Most general way: write your own function which both visits
the file and moves point to the right location
-template The template for creating the capture item. If you leave this
- empty, an appropriate default template will be used. See below
- for more details. Instead of a string, this may also be one of
+template The template for creating the capture item.
+ If it is an empty string or nil, a default template based on
+ the entry type will be used (see the \"type\" section above).
+ Instead of a string, this may also be one of:
(file \"/path/to/template-file\")
(function function-returning-the-template)
@@ -236,15 +246,15 @@ properties are:
:jump-to-captured When set, jump to the captured entry when finished.
- :empty-lines Set this to the number of lines the should be inserted
+ :empty-lines Set this to the number of lines that should be inserted
before and after the new item. Default 0, only common
other value is 1.
- :empty-lines-before Set this to the number of lines the should be inserted
+ :empty-lines-before Set this to the number of lines that should be inserted
before the new item. Overrides :empty-lines for the
number lines inserted before.
- :empty-lines-after Set this to the number of lines the should be inserted
+ :empty-lines-after Set this to the number of lines that should be inserted
after the new item. Overrides :empty-lines for the
number of lines inserted after.
@@ -260,7 +270,9 @@ properties are:
:time-prompt Prompt for a date/time to be used for date/week trees
and when filling the template.
- :tree-type When `week', make a week tree instead of the month tree.
+ :tree-type When `week', make a week tree instead of the month-day
+ tree. When `month', make a month tree instead of the
+ month-day tree.
:unnarrowed Do not narrow the target buffer, simply show the
full buffer. Default is to narrow it so that you
@@ -322,7 +334,7 @@ be replaced with content and expanded:
%^L Like %^C, but insert as link.
%^{prop}p Prompt the user for a value for property `prop'.
%^{prompt} Prompt the user for a string and replace this sequence with it.
- A default value and a completion table ca be specified like this:
+ A default value and a completion table can be specified like this:
%^{prompt|default|completion2|completion3|...}.
%? After completing the template, position cursor here.
%\\1 ... %\\N Insert the text entered at the nth %^{prompt}, where N
@@ -625,7 +637,7 @@ of the day at point (if any) or the current HH:MM time."
(setq org-overriding-default-time
(org-get-cursor-date (equal goto 1))))
(cond
- ((equal goto '(4)) (org-capture-goto-target))
+ ((equal goto '(4)) (org-capture-goto-target keys))
((equal goto '(16)) (org-capture-goto-last-stored))
(t
(let* ((orig-buf (current-buffer))
@@ -698,21 +710,19 @@ of the day at point (if any) or the current HH:MM time."
(defun org-capture-get-template ()
"Get the template from a file or a function if necessary."
- (let ((txt (org-capture-get :template)) file)
- (cond
- ((and (listp txt) (eq (car txt) 'file))
- (if (file-exists-p
- (setq file (expand-file-name (nth 1 txt) org-directory)))
- (setq txt (org-file-contents file))
- (setq txt (format "* Template file %s not found" (nth 1 txt)))))
- ((and (listp txt) (eq (car txt) 'function))
- (if (fboundp (nth 1 txt))
- (setq txt (funcall (nth 1 txt)))
- (setq txt (format "* Template function %s not found" (nth 1 txt)))))
- ((not txt) (setq txt ""))
- ((stringp txt))
- (t (setq txt "* Invalid capture template")))
- (org-capture-put :template txt)))
+ (org-capture-put
+ :template
+ (pcase (org-capture-get :template)
+ (`nil "")
+ ((and (pred stringp) template) template)
+ (`(file ,file)
+ (let ((filename (expand-file-name file org-directory)))
+ (if (file-exists-p filename) (org-file-contents filename)
+ (format "* Template file %S not found" file))))
+ (`(function ,f)
+ (if (functionp f) (funcall f)
+ (format "* Template function %S not found" f)))
+ (_ "* Invalid capture template"))))
(defun org-capture-finalize (&optional stay-with-capture)
"Finalize the capture process.
@@ -727,6 +737,11 @@ captured item after finalizing."
(run-hooks 'org-capture-prepare-finalize-hook)
+ ;; Update `org-capture-plist' with the buffer-local value. Since
+ ;; captures can be run concurrently, this is to ensure that
+ ;; `org-capture-after-finalize-hook' accesses the proper plist.
+ (setq org-capture-plist org-capture-current-plist)
+
;; Did we start the clock in this capture buffer?
(when (and org-capture-clock-was-started
org-clock-marker
@@ -996,11 +1011,13 @@ Store them in the capture property list."
(org-capture-put-target-region-and-position)
(widen)
;; Make a date/week tree entry, with the current date (or
- ;; yesterday, if we are extending dates for a couple of hours)
+ ;; yesterday, if we are extending dates for a couple of
+ ;; hours)
(funcall
- (if (eq (org-capture-get :tree-type) 'week)
- #'org-datetree-find-iso-week-create
- #'org-datetree-find-date-create)
+ (pcase (org-capture-get :tree-type)
+ (`week #'org-datetree-find-iso-week-create)
+ (`month #'org-datetree-find-month-create)
+ (_ #'org-datetree-find-date-create))
(calendar-gregorian-from-absolute
(cond
(org-overriding-default-time
@@ -1058,7 +1075,7 @@ Store them in the capture property list."
(org-capture-put-target-region-and-position)
(widen)
(goto-char org-clock-hd-marker))
- (error "No running clock that could be used as capture target")))
+ (user-error "No running clock that could be used as capture target")))
(target (error "Invalid capture target specification: %S" target)))
(org-capture-put :buffer (current-buffer)
@@ -1115,8 +1132,8 @@ may have been stored before."
(`plain (org-capture-place-plain-text))
(`item (org-capture-place-item))
(`checkitem (org-capture-place-item)))
- (org-capture-mode 1)
- (setq-local org-capture-current-plist org-capture-plist))
+ (setq-local org-capture-current-plist org-capture-plist)
+ (org-capture-mode 1))
(defun org-capture-place-entry ()
"Place the template as a new Org entry."
@@ -1129,7 +1146,14 @@ may have been stored before."
(when exact-position (goto-char exact-position))
(cond
;; Force insertion at point.
- ((org-capture-get :insert-here) nil)
+ (insert-here?
+ ;; FIXME: level should probably set directly within (let ...).
+ (setq level (org-get-valid-level
+ (if (or (org-at-heading-p)
+ (ignore-errors
+ (save-excursion (org-back-to-heading t))))
+ (org-outline-level)
+ 1))))
;; Insert as a child of the current entry.
((org-capture-get :target-entry-p)
(setq level (org-get-valid-level
@@ -1150,14 +1174,11 @@ may have been stored before."
(when insert-here? (narrow-to-region beg beg))
(org-paste-subtree level template 'for-yank))
(org-capture-position-for-last-stored beg)
- (let ((end (if (org-at-heading-p) (line-end-position 0) (point))))
- (org-capture-empty-lines-after)
- (unless (org-at-heading-p) (outline-next-heading))
- (org-capture-mark-kill-region origin (point))
- (org-capture-narrow beg end)
- (when (or (search-backward "%?" beg t)
- (search-forward "%?" end t))
- (replace-match "")))))))
+ (org-capture-empty-lines-after)
+ (unless (org-at-heading-p) (outline-next-heading))
+ (org-capture-mark-kill-region origin (point))
+ (org-capture-narrow beg (if (eobp) (point) (1- (point))))
+ (org-capture--position-cursor beg (point))))))
(defun org-capture-place-item ()
"Place the template as a new plain list item."
@@ -1269,9 +1290,7 @@ may have been stored before."
;; not narrow at the beginning of the next line, possibly
;; altering its structure (e.g., when it is a headline).
(org-capture-narrow beg (1- end))
- (when (or (search-backward "%?" beg t)
- (search-forward "%?" end t))
- (replace-match ""))))))
+ (org-capture--position-cursor beg end)))))
(defun org-capture-place-table-line ()
"Place the template as a table line."
@@ -1353,9 +1372,7 @@ may have been stored before."
;; TEXT is guaranteed to end with a newline character. Ignore
;; it when narrowing so as to not alter data on the next line.
(org-capture-narrow beg (1- end))
- (when (or (search-backward "%?" beg t)
- (search-forward "%?" end t))
- (replace-match ""))))))
+ (org-capture--position-cursor beg (1- end))))))
(defun org-capture-place-plain-text ()
"Place the template plainly.
@@ -1390,9 +1407,7 @@ Of course, if exact position has been required, just put it there."
(org-capture-empty-lines-after)
(org-capture-mark-kill-region origin (point))
(org-capture-narrow beg end)
- (when (or (search-backward "%?" beg t)
- (search-forward "%?" end t))
- (replace-match ""))))))
+ (org-capture--position-cursor beg end)))))
(defun org-capture-mark-kill-region (beg end)
"Mark the region that will have to be killed when aborting capture."
@@ -1438,8 +1453,15 @@ Of course, if exact position has been required, just put it there."
(defun org-capture-narrow (beg end)
"Narrow, unless configuration says not to narrow."
(unless (org-capture-get :unnarrowed)
- (narrow-to-region beg end)
- (goto-char beg)))
+ (narrow-to-region beg end)))
+
+(defun org-capture--position-cursor (beg end)
+ "Move point to first \"%?\" location or at start of template.
+BEG and END are buffer positions at the beginning and end position
+of the template."
+ (goto-char beg)
+ (when (search-forward "%?" end t)
+ (replace-match "")))
(defun org-capture-empty-lines-before (&optional n)
"Set the correct number of empty lines before the insertion point.
@@ -1736,11 +1758,11 @@ The template may still contain \"%?\" for cursor positioning."
(_ (error "Invalid `org-capture--clipboards' value: %S"
org-capture--clipboards)))))
("p"
- ;; We remove file properties inherited from
+ ;; We remove keyword properties inherited from
;; target buffer so `org-read-property-value' has
;; a chance to find allowed values in sub-trees
;; from the target buffer.
- (setq-local org-file-properties nil)
+ (setq-local org-keyword-properties nil)
(let* ((origin (set-marker (make-marker)
(org-capture-get :pos)
(org-capture-get :buffer)))
diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el
index 06df2d49719..2073b33380b 100644
--- a/lisp/org/org-clock.el
+++ b/lisp/org/org-clock.el
@@ -1,6 +1,6 @@
;;; org-clock.el --- The time clocking code for Org mode -*- lexical-binding: t; -*-
-;; Copyright (C) 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -35,11 +35,17 @@
(declare-function notifications-notify "notifications" (&rest params))
(declare-function org-element-property "org-element" (property element))
(declare-function org-element-type "org-element" (element))
+(declare-function org-inlinetask-at-task-p "org-inlinetask" ())
+(declare-function org-inlinetask-goto-beginning "org-inlinetask" ())
+(declare-function org-inlinetask-goto-end "org-inlinetask" ())
+(declare-function org-inlinetask-in-task-p "org-inlinetask" ())
(declare-function org-link-display-format "ol" (s))
(declare-function org-link-heading-search-string "ol" (&optional string))
(declare-function org-link-make-string "ol" (link &optional description))
(declare-function org-table-goto-line "org-table" (n))
(declare-function org-dynamic-block-define "org" (type func))
+(declare-function w32-notification-notify "w32fns.c" (&rest params))
+(declare-function w32-notification-close "w32fns.c" (&rest params))
(defvar org-frame-title-format-backup nil)
(defvar org-state)
@@ -273,6 +279,15 @@ also using the face `org-mode-line-clock-overrun'."
(const :tag "Just mark the time string" nil)
(string :tag "Text to prepend")))
+(defcustom org-show-notification-timeout 3
+ "Number of seconds to wait before closing Org notifications.
+This is applied to notifications sent with `notifications-notify'
+and `w32-notification-notify' only, not other mechanisms possibly
+set through `org-show-notification-handler'."
+ :group 'org-clock
+ :package-version '(Org . "9.4")
+ :type 'integer)
+
(defcustom org-show-notification-handler nil
"Function or program to send notification with.
The function or program will be called with the notification
@@ -457,6 +472,19 @@ Valid values are: `today', `yesterday', `thisweek', `lastweek',
(const :tag "Select range interactively" interactive))
:safe #'symbolp)
+(defcustom org-clock-auto-clockout-timer nil
+ "Timer for auto clocking out when Emacs is idle.
+When set to a number, auto clock out the currently clocked in
+task after this number of seconds of idle time.
+
+This is only effective when `org-clock-auto-clockout-insinuate'
+is added to the user configuration."
+ :group 'org-clock
+ :package-version '(Org . "9.4")
+ :type '(choice
+ (integer :tag "Clock out after Emacs is idle for X seconds")
+ (const :tag "Never auto clock out" nil)))
+
(defvar org-clock-in-prepare-hook nil
"Hook run when preparing the clock.
This hook is run before anything happens to the task that
@@ -698,7 +726,8 @@ If not, show simply the clocked time like 01:50."
(save-excursion
(let ((end (save-excursion (org-end-of-subtree))))
(when (re-search-forward (concat org-clock-string
- ".*\\]--\\(\\[[^]]+\\]\\)") end t)
+ ".*\\]--\\(\\[[^]]+\\]\\)")
+ end t)
(org-time-string-to-time (match-string 1))))))
(defun org-clock-update-mode-line (&optional refresh)
@@ -725,7 +754,8 @@ menu\nmouse-2 will jump to task"))
(setq org-mode-line-string
(concat (propertize
org-clock-task-overrun-text
- 'face 'org-mode-line-clock-overrun) org-mode-line-string)))
+ 'face 'org-mode-line-clock-overrun)
+ org-mode-line-string)))
(force-mode-line-update))
(defun org-clock-get-clocked-time ()
@@ -808,15 +838,26 @@ If PLAY-SOUND is non-nil, it overrides `org-clock-sound'."
"Show notification.
Use `org-show-notification-handler' if defined,
use libnotify if available, or fall back on a message."
+ (ignore-errors (require 'notifications))
(cond ((functionp org-show-notification-handler)
(funcall org-show-notification-handler notification))
((stringp org-show-notification-handler)
(start-process "emacs-timer-notification" nil
org-show-notification-handler notification))
+ ((fboundp 'w32-notification-notify)
+ (let ((id (w32-notification-notify
+ :title "Org mode message"
+ :body notification
+ :urgency 'low)))
+ (run-with-timer
+ org-show-notification-timeout
+ nil
+ (lambda () (w32-notification-close id)))))
((fboundp 'notifications-notify)
(notifications-notify
:title "Org mode message"
:body notification
+ :timeout (* org-show-notification-timeout 1000)
;; FIXME how to link to the Org icon?
;; :app-icon "~/.emacs.d/icons/mail.png"
:urgency 'low))
@@ -859,7 +900,8 @@ If CLOCK-SOUND is non-nil, it overrides `org-clock-sound'."
(goto-char (point-min))
(while (re-search-forward org-clock-re nil t)
(push (cons (copy-marker (match-end 1) t)
- (org-time-string-to-time (match-string 1))) clocks))))
+ (org-time-string-to-time (match-string 1)))
+ clocks))))
clocks))
(defsubst org-is-active-clock (clock)
@@ -983,7 +1025,7 @@ CLOCK is a cons cell of the form (MARKER START-TIME)."
(let ((element (org-element-at-point)))
(when (eq (org-element-type element) 'drawer)
(when (> (org-element-property :end element) (car clock))
- (org-flag-drawer nil element))
+ (org-hide-drawer-toggle 'off nil element))
(throw 'exit nil)))))))))))
(defun org-clock-resolve (clock &optional prompt-fn last-valid fail-quietly)
@@ -1022,6 +1064,9 @@ k/K Keep X minutes of the idle time (default is all). If this
that many minutes after the time that idling began, and then
clocked back in at the present time.
+t/T Like `k', but will ask you to specify a time (when you got
+ distracted away), instead of a number of minutes.
+
g/G Indicate that you \"got back\" X minutes ago. This is quite
different from `k': it clocks you out from the beginning of
the idle period and clock you back in X minutes ago.
@@ -1041,19 +1086,24 @@ to be CLOCKED OUT."))))
(while (or (null char-pressed)
(and (not (memq char-pressed
'(?k ?K ?g ?G ?s ?S ?C
- ?j ?J ?i ?q)))
+ ?j ?J ?i ?q ?t ?T)))
(or (ding) t)))
(setq char-pressed
(read-char (concat (funcall prompt-fn clock)
- " [jkKgGSscCiq]? ")
+ " [jkKtTgGSscCiq]? ")
nil 45)))
(and (not (memq char-pressed '(?i ?q))) char-pressed)))))
(default
(floor (org-time-convert-to-integer (org-time-since last-valid))
60))
(keep
- (and (memq ch '(?k ?K))
- (read-number "Keep how many minutes? " default)))
+ (or (and (memq ch '(?k ?K))
+ (read-number "Keep how many minutes? " default))
+ (and (memq ch '(?t ?T))
+ (floor
+ (/ (float-time
+ (org-time-subtract (org-read-date t t) last-valid))
+ 60)))))
(gotback
(and (memq ch '(?g ?G))
(read-number "Got back how many minutes ago? " default)))
@@ -1068,7 +1118,7 @@ to be CLOCKED OUT."))))
(org-clock-resolve-clock clock 'now nil t nil fail-quietly))
(org-clock-jump-to-current-clock clock))
((or (null ch)
- (not (memq ch '(?k ?K ?g ?G ?s ?S ?C))))
+ (not (memq ch '(?k ?K ?g ?G ?s ?S ?C ?t ?T))))
(message ""))
(t
(org-clock-resolve-clock
@@ -1092,7 +1142,7 @@ to be CLOCKED OUT."))))
(t
(error "Unexpected, please report this as a bug")))
(and gotback last-valid)
- (memq ch '(?K ?G ?S))
+ (memq ch '(?K ?G ?S ?T))
(and start-over
(not (memq ch '(?K ?G ?S ?C))))
fail-quietly)))))
@@ -1315,7 +1365,6 @@ the default behavior."
(t
(insert-before-markers "\n")
(backward-char 1)
- (org-indent-line)
(when (and (save-excursion
(end-of-line 0)
(org-in-item-p)))
@@ -1340,7 +1389,8 @@ the default behavior."
start-time
(org-current-time org-clock-rounding-minutes t)))
(setq ts (org-insert-time-stamp org-clock-start-time
- 'with-hm 'inactive))))
+ 'with-hm 'inactive))
+ (org-indent-line)))
(move-marker org-clock-marker (point) (buffer-base-buffer))
(move-marker org-clock-hd-marker
(save-excursion (org-back-to-heading t) (point))
@@ -1375,6 +1425,26 @@ the default behavior."
(message "Clock starts at %s - %s" ts org--msg-extra)
(run-hooks 'org-clock-in-hook))))))
+(defun org-clock-auto-clockout ()
+ "Clock out the currently clocked in task if Emacs is idle.
+See `org-clock-auto-clockout-timer' to set the idle time span.
+
+This is only effective when `org-clock-auto-clockout-insinuate'
+is present in the user configuration."
+ (when (and (numberp org-clock-auto-clockout-timer)
+ org-clock-current-task)
+ (run-with-idle-timer
+ org-clock-auto-clockout-timer nil #'org-clock-out)))
+
+;;;###autoload
+(defun org-clock-toggle-auto-clockout ()
+ (interactive)
+ (if (memq 'org-clock-auto-clockout org-clock-in-hook)
+ (progn (remove-hook 'org-clock-in-hook #'org-clock-auto-clockout)
+ (message "Auto clock-out after idle time turned off"))
+ (add-hook 'org-clock-in-hook #'org-clock-auto-clockout t)
+ (message "Auto clock-out after idle time turned on")))
+
;;;###autoload
(defun org-clock-in-last (&optional arg)
"Clock in the last closed clocked item.
@@ -1512,7 +1582,7 @@ line and position cursor in that line."
(insert ":" drawer ":\n:END:\n")
(org-indent-region beg (point))
(org-flag-region
- (line-end-position -1) (1- (point)) t 'org-hide-drawer)
+ (line-end-position -1) (1- (point)) t 'outline)
(forward-line -1))))
;; When a clock drawer needs to be created because of the
;; number of clock items or simply if it is missing, collect
@@ -1537,7 +1607,7 @@ line and position cursor in that line."
(let ((end (point-marker)))
(goto-char beg)
(save-excursion (insert ":" drawer ":\n"))
- (org-flag-region (line-end-position) (1- end) t 'org-hide-drawer)
+ (org-flag-region (line-end-position) (1- end) t 'outline)
(org-indent-region (point) end)
(forward-line)
(unless org-log-states-order-reversed
@@ -1579,7 +1649,7 @@ to, overriding the existing value of `org-clock-out-switch-to-state'."
org-clock-out-switch-to-state))
(now (org-current-time org-clock-rounding-minutes))
ts te s h m remove)
- (setq org-clock-out-time now)
+ (setq org-clock-out-time (or at-time now))
(save-excursion ; Do not replace this with `with-current-buffer'.
(with-no-warnings (set-buffer (org-clocking-buffer)))
(save-restriction
@@ -1724,7 +1794,7 @@ Optional argument N tells to change by that many units."
(delq 'org-mode-line-string global-mode-string))
(org-clock-restore-frame-title-format)
(force-mode-line-update)
- (error "No active clock"))
+ (user-error "No active clock"))
(save-excursion ; Do not replace this with `with-current-buffer'.
(with-no-warnings (set-buffer (org-clocking-buffer)))
(goto-char org-clock-marker)
@@ -1753,14 +1823,14 @@ With prefix arg SELECT, offer recently clocked tasks for selection."
(m (cond
(select
(or (org-clock-select-task "Select task to go to: ")
- (error "No task selected")))
+ (user-error "No task selected")))
((org-clocking-p) org-clock-marker)
((and org-clock-goto-may-find-recent-task
(car org-clock-history)
(marker-buffer (car org-clock-history)))
(setq recent t)
(car org-clock-history))
- (t (error "No active or recent clock task")))))
+ (t (user-error "No active or recent clock task")))))
(pop-to-buffer-same-window (marker-buffer m))
(if (or (< m (point-min)) (> m (point-max))) (widen))
(goto-char m)
@@ -1890,7 +1960,12 @@ PROPNAME lets you set a custom text property instead of :org-clock-minutes."
"Return time, clocked on current item in total."
(save-excursion
(save-restriction
- (org-narrow-to-subtree)
+ (if (and (featurep 'org-inlinetask)
+ (or (org-inlinetask-at-task-p)
+ (org-inlinetask-in-task-p)))
+ (narrow-to-region (save-excursion (org-inlinetask-goto-beginning) (point))
+ (save-excursion (org-inlinetask-goto-end) (point)))
+ (org-narrow-to-subtree))
(org-clock-sum tstart)
org-clock-file-total-minutes)))
@@ -2067,7 +2142,10 @@ in the buffer and update it."
(start (goto-char start)))
(org-update-dblock))
-(org-dynamic-block-define "clocktable" #'org-clock-report)
+;;;###autoload
+(eval-after-load 'org
+ '(progn
+ (org-dynamic-block-define "clocktable" #'org-clock-report)))
(defun org-day-of-week (day month year)
"Return the day of the week as an integer."
@@ -2310,7 +2388,7 @@ the currently selected interval size."
(save-excursion
(goto-char (point-at-bol))
(if (not (looking-at "^[ \t]*#\\+BEGIN:[ \t]+clocktable\\>.*?:block[ \t]+\\(\\S-+\\)"))
- (error "Line needs a :block definition before this command works")
+ (user-error "Line needs a :block definition before this command works")
(let* ((b (match-beginning 1)) (e (match-end 1))
(s (match-string 1))
block shift ins y mw d date wp m)
@@ -2369,7 +2447,7 @@ the currently selected interval size."
(encode-time 0 0 0 1 (+ mw n) y))))
(y
(setq ins (number-to-string (+ y n))))))
- (t (error "Cannot shift clocktable block")))
+ (t (user-error "Cannot shift clocktable block")))
(when ins
(goto-char b)
(insert ins)
@@ -2384,20 +2462,21 @@ the currently selected interval size."
(setq params (org-combine-plists org-clocktable-defaults params))
(catch 'exit
(let* ((scope (plist-get params :scope))
+ (base-buffer (org-base-buffer (current-buffer)))
(files (pcase scope
(`agenda
(org-agenda-files t))
(`agenda-with-archives
(org-add-archive-files (org-agenda-files t)))
(`file-with-archives
- (and buffer-file-name
- (org-add-archive-files (list buffer-file-name))))
+ (let ((base-file (buffer-file-name base-buffer)))
+ (and base-file
+ (org-add-archive-files (list base-file)))))
((or `nil `file `subtree `tree
(and (pred symbolp)
(guard (string-match "\\`tree\\([0-9]+\\)\\'"
(symbol-name scope)))))
- (or (buffer-file-name (buffer-base-buffer))
- (current-buffer)))
+ base-buffer)
((pred functionp) (funcall scope))
((pred consp) scope)
(_ (user-error "Unknown scope: %S" scope))))
@@ -2421,7 +2500,7 @@ the currently selected interval size."
(when step
;; Write many tables, in steps
(unless (or block (and ts te))
- (error "Clocktable `:step' can only be used with `:block' or `:tstart,:end'"))
+ (user-error "Clocktable `:step' can only be used with `:block' or `:tstart, :end'"))
(org-clocktable-steps params)
(throw 'exit nil))
@@ -2527,7 +2606,7 @@ from the dynamic block definition."
(guard (string-match-p "\\`[0-9]+!\\'" (symbol-name narrow))))
(setq narrow-cut-p t)
(setq narrow (string-to-number (symbol-name narrow))))
- (_ (error "Invalid value %s of :narrow property in clock table" narrow)))
+ (_ (user-error "Invalid value %s of :narrow property in clock table" narrow)))
;; Now we need to output this table stuff.
(goto-char ipos)
@@ -2718,6 +2797,7 @@ a number of clock tables."
(pcase step
(`day "Daily report: ")
(`week "Weekly report starting on: ")
+ (`semimonth "Semimonthly report starting on: ")
(`month "Monthly report starting on: ")
(`year "Annual report starting on: ")
(_ (user-error "Unknown `:step' specification: %S" step))))
@@ -2767,6 +2847,9 @@ a number of clock tables."
(let ((offset (if (= dow week-start) 7
(mod (- week-start dow) 7))))
(list 0 0 org-extend-today-until (+ d offset) m y)))
+ (`semimonth (list 0 0 0
+ (if (< d 16) 16 1)
+ (if (< d 16) m (1+ m)) y))
(`month (list 0 0 0 month-start (1+ m) y))
(`year (list 0 0 org-extend-today-until 1 1 (1+ y)))))))
(table-begin (line-beginning-position 0))
@@ -2883,7 +2966,7 @@ PROPERTIES: The list properties specified in the `:properties' parameter
(org-trim
(org-link-display-format
(replace-regexp-in-string
- "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" ""
+ "\\[[0-9]*\\(?:%\\|/[0-9]*\\)\\]" ""
headline)))))))
(tgs (and tags (org-get-tags)))
(tsp
diff --git a/lisp/org/org-colview.el b/lisp/org/org-colview.el
index e967154abbc..75056d45a7e 100644
--- a/lisp/org/org-colview.el
+++ b/lisp/org/org-colview.el
@@ -1,6 +1,6 @@
;;; org-colview.el --- Column View in Org -*- lexical-binding: t; -*-
-;; Copyright (C) 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -44,6 +44,8 @@
(declare-function org-dynamic-block-define "org" (type func))
(declare-function org-link-display-format "ol" (s))
(declare-function org-link-open-from-string "ol" (s &optional arg))
+(declare-function face-remap-remove-relative "face-remap" (cookie))
+(declare-function face-remap-add-relative "face-remap" (face &rest specs))
(defvar org-agenda-columns-add-appointments-to-effort-sum)
(defvar org-agenda-columns-compute-summary-properties)
@@ -164,7 +166,7 @@ See `org-columns-summary-types' for details.")
(org-defkey org-columns-map "o" 'org-overview)
(org-defkey org-columns-map "e" 'org-columns-edit-value)
(org-defkey org-columns-map "\C-c\C-t" 'org-columns-todo)
-(org-defkey org-columns-map "\C-c\C-c" 'org-columns-set-tags-or-toggle)
+(org-defkey org-columns-map "\C-c\C-c" 'org-columns-toggle-or-columns-quit)
(org-defkey org-columns-map "\C-c\C-o" 'org-columns-open-link)
(org-defkey org-columns-map "v" 'org-columns-show-value)
(org-defkey org-columns-map "q" 'org-columns-quit)
@@ -257,6 +259,8 @@ value for ITEM property."
(if org-hide-leading-stars ?\s ?*))
"* "))))
(concat stars (org-link-display-format value))))
+ (`(,(or "DEADLINE" "SCHEDULED" "TIMESTAMP") . ,_)
+ (replace-regexp-in-string org-ts-regexp "[\\1]" value))
(`(,_ ,_ ,_ ,_ nil) value)
;; If PRINTF is set, assume we are displaying a number and
;; obey to the format string.
@@ -364,11 +368,18 @@ ORIGINAL is the real string, i.e., before it is modified by
("TODO" (propertize v 'face (org-get-todo-face original)))
(_ v)))))
+(defvar org-columns-header-line-remap nil
+ "Store the relative remapping of column header-line.
+This is needed to later remove this relative remapping.")
+
(defun org-columns--display-here (columns &optional dateline)
"Overlay the current line with column display.
COLUMNS is an alist (SPEC VALUE DISPLAYED). Optional argument
DATELINE is non-nil when the face used should be
`org-agenda-column-dateline'."
+ (when (ignore-errors (require 'face-remap))
+ (setq org-columns-header-line-remap
+ (face-remap-add-relative 'header-line '(:inherit default))))
(save-excursion
(beginning-of-line)
(let* ((level-face (and (looking-at "\\(\\**\\)\\(\\* \\)")
@@ -378,8 +389,7 @@ DATELINE is non-nil when the face used should be
(org-get-at-bol 'face))
'default))
(color (list :foreground (face-attribute ref-face :foreground)))
- (font (list :height (face-attribute 'default :height)
- :family (face-attribute 'default :family)))
+ (font (list :family (face-attribute 'default :family)))
(face (list color font 'org-column ref-face))
(face1 (list color font 'org-agenda-column-dateline ref-face)))
;; Each column is an overlay on top of a character. So there has
@@ -502,6 +512,9 @@ for the duration of the command.")
(defun org-columns-remove-overlays ()
"Remove all currently active column overlays."
(interactive)
+ (when (and (fboundp 'face-remap-remove-relative)
+ org-columns-header-line-remap)
+ (face-remap-remove-relative org-columns-header-line-remap))
(when org-columns-overlays
(when (local-variable-p 'org-previous-header-line-format)
(setq header-line-format org-previous-header-line-format)
@@ -554,13 +567,19 @@ for the duration of the command.")
(interactive "P")
(org-columns-edit-value "TODO"))
-(defun org-columns-set-tags-or-toggle (&optional _arg)
- "Toggle checkbox at point, or set tags for current headline."
- (interactive "P")
- (if (string-match "\\`\\[[ xX-]\\]\\'"
- (get-char-property (point) 'org-columns-value))
- (org-columns-next-allowed-value)
- (org-columns-edit-value "TAGS")))
+(defun org-columns-toggle-or-columns-quit ()
+ "Toggle checkbox at point, or quit column view."
+ (interactive)
+ (or (org-columns--toggle)
+ (org-columns-quit)))
+
+(defun org-columns--toggle ()
+ "Toggle checkbox at point. Return non-nil if toggle happened, else nil.
+See info documentation about realizing a suitable checkbox."
+ (when (string-match "\\`\\[[ xX-]\\]\\'"
+ (get-char-property (point) 'org-columns-value))
+ (org-columns-next-allowed-value)
+ t))
(defvar org-overriding-columns-format nil
"When set, overrides any other format definition for the agenda.
@@ -1550,7 +1569,10 @@ PARAMS is a property list of parameters:
(id)))))
(org-update-dblock))
-(org-dynamic-block-define "columnview" #'org-columns-insert-dblock)
+;;;###autoload
+(eval-after-load 'org
+ '(progn
+ (org-dynamic-block-define "columnview" #'org-columns-insert-dblock)))
;;; Column view in the agenda
@@ -1564,6 +1586,7 @@ PARAMS is a property list of parameters:
(move-marker org-columns-begin-marker (point))
(setq org-columns-begin-marker (point-marker)))
(let* ((org-columns--time (float-time))
+ (org-done-keywords org-done-keywords-for-agenda)
(fmt
(cond
((bound-and-true-p org-overriding-columns-format))
@@ -1613,6 +1636,7 @@ PARAMS is a property list of parameters:
(dolist (entry cache)
(goto-char (car entry))
(org-columns--display-here (cdr entry)))
+ (setq-local org-agenda-columns-active t)
(when org-agenda-columns-show-summaries
(org-agenda-colview-summarize cache)))))))
@@ -1677,8 +1701,7 @@ This will add overlays to the date lines, to show the summary for each day."
'face 'bold final))
(list spec final final)))))
fmt)
- 'dateline)
- (setq-local org-agenda-columns-active t))))
+ 'dateline))))
(if (bobp) (throw :complete t) (forward-line -1)))))))
(defun org-agenda-colview-compute (fmt)
@@ -1704,4 +1727,8 @@ This will add overlays to the date lines, to show the summary for each day."
(provide 'org-colview)
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
;;; org-colview.el ends here
diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el
index c1aaf17ca2b..1f4e2e8308f 100644
--- a/lisp/org/org-compat.el
+++ b/lisp/org/org-compat.el
@@ -1,6 +1,6 @@
;;; org-compat.el --- Compatibility Code for Older Emacsen -*- lexical-binding: t; -*-
-;; Copyright (C) 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -34,7 +34,9 @@
(declare-function org-agenda-diary-entry "org-agenda")
(declare-function org-agenda-maybe-redo "org-agenda" ())
+(declare-function org-agenda-set-restriction-lock "org-agenda" (&optional type))
(declare-function org-agenda-remove-restriction-lock "org-agenda" (&optional noupdate))
+(declare-function org-calendar-goto-agenda "org-agenda" ())
(declare-function org-align-tags "org" (&optional all))
(declare-function org-at-heading-p "org" (&optional ignored))
(declare-function org-at-table.el-p "org" ())
@@ -46,11 +48,13 @@
(declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading))
(declare-function org-get-heading "org" (&optional no-tags no-todo no-priority no-comment))
(declare-function org-get-tags "org" (&optional pos local))
+(declare-function org-hide-block-toggle "org" (&optional force no-error element))
(declare-function org-link-display-format "ol" (s))
(declare-function org-link-set-parameters "ol" (type &rest rest))
(declare-function org-log-into-drawer "org" ())
(declare-function org-make-tag-string "org" (tags))
(declare-function org-reduced-level "org" (l))
+(declare-function org-return "org" (&optional indent arg interactive))
(declare-function org-show-context "org" (&optional key))
(declare-function org-table-end "org-table" (&optional table-type))
(declare-function outline-next-heading "outline" ())
@@ -101,6 +105,20 @@ is nil)."
(defun org-time-convert-to-list (time)
(seconds-to-time (float-time time))))
+;; `newline-and-indent' did not take a numeric argument before 27.1.
+(if (version< emacs-version "27")
+ (defsubst org-newline-and-indent (&optional _arg)
+ (newline-and-indent))
+ (defalias 'org-newline-and-indent #'newline-and-indent))
+
+(defun org--set-faces-extend (faces extend-p)
+ "Set the :extend attribute of FACES to EXTEND-P.
+
+This is a no-op for Emacs versions lower than 27, since face
+extension beyond end of line was not controllable."
+ (when (fboundp 'set-face-extend)
+ (mapc (lambda (f) (set-face-extend f extend-p)) faces)))
+
;;; Emacs < 26.1 compatibility
@@ -314,6 +332,8 @@ Counting starts at 1."
(define-obsolete-variable-alias 'org-attach-directory
'org-attach-id-dir "Org 9.3")
+(make-obsolete 'org-attach-store-link "No longer used" "Org 9.4")
+(make-obsolete 'org-attach-expand-link "No longer used" "Org 9.4")
(defun org-in-fixed-width-region-p ()
"Non-nil if point in a fixed-width region."
@@ -556,6 +576,11 @@ use of this function is for the stuck project list."
(define-obsolete-function-alias 'org-make-link-regexps
'org-link-make-regexps "Org 9.3")
+(define-obsolete-function-alias 'org-property-global-value
+ 'org-property-global-or-keyword-value "Org 9.3")
+
+(make-obsolete-variable 'org-file-properties 'org-keyword-properties "Org 9.3")
+
(define-obsolete-variable-alias 'org-angle-link-re
'org-link-angle-re "Org 9.3")
@@ -616,6 +641,72 @@ use of this function is for the stuck project list."
(declare (obsolete "use `org-align-tags' instead." "Org 9.2"))
(org-align-tags t))
+(define-obsolete-function-alias
+ 'org-at-property-block-p 'org-at-property-drawer-p "Org 9.4")
+
+(defun org-flag-drawer (flag &optional element beg end)
+ "When FLAG is non-nil, hide the drawer we are at.
+Otherwise make it visible.
+
+When optional argument ELEMENT is a parsed drawer, as returned by
+`org-element-at-point', hide or show that drawer instead.
+
+When buffer positions BEG and END are provided, hide or show that
+region as a drawer without further ado."
+ (declare (obsolete "use `org-hide-drawer-toggle' instead." "Org 9.4"))
+ (if (and beg end) (org-flag-region beg end flag 'outline)
+ (let ((drawer
+ (or element
+ (and (save-excursion
+ (beginning-of-line)
+ (looking-at-p "^[ \t]*:\\(\\(?:\\w\\|[-_]\\)+\\):[ \t]*$"))
+ (org-element-at-point)))))
+ (when (memq (org-element-type drawer) '(drawer property-drawer))
+ (let ((post (org-element-property :post-affiliated drawer)))
+ (org-flag-region
+ (save-excursion (goto-char post) (line-end-position))
+ (save-excursion (goto-char (org-element-property :end drawer))
+ (skip-chars-backward " \t\n")
+ (line-end-position))
+ flag 'outline)
+ ;; When the drawer is hidden away, make sure point lies in
+ ;; a visible part of the buffer.
+ (when (invisible-p (max (1- (point)) (point-min)))
+ (goto-char post)))))))
+
+(defun org-hide-block-toggle-maybe ()
+ "Toggle visibility of block at point.
+Unlike to `org-hide-block-toggle', this function does not throw
+an error. Return a non-nil value when toggling is successful."
+ (declare (obsolete "use `org-hide-block-toggle' instead." "Org 9.4"))
+ (interactive)
+ (org-hide-block-toggle nil t))
+
+(defun org-hide-block-toggle-all ()
+ "Toggle the visibility of all blocks in the current buffer."
+ (declare (obsolete "please notify Org mailing list if you use this function."
+ "Org 9.4"))
+ (let ((start (point-min))
+ (end (point-max)))
+ (save-excursion
+ (goto-char start)
+ (while (and (< (point) end)
+ (re-search-forward "^[ \t]*#\\+begin_?\
+\\([^ \n]+\\)\\(\\([^\n]+\\)\\)?\n\\([^\000]+?\\)#\\+end_?\\1[ \t]*$" end t))
+ (save-excursion
+ (save-match-data
+ (goto-char (match-beginning 0))
+ (org-hide-block-toggle)))))))
+
+(defun org-return-indent ()
+ "Goto next table row or insert a newline and indent.
+Calls `org-table-next-row' or `newline-and-indent', depending on
+context. See the individual commands for more information."
+ (declare (obsolete "use `org-return' with INDENT set to t instead."
+ "Org 9.4"))
+ (interactive)
+ (org-return t))
+
(defmacro org-with-silent-modifications (&rest body)
(declare (obsolete "use `with-silent-modifications' instead." "Org 9.2")
(debug (body)))
@@ -624,6 +715,23 @@ use of this function is for the stuck project list."
(define-obsolete-function-alias 'org-babel-strip-quotes
'org-strip-quotes "Org 9.2")
+(define-obsolete-variable-alias 'org-sort-agenda-notime-is-late
+ 'org-agenda-sort-notime-is-late "9.4")
+
+(define-obsolete-variable-alias 'org-sort-agenda-noeffort-is-high
+ 'org-agenda-sort-noeffort-is-high "9.4")
+
+(defconst org-maybe-keyword-time-regexp
+ (concat "\\(\\<\\(\\(?:CLO\\(?:CK\\|SED\\)\\|DEADLINE\\|SCHEDULED\\):\\)\\)?"
+ " *\\([[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^]\r\n>]*[]>]"
+ "\\|"
+ "<%%([^\r\n>]*>\\)")
+ "Matches a timestamp, possibly preceded by a keyword.")
+(make-obsolete-variable
+ 'org-maybe-keyword-time-regexp
+ "use `org-planning-line-re', followed by `org-ts-regexp-both' instead."
+ "Org 9.4")
+
;;;; Obsolete link types
(eval-after-load 'ol
@@ -808,7 +916,7 @@ This also applied for speedbar access."
(setq last-level level)))))
(aref subs 1))))
-(eval-after-load "imenu"
+(eval-after-load 'imenu
'(progn
(add-hook 'imenu-after-jump-hook
(lambda ()
@@ -870,7 +978,7 @@ To get rid of the restriction, use `\\[org-agenda-remove-restriction-lock]'."
(defvar speedbar-file-key-map)
(declare-function speedbar-add-supported-extension "speedbar" (extension))
-(eval-after-load "speedbar"
+(eval-after-load 'speedbar
'(progn
(speedbar-add-supported-extension ".org")
(define-key speedbar-file-key-map "<" 'org-speedbar-set-agenda-restriction)
@@ -980,7 +1088,7 @@ ELEMENT is the element at point."
(flyspell-delete-region-overlays beg end)))
(defvar flyspell-delayed-commands)
-(eval-after-load "flyspell"
+(eval-after-load 'flyspell
'(add-to-list 'flyspell-delayed-commands 'org-self-insert-command))
;;;; Bookmark
@@ -994,7 +1102,7 @@ ELEMENT is the element at point."
(org-show-context 'bookmark-jump)))
;; Make `bookmark-jump' shows the jump location if it was hidden.
-(eval-after-load "bookmark"
+(eval-after-load 'bookmark
'(if (boundp 'bookmark-after-jump-hook)
;; We can use the hook
(add-hook 'bookmark-after-jump-hook 'org-bookmark-jump-unhide)
@@ -1043,17 +1151,18 @@ key."
((guard (not (lookup-key calendar-mode-map "c")))
(local-set-key "c" #'org-calendar-goto-agenda))
(_ nil))
- (unless (eq org-agenda-diary-file 'diary-file)
+ (unless (and (boundp 'org-agenda-diary-file)
+ (eq org-agenda-diary-file 'diary-file))
(local-set-key org-calendar-insert-diary-entry-key
#'org-agenda-diary-entry)))
-(eval-after-load "calendar"
+(eval-after-load 'calendar
'(add-hook 'calendar-mode-hook #'org--setup-calendar-bindings))
;;;; Saveplace
;; Make sure saveplace shows the location if it was hidden
-(eval-after-load "saveplace"
+(eval-after-load 'saveplace
'(defadvice save-place-find-file-hook (after org-make-visible activate)
"Make the position visible."
(org-bookmark-jump-unhide)))
@@ -1061,7 +1170,7 @@ key."
;;;; Ecb
;; Make sure ecb shows the location if it was hidden
-(eval-after-load "ecb"
+(eval-after-load 'ecb
'(defadvice ecb-method-clicked (after esf/org-show-context activate)
"Make hierarchy visible when jumping into location from ECB tree buffer."
(when (derived-mode-p 'org-mode)
@@ -1075,17 +1184,17 @@ key."
(org-invisible-p))
(org-show-context 'mark-goto)))
-(eval-after-load "simple"
+(eval-after-load 'simple
'(defadvice pop-to-mark-command (after org-make-visible activate)
"Make the point visible with `org-show-context'."
(org-mark-jump-unhide)))
-(eval-after-load "simple"
+(eval-after-load 'simple
'(defadvice exchange-point-and-mark (after org-make-visible activate)
"Make the point visible with `org-show-context'."
(org-mark-jump-unhide)))
-(eval-after-load "simple"
+(eval-after-load 'simple
'(defadvice pop-global-mark (after org-make-visible activate)
"Make the point visible with `org-show-context'."
(org-mark-jump-unhide)))
@@ -1094,9 +1203,13 @@ key."
;; Make "session.el" ignore our circular variable.
(defvar session-globals-exclude)
-(eval-after-load "session"
+(eval-after-load 'session
'(add-to-list 'session-globals-exclude 'org-mark-ring))
(provide 'org-compat)
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
;;; org-compat.el ends here
diff --git a/lisp/org/org-crypt.el b/lisp/org/org-crypt.el
index 4b46a3145f4..caf9de91b98 100644
--- a/lisp/org/org-crypt.el
+++ b/lisp/org/org-crypt.el
@@ -1,14 +1,8 @@
;;; org-crypt.el --- Public Key Encryption for Org Entries -*- lexical-binding: t; -*-
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;;
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
-;; Emacs Lisp Archive Entry
-;; Filename: org-crypt.el
-;; Keywords: org-mode
;; Author: John Wiegley <johnw@gnu.org>
-;; Maintainer: Peter Jones <pjones@pmade.com>
-;; Description: Adds public key encryption to Org buffers
-;; URL: http://www.newartisans.com/software/emacs.html
-;; Compatibility: Emacs22
;; This file is part of GNU Emacs.
;;
@@ -47,9 +41,7 @@
;;
;; 3. To later decrypt an entry, use `org-decrypt-entries' or
;; `org-decrypt-entry'. It might be useful to bind this to a key,
-;; like C-c C-/. I hope that in the future, C-c C-r can be might
-;; overloaded to also decrypt an entry if it's encrypted, since
-;; that fits nicely with the meaning of "reveal".
+;; like C-c C-/.
;;
;; 4. To automatically encrypt all necessary entries when saving a
;; file, call `org-crypt-use-before-save-magic' after loading
@@ -60,10 +52,11 @@
;; - Carsten Dominik
;; - Vitaly Ostanin
-(require 'org)
-
;;; Code:
+(require 'org-macs)
+(require 'org-compat)
+
(declare-function epg-decrypt-string "epg" (context cipher))
(declare-function epg-list-keys "epg" (context &optional name mode))
(declare-function epg-make-context "epg"
@@ -74,6 +67,17 @@
(context plain recipients &optional sign always-trust))
(defvar epg-context)
+(declare-function org-back-over-empty-lines "org" ())
+(declare-function org-back-to-heading "org" (&optional invisible-ok))
+(declare-function org-before-first-heading-p "org" ())
+(declare-function org-end-of-meta-data "org" (&optional full))
+(declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading))
+(declare-function org-entry-get "org" (pom property &optional inherit literal-nil))
+(declare-function org-flag-subtree "org" (flag))
+(declare-function org-make-tags-matcher "org" (match))
+(declare-function org-previous-visible-heading "org" (arg))
+(declare-function org-scan-tags "org" (action matcher todo-only &optional start-level))
+(declare-function org-set-property "org" (property value))
(defgroup org-crypt nil
"Org Crypt."
@@ -90,9 +94,18 @@ See the \"Match syntax\" section of the org manual for more details."
(defcustom org-crypt-key ""
"The default key to use when encrypting the contents of a heading.
-This setting can also be overridden in the CRYPTKEY property."
- :type 'string
- :group 'org-crypt)
+If this variable is nil, always use symmetric encryption, unconditionally.
+
+Otherwise, The string is matched against all keys in the key ring.
+In particular, the empty string matches no key. If no key is found,
+look for the `epa-file-encrypt-to' local variable. Ultimately fall back
+to symmetric encryption.
+
+This setting can be overridden in the CRYPTKEY property."
+ :group 'org-crypt
+ :type '(choice
+ (string :tag "Public key(s) matching")
+ (const :tag "Symmetric encryption" nil)))
(defcustom org-crypt-disable-auto-save 'ask
"What org-decrypt should do if `auto-save-mode' is enabled.
@@ -118,6 +131,36 @@ nil : Leave auto-save-mode enabled.
(const :tag "Ask" ask)
(const :tag "Encrypt" encrypt)))
+(defun org-crypt--encrypted-text (beg end)
+ "Return encrypted text in between BEG and END."
+ ;; Ignore indentation.
+ (replace-regexp-in-string
+ "^[ \t]*" ""
+ (buffer-substring-no-properties beg end)))
+
+(defun org-at-encrypted-entry-p ()
+ "Is the current entry encrypted?
+When the entry is encrypted, return a pair (BEG . END) where BEG
+and END are buffer positions delimiting the encrypted area."
+ (org-with-wide-buffer
+ (unless (org-before-first-heading-p)
+ (org-back-to-heading t)
+ (org-end-of-meta-data 'standard)
+ (let ((case-fold-search nil)
+ (banner-start (rx (seq bol
+ (zero-or-more (any "\t "))
+ "-----BEGIN PGP MESSAGE-----"
+ eol))))
+ (when (looking-at banner-start)
+ (let ((start (point))
+ (banner-end (rx (seq bol
+ (or (group (zero-or-more (any "\t "))
+ "-----END PGP MESSAGE-----"
+ eol)
+ (seq (one-or-more "*") " "))))))
+ (when (and (re-search-forward banner-end nil t) (match-string 1))
+ (cons start (line-beginning-position 2)))))))))
+
(defun org-crypt-check-auto-save ()
"Check whether auto-save-mode is enabled for the current buffer.
@@ -149,93 +192,99 @@ See `org-crypt-disable-auto-save'."
(t nil))))
(defun org-crypt-key-for-heading ()
- "Return the encryption key for the current heading."
- (save-excursion
- (org-back-to-heading t)
- (or (org-entry-get nil "CRYPTKEY" 'selective)
- org-crypt-key
- (and (boundp 'epa-file-encrypt-to) epa-file-encrypt-to)
- (message "No crypt key set, using symmetric encryption."))))
-
-(defun org-encrypt-string (str crypt-key)
- "Return STR encrypted with CRYPT-KEY."
- ;; Text and key have to be identical, otherwise we re-crypt.
- (if (and (string= crypt-key (get-text-property 0 'org-crypt-key str))
- (string= (sha1 str) (get-text-property 0 'org-crypt-checksum str)))
- (get-text-property 0 'org-crypt-text str)
- (setq-local epg-context (epg-make-context nil t t))
- (epg-encrypt-string epg-context str (epg-list-keys epg-context crypt-key))))
-
+ "Return the encryption key(s) for the current heading.
+Assume `epg-context' is set."
+ (and org-crypt-key
+ (or (epg-list-keys epg-context
+ (or (org-entry-get nil "CRYPTKEY" 'selective)
+ org-crypt-key))
+ (bound-and-true-p epa-file-encrypt-to)
+ (progn
+ (message "No crypt key set, using symmetric encryption.")
+ nil))))
+
+;;;###autoload
(defun org-encrypt-entry ()
"Encrypt the content of the current headline."
(interactive)
- (require 'epg)
- (org-with-wide-buffer
- (org-back-to-heading t)
- (setq-local epg-context (epg-make-context nil t t))
- (let ((start-heading (point)))
- (org-end-of-meta-data)
- (unless (looking-at-p "-----BEGIN PGP MESSAGE-----")
- (let ((folded (org-invisible-p))
- (crypt-key (org-crypt-key-for-heading))
- (beg (point)))
+ (unless (org-at-encrypted-entry-p)
+ (require 'epg)
+ (setq-local epg-context (epg-make-context nil t t))
+ (org-with-wide-buffer
+ (org-back-to-heading t)
+ (let ((start-heading (point))
+ (crypt-key (org-crypt-key-for-heading))
+ (folded? (org-invisible-p (line-beginning-position))))
+ (org-end-of-meta-data 'standard)
+ (let ((beg (point))
+ (folded-heading
+ (and folded?
+ (save-excursion
+ (org-previous-visible-heading 1)
+ (point)))))
(goto-char start-heading)
(org-end-of-subtree t t)
(org-back-over-empty-lines)
- (let ((contents (delete-and-extract-region beg (point))))
+ (let* ((contents (delete-and-extract-region beg (point)))
+ (key (get-text-property 0 'org-crypt-key contents))
+ (checksum (get-text-property 0 'org-crypt-checksum contents)))
(condition-case err
- (insert (org-encrypt-string contents crypt-key))
+ (insert
+ ;; Text and key have to be identical, otherwise we
+ ;; re-crypt.
+ (if (and (equal crypt-key key)
+ (string= checksum (sha1 contents)))
+ (get-text-property 0 'org-crypt-text contents)
+ (epg-encrypt-string epg-context contents crypt-key)))
;; If encryption failed, make sure to insert back entry
;; contents in the buffer.
- (error (insert contents) (error (nth 1 err)))))
- (when folded
- (goto-char start-heading)
+ (error
+ (insert contents)
+ (error (error-message-string err)))))
+ (when folded-heading
+ (goto-char folded-heading)
(org-flag-subtree t))
nil)))))
+;;;###autoload
(defun org-decrypt-entry ()
"Decrypt the content of the current headline."
(interactive)
- (require 'epg)
- (unless (org-before-first-heading-p)
- (org-with-wide-buffer
- (org-back-to-heading t)
- (let ((heading-point (point))
- (heading-was-invisible-p
- (save-excursion
- (outline-end-of-heading)
- (org-invisible-p))))
- (org-end-of-meta-data)
- (when (looking-at "-----BEGIN PGP MESSAGE-----")
- (org-crypt-check-auto-save)
- (setq-local epg-context (epg-make-context nil t t))
- (let* ((end (save-excursion
- (search-forward "-----END PGP MESSAGE-----")
- (forward-line)
- (point)))
- (encrypted-text (buffer-substring-no-properties (point) end))
- (decrypted-text
- (decode-coding-string
- (epg-decrypt-string
- epg-context
- encrypted-text)
- 'utf-8)))
- ;; Delete region starting just before point, because the
- ;; outline property starts at the \n of the heading.
- (delete-region (1- (point)) end)
- ;; Store a checksum of the decrypted and the encrypted
- ;; text value. This allows reusing the same encrypted text
- ;; if the text does not change, and therefore avoid a
- ;; re-encryption process.
- (insert "\n" (propertize decrypted-text
- 'org-crypt-checksum (sha1 decrypted-text)
- 'org-crypt-key (org-crypt-key-for-heading)
- 'org-crypt-text encrypted-text))
- (when heading-was-invisible-p
- (goto-char heading-point)
- (org-flag-subtree t))
- nil))))))
+ (pcase (org-at-encrypted-entry-p)
+ (`(,beg . ,end)
+ (require 'epg)
+ (setq-local epg-context (epg-make-context nil t t))
+ (org-with-point-at beg
+ (org-crypt-check-auto-save)
+ (let* ((folded-heading
+ (and (org-invisible-p)
+ (save-excursion
+ (org-previous-visible-heading 1)
+ (point))))
+ (encrypted-text (org-crypt--encrypted-text beg end))
+ (decrypted-text
+ (decode-coding-string
+ (epg-decrypt-string epg-context encrypted-text)
+ 'utf-8)))
+ ;; Delete region starting just before point, because the
+ ;; outline property starts at the \n of the heading.
+ (delete-region (1- (point)) end)
+ ;; Store a checksum of the decrypted and the encrypted text
+ ;; value. This allows reusing the same encrypted text if the
+ ;; text does not change, and therefore avoid a re-encryption
+ ;; process.
+ (insert "\n"
+ (propertize decrypted-text
+ 'org-crypt-checksum (sha1 decrypted-text)
+ 'org-crypt-key (org-crypt-key-for-heading)
+ 'org-crypt-text encrypted-text))
+ (when folded-heading
+ (goto-char folded-heading)
+ (org-flag-subtree t))
+ nil)))
+ (_ nil)))
+;;;###autoload
(defun org-encrypt-entries ()
"Encrypt all top-level entries in the current buffer."
(interactive)
@@ -245,6 +294,7 @@ See `org-crypt-disable-auto-save'."
(cdr (org-make-tags-matcher org-crypt-tag-matcher))
org--matcher-tags-todo-only)))
+;;;###autoload
(defun org-decrypt-entries ()
"Decrypt all entries in the current buffer."
(interactive)
@@ -254,14 +304,7 @@ See `org-crypt-disable-auto-save'."
(cdr (org-make-tags-matcher org-crypt-tag-matcher))
org--matcher-tags-todo-only)))
-(defun org-at-encrypted-entry-p ()
- "Is the current entry encrypted?"
- (unless (org-before-first-heading-p)
- (save-excursion
- (org-back-to-heading t)
- (search-forward "-----BEGIN PGP MESSAGE-----"
- (save-excursion (outline-next-heading)) t))))
-
+;;;###autoload
(defun org-crypt-use-before-save-magic ()
"Add a hook to automatically encrypt entries before a file is saved to disk."
(add-hook
diff --git a/lisp/org/org-ctags.el b/lisp/org/org-ctags.el
index 08885d26f66..1fca873c159 100644
--- a/lisp/org/org-ctags.el
+++ b/lisp/org/org-ctags.el
@@ -1,6 +1,6 @@
;;; org-ctags.el - Integrate Emacs "tags" Facility with Org -*- lexical-binding: t; -*-
;;
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Paul Sexton <eeeickythump@gmail.com>
@@ -165,7 +165,7 @@ See the ctags documentation for more information.")
'(org-ctags-find-tag
org-ctags-ask-rebuild-tags-file-then-find-tag
org-ctags-ask-append-topic)
- "List of functions to be prepended to ORG-OPEN-LINK-FUNCTIONS when ORG-CTAGS is active."
+ "List of functions to be prepended to ORG-OPEN-LINK-FUNCTIONS by ORG-CTAGS."
:group 'org-ctags
:version "24.1"
:type 'hook
diff --git a/lisp/org/org-datetree.el b/lisp/org/org-datetree.el
index 6469abef794..62bd46e2e97 100644
--- a/lisp/org/org-datetree.el
+++ b/lisp/org/org-datetree.el
@@ -1,6 +1,6 @@
;;; org-datetree.el --- Create date entries in a tree -*- lexical-binding: t; -*-
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -51,11 +51,29 @@ Added time stamp is active unless value is `inactive'."
;;;###autoload
(defun org-datetree-find-date-create (d &optional keep-restriction)
- "Find or create an entry for date D.
+ "Find or create a day entry for date D.
If KEEP-RESTRICTION is non-nil, do not widen the buffer.
When it is nil, the buffer will be widened to make sure an existing date
tree can be found. If it is the symbol `subtree-at-point', then the tree
will be built under the headline at point."
+ (org-datetree--find-create-group d 'day keep-restriction))
+
+;;;###autoload
+(defun org-datetree-find-month-create (d &optional keep-restriction)
+ "Find or create a month entry for date D.
+Compared to `org-datetree-find-date-create' this function creates
+entries grouped by month instead of days.
+If KEEP-RESTRICTION is non-nil, do not widen the buffer.
+When it is nil, the buffer will be widened to make sure an existing date
+tree can be found. If it is the symbol `subtree-at-point', then the tree
+will be built under the headline at point."
+ (org-datetree--find-create-group d 'month keep-restriction))
+
+(defun org-datetree--find-create-group
+ (d time-grouping &optional keep-restriction)
+ "Find or create an entry for date D.
+If time-period is day, group entries by day. If time-period is
+month, then group entries by month."
(setq-local org-datetree-base-level 1)
(save-restriction
(if (eq keep-restriction 'subtree-at-point)
@@ -84,9 +102,10 @@ will be built under the headline at point."
(org-datetree--find-create
"^\\*+[ \t]+%d-\\([01][0-9]\\) \\w+$"
year month)
- (org-datetree--find-create
- "^\\*+[ \t]+%d-%02d-\\([0123][0-9]\\) \\w+$"
- year month day))))
+ (when (eq time-grouping 'day)
+ (org-datetree--find-create
+ "^\\*+[ \t]+%d-%02d-\\([0123][0-9]\\) \\w+$"
+ year month day)))))
;;;###autoload
(defun org-datetree-find-iso-week-create (d &optional keep-restriction)
@@ -166,6 +185,8 @@ inserted into the buffer."
(defun org-datetree-insert-line (year &optional month day text)
(delete-region (save-excursion (skip-chars-backward " \t\n") (point)) (point))
+ (when (assq 'heading org-blank-before-new-entry)
+ (insert "\n"))
(insert "\n" (make-string org-datetree-base-level ?*) " \n")
(backward-char)
(when month (org-do-demote))
diff --git a/lisp/org/org-duration.el b/lisp/org/org-duration.el
index 155bfae6ca0..29fae2dbf03 100644
--- a/lisp/org/org-duration.el
+++ b/lisp/org/org-duration.el
@@ -1,6 +1,6 @@
;;; org-duration.el --- Library handling durations -*- lexical-binding: t; -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -28,14 +28,16 @@
;; - 3:12
;; - 1:23:45
;; - 1y 3d 3h 4min
+;; - 1d3h5min
;; - 3d 13:35
;; - 2.35h
;;
;; More accurately, it consists of numbers and units, as defined in
-;; variable `org-duration-units', separated with white spaces, and
-;; a "H:MM" or "H:MM:SS" part. White spaces are tolerated between the
-;; number and its relative unit. Variable `org-duration-format'
-;; controls durations default representation.
+;; variable `org-duration-units', possibly separated with white
+;; spaces, and an optional "H:MM" or "H:MM:SS" part, which always
+;; comes last. White spaces are tolerated between the number and its
+;; relative unit. Variable `org-duration-format' controls durations
+;; default representation.
;;
;; The library provides functions allowing to convert a duration to,
;; and from, a number of minutes: `org-duration-to-minutes' and
@@ -122,8 +124,7 @@ are specified here.
Units with a zero value are skipped, unless REQUIRED? is non-nil.
In that case, the unit is always used.
-Eventually, the list can contain one of the following special
-entries:
+The list can also contain one of the following special entries:
(special . h:mm)
(special . h:mm:ss)
@@ -139,6 +140,10 @@ entries:
first one required or with a non-zero integer part. If there
is no such unit, the smallest one is used.
+Eventually, if the list contains the symbol `compact', the
+duration is expressed in a compact form, without any white space
+between units.
+
For example,
((\"d\" . nil) (\"h\" . t) (\"min\" . t))
@@ -172,7 +177,6 @@ a 2-digits fractional part, of \"d\" unit. A duration shorter
than a day uses \"h\" unit instead."
:group 'org-time
:group 'org-clock
- :version "26.1"
:package-version '(Org . "9.1")
:type '(choice
(const :tag "Use H:MM" h:mm)
@@ -191,7 +195,8 @@ than a day uses \"h\" unit instead."
(const h:mm))
(cons :tag "Use both units and H:MM:SS"
(const special)
- (const h:mm:ss))))))
+ (const h:mm:ss))
+ (const :tag "Use compact form" compact)))))
;;; Internal variables and functions
@@ -249,13 +254,10 @@ When optional argument CANONICAL is non-nil, refer to
org-duration-units))
t)))
(setq org-duration--full-re
- (format "\\`[ \t]*%s\\(?:[ \t]+%s\\)*[ \t]*\\'"
- org-duration--unit-re
- org-duration--unit-re))
+ (format "\\`\\(?:[ \t]*%s\\)+[ \t]*\\'" org-duration--unit-re))
(setq org-duration--mixed-re
- (format "\\`[ \t]*\\(?1:%s\\(?:[ \t]+%s\\)*\\)[ \t]+\
+ (format "\\`\\(?1:\\([ \t]*%s\\)+\\)[ \t]*\
\\(?2:[0-9]+\\(?::[0-9][0-9]\\)\\{1,2\\}\\)[ \t]*\\'"
- org-duration--unit-re
org-duration--unit-re)))
;;;###autoload
@@ -353,10 +355,11 @@ Raise an error if expected format is unknown."
;; Represent minutes above hour using provided units and H:MM
;; or H:MM:SS below.
(let* ((units-part (* min-modifier (/ (floor minutes) min-modifier)))
- (minutes-part (- minutes units-part)))
+ (minutes-part (- minutes units-part))
+ (compact (memq 'compact duration-format)))
(concat
(org-duration-from-minutes units-part truncated-format canonical)
- " "
+ (and (not compact) " ")
(org-duration-from-minutes minutes-part mode))))))
;; Units format.
(duration-format
@@ -368,12 +371,16 @@ Raise an error if expected format is unknown."
(format "%%.%df" digits))))
(selected-units
(sort (cl-remove-if
- ;; Ignore special format cells.
- (lambda (pair) (pcase pair (`(special . ,_) t) (_ nil)))
+ ;; Ignore special format cells and compact option.
+ (lambda (pair)
+ (pcase pair
+ ((or `compact `(special . ,_)) t)
+ (_ nil)))
duration-format)
(lambda (a b)
(> (org-duration--modifier (car a) canonical)
- (org-duration--modifier (car b) canonical))))))
+ (org-duration--modifier (car b) canonical)))))
+ (separator (if (memq 'compact duration-format) "" " ")))
(cond
;; Fractional duration: use first unit that is either required
;; or smaller than MINUTES.
@@ -402,8 +409,8 @@ Raise an error if expected format is unknown."
(cond ((<= modifier minutes)
(let ((value (floor minutes modifier)))
(cl-decf minutes (* value modifier))
- (format " %d%s" value unit)))
- (required? (concat " 0" unit))
+ (format "%s%d%s" separator value unit)))
+ (required? (concat separator "0" unit))
(t ""))))
selected-units
""))))
@@ -441,4 +448,9 @@ with \"H:MM:SS\" format, return `h:mm:ss'. Otherwise, return
(org-duration-set-regexps)
(provide 'org-duration)
+
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
;;; org-duration.el ends here
diff --git a/lisp/org/org-element.el b/lisp/org/org-element.el
index be74dfdbeff..b7319d638ed 100644
--- a/lisp/org/org-element.el
+++ b/lisp/org/org-element.el
@@ -1,6 +1,6 @@
;;; org-element.el --- Parser for Org Syntax -*- lexical-binding: t; -*-
-;; Copyright (C) 2012-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -72,7 +72,6 @@
(declare-function org-at-heading-p "org" (&optional _))
(declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading))
(declare-function org-escape-code-in-string "org-src" (s))
-(declare-function org-find-visible "org" ())
(declare-function org-macro-escape-arguments "org-macro" (&rest args))
(declare-function org-macro-extract-arguments "org-macro" (s))
(declare-function org-reduced-level "org" (l))
@@ -330,7 +329,9 @@ match group 2.
Don't modify it, set `org-element-affiliated-keywords' instead.")
(defconst org-element-object-restrictions
- (let* ((standard-set (remq 'table-cell org-element-all-objects))
+ (let* ((minimal-set '(bold code entity italic latex-fragment strike-through
+ subscript superscript underline verbatim))
+ (standard-set (remq 'table-cell org-element-all-objects))
(standard-set-no-line-break (remq 'line-break standard-set)))
`((bold ,@standard-set)
(footnote-reference ,@standard-set)
@@ -341,23 +342,20 @@ Don't modify it, set `org-element-affiliated-keywords' instead.")
(keyword ,@(remq 'footnote-reference standard-set))
;; Ignore all links in a link description. Also ignore
;; radio-targets and line breaks.
- (link bold code entity export-snippet inline-babel-call inline-src-block
- italic latex-fragment macro statistics-cookie strike-through
- subscript superscript underline verbatim)
+ (link export-snippet inline-babel-call inline-src-block macro
+ statistics-cookie ,@minimal-set)
(paragraph ,@standard-set)
;; Remove any variable object from radio target as it would
;; prevent it from being properly recognized.
- (radio-target bold code entity italic latex-fragment strike-through
- subscript superscript underline superscript)
+ (radio-target ,@minimal-set)
(strike-through ,@standard-set)
(subscript ,@standard-set)
(superscript ,@standard-set)
;; Ignore inline babel call and inline source block as formulas
;; are possible. Also ignore line breaks and statistics
;; cookies.
- (table-cell bold code entity export-snippet footnote-reference italic
- latex-fragment link macro radio-target strike-through
- subscript superscript target timestamp underline verbatim)
+ (table-cell export-snippet footnote-reference link macro radio-target
+ target timestamp ,@minimal-set)
(table-row table-cell)
(underline ,@standard-set)
(verse-block ,@standard-set)))
@@ -367,10 +365,6 @@ key is an element or object type containing objects and value is
a list of types that can be contained within an element or object
of such type.
-For example, in a `radio-target' object, one can only find
-entities, latex-fragments, subscript, superscript and text
-markup.
-
This alist also applies to secondary string. For example, an
`headline' type element doesn't directly contain objects, but
still has an entry since one of its properties (`:title') does.")
@@ -1806,13 +1800,10 @@ Return a list whose CAR is `clock' and CDR is a plist containing
;;;; Comment
-(defun org-element-comment-parser (limit affiliated)
+(defun org-element-comment-parser (limit)
"Parse a comment.
-LIMIT bounds the search. AFFILIATED is a list of which CAR is
-the buffer position at the beginning of the first affiliated
-keyword and CDR is a plist of affiliated keywords along with
-their value.
+LIMIT bounds the search.
Return a list whose CAR is `comment' and CDR is a plist
containing `:begin', `:end', `:value', `:post-blank',
@@ -1820,8 +1811,7 @@ containing `:begin', `:end', `:value', `:post-blank',
Assume point is at comment beginning."
(save-excursion
- (let* ((begin (car affiliated))
- (post-affiliated (point))
+ (let* ((begin (point))
(value (prog2 (looking-at "[ \t]*# ?")
(buffer-substring-no-properties
(match-end 0) (line-end-position))
@@ -1843,13 +1833,11 @@ Assume point is at comment beginning."
(skip-chars-forward " \r\t\n" limit)
(if (eobp) (point) (line-beginning-position)))))
(list 'comment
- (nconc
- (list :begin begin
- :end end
- :value value
- :post-blank (count-lines com-end end)
- :post-affiliated post-affiliated)
- (cdr affiliated))))))
+ (list :begin begin
+ :end end
+ :value value
+ :post-blank (count-lines com-end end)
+ :post-affiliated begin)))))
(defun org-element-comment-interpreter (comment _)
"Interpret COMMENT element as Org syntax.
@@ -2186,9 +2174,9 @@ the buffer position at the beginning of the first affiliated
keyword and CDR is a plist of affiliated keywords along with
their value.
-Return a list whose CAR is `keyword' and CDR is a plist
-containing `:key', `:value', `:begin', `:end', `:post-blank' and
-`:post-affiliated' keywords."
+Return a list whose CAR is a normalized `keyword' (uppercase) and
+CDR is a plist containing `:key', `:value', `:begin', `:end',
+`:post-blank' and `:post-affiliated' keywords."
(save-excursion
;; An orphaned affiliated keyword is considered as a regular
;; keyword. In this case AFFILIATED is nil, so we take care of
@@ -3217,10 +3205,11 @@ Assume point is at the beginning of the link."
(setq post-blank
(progn (goto-char link-end) (skip-chars-forward " \t")))
(setq end (point)))
- ;; Special "file" type link processing. Extract opening
+ ;; Special "file"-type link processing. Extract opening
;; application and search option, if any. Also normalize URI.
(when (string-match "\\`file\\(?:\\+\\(.+\\)\\)?\\'" type)
- (setq application (match-string 1 type) type "file")
+ (setq application (match-string 1 type))
+ (setq type "file")
(when (string-match "::\\(.*\\)\\'" path)
(setq search-option (match-string 1 path))
(setq path (replace-match "" nil nil path)))
@@ -3823,12 +3812,6 @@ Assume point is at the first equal sign marker."
;; `org-element--current-element' is the core function of this section.
;; It returns the Lisp representation of the element starting at
;; point.
-;;
-;; `org-element--current-element' makes use of special modes. They
-;; are activated for fixed element chaining (e.g., `plain-list' >
-;; `item') or fixed conditional element chaining (e.g., `headline' >
-;; `section'). Special modes are: `first-section', `item',
-;; `node-property', `section' and `table-row'.
(defun org-element--current-element (limit &optional granularity mode structure)
"Parse the element starting at point.
@@ -3848,8 +3831,9 @@ nil), secondary values will not be parsed, since they only
contain objects.
Optional argument MODE, when non-nil, can be either
-`first-section', `section', `planning', `item', `node-property'
-and `table-row'.
+`first-section', `item', `node-property', `planning',
+`property-drawer', `section', `table-row', or `top-comment'.
+
If STRUCTURE isn't provided but MODE is set to `item', it will be
computed.
@@ -3879,15 +3863,22 @@ element it has to parse."
(org-element-section-parser
(or (save-excursion (org-with-limited-levels (outline-next-heading)))
limit)))
+ ;; Comments.
+ ((looking-at "^[ \t]*#\\(?: \\|$\\)")
+ (org-element-comment-parser limit))
;; Planning.
((and (eq mode 'planning)
(eq ?* (char-after (line-beginning-position 0)))
(looking-at org-planning-line-re))
(org-element-planning-parser limit))
;; Property drawer.
- ((and (memq mode '(planning property-drawer))
- (eq ?* (char-after (line-beginning-position
- (if (eq mode 'planning) 0 -1))))
+ ((and (pcase mode
+ (`planning (eq ?* (char-after (line-beginning-position 0))))
+ ((or `property-drawer `top-comment)
+ (save-excursion
+ (beginning-of-line 0)
+ (not (looking-at "[[:blank:]]*$"))))
+ (_ nil))
(looking-at org-property-drawer-re))
(org-element-property-drawer-parser limit))
;; When not at bol, point is at the beginning of an item or
@@ -3896,7 +3887,7 @@ element it has to parse."
;; Clock.
((looking-at org-clock-line-re) (org-element-clock-parser limit))
;; Inlinetask.
- ((org-at-heading-p)
+ ((looking-at "^\\*+ ")
(org-element-inlinetask-parser limit raw-secondary-p))
;; From there, elements can have affiliated keywords.
(t (let ((affiliated (org-element--collect-affiliated-keywords
@@ -3910,7 +3901,7 @@ element it has to parse."
;; LaTeX Environment.
((looking-at org-element--latex-begin-environment)
(org-element-latex-environment-parser limit affiliated))
- ;; Drawer and Property Drawer.
+ ;; Drawer.
((looking-at org-drawer-regexp)
(org-element-drawer-parser limit affiliated))
;; Fixed Width
@@ -3918,13 +3909,10 @@ element it has to parse."
(org-element-fixed-width-parser limit affiliated))
;; Inline Comments, Blocks, Babel Calls, Dynamic Blocks and
;; Keywords.
- ((looking-at "[ \t]*#")
+ ((looking-at "[ \t]*#\\+")
(goto-char (match-end 0))
(cond
- ((looking-at "\\(?: \\|$\\)")
- (beginning-of-line)
- (org-element-comment-parser limit affiliated))
- ((looking-at "\\+BEGIN_\\(\\S-+\\)")
+ ((looking-at "BEGIN_\\(\\S-+\\)")
(beginning-of-line)
(funcall (pcase (upcase (match-string 1))
("CENTER" #'org-element-center-block-parser)
@@ -3937,13 +3925,13 @@ element it has to parse."
(_ #'org-element-special-block-parser))
limit
affiliated))
- ((looking-at "\\+CALL:")
+ ((looking-at "CALL:")
(beginning-of-line)
(org-element-babel-call-parser limit affiliated))
- ((looking-at "\\+BEGIN:? ")
+ ((looking-at "BEGIN:? ")
(beginning-of-line)
(org-element-dynamic-block-parser limit affiliated))
- ((looking-at "\\+\\S-+:")
+ ((looking-at "\\S-+:")
(beginning-of-line)
(org-element-keyword-parser limit affiliated))
(t
@@ -4024,7 +4012,8 @@ When PARSE is non-nil, values from keywords belonging to
(skip-chars-backward " \t")
(point))))
(if parsed?
- (org-element--parse-objects beg end nil restrict)
+ (save-match-data
+ (org-element--parse-objects beg end nil restrict))
(org-trim (buffer-substring-no-properties beg end)))))
;; If KWD is a dual keyword, find its secondary value.
;; Maybe parse it.
@@ -4144,7 +4133,9 @@ If STRING is the empty string or nil, return nil."
(dolist (v local-variables)
(ignore-errors
(if (symbolp v) (makunbound v)
- (set (make-local-variable (car v)) (cdr v)))))
+ ;; Don't set file name to avoid mishandling hooks (bug#44524)
+ (unless (memq (car v) '(buffer-file-name buffer-file-truename))
+ (set (make-local-variable (car v)) (cdr v))))))
;; Transferring local variables may put the temporary buffer
;; into a read-only state. Make sure we can insert STRING.
(let ((inhibit-read-only t)) (insert string))
@@ -4320,34 +4311,41 @@ looking into captions:
;; `org-element--object-lex' to find the next object in the current
;; container.
-(defsubst org-element--next-mode (type parentp)
- "Return next special mode according to TYPE, or nil.
-TYPE is a symbol representing the type of an element or object
-containing next element if PARENTP is non-nil, or before it
-otherwise. Modes can be either `first-section', `item',
-`node-property', `planning', `property-drawer', `section',
-`table-row' or nil."
- (if parentp
+(defsubst org-element--next-mode (mode type parent?)
+ "Return next mode according to current one.
+
+MODE is a symbol representing the expectation about the next
+element or object. Meaningful values are `first-section',
+`item', `node-property', `planning', `property-drawer',
+`section', `table-row', `top-comment', and nil.
+
+TYPE is the type of the current element or object.
+
+If PARENT? is non-nil, assume the next element or object will be
+located inside the current one. "
+ (if parent?
(pcase type
(`headline 'section)
+ ((and (guard (eq mode 'first-section)) `section) 'top-comment)
(`inlinetask 'planning)
(`plain-list 'item)
(`property-drawer 'node-property)
(`section 'planning)
(`table 'table-row))
- (pcase type
+ (pcase mode
(`item 'item)
(`node-property 'node-property)
- (`planning 'property-drawer)
- (`table-row 'table-row))))
+ ((and `planning (guard (eq type 'planning))) 'property-drawer)
+ (`table-row 'table-row)
+ ((and `top-comment (guard (eq type 'comment))) 'property-drawer))))
(defun org-element--parse-elements
(beg end mode structure granularity visible-only acc)
"Parse elements between BEG and END positions.
MODE prioritizes some elements over the others. It can be set to
-`first-section', `section', `planning', `item', `node-property'
-or `table-row'.
+`first-section', `item', `node-property', `planning',
+`property-drawer', `section', `table-row', `top-comment', or nil.
When value is `item', STRUCTURE will be used as the current list
structure.
@@ -4361,54 +4359,52 @@ elements.
Elements are accumulated into ACC."
(save-excursion
(goto-char beg)
- ;; Visible only: skip invisible parts at the beginning of the
- ;; element.
- (when (and visible-only (org-invisible-p2))
- (goto-char (min (1+ (org-find-visible)) end)))
;; When parsing only headlines, skip any text before first one.
(when (and (eq granularity 'headline) (not (org-at-heading-p)))
(org-with-limited-levels (outline-next-heading)))
(let (elements)
(while (< (point) end)
- ;; Find current element's type and parse it accordingly to
- ;; its category.
- (let* ((element (org-element--current-element
- end granularity mode structure))
- (type (org-element-type element))
- (cbeg (org-element-property :contents-begin element)))
- (goto-char (org-element-property :end element))
- ;; Visible only: skip invisible parts between siblings.
- (when (and visible-only (org-invisible-p2))
- (goto-char (min (1+ (org-find-visible)) end)))
- ;; Fill ELEMENT contents by side-effect.
- (cond
- ;; If element has no contents, don't modify it.
- ((not cbeg))
- ;; Greater element: parse it between `contents-begin' and
- ;; `contents-end'. Make sure GRANULARITY allows the
- ;; recursion, or ELEMENT is a headline, in which case going
- ;; inside is mandatory, in order to get sub-level headings.
- ((and (memq type org-element-greater-elements)
- (or (memq granularity '(element object nil))
- (and (eq granularity 'greater-element)
- (eq type 'section))
- (eq type 'headline)))
- (org-element--parse-elements
- cbeg (org-element-property :contents-end element)
- ;; Possibly switch to a special mode.
- (org-element--next-mode type t)
- (and (memq type '(item plain-list))
- (org-element-property :structure element))
- granularity visible-only element))
- ;; ELEMENT has contents. Parse objects inside, if
- ;; GRANULARITY allows it.
- ((memq granularity '(object nil))
- (org-element--parse-objects
- cbeg (org-element-property :contents-end element) element
- (org-element-restriction type))))
- (push (org-element-put-property element :parent acc) elements)
- ;; Update mode.
- (setq mode (org-element--next-mode type nil))))
+ ;; Visible only: skip invisible parts due to folding.
+ (if (and visible-only (org-invisible-p nil t))
+ (progn
+ (goto-char (org-find-visible))
+ (when (and (eolp) (not (eobp))) (forward-char)))
+ ;; Find current element's type and parse it accordingly to
+ ;; its category.
+ (let* ((element (org-element--current-element
+ end granularity mode structure))
+ (type (org-element-type element))
+ (cbeg (org-element-property :contents-begin element)))
+ (goto-char (org-element-property :end element))
+ ;; Fill ELEMENT contents by side-effect.
+ (cond
+ ;; If element has no contents, don't modify it.
+ ((not cbeg))
+ ;; Greater element: parse it between `contents-begin' and
+ ;; `contents-end'. Ensure GRANULARITY allows recursion,
+ ;; or ELEMENT is a headline, in which case going inside
+ ;; is mandatory, in order to get sub-level headings.
+ ((and (memq type org-element-greater-elements)
+ (or (memq granularity '(element object nil))
+ (and (eq granularity 'greater-element)
+ (eq type 'section))
+ (eq type 'headline)))
+ (org-element--parse-elements
+ cbeg (org-element-property :contents-end element)
+ ;; Possibly switch to a special mode.
+ (org-element--next-mode mode type t)
+ (and (memq type '(item plain-list))
+ (org-element-property :structure element))
+ granularity visible-only element))
+ ;; ELEMENT has contents. Parse objects inside, if
+ ;; GRANULARITY allows it.
+ ((memq granularity '(object nil))
+ (org-element--parse-objects
+ cbeg (org-element-property :contents-end element) element
+ (org-element-restriction type))))
+ (push (org-element-put-property element :parent acc) elements)
+ ;; Update mode.
+ (setq mode (org-element--next-mode mode type nil)))))
;; Return result.
(apply #'org-element-set-contents acc (nreverse elements)))))
@@ -4498,15 +4494,21 @@ to an appropriate container (e.g., a paragraph)."
(and (memq 'latex-fragment restriction)
(org-element-latex-fragment-parser)))))
(?\[
- (if (eq (aref result 1) ?\[)
- (and (memq 'link restriction)
- (org-element-link-parser))
- (or (and (memq 'footnote-reference restriction)
- (org-element-footnote-reference-parser))
- (and (memq 'timestamp restriction)
- (org-element-timestamp-parser))
- (and (memq 'statistics-cookie restriction)
- (org-element-statistics-cookie-parser)))))
+ (pcase (aref result 1)
+ ((and ?\[
+ (guard (memq 'link restriction)))
+ (org-element-link-parser))
+ ((and ?f
+ (guard (memq 'footnote-reference restriction)))
+ (org-element-footnote-reference-parser))
+ ((and (or ?% ?/)
+ (guard (memq 'statistics-cookie restriction)))
+ (org-element-statistics-cookie-parser))
+ (_
+ (or (and (memq 'timestamp restriction)
+ (org-element-timestamp-parser))
+ (and (memq 'statistics-cookie restriction)
+ (org-element-statistics-cookie-parser))))))
;; This is probably a plain link.
(_ (and (memq 'link restriction)
(org-element-link-parser)))))))
@@ -4821,10 +4823,12 @@ indentation removed from its contents."
;;
;; A single public function is provided: `org-element-cache-reset'.
;;
-;; Cache is enabled by default, but can be disabled globally with
+;; Cache is disabled by default for now because it sometimes triggers
+;; freezes, but it can be enabled globally with
;; `org-element-use-cache'. `org-element-cache-sync-idle-time',
-;; org-element-cache-sync-duration' and `org-element-cache-sync-break'
-;; can be tweaked to control caching behavior.
+;; `org-element-cache-sync-duration' and
+;; `org-element-cache-sync-break' can be tweaked to control caching
+;; behavior.
;;
;; Internally, parsed elements are stored in an AVL tree,
;; `org-element--cache'. This tree is updated lazily: whenever
@@ -5450,9 +5454,11 @@ the process stopped before finding the expected result."
;; element following headline above, or first element in
;; buffer.
((not cached)
- (when (org-with-limited-levels (outline-previous-heading))
- (setq mode 'planning)
- (forward-line))
+ (if (org-with-limited-levels (outline-previous-heading))
+ (progn
+ (setq mode 'planning)
+ (forward-line))
+ (setq mode 'top-comment))
(skip-chars-forward " \r\t\n")
(beginning-of-line))
;; Cache returned exact match: return it.
@@ -5521,7 +5527,7 @@ the process stopped before finding the expected result."
;; after it.
((and (<= elem-end pos) (/= (point-max) elem-end))
(goto-char elem-end)
- (setq mode (org-element--next-mode type nil)))
+ (setq mode (org-element--next-mode mode type nil)))
;; A non-greater element contains point: return it.
((not (memq type org-element-greater-elements))
(throw 'exit element))
@@ -5549,7 +5555,7 @@ the process stopped before finding the expected result."
(and (= cend pos) (= (point-max) pos)))))
(goto-char (or next cbeg))
(setq next nil
- mode (org-element--next-mode type t)
+ mode (org-element--next-mode mode type t)
parent element
end cend))))
;; Otherwise, return ELEMENT as it is the smallest
@@ -5813,7 +5819,7 @@ element.
Possible types are defined in `org-element-all-elements'.
Properties depend on element or object type, but always include
-`:begin', `:end', `:parent' and `:post-blank' properties.
+`:begin', `:end', and `:post-blank' properties.
As a special case, if point is at the very beginning of the first
item in a list or sub-list, returned element will be that list
diff --git a/lisp/org/org-entities.el b/lisp/org/org-entities.el
index e32ce269b4a..eb098993b77 100644
--- a/lisp/org/org-entities.el
+++ b/lisp/org/org-entities.el
@@ -1,6 +1,6 @@
;;; org-entities.el --- Support for Special Entities -*- lexical-binding: t; -*-
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>,
;; Ulf Stegemann <ulf at zeitform dot de>
@@ -27,6 +27,7 @@
;;; Code:
+(declare-function org-mode "org" ())
(declare-function org-toggle-pretty-entities "org" ())
(declare-function org-table-align "org-table" ())
@@ -226,7 +227,7 @@ packages to be loaded, add these packages to `org-latex-packages-alist'."
("beth" "\\beth" t "&beth;" "beth" "beth" "ב")
("dalet" "\\daleth" t "&daleth;" "dalet" "dalet" "ד")
- "** Dead languages"
+ "** Icelandic"
("ETH" "\\DH{}" nil "&ETH;" "D" "Ð" "Ð")
("eth" "\\dh{}" nil "&eth;" "dh" "ð" "ð")
("THORN" "\\TH{}" nil "&THORN;" "TH" "Þ" "Þ")
@@ -386,7 +387,7 @@ packages to be loaded, add these packages to `org-latex-packages-alist'."
("exists" "\\exists" t "&exist;" "[there exists]" "[there exists]" "∃")
("nexist" "\\nexists" t "&exist;" "[there does not exists]" "[there does not exists]" "∄")
("nexists" "\\nexists" t "&exist;" "[there does not exists]" "[there does not exists]" "∄")
- ("empty" "\\empty" t "&empty;" "[empty set]" "[empty set]" "∅")
+ ("empty" "\\emptyset" t "&empty;" "[empty set]" "[empty set]" "∅")
("emptyset" "\\emptyset" t "&empty;" "[empty set]" "[empty set]" "∅")
("isin" "\\in" t "&isin;" "[element of]" "[element of]" "∈")
("in" "\\in" t "&isin;" "[element of]" "[element of]" "∈")
diff --git a/lisp/org/org-faces.el b/lisp/org/org-faces.el
index 30eab9bc6b7..c56873b54c5 100644
--- a/lisp/org/org-faces.el
+++ b/lisp/org/org-faces.el
@@ -1,6 +1,6 @@
;;; org-faces.el --- Face definitions -*- lexical-binding: t; -*-
-;; Copyright (C) 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -243,6 +243,15 @@ is of course immediately visible, but for example a passed deadline is
of the frame, for example."
:group 'org-faces)
+(defface org-headline-todo ;Copied from `font-lock-string-face'
+ '((((class color) (min-colors 16) (background light)) (:foreground "Red4"))
+ (((class color) (min-colors 16) (background dark)) (:foreground "Pink2"))
+ (((class color) (min-colors 8) (background light)) (:bold t)))
+ "Face used to indicate that a headline is marked as TODO.
+This face is only used if `org-fontify-todo-headline' is set. If applies
+to the part of the headline after the TODO keyword."
+ :group 'org-faces)
+
(defface org-headline-done ;Copied from `font-lock-string-face'
'((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown"))
(((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon"))
@@ -355,6 +364,12 @@ changes."
"Face used for tables."
:group 'org-faces)
+(defface org-table-header '((t :inherit org-table
+ :background "LightGray"
+ :foreground "Black"))
+ "Face for table header."
+ :group 'org-faces)
+
(defface org-formula
'((((class color) (min-colors 88) (background light)) (:foreground "Firebrick"))
(((class color) (min-colors 88) (background dark)) (:foreground "chocolate1"))
@@ -393,9 +408,17 @@ follows a #+DATE:, #+AUTHOR: or #+EMAIL: keyword."
"Face for #+TITLE:, #+AUTHOR:, #+EMAIL: and #+DATE: keywords."
:group 'org-faces)
-(defface org-block '((t :inherit shadow))
- "Face text in #+begin ... #+end blocks.
-For source-blocks `org-src-block-faces' takes precedence."
+(defface org-block `((t :inherit shadow
+ ,@(and (>= emacs-major-version 27) '(:extend t))))
+ "Face used for text inside various blocks.
+
+It is always used for source blocks. You can refine what face
+should be used depending on the source block language by setting,
+`org-src-block-faces', which takes precedence.
+
+When `org-fontify-quote-and-verse-blocks' is not nil, text inside
+verse and quote blocks are fontified using the `org-verse' and
+`org-quote' faces, which inherit from `org-block'."
:group 'org-faces
:version "26.1")
diff --git a/lisp/org/org-feed.el b/lisp/org/org-feed.el
index 58bbba7c71f..5dbd887ef50 100644
--- a/lisp/org/org-feed.el
+++ b/lisp/org/org-feed.el
@@ -1,6 +1,6 @@
;;; org-feed.el --- Add RSS feed items to Org files -*- lexical-binding: t; -*-
;;
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
diff --git a/lisp/org/org-footnote.el b/lisp/org/org-footnote.el
index 14b0a2a0002..3d42421e0db 100644
--- a/lisp/org/org-footnote.el
+++ b/lisp/org/org-footnote.el
@@ -1,6 +1,6 @@
;;; org-footnote.el --- Footnote support in Org -*- lexical-binding: t; -*-
;;
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
diff --git a/lisp/org/org-goto.el b/lisp/org/org-goto.el
index dd9c0fad577..163aa580ef6 100644
--- a/lisp/org/org-goto.el
+++ b/lisp/org/org-goto.el
@@ -1,6 +1,6 @@
;;; org-goto.el --- Fast navigation in an Org buffer -*- lexical-binding: t; -*-
-;; Copyright (C) 2012-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -22,27 +22,8 @@
;;; Code:
-(require 'org-macs)
-(require 'org-compat)
-
-(declare-function org-at-heading-p "org" (&optional ignored))
-(declare-function org-beginning-of-line "org" (&optional n))
-(declare-function org-defkey "org" (keymap key def))
-(declare-function org-mark-ring-push "org" (&optional pos buffer))
-(declare-function org-overview "org" ())
-(declare-function org-refile-check-position "org" (refile-pointer))
-(declare-function org-refile-get-location "org" (&optional prompt default-buffer new-nodes))
-(declare-function org-show-context "org" (&optional key))
-(declare-function org-show-set-visibility "org" (detail))
-
-(defvar org-complex-heading-regexp)
-(defvar org-startup-align-all-tables)
-(defvar org-startup-folded)
-(defvar org-startup-truncated)
-(defvar org-special-ctrl-a/e)
-(defvar org-refile-target-verify-function)
-(defvar org-refile-use-outline-path)
-(defvar org-refile-targets)
+(require 'org)
+(require 'org-refile)
(defvar org-goto-exit-command nil)
(defvar org-goto-map nil)
@@ -234,20 +215,15 @@ position or nil."
(and (get-buffer "*org-goto*") (kill-buffer "*org-goto*"))
(pop-to-buffer-same-window
(condition-case nil
- (make-indirect-buffer (current-buffer) "*org-goto*")
- (error (make-indirect-buffer (current-buffer) "*org-goto*"))))
+ (make-indirect-buffer (current-buffer) "*org-goto*" t)
+ (error (make-indirect-buffer (current-buffer) "*org-goto*" t))))
(let (temp-buffer-show-function temp-buffer-show-hook)
(with-output-to-temp-buffer "*Org Help*"
(princ (format help (if org-goto-auto-isearch
" Just type for auto-isearch."
" n/p/f/b/u to navigate, q to quit.")))))
(org-fit-window-to-buffer (get-buffer-window "*Org Help*"))
- (setq buffer-read-only nil)
- (let ((org-startup-truncated t)
- (org-startup-folded nil)
- (org-startup-align-all-tables nil))
- (org-mode)
- (org-overview))
+ (org-overview)
(setq buffer-read-only t)
(if (and (boundp 'org-goto-start-pos)
(integer-or-marker-p org-goto-start-pos))
@@ -309,4 +285,8 @@ With a prefix argument, use the alternative interface: e.g., if
(provide 'org-goto)
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
;;; org-goto.el ends here
diff --git a/lisp/org/org-habit.el b/lisp/org/org-habit.el
index e1d13b8325c..231c08be0ac 100644
--- a/lisp/org/org-habit.el
+++ b/lisp/org/org-habit.el
@@ -1,6 +1,6 @@
;;; org-habit.el --- The habit tracking code for Org -*- lexical-binding: t; -*-
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw at gnu dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -90,7 +90,7 @@ It will be green even if it was done after the deadline."
:type 'boolean)
(defcustom org-habit-scheduled-past-days nil
- "Value to use instead of `org-scheduled-past-days', for habits only.
+"Value to use instead of `org-scheduled-past-days', for habits only.
If nil, `org-scheduled-past-days' is used.
@@ -343,7 +343,10 @@ current time."
(if (and in-the-past-p
(not last-done-date)
(not (< scheduled now)))
- '(org-habit-clear-face . org-habit-clear-future-face)
+ (if (and all-done-dates (= (car all-done-dates) start))
+ ;; This is the very first done of this habit.
+ '(org-habit-ready-face . org-habit-ready-future-face)
+ '(org-habit-clear-face . org-habit-clear-future-face))
(org-habit-get-faces
habit start
(and in-the-past-p
@@ -409,7 +412,7 @@ current time."
'help-echo
(concat (format-time-string
(org-time-stamp-format)
- (time-add starting (days-to-time (- start (time-to-days starting)))))
+ (time-add starting (days-to-time (- start (time-to-days starting)))))
(if donep " DONE" ""))
graph))
(setq start (1+ start)
@@ -436,7 +439,7 @@ current time."
habit
(time-subtract moment (days-to-time org-habit-preceding-days))
moment
- (time-add moment (days-to-time org-habit-following-days))))))
+ (time-add moment (days-to-time org-habit-following-days))))))
(forward-line)))))
(defun org-habit-toggle-habits ()
diff --git a/lisp/org/org-id.el b/lisp/org/org-id.el
index 3efbde04d3f..b3b98c614ab 100644
--- a/lisp/org/org-id.el
+++ b/lisp/org/org-id.el
@@ -1,6 +1,6 @@
;;; org-id.el --- Global identifiers for Org entries -*- lexical-binding: t; -*-
;;
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -71,11 +71,11 @@
;;; Code:
(require 'org)
+(require 'org-refile)
(require 'ol)
(declare-function message-make-fqdn "message" ())
(declare-function org-goto-location "org-goto" (&optional _buf help))
-(declare-function org-link-set-parameters "ol" (type &rest rest))
;;; Customization
@@ -259,6 +259,11 @@ Create an ID if necessary."
(interactive)
(org-kill-new (org-id-get nil 'create)))
+(defvar org-id-overriding-file-name nil
+ "Tell `org-id-get' to use this as the file name when creating an ID.
+This is useful when working with contents in a temporary buffer
+that will be copied back to the original.")
+
;;;###autoload
(defun org-id-get (&optional pom create prefix)
"Get the ID property of the entry at point-or-marker POM.
@@ -275,7 +280,9 @@ In any case, the ID of the entry is returned."
(create
(setq id (org-id-new prefix))
(org-entry-put pom "ID" id)
- (org-id-add-location id (buffer-file-name (buffer-base-buffer)))
+ (org-id-add-location id
+ (or org-id-overriding-file-name
+ (buffer-file-name (buffer-base-buffer))))
id)))))
;;;###autoload
@@ -478,55 +485,64 @@ This will scan all agenda files, all associated archives, and all
files currently mentioned in `org-id-locations'.
When FILES is given, scan also these files."
(interactive)
- (if (not org-id-track-globally)
- (error "Please turn on `org-id-track-globally' if you want to track IDs")
- (let* ((files (delete-dups
- (mapcar #'file-truename
- (append
- ;; Agenda files and all associated archives
- (org-agenda-files t org-id-search-archives)
- ;; Explicit extra files
- (unless (symbolp org-id-extra-files)
- org-id-extra-files)
- ;; All files known to have IDs
- org-id-files
- ;; function input
- files))))
- (nfiles (length files))
- ids seen-ids (ndup 0) (i 0) file-id-alist)
- (with-temp-buffer
- (delay-mode-hooks
- (org-mode)
- (dolist (file files)
- (unless silent
- (setq i (1+ i))
- (message "Finding ID locations (%d/%d files): %s"
- i nfiles file))
- (when (file-exists-p file)
- (insert-file-contents file nil nil nil 'replace)
- (setq ids (org-map-entries
- (lambda ()
- (org-entry-get (point) "ID"))
- "ID<>\"\""))
- (dolist (id ids)
- (if (member id seen-ids)
- (progn
- (message "Duplicate ID \"%s\"" id)
- (setq ndup (1+ ndup)))
- (push id seen-ids)))
+ (unless org-id-track-globally
+ (error "Please turn on `org-id-track-globally' if you want to track IDs"))
+ (setq org-id-locations nil)
+ (let* ((files
+ (delete-dups
+ (mapcar #'file-truename
+ (cl-remove-if-not
+ ;; Default `org-id-extra-files' value contains
+ ;; `agenda-archives' symbol.
+ #'stringp
+ (append
+ ;; Agenda files and all associated archives.
+ (org-agenda-files t org-id-search-archives)
+ ;; Explicit extra files.
+ (if (symbolp org-id-extra-files)
+ (symbol-value org-id-extra-files)
+ org-id-extra-files)
+ ;; All files known to have IDs.
+ org-id-files
+ ;; Additional files from function call.
+ files)))))
+ (nfiles (length files))
+ (id-regexp
+ (rx (seq bol (0+ (any "\t ")) ":ID:" (1+ " ") (not (any " ")))))
+ (seen-ids nil)
+ (ndup 0)
+ (i 0))
+ (dolist (file files)
+ (when (file-exists-p file)
+ (unless silent
+ (cl-incf i)
+ (message "Finding ID locations (%d/%d files): %s" i nfiles file))
+ (with-current-buffer (find-file-noselect file t)
+ (let ((ids nil)
+ (case-fold-search t))
+ (org-with-point-at 1
+ (while (re-search-forward id-regexp nil t)
+ (when (org-at-property-p)
+ (push (org-entry-get (point) "ID") ids)))
(when ids
- (setq file-id-alist (cons (cons (abbreviate-file-name file) ids)
- file-id-alist)))))))
- (setq org-id-locations file-id-alist)
- (setq org-id-files (mapcar 'car org-id-locations))
- (org-id-locations-save)
- ;; now convert to a hash
- (setq org-id-locations (org-id-alist-to-hash org-id-locations))
- (when (> ndup 0)
- (warn "WARNING: %d duplicate IDs found, check *Messages* buffer" ndup))
- (message "%d files scanned, %d files contains IDs and in total %d IDs found."
- nfiles (length org-id-files) (hash-table-count org-id-locations))
- org-id-locations)))
+ (push (cons (abbreviate-file-name file) ids)
+ org-id-locations)
+ (dolist (id ids)
+ (cond
+ ((not (member id seen-ids)) (push id seen-ids))
+ (silent nil)
+ (t
+ (message "Duplicate ID %S" id)
+ (cl-incf ndup))))))))))
+ (setq org-id-files (mapcar #'car org-id-locations))
+ (org-id-locations-save)
+ ;; Now convert to a hash table.
+ (setq org-id-locations (org-id-alist-to-hash org-id-locations))
+ (when (and (not silent) (> ndup 0))
+ (warn "WARNING: %d duplicate IDs found, check *Messages* buffer" ndup))
+ (message "%d files scanned, %d files contains IDs, and %d IDs found."
+ nfiles (length org-id-files) (hash-table-count org-id-locations))
+ org-id-locations))
(defun org-id-locations-save ()
"Save `org-id-locations' in `org-id-locations-file'."
@@ -572,8 +588,10 @@ When FILES is given, scan also these files."
(defun org-id-add-location (id file)
"Add the ID with location FILE to the database of ID locations."
;; Only if global tracking is on, and when the buffer has a file
+ (unless file
+ (error "bug: org-id-get expects a file-visiting buffer"))
(let ((afile (abbreviate-file-name file)))
- (when (and org-id-track-globally id file)
+ (when (and org-id-track-globally id)
(unless org-id-locations (org-id-locations-load))
(puthash id afile org-id-locations)
(unless (member afile org-id-files)
@@ -631,7 +649,7 @@ When FILES is given, scan also these files."
(or (and org-id-locations
(hash-table-p org-id-locations)
(gethash id org-id-locations))
- ;; ball back on current buffer
+ ;; Fall back on current buffer
(buffer-file-name (or (buffer-base-buffer (current-buffer))
(current-buffer)))))
@@ -665,8 +683,11 @@ optional argument MARKERP, return the position as a new marker."
(let* ((link (concat "id:" (org-id-get-create)))
(case-fold-search nil)
(desc (save-excursion
- (org-back-to-heading t)
- (or (and (looking-at org-complex-heading-regexp)
+ (org-back-to-heading-or-point-min t)
+ (or (and (org-before-first-heading-p)
+ (file-name-nondirectory
+ (buffer-file-name (buffer-base-buffer))))
+ (and (looking-at org-complex-heading-regexp)
(if (match-end 4)
(match-string 4)
(match-string 0)))
@@ -674,7 +695,7 @@ optional argument MARKERP, return the position as a new marker."
(org-link-store-props :link link :description desc :type "id")
link)))
-(defun org-id-open (id)
+(defun org-id-open (id _)
"Go to the entry with id ID."
(org-mark-ring-push)
(let ((m (org-id-find id 'marker))
diff --git a/lisp/org/org-indent.el b/lisp/org/org-indent.el
index 5171919465b..c6bf416564e 100644
--- a/lisp/org/org-indent.el
+++ b/lisp/org/org-indent.el
@@ -1,6 +1,6 @@
;;; org-indent.el --- Dynamic indentation for Org -*- lexical-binding: t; -*-
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -71,8 +71,6 @@ Delay used when the buffer to initialize isn't current.")
(defvar org-indent--initial-marker nil
"Position of initialization before interrupt.
This is used locally in each buffer being initialized.")
-(defvar org-hide-leading-stars-before-indent-mode nil
- "Used locally.")
(defvar org-indent-modified-headline-flag nil
"Non-nil means the last deletion operated on a headline.
It is modified by `org-indent-notify-modified-headline'.")
@@ -87,15 +85,13 @@ it may be prettier to customize the `org-indent' face."
:type 'character)
(defcustom org-indent-mode-turns-off-org-adapt-indentation t
- "Non-nil means setting the variable `org-indent-mode' will \
-turn off indentation adaptation.
+ "Non-nil means setting `org-indent-mode' will turn off indentation adaptation.
For details see the variable `org-adapt-indentation'."
:group 'org-indent
:type 'boolean)
(defcustom org-indent-mode-turns-on-hiding-stars t
- "Non-nil means setting the variable `org-indent-mode' will \
-turn on `org-hide-leading-stars'."
+ "Non-nil means setting `org-indent-mode' will turn on `org-hide-leading-stars'."
:group 'org-indent
:type 'boolean)
@@ -178,10 +174,11 @@ during idle time."
(setq-local indent-tabs-mode nil)
(setq-local org-indent--initial-marker (copy-marker 1))
(when org-indent-mode-turns-off-org-adapt-indentation
- (setq-local org-adapt-indentation nil))
+ ;; Don't turn off `org-adapt-indentation' when its value is
+ ;; 'headline-data, just indent headline data specially.
+ (or (eq org-adapt-indentation 'headline-data)
+ (setq-local org-adapt-indentation nil)))
(when org-indent-mode-turns-on-hiding-stars
- (setq-local org-hide-leading-stars-before-indent-mode
- org-hide-leading-stars)
(setq-local org-hide-leading-stars t))
(org-indent--compute-prefixes)
(if (boundp 'filter-buffer-substring-functions)
@@ -207,15 +204,14 @@ during idle time."
(setq org-indent-agent-timer
(run-with-idle-timer 0.2 t #'org-indent-initialize-agent))))
(t
- ;; mode was turned off (or we refused to turn it on)
+ ;; Mode was turned off (or we refused to turn it on)
(kill-local-variable 'org-adapt-indentation)
(setq org-indent-agentized-buffers
(delq (current-buffer) org-indent-agentized-buffers))
(when (markerp org-indent--initial-marker)
(set-marker org-indent--initial-marker nil))
- (when (boundp 'org-hide-leading-stars-before-indent-mode)
- (setq-local org-hide-leading-stars
- org-hide-leading-stars-before-indent-mode))
+ (when (local-variable-p 'org-hide-leading-stars)
+ (kill-local-variable 'org-hide-leading-stars))
(if (boundp 'filter-buffer-substring-functions)
(remove-hook 'filter-buffer-substring-functions
(lambda (fun start end delete)
@@ -365,7 +361,18 @@ stopped."
level (org-list-item-body-column (point))))
;; Regular line.
(t
- (org-indent-set-line-properties level (current-indentation))))))))))
+ (org-indent-set-line-properties
+ level
+ (current-indentation)
+ ;; When adapt indentation is 'headline-data, use
+ ;; `org-indent--heading-line-prefixes' for setting
+ ;; headline data indentation.
+ (and (eq org-adapt-indentation 'headline-data)
+ (or (org-at-planning-p)
+ (org-at-clock-log-p)
+ (looking-at-p org-property-start-re)
+ (looking-at-p org-property-end-re)
+ (looking-at-p org-property-re))))))))))))
(defun org-indent-notify-modified-headline (beg end)
"Set `org-indent-modified-headline-flag' depending on context.
diff --git a/lisp/org/org-inlinetask.el b/lisp/org/org-inlinetask.el
index 60e3e0cc595..48402b092b2 100644
--- a/lisp/org/org-inlinetask.el
+++ b/lisp/org/org-inlinetask.el
@@ -1,6 +1,6 @@
;;; org-inlinetask.el --- Tasks Independent of Outline Hierarchy -*- lexical-binding: t; -*-
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
diff --git a/lisp/org/org-keys.el b/lisp/org/org-keys.el
index 4d4e1241c5a..f0fdb79ea49 100644
--- a/lisp/org/org-keys.el
+++ b/lisp/org/org-keys.el
@@ -1,6 +1,6 @@
;;; org-keys.el --- Key bindings for Org mode -*- lexical-binding: t; -*-
-;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2018-2021 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
@@ -56,7 +56,7 @@
(declare-function org-clone-subtree-with-time-shift "org" (n &optional shift))
(declare-function org-columns "org" (&optional global columns-fmt-string))
(declare-function org-comment-dwim "org" (arg))
-(declare-function org-copy "org" ())
+(declare-function org-refile-copy "org" ())
(declare-function org-copy-special "org" ())
(declare-function org-copy-visible "org" (beg end))
(declare-function org-ctrl-c-ctrl-c "org" (&optional arg))
@@ -148,7 +148,7 @@
(declare-function org-remove-file "org" (&optional file))
(declare-function org-resolve-clocks "org" (&optional only-dangling-p prompt-fn last-valid))
(declare-function org-return "org" (&optional indent))
-(declare-function org-return-indent "org" ())
+(declare-function org-return-and-maybe-indent "org" ())
(declare-function org-reveal "org" (&optional siblings))
(declare-function org-schedule "org" (arg &optional time))
(declare-function org-self-insert-command "org" (N))
@@ -196,6 +196,7 @@
(declare-function org-todo "org" (&optional arg1))
(declare-function org-toggle-archive-tag "org" (&optional find-done))
(declare-function org-toggle-checkbox "org" (&optional toggle-presence))
+(declare-function org-toggle-radio-button "org" (&optional arg))
(declare-function org-toggle-comment "org" ())
(declare-function org-toggle-fixed-width "org" ())
(declare-function org-toggle-inline-images "org" (&optional include-linked))
@@ -218,7 +219,7 @@
;;; Variables
(defvar org-mode-map (make-sparse-keymap)
- "Keymap fo Org mode.")
+ "Keymap for Org mode.")
(defvaralias 'org-CUA-compatible 'org-replace-disputed-keys)
@@ -444,7 +445,7 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names."
;;;; TAB key with modifiers
(org-defkey org-mode-map (kbd "C-i") #'org-cycle)
(org-defkey org-mode-map (kbd "<tab>") #'org-cycle)
-(org-defkey org-mode-map (kbd "C-<tab>") #'org-force-cycle-archived)
+(org-defkey org-mode-map (kbd "C-c C-<tab>") #'org-force-cycle-archived)
;; Override text-mode binding to expose `complete-symbol' for
;; pcomplete functionality.
(org-defkey org-mode-map (kbd "M-<tab>") nil)
@@ -580,7 +581,7 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names."
(org-defkey org-mode-map (kbd "C-c C-d") #'org-deadline)
(org-defkey org-mode-map (kbd "C-c ;") #'org-toggle-comment)
(org-defkey org-mode-map (kbd "C-c C-w") #'org-refile)
-(org-defkey org-mode-map (kbd "C-c M-w") #'org-copy)
+(org-defkey org-mode-map (kbd "C-c M-w") #'org-refile-copy)
(org-defkey org-mode-map (kbd "C-c /") #'org-sparse-tree) ;minor-mode reserved
(org-defkey org-mode-map (kbd "C-c \\") #'org-match-sparse-tree) ;minor-mode r.
(org-defkey org-mode-map (kbd "C-c RET") #'org-ctrl-c-ret)
@@ -617,7 +618,7 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names."
(org-defkey org-mode-map (kbd "C-c C-k") #'org-kill-note-or-show-branches)
(org-defkey org-mode-map (kbd "C-c #") #'org-update-statistics-cookies)
(org-defkey org-mode-map (kbd "RET") #'org-return)
-(org-defkey org-mode-map (kbd "C-j") #'org-return-indent)
+(org-defkey org-mode-map (kbd "C-j") #'org-return-and-maybe-indent)
(org-defkey org-mode-map (kbd "C-c ?") #'org-table-field-info)
(org-defkey org-mode-map (kbd "C-c SPC") #'org-table-blank-field)
(org-defkey org-mode-map (kbd "C-c +") #'org-table-sum)
@@ -658,6 +659,7 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names."
(org-defkey org-mode-map (kbd "C-c C-x C-M-v") #'org-redisplay-inline-images)
(org-defkey org-mode-map (kbd "C-c C-x \\") #'org-toggle-pretty-entities)
(org-defkey org-mode-map (kbd "C-c C-x C-b") #'org-toggle-checkbox)
+(org-defkey org-mode-map (kbd "C-c C-x C-r") #'org-toggle-radio-button)
(org-defkey org-mode-map (kbd "C-c C-x p") #'org-set-property)
(org-defkey org-mode-map (kbd "C-c C-x P") #'org-set-property-and-value)
(org-defkey org-mode-map (kbd "C-c C-x e") #'org-set-effort)
@@ -923,6 +925,10 @@ a-list placed behind the generic `org-babel-key-prefix'.")
(interactive)
(describe-bindings org-babel-key-prefix))
-
(provide 'org-keys)
+
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
;;; org-keys.el ends here
diff --git a/lisp/org/org-lint.el b/lisp/org/org-lint.el
index 5be1ec72863..2e080cc138f 100644
--- a/lisp/org/org-lint.el
+++ b/lisp/org/org-lint.el
@@ -1,6 +1,6 @@
;;; org-lint.el --- Linting for Org documents -*- lexical-binding: t; -*-
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -108,6 +108,7 @@
(require 'cl-lib)
(require 'ob)
(require 'ol)
+(require 'org-attach)
(require 'org-macro)
(require 'ox)
@@ -423,8 +424,10 @@ instead"
(defun org-lint-deprecated-header-syntax (ast)
(let* ((deprecated-babel-properties
- (mapcar (lambda (arg) (symbol-name (car arg)))
- org-babel-common-header-args-w-values))
+ ;; DIR is also used for attachments.
+ (delete "dir"
+ (mapcar (lambda (arg) (downcase (symbol-name (car arg))))
+ org-babel-common-header-args-w-values)))
(deprecated-re
(format "\\`%s[ \t]" (regexp-opt deprecated-babel-properties t))))
(org-element-map ast '(keyword node-property)
@@ -541,15 +544,16 @@ Use :header-args: instead"
(org-element-map ast 'drawer
(lambda (d)
(when (equal (org-element-property :drawer-name d) "PROPERTIES")
- (let ((section (org-element-lineage d '(section))))
- (unless (org-element-map section 'property-drawer #'identity nil t)
- (list (org-element-property :post-affiliated d)
- (if (save-excursion
- (goto-char (org-element-property :post-affiliated d))
- (forward-line -1)
- (or (org-at-heading-p) (org-at-planning-p)))
- "Incorrect contents for PROPERTIES drawer"
- "Incorrect location for PROPERTIES drawer"))))))))
+ (let ((headline? (org-element-lineage d '(headline)))
+ (before
+ (mapcar #'org-element-type
+ (assq d (reverse (org-element-contents
+ (org-element-property :parent d)))))))
+ (list (org-element-property :post-affiliated d)
+ (if (or (and headline? (member before '(nil (planning))))
+ (and (null headline?) (member before '(nil (comment)))))
+ "Incorrect contents for PROPERTIES drawer"
+ "Incorrect location for PROPERTIES drawer")))))))
(defun org-lint-invalid-effort-property (ast)
(org-element-map ast 'node-property
@@ -564,16 +568,23 @@ Use :header-args: instead"
(defun org-lint-link-to-local-file (ast)
(org-element-map ast 'link
(lambda (l)
- (when (equal "file" (org-element-property :type l))
- (let ((file (org-element-property :path l)))
- (and (not (file-remote-p file))
- (not (file-exists-p file))
- (list (org-element-property :begin l)
- (format (if (org-element-lineage l '(link))
- "Link to non-existent image file \"%s\"\
- in link description"
- "Link to non-existent local file \"%s\"")
- file))))))))
+ (let ((type (org-element-property :type l)))
+ (pcase type
+ ((or "attachment" "file")
+ (let* ((path (org-element-property :path l))
+ (file (if (string= type "file")
+ path
+ (org-with-point-at (org-element-property :begin l)
+ (org-attach-expand path)))))
+ (and (not (file-remote-p file))
+ (not (file-exists-p file))
+ (list (org-element-property :begin l)
+ (format (if (org-element-lineage l '(link))
+ "Link to non-existent image file %S \
+in description"
+ "Link to non-existent local file %S")
+ file)))))
+ (_ nil))))))
(defun org-lint-non-existent-setupfile-parameter (ast)
(org-element-map ast 'keyword
@@ -793,15 +804,25 @@ Use \"export %s\" instead"
(let ((name (org-trim (match-string-no-properties 0)))
(element (org-element-at-point)))
(pcase (org-element-type element)
- ((or `drawer `property-drawer)
- (goto-char (org-element-property :end element))
- nil)
+ (`drawer
+ ;; Find drawer opening lines within non-empty drawers.
+ (let ((end (org-element-property :contents-end element)))
+ (when end
+ (while (re-search-forward org-drawer-regexp end t)
+ (let ((n (org-trim (match-string-no-properties 0))))
+ (push (list (line-beginning-position)
+ (format "Possible misleading drawer entry %S" n))
+ reports))))
+ (goto-char (org-element-property :end element))))
+ (`property-drawer
+ (goto-char (org-element-property :end element)))
((or `comment-block `example-block `export-block `src-block
`verse-block)
nil)
(_
+ ;; Find drawer opening lines outside of any drawer.
(push (list (line-beginning-position)
- (format "Possible incomplete drawer \"%s\"" name))
+ (format "Possible incomplete drawer %S" name))
reports)))))
reports))
@@ -1257,6 +1278,10 @@ ARG can also be a list of checker names, as symbols, to run."
(org-lint--display-reports (current-buffer) checkers)
(message "Org linting process completed"))))
-
(provide 'org-lint)
+
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
;;; org-lint.el ends here
diff --git a/lisp/org/org-list.el b/lisp/org/org-list.el
index c79325f1f33..39122e7ce41 100644
--- a/lisp/org/org-list.el
+++ b/lisp/org/org-list.el
@@ -1,6 +1,6 @@
;;; org-list.el --- Plain lists for Org -*- lexical-binding: t; -*-
;;
-;; Copyright (C) 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Bastien Guerry <bzg@gnu.org>
@@ -81,12 +81,12 @@
(require 'org-compat)
(defvar org-M-RET-may-split-line)
+(defvar org-adapt-indentation)
(defvar org-auto-align-tags)
(defvar org-blank-before-new-entry)
(defvar org-clock-string)
(defvar org-closed-string)
(defvar org-deadline-string)
-(defvar org-description-max-indent)
(defvar org-done-keywords)
(defvar org-drawer-regexp)
(defvar org-element-all-objects)
@@ -132,6 +132,7 @@
(declare-function org-inlinetask-in-task-p "org-inlinetask" ())
(declare-function org-inlinetask-outline-regexp "org-inlinetask" ())
(declare-function org-level-increment "org" ())
+(declare-function org-mode "org" ())
(declare-function org-narrow-to-subtree "org" ())
(declare-function org-outline-level "org" ())
(declare-function org-previous-line-empty-p "org" ())
@@ -911,13 +912,13 @@ items, as returned by `org-list-prevs-alist'."
STRUCT is the list structure."
(let* ((item-end (org-list-get-item-end item struct))
(sub-struct (cdr (member (assq item struct) struct)))
- subtree)
- (catch 'exit
- (mapc (lambda (e)
- (let ((pos (car e)))
- (if (< pos item-end) (push pos subtree) (throw 'exit nil))))
- sub-struct))
- (nreverse subtree)))
+ items)
+ (catch :exit
+ (pcase-dolist (`(,pos . ,_) sub-struct)
+ (if (< pos item-end)
+ (push pos items)
+ (throw :exit nil))))
+ (nreverse items)))
(defun org-list-get-all-items (item struct prevs)
"List all items in the same sub-list as ITEM.
@@ -1234,125 +1235,127 @@ after the bullet. Cursor will be after this text once the
function ends.
This function modifies STRUCT."
- (let ((case-fold-search t))
- ;; 1. Get information about list: ITEM containing POS, position of
- ;; point with regards to item start (BEFOREP), blank lines
- ;; number separating items (BLANK-NB), if we're allowed to
- ;; (SPLIT-LINE-P).
- (let* ((item (goto-char (catch :exit
- (let ((inner-item 0))
- (pcase-dolist (`(,i . ,_) struct)
- (cond
- ((= i pos) (throw :exit i))
- ((< i pos) (setq inner-item i))
- (t (throw :exit inner-item))))
- inner-item))))
- (item-end (org-list-get-item-end item struct))
- (item-end-no-blank (org-list-get-item-end-before-blank item struct))
- (beforep
- (progn
- (looking-at org-list-full-item-re)
- (<= pos
- (cond
- ((not (match-beginning 4)) (match-end 0))
- ;; Ignore tag in a non-descriptive list.
- ((save-match-data (string-match "[.)]" (match-string 1)))
- (match-beginning 4))
- (t (save-excursion
- (goto-char (match-end 4))
- (skip-chars-forward " \t")
- (point)))))))
- (split-line-p (org-get-alist-option org-M-RET-may-split-line 'item))
- (blank-nb (org-list-separating-blank-lines-number
- pos struct prevs))
- ;; 2. Build the new item to be created. Concatenate same
- ;; bullet as item, checkbox, text AFTER-BULLET if
- ;; provided, and text cut from point to end of item
- ;; (TEXT-CUT) to form item's BODY. TEXT-CUT depends on
- ;; BEFOREP and SPLIT-LINE-P. The difference of size
- ;; between what was cut and what was inserted in buffer
- ;; is stored in SIZE-OFFSET.
- (ind (org-list-get-ind item struct))
- (ind-size (if indent-tabs-mode
- (+ (/ ind tab-width) (mod ind tab-width))
- ind))
- (bullet (org-list-bullet-string (org-list-get-bullet item struct)))
- (box (when checkbox "[ ]"))
- (text-cut
- (and (not beforep) split-line-p
- (progn
- (goto-char pos)
- ;; If POS is greater than ITEM-END, then point is
- ;; in some white lines after the end of the list.
- ;; Those must be removed, or they will be left,
- ;; stacking up after the list.
- (when (< item-end pos)
- (delete-region (1- item-end) (point-at-eol)))
- (skip-chars-backward " \r\t\n")
- (setq pos (point))
- (delete-and-extract-region pos item-end-no-blank))))
- (body (concat bullet (when box (concat box " ")) after-bullet
- (and text-cut
- (if (string-match "\\`[ \t]+" text-cut)
- (replace-match "" t t text-cut)
- text-cut))))
- (item-sep (make-string (1+ blank-nb) ?\n))
- (item-size (+ ind-size (length body) (length item-sep)))
- (size-offset (- item-size (length text-cut))))
- ;; 4. Insert effectively item into buffer.
- (goto-char item)
- (indent-to-column ind)
- (insert body item-sep)
- ;; 5. Add new item to STRUCT.
- (mapc (lambda (e)
- (let ((p (car e)) (end (nth 6 e)))
- (cond
- ;; Before inserted item, positions don't change but
- ;; an item ending after insertion has its end shifted
- ;; by SIZE-OFFSET.
- ((< p item)
- (when (> end item) (setcar (nthcdr 6 e) (+ end size-offset))))
- ;; Trivial cases where current item isn't split in
- ;; two. Just shift every item after new one by
- ;; ITEM-SIZE.
- ((or beforep (not split-line-p))
- (setcar e (+ p item-size))
- (setcar (nthcdr 6 e) (+ end item-size)))
- ;; Item is split in two: elements before POS are just
- ;; shifted by ITEM-SIZE. In the case item would end
- ;; after split POS, ending is only shifted by
- ;; SIZE-OFFSET.
- ((< p pos)
- (setcar e (+ p item-size))
- (if (< end pos)
- (setcar (nthcdr 6 e) (+ end item-size))
- (setcar (nthcdr 6 e) (+ end size-offset))))
- ;; Elements after POS are moved into new item.
- ;; Length of ITEM-SEP has to be removed as ITEM-SEP
- ;; doesn't appear in buffer yet.
- ((< p item-end)
- (setcar e (+ p size-offset (- item pos (length item-sep))))
- (if (= end item-end)
- (setcar (nthcdr 6 e) (+ item item-size))
- (setcar (nthcdr 6 e)
- (+ end size-offset
- (- item pos (length item-sep))))))
- ;; Elements at ITEM-END or after are only shifted by
- ;; SIZE-OFFSET.
- (t (setcar e (+ p size-offset))
- (setcar (nthcdr 6 e) (+ end size-offset))))))
- struct)
- (push (list item ind bullet nil box nil (+ item item-size)) struct)
- (setq struct (sort struct (lambda (e1 e2) (< (car e1) (car e2)))))
- ;; 6. If not BEFOREP, new item must appear after ITEM, so
- ;; exchange ITEM with the next item in list. Position cursor
- ;; after bullet, counter, checkbox, and label.
- (if beforep
- (goto-char item)
- (setq struct (org-list-swap-items item (+ item item-size) struct))
- (goto-char (org-list-get-next-item
- item struct (org-list-prevs-alist struct))))
- struct)))
+ (let* ((case-fold-search t)
+ ;; Get information about list: ITEM containing POS, position
+ ;; of point with regards to item start (BEFOREP), blank lines
+ ;; number separating items (BLANK-NB), if we're allowed to
+ ;; (SPLIT-LINE-P).
+ (item
+ (catch :exit
+ (let ((i nil))
+ (pcase-dolist (`(,start ,_ ,_ ,_ ,_ ,_ ,end) struct)
+ (cond
+ ((> start pos) (throw :exit i))
+ ((< end pos) nil) ;skip sub-lists before point
+ (t (setq i start))))
+ ;; If no suitable item is found, insert a sibling of the
+ ;; last item in buffer.
+ (or i (caar (reverse struct))))))
+ (item-end (org-list-get-item-end item struct))
+ (item-end-no-blank (org-list-get-item-end-before-blank item struct))
+ (beforep
+ (progn
+ (goto-char item)
+ (looking-at org-list-full-item-re)
+ (<= pos
+ (cond
+ ((not (match-beginning 4)) (match-end 0))
+ ;; Ignore tag in a non-descriptive list.
+ ((save-match-data (string-match "[.)]" (match-string 1)))
+ (match-beginning 4))
+ (t (save-excursion
+ (goto-char (match-end 4))
+ (skip-chars-forward " \t")
+ (point)))))))
+ (split-line-p (org-get-alist-option org-M-RET-may-split-line 'item))
+ (blank-nb (org-list-separating-blank-lines-number pos struct prevs))
+ ;; Build the new item to be created. Concatenate same bullet
+ ;; as item, checkbox, text AFTER-BULLET if provided, and text
+ ;; cut from point to end of item (TEXT-CUT) to form item's
+ ;; BODY. TEXT-CUT depends on BEFOREP and SPLIT-LINE-P. The
+ ;; difference of size between what was cut and what was
+ ;; inserted in buffer is stored in SIZE-OFFSET.
+ (ind (org-list-get-ind item struct))
+ (ind-size (if indent-tabs-mode
+ (+ (/ ind tab-width) (mod ind tab-width))
+ ind))
+ (bullet (org-list-bullet-string (org-list-get-bullet item struct)))
+ (box (and checkbox "[ ]"))
+ (text-cut
+ (and (not beforep)
+ split-line-p
+ (progn
+ (goto-char pos)
+ ;; If POS is greater than ITEM-END, then point is in
+ ;; some white lines after the end of the list. Those
+ ;; must be removed, or they will be left, stacking up
+ ;; after the list.
+ (when (< item-end pos)
+ (delete-region (1- item-end) (point-at-eol)))
+ (skip-chars-backward " \r\t\n")
+ ;; Cut position is after any blank on the line.
+ (save-excursion
+ (skip-chars-forward " \t")
+ (setq pos (point)))
+ (delete-and-extract-region (point) item-end-no-blank))))
+ (body
+ (concat bullet
+ (and box (concat box " "))
+ after-bullet
+ (and text-cut
+ (if (string-match "\\`[ \t]+" text-cut)
+ (replace-match "" t t text-cut)
+ text-cut))))
+ (item-sep (make-string (1+ blank-nb) ?\n))
+ (item-size (+ ind-size (length body) (length item-sep)))
+ (size-offset (- item-size (length text-cut))))
+ ;; Insert effectively item into buffer.
+ (goto-char item)
+ (indent-to-column ind)
+ (insert body item-sep)
+ ;; Add new item to STRUCT.
+ (dolist (e struct)
+ (let ((p (car e)) (end (nth 6 e)))
+ (cond
+ ;; Before inserted item, positions don't change but an item
+ ;; ending after insertion has its end shifted by SIZE-OFFSET.
+ ((< p item)
+ (when (> end item)
+ (setcar (nthcdr 6 e) (+ end size-offset))))
+ ;; Item where insertion happens may be split in two parts.
+ ;; In this case, move start by ITEM-SIZE and end by
+ ;; SIZE-OFFSET.
+ ((and (= p item) (not beforep) split-line-p)
+ (setcar e (+ p item-size))
+ (setcar (nthcdr 6 e) (+ end size-offset)))
+ ;; Items starting after modified item fall into two
+ ;; categories.
+ ;;
+ ;; If modified item was split, and current sub-item was
+ ;; located after split point, it was moved to the new item:
+ ;; the part between body start and split point (POS) was
+ ;; removed. So we compute the length of that part and shift
+ ;; item's positions accordingly.
+ ;;
+ ;; Otherwise, the item was simply shifted by SIZE-OFFSET.
+ ((and split-line-p (not beforep) (>= p pos) (<= p item-end-no-blank))
+ (let ((offset (- pos item ind (length bullet) (length after-bullet))))
+ (setcar e (- p offset))
+ (setcar (nthcdr 6 e) (- end offset))))
+ (t
+ (setcar e (+ p size-offset))
+ (setcar (nthcdr 6 e) (+ end size-offset))))))
+ (push (list item ind bullet nil box nil (+ item item-size)) struct)
+ (setq struct (sort struct #'car-less-than-car))
+ ;; If not BEFOREP, new item must appear after ITEM, so exchange
+ ;; ITEM with the next item in list. Position cursor after bullet,
+ ;; counter, checkbox, and label.
+ (if beforep
+ (goto-char item)
+ (setq struct (org-list-swap-items item (+ item item-size) struct))
+ (goto-char (org-list-get-next-item
+ item struct (org-list-prevs-alist struct))))
+ struct))
(defun org-list-delete-item (item struct)
"Remove ITEM from the list and return the new structure.
@@ -1793,10 +1796,9 @@ This function modifies STRUCT."
;; There are boxes checked after an unchecked one: fix that.
(when (member "[X]" after-unchecked)
(let ((index (- (length struct) (length after-unchecked))))
- (mapc (lambda (e)
- (when (org-list-get-checkbox e struct)
- (org-list-set-checkbox e struct "[ ]")))
- (nthcdr index all-items))
+ (dolist (e (nthcdr index all-items))
+ (when (org-list-get-checkbox e struct)
+ (org-list-set-checkbox e struct "[ ]")))
;; Verify once again the structure, without ORDERED.
(org-list-struct-fix-box struct parents prevs nil)
;; Return blocking item.
@@ -1807,24 +1809,22 @@ This function modifies STRUCT."
This function modifies STRUCT."
(let (end-list acc-end)
- (mapc (lambda (e)
- (let* ((pos (car e))
- (ind-pos (org-list-get-ind pos struct))
- (end-pos (org-list-get-item-end pos struct)))
- (unless (assq end-pos struct)
- ;; To determine real ind of an ending position that is
- ;; not at an item, we have to find the item it belongs
- ;; to: it is the last item (ITEM-UP), whose ending is
- ;; further than the position we're interested in.
- (let ((item-up (assoc-default end-pos acc-end '>)))
- (push (cons
- ;; Else part is for the bottom point.
- (if item-up (+ (org-list-get-ind item-up struct) 2) 0)
- end-pos)
- end-list)))
- (push (cons ind-pos pos) end-list)
- (push (cons end-pos pos) acc-end)))
- struct)
+ (pcase-dolist (`(,pos . ,_) struct)
+ (let ((ind-pos (org-list-get-ind pos struct))
+ (end-pos (org-list-get-item-end pos struct)))
+ (unless (assq end-pos struct)
+ ;; To determine real ind of an ending position that is not
+ ;; at an item, we have to find the item it belongs to: it is
+ ;; the last item (ITEM-UP), whose ending is further than the
+ ;; position we're interested in.
+ (let ((item-up (assoc-default end-pos acc-end #'>)))
+ (push (cons
+ ;; Else part is for the bottom point.
+ (if item-up (+ (org-list-get-ind item-up struct) 2) 0)
+ end-pos)
+ end-list)))
+ (push (cons ind-pos pos) end-list)
+ (push (cons end-pos pos) acc-end)))
(setq end-list (sort end-list (lambda (e1 e2) (< (cdr e1) (cdr e2)))))
(org-list-struct-assoc-end struct end-list)))
@@ -2021,10 +2021,9 @@ beginning of the item."
(item (copy-marker (point-at-bol)))
(all (org-list-get-all-items (marker-position item) struct prevs))
(value init-value))
- (mapc (lambda (e)
- (goto-char e)
- (setq value (apply function value args)))
- (nreverse all))
+ (dolist (e (nreverse all))
+ (goto-char e)
+ (setq value (apply function value args)))
(goto-char item)
(move-marker item nil)
value))
@@ -2046,9 +2045,8 @@ Possible values are: `folded', `children' or `subtree'. See
;; Then fold every child.
(let* ((parents (org-list-parents-alist struct))
(children (org-list-get-children item struct parents)))
- (mapc (lambda (e)
- (org-list-set-item-visibility e struct 'folded))
- children)))
+ (dolist (child children)
+ (org-list-set-item-visibility child struct 'folded))))
((eq view 'subtree)
;; Show everything
(let ((item-end (org-list-get-item-end item struct)))
@@ -2303,6 +2301,56 @@ is an integer, 0 means `-', 1 means `+' etc. If WHICH is
(org-list-struct-fix-ind struct parents)
(org-list-struct-apply-struct struct old-struct)))))
+;;;###autoload
+(define-minor-mode org-list-checkbox-radio-mode
+ "When turned on, use list checkboxes as radio buttons."
+ nil " CheckBoxRadio" nil
+ (unless (eq major-mode 'org-mode)
+ (user-error "Cannot turn this mode outside org-mode buffers")))
+
+(defun org-toggle-radio-button (&optional arg)
+ "Toggle off all checkboxes and toggle on the one at point."
+ (interactive "P")
+ (if (not (org-at-item-p))
+ (user-error "Cannot toggle checkbox outside of a list")
+ (let* ((cpos (org-in-item-p))
+ (struct (org-list-struct))
+ (orderedp (org-entry-get nil "ORDERED"))
+ (parents (org-list-parents-alist struct))
+ (old-struct (copy-tree struct))
+ (cbox (org-list-get-checkbox cpos struct))
+ (prevs (org-list-prevs-alist struct))
+ (start (org-list-get-list-begin (point-at-bol) struct prevs))
+ (new (unless (and cbox (equal arg '(4)) (equal start cpos))
+ "[ ]")))
+ (dolist (pos (org-list-get-all-items
+ start struct (org-list-prevs-alist struct)))
+ (org-list-set-checkbox pos struct new))
+ (when new
+ (org-list-set-checkbox
+ cpos struct
+ (cond ((equal arg '(4)) (unless cbox "[ ]"))
+ ((equal arg '(16)) (unless cbox "[-]"))
+ (t (if (equal cbox "[X]") "[ ]" "[X]")))))
+ (org-list-struct-fix-box struct parents prevs orderedp)
+ (org-list-struct-apply-struct struct old-struct)
+ (org-update-checkbox-count-maybe))))
+
+(defun org-at-radio-list-p ()
+ "Is point at a list item with radio buttons?"
+ (when (org-match-line (org-item-re)) ;short-circuit
+ (let* ((e (save-excursion (beginning-of-line) (org-element-at-point))))
+ ;; Check we're really on a line with a bullet.
+ (when (memq (org-element-type e) '(item plain-list))
+ ;; Look for ATTR_ORG attribute in the current plain list.
+ (let ((plain-list (org-element-lineage e '(plain-list) t)))
+ (org-with-point-at (org-element-property :post-affiliated plain-list)
+ (let ((case-fold-search t)
+ (regexp "^[ \t]*#\\+attr_org:.* :radio \\(\\S-+\\)")
+ (begin (org-element-property :begin plain-list)))
+ (and (re-search-backward regexp begin t)
+ (not (string-equal "nil" (match-string 1)))))))))))
+
(defun org-toggle-checkbox (&optional toggle-presence)
"Toggle the checkbox in the current line.
@@ -2317,92 +2365,94 @@ If point is on a headline, apply this to all checkbox items in
the text below the heading, taking as reference the first item in
subtree, ignoring planning line and any drawer following it."
(interactive "P")
- (save-excursion
- (let* (singlep
- block-item
- lim-up
- lim-down
- (orderedp (org-entry-get nil "ORDERED"))
- (_bounds
- ;; In a region, start at first item in region.
+ (if (org-at-radio-list-p)
+ (org-toggle-radio-button toggle-presence)
+ (save-excursion
+ (let* (singlep
+ block-item
+ lim-up
+ lim-down
+ (orderedp (org-entry-get nil "ORDERED"))
+ (_bounds
+ ;; In a region, start at first item in region.
+ (cond
+ ((org-region-active-p)
+ (let ((limit (region-end)))
+ (goto-char (region-beginning))
+ (if (org-list-search-forward (org-item-beginning-re) limit t)
+ (setq lim-up (point-at-bol))
+ (error "No item in region"))
+ (setq lim-down (copy-marker limit))))
+ ((org-at-heading-p)
+ ;; On a heading, start at first item after drawers and
+ ;; time-stamps (scheduled, etc.).
+ (let ((limit (save-excursion (outline-next-heading) (point))))
+ (org-end-of-meta-data t)
+ (if (org-list-search-forward (org-item-beginning-re) limit t)
+ (setq lim-up (point-at-bol))
+ (error "No item in subtree"))
+ (setq lim-down (copy-marker limit))))
+ ;; Just one item: set SINGLEP flag.
+ ((org-at-item-p)
+ (setq singlep t)
+ (setq lim-up (point-at-bol)
+ lim-down (copy-marker (point-at-eol))))
+ (t (error "Not at an item or heading, and no active region"))))
+ ;; Determine the checkbox going to be applied to all items
+ ;; within bounds.
+ (ref-checkbox
+ (progn
+ (goto-char lim-up)
+ (let ((cbox (and (org-at-item-checkbox-p) (match-string 1))))
+ (cond
+ ((equal toggle-presence '(16)) "[-]")
+ ((equal toggle-presence '(4))
+ (unless cbox "[ ]"))
+ ((equal "[X]" cbox) "[ ]")
+ (t "[X]"))))))
+ ;; When an item is found within bounds, grab the full list at
+ ;; point structure, then: (1) set check-box of all its items
+ ;; within bounds to REF-CHECKBOX, (2) fix check-boxes of the
+ ;; whole list, (3) move point after the list.
+ (goto-char lim-up)
+ (while (and (< (point) lim-down)
+ (org-list-search-forward (org-item-beginning-re)
+ lim-down 'move))
+ (let* ((struct (org-list-struct))
+ (struct-copy (copy-tree struct))
+ (parents (org-list-parents-alist struct))
+ (prevs (org-list-prevs-alist struct))
+ (bottom (copy-marker (org-list-get-bottom-point struct)))
+ (items-to-toggle (cl-remove-if
+ (lambda (e) (or (< e lim-up) (> e lim-down)))
+ (mapcar #'car struct))))
+ (dolist (e items-to-toggle)
+ (org-list-set-checkbox
+ e struct
+ ;; If there is no box at item, leave as-is unless
+ ;; function was called with C-u prefix.
+ (let ((cur-box (org-list-get-checkbox e struct)))
+ (if (or cur-box (equal toggle-presence '(4)))
+ ref-checkbox
+ cur-box))))
+ (setq block-item (org-list-struct-fix-box
+ struct parents prevs orderedp))
+ ;; Report some problems due to ORDERED status of subtree.
+ ;; If only one box was being checked, throw an error, else,
+ ;; only signal problems.
(cond
- ((org-region-active-p)
- (let ((limit (region-end)))
- (goto-char (region-beginning))
- (if (org-list-search-forward (org-item-beginning-re) limit t)
- (setq lim-up (point-at-bol))
- (error "No item in region"))
- (setq lim-down (copy-marker limit))))
- ((org-at-heading-p)
- ;; On a heading, start at first item after drawers and
- ;; time-stamps (scheduled, etc.).
- (let ((limit (save-excursion (outline-next-heading) (point))))
- (org-end-of-meta-data t)
- (if (org-list-search-forward (org-item-beginning-re) limit t)
- (setq lim-up (point-at-bol))
- (error "No item in subtree"))
- (setq lim-down (copy-marker limit))))
- ;; Just one item: set SINGLEP flag.
- ((org-at-item-p)
- (setq singlep t)
- (setq lim-up (point-at-bol)
- lim-down (copy-marker (point-at-eol))))
- (t (error "Not at an item or heading, and no active region"))))
- ;; Determine the checkbox going to be applied to all items
- ;; within bounds.
- (ref-checkbox
- (progn
- (goto-char lim-up)
- (let ((cbox (and (org-at-item-checkbox-p) (match-string 1))))
- (cond
- ((equal toggle-presence '(16)) "[-]")
- ((equal toggle-presence '(4))
- (unless cbox "[ ]"))
- ((equal "[X]" cbox) "[ ]")
- (t "[X]"))))))
- ;; When an item is found within bounds, grab the full list at
- ;; point structure, then: (1) set check-box of all its items
- ;; within bounds to REF-CHECKBOX, (2) fix check-boxes of the
- ;; whole list, (3) move point after the list.
- (goto-char lim-up)
- (while (and (< (point) lim-down)
- (org-list-search-forward (org-item-beginning-re)
- lim-down 'move))
- (let* ((struct (org-list-struct))
- (struct-copy (copy-tree struct))
- (parents (org-list-parents-alist struct))
- (prevs (org-list-prevs-alist struct))
- (bottom (copy-marker (org-list-get-bottom-point struct)))
- (items-to-toggle (cl-remove-if
- (lambda (e) (or (< e lim-up) (> e lim-down)))
- (mapcar #'car struct))))
- (mapc (lambda (e) (org-list-set-checkbox
- e struct
- ;; If there is no box at item, leave as-is
- ;; unless function was called with C-u prefix.
- (let ((cur-box (org-list-get-checkbox e struct)))
- (if (or cur-box (equal toggle-presence '(4)))
- ref-checkbox
- cur-box))))
- items-to-toggle)
- (setq block-item (org-list-struct-fix-box
- struct parents prevs orderedp))
- ;; Report some problems due to ORDERED status of subtree.
- ;; If only one box was being checked, throw an error, else,
- ;; only signal problems.
- (cond
- ((and singlep block-item (> lim-up block-item))
- (error
- "Checkbox blocked because of unchecked box at line %d"
- (org-current-line block-item)))
- (block-item
- (message
- "Checkboxes were removed due to unchecked box at line %d"
- (org-current-line block-item))))
- (goto-char bottom)
- (move-marker bottom nil)
- (org-list-struct-apply-struct struct struct-copy)))
- (move-marker lim-down nil)))
+ ((and singlep block-item (> lim-up block-item))
+ (error
+ "Checkbox blocked because of unchecked box at line %d"
+ (org-current-line block-item)))
+ (block-item
+ (message
+ "Checkboxes were removed due to unchecked box at line %d"
+ (org-current-line block-item))))
+ (goto-char bottom)
+ (move-marker bottom nil)
+ (org-list-struct-apply-struct struct struct-copy)))
+ (move-marker lim-down nil))))
(org-update-checkbox-count-maybe))
(defun org-reset-checkbox-state-subtree ()
@@ -2632,10 +2682,9 @@ Return t if successful."
(org-list-bullet-string "-")))
;; Shift every item by OFFSET and fix bullets. Then
;; apply changes to buffer.
- (mapc (lambda (e)
- (let ((ind (org-list-get-ind (car e) struct)))
- (org-list-set-ind (car e) struct (+ ind offset))))
- struct)
+ (pcase-dolist (`(,pos . ,_) struct)
+ (let ((ind (org-list-get-ind pos struct)))
+ (org-list-set-ind pos struct (+ ind offset))))
(org-list-struct-fix-bul struct prevs)
(org-list-struct-apply-struct struct old-struct))))
;; Forbidden move:
@@ -2733,51 +2782,83 @@ If a region is active, all items inside will be moved."
(t (error "Not at an item")))))
(defvar org-tab-ind-state)
-(defvar org-adapt-indentation)
(defun org-cycle-item-indentation ()
"Cycle levels of indentation of an empty item.
+
The first run indents the item, if applicable. Subsequent runs
outdent it at meaningful levels in the list. When done, item is
put back at its original position with its original bullet.
Return t at each successful move."
(when (org-at-item-p)
- (let* ((org-adapt-indentation nil)
- (struct (org-list-struct))
- (ind (org-list-get-ind (point-at-bol) struct))
- (bullet (org-trim (buffer-substring (point-at-bol) (point-at-eol)))))
+ (let* ((struct (org-list-struct))
+ (item (line-beginning-position))
+ (ind (org-list-get-ind item struct)))
;; Accept empty items or if cycle has already started.
(when (or (eq last-command 'org-cycle-item-indentation)
- (and (save-excursion
- (beginning-of-line)
- (looking-at org-list-full-item-re))
- (>= (match-end 0) (save-excursion
- (goto-char (org-list-get-item-end
- (point-at-bol) struct))
- (skip-chars-backward " \r\t\n")
- (point)))))
+ (and (org-match-line org-list-full-item-re)
+ (>= (match-end 0)
+ (save-excursion
+ (goto-char (org-list-get-item-end item struct))
+ (skip-chars-backward " \t\n")
+ (point)))))
(setq this-command 'org-cycle-item-indentation)
- ;; When in the middle of the cycle, try to outdent first. If
- ;; it fails, and point is still at initial position, indent.
- ;; Else, re-create it at its original position.
- (if (eq last-command 'org-cycle-item-indentation)
+ (let ((prevs (org-list-prevs-alist struct))
+ (parents (org-list-parents-alist struct)))
+ (if (eq last-command 'org-cycle-item-indentation)
+ ;; When in the middle of the cycle, try to outdent. If
+ ;; it fails, move point back to its initial position and
+ ;; reset cycle.
+ (pcase-let ((`(,old-ind . ,old-bul) org-tab-ind-state)
+ (allow-outdent
+ (lambda (struct prevs parents)
+ ;; Non-nil if current item can be
+ ;; outdented.
+ (and (not (org-list-get-next-item item nil prevs))
+ (not (org-list-has-child-p item struct))
+ (org-list-get-parent item struct parents)))))
+ (cond
+ ((and (> ind old-ind)
+ (org-list-get-prev-item item nil prevs))
+ (org-list-indent-item-generic 1 t struct))
+ ((and (< ind old-ind)
+ (funcall allow-outdent struct prevs parents))
+ (org-list-indent-item-generic -1 t struct))
+ (t
+ (delete-region (line-beginning-position) (line-end-position))
+ (indent-to-column old-ind)
+ (insert old-bul " ")
+ (let* ((struct (org-list-struct))
+ (parents (org-list-parents-alist struct)))
+ (if (and (> ind old-ind)
+ ;; We were previously indenting item. It
+ ;; is no longer possible. Try to outdent
+ ;; from initial position.
+ (funcall allow-outdent
+ struct
+ (org-list-prevs-alist struct)
+ parents))
+ (org-list-indent-item-generic -1 t struct)
+ (org-list-write-struct struct parents)
+ ;; Start cycle over.
+ (setq this-command 'identity)
+ t)))))
+ ;; If a cycle is starting, remember initial indentation
+ ;; and bullet, then try to indent. If it fails, try to
+ ;; outdent.
+ (setq org-tab-ind-state
+ (cons ind (org-trim (org-current-line-string))))
(cond
- ((ignore-errors (org-list-indent-item-generic -1 t struct)))
- ((and (= ind (car org-tab-ind-state))
- (ignore-errors (org-list-indent-item-generic 1 t struct))))
- (t (delete-region (point-at-bol) (point-at-eol))
- (indent-to-column (car org-tab-ind-state))
- (insert (cdr org-tab-ind-state) " ")
- ;; Break cycle
- (setq this-command 'identity)))
- ;; If a cycle is starting, remember indentation and bullet,
- ;; then try to indent. If it fails, try to outdent.
- (setq org-tab-ind-state (cons ind bullet))
- (cond
- ((ignore-errors (org-list-indent-item-generic 1 t struct)))
- ((ignore-errors (org-list-indent-item-generic -1 t struct)))
- (t (user-error "Cannot move item"))))
- t))))
+ ((org-list-get-prev-item item nil prevs)
+ (org-list-indent-item-generic 1 t struct))
+ ((and (not (org-list-get-next-item item nil prevs))
+ (org-list-get-parent item struct parents))
+ (org-list-indent-item-generic -1 t struct))
+ (t
+ ;; This command failed. So will the following one.
+ ;; There's no point in starting the cycle.
+ (setq this-command 'identity)
+ (user-error "Cannot move item")))))))))
(defun org-sort-list
(&optional with-case sorting-type getkey-func compare-func interactive?)
@@ -2794,8 +2875,8 @@ if the current locale allows for it.
The command prompts for the sorting type unless it has been given
to the function through the SORTING-TYPE argument, which needs to
-be a character, \(?n ?N ?a ?A ?t ?T ?f ?F ?x ?X). Here is the
-detailed meaning of each character:
+be a character, among ?n ?N ?a ?A ?t ?T ?f ?F ?x or ?X. Here is
+the detailed meaning of each character:
n Numerically, by converting the beginning of the item to a number.
a Alphabetically. Only the first line of item is checked.
@@ -2958,7 +3039,7 @@ With a prefix argument ARG, change the region in a single item."
(if (org-region-active-p)
(setq beg (funcall skip-blanks (region-beginning))
end (copy-marker (region-end)))
- (setq beg (funcall skip-blanks (point-at-bol))
+ (setq beg (point-at-bol)
end (copy-marker (point-at-eol))))
;; Depending on the starting line, choose an action on the text
;; between BEG and END.
@@ -3501,4 +3582,8 @@ overruling parameters for `org-list-to-generic'."
(provide 'org-list)
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
;;; org-list.el ends here
diff --git a/lisp/org/org-macro.el b/lisp/org/org-macro.el
index a1b987a8e26..f914a33d61b 100644
--- a/lisp/org/org-macro.el
+++ b/lisp/org/org-macro.el
@@ -1,6 +1,6 @@
;;; org-macro.el --- Macro Replacement Code for Org -*- lexical-binding: t; -*-
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <n.goaziou@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -50,6 +50,7 @@
(require 'org-macs)
(require 'org-compat)
+(declare-function org-collect-keywords "org" (keywords &optional unique directory))
(declare-function org-element-at-point "org-element" ())
(declare-function org-element-context "org-element" (&optional element))
(declare-function org-element-copy "org-element" (datum))
@@ -88,49 +89,24 @@ directly, use instead:
VALUE is the template of the macro. The new value override the
previous one, unless VALUE is nil. TEMPLATES is the list of
templates. Return the updated list."
- (when value
- (let ((old-definition (assoc name templates)))
- (if old-definition
- (setcdr old-definition value)
- (push (cons name value) templates))))
+ (let ((old-definition (assoc name templates)))
+ (cond ((and value old-definition) (setcdr old-definition value))
+ (old-definition)
+ (t (push (cons name (or value "")) templates))))
templates)
-(defun org-macro--collect-macros (&optional files templates)
+(defun org-macro--collect-macros ()
"Collect macro definitions in current buffer and setup files.
-Return an alist containing all macro templates found.
-
-FILES is a list of setup files names read so far, used to avoid
-circular dependencies. TEMPLATES is the alist collected so far.
-The two arguments are used in recursive calls."
- (let ((case-fold-search t))
- (org-with-point-at 1
- (while (re-search-forward "^[ \t]*#\\+\\(MACRO\\|SETUPFILE\\):" nil t)
- (let ((element (org-element-at-point)))
- (when (eq (org-element-type element) 'keyword)
- (let ((val (org-element-property :value element)))
- (if (equal "MACRO" (org-element-property :key element))
- ;; Install macro in TEMPLATES.
- (when (string-match "^\\(\\S-+\\)[ \t]*" val)
- (let ((name (match-string 1 val))
- (value (substring val (match-end 0))))
- (setq templates
- (org-macro--set-template name value templates))))
- ;; Enter setup file.
- (let* ((uri (org-strip-quotes val))
- (uri-is-url (org-file-url-p uri))
- (uri (if uri-is-url
- uri
- (expand-file-name uri))))
- ;; Avoid circular dependencies.
- (unless (member uri files)
- (with-temp-buffer
- (unless uri-is-url
- (setq default-directory (file-name-directory uri)))
- (org-mode)
- (insert (org-file-contents uri 'noerror))
- (setq templates
- (org-macro--collect-macros
- (cons uri files) templates)))))))))))
+Return an alist containing all macro templates found."
+ (let ((templates nil))
+ (pcase (org-collect-keywords '("MACRO"))
+ (`(("MACRO" . ,values))
+ (dolist (value values)
+ (when (string-match "^\\(\\S-+\\)[ \t]*" value)
+ (let ((name (match-string 1 value))
+ (definition (substring value (match-end 0))))
+ (setq templates
+ (org-macro--set-template name definition templates)))))))
(let ((macros `(("author" . ,(org-macro--find-keyword-value "AUTHOR"))
("email" . ,(org-macro--find-keyword-value "EMAIL"))
("title" . ,(org-macro--find-keyword-value "TITLE" t))
@@ -417,6 +393,6 @@ Any other non-empty string resets the counter to 1."
(t 1))
org-macro--counter-table)))
-
(provide 'org-macro)
+
;;; org-macro.el ends here
diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el
index 2a7ab66a339..56afdf6ef19 100644
--- a/lisp/org/org-macs.el
+++ b/lisp/org/org-macs.el
@@ -1,6 +1,6 @@
;;; org-macs.el --- Top-level Definitions for Org -*- lexical-binding: t; -*-
-;; Copyright (C) 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -34,6 +34,8 @@
(require 'cl-lib)
(require 'format-spec)
+(declare-function org-mode "org" ())
+(declare-function org-show-context "org" (&optional key))
(declare-function org-string-collate-lessp "org-compat" (s1 s2 &optional locale ignore-case))
(defvar org-ts-regexp0)
@@ -122,7 +124,7 @@ means that the buffer should stay alive during the operation,
because otherwise all these markers will point to nowhere."
(declare (debug (form body)) (indent 1))
(org-with-gensyms (data invisible-types markers?)
- `(let* ((,invisible-types '(org-hide-block org-hide-drawer outline))
+ `(let* ((,invisible-types '(org-hide-block outline))
(,markers? ,use-markers)
(,data
(mapcar (lambda (o)
@@ -375,18 +377,25 @@ error when the user input is empty."
'org-time-stamp-inactive)
(apply #'completing-read args)))
-(defun org--mks-read-key (allowed-keys prompt)
+(defun org--mks-read-key (allowed-keys prompt navigation-keys)
"Read a key and ensure it is a member of ALLOWED-KEYS.
+Enable keys to scroll the window if NAVIGATION-KEYS is set.
TAB, SPC and RET are treated equivalently."
- (let* ((key (char-to-string
- (pcase (read-char-exclusive prompt)
- ((or ?\s ?\t ?\r) ?\t)
- (char char)))))
- (if (member key allowed-keys)
- key
- (message "Invalid key: `%s'" key)
- (sit-for 1)
- (org--mks-read-key allowed-keys prompt))))
+ (setq header-line-format (when navigation-keys "Use C-n, C-p, C-v, M-v to navigate."))
+ (let ((char-key (read-char-exclusive prompt)))
+ (if (and navigation-keys (memq char-key '(14 16 22 134217846)))
+ (progn
+ (org-scroll char-key)
+ (org--mks-read-key allowed-keys prompt navigation-keys))
+ (let ((key (char-to-string
+ (pcase char-key
+ ((or ?\s ?\t ?\r) ?\t)
+ (char char)))))
+ (if (member key allowed-keys)
+ key
+ (message "Invalid key: `%s'" key)
+ (sit-for 1)
+ (org--mks-read-key allowed-keys prompt navigation-keys))))))
(defun org-mks (table title &optional prompt specials)
"Select a member of an alist with multiple keys.
@@ -416,6 +425,7 @@ is selected, only the bare key is returned."
(let ((inhibit-quit t)
(buffer (org-switch-to-buffer-other-window "*Org Select*"))
(prompt (or prompt "Select: "))
+ case-fold-search
current)
(unwind-protect
(catch 'exit
@@ -458,9 +468,13 @@ is selected, only the bare key is returned."
;; Display UI and let user select an entry or
;; a sub-level prefix.
(goto-char (point-min))
- (unless (pos-visible-in-window-p (point-max))
- (org-fit-window-to-buffer))
- (let ((pressed (org--mks-read-key allowed-keys prompt)))
+ (org-fit-window-to-buffer)
+ (message "") ; With this line the prompt appears in
+ ; the minibuffer. Else keystrokes may
+ ; appear, which is spurious.
+ (let ((pressed (org--mks-read-key
+ allowed-keys prompt
+ (not (pos-visible-in-window-p (1- (point-max)))))))
(setq current (concat current pressed))
(cond
((equal pressed "\C-g") (user-error "Abort"))
@@ -644,6 +658,25 @@ The number of levels is controlled by `org-inlinetask-min-level'."
limit-level)))
(format "\\*\\{1,%d\\} " nstars)))))
+(defun org--line-empty-p (n)
+ "Is the Nth next line empty?
+Counts the current line as N = 1 and the previous line as N = 0;
+see `beginning-of-line'."
+ (and (not (bobp))
+ (save-excursion
+ (beginning-of-line n)
+ (looking-at-p "[ \t]*$"))))
+
+(defun org-previous-line-empty-p ()
+ "Is the previous line a blank line?
+When NEXT is non-nil, check the next line instead."
+ (org--line-empty-p 0))
+
+(defun org-next-line-empty-p ()
+ "Is the previous line a blank line?
+When NEXT is non-nil, check the next line instead."
+ (org--line-empty-p 2))
+
;;; Motion
@@ -695,7 +728,9 @@ SPEC is the invisibility spec, as a symbol."
(let ((o (make-overlay from to nil 'front-advance)))
(overlay-put o 'evaporate t)
(overlay-put o 'invisible spec)
- (overlay-put o 'isearch-open-invisible #'delete-overlay))))
+ (overlay-put o
+ 'isearch-open-invisible
+ (lambda (&rest _) (org-show-context 'isearch))))))
@@ -920,7 +955,8 @@ if necessary."
(if (<= (length s) maxlength)
s
(let* ((n (max (- maxlength 4) 1))
- (re (concat "\\`\\(.\\{1," (int-to-string n) "\\}[^ ]\\)\\([ ]\\|\\'\\)")))
+ (re (concat "\\`\\(.\\{1," (number-to-string n)
+ "\\}[^ ]\\)\\([ ]\\|\\'\\)")))
(if (string-match re s)
(concat (match-string 1 s) "...")
(concat (substring s 0 (max (- maxlength 3) 0)) "...")))))
@@ -1065,10 +1101,16 @@ the value in cdr."
(get-text-property (or (next-single-property-change 0 prop s) 0)
prop s)))
-(defun org-invisible-p (&optional pos)
+(defun org-invisible-p (&optional pos folding-only)
"Non-nil if the character after POS is invisible.
-If POS is nil, use `point' instead."
- (get-char-property (or pos (point)) 'invisible))
+If POS is nil, use `point' instead. When optional argument
+FOLDING-ONLY is non-nil, only consider invisible parts due to
+folding of a headline, a block or a drawer, i.e., not because of
+fontification."
+ (let ((value (get-char-property (or pos (point)) 'invisible)))
+ (cond ((not value) nil)
+ (folding-only (memq value '(org-hide-block outline)))
+ (t value))))
(defun org-truely-invisible-p ()
"Check if point is at a character currently not visible.
@@ -1086,6 +1128,18 @@ move it back by one char before doing this check."
(backward-char 1))
(org-invisible-p)))
+(defun org-find-visible ()
+ "Return closest visible buffer position, or `point-max'"
+ (if (org-invisible-p)
+ (next-single-char-property-change (point) 'invisible)
+ (point)))
+
+(defun org-find-invisible ()
+ "Return closest invisible buffer position, or `point-max'"
+ (if (org-invisible-p)
+ (point)
+ (next-single-char-property-change (point) 'invisible)))
+
;;; Time
@@ -1182,8 +1236,41 @@ Return 0. if S is not recognized as a valid value."
((string-match org-ts-regexp0 s) (org-2ft s))
(t 0.)))))
-
+(defun org-scroll (key &optional additional-keys)
+ "Receive KEY and scroll the current window accordingly.
+When ADDITIONAL-KEYS is not nil, also include SPC and DEL in the
+allowed keys for scrolling, as expected in the export dispatch
+window."
+ (let ((scrlup (if additional-keys '(?\s 22) 22))
+ (scrldn (if additional-keys `(?\d 134217846) 134217846)))
+ (eval
+ `(cl-case ,key
+ ;; C-n
+ (14 (if (not (pos-visible-in-window-p (point-max)))
+ (ignore-errors (scroll-up 1))
+ (message "End of buffer")
+ (sit-for 1)))
+ ;; C-p
+ (16 (if (not (pos-visible-in-window-p (point-min)))
+ (ignore-errors (scroll-down 1))
+ (message "Beginning of buffer")
+ (sit-for 1)))
+ ;; SPC or
+ (,scrlup
+ (if (not (pos-visible-in-window-p (point-max)))
+ (scroll-up nil)
+ (message "End of buffer")
+ (sit-for 1)))
+ ;; DEL
+ (,scrldn (if (not (pos-visible-in-window-p (point-min)))
+ (scroll-down nil)
+ (message "Beginning of buffer")
+ (sit-for 1)))))))
(provide 'org-macs)
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
;;; org-macs.el ends here
diff --git a/lisp/org/org-mobile.el b/lisp/org/org-mobile.el
index 8749e496c25..a64e0a274a2 100644
--- a/lisp/org/org-mobile.el
+++ b/lisp/org/org-mobile.el
@@ -1,5 +1,5 @@
;;; org-mobile.el --- Code for Asymmetric Sync With a Mobile Device -*- lexical-binding: t; -*-
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -258,6 +258,17 @@ the old and new values for the entry.")
(defvar org-mobile-files-alist nil)
(defvar org-mobile-checksum-files nil)
+;; Add org mobile commands to the main org menu
+(easy-menu-add-item
+ org-org-menu
+ nil
+ '("MobileOrg"
+ ["Push Files and Views" org-mobile-push t]
+ ["Get Captured and Flagged" org-mobile-pull t]
+ ["Find FLAGGED Tasks" (org-agenda nil "?") :active t :keys "\\[org-agenda] ?"]
+ "--"
+ ["Setup" (customize-group 'org-mobile) t]))
+
(defun org-mobile-prepare-file-lists ()
(setq org-mobile-files-alist (org-mobile-files-alist))
(setq org-mobile-checksum-files nil))
diff --git a/lisp/org/org-mouse.el b/lisp/org/org-mouse.el
index 02798874d24..5c222ea70d5 100644
--- a/lisp/org/org-mouse.el
+++ b/lisp/org/org-mouse.el
@@ -1,6 +1,6 @@
;;; org-mouse.el --- Better mouse support for Org -*- lexical-binding: t; -*-
-;; Copyright (C) 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2021 Free Software Foundation, Inc.
;; Author: Piotr Zielinski <piotr dot zielinski at gmail dot com>
;; Maintainer: Carsten Dominik <carsten at orgmode dot org>
@@ -386,7 +386,7 @@ DEFAULT is returned if no priority is given in the headline."
(save-excursion
(if (org-mouse-re-search-line org-mouse-priority-regexp)
(match-string 1)
- (when default (char-to-string org-default-priority)))))
+ (when default (char-to-string org-priority-default)))))
(defun org-mouse-delete-timestamp ()
"Deletes the current timestamp as well as the preceding keyword.
@@ -407,7 +407,7 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
(> (match-end 0) point))))))
(defun org-mouse-priority-list ()
- (cl-loop for priority from ?A to org-lowest-priority
+ (cl-loop for priority from ?A to org-priority-lowest
collect (char-to-string priority)))
(defun org-mouse-todo-menu (state)
@@ -495,7 +495,8 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
["Check Deadlines"
(if (functionp 'org-check-deadlines-and-todos)
(org-check-deadlines-and-todos org-deadline-warning-days)
- (org-check-deadlines org-deadline-warning-days)) t]
+ (org-check-deadlines org-deadline-warning-days))
+ t]
["Check TODOs" org-show-todo-tree t]
("Check Tags"
,@(org-mouse-keyword-menu
@@ -741,7 +742,8 @@ This means, between the beginning of line and the point."
(?$ "($) Formula Parameters")
(?# "(#) Recalculation: Auto")
(?* "(*) Recalculation: Manual")
- (?' "(') Recalculation: None"))) t))))
+ (?' "(') Recalculation: None")))
+ t))))
((assq :table contextlist)
(popup-menu
'(nil
diff --git a/lisp/org/org-num.el b/lisp/org/org-num.el
index 5b8e1dbb6d1..ebddaa32b4e 100644
--- a/lisp/org/org-num.el
+++ b/lisp/org/org-num.el
@@ -1,6 +1,6 @@
;;; org-num.el --- Dynamic Headlines Numbering -*- lexical-binding: t; -*-
-;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2018-2021 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -254,6 +254,7 @@ otherwise."
org-footnote-section
(equal title org-footnote-section))
(and org-num-skip-commented
+ title
(let ((case-fold-search nil))
(string-match org-num--comment-re title))
t)
@@ -466,6 +467,10 @@ NUMBERING is a list of numbers."
(remove-hook 'after-change-functions #'org-num--verify t)
(remove-hook 'change-major-mode-hook #'org-num--clear t))))
-
(provide 'org-num)
+
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
;;; org-num.el ends here
diff --git a/lisp/org/org-pcomplete.el b/lisp/org/org-pcomplete.el
index b0ebbc4c241..29d9d58482a 100644
--- a/lisp/org/org-pcomplete.el
+++ b/lisp/org/org-pcomplete.el
@@ -1,6 +1,6 @@
;;; org-pcomplete.el --- In-buffer Completion Code -*- lexical-binding: t; -*-
-;; Copyright (C) 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; John Wiegley <johnw at gnu dot org>
@@ -32,6 +32,8 @@
(require 'pcomplete)
(declare-function org-at-heading-p "org" (&optional ignored))
+(declare-function org-babel-combine-header-arg-lists "ob-core" (original &rest others))
+(declare-function org-babel-get-src-block-info "ob-core" (&optional light datum))
(declare-function org-before-first-heading-p "org" ())
(declare-function org-buffer-property-keys "org" (&optional specials defaults columns))
(declare-function org-element-at-point "org-element" ())
@@ -47,8 +49,9 @@
(declare-function org-link-heading-search-string "ol" (&optional string))
(declare-function org-tag-alist-to-string "org" (alist &optional skip-key))
+(defvar org-babel-common-header-args-w-values)
(defvar org-current-tag-alist)
-(defvar org-default-priority)
+(defvar org-priority-default)
(defvar org-drawer-regexp)
(defvar org-element-affiliated-keywords)
(defvar org-entities)
@@ -56,10 +59,10 @@
(defvar org-export-exclude-tags)
(defvar org-export-select-tags)
(defvar org-file-tags)
-(defvar org-highest-priority)
+(defvar org-priority-highest)
(defvar org-link-abbrev-alist)
(defvar org-link-abbrev-alist-local)
-(defvar org-lowest-priority)
+(defvar org-priority-lowest)
(defvar org-options-keywords)
(defvar org-outline-regexp)
(defvar org-property-re)
@@ -252,9 +255,9 @@ When completing for #+STARTUP, for example, this function returns
(defun pcomplete/org-mode/file-option/priorities ()
"Complete arguments for the #+PRIORITIES file option."
(pcomplete-here (list (format "%c %c %c"
- org-highest-priority
- org-lowest-priority
- org-default-priority))))
+ org-priority-highest
+ org-priority-lowest
+ org-priority-default))))
(defun pcomplete/org-mode/file-option/select_tags ()
"Complete arguments for the #+SELECT_TAGS file option."
@@ -352,8 +355,9 @@ This needs more work, to handle headings with lots of spaces in them."
(goto-char (point-min))
(let (tbl)
(while (re-search-forward org-outline-regexp nil t)
- (push (org-link-heading-search-string (org-get-heading t t t t))
- tbl))
+ ;; Remove the leading asterisk from
+ ;; `org-link-heading-search-string' result.
+ (push (substring (org-link-heading-search-string) 1) tbl))
(pcomplete-uniquify-list tbl)))
;; When completing a bracketed link, i.e., "[[*", argument
;; starts at the star, so remove this character.
@@ -417,11 +421,17 @@ switches."
(symbol-plist
'org-babel-load-languages)
'custom-type)))))))
- (while (pcomplete-here
- '("-n" "-r" "-l"
- ":cache" ":colnames" ":comments" ":dir" ":eval" ":exports"
- ":file" ":hlines" ":no-expand" ":noweb" ":results" ":rownames"
- ":session" ":shebang" ":tangle" ":tangle-mode" ":var"))))
+ (let* ((info (org-babel-get-src-block-info 'light))
+ (lang (car info))
+ (lang-headers (intern (concat "org-babel-header-args:" lang)))
+ (headers (org-babel-combine-header-arg-lists
+ org-babel-common-header-args-w-values
+ (and (boundp lang-headers) (eval lang-headers t)))))
+ (while (pcomplete-here
+ (append (mapcar
+ (lambda (arg) (format ":%s" (symbol-name (car arg))))
+ headers)
+ '("-n" "-r" "-l"))))))
(defun pcomplete/org-mode/block-option/clocktable ()
"Complete keywords in a clocktable line."
diff --git a/lisp/org/org-plot.el b/lisp/org/org-plot.el
index 8bf883921c9..4ac15b379d3 100644
--- a/lisp/org/org-plot.el
+++ b/lisp/org/org-plot.el
@@ -1,8 +1,9 @@
;;; org-plot.el --- Support for Plotting from Org -*- lexical-binding: t; -*-
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;;
;; Author: Eric Schulte <schulte dot eric at gmail dot com>
+;; Maintainer: TEC <tecosaur@gmail.com>
;; Keywords: tables, plotting
;; Homepage: https://orgmode.org
;;
@@ -144,7 +145,8 @@ and dependent variables."
row-vals)
(when (>= ind 0) ;; collect values of ind col
(setf row-vals (mapcar (lambda (row) (setf counter (+ 1 counter))
- (cons counter (nth ind row))) table)))
+ (cons counter (nth ind row)))
+ table)))
(when (or deps (>= ind 0)) ;; remove non-plotting columns
(setf deps (delq ind deps))
(setf table (mapcar (lambda (row)
@@ -288,14 +290,12 @@ line directly before or after the table."
(setf params (plist-put params (car pair) (cdr pair)))))
;; collect table and table information
(let* ((data-file (make-temp-file "org-plot"))
- (table (org-table-to-lisp))
- (num-cols (length (if (eq (nth 0 table) 'hline) (nth 1 table)
- (nth 0 table)))))
+ (table (org-table-collapse-header (org-table-to-lisp)))
+ (num-cols (length (car table))))
(run-with-idle-timer 0.1 nil #'delete-file data-file)
- (while (eq 'hline (car table)) (setf table (cdr table)))
(when (eq (cadr table) 'hline)
(setf params
- (plist-put params :labels (nth 0 table))) ; headers to labels
+ (plist-put params :labels (car table))) ; headers to labels
(setf table (delq 'hline (cdr table)))) ; clean non-data from table
;; Collect options.
(save-excursion (while (and (equal 0 (forward-line -1))
@@ -308,26 +308,20 @@ line directly before or after the table."
(`grid (let ((y-labels (org-plot/gnuplot-to-grid-data
table data-file params)))
(when y-labels (plist-put params :ylabels y-labels)))))
- ;; Check for timestamp ind column.
- (let ((ind (1- (plist-get params :ind))))
- (when (and (>= ind 0) (eq '2d (plist-get params :plot-type)))
- (if (= (length
- (delq 0 (mapcar
- (lambda (el)
- (if (string-match org-ts-regexp3 el) 0 1))
- (mapcar (lambda (row) (nth ind row)) table))))
- 0)
- (plist-put params :timeind t)
- ;; Check for text ind column.
- (if (or (string= (plist-get params :with) "hist")
- (> (length
- (delq 0 (mapcar
- (lambda (el)
- (if (string-match org-table-number-regexp el)
- 0 1))
- (mapcar (lambda (row) (nth ind row)) table))))
- 0))
- (plist-put params :textind t)))))
+ ;; Check type of ind column (timestamp? text?)
+ (when (eq `2d (plist-get params :plot-type))
+ (let* ((ind (1- (plist-get params :ind)))
+ (ind-column (mapcar (lambda (row) (nth ind row)) table)))
+ (cond ((< ind 0) nil) ; ind is implicit
+ ((cl-every (lambda (el)
+ (string-match org-ts-regexp3 el))
+ ind-column)
+ (plist-put params :timeind t)) ; ind holds timestamps
+ ((or (string= (plist-get params :with) "hist")
+ (cl-notevery (lambda (el)
+ (string-match org-table-number-regexp el))
+ ind-column))
+ (plist-put params :textind t))))) ; ind holds text
;; Write script.
(with-temp-buffer
(if (plist-get params :script) ; user script
diff --git a/lisp/org/org-protocol.el b/lisp/org/org-protocol.el
index 55a534d0dcd..74043f8340b 100644
--- a/lisp/org/org-protocol.el
+++ b/lisp/org/org-protocol.el
@@ -1,6 +1,6 @@
;;; org-protocol.el --- Intercept Calls from Emacsclient to Trigger Custom Actions -*- lexical-binding: t; -*-
;;
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;;
;; Authors: Bastien Guerry <bzg@gnu.org>
;; Daniel M German <dmg AT uvic DOT org>
@@ -181,7 +181,8 @@ Possible properties are:
:working-directory - the local working directory. This is, what base-url will
be replaced with.
:redirects - A list of cons cells, each of which maps a regular
- expression to match to a path relative to :working-directory.
+ expression to match to a path relative to
+ :working-directory.
Example:
@@ -191,7 +192,7 @@ Example:
:working-suffix \".org\"
:base-url \"https://orgmode.org/worg/\"
:working-directory \"/home/user/org/Worg/\")
- (\"http://localhost/org-notes/\"
+ (\"localhost org-notes/\"
:online-suffix \".html\"
:working-suffix \".org\"
:base-url \"http://localhost/org/\"
@@ -202,12 +203,18 @@ Example:
:working-directory \"~/site/content/post/\"
:online-suffix \".html\"
:working-suffix \".md\"
- :rewrites ((\"\\(https://site.com/[0-9]+/[0-9]+/[0-9]+/\\)\" . \".md\")))))
-
-
- The last line tells `org-protocol-open-source' to open
- /home/user/org/index.php, if the URL cannot be mapped to an existing
- file, and ends with either \"org\" or \"org/\".
+ :rewrites ((\"\\(https://site.com/[0-9]+/[0-9]+/[0-9]+/\\)\"
+ . \".md\")))
+ (\"GNU emacs OpenGrok\"
+ :base-url \"https://opengrok.housegordon.com/source/xref/emacs/\"
+ :working-directory \"~/dev/gnu-emacs/\")))
+
+ The :rewrites line of \"localhost org-notes\" entry tells
+ `org-protocol-open-source' to open /home/user/org/index.php,
+ if the URL cannot be mapped to an existing file, and ends with
+ either \"org\" or \"org/\". The \"GNU emacs OpenGrok\" entry
+ does not include any suffix properties, allowing local source
+ file to be opened as found by OpenGrok.
Consider using the interactive functions `org-protocol-create' and
`org-protocol-create-for-org' to help you filling this variable with valid contents."
@@ -545,11 +552,12 @@ The location for a browser's bookmark should look like this:
;; ending than strip-suffix here:
(f1 (substring f 0 (string-match "\\([\\?#].*\\)?$" f)))
(start-pos (+ (string-match wsearch f1) (length base-url)))
- (end-pos (string-match
- (regexp-quote strip-suffix) f1))
+ (end-pos (if strip-suffix
+ (string-match (regexp-quote strip-suffix) f1)
+ (length f1)))
;; We have to compare redirects without suffix below:
(f2 (concat wdir (substring f1 start-pos end-pos)))
- (the-file (concat f2 add-suffix)))
+ (the-file (if add-suffix (concat f2 add-suffix) f2)))
;; Note: the-file may still contain `%C3' et al here because browsers
;; tend to encode `&auml;' in URLs to `%25C3' - `%25' being `%'.
@@ -617,13 +625,13 @@ CLIENT is ignored."
(let ((proto
(concat the-protocol
(regexp-quote (plist-get (cdr prolist) :protocol))
- "\\(:/+\\|\\?\\)")))
+ "\\(:/+\\|/*\\?\\)")))
(when (string-match proto fname)
(let* ((func (plist-get (cdr prolist) :function))
(greedy (plist-get (cdr prolist) :greedy))
(split (split-string fname proto))
(result (if greedy restoffiles (cadr split)))
- (new-style (string= (match-string 1 fname) "?")))
+ (new-style (string-match "/*?" (match-string 1 fname))))
(when (plist-get (cdr prolist) :kill-client)
(message "Greedy org-protocol handler. Killing client.")
(server-edit))
diff --git a/lisp/org/org-refile.el b/lisp/org/org-refile.el
new file mode 100644
index 00000000000..1e0c339f7b2
--- /dev/null
+++ b/lisp/org/org-refile.el
@@ -0,0 +1,742 @@
+;;; org-refile.el --- Refile Org Subtrees -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;;
+;; This file is part of GNU Emacs.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Org Refile allows you to refile subtrees to various locations.
+
+;;; Code:
+
+(require 'org)
+
+(declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ())
+
+(defgroup org-refile nil
+ "Options concerning refiling entries in Org mode."
+ :tag "Org Refile"
+ :group 'org)
+
+(defcustom org-log-refile nil
+ "Information to record when a task is refiled.
+
+Possible values are:
+
+nil Don't add anything
+time Add a time stamp to the task
+note Prompt for a note and add it with template `org-log-note-headings'
+
+This option can also be set with on a per-file-basis with
+
+ #+STARTUP: nologrefile
+ #+STARTUP: logrefile
+ #+STARTUP: lognoterefile
+
+You can have local logging settings for a subtree by setting the LOGGING
+property to one or more of these keywords.
+
+When bulk-refiling, e.g., from the agenda, the value `note' is
+forbidden and will temporarily be changed to `time'."
+ :group 'org-refile
+ :group 'org-progress
+ :version "24.1"
+ :type '(choice
+ (const :tag "No logging" nil)
+ (const :tag "Record timestamp" time)
+ (const :tag "Record timestamp with note." note)))
+
+(defcustom org-refile-targets nil
+ "Targets for refiling entries with `\\[org-refile]'.
+This is a list of cons cells. Each cell contains:
+- a specification of the files to be considered, either a list of files,
+ or a symbol whose function or variable value will be used to retrieve
+ a file name or a list of file names. If you use `org-agenda-files' for
+ that, all agenda files will be scanned for targets. Nil means consider
+ headings in the current buffer.
+- A specification of how to find candidate refile targets. This may be
+ any of:
+ - a cons cell (:tag . \"TAG\") to identify refile targets by a tag.
+ This tag has to be present in all target headlines, inheritance will
+ not be considered.
+ - a cons cell (:todo . \"KEYWORD\") to identify refile targets by
+ todo keyword.
+ - a cons cell (:regexp . \"REGEXP\") with a regular expression matching
+ headlines that are refiling targets.
+ - a cons cell (:level . N). Any headline of level N is considered a target.
+ Note that, when `org-odd-levels-only' is set, level corresponds to
+ order in hierarchy, not to the number of stars.
+ - a cons cell (:maxlevel . N). Any headline with level <= N is a target.
+ Note that, when `org-odd-levels-only' is set, level corresponds to
+ order in hierarchy, not to the number of stars.
+
+Each element of this list generates a set of possible targets.
+The union of these sets is presented (with completion) to
+the user by `org-refile'.
+
+You can set the variable `org-refile-target-verify-function' to a function
+to verify each headline found by the simple criteria above.
+
+When this variable is nil, all top-level headlines in the current buffer
+are used, equivalent to the value `((nil . (:level . 1))'."
+ :group 'org-refile
+ :type '(repeat
+ (cons
+ (choice :value org-agenda-files
+ (const :tag "All agenda files" org-agenda-files)
+ (const :tag "Current buffer" nil)
+ (function) (variable) (file))
+ (choice :tag "Identify target headline by"
+ (cons :tag "Specific tag" (const :value :tag) (string))
+ (cons :tag "TODO keyword" (const :value :todo) (string))
+ (cons :tag "Regular expression" (const :value :regexp) (regexp))
+ (cons :tag "Level number" (const :value :level) (integer))
+ (cons :tag "Max Level number" (const :value :maxlevel) (integer))))))
+
+(defcustom org-refile-target-verify-function nil
+ "Function to verify if the headline at point should be a refile target.
+The function will be called without arguments, with point at the
+beginning of the headline. It should return t and leave point
+where it is if the headline is a valid target for refiling.
+
+If the target should not be selected, the function must return nil.
+In addition to this, it may move point to a place from where the search
+should be continued. For example, the function may decide that the entire
+subtree of the current entry should be excluded and move point to the end
+of the subtree."
+ :group 'org-refile
+ :type '(choice
+ (const nil)
+ (function)))
+
+(defcustom org-refile-use-cache nil
+ "Non-nil means cache refile targets to speed up the process.
+\\<org-mode-map>\
+The cache for a particular file will be updated automatically when
+the buffer has been killed, or when any of the marker used for flagging
+refile targets no longer points at a live buffer.
+If you have added new entries to a buffer that might themselves be targets,
+you need to clear the cache manually by pressing `C-0 \\[org-refile]' or,
+if you find that easier, \
+`\\[universal-argument] \\[universal-argument] \\[universal-argument] \
+\\[org-refile]'."
+ :group 'org-refile
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-refile-use-outline-path nil
+ "Non-nil means provide refile targets as paths.
+So a level 3 headline will be available as level1/level2/level3.
+
+When the value is `file', also include the file name (without directory)
+into the path. In this case, you can also stop the completion after
+the file name, to get entries inserted as top level in the file.
+
+When `full-file-path', include the full file path.
+
+When `buffer-name', use the buffer name."
+ :group 'org-refile
+ :type '(choice
+ (const :tag "Not" nil)
+ (const :tag "Yes" t)
+ (const :tag "Start with file name" file)
+ (const :tag "Start with full file path" full-file-path)
+ (const :tag "Start with buffer name" buffer-name)))
+
+(defcustom org-outline-path-complete-in-steps t
+ "Non-nil means complete the outline path in hierarchical steps.
+When Org uses the refile interface to select an outline path (see
+`org-refile-use-outline-path'), the completion of the path can be
+done in a single go, or it can be done in steps down the headline
+hierarchy. Going in steps is probably the best if you do not use
+a special completion package like `ido' or `icicles'. However,
+when using these packages, going in one step can be very fast,
+while still showing the whole path to the entry."
+ :group 'org-refile
+ :type 'boolean)
+
+(defcustom org-refile-allow-creating-parent-nodes nil
+ "Non-nil means allow the creation of new nodes as refile targets.
+New nodes are then created by adding \"/new node name\" to the completion
+of an existing node. When the value of this variable is `confirm',
+new node creation must be confirmed by the user (recommended).
+When nil, the completion must match an existing entry.
+
+Note that, if the new heading is not seen by the criteria
+listed in `org-refile-targets', multiple instances of the same
+heading would be created by trying again to file under the new
+heading."
+ :group 'org-refile
+ :type '(choice
+ (const :tag "Never" nil)
+ (const :tag "Always" t)
+ (const :tag "Prompt for confirmation" confirm)))
+
+(defcustom org-refile-active-region-within-subtree nil
+ "Non-nil means also refile active region within a subtree.
+
+By default `org-refile' doesn't allow refiling regions if they
+don't contain a set of subtrees, but it might be convenient to
+do so sometimes: in that case, the first line of the region is
+converted to a headline before refiling."
+ :group 'org-refile
+ :version "24.1"
+ :type 'boolean)
+
+(defvar org-refile-target-table nil
+ "The list of refile targets, created by `org-refile'.")
+
+(defvar org-refile-cache nil
+ "Cache for refile targets.")
+
+(defvar org-refile-markers nil
+ "All the markers used for caching refile locations.")
+
+;; Add org refile commands to the main org menu
+(mapc (lambda (i) (easy-menu-add-item
+ org-org-menu
+ '("Edit Structure") i))
+ '(["Refile Subtree" org-refile (org-in-subtree-not-table-p)]
+ ["Refile and copy Subtree" org-copy (org-in-subtree-not-table-p)]))
+
+(defun org-refile-marker (pos)
+ "Get a new refile marker, but only if caching is in use."
+ (if (not org-refile-use-cache)
+ pos
+ (let ((m (make-marker)))
+ (move-marker m pos)
+ (push m org-refile-markers)
+ m)))
+
+(defun org-refile-cache-clear ()
+ "Clear the refile cache and disable all the markers."
+ (dolist (m org-refile-markers) (move-marker m nil))
+ (setq org-refile-markers nil)
+ (setq org-refile-cache nil)
+ (message "Refile cache has been cleared"))
+
+(defun org-refile-cache-check-set (set)
+ "Check if all the markers in the cache still have live buffers."
+ (let (marker)
+ (catch 'exit
+ (while (and set (setq marker (nth 3 (pop set))))
+ ;; If `org-refile-use-outline-path' is 'file, marker may be nil
+ (when (and marker (null (marker-buffer marker)))
+ (message "Please regenerate the refile cache with `C-0 C-c C-w'")
+ (sit-for 3)
+ (throw 'exit nil)))
+ t)))
+
+(defun org-refile-cache-put (set &rest identifiers)
+ "Push the refile targets SET into the cache, under IDENTIFIERS."
+ (let* ((key (sha1 (prin1-to-string identifiers)))
+ (entry (assoc key org-refile-cache)))
+ (if entry
+ (setcdr entry set)
+ (push (cons key set) org-refile-cache))))
+
+(defun org-refile-cache-get (&rest identifiers)
+ "Retrieve the cached value for refile targets given by IDENTIFIERS."
+ (cond
+ ((not org-refile-cache) nil)
+ ((not org-refile-use-cache) (org-refile-cache-clear) nil)
+ (t
+ (let ((set (cdr (assoc (sha1 (prin1-to-string identifiers))
+ org-refile-cache))))
+ (and set (org-refile-cache-check-set set) set)))))
+
+(defun org-refile-get-targets (&optional default-buffer)
+ "Produce a table with refile targets."
+ (let ((case-fold-search nil)
+ ;; otherwise org confuses "TODO" as a kw and "Todo" as a word
+ (entries (or org-refile-targets '((nil . (:level . 1)))))
+ targets tgs files desc descre)
+ (message "Getting targets...")
+ (with-current-buffer (or default-buffer (current-buffer))
+ (dolist (entry entries)
+ (setq files (car entry) desc (cdr entry))
+ (cond
+ ((null files) (setq files (list (current-buffer))))
+ ((eq files 'org-agenda-files)
+ (setq files (org-agenda-files 'unrestricted)))
+ ((and (symbolp files) (fboundp files))
+ (setq files (funcall files)))
+ ((and (symbolp files) (boundp files))
+ (setq files (symbol-value files))))
+ (when (stringp files) (setq files (list files)))
+ (cond
+ ((eq (car desc) :tag)
+ (setq descre (concat "^\\*+[ \t]+.*?:" (regexp-quote (cdr desc)) ":")))
+ ((eq (car desc) :todo)
+ (setq descre (concat "^\\*+[ \t]+" (regexp-quote (cdr desc)) "[ \t]")))
+ ((eq (car desc) :regexp)
+ (setq descre (cdr desc)))
+ ((eq (car desc) :level)
+ (setq descre (concat "^\\*\\{" (number-to-string
+ (if org-odd-levels-only
+ (1- (* 2 (cdr desc)))
+ (cdr desc)))
+ "\\}[ \t]")))
+ ((eq (car desc) :maxlevel)
+ (setq descre (concat "^\\*\\{1," (number-to-string
+ (if org-odd-levels-only
+ (1- (* 2 (cdr desc)))
+ (cdr desc)))
+ "\\}[ \t]")))
+ (t (error "Bad refiling target description %s" desc)))
+ (dolist (f files)
+ (with-current-buffer (if (bufferp f) f (org-get-agenda-file-buffer f))
+ (or
+ (setq tgs (org-refile-cache-get (buffer-file-name) descre))
+ (progn
+ (when (bufferp f)
+ (setq f (buffer-file-name (buffer-base-buffer f))))
+ (setq f (and f (expand-file-name f)))
+ (when (eq org-refile-use-outline-path 'file)
+ (push (list (file-name-nondirectory f) f nil nil) tgs))
+ (when (eq org-refile-use-outline-path 'buffer-name)
+ (push (list (buffer-name (buffer-base-buffer)) f nil nil) tgs))
+ (when (eq org-refile-use-outline-path 'full-file-path)
+ (push (list (file-truename (buffer-file-name (buffer-base-buffer))) f nil nil) tgs))
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (setq org-outline-path-cache nil)
+ (while (re-search-forward descre nil t)
+ (beginning-of-line)
+ (let ((case-fold-search nil))
+ (looking-at org-complex-heading-regexp))
+ (let ((begin (point))
+ (heading (match-string-no-properties 4)))
+ (unless (or (and
+ org-refile-target-verify-function
+ (not
+ (funcall org-refile-target-verify-function)))
+ (not heading))
+ (let ((re (format org-complex-heading-regexp-format
+ (regexp-quote heading)))
+ (target
+ (if (not org-refile-use-outline-path) heading
+ (mapconcat
+ #'identity
+ (append
+ (pcase org-refile-use-outline-path
+ (`file (list (file-name-nondirectory
+ (buffer-file-name
+ (buffer-base-buffer)))))
+ (`full-file-path
+ (list (buffer-file-name
+ (buffer-base-buffer))))
+ (`buffer-name
+ (list (buffer-name
+ (buffer-base-buffer))))
+ (_ nil))
+ (mapcar (lambda (s) (replace-regexp-in-string
+ "/" "\\/" s nil t))
+ (org-get-outline-path t t)))
+ "/"))))
+ (push (list target f re (org-refile-marker (point)))
+ tgs)))
+ (when (= (point) begin)
+ ;; Verification function has not moved point.
+ (end-of-line)))))))
+ (when org-refile-use-cache
+ (org-refile-cache-put tgs (buffer-file-name) descre))
+ (setq targets (append tgs targets))))))
+ (message "Getting targets...done")
+ (delete-dups (nreverse targets))))
+
+(defvar org-refile-history nil
+ "History for refiling operations.")
+
+(defvar org-after-refile-insert-hook nil
+ "Hook run after `org-refile' has inserted its stuff at the new location.
+Note that this is still *before* the stuff will be removed from
+the *old* location.")
+
+(defvar org-refile-keep nil
+ "Non-nil means `org-refile' will copy instead of refile.")
+
+(define-obsolete-function-alias 'org-copy 'org-refile-copy "Org 9.4")
+
+;;;###autoload
+(defun org-refile-copy ()
+ "Like `org-refile', but preserve the refiled subtree."
+ (interactive)
+ (let ((org-refile-keep t))
+ (org-refile nil nil nil "Copy")))
+
+(defvar org-capture-last-stored-marker)
+
+;;;###autoload
+(defun org-refile (&optional arg default-buffer rfloc msg)
+ "Move the entry or entries at point to another heading.
+
+The list of target headings is compiled using the information in
+`org-refile-targets', which see.
+
+At the target location, the entry is filed as a subitem of the
+target heading. Depending on `org-reverse-note-order', the new
+subitem will either be the first or the last subitem.
+
+If there is an active region, all entries in that region will be
+refiled. However, the region must fulfill the requirement that
+the first heading sets the top-level of the moved text.
+
+With a `\\[universal-argument]' ARG, the command will only visit the target \
+location
+and not actually move anything.
+
+With a prefix `\\[universal-argument] \\[universal-argument]', go to the \
+location where the last
+refiling operation has put the subtree.
+
+With a numeric prefix argument of `2', refile to the running clock.
+
+With a numeric prefix argument of `3', emulate `org-refile-keep'
+being set to t and copy to the target location, don't move it.
+Beware that keeping refiled entries may result in duplicated ID
+properties.
+
+RFLOC can be a refile location obtained in a different way. It
+should be a list with the following 4 elements:
+
+1. Name - an identifier for the refile location, typically the
+headline text
+2. File - the file the refile location is in
+3. nil - used for generating refile location candidates, not
+needed when passing RFLOC
+4. Position - the position in the specified file of the
+headline to refile under
+
+MSG is a string to replace \"Refile\" in the default prompt with
+another verb. E.g. `org-copy' sets this parameter to \"Copy\".
+
+See also `org-refile-use-outline-path'.
+
+If you are using target caching (see `org-refile-use-cache'), you
+have to clear the target cache in order to find new targets.
+This can be done with a `0' prefix (`C-0 C-c C-w') or a triple
+prefix argument (`C-u C-u C-u C-c C-w')."
+ (interactive "P")
+ (if (member arg '(0 (64)))
+ (org-refile-cache-clear)
+ (let* ((actionmsg (cond (msg msg)
+ ((equal arg 3) "Refile (and keep)")
+ (t "Refile")))
+ (regionp (org-region-active-p))
+ (region-start (and regionp (region-beginning)))
+ (region-end (and regionp (region-end)))
+ (org-refile-keep (if (equal arg 3) t org-refile-keep))
+ pos it nbuf file level reversed)
+ (setq last-command nil)
+ (when regionp
+ (goto-char region-start)
+ (beginning-of-line)
+ (setq region-start (point))
+ (unless (or (org-kill-is-subtree-p
+ (buffer-substring region-start region-end))
+ (prog1 org-refile-active-region-within-subtree
+ (let ((s (point-at-eol)))
+ (org-toggle-heading)
+ (setq region-end (+ (- (point-at-eol) s) region-end)))))
+ (user-error "The region is not a (sequence of) subtree(s)")))
+ (if (equal arg '(16))
+ (org-refile-goto-last-stored)
+ (when (or
+ (and (equal arg 2)
+ org-clock-hd-marker (marker-buffer org-clock-hd-marker)
+ (prog1
+ (setq it (list (or org-clock-heading "running clock")
+ (buffer-file-name
+ (marker-buffer org-clock-hd-marker))
+ ""
+ (marker-position org-clock-hd-marker)))
+ (setq arg nil)))
+ (setq it
+ (or rfloc
+ (let (heading-text)
+ (save-excursion
+ (unless (and arg (listp arg))
+ (org-back-to-heading t)
+ (setq heading-text
+ (replace-regexp-in-string
+ org-link-bracket-re
+ "\\2"
+ (or (nth 4 (org-heading-components))
+ ""))))
+ (org-refile-get-location
+ (cond ((and arg (listp arg)) "Goto")
+ (regionp (concat actionmsg " region to"))
+ (t (concat actionmsg " subtree \""
+ heading-text "\" to")))
+ default-buffer
+ (and (not (equal '(4) arg))
+ org-refile-allow-creating-parent-nodes)))))))
+ (setq file (nth 1 it)
+ pos (nth 3 it))
+ (when (and (not arg)
+ pos
+ (equal (buffer-file-name) file)
+ (if regionp
+ (and (>= pos region-start)
+ (<= pos region-end))
+ (and (>= pos (point))
+ (< pos (save-excursion
+ (org-end-of-subtree t t))))))
+ (error "Cannot refile to position inside the tree or region"))
+ (setq nbuf (or (find-buffer-visiting file)
+ (find-file-noselect file)))
+ (if (and arg (not (equal arg 3)))
+ (progn
+ (pop-to-buffer-same-window nbuf)
+ (goto-char (cond (pos)
+ ((org-notes-order-reversed-p) (point-min))
+ (t (point-max))))
+ (org-show-context 'org-goto))
+ (if regionp
+ (progn
+ (org-kill-new (buffer-substring region-start region-end))
+ (org-save-markers-in-region region-start region-end))
+ (org-copy-subtree 1 nil t))
+ (with-current-buffer (setq nbuf (or (find-buffer-visiting file)
+ (find-file-noselect file)))
+ (setq reversed (org-notes-order-reversed-p))
+ (org-with-wide-buffer
+ (if pos
+ (progn
+ (goto-char pos)
+ (setq level (org-get-valid-level (funcall outline-level) 1))
+ (goto-char
+ (if reversed
+ (or (outline-next-heading) (point-max))
+ (or (save-excursion (org-get-next-sibling))
+ (org-end-of-subtree t t)
+ (point-max)))))
+ (setq level 1)
+ (if (not reversed)
+ (goto-char (point-max))
+ (goto-char (point-min))
+ (or (outline-next-heading) (goto-char (point-max)))))
+ (unless (bolp) (newline))
+ (org-paste-subtree level nil nil t)
+ ;; Record information, according to `org-log-refile'.
+ ;; Do not prompt for a note when refiling multiple
+ ;; headlines, however. Simply add a time stamp.
+ (cond
+ ((not org-log-refile))
+ (regionp
+ (org-map-region
+ (lambda () (org-add-log-setup 'refile nil nil 'time))
+ (point)
+ (+ (point) (- region-end region-start))))
+ (t
+ (org-add-log-setup 'refile nil nil org-log-refile)))
+ (and org-auto-align-tags
+ (let ((org-loop-over-headlines-in-active-region nil))
+ (org-align-tags)))
+ (let ((bookmark-name (plist-get org-bookmark-names-plist
+ :last-refile)))
+ (when bookmark-name
+ (with-demoted-errors
+ (bookmark-set bookmark-name))))
+ ;; If we are refiling for capture, make sure that the
+ ;; last-capture pointers point here
+ (when (bound-and-true-p org-capture-is-refiling)
+ (let ((bookmark-name (plist-get org-bookmark-names-plist
+ :last-capture-marker)))
+ (when bookmark-name
+ (with-demoted-errors
+ (bookmark-set bookmark-name))))
+ (move-marker org-capture-last-stored-marker (point)))
+ (when (fboundp 'deactivate-mark) (deactivate-mark))
+ (run-hooks 'org-after-refile-insert-hook)))
+ (unless org-refile-keep
+ (if regionp
+ (delete-region (point) (+ (point) (- region-end region-start)))
+ (org-preserve-local-variables
+ (delete-region
+ (and (org-back-to-heading t) (point))
+ (min (1+ (buffer-size)) (org-end-of-subtree t t) (point))))))
+ (when (featurep 'org-inlinetask)
+ (org-inlinetask-remove-END-maybe))
+ (setq org-markers-to-move nil)
+ (message "%s to \"%s\" in file %s: done" actionmsg
+ (car it) file)))))))
+
+(defun org-refile-goto-last-stored ()
+ "Go to the location where the last refile was stored."
+ (interactive)
+ (bookmark-jump (plist-get org-bookmark-names-plist :last-refile))
+ (message "This is the location of the last refile"))
+
+(defun org-refile--get-location (refloc tbl)
+ "When user refile to REFLOC, find the associated target in TBL.
+Also check `org-refile-target-table'."
+ (car (delq
+ nil
+ (mapcar
+ (lambda (r) (or (assoc r tbl)
+ (assoc r org-refile-target-table)))
+ (list (replace-regexp-in-string "/$" "" refloc)
+ (replace-regexp-in-string "\\([^/]\\)$" "\\1/" refloc))))))
+
+(defun org-refile-get-location (&optional prompt default-buffer new-nodes)
+ "Prompt the user for a refile location, using PROMPT.
+PROMPT should not be suffixed with a colon and a space, because
+this function appends the default value from
+`org-refile-history' automatically, if that is not empty."
+ (let ((org-refile-targets org-refile-targets)
+ (org-refile-use-outline-path org-refile-use-outline-path))
+ (setq org-refile-target-table (org-refile-get-targets default-buffer)))
+ (unless org-refile-target-table
+ (user-error "No refile targets"))
+ (let* ((cbuf (current-buffer))
+ (cfn (buffer-file-name (buffer-base-buffer cbuf)))
+ (cfunc (if (and org-refile-use-outline-path
+ org-outline-path-complete-in-steps)
+ #'org-olpath-completing-read
+ #'completing-read))
+ (extra (if org-refile-use-outline-path "/" ""))
+ (cbnex (concat (buffer-name) extra))
+ (filename (and cfn (expand-file-name cfn)))
+ (tbl (mapcar
+ (lambda (x)
+ (if (and (not (member org-refile-use-outline-path
+ '(file full-file-path)))
+ (not (equal filename (nth 1 x))))
+ (cons (concat (car x) extra " ("
+ (file-name-nondirectory (nth 1 x)) ")")
+ (cdr x))
+ (cons (concat (car x) extra) (cdr x))))
+ org-refile-target-table))
+ (completion-ignore-case t)
+ cdef
+ (prompt (concat prompt
+ (or (and (car org-refile-history)
+ (concat " (default " (car org-refile-history) ")"))
+ (and (assoc cbnex tbl) (setq cdef cbnex)
+ (concat " (default " cbnex ")"))) ": "))
+ pa answ parent-target child parent old-hist)
+ (setq old-hist org-refile-history)
+ (setq answ (funcall cfunc prompt tbl nil (not new-nodes)
+ nil 'org-refile-history
+ (or cdef (concat (car org-refile-history) extra))))
+ (if (setq pa (org-refile--get-location answ tbl))
+ (let* ((last-refile-loc (car org-refile-history))
+ (last-refile-loc-path (concat last-refile-loc extra)))
+ (org-refile-check-position pa)
+ (when (or (not org-refile-history)
+ (not (eq old-hist org-refile-history))
+ (not (equal (car pa) last-refile-loc-path)))
+ (setq org-refile-history
+ (cons (car pa) (if (assoc last-refile-loc tbl)
+ org-refile-history
+ (cdr org-refile-history))))
+ (when (or (equal last-refile-loc-path (nth 1 org-refile-history))
+ (equal last-refile-loc (nth 1 org-refile-history)))
+ (pop org-refile-history)))
+ pa)
+ (if (string-match "\\`\\(.*\\)/\\([^/]+\\)\\'" answ)
+ (progn
+ (setq parent (match-string 1 answ)
+ child (match-string 2 answ))
+ (setq parent-target (org-refile--get-location parent tbl))
+ (when (and parent-target
+ (or (eq new-nodes t)
+ (and (eq new-nodes 'confirm)
+ (y-or-n-p (format "Create new node \"%s\"? "
+ child)))))
+ (org-refile-new-child parent-target child)))
+ (user-error "Invalid target location")))))
+
+(defun org-refile-check-position (refile-pointer)
+ "Check if the refile pointer matches the headline to which it points."
+ (let* ((file (nth 1 refile-pointer))
+ (re (nth 2 refile-pointer))
+ (pos (nth 3 refile-pointer))
+ buffer)
+ (if (and (not (markerp pos)) (not file))
+ (user-error "Please indicate a target file in the refile path")
+ (when (org-string-nw-p re)
+ (setq buffer (if (markerp pos)
+ (marker-buffer pos)
+ (or (find-buffer-visiting file)
+ (find-file-noselect file))))
+ (with-current-buffer buffer
+ (org-with-wide-buffer
+ (goto-char pos)
+ (beginning-of-line 1)
+ (unless (looking-at-p re)
+ (user-error "Invalid refile position, please clear the cache with `C-0 C-c C-w' before refiling"))))))))
+
+(defun org-refile-new-child (parent-target child)
+ "Use refile target PARENT-TARGET to add new CHILD below it."
+ (unless parent-target
+ (error "Cannot find parent for new node"))
+ (let ((file (nth 1 parent-target))
+ (pos (nth 3 parent-target))
+ level)
+ (with-current-buffer (or (find-buffer-visiting file)
+ (find-file-noselect file))
+ (org-with-wide-buffer
+ (if pos
+ (goto-char pos)
+ (goto-char (point-max))
+ (unless (bolp) (newline)))
+ (when (looking-at org-outline-regexp)
+ (setq level (funcall outline-level))
+ (org-end-of-subtree t t))
+ (org-back-over-empty-lines)
+ (insert "\n" (make-string
+ (if pos (org-get-valid-level level 1) 1) ?*)
+ " " child "\n")
+ (beginning-of-line 0)
+ (list (concat (car parent-target) "/" child) file "" (point))))))
+
+(defun org-olpath-completing-read (prompt collection &rest args)
+ "Read an outline path like a file name."
+ (let ((thetable collection))
+ (apply #'completing-read
+ prompt
+ (lambda (string predicate &optional flag)
+ (cond
+ ((eq flag nil) (try-completion string thetable))
+ ((eq flag t)
+ (let ((l (length string)))
+ (mapcar (lambda (x)
+ (let ((r (substring x l))
+ (f (if (string-match " ([^)]*)$" x)
+ (match-string 0 x)
+ "")))
+ (if (string-match "/" r)
+ (concat string (substring r 0 (match-end 0)) f)
+ x)))
+ (all-completions string thetable predicate))))
+ ;; Exact match?
+ ((eq flag 'lambda) (assoc string thetable))))
+ args)))
+
+(provide 'org-refile)
+
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
+;;; org-refile.el ends here
diff --git a/lisp/org/org-src.el b/lisp/org/org-src.el
index 7876deaba19..20acee4e662 100644
--- a/lisp/org/org-src.el
+++ b/lisp/org/org-src.el
@@ -1,6 +1,6 @@
;;; org-src.el --- Source code examples in Org -*- lexical-binding: t; -*-
;;
-;; Copyright (C) 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Bastien Guerry <bzg@gnu.org>
@@ -37,6 +37,7 @@
(require 'org-compat)
(require 'org-keys)
+(declare-function org-mode "org" ())
(declare-function org-element-at-point "org-element" ())
(declare-function org-element-class "org-element" (datum &optional parent))
(declare-function org-element-context "org-element" (&optional element))
@@ -148,6 +149,9 @@ the existing edit buffer."
"How the source code edit buffer should be displayed.
Possible values for this option are:
+plain Show edit buffer using `display-buffer'. Users can
+ further control the display behavior by modifying
+ `display-buffer-alist' and its relatives.
current-window Show edit buffer in the current window, keeping all other
windows.
split-window-below Show edit buffer below the current window, keeping all
@@ -156,10 +160,12 @@ split-window-right Show edit buffer to the right of the current window,
keeping all other windows.
other-window Use `switch-to-buffer-other-window' to display edit buffer.
reorganize-frame Show only two windows on the current frame, the current
- window and the edit buffer. When exiting the edit buffer,
- return to one window.
+ window and the edit buffer.
other-frame Use `switch-to-buffer-other-frame' to display edit buffer.
- Also, when exiting the edit buffer, kill that frame."
+ Also, when exiting the edit buffer, kill that frame.
+
+Values that modify the window layout (reorganize-frame, split-window-below,
+split-window-right) will restore the layout after exiting the edit buffer."
:group 'org-edit-structure
:type '(choice
(const current-window)
@@ -232,11 +238,11 @@ green, respectability.
:version "26.1"
:package-version '(Org . "9.0"))
-(defcustom org-src-tab-acts-natively nil
+(defcustom org-src-tab-acts-natively t
"If non-nil, the effect of TAB in a code block is as if it were
issued in the language major mode buffer."
:type 'boolean
- :version "24.1"
+ :package-version '(Org . "9.4")
:group 'org-babel)
@@ -276,6 +282,9 @@ issued in the language major mode buffer."
(defvar-local org-src--remote nil)
(put 'org-src--remote 'permanent-local t)
+(defvar-local org-src--saved-temp-window-config nil)
+(put 'org-src--saved-temp-window-config 'permanent-local t)
+
(defvar-local org-src--source-type nil
"Type of element being edited, as a symbol.")
(put 'org-src--source-type 'permanent-local t)
@@ -355,6 +364,12 @@ where BEG and END are buffer positions and CONTENTS is a string."
(end (progn (goto-char (org-element-property :end datum))
(search-backward "}" (line-beginning-position) t))))
(list beg end (buffer-substring-no-properties beg end))))
+ ((eq type 'latex-fragment)
+ (let ((beg (org-element-property :begin datum))
+ (end (org-with-point-at (org-element-property :end datum)
+ (skip-chars-backward " \t")
+ (point))))
+ (list beg end (buffer-substring-no-properties beg end))))
((org-element-property :contents-begin datum)
(let ((beg (org-element-property :contents-begin datum))
(end (org-element-property :contents-end datum)))
@@ -469,6 +484,10 @@ When REMOTE is non-nil, do not try to preserve point or mark when
moving from the edit area to the source.
Leave point in edit buffer."
+ (when (memq org-src-window-setup '(reorganize-frame
+ split-window-below
+ split-window-right))
+ (setq org-src--saved-temp-window-config (current-window-configuration)))
(let* ((area (org-src--contents-area datum))
(beg (copy-marker (nth 0 area)))
(end (copy-marker (nth 1 area) t))
@@ -540,6 +559,10 @@ Leave point in edit buffer."
(setq org-src-source-file-name source-file-name)
;; Start minor mode.
(org-src-mode)
+ ;; Clear undo information so we cannot undo back to the
+ ;; initial empty buffer.
+ (buffer-disable-undo (current-buffer))
+ (buffer-enable-undo)
;; Move mark and point in edit buffer to the corresponding
;; location.
(if remote
@@ -792,9 +815,14 @@ Raise an error when current buffer is not a source editing buffer."
(defun org-src-switch-to-buffer (buffer context)
(pcase org-src-window-setup
+ (`plain
+ (when (eq context 'exit) (quit-restore-window))
+ (pop-to-buffer buffer))
(`current-window (pop-to-buffer-same-window buffer))
(`other-window
- (switch-to-buffer-other-window buffer))
+ (let ((cur-win (selected-window)))
+ (org-switch-to-buffer-other-window buffer)
+ (when (eq context 'exit) (quit-restore-window cur-win))))
(`split-window-below
(if (eq context 'exit)
(delete-window)
@@ -912,7 +940,7 @@ A coderef format regexp can only match at the end of a line."
;; remove any newline characters in order to preserve
;; table's structure.
(when (org-element-lineage definition '(table-cell))
- (while (search-forward "\n" nil t) (replace-match "")))))
+ (while (search-forward "\n" nil t) (replace-match " ")))))
contents
'remote))
;; Report success.
@@ -942,6 +970,46 @@ Throw an error when not at such a table."
(table-recognize)
t))
+(defun org-edit-latex-fragment ()
+ "Edit LaTeX fragment at point."
+ (interactive)
+ (let ((context (org-element-context)))
+ (unless (and (eq 'latex-fragment (org-element-type context))
+ (org-src--on-datum-p context))
+ (user-error "Not on a LaTeX fragment"))
+ (let* ((contents
+ (buffer-substring-no-properties
+ (org-element-property :begin context)
+ (- (org-element-property :end context)
+ (org-element-property :post-blank context))))
+ (delim-length (if (string-match "\\`\\$[^$]" contents) 1 2)))
+ ;; Make the LaTeX deliminators read-only.
+ (add-text-properties 0 delim-length
+ (list 'read-only "Cannot edit LaTeX deliminator"
+ 'front-sticky t
+ 'rear-nonsticky t)
+ contents)
+ (let ((l (length contents)))
+ (add-text-properties (- l delim-length) l
+ (list 'read-only "Cannot edit LaTeX deliminator"
+ 'front-sticky nil
+ 'rear-nonsticky nil)
+ contents))
+ (org-src--edit-element
+ context
+ (org-src--construct-edit-buffer-name (buffer-name) "LaTeX fragment")
+ (org-src-get-lang-mode "latex")
+ (lambda ()
+ ;; Blank lines break things, replace with a single newline.
+ (while (re-search-forward "\n[ \t]*\n" nil t) (replace-match "\n"))
+ ;; If within a table a newline would disrupt the structure,
+ ;; so remove newlines.
+ (goto-char (point-min))
+ (when (org-element-lineage context '(table-cell))
+ (while (search-forward "\n" nil t) (replace-match " "))))
+ contents))
+ t))
+
(defun org-edit-latex-environment ()
"Edit LaTeX environment at point.
\\<org-src-mode-map>
@@ -1182,8 +1250,11 @@ Throw an error if there is no such buffer."
(write-back (org-src--goto-coordinates coordinates beg end))))
;; Clean up left-over markers and restore window configuration.
(set-marker beg nil)
- (set-marker end nil)))
-
+ (set-marker end nil)
+ (when org-src--saved-temp-window-config
+ (unwind-protect
+ (set-window-configuration org-src--saved-temp-window-config)
+ (setq org-src--saved-temp-window-config nil)))))
(provide 'org-src)
diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el
index 5c37cb1af52..ef4672e1b96 100644
--- a/lisp/org/org-table.el
+++ b/lisp/org/org-table.el
@@ -1,6 +1,6 @@
;;; org-table.el --- The Table Editor for Org -*- lexical-binding: t; -*-
-;; Copyright (C) 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -40,8 +40,13 @@
(require 'org-keys)
(declare-function calc-eval "calc" (str &optional separator &rest args))
+(declare-function face-remap-remove-relative "face-remap" (cookie))
+(declare-function face-remap-add-relative "face-remap" (face &rest specs))
(declare-function org-at-timestamp-p "org" (&optional extended))
(declare-function org-delete-backward-char "org" (N))
+(declare-function org-mode "org" ())
+(declare-function org-duration-p "org-duration" (duration &optional canonical))
+(declare-function org-duration-to-minutes "org-duration" (duration &optional canonical))
(declare-function org-element-at-point "org-element" ())
(declare-function org-element-contents "org-element" (element))
(declare-function org-element-extract-element "org-element" (element))
@@ -164,6 +169,12 @@ table, obtained by prompting the user."
:tag "Org Table Settings"
:group 'org-table)
+(defcustom org-table-header-line-p nil
+ "Activate `org-table-header-line-mode' by default?"
+ :type 'boolean
+ :package-version '(Org . "9.4")
+ :group 'org-table)
+
(defcustom org-table-default-size "5x2"
"The default size for newly created tables, Columns x Rows."
:group 'org-table-settings
@@ -442,6 +453,59 @@ prevents it from hanging Emacs."
:package-version '(Org . "8.3"))
+;;; Org table header minor mode
+(defun org-table-row-get-visible-string (&optional pos)
+ "Get the visible string of a table row.
+This may be useful when columns have been shrunk."
+ (save-excursion
+ (when pos (goto-char pos))
+ (goto-char (line-beginning-position))
+ (let ((end (line-end-position)) str)
+ (while (progn (forward-char 1) (< (point) end))
+ (let ((ov (car (overlays-at (point)))))
+ (if (not ov)
+ (push (char-to-string (char-after)) str)
+ (push (overlay-get ov 'display) str)
+ (goto-char (1- (overlay-end ov))))))
+ (format "|%s" (mapconcat #'identity (reverse str) "")))))
+
+(defvar-local org-table-header-overlay nil)
+(defun org-table-header-set-header ()
+ "Display the header of the table at point."
+ (when (overlayp org-table-header-overlay)
+ (delete-overlay org-table-header-overlay))
+ (let* ((ws (window-start))
+ (beg (save-excursion
+ (goto-char (org-table-begin))
+ (while (or (org-at-table-hline-p)
+ (looking-at-p ".*|\\s-+<[rcl]?\\([0-9]+\\)?>"))
+ (move-beginning-of-line 2))
+ (point)))
+ (end (save-excursion (goto-char beg) (point-at-eol))))
+ (if (pos-visible-in-window-p beg)
+ (when (overlayp org-table-header-overlay)
+ (delete-overlay org-table-header-overlay))
+ (setq org-table-header-overlay
+ (make-overlay ws (+ ws (- end beg))))
+ (org-overlay-display
+ org-table-header-overlay
+ (org-table-row-get-visible-string beg)
+ 'org-table-header))))
+
+;;;###autoload
+(define-minor-mode org-table-header-line-mode
+ "Display the first row of the table at point in the header line."
+ nil " TblHeader" nil
+ (unless (eq major-mode 'org-mode)
+ (user-error "Cannot turn org table header mode outside org-mode buffers"))
+ (if org-table-header-line-mode
+ (add-hook 'post-command-hook #'org-table-header-set-header nil t)
+ (when (overlayp org-table-header-overlay)
+ (delete-overlay org-table-header-overlay)
+ (setq org-table-header-overlay nil))
+ (remove-hook 'post-command-hook #'org-table-header-set-header t)))
+
+
;;; Regexps Constants
(defconst org-table-any-line-regexp "^[ \t]*\\(|\\|\\+-[-+]\\)"
@@ -860,19 +924,22 @@ nil When nil, the command tries to be smart and figure out the
The command tries to be smart and figure out the separator in the
following way:
- - when each line contains a TAB, assume TAB-separated material
- - when each line contains a comma, assume CSV material
- - else, assume one or more SPACE characters as separator.
+- when each line contains a TAB, assume TAB-separated material;
+- when each line contains a comma, assume CSV material;
+- else, assume one or more SPACE characters as separator.
When non-nil, SEPARATOR specifies the field separator in the
lines. It can have the following values:
-(4) Use the comma as a field separator
-(16) Use a TAB as field separator
-(64) Prompt for a regular expression as field separator
-integer When a number, use that many spaces, or a TAB, as field separator
-regexp When a regular expression, use it to match the separator."
+- (4) Use the comma as a field separator.
+- (16) Use a TAB as field separator.
+- (64) Prompt for a regular expression as field separator.
+- integer When a number, use that many spaces, or a TAB, as field separator.
+- regexp When a regular expression, use it to match the separator."
(interactive "f\nP")
+ (when (and (called-interactively-p 'any)
+ (not (string-match-p (rx "." (or "txt" "tsv" "csv") eos) file)))
+ (user-error "Cannot import such file"))
(unless (bolp) (insert "\n"))
(let ((beg (point))
(pm (point-max)))
@@ -1181,7 +1248,7 @@ value."
(save-excursion
(let* ((pos (point))
(col (org-table-current-column))
- (cname (car (rassoc (int-to-string col) org-table-column-names)))
+ (cname (car (rassoc (number-to-string col) org-table-column-names)))
(name (car (rassoc (list (count-lines org-table-current-begin-pos
(line-beginning-position))
col)
@@ -1290,25 +1357,20 @@ However, when FORCE is non-nil, create new columns if necessary."
(while (< (point) end)
(unless (org-at-table-hline-p)
(org-table-goto-column col t)
- (unless (search-forward "|" (line-end-position) t 2)
- ;; Add missing vertical bar at the end of the row.
- (end-of-line)
- (insert "|"))
- (insert " |"))
+ (insert "|"))
(forward-line)))
- (org-table-goto-column (1+ col))
+ (org-table-goto-column col)
(org-table-align)
;; Shift appropriately stored shrunk column numbers, then hide the
;; columns again.
- (org-table--shrink-columns (mapcar (lambda (c) (if (<= c col) c (1+ c)))
+ (org-table--shrink-columns (mapcar (lambda (c) (if (< c col) c (1+ c)))
shrunk-columns)
beg end)
(set-marker end nil)
;; Fix TBLFM formulas, if desirable.
(when (or (not org-table-fix-formulas-confirm)
(funcall org-table-fix-formulas-confirm "Fix formulas? "))
- (org-table-fix-formulas "$" nil (1- col) 1)
- (org-table-fix-formulas "$LR" nil (1- col) 1))))
+ (org-table-fix-formulas "$" nil (1- col) 1))))
(defun org-table-find-dataline ()
"Find a data line in the current table, which is needed for column commands.
@@ -1431,6 +1493,8 @@ Swap with anything in target cell."
(interactive)
(unless (org-at-table-p) (user-error "Not at a table"))
(org-table-find-dataline)
+ (when (save-excursion (skip-chars-forward " \t") (eolp))
+ (search-backward "|")) ;snap into last column
(org-table-check-inside-data-field nil t)
(let* ((col (org-table-current-column))
(beg (org-table-begin))
@@ -1446,7 +1510,6 @@ Swap with anything in target cell."
(and (looking-at "|[^|\n]+|")
(replace-match "|")))
(forward-line)))
- (org-table-goto-column (max 1 (1- col)))
(org-table-align)
;; Shift appropriately stored shrunk column numbers, then hide the
;; columns again.
@@ -1458,9 +1521,7 @@ Swap with anything in target cell."
(when (or (not org-table-fix-formulas-confirm)
(funcall org-table-fix-formulas-confirm "Fix formulas? "))
(org-table-fix-formulas
- "$" (list (cons (number-to-string col) "INVALID")) col -1 col)
- (org-table-fix-formulas
- "$LR" (list (cons (number-to-string col) "INVALID")) col -1 col))))
+ "$" (list (cons (number-to-string col) "INVALID")) col -1 col))))
;;;###autoload
(defun org-table-move-column-right ()
@@ -1521,11 +1582,7 @@ Swap with anything in target cell."
(funcall org-table-fix-formulas-confirm "Fix formulas? "))
(org-table-fix-formulas
"$" (list (cons (number-to-string col) (number-to-string colpos))
- (cons (number-to-string colpos) (number-to-string col))))
- (org-table-fix-formulas
- "$LR" (list
- (cons (number-to-string col) (number-to-string colpos))
- (cons (number-to-string colpos) (number-to-string col))))))))
+ (cons (number-to-string colpos) (number-to-string col))))))))
;;;###autoload
(defun org-table-move-row-down ()
@@ -1958,9 +2015,9 @@ toggle `org-table-follow-field-mode'."
(coord
(if (eq org-table-use-standard-references t)
(concat (org-number-to-letters (org-table-current-column))
- (int-to-string (org-table-current-dline)))
- (concat "@" (int-to-string (org-table-current-dline))
- "$" (int-to-string (org-table-current-column)))))
+ (number-to-string (org-table-current-dline)))
+ (concat "@" (number-to-string (org-table-current-dline))
+ "$" (number-to-string (org-table-current-column)))))
(field (org-table-get-field))
(cw (current-window-configuration))
p)
@@ -2060,7 +2117,7 @@ When NAMED is non-nil, look for a named equation."
(org-table-current-column)))
(scol (cond
((not named) (format "$%d" (org-table-current-column)))
- ((and name (not (string-match "\\`LR[0-9]+\\'" name))) name)
+ (name)
(t ref)))
(name (or name ref))
(org-table-may-need-update nil)
@@ -2193,11 +2250,10 @@ For all numbers larger than LIMIT, shift them by DELTA."
(save-excursion
(goto-char (org-table-end))
(while (let ((case-fold-search t)) (looking-at "[ \t]*#\\+tblfm:"))
- (let ((msg "The formulas in #+TBLFM have been updated")
- (re (concat key "\\([0-9]+\\)"))
+ (let ((re (concat key "\\([0-9]+\\)"))
(re2
(when remove
- (if (or (equal key "$") (equal key "$LR"))
+ (if (equal key "$")
(format "\\(@[0-9]+\\)?%s%d=.*?\\(::\\|$\\)"
(regexp-quote key) remove)
(format "@%d\\$[0-9]+=.*?\\(::\\|$\\)" remove))))
@@ -2215,11 +2271,10 @@ For all numbers larger than LIMIT, shift them by DELTA."
(setq s (match-string 1) n (string-to-number s))
(cond
((setq a (assoc s replace))
- (replace-match (concat key (cdr a)) t t)
- (message msg))
+ (replace-match (concat key (cdr a)) t t))
((and limit (> n limit))
- (replace-match (concat key (int-to-string (+ n delta))) t t)
- (message msg))))))
+ (replace-match (concat key (number-to-string (+ n delta))) t t)))))
+ (message "The formulas in #+TBLFM have been updated"))
(forward-line))))
;;;###autoload
@@ -2547,7 +2602,8 @@ location of point."
ev (if (numberp ev) (number-to-string ev) ev)
ev (if duration (org-table-time-seconds-to-string
(string-to-number ev)
- duration-output-format) ev))
+ duration-output-format)
+ ev))
;; Use <...> time-stamps so that Calc can handle them.
(setq form
@@ -2578,27 +2634,29 @@ location of point."
ev)))
(when org-table-formula-debug
- (with-output-to-temp-buffer "*Substitution History*"
- (princ (format "Substitution history of formula
+ (let ((wcf (current-window-configuration)))
+ (with-output-to-temp-buffer "*Substitution History*"
+ (princ (format "Substitution history of formula
Orig: %s
$xyz-> %s
@r$c-> %s
$1-> %s\n" orig formula form0 form))
- (if (consp ev)
- (princ (format " %s^\nError: %s"
- (make-string (car ev) ?\-) (nth 1 ev)))
- (princ (format "Result: %s\nFormat: %s\nFinal: %s"
- ev (or fmt "NONE")
- (if fmt (format fmt (string-to-number ev)) ev)))))
- (setq bw (get-buffer-window "*Substitution History*"))
- (org-fit-window-to-buffer bw)
- (unless (and (called-interactively-p 'any) (not ndown))
- (unless (let (inhibit-redisplay)
- (y-or-n-p "Debugging Formula. Continue to next? "))
- (org-table-align)
- (user-error "Abort"))
- (delete-window bw)
- (message "")))
+ (if (consp ev)
+ (princ (format " %s^\nError: %s"
+ (make-string (car ev) ?\-) (nth 1 ev)))
+ (princ (format "Result: %s\nFormat: %s\nFinal: %s"
+ ev (or fmt "NONE")
+ (if fmt (format fmt (string-to-number ev)) ev)))))
+ (setq bw (get-buffer-window "*Substitution History*"))
+ (org-fit-window-to-buffer bw)
+ (unless (and (called-interactively-p 'any) (not ndown))
+ (unless (let (inhibit-redisplay)
+ (y-or-n-p "Debugging Formula. Continue to next? "))
+ (org-table-align)
+ (user-error "Abort"))
+ (delete-window bw)
+ (message "")
+ (set-window-configuration wcf))))
(when (consp ev) (setq fmt nil ev "#ERROR"))
(org-table-justify-field-maybe
(format org-table-formula-field-format
@@ -3287,7 +3345,6 @@ Parameters get priority."
(setq-local org-selected-window sel-win)
(use-local-map org-table-fedit-map)
(add-hook 'post-command-hook #'org-table-fedit-post-command t t)
- (easy-menu-add org-table-fedit-menu)
(setq startline (org-current-line))
(dolist (entry eql)
(let* ((type (cond
@@ -3768,14 +3825,16 @@ FACE, when non-nil, for the highlight."
(defun org-table-toggle-coordinate-overlays ()
"Toggle the display of Row/Column numbers in tables."
(interactive)
- (setq org-table-overlay-coordinates (not org-table-overlay-coordinates))
- (message "Tables Row/Column numbers display turned %s"
- (if org-table-overlay-coordinates "on" "off"))
- (when (and (org-at-table-p) org-table-overlay-coordinates)
- (org-table-align))
- (unless org-table-overlay-coordinates
- (mapc 'delete-overlay org-table-coordinate-overlays)
- (setq org-table-coordinate-overlays nil)))
+ (if (not (org-at-table-p))
+ (user-error "Not on a table")
+ (setq org-table-overlay-coordinates (not org-table-overlay-coordinates))
+ (when (and (org-at-table-p) org-table-overlay-coordinates)
+ (org-table-align))
+ (unless org-table-overlay-coordinates
+ (mapc 'delete-overlay org-table-coordinate-overlays)
+ (setq org-table-coordinate-overlays nil))
+ (message "Tables Row/Column numbers display turned %s"
+ (if org-table-overlay-coordinates "on" "off"))))
;;;###autoload
(defun org-table-toggle-formula-debugger ()
@@ -4239,7 +4298,8 @@ extension of the given file name, and finally on the variable
(and (string-match-p fileext f) f))
formats)))
org-table-export-default-format)
- t t) t t)))
+ t t)
+ t t)))
(setq format
(org-completing-read
"Format: " formats nil nil deffmt-readable))))
@@ -4247,9 +4307,7 @@ extension of the given file name, and finally on the variable
(let ((transform (intern (match-string 1 format)))
(params (and (match-end 2)
(read (concat "(" (match-string 2 format) ")"))))
- (table (org-table-to-lisp
- (buffer-substring-no-properties
- (org-table-begin) (org-table-end)))))
+ (table (org-table-to-lisp)))
(unless (fboundp transform)
(user-error "No such transformation function %s" transform))
(let (buf)
@@ -4293,78 +4351,79 @@ FIELD is a string. WIDTH is a number. ALIGN is either \"c\",
(move-marker org-table-aligned-end-marker end)
(goto-char beg)
(org-table-with-shrunk-columns
- (let* ((indent (progn (looking-at "[ \t]*") (match-string 0)))
- ;; Table's rows as lists of fields. Rules are replaced
- ;; by nil. Trailing spaces are removed.
- (fields (mapcar
- (lambda (l)
- (and (not (string-match-p org-table-hline-regexp l))
- (org-split-string l "[ \t]*|[ \t]*")))
- (split-string (buffer-substring beg end) "\n" t)))
- ;; Compute number of columns. If the table contains no
- ;; field, create a default table and bail out.
- (columns-number
- (if fields (apply #'max (mapcar #'length fields))
- (kill-region beg end)
- (org-table-create org-table-default-size)
- (user-error "Empty table - created default table")))
+ (let* ((table (org-table-to-lisp))
+ (rows (remq 'hline table))
(widths nil)
- (alignments nil))
- ;; Compute alignment and width for each column.
- (dotimes (i columns-number)
- (let* ((max-width 1)
- (fixed-align? nil)
- (numbers 0)
- (non-empty 0))
- (dolist (row fields)
- (let ((cell (or (nth i row) "")))
- (setq max-width (max max-width (org-string-width cell)))
- (cond (fixed-align? nil)
- ((equal cell "") nil)
- ((string-match "\\`<\\([lrc]\\)[0-9]*>\\'" cell)
- (setq fixed-align? (match-string 1 cell)))
- (t
- (cl-incf non-empty)
- (when (string-match-p org-table-number-regexp cell)
- (cl-incf numbers))))))
- (push max-width widths)
- (push (cond
- (fixed-align?)
- ((>= numbers (* org-table-number-fraction non-empty)) "r")
- (t "l"))
- alignments)))
- (setq widths (nreverse widths))
- (setq alignments (nreverse alignments))
+ (alignments nil)
+ (columns-number 1))
+ (if (null rows)
+ ;; Table contains only horizontal rules. Compute the
+ ;; number of columns anyway, and choose an arbitrary width
+ ;; and alignment.
+ (let ((end (line-end-position)))
+ (save-excursion
+ (while (search-forward "+" end t)
+ (cl-incf columns-number)))
+ (setq widths (make-list columns-number 1))
+ (setq alignments (make-list columns-number "l")))
+ ;; Compute alignment and width for each column.
+ (setq columns-number (apply #'max (mapcar #'length rows)))
+ (dotimes (i columns-number)
+ (let ((max-width 1)
+ (fixed-align? nil)
+ (numbers 0)
+ (non-empty 0))
+ (dolist (row rows)
+ (let ((cell (or (nth i row) "")))
+ (setq max-width (max max-width (org-string-width cell)))
+ (cond (fixed-align? nil)
+ ((equal cell "") nil)
+ ((string-match "\\`<\\([lrc]\\)[0-9]*>\\'" cell)
+ (setq fixed-align? (match-string 1 cell)))
+ (t
+ (cl-incf non-empty)
+ (when (string-match-p org-table-number-regexp cell)
+ (cl-incf numbers))))))
+ (push max-width widths)
+ (push (cond
+ (fixed-align?)
+ ((>= numbers (* org-table-number-fraction non-empty)) "r")
+ (t "l"))
+ alignments)))
+ (setq widths (nreverse widths))
+ (setq alignments (nreverse alignments)))
;; Store alignment of this table, for later editing of single
;; fields.
(setq org-table-last-alignment alignments)
(setq org-table-last-column-widths widths)
;; Build new table rows. Only replace rows that actually
;; changed.
- (dolist (row fields)
- (let ((previous (buffer-substring (point) (line-end-position)))
- (new
- (format "%s|%s|"
- indent
- (if (null row) ;horizontal rule
- (mapconcat (lambda (w) (make-string (+ 2 w) ?-))
- widths
- "+")
- (let ((cells ;add missing fields
- (append row
- (make-list (- columns-number
- (length row))
- ""))))
- (mapconcat #'identity
- (cl-mapcar #'org-table--align-field
- cells
- widths
- alignments)
- "|"))))))
- (if (equal new previous)
- (forward-line)
- (insert new "\n")
- (delete-region (point) (line-beginning-position 2)))))
+ (let ((rule (and (memq 'hline table)
+ (mapconcat (lambda (w) (make-string (+ 2 w) ?-))
+ widths
+ "+")))
+ (indent (progn (looking-at "[ \t]*|") (match-string 0))))
+ (dolist (row table)
+ (let ((previous (buffer-substring (point) (line-end-position)))
+ (new
+ (concat indent
+ (if (eq row 'hline) rule
+ (let* ((offset (- columns-number (length row)))
+ (fields (if (= 0 offset) row
+ ;; Add missing fields.
+ (append row
+ (make-list offset "")))))
+ (mapconcat #'identity
+ (cl-mapcar #'org-table--align-field
+ fields
+ widths
+ alignments)
+ "|")))
+ "|")))
+ (if (equal new previous)
+ (forward-line)
+ (insert new "\n")
+ (delete-region (point) (line-beginning-position 2))))))
(set-marker end nil)
(when org-table-overlay-coordinates (org-table-overlay-coordinates))
(setq org-table-may-need-update nil))))))
@@ -4406,7 +4465,7 @@ Optional argument NEW may specify text to replace the current field content."
((not new)
(concat (org-table--align-field field width align)
"|"))
- ((<= (org-string-width new) width)
+ ((and width (<= (org-string-width new) width))
(concat (org-table--align-field new width align)
"|"))
(t
@@ -4758,7 +4817,7 @@ This function sets up the following dynamically scoped variables:
(dolist (name (org-split-string (match-string 1) " *| *"))
(cl-incf c)
(when (string-match "\\`[a-zA-Z][_a-zA-Z0-9]*\\'" name)
- (push (cons name (int-to-string c)) org-table-column-names)))))
+ (push (cons name (number-to-string c)) org-table-column-names)))))
(setq org-table-column-names (nreverse org-table-column-names))
(setq org-table-column-name-regexp
(format "\\$\\(%s\\)\\>"
@@ -4817,23 +4876,10 @@ This function sets up the following dynamically scoped variables:
;; Get the number of columns from the first data line in table.
(goto-char beg)
(forward-line (aref org-table-dlines 1))
- (let* ((fields
- (org-split-string
- (buffer-substring (line-beginning-position) (line-end-position))
- "[ \t]*|[ \t]*"))
- (nfields (length fields))
- al al2)
- (setq org-table-current-ncol nfields)
- (let ((last-dline
- (aref org-table-dlines (1- (length org-table-dlines)))))
- (dotimes (i nfields)
- (let ((column (1+ i)))
- (push (list (format "LR%d" column) last-dline column) al)
- (push (cons (format "LR%d" column) (nth i fields)) al2))))
- (setq org-table-named-field-locations
- (append org-table-named-field-locations al))
- (setq org-table-local-parameters
- (append org-table-local-parameters al2))))))
+ (setq org-table-current-ncol
+ (length (org-split-string
+ (buffer-substring (line-beginning-position) (line-end-position))
+ "[ \t]*|[ \t]*"))))))
(defun org-table--force-dataline ()
"Move point to the closest data line in a table.
@@ -5039,66 +5085,66 @@ When LOCAL is non-nil, show references for the table at point."
(put 'orgtbl-mode :menu-tag "Org Table Mode")
(easy-menu-define orgtbl-mode-menu orgtbl-mode-map "OrgTbl menu"
- '("OrgTbl"
- ["Create or convert" org-table-create-or-convert-from-region
- :active (not (org-at-table-p)) :keys "C-c |" ]
- "--"
- ["Align" org-ctrl-c-ctrl-c :active (org-at-table-p) :keys "C-c C-c"]
- ["Next Field" org-cycle :active (org-at-table-p) :keys "TAB"]
- ["Previous Field" org-shifttab :active (org-at-table-p) :keys "S-TAB"]
- ["Next Row" org-return :active (org-at-table-p) :keys "RET"]
- "--"
- ["Blank Field" org-table-blank-field :active (org-at-table-p) :keys "C-c SPC"]
- ["Edit Field" org-table-edit-field :active (org-at-table-p) :keys "C-c ` "]
- ["Copy Field from Above"
- org-table-copy-down :active (org-at-table-p) :keys "S-RET"]
- "--"
- ("Column"
- ["Move Column Left" org-metaleft :active (org-at-table-p) :keys "M-<left>"]
- ["Move Column Right" org-metaright :active (org-at-table-p) :keys "M-<right>"]
- ["Delete Column" org-shiftmetaleft :active (org-at-table-p) :keys "M-S-<left>"]
- ["Insert Column" org-shiftmetaright :active (org-at-table-p) :keys "M-S-<right>"])
- ("Row"
- ["Move Row Up" org-metaup :active (org-at-table-p) :keys "M-<up>"]
- ["Move Row Down" org-metadown :active (org-at-table-p) :keys "M-<down>"]
- ["Delete Row" org-shiftmetaup :active (org-at-table-p) :keys "M-S-<up>"]
- ["Insert Row" org-shiftmetadown :active (org-at-table-p) :keys "M-S-<down>"]
- ["Sort lines in region" org-table-sort-lines :active (org-at-table-p) :keys "C-c ^"]
- "--"
- ["Insert Hline" org-table-insert-hline :active (org-at-table-p) :keys "C-c -"])
- ("Rectangle"
- ["Copy Rectangle" org-copy-special :active (org-at-table-p)]
- ["Cut Rectangle" org-cut-special :active (org-at-table-p)]
- ["Paste Rectangle" org-paste-special :active (org-at-table-p)]
- ["Fill Rectangle" org-table-wrap-region :active (org-at-table-p)])
- "--"
- ("Radio tables"
- ["Insert table template" orgtbl-insert-radio-table
- (cl-assoc-if #'derived-mode-p orgtbl-radio-table-templates)]
- ["Comment/uncomment table" orgtbl-toggle-comment t])
- "--"
- ["Set Column Formula" org-table-eval-formula :active (org-at-table-p) :keys "C-c ="]
- ["Set Field Formula" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="]
- ["Edit Formulas" org-table-edit-formulas :active (org-at-table-p) :keys "C-c '"]
- ["Recalculate line" org-table-recalculate :active (org-at-table-p) :keys "C-c *"]
- ["Recalculate all" (org-table-recalculate '(4)) :active (org-at-table-p) :keys "C-u C-c *"]
- ["Iterate all" (org-table-recalculate '(16)) :active (org-at-table-p) :keys "C-u C-u C-c *"]
- ["Toggle Recalculate Mark" org-table-rotate-recalc-marks :active (org-at-table-p) :keys "C-c #"]
- ["Sum Column/Rectangle" org-table-sum
- :active (or (org-at-table-p) (org-region-active-p)) :keys "C-c +"]
- ["Which Column?" org-table-current-column :active (org-at-table-p) :keys "C-c ?"]
- ["Debug Formulas"
- org-table-toggle-formula-debugger :active (org-at-table-p)
- :keys "C-c {"
- :style toggle :selected org-table-formula-debug]
- ["Show Col/Row Numbers"
- org-table-toggle-coordinate-overlays :active (org-at-table-p)
- :keys "C-c }"
- :style toggle :selected org-table-overlay-coordinates]
- "--"
- ("Plot"
- ["Ascii plot" orgtbl-ascii-plot :active (org-at-table-p) :keys "C-c \" a"]
- ["Gnuplot" org-plot/gnuplot :active (org-at-table-p) :keys "C-c \" g"])))
+ '("OrgTbl"
+ ["Create or convert" org-table-create-or-convert-from-region
+ :active (not (org-at-table-p)) :keys "C-c |" ]
+ "--"
+ ["Align" org-ctrl-c-ctrl-c :active (org-at-table-p) :keys "C-c C-c"]
+ ["Next Field" org-cycle :active (org-at-table-p) :keys "TAB"]
+ ["Previous Field" org-shifttab :active (org-at-table-p) :keys "S-TAB"]
+ ["Next Row" org-return :active (org-at-table-p) :keys "RET"]
+ "--"
+ ["Blank Field" org-table-blank-field :active (org-at-table-p) :keys "C-c SPC"]
+ ["Edit Field" org-table-edit-field :active (org-at-table-p) :keys "C-c ` "]
+ ["Copy Field from Above"
+ org-table-copy-down :active (org-at-table-p) :keys "S-RET"]
+ "--"
+ ("Column"
+ ["Move Column Left" org-metaleft :active (org-at-table-p) :keys "M-<left>"]
+ ["Move Column Right" org-metaright :active (org-at-table-p) :keys "M-<right>"]
+ ["Delete Column" org-shiftmetaleft :active (org-at-table-p) :keys "M-S-<left>"]
+ ["Insert Column" org-shiftmetaright :active (org-at-table-p) :keys "M-S-<right>"])
+ ("Row"
+ ["Move Row Up" org-metaup :active (org-at-table-p) :keys "M-<up>"]
+ ["Move Row Down" org-metadown :active (org-at-table-p) :keys "M-<down>"]
+ ["Delete Row" org-shiftmetaup :active (org-at-table-p) :keys "M-S-<up>"]
+ ["Insert Row" org-shiftmetadown :active (org-at-table-p) :keys "M-S-<down>"]
+ ["Sort lines in region" org-table-sort-lines :active (org-at-table-p) :keys "C-c ^"]
+ "--"
+ ["Insert Hline" org-table-insert-hline :active (org-at-table-p) :keys "C-c -"])
+ ("Rectangle"
+ ["Copy Rectangle" org-copy-special :active (org-at-table-p)]
+ ["Cut Rectangle" org-cut-special :active (org-at-table-p)]
+ ["Paste Rectangle" org-paste-special :active (org-at-table-p)]
+ ["Fill Rectangle" org-table-wrap-region :active (org-at-table-p)])
+ "--"
+ ("Radio tables"
+ ["Insert table template" orgtbl-insert-radio-table
+ (cl-assoc-if #'derived-mode-p orgtbl-radio-table-templates)]
+ ["Comment/uncomment table" orgtbl-toggle-comment t])
+ "--"
+ ["Set Column Formula" org-table-eval-formula :active (org-at-table-p) :keys "C-c ="]
+ ["Set Field Formula" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="]
+ ["Edit Formulas" org-table-edit-formulas :active (org-at-table-p) :keys "C-c '"]
+ ["Recalculate line" org-table-recalculate :active (org-at-table-p) :keys "C-c *"]
+ ["Recalculate all" (org-table-recalculate '(4)) :active (org-at-table-p) :keys "C-u C-c *"]
+ ["Iterate all" (org-table-recalculate '(16)) :active (org-at-table-p) :keys "C-u C-u C-c *"]
+ ["Toggle Recalculate Mark" org-table-rotate-recalc-marks :active (org-at-table-p) :keys "C-c #"]
+ ["Sum Column/Rectangle" org-table-sum
+ :active (or (org-at-table-p) (org-region-active-p)) :keys "C-c +"]
+ ["Which Column?" org-table-current-column :active (org-at-table-p) :keys "C-c ?"]
+ ["Debug Formulas"
+ org-table-toggle-formula-debugger :active (org-at-table-p)
+ :keys "C-c {"
+ :style toggle :selected org-table-formula-debug]
+ ["Show Col/Row Numbers"
+ org-table-toggle-coordinate-overlays :active (org-at-table-p)
+ :keys "C-c }"
+ :style toggle :selected org-table-overlay-coordinates]
+ "--"
+ ("Plot"
+ ["Ascii plot" orgtbl-ascii-plot :active (org-at-table-p) :keys "C-c \" a"]
+ ["Gnuplot" org-plot/gnuplot :active (org-at-table-p) :keys "C-c \" g"])))
;;;###autoload
(define-minor-mode orgtbl-mode
@@ -5129,15 +5175,13 @@ When LOCAL is non-nil, show references for the table at point."
orgtbl-line-start-regexp))
(when (fboundp 'font-lock-add-keywords)
(font-lock-add-keywords nil orgtbl-extra-font-lock-keywords)
- (org-restart-font-lock))
- (easy-menu-add orgtbl-mode-menu))
+ (org-restart-font-lock)))
(t
(setq auto-fill-inhibit-regexp org-old-auto-fill-inhibit-regexp)
(remove-hook 'before-change-functions 'org-before-change-function t)
(when (fboundp 'font-lock-remove-keywords)
(font-lock-remove-keywords nil orgtbl-extra-font-lock-keywords)
(org-restart-font-lock))
- (easy-menu-remove orgtbl-mode-menu)
(force-mode-line-update 'all))))
(defun orgtbl-make-binding (fun n &rest keys)
@@ -5147,7 +5191,7 @@ command name. KEYS are keys that should be checked in for a command
to execute outside of tables."
(eval
(list 'defun
- (intern (concat "orgtbl-hijacker-command-" (int-to-string n)))
+ (intern (concat "orgtbl-hijacker-command-" (number-to-string n)))
'(arg)
(concat "In tables, run `" (symbol-name fun) "'.\n"
"Outside of tables, run the binding of `"
@@ -5401,17 +5445,56 @@ a radio table."
;;;###autoload
(defun org-table-to-lisp (&optional txt)
"Convert the table at point to a Lisp structure.
+
The structure will be a list. Each item is either the symbol `hline'
for a horizontal separator line, or a list of field values as strings.
The table is taken from the parameter TXT, or from the buffer at point."
- (unless (or txt (org-at-table-p)) (user-error "No table at point"))
- (let ((txt (or txt
- (buffer-substring-no-properties (org-table-begin)
- (org-table-end)))))
- (mapcar (lambda (x)
- (if (string-match org-table-hline-regexp x) 'hline
- (org-split-string (org-trim x) "\\s-*|\\s-*")))
- (org-split-string txt "[ \t]*\n[ \t]*"))))
+ (if txt
+ (with-temp-buffer
+ (insert txt)
+ (goto-char (point-min))
+ (org-table-to-lisp))
+ (save-excursion
+ (goto-char (org-table-begin))
+ (let ((table nil))
+ (while (re-search-forward "\\=[ \t]*|" nil t)
+ (let ((row nil))
+ (if (looking-at "-")
+ (push 'hline table)
+ (while (not (progn (skip-chars-forward " \t") (eolp)))
+ (push (buffer-substring
+ (point)
+ (progn (re-search-forward "[ \t]*\\(|\\|$\\)")
+ (match-beginning 0)))
+ row))
+ (push (nreverse row) table)))
+ (forward-line))
+ (nreverse table)))))
+
+(defun org-table-collapse-header (table &optional separator max-header-lines)
+ "Collapse the lines before 'hline into a single header.
+
+The given TABLE is a list of lists as returned by `org-table-to-lisp'.
+The leading lines before the first `hline' symbol are considered
+forming the table header. This function collapses all leading header
+lines into a single header line, followed by the `hline' symbol, and
+the rest of the TABLE. Header cells are glued together with a space,
+or the given SEPARATOR."
+ (while (eq (car table) 'hline) (pop table))
+ (let* ((separator (or separator " "))
+ (max-header-lines (or max-header-lines 4))
+ (trailer table)
+ (header-lines (cl-loop for line in table
+ until (eq 'hline line)
+ collect (pop trailer))))
+ (if (and trailer (<= (length header-lines) max-header-lines))
+ (cons (apply #'cl-mapcar
+ (lambda (&rest x)
+ (org-trim
+ (mapconcat #'identity x separator)))
+ header-lines)
+ trailer)
+ table)))
(defun orgtbl-send-table (&optional maybe)
"Send a transformed version of table at point to the receiver position.
@@ -5423,9 +5506,7 @@ for this table."
;; when non-interactive, we assume align has just happened.
(when (called-interactively-p 'any) (org-table-align))
(let ((dests (orgtbl-gather-send-defs))
- (table (org-table-to-lisp
- (buffer-substring-no-properties (org-table-begin)
- (org-table-end))))
+ (table (org-table-to-lisp))
(ntbl 0))
(unless dests
(if maybe (throw 'exit nil)
@@ -6096,7 +6177,7 @@ which will prompt for the width."
((numberp ask) ask)
(t 12))))
;; Skip any hline a the top of table.
- (while (eq (car table) 'hline) (setq table (cdr table)))
+ (while (eq (car table) 'hline) (pop table))
;; Skip table header if any.
(dolist (x (or (cdr (memq 'hline table)) table))
(when (consp x)
diff --git a/lisp/org/org-tempo.el b/lisp/org/org-tempo.el
index fe3b5f8da10..36b8614fe1c 100644
--- a/lisp/org/org-tempo.el
+++ b/lisp/org/org-tempo.el
@@ -1,6 +1,6 @@
;;; org-tempo.el --- Template expansion for Org structures -*- lexical-binding: t; -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;;
;; Author: Rasmus Pank Roulund <emacs at pank dot eu>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -122,7 +122,7 @@ Go through `org-structure-template-alist' and
(special (member name '("src" "export"))))
(tempo-define-template (format "org-%s" (replace-regexp-in-string " " "-" name))
`(,(format "#+begin_%s%s" name (if special " " ""))
- ,(when special 'p) '> n '> ,(unless special 'p) n
+ ,(when special 'p) '> n ,(unless special 'p) n
,(format "#+end_%s" (car (split-string name " ")))
>)
key
diff --git a/lisp/org/org-timer.el b/lisp/org/org-timer.el
index a1eb5e4a7a7..b6802fe8b04 100644
--- a/lisp/org/org-timer.el
+++ b/lisp/org/org-timer.el
@@ -1,6 +1,6 @@
;;; org-timer.el --- Timer code for Org mode -*- lexical-binding: t; -*-
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -470,19 +470,18 @@ time is up."
Try to use an Org header, otherwise use the buffer name."
(cond
((derived-mode-p 'org-agenda-mode)
- (let* ((marker (or (get-text-property (point) 'org-marker)
- (org-agenda-error)))
+ (let* ((marker (or (get-text-property (point) 'org-marker)))
(hdmarker (or (get-text-property (point) 'org-hd-marker)
marker)))
- (with-current-buffer (marker-buffer marker)
- (org-with-wide-buffer
- (goto-char hdmarker)
- (org-show-entry)
- (or (ignore-errors (org-get-heading))
- (buffer-name (buffer-base-buffer)))))))
+ (when (and marker (marker-buffer marker))
+ (with-current-buffer (marker-buffer marker)
+ (org-with-wide-buffer
+ (goto-char hdmarker)
+ (org-show-entry)
+ (or (ignore-errors (org-get-heading))
+ (buffer-name (buffer-base-buffer))))))))
((derived-mode-p 'org-mode)
- (or (ignore-errors (org-get-heading))
- (buffer-name (buffer-base-buffer))))
+ (ignore-errors (org-get-heading)))
(t (buffer-name (buffer-base-buffer)))))
(provide 'org-timer)
diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el
index 2a783871405..25b3354bdd7 100644
--- a/lisp/org/org-version.el
+++ b/lisp/org/org-version.el
@@ -5,13 +5,13 @@
(defun org-release ()
"The release version of Org.
Inserted by installing Org mode or when a release is made."
- (let ((org-release "9.3"))
+ (let ((org-release "9.4.4"))
org-release))
;;;###autoload
(defun org-git-version ()
"The Git version of Org mode.
Inserted by installing Org or when a release is made."
- (let ((org-git-version "release_9.3"))
+ (let ((org-git-version "release_9.4.4"))
org-git-version))
(provide 'org-version)
diff --git a/lisp/org/org.el b/lisp/org/org.el
index 1ab8ab68880..43aa0a178a9 100644
--- a/lisp/org/org.el
+++ b/lisp/org/org.el
@@ -1,13 +1,15 @@
;;; org.el --- Outline-based notes management and organizer -*- lexical-binding: t; -*-
;; Carstens outline-mode for keeping track of everything.
-;; Copyright (C) 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Maintainer: Bastien Guerry <bzg@gnu.org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://orgmode.org
-;; Version: 9.3
-;;
+
+;; Version: 9.4.4
+
;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software: you can redistribute it and/or modify
@@ -121,9 +123,12 @@ Stars are put in group 1 and the trimmed body in group 2.")
(declare-function org-archive-subtree-default "org-archive" ())
(declare-function org-archive-to-archive-sibling "org-archive" ())
(declare-function org-attach "org-attach" ())
+(declare-function org-attach-dir "org-attach"
+ (&optional create-if-not-exists-p no-fs-check))
(declare-function org-babel-do-in-edit-buffer "ob-core" (&rest body) t)
(declare-function org-babel-tangle-file "ob-tangle" (file &optional target-file lang))
(declare-function org-beamer-mode "ox-beamer" (&optional prefix) t)
+(declare-function org-clock-auto-clockout "org-clock" ())
(declare-function org-clock-cancel "org-clock" ())
(declare-function org-clock-display "org-clock" (&optional arg))
(declare-function org-clock-get-last-clock-out-time "org-clock" ())
@@ -141,8 +146,10 @@ Stars are put in group 1 and the trimmed body in group 2.")
(declare-function org-clock-update-time-maybe "org-clock" ())
(declare-function org-clocking-buffer "org-clock" ())
(declare-function org-clocktable-shift "org-clock" (dir n))
+(declare-function org-columns-quit "org-colview" ())
(declare-function org-columns-insert-dblock "org-colview" ())
(declare-function org-duration-from-minutes "org-duration" (minutes &optional fmt canonical))
+(declare-function org-duration-to-minutes "org-duration" (duration &optional canonical))
(declare-function org-element-at-point "org-element" ())
(declare-function org-element-cache-refresh "org-element" (pos))
(declare-function org-element-cache-reset "org-element" (&optional all))
@@ -172,6 +179,7 @@ Stars are put in group 1 and the trimmed body in group 2.")
(declare-function org-inlinetask-outline-regexp "org-inlinetask" ())
(declare-function org-inlinetask-toggle-visibility "org-inlinetask" ())
(declare-function org-latex-make-preamble "ox-latex" (info &optional template snippet?))
+(declare-function org-num-mode "org-num" (&optional arg))
(declare-function org-plot/gnuplot "org-plot" (&optional params))
(declare-function org-tags-view "org-agenda" (&optional todo-only match))
(declare-function org-timer "org-timer" (&optional restart no-insert))
@@ -189,6 +197,7 @@ Stars are put in group 1 and the trimmed body in group 2.")
(defvar org-radio-target-regexp)
(defvar org-target-link-regexp)
(defvar org-target-regexp)
+(defvar org-id-overriding-file-name)
;; load languages based on value of `org-babel-load-languages'
(defvar org-babel-load-languages)
@@ -215,16 +224,17 @@ and then loads the resulting file using `load-file'. With
optional prefix argument COMPILE, the tangled Emacs Lisp file is
byte-compiled before it is loaded."
(interactive "fFile to load: \nP")
- (let* ((tangled-file (concat (file-name-sans-extension file) ".el")))
+ (let ((tangled-file (concat (file-name-sans-extension file) ".el")))
;; Tangle only if the Org file is newer than the Elisp file.
(unless (org-file-newer-than-p
tangled-file
- (file-attribute-modification-time (file-attributes file)))
- (org-babel-tangle-file file tangled-file "emacs-lisp"))
+ (file-attribute-modification-time
+ (file-attributes (file-truename file))))
+ (org-babel-tangle-file file tangled-file "emacs-lisp\\|elisp"))
(if compile
(progn
- (byte-compile-file tangled-file)
- (load tangled-file)
+ (byte-compile-file tangled-file)
+ (load tangled-file)
(message "Compiled and loaded %s" tangled-file))
(load-file tangled-file)
(message "Loaded %s" tangled-file))))
@@ -349,6 +359,14 @@ FULL is given."
;;; Syntax Constants
+;;;; Comments
+(defconst org-comment-regexp
+ (rx (seq bol (zero-or-more (any "\t ")) "#" (or " " eol)))
+ "Regular expression for comment lines.")
+
+;;;; Keyword
+(defconst org-keyword-regexp "^[ \t]*#\\+\\(\\S-+?\\):[ \t]*\\(.*\\)$"
+ "Regular expression for keyword-lines.")
;;;; Block
@@ -363,6 +381,65 @@ FULL is given."
(defconst org-dblock-end-re "^[ \t]*#\\+\\(?:END\\|end\\)\\([: \t\r\n]\\|$\\)"
"Matches the end of a dynamic block.")
+;;;; Timestamp
+
+(defconst org-ts--internal-regexp
+ (rx (seq
+ (= 4 digit) "-" (= 2 digit) "-" (= 2 digit)
+ (optional " " (*? nonl))))
+ "Regular expression matching the innards of a time stamp.")
+
+(defconst org-ts-regexp (format "<\\(%s\\)>" org-ts--internal-regexp)
+ "Regular expression for fast time stamp matching.")
+
+(defconst org-ts-regexp-inactive
+ (format "\\[\\(%s\\)\\]" org-ts--internal-regexp)
+ "Regular expression for fast inactive time stamp matching.")
+
+(defconst org-ts-regexp-both (format "[[<]\\(%s\\)[]>]" org-ts--internal-regexp)
+ "Regular expression for fast time stamp matching.")
+
+(defconst org-ts-regexp0
+ "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\)\\( +[^]+0-9>\r\n -]+\\)?\\( +\\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)"
+ "Regular expression matching time strings for analysis.
+This one does not require the space after the date, so it can be used
+on a string that terminates immediately after the date.")
+
+(defconst org-ts-regexp1 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) *\\([^]+0-9>\r\n -]*\\)\\( \\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)"
+ "Regular expression matching time strings for analysis.")
+
+(defconst org-ts-regexp2 (concat "<" org-ts-regexp1 "[^>\n]\\{0,16\\}>")
+ "Regular expression matching time stamps, with groups.")
+
+(defconst org-ts-regexp3 (concat "[[<]" org-ts-regexp1 "[^]>\n]\\{0,16\\}[]>]")
+ "Regular expression matching time stamps (also [..]), with groups.")
+
+(defconst org-tr-regexp (concat org-ts-regexp "--?-?" org-ts-regexp)
+ "Regular expression matching a time stamp range.")
+
+(defconst org-tr-regexp-both
+ (concat org-ts-regexp-both "--?-?" org-ts-regexp-both)
+ "Regular expression matching a time stamp range.")
+
+(defconst org-tsr-regexp (concat org-ts-regexp "\\(--?-?"
+ org-ts-regexp "\\)?")
+ "Regular expression matching a time stamp or time stamp range.")
+
+(defconst org-tsr-regexp-both
+ (concat org-ts-regexp-both "\\(--?-?"
+ org-ts-regexp-both "\\)?")
+ "Regular expression matching a time stamp or time stamp range.
+The time stamps may be either active or inactive.")
+
+(defconst org-repeat-re
+ "<[0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9] [^>\n]*?\
+\\([.+]?\\+[0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)"
+ "Regular expression for specifying repeated events.
+After a match, group 1 contains the repeat expression.")
+
+(defconst org-time-stamp-formats '("<%Y-%m-%d %a>" . "<%Y-%m-%d %a %H:%M>")
+ "Formats for `format-time-string' which are used for time stamps.")
+
;;;; Clock and Planning
(defconst org-clock-string "CLOCK:"
@@ -414,7 +491,7 @@ Matched keyword is in group 1.")
(defconst org-deadline-time-hour-regexp
(concat "\\<" org-deadline-string
- " *<\\([^>]+[0-9]\\{1,2\\}:[0-9]\\{2\\}[0-9+:hdwmy \t.-]*\\)>")
+ " *<\\([^>]+[0-9]\\{1,2\\}:[0-9]\\{2\\}[0-9+:hdwmy/ \t.-]*\\)>")
"Matches the DEADLINE keyword together with a time-and-hour stamp.")
(defconst org-deadline-line-regexp
@@ -430,7 +507,7 @@ Matched keyword is in group 1.")
(defconst org-scheduled-time-hour-regexp
(concat "\\<" org-scheduled-string
- " *<\\([^>]+[0-9]\\{1,2\\}:[0-9]\\{2\\}[0-9+:hdwmy \t.-]*\\)>")
+ " *<\\([^>]+[0-9]\\{1,2\\}:[0-9]\\{2\\}[0-9+:hdwmy/ \t.-]*\\)>")
"Matches the SCHEDULED keyword together with a time-and-hour stamp.")
(defconst org-closed-time-regexp
@@ -454,18 +531,6 @@ Matched keyword is in group 1.")
" *[[<]\\([^]>]+\\)[]>]")
"Matches any of the 3 keywords, together with the time stamp.")
-(defconst org-maybe-keyword-time-regexp
- (concat "\\(\\<"
- (regexp-opt
- (list org-scheduled-string org-deadline-string org-closed-string
- org-clock-string)
- t)
- "\\)?"
- " *\\([[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}[^]\r\n>]*[]>]"
- "\\|"
- "<%%([^\r\n>]*>\\)")
- "Matches a timestamp, possibly preceded by a keyword.")
-
(defconst org-all-time-keywords
(mapcar (lambda (w) (substring w 0 -1))
(list org-scheduled-string org-deadline-string
@@ -490,6 +555,12 @@ Group 1 contains drawer's name or \"END\".")
(defconst org-clock-drawer-end-re "^[ \t]*:END:[ \t]*$"
"Regular expression matching the last line of a clock drawer.")
+(defconst org-logbook-drawer-re
+ (rx (seq bol (0+ (any "\t ")) ":LOGBOOK:" (0+ (any "\t ")) "\n"
+ (*? (0+ nonl) "\n")
+ (0+ (any "\t ")) ":END:" (0+ (any "\t ")) eol))
+ "Matches an entire LOGBOOK drawer.")
+
(defconst org-property-drawer-re
(concat "^[ \t]*:PROPERTIES:[ \t]*\n"
"\\(?:[ \t]*:\\S-+:\\(?: .*\\)?[ \t]*\n\\)*?"
@@ -561,60 +632,8 @@ An entry can be toggled between COMMENT and normal with
(defconst org-effort-property "Effort"
"The property that is being used to keep track of effort estimates.
-Effort estimates given in this property need to have the format H:MM.")
-
-;;;; Timestamp
-
-(defconst org-ts-regexp "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}[^\r\n>]*\\)>"
- "Regular expression for fast time stamp matching.")
-
-(defconst org-ts-regexp-inactive
- "\\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}[^]\r\n>]*\\)\\]"
- "Regular expression for fast inactive time stamp matching.")
-
-(defconst org-ts-regexp-both "[[<]\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}[^]\r\n>]*\\)[]>]"
- "Regular expression for fast time stamp matching.")
-
-(defconst org-ts-regexp0
- "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\)\\( +[^]+0-9>\r\n -]+\\)?\\( +\\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)"
- "Regular expression matching time strings for analysis.
-This one does not require the space after the date, so it can be used
-on a string that terminates immediately after the date.")
-
-(defconst org-ts-regexp1 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) *\\([^]+0-9>\r\n -]*\\)\\( \\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)"
- "Regular expression matching time strings for analysis.")
-
-(defconst org-ts-regexp2 (concat "<" org-ts-regexp1 "[^>\n]\\{0,16\\}>")
- "Regular expression matching time stamps, with groups.")
-
-(defconst org-ts-regexp3 (concat "[[<]" org-ts-regexp1 "[^]>\n]\\{0,16\\}[]>]")
- "Regular expression matching time stamps (also [..]), with groups.")
-
-(defconst org-tr-regexp (concat org-ts-regexp "--?-?" org-ts-regexp)
- "Regular expression matching a time stamp range.")
-
-(defconst org-tr-regexp-both
- (concat org-ts-regexp-both "--?-?" org-ts-regexp-both)
- "Regular expression matching a time stamp range.")
-
-(defconst org-tsr-regexp (concat org-ts-regexp "\\(--?-?"
- org-ts-regexp "\\)?")
- "Regular expression matching a time stamp or time stamp range.")
-
-(defconst org-tsr-regexp-both
- (concat org-ts-regexp-both "\\(--?-?"
- org-ts-regexp-both "\\)?")
- "Regular expression matching a time stamp or time stamp range.
-The time stamps may be either active or inactive.")
-
-(defconst org-repeat-re
- "<[0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9] [^>\n]*?\
-\\([.+]?\\+[0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)"
- "Regular expression for specifying repeated events.
-After a match, group 1 contains the repeat expression.")
-
-(defconst org-time-stamp-formats '("<%Y-%m-%d %a>" . "<%Y-%m-%d %a %H:%M>")
- "Formats for `format-time-string' which are used for time stamps.")
+Effort estimates given in this property need to be in the format
+defined in org-duration.el.")
;;; The custom variables
@@ -645,6 +664,7 @@ After a match, group 1 contains the repeat expression.")
(defvar org-modules-loaded nil
"Have the modules been loaded already?")
+;;;###autoload
(defun org-load-modules-maybe (&optional force)
"Load all extensions listed in `org-modules'."
(when (or force (not org-modules-loaded))
@@ -853,6 +873,7 @@ cursor keys will then execute Org commands in the following contexts:
- in a plain list item, changing the bullet type
- in a property definition line, switching between allowed values
- in the BEGIN line of a clock table (changing the time block).
+- in a table, moving the cell in the specified direction.
Outside these contexts, the commands will throw an error.
When this variable is t and the cursor is not in a special
@@ -862,9 +883,9 @@ cycling will no longer happen anywhere in an item line, but only
if the cursor is exactly on the bullet.
If you set this variable to the symbol `always', then the keys
-will not be special in headlines, property lines, and item lines,
-to make shift selection work there as well. If this is what you
-want, you can use the following alternative commands:
+will not be special in headlines, property lines, item lines, and
+table cells, to make shift selection work there as well. If this is
+what you want, you can use the following alternative commands:
`\\[org-todo]' and `\\[org-priority]' \
to change TODO state and priority,
`\\[universal-argument] \\[universal-argument] \\[org-todo]' \
@@ -880,7 +901,7 @@ will still edit the time stamp - this is just too good to give up."
(const :tag "When outside special context" t)
(const :tag "Everywhere except timestamps" always)))
-(defcustom org-loop-over-headlines-in-active-region nil
+(defcustom org-loop-over-headlines-in-active-region t
"Shall some commands act upon headlines in the active region?
When set to t, some commands will be performed in all headlines
@@ -898,16 +919,19 @@ The list of commands is: `org-schedule', `org-deadline',
`org-todo', `org-set-tags-command', `org-archive-subtree',
`org-archive-set-tag', `org-toggle-archive-tag' and
`org-archive-to-archive-sibling'. The archiving commands skip
-already archived entries."
+already archived entries.
+
+See `org-agenda-loop-over-headlines-in-active-region' for the
+equivalent option for agenda views."
:type '(choice (const :tag "Don't loop" nil)
(const :tag "All headlines in active region" t)
(const :tag "In active region, headlines at the same level than the first one" start-level)
(string :tag "Tags/Property/Todo matcher"))
- :version "24.1"
+ :package-version '(Org . "9.4")
:group 'org-todo
:group 'org-archive)
-(defcustom org-startup-folded t
+(defcustom org-startup-folded 'showeverything
"Non-nil means entering Org mode will switch to OVERVIEW.
This can also be configured on a per-file basis by adding one of
@@ -922,6 +946,7 @@ Set `org-agenda-inhibit-startup' to a non-nil value if you want
to ignore this option when Org opens agenda files for the first
time."
:group 'org-startup
+ :package-version '(Org . "9.4")
:type '(choice
(const :tag "nofold: show all" nil)
(const :tag "fold: overview" t)
@@ -938,7 +963,7 @@ truncation for Org mode different to the other modes that use the
variable `truncate-lines' and as a shortcut instead of putting
the variable `truncate-lines' into the `org-mode-hook'. If one
wants to configure truncation for Org mode not statically but
-dynamically e. g. in a hook like `ediff-prepare-buffer-hook' then
+dynamically e.g. in a hook like `ediff-prepare-buffer-hook' then
the variable `truncate-lines' has to be used because in such a
case it is too late to set the variable `org-startup-truncated'."
:group 'org-startup
@@ -956,13 +981,24 @@ the following lines anywhere in the buffer:
(const :tag "Not" nil)
(const :tag "Globally (slow on startup in large files)" t)))
+(defcustom org-startup-numerated nil
+ "Non-nil means turn on `org-num-mode' on startup.
+This can also be configured on a per-file basis by adding one of
+the following lines anywhere in the buffer:
+
+ #+STARTUP: num
+ #+STARTUP: nonum"
+ :group 'org-structure
+ :package-version '(Org . "9.4")
+ :type '(choice
+ (const :tag "Not" nil)
+ (const :tag "Globally" t)))
+
(defcustom org-use-sub-superscripts t
"Non-nil means interpret \"_\" and \"^\" for display.
If you want to control how Org exports those characters, see
-`org-export-with-sub-superscripts'. `org-use-sub-superscripts'
-used to be an alias for `org-export-with-sub-superscripts' in
-Org <8.0, it is not anymore.
+`org-export-with-sub-superscripts'.
When this option is turned on, you can use TeX-like syntax for
sub- and superscripts within the buffer. Several characters after
@@ -1059,15 +1095,51 @@ use that string instead.
The change affects only Org mode (which will then use its own display table).
Changing this requires executing `\\[org-mode]' in a buffer to become
-effective."
+effective. It cannot be set as a local variable."
:group 'org-startup
:type '(choice (const :tag "Default" nil)
- (string :tag "String" :value "...#"))
- :safe (lambda (v) (and (string-or-null-p v) (not (equal "" v)))))
+ (string :tag "String" :value "...#")))
(defvar org-display-table nil
"The display table for Org mode, in case `org-ellipsis' is non-nil.")
+(defcustom org-directory "~/org"
+ "Directory with Org files.
+This is just a default location to look for Org files. There is no need
+at all to put your files into this directory. It is used in the
+following situations:
+
+1. When a capture template specifies a target file that is not an
+ absolute path. The path will then be interpreted relative to
+ `org-directory'
+2. When the value of variable `org-agenda-files' is a single file, any
+ relative paths in this file will be taken as relative to
+ `org-directory'."
+ :group 'org-refile
+ :group 'org-capture
+ :type 'directory)
+
+(defcustom org-default-notes-file (convert-standard-filename "~/.notes")
+ "Default target for storing notes.
+Used as a fall back file for org-capture.el, for templates that
+do not specify a target file."
+ :group 'org-refile
+ :group 'org-capture
+ :type 'file)
+
+(defcustom org-reverse-note-order nil
+ "Non-nil means store new notes at the beginning of a file or entry.
+When nil, new notes will be filed to the end of a file or entry.
+This can also be a list with cons cells of regular expressions that
+are matched against file names, and values."
+ :group 'org-capture
+ :group 'org-refile
+ :type '(choice
+ (const :tag "Reverse always" t)
+ (const :tag "Reverse never" nil)
+ (repeat :tag "By file name regexp"
+ (cons regexp boolean))))
+
(defgroup org-keywords nil
"Keywords in Org mode."
:tag "Org Keywords"
@@ -1098,7 +1170,7 @@ effective."
"Alist between context and visibility span when revealing a location.
\\<org-mode-map>Some actions may move point into invisible
-locations. As a consequence, Org always expose a neighborhood
+locations. As a consequence, Org always exposes a neighborhood
around point. How much is shown depends on the initial action,
or context. Valid contexts are
@@ -1220,16 +1292,17 @@ See `org-file-apps'.")
(defcustom org-file-apps
'((auto-mode . emacs)
+ (directory . emacs)
("\\.mm\\'" . default)
("\\.x?html?\\'" . default)
("\\.pdf\\'" . default))
- "External applications for opening `file:path' items in a document.
+ "Applications for opening `file:path' items in a document.
\\<org-mode-map>
-Org mode uses system defaults for different file types, but
-you can use this variable to set the application for a given file
-extension. The entries in this list are cons cells where the car identifies
-files and the cdr the corresponding command.
+Org mode uses system defaults for different file types, but you
+can use this variable to set the application for a given file
+extension. The entries in this list are cons cells where the car
+identifies files and the cdr the corresponding command.
Possible values for the file identifier are:
@@ -1305,6 +1378,7 @@ For more examples, see the system specific constants
`org-file-apps-windowsnt'
`org-file-apps-gnu'."
:group 'org
+ :package-version '(Org . "9.4")
:type '(repeat
(cons (choice :value ""
(string :tag "Extension")
@@ -1467,6 +1541,7 @@ the values `folded', `children', or `subtree'."
:type 'hook)
(defcustom org-cycle-hook '(org-cycle-hide-archived-subtrees
+ org-cycle-hide-drawers
org-cycle-show-empty-lines
org-optimize-window-after-visibility-change)
"Hook that is run after `org-cycle' has changed the buffer visibility.
@@ -1476,9 +1551,8 @@ argument is a symbol. After a global state change, it can have the values
`overview', `contents', or `all'. After a local state change, it can have
the values `folded', `children', or `subtree'."
:group 'org-cycle
- :type 'hook
- :version "26.1"
- :package-version '(Org . "8.3"))
+ :package-version '(Org . "9.4")
+ :type 'hook)
(defgroup org-edit-structure nil
"Options concerning structure editing in Org mode."
@@ -1504,9 +1578,15 @@ lines to the buffer:
(defcustom org-adapt-indentation t
"Non-nil means adapt indentation to outline node level.
-When this variable is set, Org assumes that you write outlines by
-indenting text in each node to align with the headline (after the
-stars). The following issues are influenced by this variable:
+When this variable is set to t, Org assumes that you write
+outlines by indenting text in each node to align with the
+headline (after the stars).
+
+When this variable is set to 'headline-data, only adapt the
+indentation of the data lines right below the headline, such as
+planning/clock lines and property/logbook drawers.
+
+The following issues are influenced by this variable:
- The indentation is increased by one space in a demotion
command, and decreased by one in a promotion command. However,
@@ -1518,14 +1598,18 @@ stars). The following issues are influenced by this variable:
when this variable is set. When nil, they will not be indented.
- TAB indents a line relative to current level. The lines below
- a headline will be indented when this variable is set.
+ a headline will be indented when this variable is set to t.
Note that this is all about true indentation, by adding and
removing space characters. See also \"org-indent.el\" which does
level-dependent indentation in a virtual way, i.e. at display
time in Emacs."
:group 'org-edit-structure
- :type 'boolean
+ :type '(choice
+ (const :tag "Adapt indentation for all lines" t)
+ (const :tag "Adapt indentation for headline data lines"
+ 'headline-data)
+ (const :tag "Do not adapt indentation at all" nil))
:safe #'booleanp)
(defvaralias 'org-special-ctrl-a 'org-special-ctrl-a/e)
@@ -1573,16 +1657,15 @@ This may also be a cons cell where the behavior for `C-a' and
When nil, `C-k' will call the default `kill-line' command.
When t, the following will happen while the cursor is in the headline:
-- When the cursor is at the beginning of a headline, kill the entire
- line and possible the folded subtree below the line.
-- When in the middle of the headline text, kill the headline up to the tags.
-- When after the headline text, kill the tags."
+- When at the beginning of a headline, kill the entire subtree.
+- When in the middle of the headline text, kill the text up to the tags.
+- When after the headline text and before the tags, kill all the tags."
:group 'org-edit-structure
:type 'boolean)
(defcustom org-ctrl-k-protect-subtree nil
- "Non-nil means, do not delete a hidden subtree with C-k.
-When set to the symbol `error', simply throw an error when C-k is
+ "Non-nil means, do not delete a hidden subtree with `C-k'.
+When set to the symbol `error', simply throw an error when `C-k' is
used to kill (part-of) a headline that has hidden text behind it.
Any other non-nil value will result in a query to the user, if it is
OK to kill that hidden subtree. When nil, kill without remorse."
@@ -1787,213 +1870,6 @@ Changing this requires a restart of Emacs to work correctly."
:group 'org-link-follow
:type 'integer)
-(defgroup org-refile nil
- "Options concerning refiling entries in Org mode."
- :tag "Org Refile"
- :group 'org)
-
-(defcustom org-directory "~/org"
- "Directory with Org files.
-This is just a default location to look for Org files. There is no need
-at all to put your files into this directory. It is used in the
-following situations:
-
-1. When a capture template specifies a target file that is not an
- absolute path. The path will then be interpreted relative to
- `org-directory'
-2. When the value of variable `org-agenda-files' is a single file, any
- relative paths in this file will be taken as relative to
- `org-directory'."
- :group 'org-refile
- :group 'org-capture
- :type 'directory)
-
-(defcustom org-default-notes-file (convert-standard-filename "~/.notes")
- "Default target for storing notes.
-Used as a fall back file for org-capture.el, for templates that
-do not specify a target file."
- :group 'org-refile
- :group 'org-capture
- :type 'file)
-
-(defcustom org-reverse-note-order nil
- "Non-nil means store new notes at the beginning of a file or entry.
-When nil, new notes will be filed to the end of a file or entry.
-This can also be a list with cons cells of regular expressions that
-are matched against file names, and values."
- :group 'org-capture
- :group 'org-refile
- :type '(choice
- (const :tag "Reverse always" t)
- (const :tag "Reverse never" nil)
- (repeat :tag "By file name regexp"
- (cons regexp boolean))))
-
-(defcustom org-log-refile nil
- "Information to record when a task is refiled.
-
-Possible values are:
-
-nil Don't add anything
-time Add a time stamp to the task
-note Prompt for a note and add it with template `org-log-note-headings'
-
-This option can also be set with on a per-file-basis with
-
- #+STARTUP: nologrefile
- #+STARTUP: logrefile
- #+STARTUP: lognoterefile
-
-You can have local logging settings for a subtree by setting the LOGGING
-property to one or more of these keywords.
-
-When bulk-refiling, e.g., from the agenda, the value `note' is
-forbidden and will temporarily be changed to `time'."
- :group 'org-refile
- :group 'org-progress
- :version "24.1"
- :type '(choice
- (const :tag "No logging" nil)
- (const :tag "Record timestamp" time)
- (const :tag "Record timestamp with note." note)))
-
-(defcustom org-refile-targets nil
- "Targets for refiling entries with `\\[org-refile]'.
-This is a list of cons cells. Each cell contains:
-- a specification of the files to be considered, either a list of files,
- or a symbol whose function or variable value will be used to retrieve
- a file name or a list of file names. If you use `org-agenda-files' for
- that, all agenda files will be scanned for targets. Nil means consider
- headings in the current buffer.
-- A specification of how to find candidate refile targets. This may be
- any of:
- - a cons cell (:tag . \"TAG\") to identify refile targets by a tag.
- This tag has to be present in all target headlines, inheritance will
- not be considered.
- - a cons cell (:todo . \"KEYWORD\") to identify refile targets by
- todo keyword.
- - a cons cell (:regexp . \"REGEXP\") with a regular expression matching
- headlines that are refiling targets.
- - a cons cell (:level . N). Any headline of level N is considered a target.
- Note that, when `org-odd-levels-only' is set, level corresponds to
- order in hierarchy, not to the number of stars.
- - a cons cell (:maxlevel . N). Any headline with level <= N is a target.
- Note that, when `org-odd-levels-only' is set, level corresponds to
- order in hierarchy, not to the number of stars.
-
-Each element of this list generates a set of possible targets.
-The union of these sets is presented (with completion) to
-the user by `org-refile'.
-
-You can set the variable `org-refile-target-verify-function' to a function
-to verify each headline found by the simple criteria above.
-
-When this variable is nil, all top-level headlines in the current buffer
-are used, equivalent to the value `((nil . (:level . 1))'."
- :group 'org-refile
- :type '(repeat
- (cons
- (choice :value org-agenda-files
- (const :tag "All agenda files" org-agenda-files)
- (const :tag "Current buffer" nil)
- (function) (variable) (file))
- (choice :tag "Identify target headline by"
- (cons :tag "Specific tag" (const :value :tag) (string))
- (cons :tag "TODO keyword" (const :value :todo) (string))
- (cons :tag "Regular expression" (const :value :regexp) (regexp))
- (cons :tag "Level number" (const :value :level) (integer))
- (cons :tag "Max Level number" (const :value :maxlevel) (integer))))))
-
-(defcustom org-refile-target-verify-function nil
- "Function to verify if the headline at point should be a refile target.
-The function will be called without arguments, with point at the
-beginning of the headline. It should return t and leave point
-where it is if the headline is a valid target for refiling.
-
-If the target should not be selected, the function must return nil.
-In addition to this, it may move point to a place from where the search
-should be continued. For example, the function may decide that the entire
-subtree of the current entry should be excluded and move point to the end
-of the subtree."
- :group 'org-refile
- :type '(choice
- (const nil)
- (function)))
-
-(defcustom org-refile-use-cache nil
- "Non-nil means cache refile targets to speed up the process.
-\\<org-mode-map>\
-The cache for a particular file will be updated automatically when
-the buffer has been killed, or when any of the marker used for flagging
-refile targets no longer points at a live buffer.
-If you have added new entries to a buffer that might themselves be targets,
-you need to clear the cache manually by pressing `C-0 \\[org-refile]' or,
-if you find that easier, \
-`\\[universal-argument] \\[universal-argument] \\[universal-argument] \
-\\[org-refile]'."
- :group 'org-refile
- :version "24.1"
- :type 'boolean)
-
-(defcustom org-refile-use-outline-path nil
- "Non-nil means provide refile targets as paths.
-So a level 3 headline will be available as level1/level2/level3.
-
-When the value is `file', also include the file name (without directory)
-into the path. In this case, you can also stop the completion after
-the file name, to get entries inserted as top level in the file.
-
-When `full-file-path', include the full file path.
-
-When `buffer-name', use the buffer name."
- :group 'org-refile
- :type '(choice
- (const :tag "Not" nil)
- (const :tag "Yes" t)
- (const :tag "Start with file name" file)
- (const :tag "Start with full file path" full-file-path)
- (const :tag "Start with buffer name" buffer-name)))
-
-(defcustom org-outline-path-complete-in-steps t
- "Non-nil means complete the outline path in hierarchical steps.
-When Org uses the refile interface to select an outline path (see
-`org-refile-use-outline-path'), the completion of the path can be
-done in a single go, or it can be done in steps down the headline
-hierarchy. Going in steps is probably the best if you do not use
-a special completion package like `ido' or `icicles'. However,
-when using these packages, going in one step can be very fast,
-while still showing the whole path to the entry."
- :group 'org-refile
- :type 'boolean)
-
-(defcustom org-refile-allow-creating-parent-nodes nil
- "Non-nil means allow the creation of new nodes as refile targets.
-New nodes are then created by adding \"/new node name\" to the completion
-of an existing node. When the value of this variable is `confirm',
-new node creation must be confirmed by the user (recommended).
-When nil, the completion must match an existing entry.
-
-Note that, if the new heading is not seen by the criteria
-listed in `org-refile-targets', multiple instances of the same
-heading would be created by trying again to file under the new
-heading."
- :group 'org-refile
- :type '(choice
- (const :tag "Never" nil)
- (const :tag "Always" t)
- (const :tag "Prompt for confirmation" confirm)))
-
-(defcustom org-refile-active-region-within-subtree nil
- "Non-nil means also refile active region within a subtree.
-
-By default `org-refile' doesn't allow refiling regions if they
-don't contain a set of subtrees, but it might be convenient to
-do so sometimes: in that case, the first line of the region is
-converted to a headline before refiling."
- :group 'org-refile
- :version "24.1"
- :type 'boolean)
-
(defgroup org-todo nil
"Options concerning TODO items in Org mode."
:tag "Org TODO"
@@ -2549,53 +2425,69 @@ property to one or more of these keywords."
:tag "Org Priorities"
:group 'org-todo)
-(defcustom org-enable-priority-commands t
+(defvaralias 'org-enable-priority-commands 'org-priority-enable-commands)
+(defcustom org-priority-enable-commands t
"Non-nil means priority commands are active.
When nil, these commands will be disabled, so that you never accidentally
set a priority."
:group 'org-priorities
:type 'boolean)
-(defcustom org-highest-priority ?A
- "The highest priority of TODO items. A character like ?A, ?B etc.
-Must have a smaller ASCII number than `org-lowest-priority'."
- :group 'org-priorities
- :type 'character)
+(defvaralias 'org-highest-priority 'org-priority-highest)
-(defcustom org-lowest-priority ?C
- "The lowest priority of TODO items. A character like ?A, ?B etc.
-Must have a larger ASCII number than `org-highest-priority'."
+(defcustom org-priority-highest ?A
+ "The highest priority of TODO items.
+A character like ?A, ?B, etc., or a numeric value like 1, 2, etc.
+Must be smaller than `org-priority-lowest'."
+ :group 'org-priorities
+ :type '(choice
+ (character :tag "Character")
+ (integer :tag "Integer (< 65)")))
+
+(defvaralias 'org-lowest-priority 'org-priority-lowest)
+(defcustom org-priority-lowest ?C
+ "The lowest priority of TODO items.
+A character like ?A, ?B, etc., or a numeric value like 1, 2, etc.
+Must be higher than `org-priority-highest'."
:group 'org-priorities
- :type 'character)
+ :type '(choice
+ (character :tag "Character")
+ (integer :tag "Integer (< 65)")))
-(defcustom org-default-priority ?B
+(defvaralias 'org-default-priority 'org-priority-default)
+(defcustom org-priority-default ?B
"The default priority of TODO items.
This is the priority an item gets if no explicit priority is given.
When starting to cycle on an empty priority the first step in the cycle
depends on `org-priority-start-cycle-with-default'. The resulting first
-step priority must not exceed the range from `org-highest-priority' to
-`org-lowest-priority' which means that `org-default-priority' has to be
-in this range exclusive or inclusive the range boundaries. Else the
-first step refuses to set the default and the second will fall back
-to (depending on the command used) the highest or lowest priority."
+step priority must not exceed the range from `org-priority-highest' to
+`org-priority-lowest' which means that `org-priority-default' has to be
+in this range exclusive or inclusive to the range boundaries. Else the
+first step refuses to set the default and the second will fall back on
+\(depending on the command used) the highest or lowest priority."
:group 'org-priorities
- :type 'character)
+ :type '(choice
+ (character :tag "Character")
+ (integer :tag "Integer (< 65)")))
(defcustom org-priority-start-cycle-with-default t
"Non-nil means start with default priority when starting to cycle.
When this is nil, the first step in the cycle will be (depending on the
command used) one higher or lower than the default priority.
-See also `org-default-priority'."
+See also `org-priority-default'."
:group 'org-priorities
:type 'boolean)
-(defcustom org-get-priority-function nil
+(defvaralias 'org-get-priority-function 'org-priority-get-priority-function)
+(defcustom org-priority-get-priority-function nil
"Function to extract the priority from a string.
-The string is normally the headline. If this is nil Org computes the
-priority from the priority cookie like [#A] in the headline. It returns
-an integer, increasing by 1000 for each priority level.
-The user can set a different function here, which should take a string
-as an argument and return the numeric priority."
+The string is normally the headline. If this is nil, Org
+computes the priority from the priority cookie like [#A] in the
+headline. It returns an integer, increasing by 1000 for each
+priority level.
+
+The user can set a different function here, which should take a
+string as an argument and return the numeric priority."
:group 'org-priorities
:version "24.1"
:type '(choice
@@ -2768,7 +2660,9 @@ stamps outside of this range."
(defcustom org-read-date-display-live t
"Non-nil means display current interpretation of date prompt live.
-This display will be in an overlay, in the minibuffer."
+This display will be in an overlay, in the minibuffer. Note that
+live display is only active when `org-read-date-popup-calendar'
+is non-nil."
:group 'org-time
:type 'boolean)
@@ -2945,7 +2839,7 @@ automatically if necessary."
When nil, you have to press RET to exit it.
During fast tag selection, you can toggle this flag with `C-c'.
This variable can also have the value `expert'. In this case, the window
-displaying the tags menu is not even shown, until you press C-c again."
+displaying the tags menu is not even shown, until you press `C-c' again."
:group 'org-tags
:type '(choice
(const :tag "No" nil)
@@ -3181,8 +3075,13 @@ This list will be combined with the constant `org-global-properties-fixed'.
The entries in this list are cons cells where the car is a property
name and cdr is a string with the value.
-You can set buffer-local values for the same purpose in the variable
-`org-file-properties' this by adding lines like
+Buffer local properties are added either by a document property drawer
+
+:PROPERTIES:
+:NAME: VALUE
+:END:
+
+or by adding lines like
#+PROPERTY: NAME VALUE"
:group 'org-properties
@@ -3190,10 +3089,15 @@ You can set buffer-local values for the same purpose in the variable
(cons (string :tag "Property")
(string :tag "Value"))))
-(defvar-local org-file-properties nil
- "List of property/value pairs that can be inherited by any entry.
-Valid for the current buffer.
-This variable is populated from #+PROPERTY lines.")
+(defvar-local org-keyword-properties nil
+ "List of property/value pairs inherited by any entry.
+
+Valid for the current buffer. This variable is populated from
+PROPERTY keywords.
+
+Note that properties are defined also in property drawers.
+Properties defined there take precedence over properties defined
+as keywords.")
(defgroup org-agenda nil
"Options concerning agenda views in Org mode."
@@ -3202,11 +3106,18 @@ This variable is populated from #+PROPERTY lines.")
(defvar-local org-category nil
"Variable used by Org files to set a category for agenda display.
-Such files should use a file variable to set it, for example
+There are multiple ways to set the category. One way is to set
+it in the document property drawer. For example:
+
+:PROPERTIES:
+:CATEGORY: ELisp
+:END:
+
+Other ways to define it is as an emacs file variable, for example
# -*- mode: org; org-category: \"ELisp\"
-or contain a special line
+or for the file to contain a special line:
#+CATEGORY: ELisp
@@ -3267,16 +3178,6 @@ A nil value means to remove them, after a query, from the list."
:group 'org-agenda
:type 'boolean)
-(defcustom org-agenda-diary-file 'diary-file
- "File to which to add new entries with the `i' key in agenda and calendar.
-When this is the symbol `diary-file', the functionality in the Emacs
-calendar will be used to add entries to the `diary-file'. But when this
-points to a file, `org-agenda-diary-entry' will be used instead."
- :group 'org-agenda
- :type '(choice
- (const :tag "The standard Emacs diary file" diary-file)
- (file :tag "Special Org file diary entries")))
-
(defgroup org-latex nil
"Options for embedding LaTeX code into Org mode."
:tag "Org LaTeX"
@@ -3350,6 +3251,22 @@ When using LaTeXML set this option to
(const :tag "None" nil)
(string :tag "\nShell command")))
+(defcustom org-latex-to-html-convert-command nil
+ "Command to convert LaTeX fragments to HTML.
+This command is very open-ended: the output of the command will
+directly replace the LaTeX fragment in the resulting HTML.
+Replace format-specifiers in the command as noted below and use
+`shell-command' to convert LaTeX to HTML.
+%i: The LaTeX fragment to be converted.
+
+For example, this could be used with LaTeXML as
+\"latexmlc 'literal:%i' --profile=math --preload=siunitx.sty 2>/dev/null\"."
+ :group 'org-latex
+ :package-version '(Org . "9.4")
+ :type '(choice
+ (const :tag "None" nil)
+ (string :tag "Shell command")))
+
(defcustom org-preview-latex-default-process 'dvipng
"The default process to convert LaTeX fragments to image files.
All available processes and theirs documents can be found in
@@ -3668,12 +3585,23 @@ hide them with `org-toggle-custom-properties-visibility'."
:version "24.3"
:type '(repeat (string :tag "Property Name")))
-(defcustom org-fontify-done-headline nil
+(defcustom org-fontify-todo-headline nil
+ "Non-nil means change the face of a headline if it is marked as TODO.
+Normally, only the TODO/DONE keyword indicates the state of a headline.
+When this is non-nil, the headline after the keyword is set to the
+`org-headline-todo' as an additional indication."
+ :group 'org-appearance
+ :package-version '(Org . "9.4")
+ :type 'boolean
+ :safe t)
+
+(defcustom org-fontify-done-headline t
"Non-nil means change the face of a headline if it is marked DONE.
Normally, only the TODO/DONE keyword indicates the state of a headline.
When this is non-nil, the headline after the keyword is set to the
`org-headline-done' as an additional indication."
:group 'org-appearance
+ :package-version '(Org . "9.4")
:type 'boolean)
(defcustom org-fontify-emphasized-text t
@@ -3775,7 +3703,7 @@ After a match, the match groups contain these elements:
;; This used to be a defcustom (Org <8.0) but allowing the users to
;; set this option proved cumbersome. See this message/thread:
-;; http://article.gmane.org/gmane.emacs.orgmode/68681
+;; https://orgmode.org/list/B72CDC2B-72F6-43A8-AC70-E6E6295766EC@gmail.com
(defvar org-emphasis-regexp-components
'("-[:space:]('\"{" "-[:space:].,:!?;'\")}\\[" "[:space:]" "." 1)
"Components used to build the regular expression for emphasis.
@@ -3921,6 +3849,14 @@ If yes, offer to stop it and to save the buffer with the changes."
(add-hook 'org-mode-hook 'org-clock-load)
(add-hook 'kill-emacs-hook 'org-clock-save))
+(defun org-clock-auto-clockout-insinuate ()
+ "Set up hook for auto clocking out when Emacs is idle.
+See `org-clock-auto-clockout-timer'.
+
+This function is meant to be added to the user configuration."
+ (require 'org-clock)
+ (add-hook 'org-clock-in-hook #'org-clock-auto-clockout t))
+
(defgroup org-archive nil
"Options concerning archiving in Org mode."
:tag "Org Archive"
@@ -3974,14 +3910,13 @@ Here are a few examples:
Archive in file ./basement (relative path), as level 3 trees
below the level 2 heading \"** Finished Tasks\".
-You may set this option on a per-file basis by adding to the buffer a
-line like
+You may define it locally by setting an ARCHIVE property. If
+such a property is found in the file or in an entry, and anywhere
+up the hierarchy, it will be used.
-#+ARCHIVE: basement::** Finished Tasks
+You can also set it for the whole file using the keyword-syntax:
-You may also define it locally for a subtree by setting an ARCHIVE property
-in the entry. If such a property is found in an entry, or anywhere up
-the hierarchy, it will be used."
+#+ARCHIVE: basement::** Finished Tasks"
:group 'org-archive
:type 'string)
@@ -4177,7 +4112,8 @@ groups carry important information:
"Regular expression to match a timestamp time or time range.
After a match, the following groups carry important information:
0 the full match
-1 date plus weekday, for back referencing to make sure both times are on the same day
+1 date plus weekday, for back referencing to make sure
+ both times are on the same day
2 the first time, range or not
4 the second time, if it is a range.")
@@ -4190,6 +4126,8 @@ After a match, the following groups carry important information:
("content" org-startup-folded content)
("indent" org-startup-indented t)
("noindent" org-startup-indented nil)
+ ("num" org-startup-numerated t)
+ ("nonum" org-startup-numerated nil)
("hidestars" org-hide-leading-stars t)
("showstars" org-hide-leading-stars nil)
("odd" org-odd-levels-only t)
@@ -4243,7 +4181,7 @@ After a match, the following groups carry important information:
"Variable associated with STARTUP options for Org.
Each element is a list of three items: the startup options (as written
in the #+STARTUP line), the corresponding variable, and the value to set
-this variable to if the option is found. An optional forth element PUSH
+this variable to if the option is found. An optional fourth element PUSH
means to push this value onto the list in the variable.")
(defcustom org-group-tags t
@@ -4303,72 +4241,112 @@ See `org-tag-alist' for their structure."
;; Preserve order of ALIST1.
(append (nreverse to-add) alist2)))))
+(defun org-priority-to-value (s)
+ "Convert priority string S to its numeric value."
+ (or (save-match-data
+ (and (string-match "\\([0-9]+\\)" s)
+ (string-to-number (match-string 1 s))))
+ (string-to-char s)))
+
(defun org-set-regexps-and-options (&optional tags-only)
"Precompute regular expressions used in the current buffer.
When optional argument TAGS-ONLY is non-nil, only compute tags
related expressions."
(when (derived-mode-p 'org-mode)
- (let ((alist (org--setup-collect-keywords
- (org-make-options-regexp
- (append '("FILETAGS" "TAGS" "SETUPFILE")
- (and (not tags-only)
- '("ARCHIVE" "CATEGORY" "COLUMNS" "CONSTANTS"
- "LINK" "OPTIONS" "PRIORITIES" "PROPERTY"
- "SEQ_TODO" "STARTUP" "TODO" "TYP_TODO")))))))
+ (let ((alist (org-collect-keywords
+ (append '("FILETAGS" "TAGS")
+ (and (not tags-only)
+ '("ARCHIVE" "CATEGORY" "COLUMNS" "CONSTANTS"
+ "LINK" "OPTIONS" "PRIORITIES" "PROPERTY"
+ "SEQ_TODO" "STARTUP" "TODO" "TYP_TODO")))
+ '("ARCHIVE" "CATEGORY" "COLUMNS" "PRIORITIES"))))
;; Startup options. Get this early since it does change
;; behavior for other options (e.g., tags).
- (let ((startup (cdr (assq 'startup alist))))
+ (let ((startup (cl-mapcan (lambda (value) (split-string value))
+ (cdr (assoc "STARTUP" alist)))))
(dolist (option startup)
- (let ((entry (assoc-string option org-startup-options t)))
- (when entry
- (let ((var (nth 1 entry))
- (val (nth 2 entry)))
- (if (not (nth 3 entry)) (set (make-local-variable var) val)
- (unless (listp (symbol-value var))
- (set (make-local-variable var) nil))
- (add-to-list var val)))))))
+ (pcase (assoc-string option org-startup-options t)
+ (`(,_ ,variable ,value t)
+ (unless (listp (symbol-value variable))
+ (set (make-local-variable variable) nil))
+ (add-to-list variable value))
+ (`(,_ ,variable ,value . ,_)
+ (set (make-local-variable variable) value))
+ (_ nil))))
(setq-local org-file-tags
(mapcar #'org-add-prop-inherited
- (cdr (assq 'filetags alist))))
+ (cl-mapcan (lambda (value)
+ (cl-mapcan
+ (lambda (k) (org-split-string k ":"))
+ (split-string value)))
+ (cdr (assoc "FILETAGS" alist)))))
(setq org-current-tag-alist
(org--tag-add-to-alist
org-tag-persistent-alist
- (let ((tags (cdr (assq 'tags alist))))
- (if tags (org-tag-string-to-alist tags)
+ (let ((tags (cdr (assoc "TAGS" alist))))
+ (if tags
+ (org-tag-string-to-alist
+ (mapconcat #'identity tags "\n"))
org-tag-alist))))
(setq org-tag-groups-alist
(org-tag-alist-to-groups org-current-tag-alist))
(unless tags-only
- ;; File properties.
- (setq-local org-file-properties (cdr (assq 'property alist)))
+ ;; Properties.
+ (let ((properties nil))
+ (dolist (value (cdr (assoc "PROPERTY" alist)))
+ (when (string-match "\\(\\S-+\\)[ \t]+\\(.*\\)" value)
+ (setq properties (org--update-property-plist
+ (match-string-no-properties 1 value)
+ (match-string-no-properties 2 value)
+ properties))))
+ (setq-local org-keyword-properties properties))
;; Archive location.
- (let ((archive (cdr (assq 'archive alist))))
+ (let ((archive (cdr (assoc "ARCHIVE" alist))))
(when archive (setq-local org-archive-location archive)))
;; Category.
- (let ((cat (org-string-nw-p (cdr (assq 'category alist)))))
- (when cat
- (setq-local org-category (intern cat))
- (setq-local org-file-properties
+ (let ((category (cdr (assoc "CATEGORY" alist))))
+ (when category
+ (setq-local org-category (intern category))
+ (setq-local org-keyword-properties
(org--update-property-plist
- "CATEGORY" cat org-file-properties))))
+ "CATEGORY" category org-keyword-properties))))
;; Columns.
- (let ((column (cdr (assq 'columns alist))))
+ (let ((column (cdr (assoc "COLUMNS" alist))))
(when column (setq-local org-columns-default-format column)))
;; Constants.
- (setq org-table-formula-constants-local (cdr (assq 'constants alist)))
+ (let ((store nil))
+ (dolist (pair (cl-mapcan #'split-string
+ (cdr (assoc "CONSTANTS" alist))))
+ (when (string-match "^\\([a-zA-Z0][_a-zA-Z0-9]*\\)=\\(.*\\)" pair)
+ (let* ((name (match-string 1 pair))
+ (value (match-string 2 pair))
+ (old (assoc name store)))
+ (if old (setcdr old value)
+ (push (cons name value) store)))))
+ (setq org-table-formula-constants-local store))
;; Link abbreviations.
- (let ((links (cdr (assq 'link alist))))
+ (let ((links
+ (delq nil
+ (mapcar
+ (lambda (value)
+ (and (string-match "\\`\\(\\S-+\\)[ \t]+\\(.+\\)" value)
+ (cons (match-string-no-properties 1 value)
+ (match-string-no-properties 2 value))))
+ (cdr (assoc "LINK" alist))))))
(when links (setq org-link-abbrev-alist-local (nreverse links))))
;; Priorities.
- (let ((priorities (cdr (assq 'priorities alist))))
- (when priorities
- (setq-local org-highest-priority (nth 0 priorities))
- (setq-local org-lowest-priority (nth 1 priorities))
- (setq-local org-default-priority (nth 2 priorities))))
+ (let ((value (cdr (assoc "PRIORITIES" alist))))
+ (pcase (and value (split-string value))
+ (`(,high ,low ,default . ,_)
+ (setq-local org-priority-highest (org-priority-to-value high))
+ (setq-local org-priority-lowest (org-priority-to-value low))
+ (setq-local org-priority-default (org-priority-to-value default)))))
;; Scripts.
- (let ((scripts (assq 'scripts alist)))
- (when scripts
- (setq-local org-use-sub-superscripts (cdr scripts))))
+ (let ((value (cdr (assoc "OPTIONS" alist))))
+ (dolist (option value)
+ (when (string-match "\\^:\\(t\\|nil\\|{}\\)" option)
+ (setq-local org-use-sub-superscripts
+ (read (match-string 1 option))))))
;; TODO keywords.
(setq-local org-todo-kwd-alist nil)
(setq-local org-todo-key-alist nil)
@@ -4379,7 +4357,13 @@ related expressions."
(setq-local org-todo-sets nil)
(setq-local org-todo-log-states nil)
(let ((todo-sequences
- (or (nreverse (cdr (assq 'todo alist)))
+ (or (append (mapcar (lambda (value)
+ (cons 'type (split-string value)))
+ (cdr (assoc "TYP_TODO" alist)))
+ (mapcar (lambda (value)
+ (cons 'sequence (split-string value)))
+ (append (cdr (assoc "TODO" alist))
+ (cdr (assoc "SEQ_TODO" alist)))))
(let ((d (default-value 'org-todo-keywords)))
(if (not (stringp (car d))) d
;; XXX: Backward compatibility code.
@@ -4464,109 +4448,90 @@ related expressions."
"[ \t]*$"))
(org-compute-latex-and-related-regexp)))))
-(defun org--setup-collect-keywords (regexp &optional files alist)
- "Return setup keywords values as an alist.
+(defun org-collect-keywords (keywords &optional unique directory)
+ "Return values for KEYWORDS in current buffer, as an alist.
-REGEXP matches a subset of setup keywords. FILES is a list of
-file names already visited. It is used to avoid circular setup
-files. ALIST, when non-nil, is the alist computed so far.
+KEYWORDS is a list of strings. Return value is a list of
+elements with the pattern:
-Return value contains the following keys: `archive', `category',
-`columns', `constants', `filetags', `link', `priorities',
-`property', `scripts', `startup', `tags' and `todo'."
- (org-with-wide-buffer
- (goto-char (point-min))
- (let ((case-fold-search t))
- (while (re-search-forward regexp nil t)
- (let ((element (org-element-at-point)))
- (when (eq (org-element-type element) 'keyword)
- (let ((key (org-element-property :key element))
- (value (org-element-property :value element)))
- (cond
- ((equal key "ARCHIVE")
- (when (org-string-nw-p value)
- (push (cons 'archive value) alist)))
- ((equal key "CATEGORY") (push (cons 'category value) alist))
- ((equal key "COLUMNS") (push (cons 'columns value) alist))
- ((equal key "CONSTANTS")
- (let* ((constants (assq 'constants alist))
- (store (cdr constants)))
- (dolist (pair (split-string value))
- (when (string-match "^\\([a-zA-Z0][_a-zA-Z0-9]*\\)=\\(.*\\)"
- pair)
- (let* ((name (match-string 1 pair))
- (value (match-string 2 pair))
- (old (assoc name store)))
- (if old (setcdr old value)
- (push (cons name value) store)))))
- (if constants (setcdr constants store)
- (push (cons 'constants store) alist))))
- ((equal key "FILETAGS")
- (when (org-string-nw-p value)
- (let ((old (assq 'filetags alist))
- (new (apply #'nconc
- (mapcar (lambda (x) (org-split-string x ":"))
- (split-string value)))))
- (if old (setcdr old (append new (cdr old)))
- (push (cons 'filetags new) alist)))))
- ((equal key "LINK")
- (when (string-match "\\`\\(\\S-+\\)[ \t]+\\(.+\\)" value)
- (let ((links (assq 'link alist))
- (pair (cons (match-string-no-properties 1 value)
- (match-string-no-properties 2 value))))
- (if links (push pair (cdr links))
- (push (list 'link pair) alist)))))
- ((equal key "OPTIONS")
- (when (and (org-string-nw-p value)
- (string-match "\\^:\\(t\\|nil\\|{}\\)" value))
- (push (cons 'scripts (read (match-string 1 value))) alist)))
- ((equal key "PRIORITIES")
- (push (cons 'priorities
- (let ((prio (split-string value)))
- (if (< (length prio) 3) '(?A ?C ?B)
- (mapcar #'string-to-char prio))))
- alist))
- ((equal key "PROPERTY")
- (when (string-match "\\(\\S-+\\)[ \t]+\\(.*\\)" value)
- (let* ((property (assq 'property alist))
- (value (org--update-property-plist
- (match-string-no-properties 1 value)
- (match-string-no-properties 2 value)
- (cdr property))))
- (if property (setcdr property value)
- (push (cons 'property value) alist)))))
- ((equal key "STARTUP")
- (let ((startup (assq 'startup alist)))
- (if startup
- (setcdr startup
- (append (cdr startup) (split-string value)))
- (push (cons 'startup (split-string value)) alist))))
- ((equal key "TAGS")
- (let ((tag-cell (assq 'tags alist)))
- (if tag-cell
- (setcdr tag-cell (concat (cdr tag-cell) "\n" value))
- (push (cons 'tags value) alist))))
- ((member key '("TODO" "SEQ_TODO" "TYP_TODO"))
- (let ((todo (assq 'todo alist))
- (value (cons (if (equal key "TYP_TODO") 'type 'sequence)
- (split-string value))))
- (if todo (push value (cdr todo))
- (push (list 'todo value) alist))))
- ((equal key "SETUPFILE")
- (unless buffer-read-only ; Do not check in Gnus messages.
- (let ((f (and (org-string-nw-p value)
- (expand-file-name (org-strip-quotes value)))))
- (when (and f (file-readable-p f) (not (member f files)))
- (with-temp-buffer
- (setq default-directory (file-name-directory f))
- (insert-file-contents f)
- (setq alist
- ;; Fake Org mode to benefit from cache
- ;; without recurring needlessly.
+ (NAME . LIST-OF-VALUES)
+
+where NAME is the upcase name of the keyword, and LIST-OF-VALUES
+is a list of non-empty values, as strings, in order of appearance
+in the buffer.
+
+When KEYWORD appears in UNIQUE list, LIST-OF-VALUE is its first
+value, empty or not, appearing in the buffer, as a string.
+
+When KEYWORD appears in DIRECTORIES, each value is a cons cell:
+
+ (VALUE . DIRECTORY)
+
+where VALUE is the regular value, and DIRECTORY is the variable
+`default-directory' for the buffer containing the keyword. This
+is important for values containing relative file names, since the
+function follows SETUPFILE keywords, and may change its working
+directory."
+ (let* ((keywords (cons "SETUPFILE" (mapcar #'upcase keywords)))
+ (unique (mapcar #'upcase unique))
+ (alist (org--collect-keywords-1
+ keywords unique directory
+ (and buffer-file-name (list buffer-file-name))
+ nil)))
+ ;; Re-order results.
+ (dolist (entry alist)
+ (pcase entry
+ (`(,_ . ,(and value (pred consp)))
+ (setcdr entry (nreverse value)))))
+ (nreverse alist)))
+
+(defun org--collect-keywords-1 (keywords unique directory files alist)
+ (org-with-point-at 1
+ (let ((case-fold-search t)
+ (regexp (org-make-options-regexp keywords)))
+ (while (and keywords (re-search-forward regexp nil t))
+ (let ((element (org-element-at-point)))
+ (when (eq 'keyword (org-element-type element))
+ (let ((value (org-element-property :value element)))
+ (pcase (org-element-property :key element)
+ ("SETUPFILE"
+ (when (and (org-string-nw-p value)
+ (not buffer-read-only)) ;FIXME: bug in Gnus?
+ (let* ((uri (org-strip-quotes value))
+ (uri-is-url (org-file-url-p uri))
+ (uri (if uri-is-url
+ uri
+ (expand-file-name uri))))
+ (unless (member uri files)
+ (with-temp-buffer
+ (unless uri-is-url
+ (setq default-directory (file-name-directory uri)))
+ (let ((contents (org-file-contents uri :noerror)))
+ (when contents
+ (insert contents)
+ ;; Fake Org mode: `org-element-at-point'
+ ;; doesn't need full set-up.
(let ((major-mode 'org-mode))
- (org--setup-collect-keywords
- regexp (cons f files) alist)))))))))))))))
- alist)
+ (setq alist
+ (org--collect-keywords-1
+ keywords unique directory
+ (cons uri files)
+ alist))))))))))
+ (keyword
+ (let ((entry (assoc keyword alist))
+ (final
+ (cond ((not (member keyword directory)) value)
+ (buffer-file-name
+ (cons value
+ (file-name-directory buffer-file-name)))
+ (t (cons value default-directory)))))
+ (cond ((member keyword unique)
+ (push (cons keyword final) alist)
+ (setq keywords (remove keyword keywords))
+ (setq regexp (org-make-options-regexp keywords)))
+ ((null entry) (push (list keyword final) alist))
+ (t (push final (cdr entry)))))))))))
+ alist)))
(defun org-tag-string-to-alist (s)
"Return tag alist associated to string S.
@@ -4678,7 +4643,7 @@ already cached in the `org--file-cache' hash table, the download step
is skipped.
If NOERROR is non-nil, ignore the error when unable to read the FILE
-from file or URL.
+from file or URL, and return nil.
If NOCACHE is non-nil, do a fresh fetch of FILE even if cached version
is available. This option applies only if FILE is a URL."
@@ -4702,7 +4667,8 @@ is available. This option applies only if FILE is a URL."
org--file-cache)
(funcall (if noerror #'message #'user-error)
"Unable to fetch file from %S"
- file))))
+ file)
+ nil)))
(t
(with-temp-buffer
(condition-case nil
@@ -4712,7 +4678,8 @@ is available. This option applies only if FILE is a URL."
(file-error
(funcall (if noerror #'message #'user-error)
"Unable to read file %S"
- file))))))))
+ file)
+ nil)))))))
(defun org-extract-log-state-settings (x)
"Extract the log state setting from a TODO keyword string.
@@ -4791,12 +4758,9 @@ This is for getting out of special buffers like capture.")
(require 'time-date)
(unless (fboundp 'time-subtract) (defalias 'time-subtract 'subtract-time))
(require 'easymenu)
-(autoload 'easy-menu-add "easymenu")
(require 'overlay)
-;; (require 'org-macs) moved higher up in the file before it is first used
(require 'org-entities)
-;; (require 'org-compat) moved higher up in the file before it is first used
(require 'org-faces)
(require 'org-list)
(require 'org-pcomplete)
@@ -4830,7 +4794,6 @@ The following commands are available:
(org-install-agenda-files-menu)
(when org-link-descriptive (add-to-invisibility-spec '(org-link)))
(add-to-invisibility-spec '(org-hide-block . t))
- (add-to-invisibility-spec '(org-hide-drawer . t))
(setq-local outline-regexp org-outline-regexp)
(setq-local outline-level 'org-outline-level)
(setq bidi-paragraph-direction 'left-to-right)
@@ -4906,10 +4869,6 @@ The following commands are available:
(regexp . "^[ \t]*#\\+[A-Z_]+:\\(\\s-*\\)\\S-+")
(modes . '(org-mode)))))
- ;; Make isearch reveal context
- (setq-local outline-isearch-open-invisible-function
- (lambda (&rest _) (org-show-context 'isearch)))
-
;; Setup the pcomplete hooks
(setq-local pcomplete-command-completion-function #'org-pcomplete-initial)
(setq-local pcomplete-command-name-function #'org-command-at-point)
@@ -4941,11 +4900,20 @@ The following commands are available:
(when org-startup-with-latex-preview (org-latex-preview '(16)))
(unless org-inhibit-startup-visibility-stuff (org-set-startup-visibility))
(when org-startup-truncated (setq truncate-lines t))
+ (when org-startup-numerated (require 'org-num) (org-num-mode 1))
(when org-startup-indented (require 'org-indent) (org-indent-mode 1))))
+
+ ;; Activate `org-table-header-line-mode'
+ (when org-table-header-line-p
+ (org-table-header-line-mode 1))
;; Try to set `org-hide' face correctly.
(let ((foreground (org-find-invisible-foreground)))
(when foreground
- (set-face-foreground 'org-hide foreground))))
+ (set-face-foreground 'org-hide foreground)))
+ ;; Set face extension as requested.
+ (org--set-faces-extend '(org-block-begin-line org-block-end-line)
+ org-fontify-whole-block-delimiter-line)
+ (org--set-faces-extend org-level-faces org-fontify-whole-heading-line))
;; Update `customize-package-emacs-version-alist'
(add-to-list 'customize-package-emacs-version-alist
@@ -4956,7 +4924,9 @@ The following commands are available:
("8.3" . "26.1")
("9.0" . "26.1")
("9.1" . "26.1")
- ("9.2" . "27.1")))
+ ("9.2" . "27.1")
+ ("9.3" . "27.1")
+ ("9.4" . "27.2")))
(defvar org-mode-transpose-word-syntax-table
(let ((st (make-syntax-table text-mode-syntax-table)))
@@ -5005,8 +4975,6 @@ the rounding returns a past time."
;;;; Font-Lock stuff, including the activators
-(require 'font-lock)
-
(defconst org-match-sexp-depth 3
"Number of stacked braces for sub/superscript matching.")
@@ -5077,9 +5045,10 @@ stacked delimiters is N. Escaping delimiters is not possible."
;; Do not span over cells in table rows.
(not (and (save-match-data (org-match-line "[ \t]*|"))
(string-match-p "|" (match-string 4))))))
- (pcase-let ((`(,_ ,face ,_) (assoc marker org-emphasis-alist)))
+ (pcase-let ((`(,_ ,face ,_) (assoc marker org-emphasis-alist))
+ (m (if org-hide-emphasis-markers 4 2)))
(font-lock-prepend-text-property
- (match-beginning 2) (match-end 2) 'face face)
+ (match-beginning m) (match-end m) 'face face)
(when verbatim?
(org-remove-flyspell-overlays-in
(match-beginning 0) (match-end 0))
@@ -5087,7 +5056,8 @@ stacked delimiters is N. Escaping delimiters is not possible."
'(display t invisible t intangible t)))
(add-text-properties (match-beginning 2) (match-end 2)
'(font-lock-multiline t org-emphasis t))
- (when org-hide-emphasis-markers
+ (when (and org-hide-emphasis-markers
+ (not (org-at-comment-p)))
(add-text-properties (match-end 4) (match-beginning 5)
'(invisible org-link))
(add-text-properties (match-beginning 3) (match-end 3)
@@ -5250,13 +5220,23 @@ by a #."
"Fontify #+ lines and blocks."
(let ((case-fold-search t))
(when (re-search-forward
- "^\\([ \t]*#\\(\\(\\+[a-zA-Z]+:?\\| \\|$\\)\\(_\\([a-zA-Z]+\\)\\)?\\)[ \t]*\\(\\([^ \t\n]*\\)[ \t]*\\(.*\\)\\)\\)"
+ (rx bol (group (zero-or-more (any " \t")) "#"
+ (group (group (or (seq "+" (one-or-more (any "a-zA-Z")) (optional ":"))
+ (any " \t")
+ eol))
+ (optional (group "_" (group (one-or-more (any "a-zA-Z"))))))
+ (zero-or-more (any " \t"))
+ (group (group (zero-or-more (not (any " \t\n"))))
+ (zero-or-more (any " \t"))
+ (group (zero-or-more any)))))
limit t)
(let ((beg (match-beginning 0))
(end-of-beginline (match-end 0))
- (block-start (match-end 0)) ; includes the \n at end of #+begin line
- (block-end nil) ; will include \n after end of block content
- (lang (match-string 7)) ; the language, if it is an src block
+ ;; Including \n at end of #+begin line will include \n
+ ;; after the end of block content.
+ (block-start (match-end 0))
+ (block-end nil)
+ (lang (match-string 7)) ; The language, if it is a source block.
(bol-after-beginline (line-beginning-position 2))
(dc1 (downcase (match-string 2)))
(dc3 (downcase (match-string 3)))
@@ -5266,15 +5246,22 @@ by a #."
((and (match-end 4) (equal dc3 "+begin"))
;; Truly a block
(setq block-type (downcase (match-string 5))
- quoting (member block-type org-protecting-blocks)) ; src, example, export, maybe more
+ ;; Src, example, export, maybe more.
+ quoting (member block-type org-protecting-blocks))
(when (re-search-forward
- (concat "^[ \t]*#\\+end" (match-string 4) "\\>.*")
- nil t) ;; on purpose, we look further than LIMIT
- ;; We do have a matching #+end line
+ (rx-to-string `(group bol (or (seq (one-or-more "*") space)
+ (seq (zero-or-more (any " \t"))
+ "#+end"
+ ,(match-string 4)
+ word-end
+ (zero-or-more any)))))
+ ;; We look further than LIMIT on purpose.
+ nil t)
+ ;; We do have a matching #+end line.
(setq beg-of-endline (match-beginning 0)
end-of-endline (match-end 0)
nl-before-endline (1- (match-beginning 0)))
- (setq block-end (match-beginning 0)) ; includes the final newline.
+ (setq block-end (match-beginning 0)) ; Include the final newline.
(when quoting
(org-remove-flyspell-overlays-in bol-after-beginline nl-before-endline)
(remove-text-properties beg end-of-endline
@@ -5307,10 +5294,14 @@ by a #."
(add-text-properties
beg (if whole-blockline bol-after-beginline end-of-beginline)
'(face org-block-begin-line))
- (add-text-properties
- beg-of-endline
- (min (point-max) (if whole-blockline (min (point-max) (1+ end-of-endline)) end-of-endline))
- '(face org-block-end-line))
+ (unless (eq (char-after beg-of-endline) ?*)
+ (add-text-properties
+ beg-of-endline
+ (if whole-blockline
+ (let ((beg-of-next-line (1+ end-of-endline)))
+ (min (point-max) beg-of-next-line))
+ (min (point-max) end-of-endline))
+ '(face org-block-end-line)))
t))
((member dc1 '("+title:" "+author:" "+email:" "+date:"))
(org-remove-flyspell-overlays-in
@@ -5330,22 +5321,26 @@ by a #."
(org-remove-flyspell-overlays-in (match-end 2) (match-end 0))
(remove-text-properties (match-beginning 0) (match-end 0)
'(display t invisible t intangible t))
- ;; Handle short captions.
+ ;; Handle short captions
(save-excursion
(beginning-of-line)
- (looking-at "\\([ \t]*#\\+caption\\(?:\\[.*\\]\\)?:\\)[ \t]*"))
+ (looking-at (rx (group (zero-or-more (any " \t"))
+ "#+caption"
+ (optional "[" (zero-or-more any) "]")
+ ":")
+ (zero-or-more (any " \t")))))
(add-text-properties (line-beginning-position) (match-end 1)
'(font-lock-fontified t face org-meta-line))
(add-text-properties (match-end 0) (line-end-position)
'(font-lock-fontified t face org-block))
t)
((member dc3 '(" " ""))
- ; Just a comment, the plus was not there
+ ;; Just a comment, the plus was not there
(org-remove-flyspell-overlays-in beg (match-end 0))
(add-text-properties
beg (match-end 0)
'(font-lock-fontified t face font-lock-comment-face)))
- (t ;; just any other in-buffer setting, but not indented
+ (t ;; Just any other in-buffer setting, but not indented
(org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
(remove-text-properties (match-beginning 0) (match-end 0)
'(display t invisible t intangible t))
@@ -5356,9 +5351,8 @@ by a #."
(defun org-fontify-drawers (limit)
"Fontify drawers."
(when (re-search-forward org-drawer-regexp limit t)
- (add-text-properties
- (line-beginning-position) (line-beginning-position 2)
- '(font-lock-fontified t face org-drawer))
+ (add-text-properties (1- (match-beginning 1)) (1+ (match-end 1))
+ '(font-lock-fontified t face org-drawer))
(org-remove-flyspell-overlays-in
(line-beginning-position) (line-beginning-position 2))
t))
@@ -5386,8 +5380,8 @@ by a #."
(end-re "\\(\\\\\\]\\|\\(#\\+end_\\|\\\\end{\\)\\S-+\\)")
(extend (lambda (r1 r2 dir)
(let ((re (replace-regexp-in-string "\\(begin\\|end\\)" r1
- (replace-regexp-in-string "[][]" r2
- (match-string-no-properties 0)))))
+ (replace-regexp-in-string "[][]" r2
+ (match-string-no-properties 0)))))
(re-search-forward (regexp-quote re) nil t dir)))))
(save-match-data
(save-excursion
@@ -5483,33 +5477,46 @@ Result depends on variable `org-highlight-latex-and-related'."
(append re-latex re-entities re-sub)
"\\|"))))
-(defun org-do-latex-and-related (_limit)
+(defun org-do-latex-and-related (limit)
"Highlight LaTeX snippets and environments, entities and sub/superscript.
Stop at first highlighted object, if any. Return t if some
highlighting was done, nil otherwise."
(when (org-string-nw-p org-latex-and-related-regexp)
- (catch 'found
- (while (re-search-forward org-latex-and-related-regexp
- nil t) ;; on purpose, we ignore LIMIT
- (unless (cl-some (lambda (f) (memq f '(org-code org-verbatim underline
- org-special-keyword)))
- (save-excursion
- (goto-char (1+ (match-beginning 0)))
- (face-at-point nil t)))
- (let* ((offset (if (memq (char-after (1+ (match-beginning 0)))
- '(?_ ?^))
- 1
- 0))
- (start (+ offset (match-beginning 0)))
- (end (match-end 0)))
- (if (memq 'native org-highlight-latex-and-related)
- (org-src-font-lock-fontify-block "latex" start end)
- (font-lock-prepend-text-property start end
- 'face 'org-latex-and-related))
- (add-text-properties (+ offset (match-beginning 0)) (match-end 0)
- '(font-lock-multiline t)))
- (throw 'found t)))
- nil)))
+ (let ((latex-prefix-re (rx (or "$" "\\(" "\\[")))
+ (blank-line-re (rx (and "\n" (zero-or-more (or " " "\t")) "\n"))))
+ (catch 'found
+ (while (and (< (point) limit)
+ (re-search-forward org-latex-and-related-regexp nil t))
+ (cond
+ ((cl-some (lambda (f)
+ (memq f '(org-code org-verbatim underline
+ org-special-keyword)))
+ (save-excursion
+ (goto-char (1+ (match-beginning 0)))
+ (face-at-point nil t))))
+ ;; Try to limit false positives. In this case, ignore
+ ;; $$...$$, \(...\), and \[...\] LaTeX constructs if they
+ ;; contain an empty line.
+ ((save-excursion
+ (goto-char (match-beginning 0))
+ (and (looking-at-p latex-prefix-re)
+ (save-match-data
+ (re-search-forward blank-line-re (1- (match-end 0)) t)))))
+ (t
+ (let* ((offset (if (memq (char-after (1+ (match-beginning 0)))
+ '(?_ ?^))
+ 1
+ 0))
+ (start (+ offset (match-beginning 0)))
+ (end (match-end 0)))
+ (if (memq 'native org-highlight-latex-and-related)
+ (org-src-font-lock-fontify-block "latex" start end)
+ (font-lock-prepend-text-property start end
+ 'face 'org-latex-and-related))
+ (add-text-properties (+ offset (match-beginning 0)) (match-end 0)
+ '(font-lock-multiline t))
+ (throw 'found t)))))
+ nil))))
(defun org-restart-font-lock ()
"Restart `font-lock-mode', to force refontification."
@@ -5637,15 +5644,22 @@ needs to be inserted at a specific position in the font-lock sequence.")
(list (format org-heading-keyword-regexp-format
org-todo-regexp)
'(2 (org-get-todo-face 2) t))
+ ;; TODO
+ (when org-fontify-todo-headline
+ (list (format org-heading-keyword-regexp-format
+ (concat
+ "\\(?:"
+ (mapconcat 'regexp-quote org-not-done-keywords "\\|")
+ "\\)"))
+ '(2 'org-headline-todo t)))
;; DONE
- (if org-fontify-done-headline
- (list (format org-heading-keyword-regexp-format
- (concat
- "\\(?:"
- (mapconcat 'regexp-quote org-done-keywords "\\|")
- "\\)"))
- '(2 'org-headline-done t))
- nil)
+ (when org-fontify-done-headline
+ (list (format org-heading-keyword-regexp-format
+ (concat
+ "\\(?:"
+ (mapconcat 'regexp-quote org-done-keywords "\\|")
+ "\\)"))
+ '(2 'org-headline-done t)))
;; Priorities
'(org-font-lock-add-priority-faces)
;; Tags
@@ -5779,20 +5793,17 @@ needs to be inserted at a specific position in the font-lock sequence.")
(org-font-lock-ensure)
(buffer-string))))
-(defvar org-m nil)
-(defvar org-l nil)
-(defvar org-f nil)
(defun org-get-level-face (n)
"Get the right face for match N in font-lock matching of headlines."
- (setq org-l (- (match-end 2) (match-beginning 1) 1))
- (when org-odd-levels-only (setq org-l (1+ (/ org-l 2))))
- (if org-cycle-level-faces
- (setq org-f (nth (% (1- org-l) org-n-level-faces) org-level-faces))
- (setq org-f (nth (1- (min org-l org-n-level-faces)) org-level-faces)))
- (cond
- ((eq n 1) (if org-hide-leading-stars 'org-hide org-f))
- ((eq n 2) org-f)
- (t (unless org-level-color-stars-only org-f))))
+ (let* ((org-l0 (- (match-end 2) (match-beginning 1) 1))
+ (org-l (if org-odd-levels-only (1+ (/ org-l0 2)) org-l0))
+ (org-f (if org-cycle-level-faces
+ (nth (% (1- org-l) org-n-level-faces) org-level-faces)
+ (nth (1- (min org-l org-n-level-faces)) org-level-faces))))
+ (cond
+ ((eq n 1) (if org-hide-leading-stars 'org-hide org-f))
+ ((eq n 2) org-f)
+ (t (unless org-level-color-stars-only org-f)))))
(defun org-face-from-face-or-color (context inherit face-or-color)
"Create a face list that inherits INHERIT, but sets the foreground color.
@@ -5827,11 +5838,13 @@ If TAG is a number, get the corresponding match group."
'tag 'org-tag (cdr (assoc tag org-tag-faces)))
'org-tag)))
+(defvar org-priority-regexp) ; defined later in the file
+
(defun org-font-lock-add-priority-faces (limit)
"Add the special priority faces."
- (while (re-search-forward "^\\*+ .*?\\(\\[#\\(.\\)\\]\\)" limit t)
+ (while (re-search-forward org-priority-regexp limit t)
(add-text-properties
- (match-beginning 1) (match-end 1)
+ (match-beginning 1) (1+ (match-end 2))
(list 'face (org-get-priority-face (string-to-char (match-string 2)))
'font-lock-fontified t))))
@@ -5915,7 +5928,7 @@ and subscripts."
"Remove outline overlays that do not contain non-white stuff."
(dolist (o (overlays-at pos))
(and (eq 'outline (overlay-get o 'invisible))
- (not (string-match "\\S-" (buffer-substring (overlay-start o)
+ (not (string-match-p "\\S-" (buffer-substring (overlay-start o)
(overlay-end o))))
(delete-overlay o))))
@@ -5964,21 +5977,37 @@ open and agenda-wise Org files."
;;;; Headlines visibility
(defun org-show-entry ()
- "Show the body directly following this heading.
+ "Show the body directly following its heading.
Show the heading too, if it is currently invisible."
(interactive)
(save-excursion
- (ignore-errors
- (org-back-to-heading t)
- (org-flag-region
- (line-end-position 0)
- (save-excursion
- (if (re-search-forward
- (concat "[\r\n]\\(" org-outline-regexp "\\)") nil t)
- (match-beginning 1)
- (point-max)))
- nil
- 'outline))))
+ (org-back-to-heading-or-point-min t)
+ (org-flag-region
+ (line-end-position 0)
+ (save-excursion
+ (if (re-search-forward
+ (concat "[\r\n]\\(" org-outline-regexp "\\)") nil t)
+ (match-beginning 1)
+ (point-max)))
+ nil
+ 'outline)
+ (org-cycle-hide-drawers 'children)))
+
+(defun org-hide-entry ()
+ "Hide the body directly following its heading."
+ (interactive)
+ (save-excursion
+ (org-back-to-heading-or-point-min t)
+ (when (org-at-heading-p) (forward-line))
+ (org-flag-region
+ (line-end-position 0)
+ (save-excursion
+ (if (re-search-forward
+ (concat "[\r\n]" org-outline-regexp) nil t)
+ (line-end-position 0)
+ (point-max)))
+ t
+ 'outline)))
(defun org-show-children (&optional level)
"Show all direct subheadings of this heading.
@@ -5986,36 +6015,37 @@ Prefix arg LEVEL is how many levels below the current level
should be shown. Default is enough to cause the following
heading to appear."
(interactive "p")
- (save-excursion
- (org-back-to-heading t)
- (let* ((current-level (funcall outline-level))
- (max-level (org-get-valid-level
- current-level
- (if level (prefix-numeric-value level) 1)))
- (end (save-excursion (org-end-of-subtree t t)))
- (regexp-fmt "^\\*\\{%d,%s\\}\\(?: \\|$\\)")
- (past-first-child nil)
- ;; Make sure to skip inlinetasks.
- (re (format regexp-fmt
- current-level
- (cond
- ((not (featurep 'org-inlinetask)) "")
- (org-odd-levels-only (- (* 2 org-inlinetask-min-level)
- 3))
- (t (1- org-inlinetask-min-level))))))
- ;; Display parent heading.
- (org-flag-heading nil)
- (forward-line)
- ;; Display children. First child may be deeper than expected
- ;; MAX-LEVEL. Since we want to display it anyway, adjust
- ;; MAX-LEVEL accordingly.
- (while (re-search-forward re end t)
- (unless past-first-child
- (setq re (format regexp-fmt
- current-level
- (max (funcall outline-level) max-level)))
- (setq past-first-child t))
- (org-flag-heading nil)))))
+ (unless (org-before-first-heading-p)
+ (save-excursion
+ (org-with-limited-levels (org-back-to-heading t))
+ (let* ((current-level (funcall outline-level))
+ (max-level (org-get-valid-level
+ current-level
+ (if level (prefix-numeric-value level) 1)))
+ (end (save-excursion (org-end-of-subtree t t)))
+ (regexp-fmt "^\\*\\{%d,%s\\}\\(?: \\|$\\)")
+ (past-first-child nil)
+ ;; Make sure to skip inlinetasks.
+ (re (format regexp-fmt
+ current-level
+ (cond
+ ((not (featurep 'org-inlinetask)) "")
+ (org-odd-levels-only (- (* 2 org-inlinetask-min-level)
+ 3))
+ (t (1- org-inlinetask-min-level))))))
+ ;; Display parent heading.
+ (org-flag-heading nil)
+ (forward-line)
+ ;; Display children. First child may be deeper than expected
+ ;; MAX-LEVEL. Since we want to display it anyway, adjust
+ ;; MAX-LEVEL accordingly.
+ (while (re-search-forward re end t)
+ (unless past-first-child
+ (setq re (format regexp-fmt
+ current-level
+ (max (funcall outline-level) max-level)))
+ (setq past-first-child t))
+ (org-flag-heading nil))))))
(defun org-show-subtree ()
"Show everything after this heading at deeper levels."
@@ -6023,117 +6053,135 @@ heading to appear."
(org-flag-region
(point) (save-excursion (org-end-of-subtree t t)) nil 'outline))
-;;;; Blocks visibility
+;;;; Blocks and drawers visibility
-(defun org-hide-block-toggle-maybe ()
- "Toggle visibility of block at point.
-Unlike to `org-hide-block-toggle', this function does not throw
-an error. Return a non-nil value when toggling is successful."
- (interactive)
- (ignore-errors (org-hide-block-toggle)))
+(defun org--hide-wrapper-toggle (element category force no-error)
+ "Toggle visibility for ELEMENT.
+
+ELEMENT is a block or drawer type parsed element. CATEGORY is
+either `block' or `drawer'. When FORCE is `off', show the block
+or drawer. If it is non-nil, hide it unconditionally. Throw an
+error when not at a block or drawer, unless NO-ERROR is non-nil.
+
+Return a non-nil value when toggling is successful."
+ (let ((type (org-element-type element)))
+ (cond
+ ((memq type
+ (pcase category
+ (`drawer '(drawer property-drawer))
+ (`block '(center-block
+ comment-block dynamic-block example-block export-block
+ quote-block special-block src-block verse-block))
+ (_ (error "Unknown category: %S" category))))
+ (let* ((post (org-element-property :post-affiliated element))
+ (start (save-excursion
+ (goto-char post)
+ (line-end-position)))
+ (end (save-excursion
+ (goto-char (org-element-property :end element))
+ (skip-chars-backward " \t\n")
+ (line-end-position))))
+ ;; Do nothing when not before or at the block opening line or
+ ;; at the block closing line.
+ (unless (let ((eol (line-end-position)))
+ (and (> eol start) (/= eol end)))
+ (let* ((spec (if (eq category 'block) 'org-hide-block 'outline))
+ (flag
+ (cond ((eq force 'off) nil)
+ (force t)
+ ((eq spec (get-char-property start 'invisible)) nil)
+ (t t))))
+ (org-flag-region start end flag spec))
+ ;; When the block is hidden away, make sure point is left in
+ ;; a visible part of the buffer.
+ (when (invisible-p (max (1- (point)) (point-min)))
+ (goto-char post))
+ ;; Signal success.
+ t)))
+ (no-error nil)
+ (t
+ (user-error (if (eq category 'drawer)
+ "Not at a drawer"
+ "Not at a block"))))))
-(defun org-hide-block-toggle (&optional force)
+(defun org-hide-block-toggle (&optional force no-error element)
"Toggle the visibility of the current block.
+
When optional argument FORCE is `off', make block visible. If it
is non-nil, hide it unconditionally. Throw an error when not at
-a block. Return a non-nil value when toggling is successful."
+a block, unless NO-ERROR is non-nil. When optional argument
+ELEMENT is provided, consider it instead of the current block.
+
+Return a non-nil value when toggling is successful."
(interactive)
- (let ((element (org-element-at-point)))
- (unless (memq (org-element-type element)
- '(center-block comment-block dynamic-block example-block
- export-block quote-block special-block
- src-block verse-block))
- (user-error "Not at a block"))
- (let* ((post (org-element-property :post-affiliated element))
- (start (save-excursion
- (goto-char post)
- (line-end-position)))
- (end (save-excursion
- (goto-char (org-element-property :end element))
- (skip-chars-backward " \t\n")
- (line-end-position))))
- ;; Do nothing when not before or at the block opening line or at
- ;; the block closing line.
- (unless (let ((eol (line-end-position))) (and (> eol start) (/= eol end)))
- (cond ((eq force 'off)
- (org-flag-region start end nil 'org-hide-block))
- (force
- (org-flag-region start end t 'org-hide-block))
- ((eq (get-char-property start 'invisible) 'org-hide-block)
- (org-flag-region start end nil 'org-hide-block))
- (t
- (org-flag-region start end t 'org-hide-block)))
- ;; When the block is hidden away, make sure point is left in
- ;; a visible part of the buffer.
- (when (invisible-p (max (1- (point)) (point-min)))
- (goto-char post))
- ;; Signal success.
- t))))
+ (org--hide-wrapper-toggle
+ (or element (org-element-at-point)) 'block force no-error))
-(defun org-hide-block-toggle-all ()
- "Toggle the visibility of all blocks in the current buffer."
- (org-block-map 'org-hide-block-toggle))
+(defun org-hide-drawer-toggle (&optional force no-error element)
+ "Toggle the visibility of the current drawer.
+
+When optional argument FORCE is `off', make drawer visible. If
+it is non-nil, hide it unconditionally. Throw an error when not
+at a drawer, unless NO-ERROR is non-nil. When optional argument
+ELEMENT is provided, consider it instead of the current drawer.
+
+Return a non-nil value when toggling is successful."
+ (interactive)
+ (org--hide-wrapper-toggle
+ (or element (org-element-at-point)) 'drawer force no-error))
(defun org-hide-block-all ()
"Fold all blocks in the current buffer."
(interactive)
(org-show-all '(blocks))
- (org-block-map 'org-hide-block-toggle-maybe))
-
-;;;; Drawers visibility
+ (org-block-map 'org-hide-block-toggle))
-(defun org-cycle-hide-drawers (state &optional exceptions)
+(defun org-hide-drawer-all ()
+ "Fold all drawers in the current buffer."
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward org-drawer-regexp nil t)
+ (let* ((pair (get-char-property-and-overlay (line-beginning-position)
+ 'invisible))
+ (o (cdr-safe pair)))
+ (if (overlayp o) (goto-char (overlay-end o)) ;invisible drawer
+ (pcase (get-char-property-and-overlay (point) 'invisible)
+ (`(outline . ,o) (goto-char (overlay-end o))) ;already folded
+ (_
+ (let* ((drawer (org-element-at-point))
+ (type (org-element-type drawer)))
+ (when (memq type '(drawer property-drawer))
+ (org-hide-drawer-toggle t nil drawer)
+ ;; Make sure to skip drawer entirely or we might flag it
+ ;; another time when matching its ending line with
+ ;; `org-drawer-regexp'.
+ (goto-char (org-element-property :end drawer)))))))))))
+
+(defun org-cycle-hide-drawers (state)
"Re-hide all drawers after a visibility state change.
STATE should be one of the symbols listed in the docstring of
-`org-cycle-hook'. When non-nil, optional argument EXCEPTIONS is
-a list of strings specifying which drawers should not be hidden."
+`org-cycle-hook'."
(when (and (derived-mode-p 'org-mode)
(not (memq state '(overview folded contents))))
- (save-excursion
- (let* ((globalp (eq state 'all))
- (beg (if globalp (point-min) (point)))
- (end (if globalp (point-max)
- (if (eq state 'children)
- (save-excursion (outline-next-heading) (point))
- (org-end-of-subtree t)))))
+ (let* ((global? (eq state 'all))
+ (beg (if global? (point-min) (line-beginning-position)))
+ (end (cond (global? (point-max))
+ ((eq state 'children) (org-entry-end-position))
+ (t (save-excursion (org-end-of-subtree t t))))))
+ (save-excursion
(goto-char beg)
- (while (re-search-forward org-drawer-regexp (max end (point)) t)
- (unless (member-ignore-case (match-string 1) exceptions)
- (let ((drawer (org-element-at-point)))
- (when (memq (org-element-type drawer) '(drawer property-drawer))
- (org-flag-drawer t drawer)
- ;; Make sure to skip drawer entirely or we might flag
- ;; it another time when matching its ending line with
- ;; `org-drawer-regexp'.
- (goto-char (org-element-property :end drawer))))))))))
-
-(defun org-flag-drawer (flag &optional element beg end)
- "When FLAG is non-nil, hide the drawer we are at.
-Otherwise make it visible.
-
-When optional argument ELEMENT is a parsed drawer, as returned by
-`org-element-at-point', hide or show that drawer instead.
-
-When buffer positions BEG and END are provided, hide or show that
-region as a drawer without further ado."
- (if (and beg end) (org-flag-region beg end flag 'org-hide-drawer)
- (let ((drawer (or element
- (and (save-excursion
- (beginning-of-line)
- (looking-at-p org-drawer-regexp))
- (org-element-at-point)))))
- (when (memq (org-element-type drawer) '(drawer property-drawer))
- (let ((post (org-element-property :post-affiliated drawer)))
- (org-flag-region
- (save-excursion (goto-char post) (line-end-position))
- (save-excursion (goto-char (org-element-property :end drawer))
- (skip-chars-backward " \t\n")
- (line-end-position))
- flag 'org-hide-drawer)
- ;; When the drawer is hidden away, make sure point lies in
- ;; a visible part of the buffer.
- (when (invisible-p (max (1- (point)) (point-min)))
- (goto-char post)))))))
+ (while (re-search-forward org-drawer-regexp end t)
+ (pcase (get-char-property-and-overlay (point) 'invisible)
+ ;; Do not fold already folded drawers.
+ (`(outline . ,o) (goto-char (overlay-end o)))
+ (_
+ (let ((drawer (org-element-at-point)))
+ (when (memq (org-element-type drawer) '(drawer property-drawer))
+ (org-hide-drawer-toggle t nil drawer)
+ ;; Make sure to skip drawer entirely or we might flag
+ ;; it another time when matching its ending line with
+ ;; `org-drawer-regexp'.
+ (goto-char (org-element-property :end drawer)))))))))))
;;;; Visibility cycling
@@ -6148,13 +6196,31 @@ By default, the function expands headings, blocks and drawers.
When optional argument TYPE is a list of symbols among `blocks',
`drawers' and `headings', to only expand one specific type."
(interactive)
- (dolist (type (or types '(blocks drawers headings)))
- (org-flag-region (point-min) (point-max) nil
- (pcase type
- (`blocks 'org-hide-block)
- (`drawers 'org-hide-drawer)
- (`headings 'outline)
- (_ (error "Invalid type: %S" type))))))
+ (let ((types (or types '(blocks drawers headings))))
+ (when (memq 'blocks types)
+ (org-flag-region (point-min) (point-max) nil 'org-hide-block))
+ (cond
+ ;; Fast path. Since headings and drawers share the same
+ ;; invisible spec, clear everything in one go.
+ ((and (memq 'headings types)
+ (memq 'drawers types))
+ (org-flag-region (point-min) (point-max) nil 'outline))
+ ((memq 'headings types)
+ (org-flag-region (point-min) (point-max) nil 'outline)
+ (org-cycle-hide-drawers 'all))
+ ((memq 'drawers types)
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward org-drawer-regexp nil t)
+ (let* ((pair (get-char-property-and-overlay (line-beginning-position)
+ 'invisible))
+ (o (cdr-safe pair)))
+ (if (overlayp o) (goto-char (overlay-end o))
+ (pcase (get-char-property-and-overlay (point) 'invisible)
+ (`(outline . ,o)
+ (goto-char (overlay-end o))
+ (delete-overlay o))
+ (_ nil))))))))))
;;;###autoload
(defun org-cycle (&optional arg)
@@ -6205,11 +6271,11 @@ When point is not at the beginning of a headline, execute the global
binding for `TAB', which is re-indenting the line. See the option
`org-cycle-emulate-tab' for details.
-As a special case, if point is at the beginning of the buffer and there is
-no headline in line 1, this function will act as if called with prefix arg
-\(`\\[universal-argument] TAB', same as `S-TAB') also when called without \
-prefix arg, but only
-if the variable `org-cycle-global-at-bob' is t."
+As a special case, if point is at the very beginning of the buffer, if
+there is no headline there, and if the variable `org-cycle-global-at-bob'
+is non-nil, this function acts as if called with prefix argument \
+\(`\\[universal-argument] TAB',
+same as `S-TAB') also when called without prefix argument."
(interactive "P")
(org-load-modules-maybe)
(unless (or (run-hook-with-args-until-success 'org-tab-first-hook)
@@ -6221,63 +6287,22 @@ if the variable `org-cycle-global-at-bob' is t."
(and (boundp 'org-inlinetask-min-level)
org-inlinetask-min-level
(1- org-inlinetask-min-level))))
- (nstars (and limit-level
- (if org-odd-levels-only
- (and limit-level (1- (* limit-level 2)))
- limit-level)))
+ (nstars
+ (and limit-level
+ (if org-odd-levels-only
+ (1- (* 2 limit-level))
+ limit-level)))
(org-outline-regexp
- (if (not (derived-mode-p 'org-mode))
- outline-regexp
- (concat "\\*" (if nstars (format "\\{1,%d\\} " nstars) "+ "))))
- (bob-special (and org-cycle-global-at-bob (not arg) (bobp)
- (not (looking-at org-outline-regexp))))
- (org-cycle-hook
- (if bob-special
- (delq 'org-optimize-window-after-visibility-change
- (copy-sequence org-cycle-hook))
- org-cycle-hook))
- (pos (point)))
-
+ (format "\\*%s " (if nstars (format "\\{1,%d\\}" nstars) "+"))))
(cond
-
((equal arg '(16))
(setq last-command 'dummy)
(org-set-startup-visibility)
(org-unlogged-message "Startup visibility, plus VISIBILITY properties"))
-
((equal arg '(64))
(org-show-all)
(org-unlogged-message "Entire buffer visible, including drawers"))
-
((equal arg '(4)) (org-cycle-internal-global))
-
- ;; Try hiding block at point.
- ((org-hide-block-toggle-maybe))
-
- ;; Try cdlatex TAB completion
- ((org-try-cdlatex-tab))
-
- ;; Table: enter it or move to the next field.
- ((org-at-table-p 'any)
- (if (org-at-table.el-p)
- (message "%s" (substitute-command-keys "\\<org-mode-map>\
-Use `\\[org-edit-special]' to edit table.el tables"))
- (if arg (org-table-edit-field t)
- (org-table-justify-field-maybe)
- (call-interactively 'org-table-next-field))))
-
- ((run-hook-with-args-until-success 'org-tab-after-check-for-table-hook))
-
- ;; Global cycling: delegate to `org-cycle-internal-global'.
- (bob-special (org-cycle-internal-global))
-
- ;; Drawers: delegate to `org-flag-drawer'.
- ((save-excursion
- (beginning-of-line 1)
- (looking-at org-drawer-regexp))
- (org-flag-drawer ; toggle block visibility
- (not (get-char-property (match-end 0) 'invisible))))
-
;; Show-subtree, ARG levels up from here.
((integerp arg)
(save-excursion
@@ -6285,52 +6310,79 @@ Use `\\[org-edit-special]' to edit table.el tables"))
(outline-up-heading (if (< arg 0) (- arg)
(- (funcall outline-level) arg)))
(org-show-subtree)))
-
+ ;; Global cycling at BOB: delegate to `org-cycle-internal-global'.
+ ((and org-cycle-global-at-bob
+ (bobp)
+ (not (looking-at org-outline-regexp)))
+ (let ((org-cycle-hook
+ (remq 'org-optimize-window-after-visibility-change
+ org-cycle-hook)))
+ (org-cycle-internal-global)))
+ ;; Try CDLaTeX TAB completion.
+ ((org-try-cdlatex-tab))
;; Inline task: delegate to `org-inlinetask-toggle-visibility'.
((and (featurep 'org-inlinetask)
(org-inlinetask-at-task-p)
(or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol))))
(org-inlinetask-toggle-visibility))
-
- ;; At an item/headline: delegate to `org-cycle-internal-local'.
- ((and (or (and org-cycle-include-plain-lists (org-at-item-p))
- (save-excursion (move-beginning-of-line 1)
- (looking-at org-outline-regexp)))
- (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol))))
- (org-cycle-internal-local))
-
- ;; From there: TAB emulation and template completion.
- (buffer-read-only (org-back-to-heading))
-
- ((run-hook-with-args-until-success
- 'org-tab-after-check-for-cycling-hook))
-
- ((run-hook-with-args-until-success
- 'org-tab-before-tab-emulation-hook))
-
- ((and (eq org-cycle-emulate-tab 'exc-hl-bol)
- (or (not (bolp))
- (not (looking-at org-outline-regexp))))
- (call-interactively (global-key-binding "\t")))
-
- ((if (and (memq org-cycle-emulate-tab '(white whitestart))
- (save-excursion (beginning-of-line 1) (looking-at "[ \t]*"))
- (or (and (eq org-cycle-emulate-tab 'white)
- (= (match-end 0) (point-at-eol)))
- (and (eq org-cycle-emulate-tab 'whitestart)
- (>= (match-end 0) pos))))
- t
- (eq org-cycle-emulate-tab t))
- (call-interactively (global-key-binding "\t")))
-
- (t (save-excursion
- (org-back-to-heading)
- (org-cycle)))))))
+ (t
+ (let ((pos (point))
+ (element (org-element-at-point)))
+ (cond
+ ;; Try toggling visibility for block at point.
+ ((org-hide-block-toggle nil t element))
+ ;; Try toggling visibility for drawer at point.
+ ((org-hide-drawer-toggle nil t element))
+ ;; Table: enter it or move to the next field.
+ ((and (org-match-line "[ \t]*[|+]")
+ (org-element-lineage element '(table) t))
+ (if (and (eq 'table (org-element-type element))
+ (eq 'table.el (org-element-property :type element)))
+ (message (substitute-command-keys "\\<org-mode-map>\
+Use `\\[org-edit-special]' to edit table.el tables"))
+ (org-table-justify-field-maybe)
+ (call-interactively #'org-table-next-field)))
+ ((run-hook-with-args-until-success
+ 'org-tab-after-check-for-table-hook))
+ ;; At an item/headline: delegate to `org-cycle-internal-local'.
+ ((and (or (and org-cycle-include-plain-lists
+ (let ((item (org-element-lineage element
+ '(item plain-list)
+ t)))
+ (and item
+ (= (line-beginning-position)
+ (org-element-property :post-affiliated
+ item)))))
+ (org-match-line org-outline-regexp))
+ (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol))))
+ (org-cycle-internal-local))
+ ;; From there: TAB emulation and template completion.
+ (buffer-read-only (org-back-to-heading))
+ ((run-hook-with-args-until-success
+ 'org-tab-after-check-for-cycling-hook))
+ ((run-hook-with-args-until-success
+ 'org-tab-before-tab-emulation-hook))
+ ((and (eq org-cycle-emulate-tab 'exc-hl-bol)
+ (or (not (bolp))
+ (not (looking-at org-outline-regexp))))
+ (call-interactively (global-key-binding (kbd "TAB"))))
+ ((or (eq org-cycle-emulate-tab t)
+ (and (memq org-cycle-emulate-tab '(white whitestart))
+ (save-excursion (beginning-of-line 1) (looking-at "[ \t]*"))
+ (or (and (eq org-cycle-emulate-tab 'white)
+ (= (match-end 0) (point-at-eol)))
+ (and (eq org-cycle-emulate-tab 'whitestart)
+ (>= (match-end 0) pos)))))
+ (call-interactively (global-key-binding (kbd "TAB"))))
+ (t
+ (save-excursion
+ (org-back-to-heading)
+ (org-cycle))))))))))
(defun org-cycle-internal-global ()
"Do the global cycling action."
;; Hack to avoid display of messages for .org attachments in Gnus
- (let ((ga (string-match "\\*fontification" (buffer-name))))
+ (let ((ga (string-match-p "\\*fontification" (buffer-name))))
(cond
((and (eq last-command this-command)
(eq org-cycle-global-status 'overview))
@@ -6378,19 +6430,23 @@ Use `\\[org-edit-special]' to edit table.el tables"))
(setq has-children (org-list-has-child-p (point) struct)))
(org-back-to-heading)
(setq eoh (save-excursion (outline-end-of-heading) (point)))
- (setq eos (save-excursion (org-end-of-subtree t t)
- (when (bolp) (backward-char)) (point)))
+ (setq eos (save-excursion
+ (org-end-of-subtree t t)
+ (unless (eobp) (forward-char -1))
+ (point)))
(setq has-children
- (or (save-excursion
- (let ((level (funcall outline-level)))
- (outline-next-heading)
- (and (org-at-heading-p t)
- (> (funcall outline-level) level))))
- (save-excursion
- (org-list-search-forward (org-item-beginning-re) eos t)))))
+ (or
+ (save-excursion
+ (let ((level (funcall outline-level)))
+ (outline-next-heading)
+ (and (org-at-heading-p t)
+ (> (funcall outline-level) level))))
+ (and (eq org-cycle-include-plain-lists 'integrate)
+ (save-excursion
+ (org-list-search-forward (org-item-beginning-re) eos t))))))
;; Determine end invisible part of buffer (EOL)
(beginning-of-line 2)
- (while (and (not (eobp)) ;This is like `next-line'.
+ (while (and (not (eobp)) ;this is like `next-line'
(get-char-property (1- (point)) 'invisible))
(goto-char (next-single-char-property-change (point) 'invisible))
(and (eolp) (beginning-of-line 2)))
@@ -6468,18 +6524,15 @@ Use `\\[org-edit-special]' to edit table.el tables"))
With `\\[universal-argument]' prefix ARG, switch to startup visibility.
With a numeric prefix, show all headlines up to that level."
(interactive "P")
- (let ((org-cycle-include-plain-lists
- (if (derived-mode-p 'org-mode) org-cycle-include-plain-lists nil)))
- (cond
- ((integerp arg)
- (org-show-all '(headings blocks))
- (outline-hide-sublevels arg)
- (setq org-cycle-global-status 'contents))
- ((equal arg '(4))
- (org-set-startup-visibility)
- (org-unlogged-message "Startup visibility, plus VISIBILITY properties."))
- (t
- (org-cycle '(4))))))
+ (cond
+ ((integerp arg)
+ (org-content arg)
+ (setq org-cycle-global-status 'contents))
+ ((equal arg '(4))
+ (org-set-startup-visibility)
+ (org-unlogged-message "Startup visibility, plus VISIBILITY properties."))
+ (t
+ (org-cycle '(4)))))
(defun org-set-startup-visibility ()
"Set the visibility required by startup options and properties."
@@ -6527,51 +6580,60 @@ With a numeric prefix, show all headlines up to that level."
(org-end-of-subtree)))))))
(defun org-overview ()
- "Switch to overview mode, showing only top-level headlines.
-This shows all headlines with a level equal or greater than the level
-of the first headline in the buffer. This is important, because if the
-first headline is not level one, then (hide-sublevels 1) gives confusing
-results."
+ "Switch to overview mode, showing only top-level headlines."
(interactive)
+ (org-show-all '(headings drawers))
(save-excursion
- (let ((level
- (save-excursion
- (goto-char (point-min))
- (when (re-search-forward org-outline-regexp-bol nil t)
- (goto-char (match-beginning 0))
- (funcall outline-level)))))
- (and level (outline-hide-sublevels level)))))
+ (goto-char (point-min))
+ (when (re-search-forward org-outline-regexp-bol nil t)
+ (let* ((last (line-end-position))
+ (level (- (match-end 0) (match-beginning 0) 1))
+ (regexp (format "^\\*\\{1,%d\\} " level)))
+ (while (re-search-forward regexp nil :move)
+ (org-flag-region last (line-end-position 0) t 'outline)
+ (setq last (line-end-position))
+ (setq level (- (match-end 0) (match-beginning 0) 1))
+ (setq regexp (format "^\\*\\{1,%d\\} " level)))
+ (org-flag-region last (point) t 'outline)))))
(defun org-content (&optional arg)
"Show all headlines in the buffer, like a table of contents.
With numerical argument N, show content up to level N."
- (interactive "P")
- (org-overview)
+ (interactive "p")
+ (org-show-all '(headings drawers))
(save-excursion
- ;; Visit all headings and show their offspring
- (and (integerp arg) (org-overview))
(goto-char (point-max))
- (catch 'exit
- (while (and (progn (condition-case nil
- (outline-previous-visible-heading 1)
- (error (goto-char (point-min))))
- t)
- (looking-at org-outline-regexp))
- (if (integerp arg)
- (org-show-children (1- arg))
- (outline-show-branches))
- (when (bobp) (throw 'exit nil))))))
-
+ (let ((regexp (if (and (wholenump arg) (> arg 0))
+ (format "^\\*\\{1,%d\\} " arg)
+ "^\\*+ "))
+ (last (point)))
+ (while (re-search-backward regexp nil t)
+ (org-flag-region (line-end-position) last t 'outline)
+ (setq last (line-end-position 0))))))
+
+(defvar org-scroll-position-to-restore nil
+ "Temporarily store scroll position to restore.")
(defun org-optimize-window-after-visibility-change (state)
"Adjust the window after a change in outline visibility.
This function is the default value of the hook `org-cycle-hook'."
(when (get-buffer-window (current-buffer))
- (cond
- ((eq state 'content) nil)
- ((eq state 'all) nil)
- ((eq state 'folded) nil)
- ((eq state 'children) (or (org-subtree-end-visible-p) (recenter 1)))
- ((eq state 'subtree) (or (org-subtree-end-visible-p) (recenter 1))))))
+ (let ((repeat (eq last-command this-command)))
+ (unless repeat
+ (setq org-scroll-position-to-restore nil))
+ (cond
+ ((eq state 'content) nil)
+ ((eq state 'all) nil)
+ ((and org-scroll-position-to-restore repeat
+ (eq state 'folded))
+ (set-window-start nil org-scroll-position-to-restore))
+ ((eq state 'folded) nil)
+ ((eq state 'children)
+ (setq org-scroll-position-to-restore (window-start))
+ (or (org-subtree-end-visible-p) (recenter 1)))
+ ((eq state 'subtree)
+ (unless repeat
+ (setq org-scroll-position-to-restore (window-start)))
+ (or (org-subtree-end-visible-p) (recenter 1)))))))
(defun org-clean-visibility-after-subtree-move ()
"Fix visibility issues after moving a subtree."
@@ -6672,8 +6734,7 @@ information."
;; If point is hidden within a drawer or a block, make sure to
;; expose it.
(dolist (o (overlays-at (point)))
- (when (memq (overlay-get o 'invisible)
- '(org-hide-block org-hide-drawer outline))
+ (when (memq (overlay-get o 'invisible) '(org-hide-block outline))
(delete-overlay o)))
(unless (org-before-first-heading-p)
(org-with-limited-levels
@@ -6786,7 +6847,7 @@ frame is not changed."
(pop-to-buffer ibuf))
(t (error "Invalid value")))
(narrow-to-region beg end)
- (org-show-all '(headings blocks))
+ (org-show-all '(headings drawers blocks))
(goto-char pos)
(run-hook-with-args 'org-cycle-hook 'all)
(and (window-live-p cwin) (select-window cwin))))
@@ -6813,27 +6874,6 @@ frame is not changed."
;;; Inserting headlines
-(defun org--line-empty-p (n)
- "Is the Nth next line empty?
-
-Counts the current line as N = 1 and the previous line as N = 0;
-see `beginning-of-line'."
- (save-excursion
- (and (not (bobp))
- (or (beginning-of-line n) t)
- (save-match-data
- (looking-at "[ \t]*$")))))
-
-(defun org-previous-line-empty-p ()
- "Is the previous line a blank line?
-When NEXT is non-nil, check the next line instead."
- (org--line-empty-p 0))
-
-(defun org-next-line-empty-p ()
- "Is the previous line a blank line?
-When NEXT is non-nil, check the next line instead."
- (org--line-empty-p 2))
-
(defun org--blank-before-heading-p (&optional parent)
"Non-nil when an empty line should precede a new heading here.
When optional argument PARENT is non-nil, consider parent
@@ -7345,9 +7385,17 @@ Assume point is at a heading or an inlinetask beginning."
(when (looking-at org-property-drawer-re)
(goto-char (match-end 0))
(forward-line)
- (save-excursion (org-indent-region (match-beginning 0) (match-end 0))))
+ (org-indent-region (match-beginning 0) (match-end 0)))
+ (when (looking-at org-logbook-drawer-re)
+ (let ((end-marker (move-marker (make-marker) (match-end 0)))
+ (col (+ (current-indentation) diff)))
+ (when (wholenump col)
+ (while (< (point) end-marker)
+ (indent-line-to col)
+ (forward-line)))))
(catch 'no-shift
- (when (zerop diff) (throw 'no-shift nil))
+ (when (or (zerop diff) (not (eq org-adapt-indentation t)))
+ (throw 'no-shift nil))
;; If DIFF is negative, first check if a shift is possible at all
;; (e.g., it doesn't break structure). This can only happen if
;; some contents are not properly indented.
@@ -7762,8 +7810,9 @@ If yes, remember the marker and the distance to BEG."
"Narrow to the subtree at point or widen a narrowed buffer."
(interactive)
(if (buffer-narrowed-p)
- (widen)
- (org-narrow-to-subtree)))
+ (progn (widen) (message "Buffer widen"))
+ (org-narrow-to-subtree)
+ (message "Buffer narrowed to current subtree")))
(defun org-narrow-to-block ()
"Narrow buffer to the current block."
@@ -7844,7 +7893,8 @@ with the original repeater."
(nmin 1)
(nmax n)
(n-no-remove -1)
- (idprop (org-entry-get nil "ID")))
+ (org-id-overriding-file-name (buffer-file-name (buffer-base-buffer)))
+ (idprop (org-entry-get beg "ID")))
(when (and doshift
(string-match-p "<[^<>\n]+ [.+]?\\+[0-9]+[hdwmy][^<>\n]*>"
template))
@@ -7886,6 +7936,131 @@ with the original repeater."
(buffer-string)))))
(goto-char beg)))
+;;; Outline path
+
+(defvar org-outline-path-cache nil
+ "Alist between buffer positions and outline paths.
+It value is an alist (POSITION . PATH) where POSITION is the
+buffer position at the beginning of an entry and PATH is a list
+of strings describing the outline path for that entry, in reverse
+order.")
+
+(defun org--get-outline-path-1 (&optional use-cache)
+ "Return outline path to current headline.
+
+Outline path is a list of strings, in reverse order. When
+optional argument USE-CACHE is non-nil, make use of a cache. See
+`org-get-outline-path' for details.
+
+Assume buffer is widened and point is on a headline."
+ (or (and use-cache (cdr (assq (point) org-outline-path-cache)))
+ (let ((p (point))
+ (heading (let ((case-fold-search nil))
+ (looking-at org-complex-heading-regexp)
+ (if (not (match-end 4)) ""
+ ;; Remove statistics cookies.
+ (org-trim
+ (org-link-display-format
+ (replace-regexp-in-string
+ "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" ""
+ (match-string-no-properties 4))))))))
+ (if (org-up-heading-safe)
+ (let ((path (cons heading (org--get-outline-path-1 use-cache))))
+ (when use-cache
+ (push (cons p path) org-outline-path-cache))
+ path)
+ ;; This is a new root node. Since we assume we are moving
+ ;; forward, we can drop previous cache so as to limit number
+ ;; of associations there.
+ (let ((path (list heading)))
+ (when use-cache (setq org-outline-path-cache (list (cons p path))))
+ path)))))
+
+(defun org-get-outline-path (&optional with-self use-cache)
+ "Return the outline path to the current entry.
+
+An outline path is a list of ancestors for current headline, as
+a list of strings. Statistics cookies are removed and links are
+replaced with their description, if any, or their path otherwise.
+
+When optional argument WITH-SELF is non-nil, the path also
+includes the current headline.
+
+When optional argument USE-CACHE is non-nil, cache outline paths
+between calls to this function so as to avoid backtracking. This
+argument is useful when planning to find more than one outline
+path in the same document. In that case, there are two
+conditions to satisfy:
+ - `org-outline-path-cache' is set to nil before starting the
+ process;
+ - outline paths are computed by increasing buffer positions."
+ (org-with-wide-buffer
+ (and (or (and with-self (org-back-to-heading t))
+ (org-up-heading-safe))
+ (reverse (org--get-outline-path-1 use-cache)))))
+
+(defun org-format-outline-path (path &optional width prefix separator)
+ "Format the outline path PATH for display.
+WIDTH is the maximum number of characters that is available.
+PREFIX is a prefix to be included in the returned string,
+such as the file name.
+SEPARATOR is inserted between the different parts of the path,
+the default is \"/\"."
+ (setq width (or width 79))
+ (setq path (delq nil path))
+ (unless (> width 0)
+ (user-error "Argument `width' must be positive"))
+ (setq separator (or separator "/"))
+ (let* ((org-odd-levels-only nil)
+ (fpath (concat
+ prefix (and prefix path separator)
+ (mapconcat
+ (lambda (s) (replace-regexp-in-string "[ \t]+\\'" "" s))
+ (cl-loop for head in path
+ for n from 0
+ collect (org-add-props
+ head nil 'face
+ (nth (% n org-n-level-faces) org-level-faces)))
+ separator))))
+ (when (> (length fpath) width)
+ (if (< width 7)
+ ;; It's unlikely that `width' will be this small, but don't
+ ;; waste characters by adding ".." if it is.
+ (setq fpath (substring fpath 0 width))
+ (setf (substring fpath (- width 2)) "..")))
+ fpath))
+
+(defun org-display-outline-path (&optional file current separator just-return-string)
+ "Display the current outline path in the echo area.
+
+If FILE is non-nil, prepend the output with the file name.
+If CURRENT is non-nil, append the current heading to the output.
+SEPARATOR is passed through to `org-format-outline-path'. It separates
+the different parts of the path and defaults to \"/\".
+If JUST-RETURN-STRING is non-nil, return a string, don't display a message."
+ (interactive "P")
+ (let* (case-fold-search
+ (bfn (buffer-file-name (buffer-base-buffer)))
+ (path (and (derived-mode-p 'org-mode) (org-get-outline-path)))
+ res)
+ (when current (setq path (append path
+ (save-excursion
+ (org-back-to-heading t)
+ (when (looking-at org-complex-heading-regexp)
+ (list (match-string 4)))))))
+ (setq res
+ (org-format-outline-path
+ path
+ (1- (frame-width))
+ (and file bfn (concat (file-name-nondirectory bfn) separator))
+ separator))
+ (add-face-text-property 0 (length res)
+ `(:height ,(face-attribute 'default :height))
+ nil res)
+ (if just-return-string
+ res
+ (org-unlogged-message "%s" res))))
+
;;; Outline Sorting
(defun org-sort (&optional with-case)
@@ -7908,8 +8083,6 @@ Optional argument WITH-CASE means sort case-sensitively."
(org-link-display-format s)
t t) t t))
-(defvar org-priority-regexp) ; defined later in the file
-
(defvar org-after-sorting-entries-or-items-hook nil
"Hook that is run after a bunch of entries or items have been sorted.
When children are sorted, the cursor is in the parent line when this
@@ -8003,7 +8176,7 @@ function is being called interactively."
(setq end (point-max))
(setq what "top-level")
(goto-char start)
- (org-show-all '(headings blocks))))
+ (org-show-all '(headings drawers blocks))))
(setq beg (point))
(when (>= beg end) (goto-char start) (user-error "Nothing to sort"))
@@ -8113,7 +8286,7 @@ function is being called interactively."
((= dcst ?p)
(if (re-search-forward org-priority-regexp (point-at-eol) t)
(string-to-char (match-string 2))
- org-default-priority))
+ org-priority-default))
((= dcst ?r)
(or (org-entry-get nil property) ""))
((= dcst ?o)
@@ -8270,13 +8443,14 @@ the value of the drawer property."
(inhibit-read-only t)
(inherit? (org-property-inherit-p dprop))
(property-re (org-re-property (concat (regexp-quote dprop) "\\+?") t))
- (global (and inherit? (org--property-global-value dprop nil))))
+ (global-or-keyword (and inherit?
+ (org--property-global-or-keyword-value dprop nil))))
(with-silent-modifications
(org-with-point-at 1
- ;; Set global values (e.g., values defined through
- ;; "#+PROPERTY:" keywords) to the whole buffer.
- (when global (put-text-property (point-min) (point-max) tprop global))
- ;; Set local values.
+ ;; Set global and keyword based values to the whole buffer.
+ (when global-or-keyword
+ (put-text-property (point-min) (point-max) tprop global-or-keyword))
+ ;; Set values based on property-drawers throughout the document.
(while (re-search-forward property-re nil t)
(when (org-at-property-p)
(org-refresh-property tprop (org-entry-get (point) dprop) inherit?))
@@ -8284,21 +8458,30 @@ the value of the drawer property."
(defun org-refresh-property (tprop p &optional inherit)
"Refresh the buffer text property TPROP from the drawer property P.
-The refresh happens only for the current headline, or the whole
-sub-tree if optional argument INHERIT is non-nil."
- (unless (org-before-first-heading-p)
- (save-excursion
- (org-back-to-heading t)
- (let ((start (point))
- (end (save-excursion
- (if inherit (org-end-of-subtree t t)
- (or (outline-next-heading) (point-max))))))
- (if (symbolp tprop)
- ;; TPROP is a text property symbol.
- (put-text-property start end tprop p)
- ;; TPROP is an alist with (property . function) elements.
- (pcase-dolist (`(,prop . ,f) tprop)
- (put-text-property start end prop (funcall f p))))))))
+
+The refresh happens only for the current entry, or the whole
+sub-tree if optional argument INHERIT is non-nil.
+
+If point is before first headline, the function applies to the
+part before the first headline. In that particular case, when
+optional argument INHERIT is non-nil, it refreshes properties for
+the whole buffer."
+ (save-excursion
+ (org-back-to-heading-or-point-min t)
+ (let ((start (point))
+ (end (save-excursion
+ (cond ((and inherit (org-before-first-heading-p))
+ (point-max))
+ (inherit
+ (org-end-of-subtree t t))
+ ((outline-next-heading))
+ ((point-max))))))
+ (if (symbolp tprop)
+ ;; TPROP is a text property symbol.
+ (put-text-property start end tprop p)
+ ;; TPROP is an alist with (property . function) elements.
+ (pcase-dolist (`(,prop . ,f) tprop)
+ (put-text-property start end prop (funcall f p)))))))
(defun org-refresh-category-properties ()
"Refresh category text properties in the buffer."
@@ -8314,9 +8497,9 @@ sub-tree if optional argument INHERIT is non-nil."
(t org-category))))
(with-silent-modifications
(org-with-wide-buffer
- ;; Set buffer-wide category. Search last #+CATEGORY keyword.
- ;; This is the default category for the buffer. If none is
- ;; found, fall-back to `org-category' or buffer file name.
+ ;; Set buffer-wide property from keyword. Search last #+CATEGORY
+ ;; keyword. If none is found, fall-back to `org-category' or
+ ;; buffer file name, or set it by the document property drawer.
(put-text-property
(point-min) (point-max)
'org-category
@@ -8328,15 +8511,20 @@ sub-tree if optional argument INHERIT is non-nil."
(throw 'buffer-category
(org-element-property :value element)))))
default-category))
- ;; Set sub-tree specific categories.
+ ;; Set categories from the document property drawer or
+ ;; property drawers in the outline. If category is found in
+ ;; the property drawer for the whole buffer that value
+ ;; overrides the keyword-based value set above.
(goto-char (point-min))
(let ((regexp (org-re-property "CATEGORY")))
(while (re-search-forward regexp nil t)
(let ((value (match-string-no-properties 3)))
(when (org-at-property-p)
(put-text-property
- (save-excursion (org-back-to-heading t) (point))
- (save-excursion (org-end-of-subtree t t) (point))
+ (save-excursion (org-back-to-heading-or-point-min t))
+ (save-excursion (if (org-before-first-heading-p)
+ (point-max)
+ (org-end-of-subtree t t)))
'org-category
value)))))))))
@@ -8660,31 +8848,30 @@ a link."
;; a link, a footnote reference.
((memq type '(headline inlinetask))
(org-match-line org-complex-heading-regexp)
- (if (and (match-beginning 5)
- (>= (point) (match-beginning 5))
- (< (point) (match-end 5)))
- ;; On tags.
- (org-tags-view
- arg
- (save-excursion
- (let* ((beg (match-beginning 5))
- (end (match-end 5))
- (beg-tag (or (search-backward ":" beg 'at-limit) (point)))
- (end-tag (search-forward ":" end nil 2)))
- (buffer-substring (1+ beg-tag) (1- end-tag)))))
- ;; Not on tags.
- (pcase (org-offer-links-in-entry (current-buffer) (point) arg)
- (`(nil . ,_)
- (require 'org-attach)
- (message "Opening attachment-dir")
- (if (equal arg '(4))
- (org-attach-reveal-in-emacs)
- (org-attach-reveal)))
- (`(,links . ,links-end)
- (dolist (link (if (stringp links) (list links) links))
- (search-forward link nil links-end)
- (goto-char (match-beginning 0))
- (org-open-at-point arg))))))
+ (let ((tags-beg (match-beginning 5))
+ (tags-end (match-end 5)))
+ (if (and tags-beg (>= (point) tags-beg) (< (point) tags-end))
+ ;; On tags.
+ (org-tags-view
+ arg
+ (save-excursion
+ (let* ((beg-tag (or (search-backward ":" tags-beg 'at-limit) (point)))
+ (end-tag (search-forward ":" tags-end nil 2)))
+ (buffer-substring (1+ beg-tag) (1- end-tag)))))
+ ;; Not on tags.
+ (pcase (org-offer-links-in-entry (current-buffer) (point) arg)
+ (`(nil . ,_)
+ (require 'org-attach)
+ (when (org-attach-dir)
+ (message "Opening attachment")
+ (if (equal arg '(4))
+ (org-attach-reveal-in-emacs)
+ (org-attach-reveal))))
+ (`(,links . ,links-end)
+ (dolist (link (if (stringp links) (list links) links))
+ (search-forward link nil links-end)
+ (goto-char (match-beginning 0))
+ (org-open-at-point arg)))))))
;; On a footnote reference or at definition's label.
((or (eq type 'footnote-reference)
(and (eq type 'footnote-definition)
@@ -8904,639 +9091,10 @@ or to another Org file, automatically push the old position onto the ring."
(when (string-match (car entry) buffer-file-name)
(throw 'exit (cdr entry))))))))
-(defvar org-refile-target-table nil
- "The list of refile targets, created by `org-refile'.")
-
(defvar org-agenda-new-buffers nil
"Buffers created to visit agenda files.")
-(defvar org-refile-cache nil
- "Cache for refile targets.")
-
-(defvar org-refile-markers nil
- "All the markers used for caching refile locations.")
-
-(defun org-refile-marker (pos)
- "Get a new refile marker, but only if caching is in use."
- (if (not org-refile-use-cache)
- pos
- (let ((m (make-marker)))
- (move-marker m pos)
- (push m org-refile-markers)
- m)))
-
-(defun org-refile-cache-clear ()
- "Clear the refile cache and disable all the markers."
- (dolist (m org-refile-markers) (move-marker m nil))
- (setq org-refile-markers nil)
- (setq org-refile-cache nil)
- (message "Refile cache has been cleared"))
-
-(defun org-refile-cache-check-set (set)
- "Check if all the markers in the cache still have live buffers."
- (let (marker)
- (catch 'exit
- (while (and set (setq marker (nth 3 (pop set))))
- ;; If `org-refile-use-outline-path' is 'file, marker may be nil
- (when (and marker (null (marker-buffer marker)))
- (message "Please regenerate the refile cache with `C-0 C-c C-w'")
- (sit-for 3)
- (throw 'exit nil)))
- t)))
-
-(defun org-refile-cache-put (set &rest identifiers)
- "Push the refile targets SET into the cache, under IDENTIFIERS."
- (let* ((key (sha1 (prin1-to-string identifiers)))
- (entry (assoc key org-refile-cache)))
- (if entry
- (setcdr entry set)
- (push (cons key set) org-refile-cache))))
-
-(defun org-refile-cache-get (&rest identifiers)
- "Retrieve the cached value for refile targets given by IDENTIFIERS."
- (cond
- ((not org-refile-cache) nil)
- ((not org-refile-use-cache) (org-refile-cache-clear) nil)
- (t
- (let ((set (cdr (assoc (sha1 (prin1-to-string identifiers))
- org-refile-cache))))
- (and set (org-refile-cache-check-set set) set)))))
-
-(defvar org-outline-path-cache nil
- "Alist between buffer positions and outline paths.
-It value is an alist (POSITION . PATH) where POSITION is the
-buffer position at the beginning of an entry and PATH is a list
-of strings describing the outline path for that entry, in reverse
-order.")
-
-(defun org-refile-get-targets (&optional default-buffer)
- "Produce a table with refile targets."
- (let ((case-fold-search nil)
- ;; otherwise org confuses "TODO" as a kw and "Todo" as a word
- (entries (or org-refile-targets '((nil . (:level . 1)))))
- targets tgs files desc descre)
- (message "Getting targets...")
- (with-current-buffer (or default-buffer (current-buffer))
- (dolist (entry entries)
- (setq files (car entry) desc (cdr entry))
- (cond
- ((null files) (setq files (list (current-buffer))))
- ((eq files 'org-agenda-files)
- (setq files (org-agenda-files 'unrestricted)))
- ((and (symbolp files) (fboundp files))
- (setq files (funcall files)))
- ((and (symbolp files) (boundp files))
- (setq files (symbol-value files))))
- (when (stringp files) (setq files (list files)))
- (cond
- ((eq (car desc) :tag)
- (setq descre (concat "^\\*+[ \t]+.*?:" (regexp-quote (cdr desc)) ":")))
- ((eq (car desc) :todo)
- (setq descre (concat "^\\*+[ \t]+" (regexp-quote (cdr desc)) "[ \t]")))
- ((eq (car desc) :regexp)
- (setq descre (cdr desc)))
- ((eq (car desc) :level)
- (setq descre (concat "^\\*\\{" (number-to-string
- (if org-odd-levels-only
- (1- (* 2 (cdr desc)))
- (cdr desc)))
- "\\}[ \t]")))
- ((eq (car desc) :maxlevel)
- (setq descre (concat "^\\*\\{1," (number-to-string
- (if org-odd-levels-only
- (1- (* 2 (cdr desc)))
- (cdr desc)))
- "\\}[ \t]")))
- (t (error "Bad refiling target description %s" desc)))
- (dolist (f files)
- (with-current-buffer (if (bufferp f) f (org-get-agenda-file-buffer f))
- (or
- (setq tgs (org-refile-cache-get (buffer-file-name) descre))
- (progn
- (when (bufferp f)
- (setq f (buffer-file-name (buffer-base-buffer f))))
- (setq f (and f (expand-file-name f)))
- (when (eq org-refile-use-outline-path 'file)
- (push (list (file-name-nondirectory f) f nil nil) tgs))
- (when (eq org-refile-use-outline-path 'buffer-name)
- (push (list (buffer-name (buffer-base-buffer)) f nil nil) tgs))
- (when (eq org-refile-use-outline-path 'full-file-path)
- (push (list (file-truename (buffer-file-name (buffer-base-buffer))) f nil nil) tgs))
- (org-with-wide-buffer
- (goto-char (point-min))
- (setq org-outline-path-cache nil)
- (while (re-search-forward descre nil t)
- (beginning-of-line)
- (let ((case-fold-search nil))
- (looking-at org-complex-heading-regexp))
- (let ((begin (point))
- (heading (match-string-no-properties 4)))
- (unless (or (and
- org-refile-target-verify-function
- (not
- (funcall org-refile-target-verify-function)))
- (not heading))
- (let ((re (format org-complex-heading-regexp-format
- (regexp-quote heading)))
- (target
- (if (not org-refile-use-outline-path) heading
- (mapconcat
- #'identity
- (append
- (pcase org-refile-use-outline-path
- (`file (list (file-name-nondirectory
- (buffer-file-name
- (buffer-base-buffer)))))
- (`full-file-path
- (list (buffer-file-name
- (buffer-base-buffer))))
- (`buffer-name
- (list (buffer-name
- (buffer-base-buffer))))
- (_ nil))
- (mapcar (lambda (s) (replace-regexp-in-string
- "/" "\\/" s nil t))
- (org-get-outline-path t t)))
- "/"))))
- (push (list target f re (org-refile-marker (point)))
- tgs)))
- (when (= (point) begin)
- ;; Verification function has not moved point.
- (end-of-line)))))))
- (when org-refile-use-cache
- (org-refile-cache-put tgs (buffer-file-name) descre))
- (setq targets (append tgs targets))))))
- (message "Getting targets...done")
- (delete-dups (nreverse targets))))
-
-(defun org--get-outline-path-1 (&optional use-cache)
- "Return outline path to current headline.
-
-Outline path is a list of strings, in reverse order. When
-optional argument USE-CACHE is non-nil, make use of a cache. See
-`org-get-outline-path' for details.
-
-Assume buffer is widened and point is on a headline."
- (or (and use-cache (cdr (assq (point) org-outline-path-cache)))
- (let ((p (point))
- (heading (let ((case-fold-search nil))
- (looking-at org-complex-heading-regexp)
- (if (not (match-end 4)) ""
- ;; Remove statistics cookies.
- (org-trim
- (org-link-display-format
- (replace-regexp-in-string
- "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" ""
- (match-string-no-properties 4))))))))
- (if (org-up-heading-safe)
- (let ((path (cons heading (org--get-outline-path-1 use-cache))))
- (when use-cache
- (push (cons p path) org-outline-path-cache))
- path)
- ;; This is a new root node. Since we assume we are moving
- ;; forward, we can drop previous cache so as to limit number
- ;; of associations there.
- (let ((path (list heading)))
- (when use-cache (setq org-outline-path-cache (list (cons p path))))
- path)))))
-
-(defun org-get-outline-path (&optional with-self use-cache)
- "Return the outline path to the current entry.
-
-An outline path is a list of ancestors for current headline, as
-a list of strings. Statistics cookies are removed and links are
-replaced with their description, if any, or their path otherwise.
-
-When optional argument WITH-SELF is non-nil, the path also
-includes the current headline.
-
-When optional argument USE-CACHE is non-nil, cache outline paths
-between calls to this function so as to avoid backtracking. This
-argument is useful when planning to find more than one outline
-path in the same document. In that case, there are two
-conditions to satisfy:
- - `org-outline-path-cache' is set to nil before starting the
- process;
- - outline paths are computed by increasing buffer positions."
- (org-with-wide-buffer
- (and (or (and with-self (org-back-to-heading t))
- (org-up-heading-safe))
- (reverse (org--get-outline-path-1 use-cache)))))
-
-(defun org-format-outline-path (path &optional width prefix separator)
- "Format the outline path PATH for display.
-WIDTH is the maximum number of characters that is available.
-PREFIX is a prefix to be included in the returned string,
-such as the file name.
-SEPARATOR is inserted between the different parts of the path,
-the default is \"/\"."
- (setq width (or width 79))
- (setq path (delq nil path))
- (unless (> width 0)
- (user-error "Argument `width' must be positive"))
- (setq separator (or separator "/"))
- (let* ((org-odd-levels-only nil)
- (fpath (concat
- prefix (and prefix path separator)
- (mapconcat
- (lambda (s) (replace-regexp-in-string "[ \t]+\\'" "" s))
- (cl-loop for head in path
- for n from 0
- collect (org-add-props
- head nil 'face
- (nth (% n org-n-level-faces) org-level-faces)))
- separator))))
- (when (> (length fpath) width)
- (if (< width 7)
- ;; It's unlikely that `width' will be this small, but don't
- ;; waste characters by adding ".." if it is.
- (setq fpath (substring fpath 0 width))
- (setf (substring fpath (- width 2)) "..")))
- fpath))
-
-(defun org-display-outline-path (&optional file current separator just-return-string)
- "Display the current outline path in the echo area.
-
-If FILE is non-nil, prepend the output with the file name.
-If CURRENT is non-nil, append the current heading to the output.
-SEPARATOR is passed through to `org-format-outline-path'. It separates
-the different parts of the path and defaults to \"/\".
-If JUST-RETURN-STRING is non-nil, return a string, don't display a message."
- (interactive "P")
- (let* (case-fold-search
- (bfn (buffer-file-name (buffer-base-buffer)))
- (path (and (derived-mode-p 'org-mode) (org-get-outline-path)))
- res)
- (when current (setq path (append path
- (save-excursion
- (org-back-to-heading t)
- (when (looking-at org-complex-heading-regexp)
- (list (match-string 4)))))))
- (setq res
- (org-format-outline-path
- path
- (1- (frame-width))
- (and file bfn (concat (file-name-nondirectory bfn) separator))
- separator))
- (if just-return-string
- (org-no-properties res)
- (org-unlogged-message "%s" res))))
-
-(defvar org-refile-history nil
- "History for refiling operations.")
-
-(defvar org-after-refile-insert-hook nil
- "Hook run after `org-refile' has inserted its stuff at the new location.
-Note that this is still *before* the stuff will be removed from
-the *old* location.")
-
-(defvar org-capture-last-stored-marker)
-(defvar org-refile-keep nil
- "Non-nil means `org-refile' will copy instead of refile.")
-
-(defun org-copy ()
- "Like `org-refile', but copy."
- (interactive)
- (let ((org-refile-keep t))
- (org-refile nil nil nil "Copy")))
-
-(defun org-refile (&optional arg default-buffer rfloc msg)
- "Move the entry or entries at point to another heading.
-
-The list of target headings is compiled using the information in
-`org-refile-targets', which see.
-
-At the target location, the entry is filed as a subitem of the
-target heading. Depending on `org-reverse-note-order', the new
-subitem will either be the first or the last subitem.
-
-If there is an active region, all entries in that region will be
-refiled. However, the region must fulfill the requirement that
-the first heading sets the top-level of the moved text.
-
-With a `\\[universal-argument]' ARG, the command will only visit the target \
-location
-and not actually move anything.
-
-With a prefix `\\[universal-argument] \\[universal-argument]', go to the \
-location where the last
-refiling operation has put the subtree.
-
-With a numeric prefix argument of `2', refile to the running clock.
-
-With a numeric prefix argument of `3', emulate `org-refile-keep'
-being set to t and copy to the target location, don't move it.
-Beware that keeping refiled entries may result in duplicated ID
-properties.
-
-RFLOC can be a refile location obtained in a different way.
-
-MSG is a string to replace \"Refile\" in the default prompt with
-another verb. E.g. `org-copy' sets this parameter to \"Copy\".
-
-See also `org-refile-use-outline-path'.
-
-If you are using target caching (see `org-refile-use-cache'), you
-have to clear the target cache in order to find new targets.
-This can be done with a `0' prefix (`C-0 C-c C-w') or a triple
-prefix argument (`C-u C-u C-u C-c C-w')."
- (interactive "P")
- (if (member arg '(0 (64)))
- (org-refile-cache-clear)
- (let* ((actionmsg (cond (msg msg)
- ((equal arg 3) "Refile (and keep)")
- (t "Refile")))
- (regionp (org-region-active-p))
- (region-start (and regionp (region-beginning)))
- (region-end (and regionp (region-end)))
- (org-refile-keep (if (equal arg 3) t org-refile-keep))
- pos it nbuf file level reversed)
- (setq last-command nil)
- (when regionp
- (goto-char region-start)
- (beginning-of-line)
- (setq region-start (point))
- (unless (or (org-kill-is-subtree-p
- (buffer-substring region-start region-end))
- (prog1 org-refile-active-region-within-subtree
- (let ((s (point-at-eol)))
- (org-toggle-heading)
- (setq region-end (+ (- (point-at-eol) s) region-end)))))
- (user-error "The region is not a (sequence of) subtree(s)")))
- (if (equal arg '(16))
- (org-refile-goto-last-stored)
- (when (or
- (and (equal arg 2)
- org-clock-hd-marker (marker-buffer org-clock-hd-marker)
- (prog1
- (setq it (list (or org-clock-heading "running clock")
- (buffer-file-name
- (marker-buffer org-clock-hd-marker))
- ""
- (marker-position org-clock-hd-marker)))
- (setq arg nil)))
- (setq it
- (or rfloc
- (let (heading-text)
- (save-excursion
- (unless (and arg (listp arg))
- (org-back-to-heading t)
- (setq heading-text
- (replace-regexp-in-string
- org-link-bracket-re
- "\\2"
- (or (nth 4 (org-heading-components))
- ""))))
- (org-refile-get-location
- (cond ((and arg (listp arg)) "Goto")
- (regionp (concat actionmsg " region to"))
- (t (concat actionmsg " subtree \""
- heading-text "\" to")))
- default-buffer
- (and (not (equal '(4) arg))
- org-refile-allow-creating-parent-nodes)))))))
- (setq file (nth 1 it)
- pos (nth 3 it))
- (when (and (not arg)
- pos
- (equal (buffer-file-name) file)
- (if regionp
- (and (>= pos region-start)
- (<= pos region-end))
- (and (>= pos (point))
- (< pos (save-excursion
- (org-end-of-subtree t t))))))
- (error "Cannot refile to position inside the tree or region"))
- (setq nbuf (or (find-buffer-visiting file)
- (find-file-noselect file)))
- (if (and arg (not (equal arg 3)))
- (progn
- (pop-to-buffer-same-window nbuf)
- (goto-char (cond (pos)
- ((org-notes-order-reversed-p) (point-min))
- (t (point-max))))
- (org-show-context 'org-goto))
- (if regionp
- (progn
- (org-kill-new (buffer-substring region-start region-end))
- (org-save-markers-in-region region-start region-end))
- (org-copy-subtree 1 nil t))
- (with-current-buffer (setq nbuf (or (find-buffer-visiting file)
- (find-file-noselect file)))
- (setq reversed (org-notes-order-reversed-p))
- (org-with-wide-buffer
- (if pos
- (progn
- (goto-char pos)
- (setq level (org-get-valid-level (funcall outline-level) 1))
- (goto-char
- (if reversed
- (or (outline-next-heading) (point-max))
- (or (save-excursion (org-get-next-sibling))
- (org-end-of-subtree t t)
- (point-max)))))
- (setq level 1)
- (if (not reversed)
- (goto-char (point-max))
- (goto-char (point-min))
- (or (outline-next-heading) (goto-char (point-max)))))
- (unless (bolp) (newline))
- (org-paste-subtree level nil nil t)
- ;; Record information, according to `org-log-refile'.
- ;; Do not prompt for a note when refiling multiple
- ;; headlines, however. Simply add a time stamp.
- (cond
- ((not org-log-refile))
- (regionp
- (org-map-region
- (lambda () (org-add-log-setup 'refile nil nil 'time))
- (point)
- (+ (point) (- region-end region-start))))
- (t
- (org-add-log-setup 'refile nil nil org-log-refile)))
- (and org-auto-align-tags
- (let ((org-loop-over-headlines-in-active-region nil))
- (org-align-tags)))
- (let ((bookmark-name (plist-get org-bookmark-names-plist
- :last-refile)))
- (when bookmark-name
- (with-demoted-errors
- (bookmark-set bookmark-name))))
- ;; If we are refiling for capture, make sure that the
- ;; last-capture pointers point here
- (when (bound-and-true-p org-capture-is-refiling)
- (let ((bookmark-name (plist-get org-bookmark-names-plist
- :last-capture-marker)))
- (when bookmark-name
- (with-demoted-errors
- (bookmark-set bookmark-name))))
- (move-marker org-capture-last-stored-marker (point)))
- (when (fboundp 'deactivate-mark) (deactivate-mark))
- (run-hooks 'org-after-refile-insert-hook)))
- (unless org-refile-keep
- (if regionp
- (delete-region (point) (+ (point) (- region-end region-start)))
- (org-preserve-local-variables
- (delete-region
- (and (org-back-to-heading t) (point))
- (min (1+ (buffer-size)) (org-end-of-subtree t t) (point))))))
- (when (featurep 'org-inlinetask)
- (org-inlinetask-remove-END-maybe))
- (setq org-markers-to-move nil)
- (message "%s to \"%s\" in file %s: done" actionmsg
- (car it) file)))))))
-
-(defun org-refile-goto-last-stored ()
- "Go to the location where the last refile was stored."
- (interactive)
- (bookmark-jump (plist-get org-bookmark-names-plist :last-refile))
- (message "This is the location of the last refile"))
-
-(defun org-refile--get-location (refloc tbl)
- "When user refile to REFLOC, find the associated target in TBL.
-Also check `org-refile-target-table'."
- (car (delq
- nil
- (mapcar
- (lambda (r) (or (assoc r tbl)
- (assoc r org-refile-target-table)))
- (list (replace-regexp-in-string "/$" "" refloc)
- (replace-regexp-in-string "\\([^/]\\)$" "\\1/" refloc))))))
-
-(defun org-refile-get-location (&optional prompt default-buffer new-nodes)
- "Prompt the user for a refile location, using PROMPT.
-PROMPT should not be suffixed with a colon and a space, because
-this function appends the default value from
-`org-refile-history' automatically, if that is not empty."
- (let ((org-refile-targets org-refile-targets)
- (org-refile-use-outline-path org-refile-use-outline-path))
- (setq org-refile-target-table (org-refile-get-targets default-buffer)))
- (unless org-refile-target-table
- (user-error "No refile targets"))
- (let* ((cbuf (current-buffer))
- (cfn (buffer-file-name (buffer-base-buffer cbuf)))
- (cfunc (if (and org-refile-use-outline-path
- org-outline-path-complete-in-steps)
- #'org-olpath-completing-read
- #'completing-read))
- (extra (if org-refile-use-outline-path "/" ""))
- (cbnex (concat (buffer-name) extra))
- (filename (and cfn (expand-file-name cfn)))
- (tbl (mapcar
- (lambda (x)
- (if (and (not (member org-refile-use-outline-path
- '(file full-file-path)))
- (not (equal filename (nth 1 x))))
- (cons (concat (car x) extra " ("
- (file-name-nondirectory (nth 1 x)) ")")
- (cdr x))
- (cons (concat (car x) extra) (cdr x))))
- org-refile-target-table))
- (completion-ignore-case t)
- cdef
- (prompt (concat prompt
- (or (and (car org-refile-history)
- (concat " (default " (car org-refile-history) ")"))
- (and (assoc cbnex tbl) (setq cdef cbnex)
- (concat " (default " cbnex ")"))) ": "))
- pa answ parent-target child parent old-hist)
- (setq old-hist org-refile-history)
- (setq answ (funcall cfunc prompt tbl nil (not new-nodes)
- nil 'org-refile-history (or cdef (car org-refile-history))))
- (if (setq pa (org-refile--get-location answ tbl))
- (progn
- (org-refile-check-position pa)
- (when (or (not org-refile-history)
- (not (eq old-hist org-refile-history))
- (not (equal (car pa) (car org-refile-history))))
- (setq org-refile-history
- (cons (car pa) (if (assoc (car org-refile-history) tbl)
- org-refile-history
- (cdr org-refile-history))))
- (when (equal (car org-refile-history) (nth 1 org-refile-history))
- (pop org-refile-history)))
- pa)
- (if (string-match "\\`\\(.*\\)/\\([^/]+\\)\\'" answ)
- (progn
- (setq parent (match-string 1 answ)
- child (match-string 2 answ))
- (setq parent-target (org-refile--get-location parent tbl))
- (when (and parent-target
- (or (eq new-nodes t)
- (and (eq new-nodes 'confirm)
- (y-or-n-p (format "Create new node \"%s\"? "
- child)))))
- (org-refile-new-child parent-target child)))
- (user-error "Invalid target location")))))
-
(declare-function org-string-nw-p "org-macs" (s))
-(defun org-refile-check-position (refile-pointer)
- "Check if the refile pointer matches the headline to which it points."
- (let* ((file (nth 1 refile-pointer))
- (re (nth 2 refile-pointer))
- (pos (nth 3 refile-pointer))
- buffer)
- (if (and (not (markerp pos)) (not file))
- (user-error "Please indicate a target file in the refile path")
- (when (org-string-nw-p re)
- (setq buffer (if (markerp pos)
- (marker-buffer pos)
- (or (find-buffer-visiting file)
- (find-file-noselect file))))
- (with-current-buffer buffer
- (org-with-wide-buffer
- (goto-char pos)
- (beginning-of-line 1)
- (unless (looking-at-p re)
- (user-error "Invalid refile position, please clear the cache with `C-0 C-c C-w' before refiling"))))))))
-
-(defun org-refile-new-child (parent-target child)
- "Use refile target PARENT-TARGET to add new CHILD below it."
- (unless parent-target
- (error "Cannot find parent for new node"))
- (let ((file (nth 1 parent-target))
- (pos (nth 3 parent-target))
- level)
- (with-current-buffer (or (find-buffer-visiting file)
- (find-file-noselect file))
- (org-with-wide-buffer
- (if pos
- (goto-char pos)
- (goto-char (point-max))
- (unless (bolp) (newline)))
- (when (looking-at org-outline-regexp)
- (setq level (funcall outline-level))
- (org-end-of-subtree t t))
- (org-back-over-empty-lines)
- (insert "\n" (make-string
- (if pos (org-get-valid-level level 1) 1) ?*)
- " " child "\n")
- (beginning-of-line 0)
- (list (concat (car parent-target) "/" child) file "" (point))))))
-
-(defun org-olpath-completing-read (prompt collection &rest args)
- "Read an outline path like a file name."
- (let ((thetable collection))
- (apply #'completing-read
- prompt
- (lambda (string predicate &optional flag)
- (cond
- ((eq flag nil) (try-completion string thetable))
- ((eq flag t)
- (let ((l (length string)))
- (mapcar (lambda (x)
- (let ((r (substring x l))
- (f (if (string-match " ([^)]*)$" x)
- (match-string 0 x)
- "")))
- (if (string-match "/" r)
- (concat string (substring r 0 (match-end 0)) f)
- x)))
- (all-completions string thetable predicate))))
- ;; Exact match?
- ((eq flag 'lambda) (assoc string thetable))))
- args)))
-
;;;; Dynamic blocks
(defun org-find-dblock (name)
@@ -9632,15 +9190,18 @@ block of such type."
(`nil (push (cons type func) org-dynamic-block-alist))
(def (setcdr def func))))
-(defun org-dynamic-block-insert-dblock (type)
+(defun org-dynamic-block-insert-dblock (type &optional interactive-p)
"Insert a dynamic block of type TYPE.
When used interactively, select the dynamic block types among
-defined types, per `org-dynamic-block-define'."
+defined types, per `org-dynamic-block-define'. If INTERACTIVE-P
+is non-nil, call the dynamic block function interactively."
(interactive (list (completing-read "Dynamic block: "
- (org-dynamic-block-types))))
+ (org-dynamic-block-types))
+ t))
(pcase (org-dynamic-block-function type)
(`nil (error "No such dynamic block: %S" type))
- ((and f (pred functionp)) (funcall f))
+ ((and f (pred functionp))
+ (if interactive-p (call-interactively f) (funcall f)))
(_ (error "Invalid function for dynamic block %S" type))))
(defun org-dblock-update (&optional arg)
@@ -9764,8 +9325,7 @@ block can be inserted by pressing TAB after the string \"<KEY\"."
(defun org--check-org-structure-template-alist (&optional checklist)
"Check whether `org-structure-template-alist' is set up correctly.
In particular, check if the Org 9.2 format is used as opposed to
-previous format.
-"
+previous format."
(let ((elm (cl-remove-if-not (lambda (x) (listp (cdr x)))
(or (eval checklist)
org-structure-template-alist))))
@@ -10040,9 +9600,9 @@ When called through ELisp, arg is also interpreted in the following way:
'region-start-level 'region))
org-loop-over-headlines-in-active-region)
(org-map-entries
- `(org-todo ,arg)
- org-loop-over-headlines-in-active-region
- cl (when (org-invisible-p) (org-end-of-subtree nil t))))
+ (lambda () (org-todo arg))
+ nil cl
+ (when (org-invisible-p) (org-end-of-subtree nil t))))
(when (equal arg '(16)) (setq arg 'nextset))
(when (equal arg -1) (org-cancel-repeater) (setq arg nil))
(let ((org-blocker-hook org-blocker-hook)
@@ -10159,7 +9719,7 @@ When called through ELisp, arg is also interpreted in the following way:
(throw 'exit nil)))))
(store-match-data match-data)
(replace-match next t t)
- (cond ((equal this org-state)
+ (cond ((and org-state (equal this org-state))
(message "TODO state was already %s" (org-trim next)))
((not (pos-visible-in-window-p hl-pos))
(message "TODO state changed to %s" (org-trim next))))
@@ -10535,8 +10095,7 @@ when there is a statistics cookie in the headline!
(defun org-summary-todo (n-done n-not-done)
\"Switch entry to DONE when all subentries are done, to TODO otherwise.\"
(let (org-log-done org-log-states) ; turn off logging
- (org-todo (if (= n-not-done 0) \"DONE\" \"TODO\"))))
-")
+ (org-todo (if (= n-not-done 0) \"DONE\" \"TODO\"))))")
(defvar org-todo-statistics-hook nil
"Hook that is run whenever Org thinks TODO statistics should be updated.
@@ -10825,9 +10384,13 @@ This function is run automatically after each state change to a DONE state."
(repeater-type (match-string 1 ts)))
(cond
((equal "." repeater-type)
- ;; Shift starting date to today.
- (org-timestamp-change (- (org-today) (time-to-days time))
- 'day))
+ ;; Shift starting date to today, or now if
+ ;; repeater is by hours.
+ (if (equal what "h")
+ (org-timestamp-change
+ (floor (- (org-time-stamp-to-now ts t)) 60) 'minute)
+ (org-timestamp-change
+ (- (org-today) (time-to-days time)) 'day)))
((equal "+" repeater-type)
(let ((nshiftmax 10)
(nshift 0))
@@ -10966,7 +10529,11 @@ TYPE is either `deadline' or `scheduled'. See `org-deadline' or
org-last-inserted-timestamp)))))
(defun org-deadline (arg &optional time)
- "Insert the \"DEADLINE:\" string with a timestamp to make a deadline.
+ "Insert a \"DEADLINE:\" string with a timestamp to make a deadline.
+
+When called interactively, this command pops up the Emacs calendar to let
+the user select a date.
+
With one universal prefix argument, remove any deadline from the item.
With two universal prefix arguments, prompt for a warning delay.
With argument TIME, set the deadline at the corresponding date. TIME
@@ -10983,7 +10550,11 @@ can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
(org--deadline-or-schedule arg 'deadline time)))
(defun org-schedule (arg &optional time)
- "Insert the SCHEDULED: string with a timestamp to schedule a TODO item.
+ "Insert a \"SCHEDULED:\" string with a timestamp to schedule an item.
+
+When called interactively, this command pops up the Emacs calendar to let
+the user select a date.
+
With one universal prefix argument, remove any scheduling date from the item.
With two universal prefix arguments, prompt for a delay cookie.
With argument TIME, scheduled at the corresponding date. TIME can
@@ -11058,97 +10629,100 @@ the time to use. If none is given, the user is prompted for
a date. REMOVE indicates what kind of entries to remove. An old
WHAT entry will also be removed."
(let (org-time-was-given org-end-time-was-given default-time default-input)
- (catch 'exit
- (when (and (memq what '(scheduled deadline))
- (or (not time)
- (and (stringp time)
- (string-match "^[-+]+[0-9]" time))))
- ;; Try to get a default date/time from existing timestamp
- (save-excursion
- (org-back-to-heading t)
- (let ((end (save-excursion (outline-next-heading) (point))) ts)
- (when (re-search-forward (if (eq what 'scheduled)
- org-scheduled-time-regexp
- org-deadline-time-regexp)
- end t)
- (setq ts (match-string 1)
- default-time (org-time-string-to-time ts)
- default-input (and ts (org-get-compact-tod ts)))))))
- (when what
- (setq time
- (if (stringp time)
- ;; This is a string (relative or absolute), set
- ;; proper date.
- (apply #'encode-time
- (org-read-date-analyze
- time default-time (decode-time default-time)))
- ;; If necessary, get the time from the user
- (or time (org-read-date nil 'to-time nil
- (cl-case what
- (deadline "DEADLINE")
- (scheduled "SCHEDULED")
- (otherwise nil))
- default-time default-input)))))
- (org-with-wide-buffer
- (org-back-to-heading t)
- (forward-line)
- (unless (bolp) (insert "\n"))
- (cond ((looking-at-p org-planning-line-re)
- ;; Move to current indentation.
- (skip-chars-forward " \t")
- ;; Check if we have to remove something.
- (dolist (type (if what (cons what remove) remove))
- (save-excursion
- (when (re-search-forward
- (cl-case type
- (closed org-closed-time-regexp)
- (deadline org-deadline-time-regexp)
- (scheduled org-scheduled-time-regexp)
- (otherwise
- (error "Invalid planning type: %s" type)))
- (line-end-position) t)
- ;; Delete until next keyword or end of line.
- (delete-region
- (match-beginning 0)
- (if (re-search-forward org-keyword-time-not-clock-regexp
- (line-end-position)
- t)
- (match-beginning 0)
- (line-end-position))))))
- ;; If there is nothing more to add and no more keyword
- ;; is left, remove the line completely.
- (if (and (looking-at-p "[ \t]*$") (not what))
- (delete-region (line-beginning-position)
- (line-beginning-position 2))
- ;; If we removed last keyword, do not leave trailing
- ;; white space at the end of line.
- (let ((p (point)))
- (save-excursion
- (end-of-line)
- (unless (= (skip-chars-backward " \t" p) 0)
- (delete-region (point) (line-end-position)))))))
- ((not what) (throw 'exit nil)) ; Nothing to do.
- (t (insert-before-markers "\n")
- (backward-char 1)
- (when org-adapt-indentation
- (indent-to-column (1+ (org-outline-level))))))
- (when what
- ;; Insert planning keyword.
- (insert (cl-case what
- (closed org-closed-string)
- (deadline org-deadline-string)
- (scheduled org-scheduled-string)
- (otherwise (error "Invalid planning type: %s" what)))
- " ")
- ;; Insert associated timestamp.
- (let ((ts (org-insert-time-stamp
- time
- (or org-time-was-given
- (and (eq what 'closed) org-log-done-with-time))
- (eq what 'closed)
- nil nil (list org-end-time-was-given))))
- (unless (eolp) (insert " "))
- ts))))))
+ (when (and (memq what '(scheduled deadline))
+ (or (not time)
+ (and (stringp time)
+ (string-match "^[-+]+[0-9]" time))))
+ ;; Try to get a default date/time from existing timestamp
+ (save-excursion
+ (org-back-to-heading t)
+ (let ((end (save-excursion (outline-next-heading) (point))) ts)
+ (when (re-search-forward (if (eq what 'scheduled)
+ org-scheduled-time-regexp
+ org-deadline-time-regexp)
+ end t)
+ (setq ts (match-string 1)
+ default-time (org-time-string-to-time ts)
+ default-input (and ts (org-get-compact-tod ts)))))))
+ (when what
+ (setq time
+ (if (stringp time)
+ ;; This is a string (relative or absolute), set
+ ;; proper date.
+ (apply #'encode-time
+ (org-read-date-analyze
+ time default-time (decode-time default-time)))
+ ;; If necessary, get the time from the user
+ (or time (org-read-date nil 'to-time nil
+ (cl-case what
+ (deadline "DEADLINE")
+ (scheduled "SCHEDULED")
+ (otherwise nil))
+ default-time default-input)))))
+ (org-with-wide-buffer
+ (org-back-to-heading t)
+ (let ((planning? (save-excursion
+ (forward-line)
+ (looking-at-p org-planning-line-re))))
+ (cond
+ (planning?
+ (forward-line)
+ ;; Move to current indentation.
+ (skip-chars-forward " \t")
+ ;; Check if we have to remove something.
+ (dolist (type (if what (cons what remove) remove))
+ (save-excursion
+ (when (re-search-forward
+ (cl-case type
+ (closed org-closed-time-regexp)
+ (deadline org-deadline-time-regexp)
+ (scheduled org-scheduled-time-regexp)
+ (otherwise (error "Invalid planning type: %s" type)))
+ (line-end-position)
+ t)
+ ;; Delete until next keyword or end of line.
+ (delete-region
+ (match-beginning 0)
+ (if (re-search-forward org-keyword-time-not-clock-regexp
+ (line-end-position)
+ t)
+ (match-beginning 0)
+ (line-end-position))))))
+ ;; If there is nothing more to add and no more keyword is
+ ;; left, remove the line completely.
+ (if (and (looking-at-p "[ \t]*$") (not what))
+ (delete-region (line-end-position 0)
+ (line-end-position))
+ ;; If we removed last keyword, do not leave trailing white
+ ;; space at the end of line.
+ (let ((p (point)))
+ (save-excursion
+ (end-of-line)
+ (unless (= (skip-chars-backward " \t" p) 0)
+ (delete-region (point) (line-end-position)))))))
+ (what
+ (end-of-line)
+ (insert "\n")
+ (when org-adapt-indentation
+ (indent-to-column (1+ (org-outline-level)))))
+ (t nil)))
+ (when what
+ ;; Insert planning keyword.
+ (insert (cl-case what
+ (closed org-closed-string)
+ (deadline org-deadline-string)
+ (scheduled org-scheduled-string)
+ (otherwise (error "Invalid planning type: %s" what)))
+ " ")
+ ;; Insert associated timestamp.
+ (let ((ts (org-insert-time-stamp
+ time
+ (or org-time-was-given
+ (and (eq what 'closed) org-log-done-with-time))
+ (eq what 'closed)
+ nil nil (list org-end-time-was-given))))
+ (unless (eolp) (insert " "))
+ ts)))))
(defvar org-log-note-marker (make-marker)
"Marker pointing at the entry where the note is to be inserted.")
@@ -11159,8 +10733,9 @@ WHAT entry will also be removed."
(defvar org-log-note-window-configuration nil)
(defvar org-log-note-return-to (make-marker))
(defvar org-log-note-effective-time nil
- "Remembered current time so that dynamically scoped
-`org-extend-today-until' affects timestamps in state change log")
+ "Remembered current time.
+So that dynamically scoped `org-extend-today-until' affects
+timestamps in state change log.")
(defvar org-log-post-message nil
"Message to be displayed after a log note has been stored.
@@ -11201,8 +10776,7 @@ narrowing."
(let ((beg (point)))
(insert ":" drawer ":\n:END:\n")
(org-indent-region beg (point))
- (org-flag-region
- (line-end-position -1) (1- (point)) t 'org-hide-drawer))
+ (org-flag-region (line-end-position -1) (1- (point)) t 'outline))
(end-of-line -1)))))
(t
(org-end-of-meta-data org-log-state-notes-insert-after-drawers)
@@ -11267,19 +10841,19 @@ EXTRA is additional text that will be inserted into the notes buffer."
(insert (format "# Insert note for %s.
# Finish with C-c C-c, or cancel with C-c C-k.\n\n"
(cl-case org-log-note-purpose
- (clock-out "stopped clock")
- (done "closed todo item")
- (reschedule "rescheduling")
- (delschedule "no longer scheduled")
- (redeadline "changing deadline")
- (deldeadline "removing deadline")
- (refile "refiling")
- (note "this entry")
- (state
- (format "state change from \"%s\" to \"%s\""
- (or org-log-note-previous-state "")
- (or org-log-note-state "")))
- (t (error "This should not happen")))))
+ (clock-out "stopped clock")
+ (done "closed todo item")
+ (reschedule "rescheduling")
+ (delschedule "no longer scheduled")
+ (redeadline "changing deadline")
+ (deldeadline "removing deadline")
+ (refile "refiling")
+ (note "this entry")
+ (state
+ (format "state change from \"%s\" to \"%s\""
+ (or org-log-note-previous-state "")
+ (or org-log-note-state "")))
+ (t (error "This should not happen")))))
(when org-log-note-extra (insert org-log-note-extra))
(setq-local org-finish-function 'org-store-log-note)
(run-hooks 'org-log-buffer-setup-hook)))
@@ -11460,7 +11034,7 @@ on `org-remove-highlights-with-change'), this variable is emptied
as well.")
(defun org-occur (regexp &optional keep-previous callback)
- "Make a compact tree which shows all matches of REGEXP.
+ "Make a compact tree showing all matches of REGEXP.
The tree will show the lines where the regexp matches, and any other context
defined in `org-show-context-detail', which see.
@@ -11554,10 +11128,13 @@ from the `before-change-functions' in the current buffer."
;;;; Priorities
-(defvar org-priority-regexp ".*?\\(\\[#\\([A-Z0-9]\\)\\] ?\\)"
- "Regular expression matching the priority indicator.")
-
-(defvar org-remove-priority-next-time nil)
+(defvar org-priority-regexp ".*?\\(\\[#\\([A-Z0-9]+\\)\\] ?\\)"
+ "Regular expression matching the priority indicator.
+A priority indicator can be e.g. [#A] or [#1].
+This regular expression matches these groups:
+0 : the whole match, e.g. \"TODO [#A] Hack\"
+1 : the priority cookie, e.g. \"[#A]\"
+2 : the value of the priority cookie, e.g. \"A\".")
(defun org-priority-up ()
"Increase the priority of the current item."
@@ -11583,16 +11160,18 @@ or a character."
;; passed the SHOW argument should be removed.
(warn "`org-priority' called with deprecated SHOW argument"))
(if (equal action '(4))
- (org-show-priority)
- (unless org-enable-priority-commands
+ (org-priority-show)
+ (unless org-priority-enable-commands
(user-error "Priority commands are disabled"))
(setq action (or action 'set))
- (let (current new news have remove)
+ (let ((nump (< org-priority-lowest 65))
+ current new news have remove)
(save-excursion
(org-back-to-heading t)
(when (looking-at org-priority-regexp)
- (setq current (string-to-char (match-string 2))
- have t))
+ (let ((ms (match-string 2)))
+ (setq current (org-priority-to-value ms)
+ have t)))
(cond
((eq action 'remove)
(setq remove t new ?\ ))
@@ -11600,49 +11179,61 @@ or a character."
(integerp action))
(if (not (eq action 'set))
(setq new action)
- (message "Priority %c-%c, SPC to remove: "
- org-highest-priority org-lowest-priority)
- (save-match-data
- (setq new (read-char-exclusive))))
- (when (and (= (upcase org-highest-priority) org-highest-priority)
- (= (upcase org-lowest-priority) org-lowest-priority))
+ (setq
+ new
+ (if nump
+ (string-to-number
+ (read-string (format "Priority %s-%s, SPC to remove: "
+ (number-to-string org-priority-highest)
+ (number-to-string org-priority-lowest))))
+ (progn (message "Priority %c-%c, SPC to remove: "
+ org-priority-highest org-priority-lowest)
+ (save-match-data
+ (setq new (read-char-exclusive)))))))
+ (when (and (= (upcase org-priority-highest) org-priority-highest)
+ (= (upcase org-priority-lowest) org-priority-lowest))
(setq new (upcase new)))
(cond ((equal new ?\s) (setq remove t))
- ((or (< (upcase new) org-highest-priority) (> (upcase new) org-lowest-priority))
- (user-error "Priority must be between `%c' and `%c'"
- org-highest-priority org-lowest-priority))))
+ ((or (< (upcase new) org-priority-highest) (> (upcase new) org-priority-lowest))
+ (user-error
+ (if nump
+ "Priority must be between `%s' and `%s'"
+ "Priority must be between `%c' and `%c'")
+ org-priority-highest org-priority-lowest))))
((eq action 'up)
(setq new (if have
(1- current) ; normal cycling
;; last priority was empty
(if (eq last-command this-command)
- org-lowest-priority ; wrap around empty to lowest
+ org-priority-lowest ; wrap around empty to lowest
;; default
(if org-priority-start-cycle-with-default
- org-default-priority
- (1- org-default-priority))))))
+ org-priority-default
+ (1- org-priority-default))))))
((eq action 'down)
(setq new (if have
(1+ current) ; normal cycling
;; last priority was empty
(if (eq last-command this-command)
- org-highest-priority ; wrap around empty to highest
+ org-priority-highest ; wrap around empty to highest
;; default
(if org-priority-start-cycle-with-default
- org-default-priority
- (1+ org-default-priority))))))
+ org-priority-default
+ (1+ org-priority-default))))))
(t (user-error "Invalid action")))
- (when (or (< (upcase new) org-highest-priority)
- (> (upcase new) org-lowest-priority))
+ (when (or (< (upcase new) org-priority-highest)
+ (> (upcase new) org-priority-lowest))
(if (and (memq action '(up down))
(not have) (not (eq last-command this-command)))
;; `new' is from default priority
(error
- "The default can not be set, see `org-default-priority' why")
+ "The default can not be set, see `org-priority-default' why")
;; normal cycling: `new' is beyond highest/lowest priority
;; and is wrapped around to the empty priority
(setq remove t)))
- (setq news (format "%c" new))
+ ;; Numerical priorities are limited to 64, beyond that number,
+ ;; assume the priority cookie is a character.
+ (setq news (if (> new 64) (format "%c" new) (format "%s" new)))
(if have
(if remove
(replace-match "" t t nil 1)
@@ -11661,7 +11252,8 @@ or a character."
(message "Priority removed")
(message "Priority of current item set to %s" news)))))
-(defun org-show-priority ()
+(defalias 'org-show-priority 'org-priority-show)
+(defun org-priority-show ()
"Show the priority of the current item.
This priority is composed of the main priority given with the [#A] cookies,
and by additional input from the age of a schedules or deadline entry."
@@ -11676,14 +11268,18 @@ and by additional input from the age of a schedules or deadline entry."
(message "Priority is %d" (if pri pri -1000))))
(defun org-get-priority (s)
- "Find priority cookie and return priority."
+ "Find priority cookie and return priority.
+S is a string against which you can match `org-priority-regexp'.
+If `org-priority-get-priority-function' is set to a custom
+function, use it. Otherwise process S and output the priority
+value, an integer."
(save-match-data
- (if (functionp org-get-priority-function)
- (funcall org-get-priority-function s)
+ (if (functionp org-priority-get-priority-function)
+ (funcall org-priority-get-priority-function s)
(if (not (string-match org-priority-regexp s))
- (* 1000 (- org-lowest-priority org-default-priority))
- (* 1000 (- org-lowest-priority
- (string-to-char (match-string 2 s))))))))
+ (* 1000 (- org-priority-lowest org-priority-default))
+ (* 1000 (- org-priority-lowest
+ (org-priority-to-value (match-string 2 s))))))))
;;;; Tags
@@ -11908,7 +11504,7 @@ are also TODO tasks."
(interactive "P")
(org-agenda-prepare-buffers (list (current-buffer)))
(let ((org--matcher-tags-todo-only todo-only))
- (org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match))
+ (org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match t))
org--matcher-tags-todo-only)))
(defalias 'org-tags-sparse-tree 'org-match-sparse-tree)
@@ -11949,7 +11545,7 @@ instead of the agenda files."
(if (car-safe files) files
(org-agenda-files))))))))
-(defun org-make-tags-matcher (match)
+(defun org-make-tags-matcher (match &optional only-local-tags)
"Create the TAGS/TODO matcher form for the selection string MATCH.
Returns a cons of the selection string MATCH and a function
@@ -11967,6 +11563,9 @@ This function sets the variable `org--matcher-tags-todo-only' to
a non-nil value if the matcher restricts matching to TODO
entries, otherwise it is not touched.
+When ONLY-LOCAL-TAGS is non-nil, ignore the global tag completion
+table, only get buffer tags.
+
See also `org-scan-tags'."
(unless match
;; Get a new match request, with completion against the global
@@ -11974,7 +11573,8 @@ See also `org-scan-tags'."
(let ((org-last-tags-completion-table
(org--tag-add-to-alist
(org-get-buffer-tags)
- (org-global-tags-completion-table))))
+ (unless only-local-tags
+ (org-global-tags-completion-table)))))
(setq match
(completing-read
"Match: "
@@ -12101,7 +11701,7 @@ See also `org-scan-tags'."
(cons match0 `(lambda (todo tags-list level) ,matcher)))))
(defun org--tags-expand-group (group tag-groups expanded)
- "Recursively Expand all tags in GROUP, according to TAG-GROUPS.
+ "Recursively expand all tags in GROUP, according to TAG-GROUPS.
TAG-GROUPS is the list of groups used for expansion. EXPANDED is
an accumulator used in recursive calls."
(dolist (tag group)
@@ -12149,7 +11749,9 @@ When DOWNCASED is non-nil, expand downcased TAGS."
(if (not downcased) g
(mapcar (lambda (s) (mapcar #'downcase s)) g)))))
(cond
- (single-as-list (org--tags-expand-group (list match) tag-groups nil))
+ (single-as-list (org--tags-expand-group
+ (list (if downcased (downcase match) match))
+ tag-groups nil))
(org-group-tags
(let* ((case-fold-search t)
(tag-syntax org-mode-syntax-table)
@@ -12332,7 +11934,12 @@ in Lisp code use `org-set-tags' instead."
#'org-tags-completion-function
nil nil (org-make-tag-string current-tags)
'org-tags-history)))))))
- (org-set-tags tags)))))))
+ (org-set-tags tags)))))
+ ;; `save-excursion' may not replace the point at the right
+ ;; position.
+ (when (and (save-excursion (skip-chars-backward "*") (bolp))
+ (looking-at-p " "))
+ (forward-char))))
(defun org-align-tags (&optional all)
"Align tags in current entry.
@@ -12713,7 +12320,8 @@ According to `org-use-tag-inheritance', tags may be inherited
from parent headlines, and from the whole document, through
`org-file-tags'. In this case, the returned list of tags
contains tags in this order: file tags, tags inherited from
-parent headlines, local tags.
+parent headlines, local tags. If a tag appears multiple times,
+only the most local tag is returned.
However, when optional argument LOCAL is non-nil, only return
tags specified at the headline.
@@ -12729,12 +12337,13 @@ Inherited tags have the `inherited' text property."
(let ((ltags (org--get-local-tags)) itags)
(if (or local (not org-use-tag-inheritance)) ltags
(while (org-up-heading-safe)
- (setq itags (append (mapcar #'org-add-prop-inherited
- (org--get-local-tags))
- itags)))
+ (setq itags (nconc (mapcar #'org-add-prop-inherited
+ (org--get-local-tags))
+ itags)))
(setq itags (append org-file-tags itags))
- (delete-dups
- (append (org-remove-uninherited-tags itags) ltags))))))))
+ (nreverse
+ (delete-dups
+ (nreverse (nconc (org-remove-uninherited-tags itags) ltags))))))))))
(defun org-get-buffer-tags ()
"Get a table of all tags used in the buffer, for completion."
@@ -12922,30 +12531,52 @@ Modifications are made by side-effect. Return new alist."
(defun org-get-property-block (&optional beg force)
"Return the (beg . end) range of the body of the property drawer.
-BEG is the beginning of the current subtree, or of the part
-before the first headline. If it is not given, it will be found.
-If the drawer does not exist, create it if FORCE is non-nil, or
-return nil."
+BEG is the beginning of the current subtree or the beginning of
+the document if before the first headline. If it is not given,
+it will be found. If the drawer does not exist, create it if
+FORCE is non-nil, or return nil."
(org-with-wide-buffer
- (when beg (goto-char beg))
- (unless (org-before-first-heading-p)
- (let ((beg (cond (beg)
+ (let ((beg (cond (beg (goto-char beg))
((or (not (featurep 'org-inlinetask))
(org-inlinetask-in-task-p))
- (org-back-to-heading t))
- (t (org-with-limited-levels (org-back-to-heading t))))))
- (forward-line)
- (when (looking-at-p org-planning-line-re) (forward-line))
- (cond ((looking-at org-property-drawer-re)
- (forward-line)
- (cons (point) (progn (goto-char (match-end 0))
- (line-beginning-position))))
- (force
- (goto-char beg)
- (org-insert-property-drawer)
- (let ((pos (save-excursion (search-forward ":END:")
- (line-beginning-position))))
- (cons pos pos))))))))
+ (org-back-to-heading-or-point-min t) (point))
+ (t (org-with-limited-levels
+ (org-back-to-heading-or-point-min t))
+ (point)))))
+ ;; Move point to its position according to its positional rules.
+ (cond ((org-before-first-heading-p)
+ (while (and (org-at-comment-p) (bolp)) (forward-line)))
+ (t (forward-line)
+ (when (looking-at-p org-planning-line-re) (forward-line))))
+ (cond ((looking-at org-property-drawer-re)
+ (forward-line)
+ (cons (point) (progn (goto-char (match-end 0))
+ (line-beginning-position))))
+ (force
+ (goto-char beg)
+ (org-insert-property-drawer)
+ (let ((pos (save-excursion (re-search-forward org-property-drawer-re)
+ (line-beginning-position))))
+ (cons pos pos)))))))
+
+(defun org-at-property-drawer-p ()
+ "Non-nil when point is at the first line of a property drawer."
+ (org-with-wide-buffer
+ (beginning-of-line)
+ (and (looking-at org-property-drawer-re)
+ (or (bobp)
+ (progn
+ (forward-line -1)
+ (cond ((org-at-heading-p))
+ ((looking-at org-planning-line-re)
+ (forward-line -1)
+ (org-at-heading-p))
+ ((looking-at org-comment-regexp)
+ (forward-line -1)
+ (while (and (not (bobp)) (looking-at org-comment-regexp))
+ (forward-line -1))
+ (looking-at org-comment-regexp))
+ (t nil)))))))
(defun org-at-property-p ()
"Non-nil when point is inside a property drawer.
@@ -13001,6 +12632,10 @@ variables is set."
(not (get-text-property 0 'org-unrestricted
(caar allowed))))))
(completing-read "Effort: " allowed nil must-match))))))
+ ;; Test whether the value can be interpreted as a duration before
+ ;; inserting it in the buffer:
+ (org-duration-to-minutes value)
+ ;; Maybe update the effort value:
(unless (equal current value)
(org-entry-put nil org-effort-property value))
(org-refresh-property '((effort . identity)
@@ -13030,7 +12665,7 @@ Return value is an alist. Keys are properties, as upcased
strings."
(org-with-point-at pom
(when (and (derived-mode-p 'org-mode)
- (ignore-errors (org-back-to-heading t)))
+ (org-back-to-heading-or-point-min t))
(catch 'exit
(let* ((beg (point))
(specific (and (stringp which) (upcase which)))
@@ -13073,7 +12708,7 @@ strings."
(push (cons "PRIORITY"
(if (looking-at org-priority-regexp)
(match-string-no-properties 2)
- (char-to-string org-default-priority)))
+ (char-to-string org-priority-default)))
props)
(when specific (throw 'exit props)))
(when (or (not specific) (string= specific "FILE"))
@@ -13239,13 +12874,13 @@ unless LITERAL-NIL is non-nil."
;; Return final values.
(and (not (equal value '(nil))) (nreverse value))))))
-(defun org--property-global-value (property literal-nil)
- "Return value for PROPERTY in current buffer.
+(defun org--property-global-or-keyword-value (property literal-nil)
+ "Return value for PROPERTY as defined by global properties or by keyword.
Return value is a string. Return nil if property is not set
-globally. Also return nil when PROPERTY is set to \"nil\",
-unless LITERAL-NIL is non-nil."
+globally or by keyword. Also return nil when PROPERTY is set to
+\"nil\", unless LITERAL-NIL is non-nil."
(let ((global
- (cdr (or (assoc-string property org-file-properties t)
+ (cdr (or (assoc-string property org-keyword-properties t)
(assoc-string property org-global-properties t)
(assoc-string property org-global-properties-fixed t)))))
(if literal-nil global (org-not-nil global))))
@@ -13394,12 +13029,12 @@ However, if LITERAL-NIL is set, return the string value \"nil\" instead."
value)))
(cond
((car v)
- (org-back-to-heading t)
+ (org-back-to-heading-or-point-min t)
(move-marker org-entry-property-inherited-from (point))
(throw 'exit nil))
- ((org-up-heading-safe))
+ ((org-up-heading-or-point-min))
(t
- (let ((global (org--property-global-value property literal-nil)))
+ (let ((global (org--property-global-or-keyword-value property literal-nil)))
(cond ((not global))
(value (setq value (concat global " " value)))
(t (setq value global))))
@@ -13431,8 +13066,8 @@ decreases scheduled or deadline date by one day."
(user-error "Invalid property name: \"%s\"" property)))
(org-with-point-at pom
(if (or (not (featurep 'org-inlinetask)) (org-inlinetask-in-task-p))
- (org-back-to-heading t)
- (org-with-limited-levels (org-back-to-heading t)))
+ (org-back-to-heading-or-point-min t)
+ (org-with-limited-levels (org-back-to-heading-or-point-min t)))
(let ((beg (point)))
(cond
((equal property "TODO")
@@ -13502,7 +13137,10 @@ COLUMN formats in the current buffer."
(props (append
(and specials org-special-properties)
(and defaults (cons org-effort-property org-default-properties))
- nil)))
+ ;; Get property names from #+PROPERTY keywords as well
+ (mapcar (lambda (s)
+ (nth 0 (split-string s)))
+ (cdar (org-collect-keywords '("PROPERTY")))))))
(org-with-wide-buffer
(goto-char (point-min))
(while (re-search-forward org-property-start-re nil t)
@@ -13550,7 +13188,15 @@ COLUMN formats in the current buffer."
(let ((p (match-string-no-properties 1 value)))
(unless (member-ignore-case p org-special-properties)
(push p props))))))))))
- (sort (delete-dups props) (lambda (a b) (string< (upcase a) (upcase b))))))
+ (sort (delete-dups
+ (append props
+ ;; for each xxx_ALL property, make sure the bare
+ ;; xxx property is also included
+ (delq nil (mapcar (lambda (p)
+ (and (string-match-p "._ALL\\'" p)
+ (substring p 0 -4)))
+ props))))
+ (lambda (a b) (string< (upcase a) (upcase b))))))
(defun org-property-values (key)
"List all non-nil values of property KEY in current buffer."
@@ -13568,21 +13214,26 @@ COLUMN formats in the current buffer."
Do nothing if the drawer already exists. The newly created
drawer is immediately hidden."
(org-with-wide-buffer
+ ;; Set point to the position where the drawer should be inserted.
(if (or (not (featurep 'org-inlinetask)) (org-inlinetask-in-task-p))
- (org-back-to-heading t)
- (org-with-limited-levels (org-back-to-heading t)))
- (forward-line)
- (when (looking-at-p org-planning-line-re) (forward-line))
+ (org-back-to-heading-or-point-min t)
+ (org-with-limited-levels (org-back-to-heading-or-point-min t)))
+ (if (org-before-first-heading-p)
+ (while (and (org-at-comment-p) (bolp)) (forward-line))
+ (progn
+ (forward-line)
+ (when (looking-at-p org-planning-line-re) (forward-line))))
(unless (looking-at-p org-property-drawer-re)
;; Make sure we start editing a line from current entry, not from
;; next one. It prevents extending text properties or overlays
;; belonging to the latter.
- (when (bolp) (backward-char))
- (let ((begin (1+ (point)))
+ (when (and (bolp) (> (point) (point-min))) (backward-char))
+ (let ((begin (if (bobp) (point) (1+ (point))))
(inhibit-read-only t))
- (insert "\n:PROPERTIES:\n:END:")
- (org-flag-drawer t nil (line-end-position 0) (point))
- (when (eobp) (insert "\n"))
+ (unless (bobp) (insert "\n"))
+ (insert ":PROPERTIES:\n:END:")
+ (org-flag-region (line-end-position 0) (point) t 'outline)
+ (when (or (eobp) (= begin (point-min))) (insert "\n"))
(org-indent-region begin (point))))))
(defun org-insert-drawer (&optional arg drawer)
@@ -13762,7 +13413,8 @@ part of the buffer."
(while (re-search-forward re nil t)
(when (if value (org-at-property-p)
(org-entry-get (point) property nil t))
- (throw 'exit (progn (org-back-to-heading t) (point)))))))))
+ (throw 'exit (progn (org-back-to-heading-or-point-min t)
+ (point)))))))))
(defun org-delete-property (property)
"In the current entry, delete PROPERTY."
@@ -13832,8 +13484,8 @@ completion."
(setq vals (org-with-point-at pom
(append org-todo-keywords-1 '("")))))
((equal property "PRIORITY")
- (let ((n org-lowest-priority))
- (while (>= n org-highest-priority)
+ (let ((n org-priority-lowest))
+ (while (>= n org-priority-highest)
(push (char-to-string n) vals)
(setq n (1- n)))))
((equal property "CATEGORY"))
@@ -13898,15 +13550,9 @@ completion."
(defun org-find-olp (path &optional this-buffer)
"Return a marker pointing to the entry at outline path OLP.
-If anything goes wrong, throw an error.
-You can wrap this call to catch the error like this:
-
- (condition-case msg
- (org-mobile-locate-entry (match-string 4))
- (error (nth 1 msg)))
-
-The return value will then be either a string with the error message,
-or a marker if everything is OK.
+If anything goes wrong, throw an error, and if you need to do
+something based on this error, you can catch it with
+`condition-case'.
If THIS-BUFFER is set, the outline path does not contain a file,
only headings."
@@ -14082,16 +13728,16 @@ non-nil."
(defun org-time-stamp-inactive (&optional arg)
"Insert an inactive time stamp.
-An inactive time stamp is enclosed in square brackets instead of angle
-brackets. It is inactive in the sense that it does not trigger agenda entries,
-does not link to the calendar and cannot be changed with the S-cursor keys.
-So these are more for recording a certain time/date.
+An inactive time stamp is enclosed in square brackets instead of
+angle brackets. It is inactive in the sense that it does not
+trigger agenda entries. So these are more for recording a
+certain time/date.
If the user specifies a time like HH:MM or if this command is called with
at least one prefix argument, the time stamp contains the date and the time.
Otherwise, only the date is included.
-When called with two universal prefix arguments, insert an active time stamp
+When called with two universal prefix arguments, insert an inactive time stamp
with the current time without prompting the user."
(interactive "P")
(org-time-stamp arg 'inactive))
@@ -14107,7 +13753,6 @@ with the current time without prompting the user."
(defvar org-overriding-default-time nil) ; dynamically scoped
(defvar org-read-date-overlay nil)
-(defvar org-dcst nil) ; dynamically scoped
(defvar org-read-date-history nil)
(defvar org-read-date-final-answer nil)
(defvar org-read-date-analyze-futurep nil)
@@ -14177,7 +13822,6 @@ user."
(if (equal org-with-time '(16))
'(0 0)
org-time-stamp-rounding-minutes))
- (org-dcst org-display-custom-times)
(ct (org-current-time))
(org-def (or org-overriding-default-time default-time ct))
(org-defdecode (decode-time org-def))
@@ -14296,7 +13940,7 @@ user."
" " (or org-ans1 org-ans2)))
(org-end-time-was-given nil)
(f (org-read-date-analyze ans org-def org-defdecode))
- (fmts (if org-dcst
+ (fmts (if org-display-custom-times
org-time-stamp-custom-formats
org-time-stamp-formats))
(fmt (if (or org-with-time
@@ -14962,7 +14606,7 @@ signaled."
(cdr errdata))))))))
(defun org-days-to-iso-week (days)
- "Return the iso week number."
+ "Return the ISO week number."
(require 'cal-iso)
(car (calendar-iso-from-absolute days)))
@@ -16042,7 +15686,7 @@ environment remains unintended."
;; Get indentation of next line unless at column 0.
(let ((ind (if (bolp) 0
(save-excursion
- (org-return-indent)
+ (org-return t)
(prog1 (current-indentation)
(when (progn (skip-chars-forward " \t") (eolp))
(delete-region beg (point)))))))
@@ -16087,7 +15731,10 @@ looks only before point, not after."
(catch 'exit
(let ((pos (point))
(dodollar (member "$" (plist-get org-format-latex-options :matchers)))
- (lim (save-excursion (org-backward-paragraph) (point)))
+ (lim (progn
+ (re-search-backward (concat "^\\(" paragraph-start "\\)") nil
+ 'move)
+ (point)))
dd-on str (start 0) m re)
(goto-char pos)
(when dodollar
@@ -16155,7 +15802,7 @@ BEG and END are buffer positions."
;; Emacs cannot overlay images from remote hosts. Create it in
;; `temporary-file-directory' instead.
(if (or (not file) (file-remote-p file))
- temporary-file-directory
+ temporary-file-directory
default-directory)
'overlays nil 'forbuffer org-preview-latex-default-process))))
@@ -16266,6 +15913,10 @@ Some of the options can be changed using the variable
(if (string= (match-string 0 value) "$$")
(insert "\\[" (substring value 2 -2) "\\]")
(insert "\\(" (substring value 1 -1) "\\)"))))
+ ((eq processing-type 'html)
+ (goto-char beg)
+ (delete-region beg end)
+ (insert (org-format-latex-as-html value)))
((assq processing-type org-preview-latex-process-alist)
;; Process to an image.
(cl-incf cnt)
@@ -16394,7 +16045,7 @@ inspection."
(write-region mathml nil mathml-file))
(when (called-interactively-p 'any)
(message mathml)))
- ((message "LaTeX to MathML conversion failed")
+ ((warn "LaTeX to MathML conversion failed")
(message shell-command-output)))
(delete-file tmp-in-file)
(when (file-exists-p tmp-out-file)
@@ -16431,6 +16082,14 @@ inspection."
;; Failed conversion. Return the LaTeX fragment verbatim
latex-frag)))
+(defun org-format-latex-as-html (latex-fragment)
+ "Convert LATEX-FRAGMENT to HTML.
+This uses `org-latex-to-html-convert-command', which see."
+ (let ((cmd (format-spec org-latex-to-html-convert-command
+ `((?i . ,latex-fragment)))))
+ (message "Running %s" cmd)
+ (shell-command-to-string cmd)))
+
(defun org--get-display-dpi ()
"Get the DPI of the display.
The function assumes that the display has the same pixel width in
@@ -16500,12 +16159,16 @@ a HTML file."
(setq bg (org-latex-color :background))
(setq bg (org-latex-color-format
(if (string= bg "Transparent") "white" bg))))
+ ;; Remove TeX \par at end of snippet to avoid trailing space.
+ (if (string-suffix-p string "\n")
+ (aset string (1- (length string)) ?%)
+ (setq string (concat string "%")))
(with-temp-file texfile
(insert latex-header)
(insert "\n\\begin{document}\n"
- "\\definecolor{fg}{rgb}{" fg "}\n"
- "\\definecolor{bg}{rgb}{" bg "}\n"
- "\n\\pagecolor{bg}\n"
+ "\\definecolor{fg}{rgb}{" fg "}%\n"
+ "\\definecolor{bg}{rgb}{" bg "}%\n"
+ "\n\\pagecolor{bg}%\n"
"\n{\\color{fg}\n"
string
"\n}\n"
@@ -16632,16 +16295,60 @@ INCLUDE-LINKED is passed to `org-display-inline-images'."
"No images to display inline")))))
(defun org-redisplay-inline-images ()
- "Refresh the display of inline images."
+ "Assure display of inline images and refresh them."
(interactive)
- (if (not org-inline-image-overlays)
- (org-toggle-inline-images)
- (org-toggle-inline-images)
+ (org-toggle-inline-images)
+ (unless org-inline-image-overlays
(org-toggle-inline-images)))
;; For without-x builds.
(declare-function image-refresh "image" (spec &optional frame))
+(defcustom org-display-remote-inline-images 'skip
+ "How to display remote inline images.
+Possible values of this option are:
+
+skip Don't display remote images.
+download Always download and display remote images.
+cache Display remote images, and open them in separate buffers
+ for caching. Silently update the image buffer when a file
+ change is detected."
+ :group 'org-appearance
+ :package-version '(Org . "9.4")
+ :type '(choice
+ (const :tag "Ignore remote images" skip)
+ (const :tag "Always display remote images" download)
+ (const :tag "Display and silently update remote images" cache))
+ :safe #'symbolp)
+
+(defun org--create-inline-image (file width)
+ "Create image located at FILE, or return nil.
+WIDTH is the width of the image. The image may not be created
+according to the value of `org-display-remote-inline-images'."
+ (let* ((remote? (file-remote-p file))
+ (file-or-data
+ (pcase org-display-remote-inline-images
+ ((guard (not remote?)) file)
+ (`download (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert-file-contents-literally file)
+ (buffer-string)))
+ (`cache (let ((revert-without-query '(".")))
+ (with-current-buffer (find-file-noselect file)
+ (buffer-string))))
+ (`skip nil)
+ (other
+ (message "Invalid value of `org-display-remote-inline-images': %S"
+ other)
+ nil))))
+ (when file-or-data
+ (create-image file-or-data
+ (and (image-type-available-p 'imagemagick)
+ width
+ 'imagemagick)
+ remote?
+ :width width))))
+
(defun org-display-inline-images (&optional include-linked refresh beg end)
"Display inline images.
@@ -16760,11 +16467,7 @@ buffer boundaries with possible narrowing."
'org-image-overlay)))
(if (and (car-safe old) refresh)
(image-refresh (overlay-get (cdr old) 'display))
- (let ((image (create-image file
- (and (image-type-available-p 'imagemagick)
- width 'imagemagick)
- nil
- :width width)))
+ (let ((image (org--create-inline-image file width)))
(when image
(let ((ov (make-overlay
(org-element-property :begin link)
@@ -16779,7 +16482,9 @@ buffer boundaries with possible narrowing."
(overlay-put
ov 'modification-hooks
(list 'org-display-inline-remove-overlay))
- (overlay-put ov 'keymap image-map)
+ (when (<= 26 emacs-major-version)
+ (cl-assert (boundp 'image-map))
+ (overlay-put ov 'keymap image-map))
(push ov org-inline-image-overlays))))))))))))))))
(defun org-display-inline-remove-overlay (ov after _beg _end &optional _len)
@@ -16866,7 +16571,7 @@ overwritten, and the table is not marked as requiring realignment."
(1+ org-self-insert-command-undo-counter))))))))
(defun org-check-before-invisible-edit (kind)
- "Check is editing if kind KIND would be dangerous with invisible text around.
+ "Check if editing kind KIND would be dangerous with invisible text around.
The detailed reaction depends on the user option `org-catch-invisible-edits'."
;; First, try to get out of here as quickly as possible, to reduce overhead
(when (and org-catch-invisible-edits
@@ -17026,7 +16731,7 @@ word constituents."
(defvar org-ctrl-c-ctrl-c-hook nil
"Hook for functions attaching themselves to `C-c C-c'.
-This can be used to add additional functionality to the C-c C-c
+This can be used to add additional functionality to the `C-c C-c'
key which executes context-dependent commands. This hook is run
before any other test, while `org-ctrl-c-ctrl-c-final-hook' is
run after the last test.
@@ -17039,7 +16744,7 @@ context is wrong, just do nothing and return nil.")
(defvar org-ctrl-c-ctrl-c-final-hook nil
"Hook for functions attaching themselves to `C-c C-c'.
-This can be used to add additional functionality to the C-c C-c
+This can be used to add additional functionality to the `C-c C-c'
key which executes context-dependent commands. This hook is run
after any other test, while `org-ctrl-c-ctrl-c-hook' is run
before the first test.
@@ -17404,13 +17109,15 @@ individual commands for more information."
(call-interactively (if org-edit-timestamp-down-means-later
'org-timestamp-down 'org-timestamp-up)))
((and (not (eq org-support-shift-select 'always))
- org-enable-priority-commands
+ org-priority-enable-commands
(org-at-heading-p))
(call-interactively 'org-priority-up))
((and (not org-support-shift-select) (org-at-item-p))
(call-interactively 'org-previous-item))
((org-clocktable-try-shift 'up arg))
- ((org-at-table-p) (org-table-move-cell-up))
+ ((and (not (eq org-support-shift-select 'always))
+ (org-at-table-p))
+ (org-table-move-cell-up))
((run-hook-with-args-until-success 'org-shiftup-final-hook))
(org-support-shift-select
(org-call-for-shift-select 'previous-line))
@@ -17430,13 +17137,15 @@ individual commands for more information."
(call-interactively (if org-edit-timestamp-down-means-later
'org-timestamp-up 'org-timestamp-down)))
((and (not (eq org-support-shift-select 'always))
- org-enable-priority-commands
+ org-priority-enable-commands
(org-at-heading-p))
(call-interactively 'org-priority-down))
((and (not org-support-shift-select) (org-at-item-p))
(call-interactively 'org-next-item))
((org-clocktable-try-shift 'down arg))
- ((org-at-table-p) (org-table-move-cell-down))
+ ((and (not (eq org-support-shift-select 'always))
+ (org-at-table-p))
+ (org-table-move-cell-down))
((run-hook-with-args-until-success 'org-shiftdown-final-hook))
(org-support-shift-select
(org-call-for-shift-select 'next-line))
@@ -17474,7 +17183,9 @@ This does one of the following:
(org-at-property-p))
(call-interactively 'org-property-next-allowed-value))
((org-clocktable-try-shift 'right arg))
- ((org-at-table-p) (org-table-move-cell-right))
+ ((and (not (eq org-support-shift-select 'always))
+ (org-at-table-p))
+ (org-table-move-cell-right))
((run-hook-with-args-until-success 'org-shiftright-final-hook))
(org-support-shift-select
(org-call-for-shift-select 'forward-char))
@@ -17512,7 +17223,9 @@ This does one of the following:
(org-at-property-p))
(call-interactively 'org-property-previous-allowed-value))
((org-clocktable-try-shift 'left arg))
- ((org-at-table-p) (org-table-move-cell-left))
+ ((and (not (eq org-support-shift-select 'always))
+ (org-at-table-p))
+ (org-table-move-cell-left))
((run-hook-with-args-until-success 'org-shiftleft-final-hook))
(org-support-shift-select
(org-call-for-shift-select 'backward-char))
@@ -17589,23 +17302,12 @@ this numeric value."
(org-increase-number-at-point (- (or inc 1))))
(defun org-ctrl-c-ret ()
- "Call `org-table-hline-and-move' or `org-insert-heading' dep. on context."
+ "Call `org-table-hline-and-move' or `org-insert-heading'."
(interactive)
(cond
((org-at-table-p) (call-interactively 'org-table-hline-and-move))
(t (call-interactively 'org-insert-heading))))
-(defun org-find-visible ()
- (let ((s (point)))
- (while (and (not (= (point-max) (setq s (next-overlay-change s))))
- (get-char-property s 'invisible)))
- s))
-(defun org-find-invisible ()
- (let ((s (point)))
- (while (and (not (= (point-max) (setq s (next-overlay-change s))))
- (not (get-char-property s 'invisible))))
- s))
-
(defun org-copy-visible (beg end)
"Copy the visible parts of the region."
(interactive "r")
@@ -17713,6 +17415,7 @@ Otherwise, return a user error."
(pcase (org-element-type context)
(`footnote-reference (org-edit-footnote-reference))
(`inline-src-block (org-edit-inline-src-code))
+ (`latex-fragment (org-edit-latex-fragment))
(`timestamp (if (eq 'inactive (org-element-property :type context))
(call-interactively #'org-time-stamp-inactive)
(call-interactively #'org-time-stamp)))
@@ -17724,14 +17427,19 @@ Otherwise, return a user error."
This command does many different things, depending on context:
+- If column view is active, in agenda or org buffers, quit it.
+
+- If there are highlights, remove them.
+
- If a function in `org-ctrl-c-ctrl-c-hook' recognizes this location,
this is what we do.
- If the cursor is on a statistics cookie, update it.
-- If the cursor is in a headline, prompt for tags and insert them
- into the current line, aligned to `org-tags-column'. When called
- with prefix arg, realign all tags in the current buffer.
+- If the cursor is in a headline, in an agenda or an org buffer,
+ prompt for tags and insert them into the current line, aligned
+ to `org-tags-column'. When called with prefix arg, realign all
+ tags in the current buffer.
- If the cursor is in one of the special #+KEYWORD lines, this
triggers scanning the buffer for these lines and updating the
@@ -17765,6 +17473,7 @@ This command does many different things, depending on context:
inhibited by setting `org-babel-no-eval-on-ctrl-c-ctrl-c'."
(interactive "P")
(cond
+ ((bound-and-true-p org-columns-overlays) (org-columns-quit))
((or (bound-and-true-p org-clock-overlays) org-occur-highlights)
(when (boundp 'org-clock-overlays) (org-clock-remove-overlays))
(org-remove-occur-highlights)
@@ -17786,6 +17495,7 @@ This command does many different things, depending on context:
src-block statistics-cookie table table-cell table-row
timestamp)
t))
+ (radio-list-p (org-at-radio-list-p))
(type (org-element-type context)))
;; For convenience: at the first line of a paragraph on the same
;; line as an item, apply function on that item instead.
@@ -17832,39 +17542,81 @@ This command does many different things, depending on context:
;; unconditionally, whereas `C-u' will toggle its presence.
;; Without a universal argument, if the item has a checkbox,
;; toggle it. Otherwise repair the list.
- (let* ((box (org-element-property :checkbox context))
- (struct (org-element-property :structure context))
- (old-struct (copy-tree struct))
- (parents (org-list-parents-alist struct))
- (prevs (org-list-prevs-alist struct))
- (orderedp (org-not-nil (org-entry-get nil "ORDERED"))))
- (org-list-set-checkbox
- (org-element-property :begin context) struct
- (cond ((equal arg '(16)) "[-]")
- ((and (not box) (equal arg '(4))) "[ ]")
- ((or (not box) (equal arg '(4))) nil)
- ((eq box 'on) "[ ]")
- (t "[X]")))
- ;; Mimic `org-list-write-struct' but with grabbing a return
- ;; value from `org-list-struct-fix-box'.
- (org-list-struct-fix-ind struct parents 2)
- (org-list-struct-fix-item-end struct)
- (org-list-struct-fix-bul struct prevs)
- (org-list-struct-fix-ind struct parents)
- (let ((block-item
- (org-list-struct-fix-box struct parents prevs orderedp)))
- (if (and box (equal struct old-struct))
- (if (equal arg '(16))
- (message "Checkboxes already reset")
- (user-error "Cannot toggle this checkbox: %s"
- (if (eq box 'on)
- "all subitems checked"
- "unchecked subitems")))
- (org-list-struct-apply-struct struct old-struct)
- (org-update-checkbox-count-maybe))
- (when block-item
- (message "Checkboxes were removed due to empty box at line %d"
- (org-current-line block-item))))))
+ (if (or radio-list-p
+ (and (boundp org-list-checkbox-radio-mode)
+ org-list-checkbox-radio-mode))
+ (org-toggle-radio-button arg)
+ (let* ((box (org-element-property :checkbox context))
+ (struct (org-element-property :structure context))
+ (old-struct (copy-tree struct))
+ (parents (org-list-parents-alist struct))
+ (prevs (org-list-prevs-alist struct))
+ (orderedp (org-not-nil (org-entry-get nil "ORDERED"))))
+ (org-list-set-checkbox
+ (org-element-property :begin context) struct
+ (cond ((equal arg '(16)) "[-]")
+ ((and (not box) (equal arg '(4))) "[ ]")
+ ((or (not box) (equal arg '(4))) nil)
+ ((eq box 'on) "[ ]")
+ (t "[X]")))
+ ;; Mimic `org-list-write-struct' but with grabbing a return
+ ;; value from `org-list-struct-fix-box'.
+ (org-list-struct-fix-ind struct parents 2)
+ (org-list-struct-fix-item-end struct)
+ (org-list-struct-fix-bul struct prevs)
+ (org-list-struct-fix-ind struct parents)
+ (let ((block-item
+ (org-list-struct-fix-box struct parents prevs orderedp)))
+ (if (and box (equal struct old-struct))
+ (if (equal arg '(16))
+ (message "Checkboxes already reset")
+ (user-error "Cannot toggle this checkbox: %s"
+ (if (eq box 'on)
+ "all subitems checked"
+ "unchecked subitems")))
+ (org-list-struct-apply-struct struct old-struct)
+ (org-update-checkbox-count-maybe))
+ (when block-item
+ (message "Checkboxes were removed due to empty box at line %d"
+ (org-current-line block-item)))))))
+ (`plain-list
+ ;; At a plain list, with a double C-u argument, set
+ ;; checkboxes of each item to "[-]", whereas a single one
+ ;; will toggle their presence according to the state of the
+ ;; first item in the list. Without an argument, repair the
+ ;; list.
+ (if (or radio-list-p
+ (and (boundp org-list-checkbox-radio-mode)
+ org-list-checkbox-radio-mode))
+ (org-toggle-radio-button arg)
+ (let* ((begin (org-element-property :contents-begin context))
+ (struct (org-element-property :structure context))
+ (old-struct (copy-tree struct))
+ (first-box (save-excursion
+ (goto-char begin)
+ (looking-at org-list-full-item-re)
+ (match-string-no-properties 3)))
+ (new-box (cond ((equal arg '(16)) "[-]")
+ ((equal arg '(4)) (unless first-box "[ ]"))
+ ((equal first-box "[X]") "[ ]")
+ (t "[X]"))))
+ (cond
+ (arg
+ (dolist (pos
+ (org-list-get-all-items
+ begin struct (org-list-prevs-alist struct)))
+ (org-list-set-checkbox pos struct new-box)))
+ ((and first-box (eq (point) begin))
+ ;; For convenience, when point is at bol on the first
+ ;; item of the list and no argument is provided, simply
+ ;; toggle checkbox of that item, if any.
+ (org-list-set-checkbox begin struct new-box)))
+ (when (equal
+ (org-list-write-struct
+ struct (org-list-parents-alist struct) old-struct)
+ old-struct)
+ (message "Cannot update this checkbox"))
+ (org-update-checkbox-count-maybe))))
(`keyword
(let ((org-inhibit-startup-visibility-stuff t)
(org-startup-align-all-tables nil))
@@ -17873,40 +17625,6 @@ This command does many different things, depending on context:
(setq org-table-coordinate-overlays nil))
(org-save-outline-visibility 'use-markers (org-mode-restart)))
(message "Local setup has been refreshed"))
- (`plain-list
- ;; At a plain list, with a double C-u argument, set
- ;; checkboxes of each item to "[-]", whereas a single one
- ;; will toggle their presence according to the state of the
- ;; first item in the list. Without an argument, repair the
- ;; list.
- (let* ((begin (org-element-property :contents-begin context))
- (struct (org-element-property :structure context))
- (old-struct (copy-tree struct))
- (first-box (save-excursion
- (goto-char begin)
- (looking-at org-list-full-item-re)
- (match-string-no-properties 3)))
- (new-box (cond ((equal arg '(16)) "[-]")
- ((equal arg '(4)) (unless first-box "[ ]"))
- ((equal first-box "[X]") "[ ]")
- (t "[X]"))))
- (cond
- (arg
- (dolist (pos
- (org-list-get-all-items
- begin struct (org-list-prevs-alist struct)))
- (org-list-set-checkbox pos struct new-box)))
- ((and first-box (eq (point) begin))
- ;; For convenience, when point is at bol on the first
- ;; item of the list and no argument is provided, simply
- ;; toggle checkbox of that item, if any.
- (org-list-set-checkbox begin struct new-box)))
- (when (equal
- (org-list-write-struct
- struct (org-list-parents-alist struct) old-struct)
- old-struct)
- (message "Cannot update this checkbox"))
- (org-update-checkbox-count-maybe)))
((or `property-drawer `node-property)
(call-interactively #'org-property-action))
(`radio-target
@@ -17950,6 +17668,7 @@ Use `\\[org-edit-special]' to edit table.el tables"))
"`\\[org-ctrl-c-ctrl-c]' can do nothing useful here"))))))))
(defun org-mode-restart ()
+"Restart `org-mode'."
(interactive)
(let ((indent-status (bound-and-true-p org-indent-mode)))
(funcall major-mode)
@@ -17981,13 +17700,17 @@ Move point to the beginning of first heading or end of buffer."
(defun org-kill-note-or-show-branches ()
"Abort storing current note, or show just branches."
(interactive)
- (if org-finish-function
- (let ((org-note-abort t))
- (funcall org-finish-function))
- (if (org-before-first-heading-p)
- (org-show-branches-buffer)
- (outline-hide-subtree)
- (outline-show-branches))))
+ (cond (org-finish-function
+ (let ((org-note-abort t)) (funcall org-finish-function)))
+ ((org-before-first-heading-p)
+ (org-show-branches-buffer)
+ (org-hide-archived-subtrees (point-min) (point-max)))
+ (t
+ (let ((beg (progn (org-back-to-heading) (point)))
+ (end (save-excursion (org-end-of-subtree t t) (point))))
+ (outline-hide-subtree)
+ (outline-show-branches)
+ (org-hide-archived-subtrees beg end)))))
(defun org-delete-indentation (&optional arg)
"Join current line to previous and fix whitespace at join.
@@ -17995,7 +17718,9 @@ Move point to the beginning of first heading or end of buffer."
If previous line is a headline add to headline title. Otherwise
the function calls `delete-indentation'.
-With a non-nil optional argument, join it to the following one."
+I.e. with a non-nil optional argument, join the line with the
+following one. If there is a region then join the lines in that
+region."
(interactive "*P")
(if (save-excursion
(beginning-of-line (if arg 1 0))
@@ -18020,7 +17745,8 @@ With a non-nil optional argument, join it to the following one."
((not tags-column)) ;no tags
(org-auto-align-tags (org-align-tags))
(t (org--align-tags-here tags-column)))) ;preserve tags column
- (delete-indentation arg)))
+ (let ((current-prefix-arg arg))
+ (call-interactively #'delete-indentation))))
(defun org-open-line (n)
"Insert a new row in tables, call `open-line' elsewhere.
@@ -18032,20 +17758,31 @@ call `open-line' on the very first character."
(org-table-insert-row)
(open-line n)))
-(defun org-return (&optional indent)
+(defun org--newline (indent arg interactive)
+ "Call `newline-and-indent' or just `newline'.
+If INDENT is non-nil, call `newline-and-indent' with ARG to
+indent unconditionally; otherwise, call `newline' with ARG and
+INTERACTIVE, which can trigger indentation if
+`electric-indent-mode' is enabled."
+ (if indent
+ (org-newline-and-indent arg)
+ (newline arg interactive)))
+
+(defun org-return (&optional indent arg interactive)
"Goto next table row or insert a newline.
Calls `org-table-next-row' or `newline', depending on context.
When optional INDENT argument is non-nil, call
-`newline-and-indent' instead of `newline'.
+`newline-and-indent' with ARG, otherwise call `newline' with ARG
+and INTERACTIVE.
When `org-return-follows-link' is non-nil and point is on
a timestamp or a link, call `org-open-at-point'. However, it
will not happen if point is in a table or on a \"dead\"
object (e.g., within a comment). In these case, you need to use
`org-open-at-point' directly."
- (interactive)
+ (interactive "i\nP\np")
(let ((context (if org-return-follows-link (org-element-context)
(org-element-at-point))))
(cond
@@ -18096,45 +17833,47 @@ object (e.g., within a comment). In these case, you need to use
(t (org--align-tags-here tags-column))) ;preserve tags column
(end-of-line)
(org-show-entry)
- (if indent (newline-and-indent) (newline))
+ (org--newline indent arg interactive)
(when string (save-excursion (insert (org-trim string))))))
;; In a list, make sure indenting keeps trailing text within.
- ((and indent
- (not (eolp))
+ ((and (not (eolp))
(org-element-lineage context '(item)))
(let ((trailing-data
(delete-and-extract-region (point) (line-end-position))))
- (newline-and-indent)
+ (org--newline indent arg interactive)
(save-excursion (insert trailing-data))))
(t
;; Do not auto-fill when point is in an Org property drawer.
(let ((auto-fill-function (and (not (org-at-property-p))
auto-fill-function)))
- (if indent
- (newline-and-indent)
- (newline)))))))
+ (org--newline indent arg interactive))))))
-(defun org-return-indent ()
- "Goto next table row or insert a newline and indent.
-Calls `org-table-next-row' or `newline-and-indent', depending on
-context. See the individual commands for more information."
+(defun org-return-and-maybe-indent ()
+ "Goto next table row, or insert a newline.
+Call `org-table-next-row' or `org-return', depending on context.
+See the individual commands for more information.
+
+When inserting a newline, indent the new line if
+`electric-indent-mode' is disabled."
(interactive)
- (org-return t))
+ (org-return (not electric-indent-mode)))
(defun org-ctrl-c-tab (&optional arg)
"Toggle columns width in a table, or show children.
Call `org-table-toggle-column-width' if point is in a table.
-Otherwise, call `org-show-children'. ARG is the level to hide."
+Otherwise provide a compact view of the children. ARG is the
+level to hide."
(interactive "p")
- (if (org-at-table-p)
- (call-interactively #'org-table-toggle-column-width)
- (if (org-before-first-heading-p)
- (progn
- (org-flag-above-first-heading)
- (outline-hide-sublevels (or arg 1))
- (goto-char (point-min)))
- (outline-hide-subtree)
- (org-show-children arg))))
+ (cond
+ ((org-at-table-p)
+ (call-interactively #'org-table-toggle-column-width))
+ ((org-before-first-heading-p)
+ (save-excursion
+ (org-flag-above-first-heading)
+ (outline-hide-sublevels (or arg 1))))
+ (t
+ (outline-hide-subtree)
+ (org-show-children arg))))
(defun org-ctrl-c-star ()
"Compute table, or change heading status of lines.
@@ -18278,79 +18017,14 @@ an argument, unconditionally call `org-insert-heading'."
(t #'org-insert-heading)))))
;;; Menu entries
-
(defsubst org-in-subtree-not-table-p ()
"Are we in a subtree and not in a table?"
(and (not (org-before-first-heading-p))
(not (org-at-table-p))))
;; Define the Org mode menus
-(easy-menu-define org-tbl-menu org-mode-map "Tbl menu"
- '("Tbl"
- ["Align" org-ctrl-c-ctrl-c :active (org-at-table-p)]
- ["Next Field" org-cycle (org-at-table-p)]
- ["Previous Field" org-shifttab (org-at-table-p)]
- ["Next Row" org-return (org-at-table-p)]
- "--"
- ["Blank Field" org-table-blank-field (org-at-table-p)]
- ["Edit Field" org-table-edit-field (org-at-table-p)]
- ["Copy Field from Above" org-table-copy-down (org-at-table-p)]
- "--"
- ("Column"
- ["Move Column Left" org-metaleft (org-at-table-p)]
- ["Move Column Right" org-metaright (org-at-table-p)]
- ["Delete Column" org-shiftmetaleft (org-at-table-p)]
- ["Insert Column" org-shiftmetaright (org-at-table-p)]
- ["Shrink Column" org-table-toggle-column-width (org-at-table-p)])
- ("Row"
- ["Move Row Up" org-metaup (org-at-table-p)]
- ["Move Row Down" org-metadown (org-at-table-p)]
- ["Delete Row" org-shiftmetaup (org-at-table-p)]
- ["Insert Row" org-shiftmetadown (org-at-table-p)]
- ["Sort lines in region" org-table-sort-lines (org-at-table-p)]
- "--"
- ["Insert Hline" org-ctrl-c-minus (org-at-table-p)])
- ("Rectangle"
- ["Copy Rectangle" org-copy-special (org-at-table-p)]
- ["Cut Rectangle" org-cut-special (org-at-table-p)]
- ["Paste Rectangle" org-paste-special (org-at-table-p)]
- ["Fill Rectangle" org-table-wrap-region (org-at-table-p)])
- "--"
- ("Calculate"
- ["Set Column Formula" org-table-eval-formula (org-at-table-p)]
- ["Set Field Formula" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="]
- ["Edit Formulas" org-edit-special (org-at-table-p)]
- "--"
- ["Recalculate line" org-table-recalculate (org-at-table-p)]
- ["Recalculate all" (lambda () (interactive) (org-table-recalculate '(4))) :active (org-at-table-p) :keys "C-u C-c *"]
- ["Iterate all" (lambda () (interactive) (org-table-recalculate '(16))) :active (org-at-table-p) :keys "C-u C-u C-c *"]
- "--"
- ["Toggle Recalculate Mark" org-table-rotate-recalc-marks (org-at-table-p)]
- "--"
- ["Sum Column/Rectangle" org-table-sum
- (or (org-at-table-p) (org-region-active-p))]
- ["Which Column?" org-table-current-column (org-at-table-p)])
- ["Debug Formulas"
- org-table-toggle-formula-debugger
- :style toggle :selected (bound-and-true-p org-table-formula-debug)]
- ["Show Col/Row Numbers"
- org-table-toggle-coordinate-overlays
- :style toggle
- :selected (bound-and-true-p org-table-overlay-coordinates)]
- "--"
- ["Create" org-table-create (not (org-at-table-p))]
- ["Convert Region" org-table-convert-region (not (org-at-table-p 'any))]
- ["Import from File" org-table-import (not (org-at-table-p))]
- ["Export to File" org-table-export (org-at-table-p)]
- "--"
- ["Create/Convert from/to table.el" org-table-create-with-table.el t]
- "--"
- ("Plot"
- ["Ascii plot" orgtbl-ascii-plot :active (org-at-table-p) :keys "C-c \" a"]
- ["Gnuplot" org-plot/gnuplot :active (org-at-table-p) :keys "C-c \" g"])))
-
(easy-menu-define org-org-menu org-mode-map "Org menu"
- '("Org"
+ `("Org"
("Show/Hide"
["Cycle Visibility" org-cycle :active (or (bobp) (outline-on-heading-p))]
["Cycle Global Visibility" org-shifttab :active (not (org-at-table-p))]
@@ -18370,8 +18044,6 @@ an argument, unconditionally call `org-insert-heading'."
"--"
["Jump" org-goto t])
("Edit Structure"
- ["Refile Subtree" org-refile (org-in-subtree-not-table-p)]
- "--"
["Move Subtree Up" org-metaup (org-at-heading-p)]
["Move Subtree Down" org-metadown (org-at-heading-p)]
"--"
@@ -18394,6 +18066,7 @@ an argument, unconditionally call `org-insert-heading'."
["Convert to odd/even levels" org-convert-to-oddeven-levels t])
("Editing"
["Emphasis..." org-emphasize t]
+ ["Add block structure" org-insert-structure-template t]
["Edit Source Example" org-edit-special t]
"--"
["Footnote new/jump" org-footnote-action t]
@@ -18403,8 +18076,7 @@ an argument, unconditionally call `org-insert-heading'."
"--"
["Move Subtree to Archive file" org-archive-subtree (org-in-subtree-not-table-p)]
["Toggle ARCHIVE tag" org-toggle-archive-tag (org-in-subtree-not-table-p)]
- ["Move subtree to Archive sibling" org-archive-to-archive-sibling (org-in-subtree-not-table-p)]
- )
+ ["Move subtree to Archive sibling" org-archive-to-archive-sibling (org-in-subtree-not-table-p)])
"--"
("Hyperlinks"
["Store Link (Global)" org-store-link t]
@@ -18521,13 +18193,6 @@ an argument, unconditionally call `org-insert-heading'."
(org-inside-LaTeX-fragment-p)]
["Insert citation" org-reftex-citation t])
"--"
- ("MobileOrg"
- ["Push Files and Views" org-mobile-push t]
- ["Get Captured and Flagged" org-mobile-pull t]
- ["Find FLAGGED Tasks" (org-agenda nil "?") :active t :keys "\\[org-agenda] ?"]
- "--"
- ["Setup" (progn (require 'org-mobile) (customize-group 'org-mobile)) t])
- "--"
("Documentation"
["Show Version" org-version t]
["Info Documentation" org-info t]
@@ -18535,8 +18200,7 @@ an argument, unconditionally call `org-insert-heading'."
("Customize"
["Browse Org Group" org-customize t]
"--"
- ["Expand This Menu" org-create-customize-menu
- (fboundp 'customize-menu-create)])
+ ["Expand This Menu" org-create-customize-menu t])
["Send bug report" org-submit-bug-report t]
"--"
("Refresh/Reload"
@@ -18544,6 +18208,70 @@ an argument, unconditionally call `org-insert-heading'."
["Reload Org (after update)" org-reload t]
["Reload Org uncompiled" (org-reload t) :active t :keys "C-u C-c C-x !"])))
+(easy-menu-define org-tbl-menu org-mode-map "Org Table menu"
+ '("Table"
+ ["Align" org-ctrl-c-ctrl-c :active (org-at-table-p)]
+ ["Next Field" org-cycle (org-at-table-p)]
+ ["Previous Field" org-shifttab (org-at-table-p)]
+ ["Next Row" org-return (org-at-table-p)]
+ "--"
+ ["Blank Field" org-table-blank-field (org-at-table-p)]
+ ["Edit Field" org-table-edit-field (org-at-table-p)]
+ ["Copy Field from Above" org-table-copy-down (org-at-table-p)]
+ "--"
+ ("Column"
+ ["Move Column Left" org-metaleft (org-at-table-p)]
+ ["Move Column Right" org-metaright (org-at-table-p)]
+ ["Delete Column" org-shiftmetaleft (org-at-table-p)]
+ ["Insert Column" org-shiftmetaright (org-at-table-p)]
+ ["Shrink Column" org-table-toggle-column-width (org-at-table-p)])
+ ("Row"
+ ["Move Row Up" org-metaup (org-at-table-p)]
+ ["Move Row Down" org-metadown (org-at-table-p)]
+ ["Delete Row" org-shiftmetaup (org-at-table-p)]
+ ["Insert Row" org-shiftmetadown (org-at-table-p)]
+ ["Sort lines in region" org-table-sort-lines (org-at-table-p)]
+ "--"
+ ["Insert Hline" org-ctrl-c-minus (org-at-table-p)])
+ ("Rectangle"
+ ["Copy Rectangle" org-copy-special (org-at-table-p)]
+ ["Cut Rectangle" org-cut-special (org-at-table-p)]
+ ["Paste Rectangle" org-paste-special (org-at-table-p)]
+ ["Fill Rectangle" org-table-wrap-region (org-at-table-p)])
+ "--"
+ ("Calculate"
+ ["Set Column Formula" org-table-eval-formula (org-at-table-p)]
+ ["Set Field Formula" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="]
+ ["Edit Formulas" org-edit-special (org-at-table-p)]
+ "--"
+ ["Recalculate line" org-table-recalculate (org-at-table-p)]
+ ["Recalculate all" (lambda () (interactive) (org-table-recalculate '(4))) :active (org-at-table-p) :keys "C-u C-c *"]
+ ["Iterate all" (lambda () (interactive) (org-table-recalculate '(16))) :active (org-at-table-p) :keys "C-u C-u C-c *"]
+ "--"
+ ["Toggle Recalculate Mark" org-table-rotate-recalc-marks (org-at-table-p)]
+ "--"
+ ["Sum Column/Rectangle" org-table-sum
+ (or (org-at-table-p) (org-region-active-p))]
+ ["Which Column?" org-table-current-column (org-at-table-p)])
+ ["Debug Formulas"
+ org-table-toggle-formula-debugger
+ :style toggle :selected (bound-and-true-p org-table-formula-debug)]
+ ["Show Col/Row Numbers"
+ org-table-toggle-coordinate-overlays
+ :style toggle
+ :selected (bound-and-true-p org-table-overlay-coordinates)]
+ "--"
+ ["Create" org-table-create (not (org-at-table-p))]
+ ["Convert Region" org-table-convert-region (not (org-at-table-p 'any))]
+ ["Import from File" org-table-import (not (org-at-table-p))]
+ ["Export to File" org-table-export (org-at-table-p)]
+ "--"
+ ["Create/Convert from/to table.el" org-table-create-with-table.el t]
+ "--"
+ ("Plot"
+ ["Ascii plot" orgtbl-ascii-plot :active (org-at-table-p) :keys "C-c \" a"]
+ ["Gnuplot" org-plot/gnuplot :active (org-at-table-p) :keys "C-c \" g"])))
+
(defun org-info (&optional node)
"Read documentation for Org in the info system.
With optional NODE, go directly to that node."
@@ -18580,14 +18308,22 @@ information about your Org version and configuration."
(erase-buffer)
(insert "You are about to submit a bug report to the Org mailing list.
-We would like to add your full Org and Outline configuration to the
-bug report. This greatly simplifies the work of the maintainer and
-other experts on the mailing list.
+If your report is about Org installation, please read this section:
+https://orgmode.org/org.html#Installation
+
+Please read https://orgmode.org/org.html#Feedback on how to make
+a good report, it will help Org contributors fixing your problem.
+
+Search https://lists.gnu.org/archive/html/emacs-orgmode/ to see
+if the issue you are about to raise has already been dealt with.
-HOWEVER, some variables you have customized may contain private
+We also would like to add your full Org and Outline configuration
+to the bug report. It will help us debugging the issue.
+
+*HOWEVER*, some variables you have customized may contain private
information. The names of customers, colleagues, or friends, might
-appear in the form of file names, tags, todo states, or search strings.
-If you answer yes to the prompt, you might want to check and remove
+appear in the form of file names, tags, todo states or search strings.
+If you answer \"yes\" to the prompt, you might want to check and remove
such private information before sending the email.")
(add-text-properties (point-min) (point-max) '(face org-warning))
(when (yes-or-no-p "Include your Org configuration ")
@@ -18617,6 +18353,7 @@ Your bug report will be posted to the Org mailing list.
(defun org-install-agenda-files-menu ()
+ "Install agenda file menu."
(let ((bl (buffer-list)))
(save-excursion
(while bl
@@ -18709,20 +18446,17 @@ With prefix arg UNCOMPILED, load the uncompiled versions."
(interactive)
(org-load-modules-maybe)
(org-require-autoloaded-modules)
- (if (fboundp 'customize-menu-create)
- (progn
- (easy-menu-change
- '("Org") "Customize"
- `(["Browse Org group" org-customize t]
- "--"
- ,(customize-menu-create 'org)
- ["Set" Custom-set t]
- ["Save" Custom-save t]
- ["Reset to Current" Custom-reset-current t]
- ["Reset to Saved" Custom-reset-saved t]
- ["Reset to Standard Settings" Custom-reset-standard t]))
- (message "\"Org\"-menu now contains full customization menu"))
- (error "Cannot expand menu (outdated version of cus-edit.el)")))
+ (easy-menu-change
+ '("Org") "Customize"
+ `(["Browse Org group" org-customize t]
+ "--"
+ ,(customize-menu-create 'org)
+ ["Set" Custom-set t]
+ ["Save" Custom-save t]
+ ["Reset to Current" Custom-reset-current t]
+ ["Reset to Saved" Custom-reset-saved t]
+ ["Reset to Standard Settings" Custom-reset-standard t]))
+ (message "\"Org\"-menu now contains full customization menu"))
;;;; Miscellaneous stuff
@@ -18852,7 +18586,8 @@ and :keyword."
(when (memq 'org-formula faces)
(push (list :table-special
(previous-single-property-change p 'face)
- (next-single-property-change p 'face)) clist)))
+ (next-single-property-change p 'face))
+ clist)))
((org-at-table-p 'any)
(push (list :table-table) clist)))
(goto-char p)
@@ -18865,14 +18600,16 @@ and :keyword."
(re-search-backward "[ \t]*\\(#+BEGIN: clocktable\\)" nil t))
(match-beginning 1))
(and (re-search-forward "[ \t]*#\\+END:?" nil t)
- (match-end 0))) clist))
+ (match-end 0)))
+ clist))
((org-in-src-block-p)
(push (list :src-block
(and (or (looking-at "[ \t]*\\(#\\+BEGIN_SRC\\)")
(re-search-backward "[ \t]*\\(#+BEGIN_SRC\\)" nil t))
(match-beginning 1))
(and (search-forward "#+END_SRC" nil t)
- (match-beginning 0))) clist))))
+ (match-beginning 0)))
+ clist))))
(goto-char p)
;; Now the small context
@@ -18882,20 +18619,24 @@ and :keyword."
((memq 'org-link faces)
(push (list :link
(previous-single-property-change p 'face)
- (next-single-property-change p 'face)) clist))
+ (next-single-property-change p 'face))
+ clist))
((memq 'org-special-keyword faces)
(push (list :keyword
(previous-single-property-change p 'face)
- (next-single-property-change p 'face)) clist))
+ (next-single-property-change p 'face))
+ clist))
((setq o (cl-some
(lambda (o)
(and (eq (overlay-get o 'org-overlay-type) 'org-latex-overlay)
o))
(overlays-at (point))))
(push (list :latex-fragment
- (overlay-start o) (overlay-end o)) clist)
+ (overlay-start o) (overlay-end o))
+ clist)
(push (list :latex-preview
- (overlay-start o) (overlay-end o)) clist))
+ (overlay-start o) (overlay-end o))
+ clist))
((org-inside-LaTeX-fragment-p)
;; FIXME: positions wrong.
(push (list :latex-fragment (point) (point)) clist)))
@@ -19024,7 +18765,7 @@ earliest time on the cursor date that Org treats as that date
(let (date day defd tp hod mod)
(when with-time
(setq tp (get-text-property (point) 'time))
- (when (and tp (string-match "\\([0-9][0-9]\\):\\([0-9][0-9]\\)" tp))
+ (when (and tp (string-match "\\([0-2]?[0-9]\\):\\([0-5][0-9]\\)" tp))
(setq hod (string-to-number (match-string 1 tp))
mod (string-to-number (match-string 2 tp))))
(or tp (let ((now (decode-time)))
@@ -19082,6 +18823,11 @@ ELEMENT."
(t
(goto-char start)
(current-indentation))))
+ ((and
+ (eq org-adapt-indentation 'headline-data)
+ (memq type '(planning clock node-property property-drawer drawer)))
+ (org--get-expected-indentation
+ (org-element-property :parent element) t))
((memq type '(headline inlinetask nil))
(if (org-match-line "[ \t]*$")
(org--get-expected-indentation element t)
@@ -19095,7 +18841,8 @@ ELEMENT."
;; At first line: indent according to previous sibling, if any,
;; ignoring footnote definitions and inline tasks, or parent's
;; contents.
- ((= (line-beginning-position) start)
+ ((and ( = (line-beginning-position) start)
+ (eq org-adapt-indentation t))
(catch 'exit
(while t
(if (= (point-min) start) (throw 'exit 0)
@@ -19120,7 +18867,7 @@ ELEMENT."
(org--get-expected-indentation
(org-element-property :parent previous) t))))))))))
;; Otherwise, move to the first non-blank line above.
- (t
+ ((not (eq org-adapt-indentation 'headline-data))
(beginning-of-line)
(let ((pos (point)))
(skip-chars-backward " \r\t\n")
@@ -19162,7 +18909,9 @@ ELEMENT."
(goto-char start)
(current-indentation)))
;; In any other case, indent like the current line.
- (t (current-indentation)))))))))
+ (t (current-indentation)))))
+ ;; Finally, no indentation is needed, fall back to 0.
+ (t (current-indentation))))))
(defun org--align-node-property ()
"Align node property at point.
@@ -19220,31 +18969,28 @@ list structure. Instead, use \\<org-mode-map>`\\[org-shiftmetaleft]' or \
Also align node properties according to `org-property-format'."
(interactive)
- (cond
- ((org-at-heading-p) 'noindent)
- (t
+ (unless (org-at-heading-p)
(let* ((element (save-excursion (beginning-of-line) (org-element-at-point)))
(type (org-element-type element)))
(cond ((and (memq type '(plain-list item))
(= (line-beginning-position)
(org-element-property :post-affiliated element)))
- 'noindent)
+ nil)
((and (eq type 'latex-environment)
(>= (point) (org-element-property :post-affiliated element))
- (< (point) (org-with-wide-buffer
- (goto-char (org-element-property :end element))
- (skip-chars-backward " \r\t\n")
- (line-beginning-position 2))))
- 'noindent)
+ (< (point)
+ (org-with-point-at (org-element-property :end element)
+ (skip-chars-backward " \t\n")
+ (line-beginning-position 2))))
+ nil)
((and (eq type 'src-block)
org-src-tab-acts-natively
(> (line-beginning-position)
(org-element-property :post-affiliated element))
(< (line-beginning-position)
- (org-with-wide-buffer
- (goto-char (org-element-property :end element))
- (skip-chars-backward " \r\t\n")
- (line-beginning-position))))
+ (org-with-point-at (org-element-property :end element)
+ (skip-chars-backward " \t\n")
+ (line-beginning-position))))
(org-babel-do-key-sequence-in-edit-buffer (kbd "TAB")))
(t
(let ((column (org--get-expected-indentation element nil)))
@@ -19256,7 +19002,7 @@ Also align node properties according to `org-property-format'."
(when (eq type 'node-property)
(let ((column (current-column)))
(org--align-node-property)
- (org-move-to-column column)))))))))
+ (org-move-to-column column))))))))
(defun org-indent-region (start end)
"Indent each non-blank line in the region.
@@ -19671,12 +19417,17 @@ filling the current element."
(unwind-protect
(progn
(goto-char (region-end))
+ (skip-chars-backward " \t\n")
(while (> (point) start)
- (org-backward-paragraph)
- (org-fill-element justify)))
+ (org-fill-element justify)
+ (org-backward-paragraph)))
(goto-char origin)
(set-marker origin nil))))
- (t (org-fill-element justify)))
+ (t
+ (save-excursion
+ (when (org-match-line "[ \t]*$")
+ (skip-chars-forward " \t\n"))
+ (org-fill-element justify))))
;; If we didn't change anything in the buffer (and the buffer was
;; previously unmodified), then flip the modification status back
;; to "unchanged".
@@ -20378,7 +20129,8 @@ depending on context."
(if (<= end (point)) ;on tags part
(kill-region (point) (line-end-position))
(kill-region (point) end)))
- (org-align-tags))
+ ;; Only align tags when we are still on a heading:
+ (if (org-at-heading-p) (org-align-tags)))
(t (kill-region (point) (line-end-position)))))
(defun org-yank (&optional arg)
@@ -20487,8 +20239,18 @@ interactive command with similar behavior."
"Call `outline-back-to-heading', but provide a better error message."
(condition-case nil
(outline-back-to-heading invisible-ok)
- (error (error "Before first headline at position %d in buffer %s"
- (point) (current-buffer)))))
+ (error
+ (user-error "Before first headline at position %d in buffer %s"
+ (point) (current-buffer)))))
+
+(defun org-back-to-heading-or-point-min (&optional invisible-ok)
+ "Go back to heading or first point in buffer.
+If point is before first heading go to first point in buffer
+instead of back to heading."
+ (condition-case nil
+ (outline-back-to-heading invisible-ok)
+ (error
+ (goto-char (point-min)))))
(defun org-before-first-heading-p ()
"Before first heading?"
@@ -20516,12 +20278,31 @@ unless optional argument NO-INHERITANCE is non-nil."
(t
(save-excursion (and (org-up-heading-safe) (org-in-commented-heading-p))))))
+(defun org-in-archived-heading-p (&optional no-inheritance)
+ "Non-nil if point is under an archived heading.
+This function also checks ancestors of the current headline,
+unless optional argument NO-INHERITANCE is non-nil."
+ (cond
+ ((org-before-first-heading-p) nil)
+ ((let ((tags (org-get-tags nil 'local)))
+ (and tags
+ (cl-some (apply-partially #'string= org-archive-tag) tags))))
+ (no-inheritance nil)
+ (t
+ (save-excursion (and (org-up-heading-safe) (org-in-archived-heading-p))))))
+
(defun org-at-comment-p nil
"Return t if cursor is in a commented line."
(save-excursion
(save-match-data
(beginning-of-line)
- (looking-at "^[ \t]*# "))))
+ (looking-at org-comment-regexp))))
+
+(defun org-at-keyword-p nil
+ "Return t if cursor is at a keyword-line."
+ (save-excursion
+ (move-beginning-of-line 1)
+ (looking-at org-keyword-regexp)))
(defun org-at-drawer-p nil
"Return t if cursor is at a drawer keyword."
@@ -20570,6 +20351,17 @@ make a significant difference in outlines with very many siblings."
(re-search-backward (format "^\\*\\{1,%d\\} " level-up) nil t)
(funcall outline-level)))))
+(defun org-up-heading-or-point-min ()
+ "Move to the heading line of which the present is a subheading, or point-min.
+This version is needed to make point-min behave like a virtual
+heading of level 0 for property-inheritance. It will return the
+level of the headline found (down to 0) or nil if already at a
+point before the first headline or at point-min."
+ (when (ignore-errors (org-back-to-heading t))
+ (if (< 1 (funcall outline-level))
+ (org-up-heading-safe)
+ (unless (= (point) (point-min)) (goto-char (point-min))))))
+
(defun org-first-sibling-p ()
"Is this heading the first child of its parents?"
(interactive)
@@ -20670,28 +20462,31 @@ If there is no such heading, return nil."
(defun org-end-of-subtree (&optional invisible-ok to-heading)
"Goto to the end of a subtree."
;; This contains an exact copy of the original function, but it uses
- ;; `org-back-to-heading', to make it work also in invisible
- ;; trees. And is uses an invisible-ok argument.
+ ;; `org-back-to-heading-or-point-min', to make it work also in invisible
+ ;; trees and before first headline. And is uses an invisible-ok argument.
;; Under Emacs this is not needed, but the old outline.el needs this fix.
;; Furthermore, when used inside Org, finding the end of a large subtree
;; with many children and grandchildren etc, this can be much faster
;; than the outline version.
- (org-back-to-heading invisible-ok)
+ (org-back-to-heading-or-point-min invisible-ok)
(let ((first t)
(level (funcall outline-level)))
- (if (and (derived-mode-p 'org-mode) (< level 1000))
- ;; A true heading (not a plain list item), in Org
- ;; This means we can easily find the end by looking
- ;; only for the right number of stars. Using a regexp to do
- ;; this is so much faster than using a Lisp loop.
- (let ((re (concat "^\\*\\{1," (int-to-string level) "\\} ")))
- (forward-char 1)
- (and (re-search-forward re nil 'move) (beginning-of-line 1)))
- ;; something else, do it the slow way
- (while (and (not (eobp))
- (or first (> (funcall outline-level) level)))
- (setq first nil)
- (outline-next-heading)))
+ (cond ((= level 0)
+ (goto-char (point-max)))
+ ((and (derived-mode-p 'org-mode) (< level 1000))
+ ;; A true heading (not a plain list item), in Org
+ ;; This means we can easily find the end by looking
+ ;; only for the right number of stars. Using a regexp to do
+ ;; this is so much faster than using a Lisp loop.
+ (let ((re (concat "^\\*\\{1," (number-to-string level) "\\} ")))
+ (forward-char 1)
+ (and (re-search-forward re nil 'move) (beginning-of-line 1))))
+ (t
+ ;; something else, do it the slow way
+ (while (and (not (eobp))
+ (or first (> (funcall outline-level) level)))
+ (setq first nil)
+ (outline-next-heading))))
(unless to-heading
(when (memq (preceding-char) '(?\n ?\^M))
;; Go to end of line before heading
@@ -20703,26 +20498,50 @@ If there is no such heading, return nil."
(defun org-end-of-meta-data (&optional full)
"Skip planning line and properties drawer in current entry.
-When optional argument FULL is non-nil, also skip empty lines,
-clocking lines and regular drawers at the beginning of the
-entry."
+
+When optional argument FULL is t, also skip planning information,
+clocking lines and any kind of drawer.
+
+When FULL is non-nil but not t, skip planning information,
+clocking lines and only non-regular drawers, i.e. properties and
+logbook drawers."
(org-back-to-heading t)
(forward-line)
+ ;; Skip planning information.
(when (looking-at-p org-planning-line-re) (forward-line))
+ ;; Skip property drawer.
(when (looking-at org-property-drawer-re)
(goto-char (match-end 0))
(forward-line))
+ ;; When FULL is not nil, skip more.
(when (and full (not (org-at-heading-p)))
(catch 'exit
(let ((end (save-excursion (outline-next-heading) (point)))
(re (concat "[ \t]*$" "\\|" org-clock-line-re)))
(while (not (eobp))
- (cond ((looking-at-p org-drawer-regexp)
- (if (re-search-forward "^[ \t]*:END:[ \t]*$" end t)
- (forward-line)
- (throw 'exit t)))
- ((looking-at-p re) (forward-line))
- (t (throw 'exit t))))))))
+ (cond ;; Skip clock lines.
+ ((looking-at-p re) (forward-line))
+ ;; Skip logbook drawer.
+ ((looking-at-p org-logbook-drawer-re)
+ (if (re-search-forward "^[ \t]*:END:[ \t]*$" end t)
+ (forward-line)
+ (throw 'exit t)))
+ ;; When FULL is t, skip regular drawer too.
+ ((and (eq full t) (looking-at-p org-drawer-regexp))
+ (if (re-search-forward "^[ \t]*:END:[ \t]*$" end t)
+ (forward-line)
+ (throw 'exit t)))
+ (t (throw 'exit t))))))))
+
+(defun org--line-fully-invisible-p ()
+ "Return non-nil if the current line is fully invisible."
+ (let ((line-beg (line-beginning-position))
+ (line-pos (1- (line-end-position)))
+ (is-invisible t))
+ (while (and (< line-beg line-pos) is-invisible)
+ (setq is-invisible (org-invisible-p line-pos))
+ (setq line-pos (1- line-pos)))
+ is-invisible))
(defun org-forward-heading-same-level (arg &optional invisible-ok)
"Move forward to the ARG'th subheading at same level as this one.
@@ -20745,8 +20564,14 @@ non-nil it will also look at invisible ones."
(cond ((< l level) (setq count 0))
((and (= l level)
(or invisible-ok
- (not (org-invisible-p
- (line-beginning-position)))))
+ ;; FIXME: See commit a700fadd72 and the
+ ;; related discussion on why using
+ ;; `org--line-fully-invisible-p' is needed
+ ;; here, which is to serve the needs of an
+ ;; external package. If the change is
+ ;; wrong regarding Org itself, it should
+ ;; be removed.
+ (not (org--line-fully-invisible-p))))
(cl-decf count)
(when (= l level) (setq result (point)))))))
(goto-char result))
@@ -20759,175 +20584,332 @@ Stop at the first and last subheadings of a superior heading."
(org-forward-heading-same-level (if arg (- arg) -1) invisible-ok))
(defun org-next-visible-heading (arg)
- "Move to the next visible heading.
-
-This function wraps `outline-next-visible-heading' with
-`org-with-limited-levels' in order to skip over inline tasks and
-respect customization of `org-odd-levels-only'."
+ "Move to the next visible heading line.
+With ARG, repeats or can move backward if negative."
(interactive "p")
- (org-with-limited-levels
- (outline-next-visible-heading arg)))
+ (let ((regexp (concat "^" (org-get-limited-outline-regexp))))
+ (if (< arg 0)
+ (beginning-of-line)
+ (end-of-line))
+ (while (and (< arg 0) (re-search-backward regexp nil :move))
+ (unless (bobp)
+ (while (pcase (get-char-property-and-overlay (point) 'invisible)
+ (`(outline . ,o)
+ (goto-char (overlay-start o))
+ (re-search-backward regexp nil :move))
+ (_ nil))))
+ (cl-incf arg))
+ (while (and (> arg 0) (re-search-forward regexp nil t))
+ (while (pcase (get-char-property-and-overlay (point) 'invisible)
+ (`(outline . ,o)
+ (goto-char (overlay-end o))
+ (re-search-forward regexp nil :move))
+ (_
+ (end-of-line)
+ nil))) ;leave the loop
+ (cl-decf arg))
+ (if (> arg 0) (goto-char (point-max)) (beginning-of-line))))
(defun org-previous-visible-heading (arg)
"Move to the previous visible heading.
-
-This function wraps `outline-previous-visible-heading' with
-`org-with-limited-levels' in order to skip over inline tasks and
-respect customization of `org-odd-levels-only'."
+With ARG, repeats or can move forward if negative."
(interactive "p")
- (org-with-limited-levels
- (outline-previous-visible-heading arg)))
+ (org-next-visible-heading (- arg)))
+
+(defun org-forward-paragraph (&optional arg)
+ "Move forward by a paragraph, or equivalent, unit.
-(defun org-forward-paragraph ()
- "Move forward to beginning of next paragraph or equivalent.
+With argument ARG, do it ARG times;
+a negative argument ARG = -N means move backward N paragraphs.
-The function moves point to the beginning of the next visible
-structural element, which can be a paragraph, a table, a list
-item, etc. It also provides some special moves for convenience:
+The function moves point between two structural
+elements (paragraphs, tables, lists, etc.).
- - On an affiliated keyword, jump to the beginning of the
- relative element.
- - On an item or a footnote definition, move to the second
- element inside, if any.
- - On a table or a property drawer, jump after it.
- - On a verse or source block, stop after blank lines."
+It also provides the following special moves for convenience:
+
+ - on a table or a property drawer, move to its beginning;
+ - on comment, example, export, source and verse blocks, stop
+ at blank lines;
+ - skip consecutive clocks, diary S-exps, and keywords."
+ (interactive "^p")
+ (unless arg (setq arg 1))
+ (if (< arg 0) (org-backward-paragraph (- arg))
+ (while (and (> arg 0) (not (eobp)))
+ (org--forward-paragraph-once)
+ (cl-decf arg))
+ ;; Return moves left.
+ arg))
+
+(defun org-backward-paragraph (&optional arg)
+ "Move backward by a paragraph, or equivalent, unit.
+
+With argument ARG, do it ARG times;
+a negative argument ARG = -N means move forward N paragraphs.
+
+The function moves point between two structural
+elements (paragraphs, tables, lists, etc.).
+
+It also provides the following special moves for convenience:
+
+ - on a table or a property drawer, move to its beginning;
+ - on comment, example, export, source and verse blocks, stop
+ at blank lines;
+ - skip consecutive clocks, diary S-exps, and keywords."
+ (interactive "^p")
+ (unless arg (setq arg 1))
+ (if (< arg 0) (org-forward-paragraph (- arg))
+ (while (and (> arg 0) (not (bobp)))
+ (org--backward-paragraph-once)
+ (cl-decf arg))
+ ;; Return moves left.
+ arg))
+
+(defun org--paragraph-at-point ()
+ "Return paragraph, or equivalent, element at point.
+
+Paragraph element at point is the element at point, with the
+following special cases:
+
+- treat table rows (resp. node properties) as the table
+ \(resp. property drawer) containing them.
+
+- treat plain lists with an item every line as a whole.
+
+- treat consecutive keywords, clocks, and diary-sexps as a single
+ block.
+
+Function may return a real element, or a pseudo-element with type
+`pseudo-paragraph'."
+ (let* ((e (org-element-at-point))
+ (type (org-element-type e))
+ ;; If we need to fake a new pseudo-element, triplet is
+ ;;
+ ;; (BEG END PARENT)
+ ;;
+ ;; where BEG and END are element boundaries, and PARENT the
+ ;; element containing it, or nil.
+ (triplet
+ (cond
+ ((memq type '(table property-drawer))
+ (list (org-element-property :begin e)
+ (org-element-property :end e)
+ (org-element-property :parent e)))
+ ((memq type '(node-property table-row))
+ (let ((e (org-element-property :parent e)))
+ (list (org-element-property :begin e)
+ (org-element-property :end e)
+ (org-element-property :parent e))))
+ ((memq type '(clock diary-sexp keyword))
+ (let* ((regexp (pcase type
+ (`clock org-clock-line-re)
+ (`diary-sexp "%%(")
+ (_ org-keyword-regexp)))
+ (end (if (< 0 (org-element-property :post-blank e))
+ (org-element-property :end e)
+ (org-with-wide-buffer
+ (forward-line)
+ (while (looking-at regexp) (forward-line))
+ (skip-chars-forward " \t\n")
+ (line-beginning-position))))
+ (begin (org-with-point-at (org-element-property :begin e)
+ (while (and (not (bobp)) (looking-at regexp))
+ (forward-line -1))
+ ;; We may have gotten one line too far.
+ (if (looking-at regexp)
+ (point)
+ (line-beginning-position 2)))))
+ (list begin end (org-element-property :parent e))))
+ ;; Find the full plain list containing point, the check it
+ ;; contains exactly one line per item.
+ ((let ((l (org-element-lineage e '(plain-list) t)))
+ (while (memq (org-element-type (org-element-property :parent l))
+ '(item plain-list))
+ (setq l (org-element-property :parent l)))
+ (and l
+ (org-with-point-at (org-element-property :post-affiliated l)
+ (forward-line (length (org-element-property :structure l)))
+ (= (point) (org-element-property :contents-end l)))
+ ;; Return value.
+ (list (org-element-property :begin l)
+ (org-element-property :end l)
+ (org-element-property :parent l)))))
+ (t nil)))) ;no triplet: return element
+ (pcase triplet
+ (`(,b ,e ,p)
+ (org-element-create
+ 'pseudo-paragraph
+ (list :begin b :end e :parent p :post-blank 0 :post-affiliated b)))
+ (_ e))))
+
+(defun org--forward-paragraph-once ()
+ "Move forward to end of paragraph or equivalent, once.
+See `org-forward-paragraph'."
(interactive)
- (unless (eobp)
- (let* ((deactivate-mark nil)
- (element (org-element-at-point))
- (type (org-element-type element))
- (post-affiliated (org-element-property :post-affiliated element))
- (contents-begin (org-element-property :contents-begin element))
- (contents-end (org-element-property :contents-end element))
- (end (let ((end (org-element-property :end element)) (parent element))
- (while (and (setq parent (org-element-property :parent parent))
- (= (org-element-property :contents-end parent) end))
- (setq end (org-element-property :end parent)))
- end)))
- (cond ((not element)
- (skip-chars-forward " \r\t\n")
- (or (eobp) (beginning-of-line)))
- ;; On affiliated keywords, move to element's beginning.
- ((< (point) post-affiliated)
- (goto-char post-affiliated))
- ;; At a table row, move to the end of the table. Similarly,
- ;; at a node property, move to the end of the property
- ;; drawer.
- ((memq type '(node-property table-row))
- (goto-char (org-element-property
- :end (org-element-property :parent element))))
- ((memq type '(property-drawer table)) (goto-char end))
- ;; Consider blank lines as separators in verse and source
- ;; blocks to ease editing.
- ((memq type '(src-block verse-block))
- (when (eq type 'src-block)
- (setq contents-end
- (save-excursion (goto-char end)
- (skip-chars-backward " \r\t\n")
- (line-beginning-position))))
- (beginning-of-line)
- (when (looking-at "[ \t]*$") (skip-chars-forward " \r\t\n"))
- (if (not (re-search-forward "^[ \t]*$" contents-end t))
- (goto-char end)
- (skip-chars-forward " \r\t\n")
- (if (= (point) contents-end) (goto-char end)
- (beginning-of-line))))
- ;; With no contents, just skip element.
- ((not contents-begin) (goto-char end))
- ;; If contents are invisible, skip the element altogether.
- ((org-invisible-p (line-end-position))
- (cl-case type
- (headline
- (org-with-limited-levels (outline-next-visible-heading 1)))
- ;; At a plain list, make sure we move to the next item
- ;; instead of skipping the whole list.
- (plain-list (forward-char)
- (org-forward-paragraph))
- (otherwise (goto-char end))))
- ((>= (point) contents-end) (goto-char end))
- ((>= (point) contents-begin)
- ;; This can only happen on paragraphs and plain lists.
- (cl-case type
- (paragraph (goto-char end))
- ;; At a plain list, try to move to second element in
- ;; first item, if possible.
- (plain-list (end-of-line)
- (org-forward-paragraph))))
- ;; When contents start on the middle of a line (e.g. in
- ;; items and footnote definitions), try to reach first
- ;; element starting after current line.
- ((> (line-end-position) contents-begin)
- (end-of-line)
- (org-forward-paragraph))
- (t (goto-char contents-begin))))))
-
-(defun org-backward-paragraph ()
- "Move backward to start of previous paragraph or equivalent.
-
-The function moves point to the beginning of the current
-structural element, which can be a paragraph, a table, a list
-item, etc., or to the beginning of the previous visible one if
-point is already there. It also provides some special moves for
-convenience:
-
- - On an affiliated keyword, jump to the first one.
- - On a table or a property drawer, move to its beginning.
- - On comment, example, export, src and verse blocks, stop
- before blank lines."
+ (save-restriction
+ (widen)
+ (skip-chars-forward " \t\n")
+ (cond
+ ((eobp) nil)
+ ;; When inside a folded part, move out of it.
+ ((pcase (get-char-property-and-overlay (point) 'invisible)
+ (`(,(or `outline `org-hide-block) . ,o)
+ (goto-char (overlay-end o))
+ (forward-line)
+ t)
+ (_ nil)))
+ (t
+ (let* ((element (org--paragraph-at-point))
+ (type (org-element-type element))
+ (contents-begin (org-element-property :contents-begin element))
+ (end (org-element-property :end element))
+ (post-affiliated (org-element-property :post-affiliated element)))
+ (cond
+ ((eq type 'plain-list)
+ (forward-char)
+ (org--forward-paragraph-once))
+ ;; If the element is folded, skip it altogether.
+ ((pcase (org-with-point-at post-affiliated
+ (get-char-property-and-overlay (line-end-position)
+ 'invisible))
+ (`(,(or `outline `org-hide-block) . ,o)
+ (goto-char (overlay-end o))
+ (forward-line)
+ t)
+ (_ nil)))
+ ;; At a greater element, move inside.
+ ((and contents-begin
+ (> contents-begin (point))
+ (not (eq type 'paragraph)))
+ (goto-char contents-begin)
+ ;; Items and footnote definitions contents may not start at
+ ;; the beginning of the line. In this case, skip until the
+ ;; next paragraph.
+ (cond
+ ((not (bolp)) (org--forward-paragraph-once))
+ ((org-previous-line-empty-p) (forward-line -1))
+ (t nil)))
+ ;; Move between empty lines in some blocks.
+ ((memq type '(comment-block example-block export-block src-block
+ verse-block))
+ (let ((contents-start
+ (org-with-point-at post-affiliated
+ (line-beginning-position 2))))
+ (if (< (point) contents-start)
+ (goto-char contents-start)
+ (let ((contents-end
+ (org-with-point-at end
+ (skip-chars-backward " \t\n")
+ (line-beginning-position))))
+ (cond
+ ((>= (point) contents-end)
+ (goto-char end)
+ (skip-chars-backward " \t\n")
+ (forward-line))
+ ((re-search-forward "^[ \t]*\n" contents-end :move)
+ (forward-line -1))
+ (t nil))))))
+ (t
+ ;; Move to element's end.
+ (goto-char end)
+ (skip-chars-backward " \t\n")
+ (forward-line))))))))
+
+(defun org--backward-paragraph-once ()
+ "Move backward to start of paragraph or equivalent, once.
+See `org-backward-paragraph'."
(interactive)
- (unless (bobp)
- (let* ((deactivate-mark nil)
- (element (org-element-at-point))
- (type (org-element-type element))
- (contents-end (org-element-property :contents-end element))
- (post-affiliated (org-element-property :post-affiliated element))
- (begin (org-element-property :begin element))
- (special? ;blocks handled specially
- (memq type '(comment-block example-block export-block src-block
- verse-block)))
- (contents-begin
- (if special?
- ;; These types have no proper contents. Fake line
- ;; below the block opening line as contents beginning.
- (save-excursion (goto-char begin) (line-beginning-position 2))
- (org-element-property :contents-begin element))))
- (cond
- ((not element) (goto-char (point-min)))
- ((= (point) begin)
- (backward-char)
- (org-backward-paragraph))
- ((<= (point) post-affiliated) (goto-char begin))
- ;; Special behavior: on a table or a property drawer, move to
- ;; its beginning.
- ((memq type '(node-property table-row))
- (goto-char (org-element-property
- :post-affiliated (org-element-property :parent element))))
- (special?
- (if (<= (point) contents-begin) (goto-char post-affiliated)
- ;; Inside a verse block, see blank lines as paragraph
- ;; separators.
- (let ((origin (point)))
- (skip-chars-backward " \r\t\n" contents-begin)
- (when (re-search-backward "^[ \t]*$" contents-begin 'move)
- (skip-chars-forward " \r\t\n" origin)
- (if (= (point) origin) (goto-char contents-begin)
- (beginning-of-line))))))
- ((eq type 'paragraph) (goto-char contents-begin)
- ;; When at first paragraph in an item or a footnote definition,
- ;; move directly to beginning of line.
- (let ((parent-contents
- (org-element-property
- :contents-begin (org-element-property :parent element))))
- (when (and parent-contents (= parent-contents contents-begin))
- (beginning-of-line))))
- ;; At the end of a greater element, move to the beginning of
- ;; the last element within.
- ((and contents-end (>= (point) contents-end))
- (goto-char (1- contents-end))
- (org-backward-paragraph))
- (t (goto-char (or post-affiliated begin))))
- ;; Ensure we never leave point invisible.
- (when (org-invisible-p (point)) (beginning-of-visual-line)))))
+ (save-restriction
+ (widen)
+ (cond
+ ((bobp) nil)
+ ;; Blank lines at the beginning of the buffer.
+ ((and (org-match-line "^[ \t]*$")
+ (save-excursion (skip-chars-backward " \t\n") (bobp)))
+ (goto-char (point-min)))
+ ;; When inside a folded part, move out of it.
+ ((pcase (get-char-property-and-overlay (1- (point)) 'invisible)
+ (`(,(or `outline `org-hide-block) . ,o)
+ (goto-char (1- (overlay-start o)))
+ (org--backward-paragraph-once)
+ t)
+ (_ nil)))
+ (t
+ (let* ((element (org--paragraph-at-point))
+ (type (org-element-type element))
+ (begin (org-element-property :begin element))
+ (post-affiliated (org-element-property :post-affiliated element))
+ (contents-end (org-element-property :contents-end element))
+ (end (org-element-property :end element))
+ (parent (org-element-property :parent element))
+ (reach
+ ;; Move to the visible empty line above position P, or
+ ;; to position P. Return t.
+ (lambda (p)
+ (goto-char p)
+ (when (and (org-previous-line-empty-p)
+ (let ((end (line-end-position 0)))
+ (or (= end (point-min))
+ (not (org-invisible-p (1- end))))))
+ (forward-line -1))
+ t)))
+ (cond
+ ;; Already at the beginning of an element.
+ ((= begin (point))
+ (cond
+ ;; There is a blank line above. Move there.
+ ((and (org-previous-line-empty-p)
+ (not (org-invisible-p (1- (line-end-position 0)))))
+ (forward-line -1))
+ ;; At the beginning of the first element within a greater
+ ;; element. Move to the beginning of the greater element.
+ ((and parent (= begin (org-element-property :contents-begin parent)))
+ (funcall reach (org-element-property :begin parent)))
+ ;; Since we have to move anyway, find the beginning
+ ;; position of the element above.
+ (t
+ (forward-char -1)
+ (org--backward-paragraph-once))))
+ ;; Skip paragraphs at the very beginning of footnote
+ ;; definitions or items.
+ ((and (eq type 'paragraph)
+ (org-with-point-at begin (not (bolp))))
+ (funcall reach (progn (goto-char begin) (line-beginning-position))))
+ ;; If the element is folded, skip it altogether.
+ ((org-with-point-at post-affiliated
+ (org-invisible-p (line-end-position) t))
+ (funcall reach begin))
+ ;; At the end of a greater element, move inside.
+ ((and contents-end
+ (<= contents-end (point))
+ (not (eq type 'paragraph)))
+ (cond
+ ((memq type '(footnote-definition plain-list))
+ (skip-chars-backward " \t\n")
+ (org--backward-paragraph-once))
+ ((= contents-end (point))
+ (forward-char -1)
+ (org--backward-paragraph-once))
+ (t
+ (goto-char contents-end))))
+ ;; Move between empty lines in some blocks.
+ ((and (memq type '(comment-block example-block export-block src-block
+ verse-block))
+ (let ((contents-start
+ (org-with-point-at post-affiliated
+ (line-beginning-position 2))))
+ (when (> (point) contents-start)
+ (let ((contents-end
+ (org-with-point-at end
+ (skip-chars-backward " \t\n")
+ (line-beginning-position))))
+ (if (> (point) contents-end)
+ (progn (goto-char contents-end) t)
+ (skip-chars-backward " \t\n" begin)
+ (re-search-backward "^[ \t]*\n" contents-start :move)
+ t))))))
+ ;; Move to element's start.
+ (t
+ (funcall reach begin))))))))
(defun org-forward-element ()
"Move forward by one element.
@@ -21109,10 +21091,11 @@ ones already marked."
(set-mark
(save-excursion
(goto-char (mark))
- (goto-char (org-element-property :end (org-element-at-point)))))
+ (goto-char (org-element-property :end (org-element-at-point)))
+ (point)))
(let ((element (org-element-at-point)))
(end-of-line)
- (push-mark (org-element-property :end element) t t)
+ (push-mark (min (point-max) (org-element-property :end element)) t t)
(goto-char (org-element-property :begin element))))))
(defun org-narrow-to-element ()
diff --git a/lisp/org/ox-ascii.el b/lisp/org/ox-ascii.el
index 972b58a9912..70bd1c4df2f 100644
--- a/lisp/org/ox-ascii.el
+++ b/lisp/org/ox-ascii.el
@@ -1,6 +1,6 @@
;;; ox-ascii.el --- ASCII Back-End for Org Export Engine -*- lexical-binding: t; -*-
-;; Copyright (C) 2012-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -31,6 +31,8 @@
(require 'ox-publish)
(require 'cl-lib)
+;;; Function Declarations
+
(declare-function aa2u "ext:ascii-art-to-unicode" ())
;;; Define Back-End
@@ -954,7 +956,7 @@ channel."
((not (org-element-contents link)) nil)
;; Do not add a link already handled by custom export
;; functions.
- ((org-export-custom-protocol-maybe link anchor 'ascii) nil)
+ ((org-export-custom-protocol-maybe link anchor 'ascii info) nil)
(t
(concat
(org-ascii--fill-string
@@ -1270,7 +1272,8 @@ CONTENTS is nil. INFO is a plist holding contextual information."
(org-ascii--justify-element
(org-ascii--box-string
(org-remove-indentation
- (org-element-property :value fixed-width)) info)
+ (org-element-property :value fixed-width))
+ info)
fixed-width info))
@@ -1569,7 +1572,7 @@ DESC is the description part of the link, or the empty string.
INFO is a plist holding contextual information."
(let ((type (org-element-property :type link)))
(cond
- ((org-export-custom-protocol-maybe link desc 'ascii))
+ ((org-export-custom-protocol-maybe link desc 'ascii info))
((string= type "coderef")
(let ((ref (org-element-property :path link)))
(format (org-export-get-coderef-format ref desc)
@@ -1605,13 +1608,11 @@ INFO is a plist holding contextual information."
;; Don't know what to do. Signal it.
(_ "???"))))
(t
- (let ((raw-link (concat (org-element-property :type link)
- ":"
- (org-element-property :path link))))
- (if (not (org-string-nw-p desc)) (format "<%s>" raw-link)
+ (let ((path (org-element-property :raw-link link)))
+ (if (not (org-string-nw-p desc)) (format "<%s>" path)
(concat (format "[%s]" desc)
(and (not (plist-get info :ascii-links-to-notes))
- (format " (<%s>)" raw-link)))))))))
+ (format " (<%s>)" path)))))))))
;;;; Node Properties
diff --git a/lisp/org/ox-beamer.el b/lisp/org/ox-beamer.el
index 23656db444c..1a1732b6836 100644
--- a/lisp/org/ox-beamer.el
+++ b/lisp/org/ox-beamer.el
@@ -1,6 +1,6 @@
;;; ox-beamer.el --- Beamer Back-End for Org Export Engine -*- lexical-binding: t; -*-
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten.dominik AT gmail DOT com>
;; Nicolas Goaziou <n.goaziou AT gmail DOT com>
@@ -731,7 +731,7 @@ channel."
"Transcode a LINK object into Beamer code.
CONTENTS is the description part of the link. INFO is a plist
used as a communication channel."
- (or (org-export-custom-protocol-maybe link contents 'beamer)
+ (or (org-export-custom-protocol-maybe link contents 'beamer info)
;; Fall-back to LaTeX export. However, prefer "\hyperlink" over
;; "\hyperref" since the former handles overlay specifications.
(let ((latex-link (org-export-with-backend 'latex link contents info)))
diff --git a/lisp/org/ox-html.el b/lisp/org/ox-html.el
index 678506a6756..03145e35c53 100644
--- a/lisp/org/ox-html.el
+++ b/lisp/org/ox-html.el
@@ -1,6 +1,6 @@
;;; ox-html.el --- HTML Back-End for Org Export Engine -*- lexical-binding: t; -*-
-;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Jambunathan K <kjambunathan at gmail dot com>
@@ -62,7 +62,6 @@
(export-block . org-html-export-block)
(export-snippet . org-html-export-snippet)
(fixed-width . org-html-fixed-width)
- (footnote-definition . org-html-footnote-definition)
(footnote-reference . org-html-footnote-reference)
(headline . org-html-headline)
(horizontal-rule . org-html-horizontal-rule)
@@ -121,6 +120,7 @@
(:html-link-home "HTML_LINK_HOME" nil org-html-link-home)
(:html-link-up "HTML_LINK_UP" nil org-html-link-up)
(:html-mathjax "HTML_MATHJAX" nil "" space)
+ (:html-equation-reference-format "HTML_EQUATION_REFERENCE_FORMAT" nil org-html-equation-reference-format t)
(:html-postamble nil "html-postamble" org-html-postamble)
(:html-preamble nil "html-preamble" org-html-preamble)
(:html-head "HTML_HEAD" nil org-html-head newline)
@@ -152,6 +152,7 @@
(:html-metadata-timestamp-format nil nil org-html-metadata-timestamp-format)
(:html-postamble-format nil nil org-html-postamble-format)
(:html-preamble-format nil nil org-html-preamble-format)
+ (:html-prefer-user-labels nil nil org-html-prefer-user-labels)
(:html-self-link-headlines nil nil org-html-self-link-headlines)
(:html-table-align-individual-fields
nil nil org-html-table-align-individual-fields)
@@ -232,50 +233,26 @@ property on the headline itself.")
(defconst org-html-scripts
"<script type=\"text/javascript\">
-/*
-@licstart The following is the entire license notice for the
-JavaScript code in this tag.
-
-Copyright (C) 2012-2020 Free Software Foundation, Inc.
-
-The JavaScript code in this tag is free software: you can
-redistribute it and/or modify it under the terms of the GNU
-General Public License (GNU GPL) as published by the Free Software
-Foundation, either version 3 of the License, or (at your option)
-any later version. The code is distributed WITHOUT ANY WARRANTY;
-without even the implied warranty of MERCHANTABILITY or FITNESS
-FOR A PARTICULAR PURPOSE. See the GNU GPL for more details.
-
-As additional permission under GNU GPL version 3 section 7, you
-may distribute non-source (e.g., minimized or compacted) forms of
-that code without the copy of the GNU GPL normally required by
-section 4, provided you include this license notice and a URL
-through which recipients can access the Corresponding Source.
-
-
-@licend The above is the entire license notice
-for the JavaScript code in this tag.
-*/
+// @license magnet:?xt=urn:btih:e95b018ef3580986a04669f1b5879592219e2a7a&dn=public-domain.txt Public Domain
<!--/*--><![CDATA[/*><!--*/
- function CodeHighlightOn(elem, id)
- {
- var target = document.getElementById(id);
- if(null != target) {
- elem.cacheClassElem = elem.className;
- elem.cacheClassTarget = target.className;
- target.className = \"code-highlighted\";
- elem.className = \"code-highlighted\";
- }
- }
- function CodeHighlightOff(elem, id)
- {
- var target = document.getElementById(id);
- if(elem.cacheClassElem)
- elem.className = elem.cacheClassElem;
- if(elem.cacheClassTarget)
- target.className = elem.cacheClassTarget;
- }
-/*]]>*///-->
+ function CodeHighlightOn(elem, id)
+ {
+ var target = document.getElementById(id);
+ if(null != target) {
+ elem.classList.add(\"code-highlighted\");
+ target.classList.add(\"code-highlighted\");
+ }
+ }
+ function CodeHighlightOff(elem, id)
+ {
+ var target = document.getElementById(id);
+ if(null != target) {
+ elem.classList.remove(\"code-highlighted\");
+ target.classList.remove(\"code-highlighted\");
+ }
+ }
+ /*]]>*///-->
+// @license-end
</script>"
"Basic JavaScript that is needed by HTML files produced by Org mode.")
@@ -311,7 +288,7 @@ for the JavaScript code in this tag.
}
pre.src {
position: relative;
- overflow: visible;
+ overflow: auto;
padding-top: 1.2em;
}
pre.src:before {
@@ -323,7 +300,7 @@ for the JavaScript code in this tag.
padding: 3px;
border: 1px solid black;
}
- pre.src:hover:before { display: inline;}
+ pre.src:hover:before { display: inline; margin-top: 14px;}
/* Languages per Org manual */
pre.src-asymptote:before { content: 'Asymptote'; }
pre.src-awk:before { content: 'Awk'; }
@@ -532,73 +509,22 @@ means to use the maximum value consistent with other options."
(defcustom org-html-infojs-template
"<script type=\"text/javascript\" src=\"%SCRIPT_PATH\">
-/**
- *
- * @source: %SCRIPT_PATH
- *
- * @licstart The following is the entire license notice for the
- * JavaScript code in %SCRIPT_PATH.
- *
- * Copyright (C) 2012-2020 Free Software Foundation, Inc.
- *
- *
- * The JavaScript code in this tag is free software: you can
- * redistribute it and/or modify it under the terms of the GNU
- * General Public License (GNU GPL) as published by the Free Software
- * Foundation, either version 3 of the License, or (at your option)
- * any later version. The code is distributed WITHOUT ANY WARRANTY;
- * without even the implied warranty of MERCHANTABILITY or FITNESS
- * FOR A PARTICULAR PURPOSE. See the GNU GPL for more details.
- *
- * As additional permission under GNU GPL version 3 section 7, you
- * may distribute non-source (e.g., minimized or compacted) forms of
- * that code without the copy of the GNU GPL normally required by
- * section 4, provided you include this license notice and a URL
- * through which recipients can access the Corresponding Source.
- *
- * @licend The above is the entire license notice
- * for the JavaScript code in %SCRIPT_PATH.
- *
- */
+// @license magnet:?xt=urn:btih:1f739d935676111cfff4b4693e3816e664797050&amp;dn=gpl-3.0.txt GPL-v3-or-Later
+// @license-end
</script>
<script type=\"text/javascript\">
-
-/*
-@licstart The following is the entire license notice for the
-JavaScript code in this tag.
-
-Copyright (C) 2012-2020 Free Software Foundation, Inc.
-
-The JavaScript code in this tag is free software: you can
-redistribute it and/or modify it under the terms of the GNU
-General Public License (GNU GPL) as published by the Free Software
-Foundation, either version 3 of the License, or (at your option)
-any later version. The code is distributed WITHOUT ANY WARRANTY;
-without even the implied warranty of MERCHANTABILITY or FITNESS
-FOR A PARTICULAR PURPOSE. See the GNU GPL for more details.
-
-As additional permission under GNU GPL version 3 section 7, you
-may distribute non-source (e.g., minimized or compacted) forms of
-that code without the copy of the GNU GPL normally required by
-section 4, provided you include this license notice and a URL
-through which recipients can access the Corresponding Source.
-
-
-@licend The above is the entire license notice
-for the JavaScript code in this tag.
-*/
-
+// @license magnet:?xt=urn:btih:1f739d935676111cfff4b4693e3816e664797050&amp;dn=gpl-3.0.txt GPL-v3-or-Later
<!--/*--><![CDATA[/*><!--*/
%MANAGER_OPTIONS
org_html_manager.setup(); // activate after the parameters are set
/*]]>*///-->
+// @license-end
</script>"
"The template for the export style additions when org-info.js is used.
Option settings will replace the %MANAGER-OPTIONS cookie."
:group 'org-export-html
- :version "24.4"
- :package-version '(Org . "8.0")
+ :package-version '(Org . "9.4")
:type 'string)
(defun org-html-infojs-install-script (exp-plist _backend)
@@ -811,6 +737,24 @@ but without \"name\" attribute."
:type 'boolean
:safe #'booleanp)
+(defcustom org-html-prefer-user-labels nil
+ "When non-nil use user-defined names and ID over internal ones.
+
+By default, Org generates its own internal ID values during HTML
+export. This process ensures that these values are unique and
+valid, but the keys are not available in advance of the export
+process, and not so readable.
+
+When this variable is non-nil, Org will use NAME keyword, or the
+real name of the target to create the ID attribute.
+
+Independently of this variable, however, CUSTOM_ID are always
+used as a reference."
+ :group 'org-export-html
+ :package-version '(Org . "9.4")
+ :type 'boolean
+ :safe #'booleanp)
+
;;;; Inlinetasks
(defcustom org-html-format-inlinetask-function
@@ -834,6 +778,24 @@ The function should return the string to be exported."
;;;; LaTeX
+(defcustom org-html-equation-reference-format "\\eqref{%s}"
+ "The MathJax command to use when referencing equations.
+
+This is a format control string that expects a single string argument
+specifying the label that is being referenced. The argument is
+generated automatically on export.
+
+The default is to wrap equations in parentheses (using \"\\eqref{%s}\)\".
+
+Most common values are:
+
+ \\eqref{%s} Wrap the equation in parentheses
+ \\ref{%s} Do not wrap the equation in parentheses"
+ :group 'org-export-html
+ :package-version '(Org . "9.4")
+ :type 'string
+ :safe t)
+
(defcustom org-html-with-latex org-export-with-latex
"Non-nil means process LaTeX math snippets.
@@ -847,6 +809,8 @@ e.g. \"tex:mathjax\". Allowed values are:
`verbatim' Keep everything in verbatim
`mathjax', t Do MathJax preprocessing and arrange for MathJax.js to
be loaded.
+ `html' Use `org-latex-to-html-convert-command' to convert
+ LaTeX fragments to HTML.
SYMBOL Any symbol defined in `org-preview-latex-process-alist',
e.g., `dvipng'."
:group 'org-export-html
@@ -884,10 +848,9 @@ link to the image."
:type 'boolean)
(defcustom org-html-inline-image-rules
- '(("file" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|svg\\)\\'")
- ("attachment" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|svg\\)\\'")
- ("http" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|svg\\)\\'")
- ("https" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|svg\\)\\'"))
+ `(("file" . ,(regexp-opt '(".jpeg" ".jpg" ".png" ".gif" ".svg")))
+ ("http" . ,(regexp-opt '(".jpeg" ".jpg" ".png" ".gif" ".svg")))
+ ("https" . ,(regexp-opt '(".jpeg" ".jpg" ".png" ".gif" ".svg"))))
"Rules characterizing image files that can be inlined into HTML.
A rule consists in an association whose key is the type of link
to consider, and value is a regexp that will be matched against
@@ -1350,9 +1313,10 @@ like that: \"%%\"."
(string :tag "Format string"))))
(defcustom org-html-validation-link
- "<a href=\"http://validator.w3.org/check?uri=referer\">Validate</a>"
+ "<a href=\"https://validator.w3.org/check?uri=referer\">Validate</a>"
"Link to HTML validation service."
:group 'org-export-html
+ :package-version '(Org . "9.4")
:type 'string)
(defcustom org-html-creator-string
@@ -1662,6 +1626,36 @@ attribute with a nil value will be omitted from the result."
"\"" "&quot;" (org-html-encode-plain-text item))))
(setcar output (format "%s=\"%s\"" key value))))))))
+(defun org-html--reference (datum info &optional named-only)
+ "Return an appropriate reference for DATUM.
+
+DATUM is an element or a `target' type object. INFO is the
+current export state, as a plist.
+
+When NAMED-ONLY is non-nil and DATUM has no NAME keyword, return
+nil. This doesn't apply to headlines, inline tasks, radio
+targets and targets."
+ (let* ((type (org-element-type datum))
+ (user-label
+ (org-element-property
+ (pcase type
+ ((or `headline `inlinetask) :CUSTOM_ID)
+ ((or `radio-target `target) :value)
+ (_ :name))
+ datum)))
+ (cond
+ ((and user-label
+ (or (plist-get info :html-prefer-user-labels)
+ ;; Used CUSTOM_ID property unconditionally.
+ (memq type '(headline inlinetask))))
+ user-label)
+ ((and named-only
+ (not (memq type '(headline inlinetask radio-target target)))
+ (not user-label))
+ nil)
+ (t
+ (org-export-get-reference datum info)))))
+
(defun org-html--wrap-image (contents info &optional caption label)
"Wrap CONTENTS string within an appropriate environment for images.
INFO is a plist used as a communication channel. When optional
@@ -1693,7 +1687,8 @@ a communication channel."
(org-html--make-attribute-string
(org-combine-plists
(list :src source
- :alt (if (string-match-p "^ltxpng/" source)
+ :alt (if (string-match-p
+ (concat "^" org-preview-latex-image-directory) source)
(org-html-encode-plain-text
(org-find-text-property-in-string 'org-latex-src source))
(file-name-nondirectory source)))
@@ -1853,13 +1848,8 @@ INFO is a plist used as a communication channel."
(title (if (org-string-nw-p title) title "&lrm;"))
(author (and (plist-get info :with-author)
(let ((auth (plist-get info :author)))
- (and auth
- ;; Return raw Org syntax, skipping non
- ;; exportable objects.
- (org-element-interpret-data
- (org-element-map auth
- (cons 'plain-text org-element-all-objects)
- 'identity info))))))
+ ;; Return raw Org syntax.
+ (and auth (org-element-interpret-data auth)))))
(description (plist-get info :description))
(keywords (plist-get info :keywords))
(charset (or (and org-html-coding-system
@@ -1882,7 +1872,7 @@ INFO is a plist used as a communication channel."
charset) "\n"
(let ((viewport-options
(cl-remove-if-not (lambda (cell) (org-string-nw-p (cadr cell)))
- (plist-get info :html-viewport))))
+ (plist-get info :html-viewport))))
(and viewport-options
(concat
(org-html-close-tag
@@ -2213,7 +2203,8 @@ is the language used for CODE, as a string, or nil."
;; htmlize
(setq code
(let ((output-type org-html-htmlize-output-type)
- (font-prefix org-html-htmlize-font-prefix))
+ (font-prefix org-html-htmlize-font-prefix)
+ (inhibit-read-only t))
(with-temp-buffer
;; Switch to language-specific mode.
(funcall lang-mode)
@@ -2372,8 +2363,7 @@ INFO is a plist used as a communication channel."
(org-export-get-tags headline info))))
(format "<a href=\"#%s\">%s</a>"
;; Label.
- (or (org-element-property :CUSTOM_ID headline)
- (org-export-get-reference headline info))
+ (org-html--reference headline info)
;; Body.
(concat
(and (not (org-export-low-level-p headline info))
@@ -2401,8 +2391,7 @@ of listings as a string, or nil if it is empty."
(org-html--translate "Listing %d:" info))))
(mapconcat
(lambda (entry)
- (let ((label (and (org-element-property :name entry)
- (org-export-get-reference entry info)))
+ (let ((label (org-html--reference entry info t))
(title (org-trim
(org-export-data
(or (org-export-get-caption entry t)
@@ -2440,8 +2429,7 @@ of tables as a string, or nil if it is empty."
(org-html--translate "Table %d:" info))))
(mapconcat
(lambda (entry)
- (let ((label (and (org-element-property :name entry)
- (org-export-get-reference entry info)))
+ (let ((label (org-html--reference entry info t))
(title (org-trim
(org-export-data
(or (org-export-get-caption entry t)
@@ -2542,11 +2530,11 @@ information."
(if (plist-get attributes :textarea)
(org-html--textarea-block example-block)
(format "<pre class=\"example\"%s>\n%s</pre>"
- (let* ((name (org-element-property :name example-block))
+ (let* ((reference (org-html--reference example-block info))
(a (org-html--make-attribute-string
- (if (or (not name) (plist-member attributes :id))
+ (if (or (not reference) (plist-member attributes :id))
attributes
- (plist-put attributes :id name)))))
+ (plist-put attributes :id reference)))))
(if (org-string-nw-p a) (concat " " a) ""))
(org-html-format-code example-block info)))))
@@ -2622,8 +2610,7 @@ holding contextual information."
(full-text (funcall (plist-get info :html-format-headline-function)
todo todo-type priority text tags info))
(contents (or contents ""))
- (id (or (org-element-property :CUSTOM_ID headline)
- (org-export-get-reference headline info)))
+ (id (org-html--reference headline info))
(formatted-text
(if (plist-get info :html-self-link-headlines)
(format "<a href=\"#%s\">%s</a>" id full-text)
@@ -2649,8 +2636,7 @@ holding contextual information."
(first-content (car (org-element-contents headline))))
(format "<%s id=\"%s\" class=\"%s\">%s%s</%s>\n"
(org-html--container headline info)
- (concat "outline-container-"
- (org-export-get-reference headline info))
+ (format "outline-container-%s" id)
(concat (format "outline-%d" level)
(and extra-class " ")
extra-class)
@@ -2711,8 +2697,7 @@ contextual information."
(org-element-property :value inline-src-block)
lang))
(label
- (let ((lbl (and (org-element-property :name inline-src-block)
- (org-export-get-reference inline-src-block info))))
+ (let ((lbl (org-html--reference inline-src-block info t)))
(if (not lbl) "" (format " id=\"%s\"" lbl)))))
(format "<code class=\"src src-%s\"%s>%s</code>" lang label code)))
@@ -2848,12 +2833,13 @@ CONTENTS is nil. INFO is a plist holding contextual information."
(defun org-html-format-latex (latex-frag processing-type info)
"Format a LaTeX fragment LATEX-FRAG into HTML.
PROCESSING-TYPE designates the tool used for conversion. It can
-be `mathjax', `verbatim', nil, t or symbols in
+be `mathjax', `verbatim', `html', nil, t or symbols in
`org-preview-latex-process-alist', e.g., `dvipng', `dvisvgm' or
`imagemagick'. See `org-html-with-latex' for more information.
INFO is a plist containing export properties."
(let ((cache-relpath "") (cache-dir ""))
- (unless (eq processing-type 'mathjax)
+ (unless (or (eq processing-type 'mathjax)
+ (eq processing-type 'html))
(let ((bfn (or (buffer-file-name)
(make-temp-name
(expand-file-name "latex" temporary-file-directory))))
@@ -2903,6 +2889,12 @@ used as a predicate for `org-export-get-ordinal' or a value to
(string-match-p org-latex-math-environments-re
(org-element-property :value element)))
+(defun org-html--latex-environment-numbered-p (element)
+ "Non-nil when ELEMENT contains a numbered LaTeX math environment.
+Starred and \"displaymath\" environments are not numbered."
+ (not (string-match-p "\\`[ \t]*\\\\begin{\\(.*\\*\\|displaymath\\)}"
+ (org-element-property :value element))))
+
(defun org-html--unlabel-latex-environment (latex-frag)
"Change environment in LATEX-FRAG string to an unnumbered one.
For instance, change an 'equation' environment to 'equation*'."
@@ -2921,12 +2913,14 @@ CONTENTS is nil. INFO is a plist holding contextual information."
(latex-frag (org-remove-indentation
(org-element-property :value latex-environment)))
(attributes (org-export-read-attribute :attr_html latex-environment))
- (label (and (org-element-property :name latex-environment)
- (org-export-get-reference latex-environment info)))
- (caption (number-to-string
- (org-export-get-ordinal
- latex-environment info nil
- #'org-html--math-environment-p))))
+ (label (org-html--reference latex-environment info t))
+ (caption (and (org-html--latex-environment-numbered-p latex-environment)
+ (number-to-string
+ (org-export-get-ordinal
+ latex-environment info nil
+ (lambda (l _)
+ (and (org-html--math-environment-p l)
+ (org-html--latex-environment-numbered-p l))))))))
(cond
((memq processing-type '(t mathjax))
(org-html-format-latex
@@ -2942,10 +2936,10 @@ CONTENTS is nil. INFO is a plist holding contextual information."
(org-html--unlabel-latex-environment latex-frag)
processing-type info)))
(when (and formula-link (string-match "file:\\([^]]*\\)" formula-link))
- (org-html--wrap-latex-environment
- (org-html--format-image
- (match-string 1 formula-link) attributes info)
- info caption label))))
+ (let ((source (org-export-file-uri (match-string 1 formula-link))))
+ (org-html--wrap-latex-environment
+ (org-html--format-image source attributes info)
+ info caption label)))))
(t (org-html--wrap-latex-environment latex-frag info caption label)))))
;;;; Latex Fragment
@@ -2958,11 +2952,14 @@ CONTENTS is nil. INFO is a plist holding contextual information."
(cond
((memq processing-type '(t mathjax))
(org-html-format-latex latex-frag 'mathjax info))
+ ((memq processing-type '(t html))
+ (org-html-format-latex latex-frag 'html info))
((assq processing-type org-preview-latex-process-alist)
(let ((formula-link
(org-html-format-latex latex-frag processing-type info)))
(when (and formula-link (string-match "file:\\([^]]*\\)" formula-link))
- (org-html--format-image (match-string 1 formula-link) nil info))))
+ (let ((source (org-export-file-uri (match-string 1 formula-link))))
+ (org-html--format-image source nil info)))))
(t latex-frag))))
;;;; Line Break
@@ -3044,7 +3041,9 @@ images, set it to:
DESC is the description part of the link, or the empty string.
INFO is a plist holding contextual information. See
`org-export-data'."
- (let* ((link-org-files-as-html-maybe
+ (let* ((html-ext (plist-get info :html-extension))
+ (dot (when (> (length html-ext) 0) "."))
+ (link-org-files-as-html-maybe
(lambda (raw-path info)
;; Treat links to `file.org' as links to `file.html', if
;; needed. See `org-html-link-org-files-as-html'.
@@ -3052,8 +3051,7 @@ INFO is a plist holding contextual information. See
((and (plist-get info :html-link-org-files-as-html)
(string= ".org"
(downcase (file-name-extension raw-path "."))))
- (concat (file-name-sans-extension raw-path) "."
- (plist-get info :html-extension)))
+ (concat (file-name-sans-extension raw-path) dot html-ext))
(t raw-path))))
(type (org-element-property :type link))
(raw-path (org-element-property :path link))
@@ -3063,7 +3061,7 @@ INFO is a plist holding contextual information. See
(cond
((member type '("http" "https" "ftp" "mailto" "news"))
(url-encode-url (concat type ":" raw-path)))
- ((string= type "file")
+ ((string= "file" type)
;; During publishing, turn absolute file names belonging
;; to base directory into relative file names. Otherwise,
;; append "file" protocol to absolute file name.
@@ -3114,7 +3112,7 @@ INFO is a plist holding contextual information. See
(if (org-string-nw-p attr) (concat " " attr) ""))))
(cond
;; Link type is handled by a special function.
- ((org-export-custom-protocol-maybe link desc 'html))
+ ((org-export-custom-protocol-maybe link desc 'html info))
;; Image file.
((and (plist-get info :html-inline-images)
(org-export-inline-image-p
@@ -3152,8 +3150,7 @@ INFO is a plist holding contextual information. See
(org-element-property :raw-link link) info))))
;; Link points to a headline.
(`headline
- (let ((href (or (org-element-property :CUSTOM_ID destination)
- (org-export-get-reference destination info)))
+ (let ((href (org-html--reference destination info))
;; What description to use?
(desc
;; Case 1: Headline is numbered and LINK has no
@@ -3177,11 +3174,11 @@ INFO is a plist holding contextual information. See
(eq 'latex-environment (org-element-type destination))
(eq 'math (org-latex--environment-type destination)))
;; Caption and labels are introduced within LaTeX
- ;; environment. Use "eqref" macro to refer to those in
- ;; the document.
- (format "\\eqref{%s}"
- (org-export-get-reference destination info))
- (let* ((ref (org-export-get-reference destination info))
+ ;; environment. Use "ref" or "eqref" macro, depending on user
+ ;; preference to refer to those in the document.
+ (format (plist-get info :html-equation-reference-format)
+ (org-html--reference destination info))
+ (let* ((ref (org-html--reference destination info))
(org-html-standalone-image-predicate
#'org-html--has-caption-p)
(counter-predicate
@@ -3278,8 +3275,7 @@ the plist used as a communication channel."
info nil #'org-html-standalone-image-p))
" </span>"
raw))))
- (label (and (org-element-property :name paragraph)
- (org-export-get-reference paragraph info))))
+ (label (org-html--reference paragraph info)))
(org-html--wrap-image contents info caption label)))
;; Regular paragraph.
(t (format "<p%s%s>\n%s</p>"
@@ -3385,17 +3381,17 @@ holding contextual information."
;;;; Quote Block
-(defun org-html-quote-block (quote-block contents _info)
+(defun org-html-quote-block (quote-block contents info)
"Transcode a QUOTE-BLOCK element from Org to HTML.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
(format "<blockquote%s>\n%s</blockquote>"
- (let* ((name (org-element-property :name quote-block))
+ (let* ((reference (org-html--reference quote-block info t))
(attributes (org-export-read-attribute :attr_html quote-block))
(a (org-html--make-attribute-string
- (if (or (not name) (plist-member attributes :id))
+ (if (or (not reference) (plist-member attributes :id))
attributes
- (plist-put attributes :id name)))))
+ (plist-put attributes :id reference)))))
(if (org-string-nw-p a) (concat " " a) ""))
contents))
@@ -3430,7 +3426,7 @@ holding contextual information."
"Transcode a RADIO-TARGET object from Org to HTML.
TEXT is the text of the target. INFO is a plist holding
contextual information."
- (let ((ref (org-export-get-reference radio-target info)))
+ (let ((ref (org-html--reference radio-target info)))
(org-html--anchor ref text nil info)))
;;;; Special Block
@@ -3449,11 +3445,11 @@ holding contextual information."
(if class (concat class " " block-type)
block-type)))))
(let* ((contents (or contents ""))
- (name (org-element-property :name special-block))
+ (reference (org-html--reference special-block info))
(a (org-html--make-attribute-string
- (if (or (not name) (plist-member attributes :id))
+ (if (or (not reference) (plist-member attributes :id))
attributes
- (plist-put attributes :id name))))
+ (plist-put attributes :id reference))))
(str (if (org-string-nw-p a) (concat " " a) "")))
(if html5-fancy
(format "<%s%s>\n%s</%s>" block-type str contents block-type)
@@ -3469,8 +3465,7 @@ contextual information."
(org-html--textarea-block src-block)
(let* ((lang (org-element-property :language src-block))
(code (org-html-format-code src-block info))
- (label (let ((lbl (and (org-element-property :name src-block)
- (org-export-get-reference src-block info))))
+ (label (let ((lbl (org-html--reference src-block info t)))
(if lbl (format " id=\"%s\"" lbl) "")))
(klipsify (and (plist-get info :html-klipsify-src)
(member lang '("javascript" "js"
@@ -3665,8 +3660,7 @@ contextual information."
(attributes
(org-html--make-attribute-string
(org-combine-plists
- (and (org-element-property :name table)
- (list :id (org-export-get-reference table info)))
+ (list :id (org-html--reference table info t))
(and (not (org-html-html5-p info))
(plist-get info :html-table-attributes))
(org-export-read-attribute :attr_html table))))
@@ -3713,7 +3707,7 @@ contextual information."
"Transcode a TARGET object from Org to HTML.
CONTENTS is nil. INFO is a plist holding contextual
information."
- (let ((ref (org-export-get-reference target info)))
+ (let ((ref (org-html--reference target info)))
(org-html--anchor ref nil nil info)))
;;;; Timestamp
@@ -3852,9 +3846,11 @@ file-local settings.
Return output file's name."
(interactive)
- (let* ((extension (concat "." (or (plist-get ext-plist :html-extension)
- org-html-extension
- "html")))
+ (let* ((extension (concat
+ (when (> (length org-html-extension) 0) ".")
+ (or (plist-get ext-plist :html-extension)
+ org-html-extension
+ "html")))
(file (org-export-output-file-name extension subtreep))
(org-export-coding-system org-html-coding-system))
(org-export-to-file 'html file
@@ -3870,9 +3866,10 @@ publishing directory.
Return output file name."
(org-publish-org-to 'html filename
- (concat "." (or (plist-get plist :html-extension)
- org-html-extension
- "html"))
+ (concat (when (> (length org-html-extension) 0) ".")
+ (or (plist-get plist :html-extension)
+ org-html-extension
+ "html"))
plist pub-dir))
diff --git a/lisp/org/ox-icalendar.el b/lisp/org/ox-icalendar.el
index 5968d4ee649..b8834c4ce10 100644
--- a/lisp/org/ox-icalendar.el
+++ b/lisp/org/ox-icalendar.el
@@ -1,6 +1,6 @@
;;; ox-icalendar.el --- iCalendar Back-End for Org Export Engine -*- lexical-binding: t; -*-
-;; Copyright (C) 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Nicolas Goaziou <n dot goaziou at gmail dot com>
@@ -367,7 +367,8 @@ A headline is blocked when either
(defun org-icalendar-use-UTC-date-time-p ()
"Non-nil when `org-icalendar-date-time-format' requires UTC time."
(char-equal (elt org-icalendar-date-time-format
- (1- (length org-icalendar-date-time-format))) ?Z))
+ (1- (length org-icalendar-date-time-format)))
+ ?Z))
(defvar org-agenda-default-appointment-duration) ; From org-agenda.el.
(defun org-icalendar-convert-timestamp (timestamp keyword &optional end tz)
@@ -763,10 +764,10 @@ Return VTODO component as a string."
"SEQUENCE:1\n"
(format "PRIORITY:%d\n"
(let ((pri (or (org-element-property :priority entry)
- org-default-priority)))
- (floor (- 9 (* 8. (/ (float (- org-lowest-priority pri))
- (- org-lowest-priority
- org-highest-priority)))))))
+ org-priority-default)))
+ (floor (- 9 (* 8. (/ (float (- org-priority-lowest pri))
+ (- org-priority-lowest
+ org-priority-highest)))))))
(format "STATUS:%s\n"
(if (eq (org-element-property :todo-type entry) 'todo)
"NEEDS-ACTION"
diff --git a/lisp/org/ox-latex.el b/lisp/org/ox-latex.el
index 2f61abad9cc..149492fa849 100644
--- a/lisp/org/ox-latex.el
+++ b/lisp/org/ox-latex.el
@@ -1,6 +1,6 @@
;;; ox-latex.el --- LaTeX Back-End for Org Export Engine -*- lexical-binding: t; -*-
-;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -30,6 +30,8 @@
(require 'ox)
(require 'ox-publish)
+;;; Function Declarations
+
(defvar org-latex-default-packages-alist)
(defvar org-latex-packages-alist)
(defvar orgtbl-exp-regexp)
@@ -736,8 +738,9 @@ environment."
:safe #'stringp)
(defcustom org-latex-inline-image-rules
- `(("file" . ,(regexp-opt
- '("pdf" "jpeg" "jpg" "png" "ps" "eps" "tikz" "pgf" "svg"))))
+ `(("file" . ,(rx "."
+ (or "pdf" "jpeg" "jpg" "png" "ps" "eps" "tikz" "pgf" "svg")
+ eos)))
"Rules characterizing image files that can be inlined into LaTeX.
A rule consists in an association whose key is the type of link
@@ -750,8 +753,7 @@ pdflatex, pdf, jpg and png images are OK. When processing
through dvi to Postscript, only ps and eps are allowed. The
default we use here encompasses both."
:group 'org-export-latex
- :version "24.4"
- :package-version '(Org . "8.0")
+ :package-version '(Org . "9.4")
:type '(alist :key-type (string :tag "Type")
:value-type (regexp :tag "Path")))
@@ -1586,6 +1588,7 @@ INFO is a plist used as a communication channel."
lang))))
`((?a . ,(org-export-data (plist-get info :author) info))
(?t . ,(org-export-data (plist-get info :title) info))
+ (?s . ,(org-export-data (plist-get info :subtitle) info))
(?k . ,(org-export-data (org-latex--wrap-latex-math-block
(plist-get info :keywords) info)
info))
@@ -2171,25 +2174,27 @@ contextual information."
"Transcode an ITEM element from Org to LaTeX.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
- (let* ((counter
- (let ((count (org-element-property :counter item))
- (level
- ;; Determine level of current item to determine the
- ;; correct LaTeX counter to use (enumi, enumii...).
- (let ((parent item) (level 0))
- (while (memq (org-element-type
- (setq parent (org-export-get-parent parent)))
- '(plain-list item))
- (when (and (eq (org-element-type parent) 'plain-list)
- (eq (org-element-property :type parent)
- 'ordered))
- (cl-incf level)))
- level)))
- (and count
- (< level 5)
- (format "\\setcounter{enum%s}{%s}\n"
- (nth (1- level) '("i" "ii" "iii" "iv"))
- (1- count)))))
+ (let* ((orderedp (eq (org-element-property
+ :type (org-export-get-parent item))
+ 'ordered))
+ (level
+ ;; Determine level of current item to determine the
+ ;; correct LaTeX counter to use (enumi, enumii...).
+ (let ((parent item) (level 0))
+ (while (memq (org-element-type
+ (setq parent (org-export-get-parent parent)))
+ '(plain-list item))
+ (when (and (eq (org-element-type parent) 'plain-list)
+ (eq (org-element-property :type parent)
+ 'ordered))
+ (cl-incf level)))
+ level))
+ (count (org-element-property :counter item))
+ (counter (and count
+ (< level 5)
+ (format "\\setcounter{enum%s}{%s}\n"
+ (nth (1- level) '("i" "ii" "iii" "iv"))
+ (1- count))))
(checkbox (cl-case (org-element-property :checkbox item)
(on "$\\boxtimes$")
(off "$\\square$")
@@ -2208,9 +2213,11 @@ contextual information."
"\\item"
(cond
((and checkbox tag)
- (format "[{%s %s}] %s" checkbox tag tag-footnotes))
+ (format (if orderedp "{%s %s} %s" "[{%s %s}] %s")
+ checkbox tag tag-footnotes))
((or checkbox tag)
- (format "[{%s}] %s" (or checkbox tag) tag-footnotes))
+ (format (if orderedp "{%s} %s" "[{%s}] %s")
+ (or checkbox tag) tag-footnotes))
;; Without a tag or a check-box, if CONTENTS starts with
;; an opening square bracket, add "\relax" to "\item",
;; unless the brackets comes from an initial export
@@ -2382,8 +2389,11 @@ used as a communication channel."
(format "[%s]" (plist-get info :latex-default-figure-position)))
(t ""))))
(center
- (if (plist-member attr :center) (plist-get attr :center)
- (plist-get info :latex-images-centered)))
+ (cond
+ ;; If link is an image link, do not center.
+ ((eq 'link (org-element-type (org-export-get-parent link))) nil)
+ ((plist-member attr :center) (plist-get attr :center))
+ (t (plist-get info :latex-images-centered))))
(comment-include (if (plist-get attr :comment-include) "%" ""))
;; It is possible to specify scale or width and height in
;; the ATTR_LATEX line, and also via default variables.
@@ -2425,7 +2435,8 @@ used as a communication channel."
(format "\\resizebox{%s}{%s}{%s}"
(if (org-string-nw-p width) width "!")
(if (org-string-nw-p height) height "!")
- image-code)))))
+ image-code))
+ (t image-code))))
;; For other images:
;; - add scale, or width and height to options.
;; - include the image with \includegraphics.
@@ -2517,15 +2528,16 @@ INFO is a plist holding contextual information. See
(imagep (org-export-inline-image-p
link (plist-get info :latex-inline-image-rules)))
(path (org-latex--protect-text
- (cond ((member type '("http" "https" "ftp" "mailto" "doi"))
- (concat type ":" raw-path))
- ((string= type "file")
- (org-export-file-uri raw-path))
- (t
- raw-path)))))
+ (pcase type
+ ((or "http" "https" "ftp" "mailto" "doi")
+ (concat type ":" raw-path))
+ ("file"
+ (org-export-file-uri raw-path))
+ (_
+ raw-path)))))
(cond
;; Link type is handled by a special function.
- ((org-export-custom-protocol-maybe link desc 'latex))
+ ((org-export-custom-protocol-maybe link desc 'latex info))
;; Image file.
(imagep (org-latex--inline-image link info))
;; Radio link: Transcode target's contents and use them as link's
@@ -2576,7 +2588,9 @@ INFO is a plist holding contextual information. See
;; equivalent line number.
((string= type "coderef")
(format (org-export-get-coderef-format path desc)
- (org-export-resolve-coderef path info)))
+ ;; Resolve with RAW-PATH since PATH could be tainted
+ ;; with `org-latex--protect-text' call above.
+ (org-export-resolve-coderef raw-path info)))
;; External link with a description part.
((and path desc) (format "\\href{%s}{%s}" path desc))
;; External link without a description part.
diff --git a/lisp/org/ox-man.el b/lisp/org/ox-man.el
index 36822ff9664..6cace7e6989 100644
--- a/lisp/org/ox-man.el
+++ b/lisp/org/ox-man.el
@@ -1,6 +1,6 @@
;; ox-man.el --- Man Back-End for Org Export Engine -*- lexical-binding: t; -*-
-;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
;; Luis R Anaya <papoanaya aroba hot mail punto com>
@@ -40,6 +40,8 @@
(require 'cl-lib)
(require 'ox)
+;;; Function Declarations
+
(defvar org-export-man-default-packages-alist)
(defvar org-export-man-packages-alist)
(defvar orgtbl-exp-regexp)
@@ -599,24 +601,24 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;; Link
-(defun org-man-link (link desc _info)
+(defun org-man-link (link desc info)
"Transcode a LINK object from Org to Man.
DESC is the description part of the link, or the empty string.
INFO is a plist holding contextual information. See
`org-export-data'."
(let* ((type (org-element-property :type link))
- (raw-path (org-element-property :path link))
+ (raw-path (org-element-property :path link))
;; Ensure DESC really exists, or set it to nil.
(desc (and (not (string= desc "")) desc))
- (path (cond
- ((member type '("http" "https" "ftp" "mailto"))
- (concat type ":" raw-path))
- ((string= type "file") (org-export-file-uri raw-path))
- (t raw-path))))
+ (path (pcase type
+ ((or "http" "https" "ftp" "mailto")
+ (concat type ":" raw-path))
+ ("file" (org-export-file-uri raw-path))
+ (_ raw-path))))
(cond
;; Link type is handled by a special function.
- ((org-export-custom-protocol-maybe link desc 'man))
+ ((org-export-custom-protocol-maybe link desc 'man info))
;; External link with a description part.
((and path desc) (format "%s \\fBat\\fP \\fI%s\\fP" path desc))
;; External link without a description part.
@@ -1136,8 +1138,4 @@ Return PDF file name or an error if it couldn't be produced."
(provide 'ox-man)
-;; Local variables:
-;; generated-autoload-file: "org-loaddefs.el"
-;; End:
-
;;; ox-man.el ends here
diff --git a/lisp/org/ox-md.el b/lisp/org/ox-md.el
index 91d5c0ba089..f4afe6b30ea 100644
--- a/lisp/org/ox-md.el
+++ b/lisp/org/ox-md.el
@@ -1,6 +1,6 @@
;;; ox-md.el --- Markdown Back-End for Org Export Engine -*- lexical-binding: t; -*-
-;; Copyright (C) 2012-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <n.goaziou@gmail.com>
;; Keywords: org, wp, markdown
@@ -85,13 +85,17 @@ The %s will be replaced by the footnote reference itself."
(if a (org-md-export-to-markdown t s v)
(org-open-file (org-md-export-to-markdown nil s v)))))))
:translate-alist '((bold . org-md-bold)
+ (center-block . org-md--convert-to-html)
(code . org-md-verbatim)
+ (drawer . org-md--identity)
+ (dynamic-block . org-md--identity)
(example-block . org-md-example-block)
(export-block . org-md-export-block)
(fixed-width . org-md-example-block)
(headline . org-md-headline)
(horizontal-rule . org-md-horizontal-rule)
(inline-src-block . org-md-verbatim)
+ (inlinetask . org-md--convert-to-html)
(inner-template . org-md-inner-template)
(italic . org-md-italic)
(item . org-md-item)
@@ -105,7 +109,9 @@ The %s will be replaced by the footnote reference itself."
(property-drawer . org-md-property-drawer)
(quote-block . org-md-quote-block)
(section . org-md-section)
+ (special-block . org-md--convert-to-html)
(src-block . org-md-example-block)
+ (table . org-md--convert-to-html)
(template . org-md-template)
(verbatim . org-md-verbatim))
:options-alist
@@ -147,6 +153,145 @@ Assume BACKEND is `md'."
;; Return updated tree.
tree)
+
+;;; Internal functions
+
+(defun org-md--headline-referred-p (headline info)
+ "Non-nil when HEADLINE is being referred to.
+INFO is a plist used as a communication channel. Links and table
+of contents can refer to headlines."
+ (unless (org-element-property :footnote-section-p headline)
+ (or
+ ;; Global table of contents includes HEADLINE.
+ (and (plist-get info :with-toc)
+ (memq headline
+ (org-export-collect-headlines info (plist-get info :with-toc))))
+ ;; A local table of contents includes HEADLINE.
+ (cl-some
+ (lambda (h)
+ (let ((section (car (org-element-contents h))))
+ (and
+ (eq 'section (org-element-type section))
+ (org-element-map section 'keyword
+ (lambda (keyword)
+ (when (equal "TOC" (org-element-property :key keyword))
+ (let ((case-fold-search t)
+ (value (org-element-property :value keyword)))
+ (and (string-match-p "\\<headlines\\>" value)
+ (let ((n (and
+ (string-match "\\<[0-9]+\\>" value)
+ (string-to-number (match-string 0 value))))
+ (local? (string-match-p "\\<local\\>" value)))
+ (memq headline
+ (org-export-collect-headlines
+ info n (and local? keyword))))))))
+ info t))))
+ (org-element-lineage headline))
+ ;; A link refers internally to HEADLINE.
+ (org-element-map (plist-get info :parse-tree) 'link
+ (lambda (link)
+ (eq headline
+ (pcase (org-element-property :type link)
+ ((or "custom-id" "id") (org-export-resolve-id-link link info))
+ ("fuzzy" (org-export-resolve-fuzzy-link link info))
+ (_ nil))))
+ info t))))
+
+(defun org-md--headline-title (style level title &optional anchor tags)
+ "Generate a headline title in the preferred Markdown headline style.
+STYLE is the preferred style (`atx' or `setext'). LEVEL is the
+header level. TITLE is the headline title. ANCHOR is the HTML
+anchor tag for the section as a string. TAGS are the tags set on
+the section."
+ (let ((anchor-lines (and anchor (concat anchor "\n\n"))))
+ ;; Use "Setext" style
+ (if (and (eq style 'setext) (< level 3))
+ (let* ((underline-char (if (= level 1) ?= ?-))
+ (underline (concat (make-string (length title) underline-char)
+ "\n")))
+ (concat "\n" anchor-lines title tags "\n" underline "\n"))
+ ;; Use "Atx" style
+ (let ((level-mark (make-string level ?#)))
+ (concat "\n" anchor-lines level-mark " " title tags "\n\n")))))
+
+(defun org-md--build-toc (info &optional n _keyword scope)
+ "Return a table of contents.
+
+INFO is a plist used as a communication channel.
+
+Optional argument N, when non-nil, is an integer specifying the
+depth of the table.
+
+When optional argument SCOPE is non-nil, build a table of
+contents according to the specified element."
+ (concat
+ (unless scope
+ (let ((style (plist-get info :md-headline-style))
+ (title (org-html--translate "Table of Contents" info)))
+ (org-md--headline-title style 1 title nil)))
+ (mapconcat
+ (lambda (headline)
+ (let* ((indentation
+ (make-string
+ (* 4 (1- (org-export-get-relative-level headline info)))
+ ?\s))
+ (bullet
+ (if (not (org-export-numbered-headline-p headline info)) "- "
+ (let ((prefix
+ (format "%d." (org-last (org-export-get-headline-number
+ headline info)))))
+ (concat prefix (make-string (max 1 (- 4 (length prefix)))
+ ?\s)))))
+ (title
+ (format "[%s](#%s)"
+ (org-export-data-with-backend
+ (org-export-get-alt-title headline info)
+ (org-export-toc-entry-backend 'md)
+ info)
+ (or (org-element-property :CUSTOM_ID headline)
+ (org-export-get-reference headline info))))
+ (tags (and (plist-get info :with-tags)
+ (not (eq 'not-in-toc (plist-get info :with-tags)))
+ (org-make-tag-string
+ (org-export-get-tags headline info)))))
+ (concat indentation bullet title tags)))
+ (org-export-collect-headlines info n scope) "\n")
+ "\n"))
+
+(defun org-md--footnote-formatted (footnote info)
+ "Formats a single footnote entry FOOTNOTE.
+FOOTNOTE is a cons cell of the form (number . definition).
+INFO is a plist with contextual information."
+ (let* ((fn-num (car footnote))
+ (fn-text (cdr footnote))
+ (fn-format (plist-get info :md-footnote-format))
+ (fn-anchor (format "fn.%d" fn-num))
+ (fn-href (format " href=\"#fnr.%d\"" fn-num))
+ (fn-link-to-ref (org-html--anchor fn-anchor fn-num fn-href info)))
+ (concat (format fn-format fn-link-to-ref) " " fn-text "\n")))
+
+(defun org-md--footnote-section (info)
+ "Format the footnote section.
+INFO is a plist used as a communication channel."
+ (let* ((fn-alist (org-export-collect-footnote-definitions info))
+ (fn-alist (cl-loop for (n _type raw) in fn-alist collect
+ (cons n (org-trim (org-export-data raw info)))))
+ (headline-style (plist-get info :md-headline-style))
+ (section-title (org-html--translate "Footnotes" info)))
+ (when fn-alist
+ (format (plist-get info :md-footnotes-section)
+ (org-md--headline-title headline-style 1 section-title)
+ (mapconcat (lambda (fn) (org-md--footnote-formatted fn info))
+ fn-alist
+ "\n")))))
+
+(defun org-md--convert-to-html (datum _contents info)
+ "Convert DATUM into raw HTML, including contents."
+ (org-export-data-with-backend datum 'html info))
+
+(defun org-md--identity (_datum contents _info)
+ "Return CONTENTS only."
+ contents)
;;; Transcode Functions
@@ -242,65 +387,6 @@ a communication channel."
(concat (org-md--headline-title style level heading anchor tags)
contents)))))))
-
-(defun org-md--headline-referred-p (headline info)
- "Non-nil when HEADLINE is being referred to.
-INFO is a plist used as a communication channel. Links and table
-of contents can refer to headlines."
- (unless (org-element-property :footnote-section-p headline)
- (or
- ;; Global table of contents includes HEADLINE.
- (and (plist-get info :with-toc)
- (memq headline
- (org-export-collect-headlines info (plist-get info :with-toc))))
- ;; A local table of contents includes HEADLINE.
- (cl-some
- (lambda (h)
- (let ((section (car (org-element-contents h))))
- (and
- (eq 'section (org-element-type section))
- (org-element-map section 'keyword
- (lambda (keyword)
- (when (equal "TOC" (org-element-property :key keyword))
- (let ((case-fold-search t)
- (value (org-element-property :value keyword)))
- (and (string-match-p "\\<headlines\\>" value)
- (let ((n (and
- (string-match "\\<[0-9]+\\>" value)
- (string-to-number (match-string 0 value))))
- (local? (string-match-p "\\<local\\>" value)))
- (memq headline
- (org-export-collect-headlines
- info n (and local? keyword))))))))
- info t))))
- (org-element-lineage headline))
- ;; A link refers internally to HEADLINE.
- (org-element-map (plist-get info :parse-tree) 'link
- (lambda (link)
- (eq headline
- (pcase (org-element-property :type link)
- ((or "custom-id" "id") (org-export-resolve-id-link link info))
- ("fuzzy" (org-export-resolve-fuzzy-link link info))
- (_ nil))))
- info t))))
-
-(defun org-md--headline-title (style level title &optional anchor tags)
- "Generate a headline title in the preferred Markdown headline style.
-STYLE is the preferred style (`atx' or `setext'). LEVEL is the
-header level. TITLE is the headline title. ANCHOR is the HTML
-anchor tag for the section as a string. TAGS are the tags set on
-the section."
- (let ((anchor-lines (and anchor (concat anchor "\n\n"))))
- ;; Use "Setext" style
- (if (and (eq style 'setext) (< level 3))
- (let* ((underline-char (if (= level 1) ?= ?-))
- (underline (concat (make-string (length title) underline-char)
- "\n")))
- (concat "\n" anchor-lines title tags "\n" underline "\n"))
- ;; Use "Atx" style
- (let ((level-mark (make-string level ?#)))
- (concat "\n" anchor-lines level-mark " " title tags "\n\n")))))
-
;;;; Horizontal Rule
(defun org-md-horizontal-rule (_horizontal-rule _contents _info)
@@ -385,20 +471,28 @@ channel."
;;;; Link
-(defun org-md-link (link contents info)
- "Transcode LINE-BREAK object into Markdown format.
-CONTENTS is the link's description. INFO is a plist used as
-a communication channel."
- (let ((link-org-files-as-md
- (lambda (raw-path)
- ;; Treat links to `file.org' as links to `file.md'.
- (if (string= ".org" (downcase (file-name-extension raw-path ".")))
- (concat (file-name-sans-extension raw-path) ".md")
- raw-path)))
- (type (org-element-property :type link)))
+(defun org-md-link (link desc info)
+ "Transcode LINK object into Markdown format.
+DESC is the description part of the link, or the empty string.
+INFO is a plist holding contextual information. See
+`org-export-data'."
+ (let* ((link-org-files-as-md
+ (lambda (raw-path)
+ ;; Treat links to `file.org' as links to `file.md'.
+ (if (string= ".org" (downcase (file-name-extension raw-path ".")))
+ (concat (file-name-sans-extension raw-path) ".md")
+ raw-path)))
+ (type (org-element-property :type link))
+ (raw-path (org-element-property :path link))
+ (path (cond
+ ((member type '("http" "https" "ftp" "mailto"))
+ (concat type ":" raw-path))
+ ((string-equal type "file")
+ (org-export-file-uri (funcall link-org-files-as-md raw-path)))
+ (t raw-path))))
(cond
;; Link type is handled by a special function.
- ((org-export-custom-protocol-maybe link contents 'md))
+ ((org-export-custom-protocol-maybe link desc 'md info))
((member type '("custom-id" "id" "fuzzy"))
(let ((destination (if (string= type "fuzzy")
(org-export-resolve-fuzzy-link link info)
@@ -406,13 +500,13 @@ a communication channel."
(pcase (org-element-type destination)
(`plain-text ; External file.
(let ((path (funcall link-org-files-as-md destination)))
- (if (not contents) (format "<%s>" path)
- (format "[%s](%s)" contents path))))
+ (if (not desc) (format "<%s>" path)
+ (format "[%s](%s)" desc path))))
(`headline
(format
"[%s](#%s)"
;; Description.
- (cond ((org-string-nw-p contents))
+ (cond ((org-string-nw-p desc))
((org-export-numbered-headline-p destination info)
(mapconcat #'number-to-string
(org-export-get-headline-number destination info)
@@ -424,7 +518,7 @@ a communication channel."
(org-export-get-reference destination info))))
(_
(let ((description
- (or (org-string-nw-p contents)
+ (or (org-string-nw-p desc)
(let ((number (org-export-get-ordinal destination info)))
(cond
((not number) nil)
@@ -435,31 +529,23 @@ a communication channel."
description
(org-export-get-reference destination info))))))))
((org-export-inline-image-p link org-html-inline-image-rules)
- (let ((path (let ((raw-path (org-element-property :path link)))
- (cond ((not (equal "file" type)) (concat type ":" raw-path))
- ((not (file-name-absolute-p raw-path)) raw-path)
- (t (expand-file-name raw-path)))))
+ (let ((path (cond ((not (string-equal type "file"))
+ (concat type ":" raw-path))
+ ((not (file-name-absolute-p raw-path)) raw-path)
+ (t (expand-file-name raw-path))))
(caption (org-export-data
(org-export-get-caption
- (org-export-get-parent-element link)) info)))
+ (org-export-get-parent-element link))
+ info)))
(format "![img](%s)"
(if (not (org-string-nw-p caption)) path
(format "%s \"%s\"" path caption)))))
((string= type "coderef")
- (let ((ref (org-element-property :path link)))
- (format (org-export-get-coderef-format ref contents)
- (org-export-resolve-coderef ref info))))
- ((equal type "radio") contents)
- (t (let* ((raw-path (org-element-property :path link))
- (path
- (cond
- ((member type '("http" "https" "ftp" "mailto"))
- (concat type ":" raw-path))
- ((string= type "file")
- (org-export-file-uri (funcall link-org-files-as-md raw-path)))
- (t raw-path))))
- (if (not contents) (format "<%s>" path)
- (format "[%s](%s)" contents path)))))))
+ (format (org-export-get-coderef-format path desc)
+ (org-export-resolve-coderef path info)))
+ ((equal type "radio") desc)
+ (t (if (not desc) (format "<%s>" path)
+ (format "[%s](%s)" desc path))))))
;;;; Node Property
@@ -555,77 +641,6 @@ a communication channel."
;;;; Template
-(defun org-md--build-toc (info &optional n _keyword scope)
- "Return a table of contents.
-
-INFO is a plist used as a communication channel.
-
-Optional argument N, when non-nil, is an integer specifying the
-depth of the table.
-
-When optional argument SCOPE is non-nil, build a table of
-contents according to the specified element."
- (concat
- (unless scope
- (let ((style (plist-get info :md-headline-style))
- (title (org-html--translate "Table of Contents" info)))
- (org-md--headline-title style 1 title nil)))
- (mapconcat
- (lambda (headline)
- (let* ((indentation
- (make-string
- (* 4 (1- (org-export-get-relative-level headline info)))
- ?\s))
- (bullet
- (if (not (org-export-numbered-headline-p headline info)) "- "
- (let ((prefix
- (format "%d." (org-last (org-export-get-headline-number
- headline info)))))
- (concat prefix (make-string (max 1 (- 4 (length prefix)))
- ?\s)))))
- (title
- (format "[%s](#%s)"
- (org-export-data-with-backend
- (org-export-get-alt-title headline info)
- (org-export-toc-entry-backend 'md)
- info)
- (or (org-element-property :CUSTOM_ID headline)
- (org-export-get-reference headline info))))
- (tags (and (plist-get info :with-tags)
- (not (eq 'not-in-toc (plist-get info :with-tags)))
- (org-make-tag-string
- (org-export-get-tags headline info)))))
- (concat indentation bullet title tags)))
- (org-export-collect-headlines info n scope) "\n")
- "\n"))
-
-(defun org-md--footnote-formatted (footnote info)
- "Formats a single footnote entry FOOTNOTE.
-FOOTNOTE is a cons cell of the form (number . definition).
-INFO is a plist with contextual information."
- (let* ((fn-num (car footnote))
- (fn-text (cdr footnote))
- (fn-format (plist-get info :md-footnote-format))
- (fn-anchor (format "fn.%d" fn-num))
- (fn-href (format " href=\"#fnr.%d\"" fn-num))
- (fn-link-to-ref (org-html--anchor fn-anchor fn-num fn-href info)))
- (concat (format fn-format fn-link-to-ref) " " fn-text "\n")))
-
-(defun org-md--footnote-section (info)
- "Format the footnote section.
-INFO is a plist used as a communication channel."
- (let* ((fn-alist (org-export-collect-footnote-definitions info))
- (fn-alist (cl-loop for (n _type raw) in fn-alist collect
- (cons n (org-trim (org-export-data raw info)))))
- (headline-style (plist-get info :md-headline-style))
- (section-title (org-html--translate "Footnotes" info)))
- (when fn-alist
- (format (plist-get info :md-footnotes-section)
- (org-md--headline-title headline-style 1 section-title)
- (mapconcat (lambda (fn) (org-md--footnote-formatted fn info))
- fn-alist
- "\n")))))
-
(defun org-md-inner-template (contents info)
"Return body of document after converting it to Markdown syntax.
CONTENTS is the transcoded contents string. INFO is a plist
diff --git a/lisp/org/ox-odt.el b/lisp/org/ox-odt.el
index a1486318a7d..2d550d92774 100644
--- a/lisp/org/ox-odt.el
+++ b/lisp/org/ox-odt.el
@@ -1,6 +1,6 @@
;;; ox-odt.el --- OpenDocument Text Exporter for Org Mode -*- lexical-binding: t; -*-
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Jambunathan K <kjambunathan at gmail dot com>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -96,7 +96,7 @@
(if a (org-odt-export-to-odt t s v)
(org-open-file (org-odt-export-to-odt nil s v) 'system))))))
:options-alist
- '((:odt-styles-file "ODT_STYLES_FILE" nil nil t)
+ '((:odt-styles-file "ODT_STYLES_FILE" nil org-odt-styles-file t)
(:description "DESCRIPTION" nil nil newline)
(:keywords "KEYWORDS" nil nil space)
(:subtitle "SUBTITLE" nil nil parse)
@@ -110,7 +110,6 @@
(:odt-inline-formula-rules nil nil org-odt-inline-formula-rules)
(:odt-inline-image-rules nil nil org-odt-inline-image-rules)
(:odt-pixels-per-inch nil nil org-odt-pixels-per-inch)
- (:odt-styles-file nil nil org-odt-styles-file)
(:odt-table-styles nil nil org-odt-table-styles)
(:odt-use-date-fields nil nil org-odt-use-date-fields)
;; Redefine regular option.
@@ -741,7 +740,7 @@ link's path."
:value-type (regexp :tag "Path")))
(defcustom org-odt-inline-image-rules
- '(("file" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|svg\\)\\'"))
+ `(("file" . ,(regexp-opt '(".jpeg" ".jpg" ".png" ".gif" ".svg"))))
"Rules characterizing image files that can be inlined into ODT.
A rule consists in an association whose key is the type of link
@@ -1383,6 +1382,8 @@ original parsed data. INFO is a plist holding export options."
;; create a manifest entry for styles.xml
(org-odt-create-manifest-file-entry "text/xml" "styles.xml")
+ ;; Ensure we have write permissions to this file.
+ (set-file-modes (concat org-odt-zip-dir "styles.xml") #o600)
;; FIXME: Who is opening an empty styles.xml before this point?
(with-current-buffer
@@ -2199,16 +2200,15 @@ SHORT-CAPTION are strings."
(defun org-odt--image-size
(file info &optional user-width user-height scale dpi embed-as)
(let* ((--pixels-to-cms
- (function (lambda (pixels dpi)
- (let ((cms-per-inch 2.54)
- (inches (/ pixels dpi)))
- (* cms-per-inch inches)))))
+ (lambda (pixels dpi)
+ (let ((cms-per-inch 2.54)
+ (inches (/ pixels dpi)))
+ (* cms-per-inch inches))))
(--size-in-cms
- (function
- (lambda (size-in-pixels dpi)
- (and size-in-pixels
- (cons (funcall --pixels-to-cms (car size-in-pixels) dpi)
- (funcall --pixels-to-cms (cdr size-in-pixels) dpi))))))
+ (lambda (size-in-pixels dpi)
+ (and size-in-pixels
+ (cons (funcall --pixels-to-cms (car size-in-pixels) dpi)
+ (funcall --pixels-to-cms (cdr size-in-pixels) dpi)))))
(dpi (or dpi (plist-get info :odt-pixels-per-inch)))
(anchor-type (or embed-as "paragraph"))
(user-width (and (not scale) user-width))
@@ -2699,13 +2699,14 @@ INFO is a plist holding contextual information. See
(path (cond
((member type '("http" "https" "ftp" "mailto"))
(concat type ":" raw-path))
- ((string= type "file") (org-export-file-uri raw-path))
+ ((string= type "file")
+ (org-export-file-uri raw-path))
(t raw-path)))
;; Convert & to &amp; for correct XML representation
(path (replace-regexp-in-string "&" "&amp;" path)))
(cond
;; Link type is handled by a special function.
- ((org-export-custom-protocol-maybe link desc 'odt))
+ ((org-export-custom-protocol-maybe link desc 'odt info))
;; Image file.
((and (not desc) imagep) (org-odt-link--inline-image link info))
;; Formula file.
@@ -2946,7 +2947,7 @@ channel."
(when scheduled
(concat
(format "<text:span text:style-name=\"%s\">%s</text:span>"
- "OrgScheduledKeyword" org-deadline-string)
+ "OrgScheduledKeyword" org-scheduled-string)
(org-odt-timestamp scheduled contents info)))))))
@@ -3728,7 +3729,8 @@ contextual information."
(cache-dir (file-name-directory input-file))
(cache-subdir (concat
(cl-case processing-type
- ((dvipng imagemagick) "ltxpng/")
+ ((dvipng imagemagick)
+ org-preview-latex-image-directory)
(mathml "ltxmathml/"))
(file-name-sans-extension
(file-name-nondirectory input-file))))
@@ -4239,7 +4241,7 @@ Return output file's name."
`((?i . ,(shell-quote-argument in-file))
(?I . ,(browse-url-file-url in-file))
(?f . ,out-fmt)
- (?o . ,out-file)
+ (?o . ,(shell-quote-argument out-file))
(?O . ,(browse-url-file-url out-file))
(?d . , (shell-quote-argument out-dir))
(?D . ,(browse-url-file-url out-dir))
diff --git a/lisp/org/ox-org.el b/lisp/org/ox-org.el
index 97d8d0e92b9..26259d8752c 100644
--- a/lisp/org/ox-org.el
+++ b/lisp/org/ox-org.el
@@ -1,6 +1,6 @@
;;; ox-org.el --- Org Back-End for Org Export Engine -*- lexical-binding: t; -*-
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <n.goaziou@gmail.com>
;; Keywords: org, wp
@@ -165,11 +165,11 @@ CONTENTS is nil. INFO is ignored."
'("AUTHOR" "CREATOR" "DATE" "EMAIL" "OPTIONS" "TITLE"))
(org-element-keyword-interpreter keyword nil))))
-(defun org-org-link (link contents _info)
+(defun org-org-link (link contents info)
"Transcode LINK object back into Org syntax.
CONTENTS is the description of the link, as a string, or nil.
INFO is a plist containing current export state."
- (or (org-export-custom-protocol-maybe link contents 'org)
+ (or (org-export-custom-protocol-maybe link contents 'org info)
(org-element-link-interpreter link contents)))
(defun org-org-template (contents info)
diff --git a/lisp/org/ox-publish.el b/lisp/org/ox-publish.el
index a476796568c..6f82b485724 100644
--- a/lisp/org/ox-publish.el
+++ b/lisp/org/ox-publish.el
@@ -1,5 +1,5 @@
;;; ox-publish.el --- Publish Related Org Mode Files as a Website -*- lexical-binding: t; -*-
-;; Copyright (C) 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2021 Free Software Foundation, Inc.
;; Author: David O'Toole <dto@gnu.org>
;; Maintainer: Carsten Dominik <carsten at orgmode dot org>
@@ -659,8 +659,8 @@ If `:auto-sitemap' is set, publish the sitemap too. If
(let ((plist (cdr project)))
(let ((fun (org-publish-property :preparation-function project)))
(cond
- ((consp fun) (dolist (f fun) (funcall f plist)))
- ((functionp fun) (funcall fun plist))))
+ ((functionp fun) (funcall fun plist))
+ ((consp fun) (dolist (f fun) (funcall f plist)))))
;; Each project uses its own cache file.
(org-publish-initialize-cache (car project))
(when (org-publish-property :auto-sitemap project)
@@ -685,8 +685,8 @@ If `:auto-sitemap' is set, publish the sitemap too. If
(org-publish-file theindex project t)))
(let ((fun (org-publish-property :completion-function project)))
(cond
- ((consp fun) (dolist (f fun) (funcall f plist)))
- ((functionp fun) (funcall fun plist)))))
+ ((functionp fun) (funcall fun plist))
+ ((consp fun) (dolist (f fun) (funcall f plist))))))
(org-publish-write-cache-file)))
@@ -754,7 +754,8 @@ Default for SITEMAP-FILENAME is `sitemap.org'."
(let* ((root (expand-file-name
(file-name-as-directory
(org-publish-property :base-directory project))))
- (sitemap-filename (concat root (or sitemap-filename "sitemap.org")))
+ (sitemap-filename (expand-file-name (or sitemap-filename "sitemap.org")
+ root))
(title (or (org-publish-property :sitemap-title project)
(concat "Sitemap for project " (car project))))
(style (or (org-publish-property :sitemap-style project)
diff --git a/lisp/org/ox-texinfo.el b/lisp/org/ox-texinfo.el
index 4265a85d1b2..cf080549a6a 100644
--- a/lisp/org/ox-texinfo.el
+++ b/lisp/org/ox-texinfo.el
@@ -1,6 +1,6 @@
;;; ox-texinfo.el --- Texinfo Back-End for Org Export Engine -*- lexical-binding: t; -*-
-;; Copyright (C) 2012-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
;; Author: Jonathan Leech-Pepin <jonathan.leechpepin at gmail dot com>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -600,7 +600,8 @@ holding export options."
"^@documentencoding \\(AUTO\\)$"
coding
(replace-regexp-in-string
- "^@documentlanguage \\(AUTO\\)$" language header t nil 1) t nil 1)))
+ "^@documentlanguage \\(AUTO\\)$" language header t nil 1)
+ t nil 1)))
;; Additional header options set by #+TEXINFO_HEADER.
(let ((texinfo-header (plist-get info :texinfo-header)))
(and texinfo-header (org-element-normalize-string texinfo-header)))
@@ -1049,13 +1050,15 @@ INFO is a plist holding contextual information. See
(raw-path (org-element-property :path link))
;; Ensure DESC really exists, or set it to nil.
(desc (and (not (string= desc "")) desc))
- (path (cond
- ((member type '("http" "https" "ftp"))
- (concat type ":" raw-path))
- ((string= type "file") (org-export-file-uri raw-path))
- (t raw-path))))
+ (path (org-texinfo--sanitize-content
+ (cond
+ ((member type '("http" "https" "ftp"))
+ (concat type ":" raw-path))
+ ((string-equal type "file")
+ (org-export-file-uri raw-path))
+ (t raw-path)))))
(cond
- ((org-export-custom-protocol-maybe link desc 'texinfo))
+ ((org-export-custom-protocol-maybe link desc 'texinfo info))
((org-export-inline-image-p link org-texinfo-inline-image-rules)
(org-texinfo--inline-image link info))
((equal type "radio")
@@ -1069,8 +1072,7 @@ INFO is a plist holding contextual information. See
(org-export-resolve-id-link link info))))
(pcase (org-element-type destination)
(`nil
- (format org-texinfo-link-with-unknown-path-format
- (org-texinfo--sanitize-content path)))
+ (format org-texinfo-link-with-unknown-path-format path))
;; Id link points to an external file.
(`plain-text
(if desc (format "@uref{file://%s,%s}" destination desc)
@@ -1088,8 +1090,7 @@ INFO is a plist holding contextual information. See
(_ (org-texinfo--@ref destination desc info)))))
((string= type "mailto")
(format "@email{%s}"
- (concat (org-texinfo--sanitize-content path)
- (and desc (concat ", " desc)))))
+ (concat path (and desc (concat ", " desc)))))
;; External link with a description part.
((and path desc) (format "@uref{%s, %s}" path desc))
;; External link without a description part.
diff --git a/lisp/org/ox.el b/lisp/org/ox.el
index 2f8fd0c645b..050a8094d07 100644
--- a/lisp/org/ox.el
+++ b/lisp/org/ox.el
@@ -1,6 +1,6 @@
;;; ox.el --- Export Framework for Org Mode -*- lexical-binding: t; -*-
-;; Copyright (C) 2012-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -172,12 +172,6 @@ All these properties should be back-end agnostic. Back-end
specific properties are set through `org-export-define-backend'.
Properties redefined there have precedence over these.")
-(defconst org-export-special-keywords '("FILETAGS" "SETUPFILE" "OPTIONS")
- "List of in-buffer keywords that require special treatment.
-These keywords are not directly associated to a property. The
-way they are handled must be hard-coded into
-`org-export--get-inbuffer-options' function.")
-
(defconst org-export-filters-alist
'((:filter-body . org-export-filter-body-functions)
(:filter-bold . org-export-filter-bold-functions)
@@ -1474,104 +1468,57 @@ Assume buffer is in Org mode. Narrowing, if any, is ignored."
;; Priority is given to back-end specific options.
(org-export-get-all-options backend)
org-export-options-alist))
- (regexp (format "^[ \t]*#\\+%s:"
- (regexp-opt (nconc (delq nil (mapcar #'cadr options))
- org-export-special-keywords))))
plist to-parse)
- (letrec ((find-properties
- (lambda (keyword)
- ;; Return all properties associated to KEYWORD.
- (let (properties)
- (dolist (option options properties)
- (when (equal (nth 1 option) keyword)
- (cl-pushnew (car option) properties))))))
- (get-options
- (lambda (&optional files)
- ;; Recursively read keywords in buffer. FILES is
- ;; a list of files read so far. PLIST is the current
- ;; property list obtained.
- (org-with-wide-buffer
- (goto-char (point-min))
- (while (re-search-forward regexp nil t)
- (let ((element (org-element-at-point)))
- (when (eq (org-element-type element) 'keyword)
- (let ((key (org-element-property :key element))
- (val (org-element-property :value element)))
- (cond
- ;; Options in `org-export-special-keywords'.
- ((equal key "SETUPFILE")
- (let* ((uri (org-strip-quotes (org-trim val)))
- (uri-is-url (org-file-url-p uri))
- (uri (if uri-is-url
- uri
- (expand-file-name uri))))
- ;; Avoid circular dependencies.
- (unless (member uri files)
- (with-temp-buffer
- (unless uri-is-url
- (setq default-directory
- (file-name-directory uri)))
- (insert (org-file-contents uri 'noerror))
- (let ((org-inhibit-startup t)) (org-mode))
- (funcall get-options (cons uri files))))))
- ((equal key "OPTIONS")
- (setq plist
- (org-combine-plists
- plist
- (org-export--parse-option-keyword
- val backend))))
- ((equal key "FILETAGS")
- (setq plist
- (org-combine-plists
- plist
- (list :filetags
- (org-uniquify
- (append
- (org-split-string val ":")
- (plist-get plist :filetags)))))))
- (t
- ;; Options in `org-export-options-alist'.
- (dolist (property (funcall find-properties key))
- (setq
- plist
- (plist-put
- plist property
- ;; Handle value depending on specified
- ;; BEHAVIOR.
- (cl-case (nth 4 (assq property options))
- (parse
- (unless (memq property to-parse)
- (push property to-parse))
- ;; Even if `parse' implies `space'
- ;; behavior, we separate line with
- ;; "\n" so as to preserve
- ;; line-breaks. However, empty
- ;; lines are forbidden since `parse'
- ;; doesn't allow more than one
- ;; paragraph.
- (let ((old (plist-get plist property)))
- (cond ((not (org-string-nw-p val)) old)
- (old (concat old "\n" val))
- (t val))))
- (space
- (if (not (plist-get plist property))
- (org-trim val)
- (concat (plist-get plist property)
- " "
- (org-trim val))))
- (newline
- (org-trim
- (concat (plist-get plist property)
- "\n"
- (org-trim val))))
- (split `(,@(plist-get plist property)
- ,@(split-string val)))
- ((t) val)
- (otherwise
- (if (not (plist-member plist property)) val
- (plist-get plist property)))))))))))))))))
+ (let ((find-properties
+ (lambda (keyword)
+ ;; Return all properties associated to KEYWORD.
+ (let (properties)
+ (dolist (option options properties)
+ (when (equal (nth 1 option) keyword)
+ (cl-pushnew (car option) properties)))))))
;; Read options in the current buffer and return value.
- (funcall get-options (and buffer-file-name (list buffer-file-name)))
+ (dolist (entry (org-collect-keywords
+ (nconc (delq nil (mapcar #'cadr options))
+ '("FILETAGS" "OPTIONS"))))
+ (pcase entry
+ (`("OPTIONS" . ,values)
+ (setq plist
+ (apply #'org-combine-plists
+ plist
+ (mapcar (lambda (v)
+ (org-export--parse-option-keyword v backend))
+ values))))
+ (`("FILETAGS" . ,values)
+ (setq plist
+ (plist-put plist
+ :filetags
+ (org-uniquify
+ (cl-mapcan (lambda (v) (org-split-string v ":"))
+ values)))))
+ (`(,keyword . ,values)
+ (dolist (property (funcall find-properties keyword))
+ (setq plist
+ (plist-put
+ plist property
+ ;; Handle value depending on specified BEHAVIOR.
+ (cl-case (nth 4 (assq property options))
+ (parse
+ (unless (memq property to-parse)
+ (push property to-parse))
+ ;; Even if `parse' implies `space' behavior, we
+ ;; separate line with "\n" so as to preserve
+ ;; line-breaks.
+ (mapconcat #'identity values "\n"))
+ (space
+ (mapconcat #'identity values " "))
+ (newline
+ (mapconcat #'identity values "\n"))
+ (split
+ (cl-mapcan (lambda (v) (split-string v)) values))
+ ((t)
+ (org-last values))
+ (otherwise
+ (car values)))))))))
;; Parse properties in TO-PARSE. Remove newline characters not
;; involved in line breaks to simulate `space' behavior.
;; Finally return options.
@@ -1633,44 +1580,10 @@ process."
Also look for BIND keywords in setup files. The return value is
an alist where associations are (VARIABLE-NAME VALUE)."
(when org-export-allow-bind-keywords
- (letrec ((collect-bind
- (lambda (files alist)
- ;; Return an alist between variable names and their
- ;; value. FILES is a list of setup files names read
- ;; so far, used to avoid circular dependencies. ALIST
- ;; is the alist collected so far.
- (let ((case-fold-search t))
- (org-with-wide-buffer
- (goto-char (point-min))
- (while (re-search-forward
- "^[ \t]*#\\+\\(BIND\\|SETUPFILE\\):" nil t)
- (let ((element (org-element-at-point)))
- (when (eq (org-element-type element) 'keyword)
- (let ((val (org-element-property :value element)))
- (if (equal (org-element-property :key element)
- "BIND")
- (push (read (format "(%s)" val)) alist)
- ;; Enter setup file.
- (let* ((uri (org-strip-quotes val))
- (uri-is-url (org-file-url-p uri))
- (uri (if uri-is-url
- uri
- (expand-file-name uri))))
- ;; Avoid circular dependencies.
- (unless (member uri files)
- (with-temp-buffer
- (unless uri-is-url
- (setq default-directory
- (file-name-directory uri)))
- (let ((org-inhibit-startup t)) (org-mode))
- (insert (org-file-contents uri 'noerror))
- (setq alist
- (funcall collect-bind
- (cons uri files)
- alist))))))))))
- alist)))))
- ;; Return value in appropriate order of appearance.
- (nreverse (funcall collect-bind nil nil)))))
+ (pcase (org-collect-keywords '("BIND"))
+ (`(("BIND" . ,values))
+ (mapcar (lambda (v) (read (format "(%s)" v)))
+ values)))))
;; defsubst org-export-get-parent must be defined before first use,
;; was originally defined in the topology section
@@ -3461,15 +3374,16 @@ Move point after the link."
(goto-char (org-element-property :end link))
(let ((new-path (file-relative-name (expand-file-name path file-dir)
includer-dir))
- (new-link (org-element-copy link))
- (contents (and (org-element-property :contents-begin link)
- (buffer-substring
- (org-element-property :contents-begin link)
- (org-element-property :contents-end link)))))
+ (new-link (org-element-copy link)))
(org-element-put-property new-link :path new-path)
+ (when (org-element-property :contents-begin link)
+ (org-element-adopt-elements new-link
+ (buffer-substring
+ (org-element-property :contents-begin link)
+ (org-element-property :contents-end link))))
(delete-region (org-element-property :begin link)
(org-element-property :end link))
- (insert (org-element-link-interpreter new-link contents))))))
+ (insert (org-element-interpret-data new-link))))))
(defun org-export--prepare-file-contents
(file &optional lines ind minlevel id footnotes includer)
@@ -4184,8 +4098,8 @@ meant to be translated with `org-export-data' or alike."
(org-define-error 'org-link-broken "Unable to resolve link; aborting")
-(defun org-export-custom-protocol-maybe (link desc backend)
- "Try exporting LINK with a dedicated function.
+(defun org-export-custom-protocol-maybe (link desc backend &optional info)
+ "Try exporting LINK object with a dedicated function.
DESC is its description, as a string, or nil. BACKEND is the
back-end used for export, as a symbol.
@@ -4196,14 +4110,20 @@ A custom protocol has precedence over regular back-end export.
The function ignores links with an implicit type (e.g.,
\"custom-id\")."
(let ((type (org-element-property :type link)))
- (unless (or (member type '("coderef" "custom-id" "fuzzy" "radio"))
+ (unless (or (member type '("coderef" "custom-id" "fuzzy" "radio" nil))
(not backend))
- (let ((protocol (org-link-get-parameter type :export)))
+ (let ((protocol (org-link-get-parameter type :export))
+ (path (org-element-property :path link)))
(and (functionp protocol)
- (funcall protocol
- (org-element-property :path link)
- desc
- backend))))))
+ (condition-case nil
+ (funcall protocol path desc backend info)
+ ;; XXX: The function used (< Org 9.4) to accept only
+ ;; three mandatory arguments. Type-specific `:export'
+ ;; functions in the wild may not handle current
+ ;; signature. Provide backward compatibility support
+ ;; for them.
+ (wrong-number-of-arguments
+ (funcall protocol path desc backend))))))))
(defun org-export-get-coderef-format (path desc)
"Return format string for code reference link.
@@ -4332,7 +4252,7 @@ ignores white spaces and statistics cookies, if applicable."
(`headline
(let ((title (split-string
(replace-regexp-in-string
- "\\[[0-9]*\\(?:%\\|/[0-9]*\\)\\]" ""
+ "\\[[0-9]*\\(?:%\\|/[0-9]*\\)\\]" " "
(org-element-property :raw-value datum)))))
(delq nil
(list
@@ -4805,9 +4725,6 @@ code."
;; `org-export-table-row-is-special-p' are predicates used to look for
;; meta-information about the table structure.
;;
-;; `org-table-has-header-p' tells when the rows before the first rule
-;; should be considered as table's header.
-;;
;; `org-export-table-cell-width', `org-export-table-cell-alignment'
;; and `org-export-table-cell-borders' extract information from
;; a table-cell element.
@@ -5243,7 +5160,8 @@ rows (resp. columns)."
(lambda (row)
(when (eq (org-element-property :type row) 'standard)
(cl-incf rows)
- (unless first-row (setq first-row row)))) info)
+ (unless first-row (setq first-row row))))
+ info)
;; Set number of columns.
(org-element-map first-row 'table-cell (lambda (_) (cl-incf columns)) info)
;; Return value.
@@ -5552,6 +5470,17 @@ transcoding it."
(secondary-opening :utf-8 "‘" :html "&lsquo;" :latex "`" :texinfo "`")
(secondary-closing :utf-8 "’" :html "&rsquo;" :latex "'" :texinfo "'")
(apostrophe :utf-8 "’" :html "&rsquo;"))
+ ("ro"
+ (primary-opening
+ :utf-8 "„" :html "&bdquo;" :latex "\"`" :texinfo "@quotedblbase{}")
+ (primary-closing :utf-8 "”" :html "&rdquo;" :latex "''" :texinfo "''")
+ (secondary-opening
+ :utf-8 "«" :html "&laquo;" :latex "\\guillemotleft{}"
+ :texinfo "@guillemetleft{}")
+ (secondary-closing
+ :utf-8 "»" :html "&raquo;" :latex "\\guillemotright{}"
+ :texinfo "@guillemetright{}")
+ (apostrophe :utf-8 "’" :html "&rsquo;"))
("ru"
;; https://ru.wikipedia.org/wiki/%D0%9A%D0%B0%D0%B2%D1%8B%D1%87%D0%BA%D0%B8#.D0.9A.D0.B0.D0.B2.D1.8B.D1.87.D0.BA.D0.B8.2C_.D0.B8.D1.81.D0.BF.D0.BE.D0.BB.D1.8C.D0.B7.D1.83.D0.B5.D0.BC.D1.8B.D0.B5_.D0.B2_.D1.80.D1.83.D1.81.D1.81.D0.BA.D0.BE.D0.BC_.D1.8F.D0.B7.D1.8B.D0.BA.D0.B5
;; http://www.artlebedev.ru/kovodstvo/sections/104/
@@ -5812,6 +5741,7 @@ them."
("nn" :default "Forfattar")
("pl" :default "Autor")
("pt_BR" :default "Autor")
+ ("ro" :default "Autor")
("ru" :html "&#1040;&#1074;&#1090;&#1086;&#1088;" :utf-8 "Автор")
("sl" :default "Avtor")
("sv" :html "F&ouml;rfattare")
@@ -5829,6 +5759,7 @@ them."
("nl" :default "Vervolg van vorige pagina")
("pt" :default "Continuação da página anterior")
("pt_BR" :html "Continua&ccedil;&atilde;o da p&aacute;gina anterior" :ascii "Continuacao da pagina anterior" :default "Continuação da página anterior")
+ ("ro" :default "Continuare de pe pagina precedentă")
("ru" :html "(&#1055;&#1088;&#1086;&#1076;&#1086;&#1083;&#1078;&#1077;&#1085;&#1080;&#1077;)"
:utf-8 "(Продолжение)")
("sl" :default "Nadaljevanje s prejšnje strani"))
@@ -5843,12 +5774,15 @@ them."
("nl" :default "Vervolg op volgende pagina")
("pt" :default "Continua na página seguinte")
("pt_BR" :html "Continua na pr&oacute;xima p&aacute;gina" :ascii "Continua na proxima pagina" :default "Continua na próxima página")
+ ("ro" :default "Continuare pe pagina următoare")
("ru" :html "(&#1055;&#1088;&#1086;&#1076;&#1086;&#1083;&#1078;&#1077;&#1085;&#1080;&#1077; &#1089;&#1083;&#1077;&#1076;&#1091;&#1077;&#1090;)"
:utf-8 "(Продолжение следует)")
("sl" :default "Nadaljevanje na naslednji strani"))
("Created"
("cs" :default "Vytvořeno")
+ ("nl" :default "Gemaakt op") ;; must be followed by a date or date+time
("pt_BR" :default "Criado em")
+ ("ro" :default "Creat")
("sl" :default "Ustvarjeno"))
("Date"
("ar" :default "بتاريخ")
@@ -5869,6 +5803,7 @@ them."
("nb" :default "Dato")
("nn" :default "Dato")
("pl" :default "Data")
+ ("ro" :default "Data")
("pt_BR" :default "Data")
("ru" :html "&#1044;&#1072;&#1090;&#1072;" :utf-8 "Дата")
("sl" :default "Datum")
@@ -5886,10 +5821,12 @@ them."
("fr" :ascii "Equation" :default "Équation")
("is" :default "Jafna")
("ja" :default "方程式")
+ ("nl" :default "Vergelijking")
("no" :default "Ligning")
("nb" :default "Ligning")
("nn" :default "Likning")
("pt_BR" :html "Equa&ccedil;&atilde;o" :default "Equação" :ascii "Equacao")
+ ("ro" :default "Ecuația")
("ru" :html "&#1059;&#1088;&#1072;&#1074;&#1085;&#1077;&#1085;&#1080;&#1077;"
:utf-8 "Уравнение")
("sl" :default "Enačba")
@@ -5905,10 +5842,12 @@ them."
("is" :default "Mynd")
("it" :default "Figura")
("ja" :default "図" :html "&#22259;")
+ ("nl" :default "Figuur")
("no" :default "Illustrasjon")
("nb" :default "Illustrasjon")
("nn" :default "Illustrasjon")
("pt_BR" :default "Figura")
+ ("ro" :default "Imaginea")
("ru" :html "&#1056;&#1080;&#1089;&#1091;&#1085;&#1086;&#1082;" :utf-8 "Рисунок")
("sv" :default "Illustration")
("zh-CN" :html "&#22270;" :utf-8 "图"))
@@ -5923,10 +5862,12 @@ them."
("is" :default "Mynd %d")
("it" :default "Figura %d:")
("ja" :default "図%d: " :html "&#22259;%d: ")
+ ("nl" :default "Figuur %d:" :html "Figuur&nbsp;%d:")
("no" :default "Illustrasjon %d")
("nb" :default "Illustrasjon %d")
("nn" :default "Illustrasjon %d")
("pt_BR" :default "Figura %d:")
+ ("ro" :default "Imaginea %d:")
("ru" :html "&#1056;&#1080;&#1089;. %d.:" :utf-8 "Рис. %d.:")
("sl" :default "Slika %d")
("sv" :default "Illustration %d")
@@ -5952,6 +5893,7 @@ them."
("nn" :default "Fotnotar")
("pl" :default "Przypis")
("pt_BR" :html "Notas de Rodap&eacute;" :default "Notas de Rodapé" :ascii "Notas de Rodape")
+ ("ro" :default "Note de subsol")
("ru" :html "&#1057;&#1085;&#1086;&#1089;&#1082;&#1080;" :utf-8 "Сноски")
("sl" :default "Opombe")
("sv" :default "Fotnoter")
@@ -5968,6 +5910,7 @@ them."
("et" :default "Loendite nimekiri")
("fr" :default "Liste des programmes")
("ja" :default "ソースコード目次")
+ ("nl" :default "Lijst van programma's")
("no" :default "Dataprogrammer")
("nb" :default "Dataprogrammer")
("pt_BR" :html "&Iacute;ndice de Listagens" :default "Índice de Listagens" :ascii "Indice de Listagens")
@@ -5986,10 +5929,12 @@ them."
("is" :default "Töfluskrá" :html "T&ouml;fluskr&aacute;")
("it" :default "Indice delle tabelle")
("ja" :default "表目次")
+ ("nl" :default "Lijst van tabellen")
("no" :default "Tabeller")
("nb" :default "Tabeller")
("nn" :default "Tabeller")
("pt_BR" :html "&Iacute;ndice de Tabelas" :default "Índice de Tabelas" :ascii "Indice de Tabelas")
+ ("ro" :default "Tabele")
("ru" :html "&#1057;&#1087;&#1080;&#1089;&#1086;&#1082; &#1090;&#1072;&#1073;&#1083;&#1080;&#1094;"
:utf-8 "Список таблиц")
("sl" :default "Seznam tabel")
@@ -6005,9 +5950,11 @@ them."
("fr" :default "Programme" :html "Programme")
("it" :default "Listato")
("ja" :default "ソースコード")
+ ("nl" :default "Programma")
("no" :default "Dataprogram")
("nb" :default "Dataprogram")
("pt_BR" :default "Listagem")
+ ("ro" :default "Lista")
("ru" :html "&#1056;&#1072;&#1089;&#1087;&#1077;&#1095;&#1072;&#1090;&#1082;&#1072;"
:utf-8 "Распечатка")
("sl" :default "Izpis programa")
@@ -6022,8 +5969,10 @@ them."
("fr" :default "Programme %d :" :html "Programme&nbsp;%d&nbsp;:")
("it" :default "Listato %d :")
("ja" :default "ソースコード%d:")
+ ("nl" :default "Programma %d:" :html "Programma&nbsp;%d:")
("no" :default "Dataprogram %d")
("nb" :default "Dataprogram %d")
+ ("ro" :default "Lista %d")
("pt_BR" :default "Listagem %d:")
("ru" :html "&#1056;&#1072;&#1089;&#1087;&#1077;&#1095;&#1072;&#1090;&#1082;&#1072; %d.:"
:utf-8 "Распечатка %d.:")
@@ -6036,20 +5985,28 @@ them."
("es" :default "Referencias")
("fr" :ascii "References" :default "Références")
("it" :default "Riferimenti")
+ ("nl" :default "Bronverwijzingen")
("pt_BR" :html "Refer&ecirc;ncias" :default "Referências" :ascii "Referencias")
+ ("ro" :default "Bibliografie")
("sl" :default "Reference"))
("See figure %s"
("cs" :default "Viz obrázek %s")
("fr" :default "cf. figure %s"
:html "cf.&nbsp;figure&nbsp;%s" :latex "cf.~figure~%s")
("it" :default "Vedi figura %s")
+ ("nl" :default "Zie figuur %s"
+ :html "Zie figuur&nbsp;%s" :latex "Zie figuur~%s")
("pt_BR" :default "Veja a figura %s")
+ ("ro" :default "Vezi figura %s")
("sl" :default "Glej sliko %s"))
("See listing %s"
("cs" :default "Viz program %s")
("fr" :default "cf. programme %s"
:html "cf.&nbsp;programme&nbsp;%s" :latex "cf.~programme~%s")
+ ("nl" :default "Zie programma %s"
+ :html "Zie programma&nbsp;%s" :latex "Zie programma~%s")
("pt_BR" :default "Veja a listagem %s")
+ ("ro" :default "Vezi tabelul %s")
("sl" :default "Glej izpis programa %s"))
("See section %s"
("ar" :default "انظر قسم %s")
@@ -6061,8 +6018,11 @@ them."
("fr" :default "cf. section %s")
("it" :default "Vedi sezione %s")
("ja" :default "セクション %s を参照")
+ ("nl" :default "Zie sectie %s"
+ :html "Zie sectie&nbsp;%s" :latex "Zie sectie~%s")
("pt_BR" :html "Veja a se&ccedil;&atilde;o %s" :default "Veja a seção %s"
:ascii "Veja a secao %s")
+ ("ro" :default "Vezi secțiunea %s")
("ru" :html "&#1057;&#1084;. &#1088;&#1072;&#1079;&#1076;&#1077;&#1083; %s"
:utf-8 "См. раздел %s")
("sl" :default "Glej poglavje %d")
@@ -6072,7 +6032,10 @@ them."
("fr" :default "cf. tableau %s"
:html "cf.&nbsp;tableau&nbsp;%s" :latex "cf.~tableau~%s")
("it" :default "Vedi tabella %s")
+ ("nl" :default "Zie tabel %s"
+ :html "Zie tabel&nbsp;%s" :latex "Zie tabel~%s")
("pt_BR" :default "Veja a tabela %s")
+ ("ro" :default "Vezi tabelul %s")
("sl" :default "Glej tabelo %s"))
("Table"
("ar" :default "جدول")
@@ -6084,7 +6047,9 @@ them."
("is" :default "Tafla")
("it" :default "Tabella")
("ja" :default "表" :html "&#34920;")
+ ("nl" :default "Tabel")
("pt_BR" :default "Tabela")
+ ("ro" :default "Tabel")
("ru" :html "&#1058;&#1072;&#1073;&#1083;&#1080;&#1094;&#1072;"
:utf-8 "Таблица")
("zh-CN" :html "&#34920;" :utf-8 "表"))
@@ -6099,10 +6064,12 @@ them."
("is" :default "Tafla %d")
("it" :default "Tabella %d:")
("ja" :default "表%d:" :html "&#34920;%d:")
+ ("nl" :default "Tabel %d:" :html "Tabel&nbsp;%d:")
("no" :default "Tabell %d")
("nb" :default "Tabell %d")
("nn" :default "Tabell %d")
("pt_BR" :default "Tabela %d:")
+ ("ro" :default "Tabel %d")
("ru" :html "&#1058;&#1072;&#1073;&#1083;&#1080;&#1094;&#1072; %d.:"
:utf-8 "Таблица %d.:")
("sl" :default "Tabela %d")
@@ -6129,6 +6096,7 @@ them."
("nn" :default "Innhald")
("pl" :html "Spis tre&#x015b;ci")
("pt_BR" :html "&Iacute;ndice" :utf8 "Índice" :ascii "Indice")
+ ("ro" :default "Cuprins")
("ru" :html "&#1057;&#1086;&#1076;&#1077;&#1088;&#1078;&#1072;&#1085;&#1080;&#1077;"
:utf-8 "Содержание")
("sl" :default "Kazalo")
@@ -6145,7 +6113,9 @@ them."
("fr" :ascii "Destination inconnue" :default "Référence inconnue")
("it" :default "Riferimento sconosciuto")
("ja" :default "不明な参照先")
+ ("nl" :default "Onbekende verwijzing")
("pt_BR" :html "Refer&ecirc;ncia desconhecida" :default "Referência desconhecida" :ascii "Referencia desconhecida")
+ ("ro" :default "Referință necunoscută")
("ru" :html "&#1053;&#1077;&#1080;&#1079;&#1074;&#1077;&#1089;&#1090;&#1085;&#1072;&#1103; &#1089;&#1089;&#1099;&#1083;&#1082;&#1072;"
:utf-8 "Неизвестная ссылка")
("sl" :default "Neznana referenca")
@@ -6877,10 +6847,12 @@ back to standard interface."
(with-current-buffer "*Org Export Dispatcher*"
;; Refresh help. Maintain display continuity by re-visiting
;; previous window position.
- (let ((pos (window-start)))
+ (let ((pt (point))
+ (wstart (window-start)))
(erase-buffer)
(insert help)
- (set-window-start nil pos)))
+ (goto-char pt)
+ (set-window-start nil wstart)))
(org-fit-window-to-buffer)
(org-export--dispatch-action
standard-prompt allowed-keys entries options first-key expertp))))
@@ -6903,24 +6875,10 @@ options as CDR."
;; C-p, SPC, DEL).
(while (and (setq key (read-char-exclusive prompt))
(not expertp)
- (memq key '(14 16 ?\s ?\d)))
- (cl-case key
- (14 (if (not (pos-visible-in-window-p (point-max)))
- (ignore-errors (scroll-up 1))
- (message "End of buffer")
- (sit-for 1)))
- (16 (if (not (pos-visible-in-window-p (point-min)))
- (ignore-errors (scroll-down 1))
- (message "Beginning of buffer")
- (sit-for 1)))
- (?\s (if (not (pos-visible-in-window-p (point-max)))
- (scroll-up nil)
- (message "End of buffer")
- (sit-for 1)))
- (?\d (if (not (pos-visible-in-window-p (point-min)))
- (scroll-down nil)
- (message "Beginning of buffer")
- (sit-for 1)))))
+ ;; FIXME: Don't use C-v (22) here, as it is used as a
+ ;; modifier key in the export dispatch.
+ (memq key '(14 16 ?\s ?\d 134217846)))
+ (org-scroll key t))
(cond
;; Ignore undefined associations.
((not (memq key allowed-keys))
@@ -6929,7 +6887,7 @@ options as CDR."
(org-export--dispatch-ui options first-key expertp))
;; q key at first level aborts export. At second level, cancel
;; first key instead.
- ((eq key ?q) (if (not first-key) (error "Export aborted")
+ ((eq key ?q) (if (not first-key) (user-error "Export aborted")
(org-export--dispatch-ui options nil expertp)))
;; Help key: Switch back to standard interface if expert UI was
;; active.
diff --git a/lisp/outline.el b/lisp/outline.el
index 47e6528859f..57909b307b8 100644
--- a/lisp/outline.el
+++ b/lisp/outline.el
@@ -1,6 +1,6 @@
;;; outline.el --- outline mode commands for Emacs -*- lexical-binding: t; -*-
-;; Copyright (C) 1986, 1993-1995, 1997, 2000-2020 Free Software
+;; Copyright (C) 1986, 1993-1995, 1997, 2000-2021 Free Software
;; Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
@@ -318,7 +318,7 @@ See the command `outline-mode' for more information on this mode."
(add-hook 'change-major-mode-hook
(lambda () (outline-minor-mode -1))
nil t)
- (set (make-local-variable 'line-move-ignore-invisible) t)
+ (setq-local line-move-ignore-invisible t)
;; Cause use of ellipses for invisible text.
(add-to-invisibility-spec '(outline . t)))
(setq line-move-ignore-invisible nil)
@@ -1121,14 +1121,19 @@ Return either 'hide-all, 'headings-only, or 'show-all."
(setq heading-end (point))
(outline-end-of-subtree)
(setq end (point))
- (setq ov-list (cl-remove-if-not
- (lambda (o) (eq (overlay-get o 'invisible) 'outline))
- (overlays-in start end)))
- (cond ((eq ov-list nil) 'show-all)
- ;; (eq (length ov-list) 1) wouldn’t work: what if there is
- ;; one folded subheading?
- ((and (eq (overlay-end (car ov-list)) end)
- (eq (overlay-start (car ov-list)) heading-end))
+ (setq ov-list
+ (seq-filter
+ (lambda (o)
+ (and (eq (overlay-get o 'invisible) 'outline)
+ (save-excursion
+ (goto-char (overlay-start o))
+ (outline-on-heading-p t))))
+ (overlays-in start end)))
+ (cond ((null ov-list) 'show-all)
+ ((and (or (= end (point-max)
+ (1+ (overlay-end (car ov-list))))
+ (= (overlay-end (car ov-list)) end))
+ (= (overlay-start (car ov-list)) heading-end))
'hide-all)
(t 'headings-only)))))
@@ -1168,20 +1173,30 @@ Return either 'hide-all, 'headings-only, or 'show-all."
(defun outline-cycle-buffer ()
"Cycle the whole buffer like in `outline-cycle'."
(interactive)
- (pcase outline--cycle-buffer-state
- ('show-all
- (outline-hide-sublevels 1)
- (setq outline--cycle-buffer-state 'top-level)
- (message "Top level headings"))
- ('top-level
- (outline-show-all)
- (outline-hide-region-body (point-min) (point-max))
- (setq outline--cycle-buffer-state 'all-heading)
- (message "All headings"))
- ('all-heading
- (outline-show-all)
- (setq outline--cycle-buffer-state 'show-all)
- (message "Show all"))))
+ (let (has-top-level)
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (or has-top-level (eobp)))
+ (when (outline-on-heading-p t)
+ (when (= (funcall outline-level) 1)
+ (setq has-top-level t)))
+ (outline-next-heading)))
+ (cond
+ ((and (eq outline--cycle-buffer-state 'show-all)
+ has-top-level)
+ (outline-hide-sublevels 1)
+ (setq outline--cycle-buffer-state 'top-level)
+ (message "Top level headings"))
+ ((or (eq outline--cycle-buffer-state 'show-all)
+ (eq outline--cycle-buffer-state 'top-level))
+ (outline-show-all)
+ (outline-hide-region-body (point-min) (point-max))
+ (setq outline--cycle-buffer-state 'all-heading)
+ (message "All headings"))
+ (t
+ (outline-show-all)
+ (setq outline--cycle-buffer-state 'show-all)
+ (message "Show all")))))
(provide 'outline)
(provide 'noutline)
diff --git a/lisp/paren.el b/lisp/paren.el
index b56a78781c3..a45a08abd36 100644
--- a/lisp/paren.el
+++ b/lisp/paren.el
@@ -1,6 +1,6 @@
;;; paren.el --- highlight matching paren -*- lexical-binding:t -*-
-;; Copyright (C) 1993, 1996, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1996, 2001-2021 Free Software Foundation, Inc.
;; Author: rms@gnu.org
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/password-cache.el b/lisp/password-cache.el
index 2443f374a84..83a25725199 100644
--- a/lisp/password-cache.el
+++ b/lisp/password-cache.el
@@ -1,6 +1,6 @@
;;; password-cache.el --- Read passwords, possibly using a password cache. -*- lexical-binding: t -*-
-;; Copyright (C) 1999-2000, 2003-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2000, 2003-2021 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
;; Created: 2003-12-21
@@ -103,9 +103,7 @@ that a password is invalid, so that `password-read' query the
user again."
(let ((password (gethash key password-data)))
(when (stringp password)
- (if (fboundp 'clear-string)
- (clear-string password)
- (fillarray password ?_)))
+ (clear-string password))
(remhash key password-data)))
(defun password-cache-add (key password)
diff --git a/lisp/pcmpl-cvs.el b/lisp/pcmpl-cvs.el
index 1b49b297e42..588a5e725a8 100644
--- a/lisp/pcmpl-cvs.el
+++ b/lisp/pcmpl-cvs.el
@@ -1,6 +1,6 @@
-;;; pcmpl-cvs.el --- functions for dealing with cvs completions
+;;; pcmpl-cvs.el --- functions for dealing with cvs completions -*- lexical-binding: t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
;; Package: pcomplete
@@ -29,7 +29,6 @@
(provide 'pcmpl-cvs)
(require 'pcomplete)
-(require 'executable)
(defgroup pcmpl-cvs nil
"Functions for dealing with CVS completions."
@@ -39,8 +38,7 @@
(defcustom pcmpl-cvs-binary (or (executable-find "cvs") "cvs")
"The full path of the `cvs' binary."
- :type 'file
- :group 'pcmpl-cvs)
+ :type 'file)
;; Functions:
@@ -139,7 +137,7 @@
(let ((entries (pcmpl-cvs-entries opers))
tags)
(with-temp-buffer
- (apply 'call-process pcmpl-cvs-binary nil t nil
+ (apply #'call-process pcmpl-cvs-binary nil t nil
"status" "-v" entries)
(goto-char (point-min))
(while (re-search-forward "Existing Tags:" nil t)
diff --git a/lisp/pcmpl-gnu.el b/lisp/pcmpl-gnu.el
index fa84b31675e..dd964e36384 100644
--- a/lisp/pcmpl-gnu.el
+++ b/lisp/pcmpl-gnu.el
@@ -1,6 +1,6 @@
;;; pcmpl-gnu.el --- completions for GNU project tools -*- lexical-binding: t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Package: pcomplete
@@ -65,15 +65,14 @@
"Find all zipped or unzipped files: the inverse of UNZIP-P."
(pcomplete-entries
nil
- (function
- (lambda (entry)
- (or (file-directory-p entry)
- (when (and (file-readable-p entry)
- (file-regular-p entry))
- (let ((zipped (string-match "\\.\\(t?gz\\|\\(ta\\)?Z\\)\\'"
- entry)))
- (or (and unzip-p zipped)
- (and (not unzip-p) (not zipped))))))))))
+ (lambda (entry)
+ (or (file-directory-p entry)
+ (when (and (file-readable-p entry)
+ (file-regular-p entry))
+ (let ((zipped (string-match "\\.\\(t?gz\\|\\(ta\\)?Z\\)\\'"
+ entry)))
+ (or (and unzip-p zipped)
+ (and (not unzip-p) (not zipped)))))))))
;;;###autoload
(defun pcomplete/bzip2 ()
@@ -92,13 +91,12 @@
"Find all zipped or unzipped files: the inverse of UNZIP-P."
(pcomplete-entries
nil
- (function
- (lambda (entry)
- (when (and (file-readable-p entry)
- (file-regular-p entry))
- (let ((zipped (string-match "\\.\\(t?z2\\|bz2\\)\\'" entry)))
- (or (and unzip-p zipped)
- (and (not unzip-p) (not zipped)))))))))
+ (lambda (entry)
+ (when (and (file-readable-p entry)
+ (file-regular-p entry))
+ (let ((zipped (string-match "\\.\\(t?z2\\|bz2\\)\\'" entry)))
+ (or (and unzip-p zipped)
+ (and (not unzip-p) (not zipped))))))))
;;;###autoload
(defun pcomplete/make ()
diff --git a/lisp/pcmpl-linux.el b/lisp/pcmpl-linux.el
index df9d24507a0..2f42dbd4fa1 100644
--- a/lisp/pcmpl-linux.el
+++ b/lisp/pcmpl-linux.el
@@ -1,6 +1,6 @@
;;; pcmpl-linux.el --- functions for dealing with GNU/Linux completions -*- lexical-binding: t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Package: pcomplete
diff --git a/lisp/pcmpl-rpm.el b/lisp/pcmpl-rpm.el
index 52a1dd486bd..39f700cb362 100644
--- a/lisp/pcmpl-rpm.el
+++ b/lisp/pcmpl-rpm.el
@@ -1,6 +1,6 @@
-;;; pcmpl-rpm.el --- functions for dealing with rpm completions
+;;; pcmpl-rpm.el --- functions for dealing with rpm completions -*- lexical-binding: t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Package: pcomplete
@@ -47,14 +47,12 @@
:version "24.3"
:type '(choice (const :tag "No options" nil)
(string :tag "Single option")
- (repeat :tag "List of options" string))
- :group 'pcmpl-rpm)
+ (repeat :tag "List of options" string)))
(defcustom pcmpl-rpm-cache t
"Whether to cache the list of installed packages."
:version "24.3"
- :type 'boolean
- :group 'pcmpl-rpm)
+ :type 'boolean)
(defconst pcmpl-rpm-cache-stamp-file "/var/lib/rpm/Packages"
"File used to check that the list of installed packages is up-to-date.")
@@ -78,7 +76,7 @@
(message "Getting list of installed rpms...")
(setq pcmpl-rpm-cache-time (current-time)
pcmpl-rpm-packages
- (split-string (apply 'pcomplete-process-result "rpm"
+ (split-string (apply #'pcomplete-process-result "rpm"
(append '("-q" "-a")
(if (stringp pcmpl-rpm-query-options)
(list pcmpl-rpm-query-options)
diff --git a/lisp/pcmpl-unix.el b/lisp/pcmpl-unix.el
index 13de4b65e5b..70273b94a1b 100644
--- a/lisp/pcmpl-unix.el
+++ b/lisp/pcmpl-unix.el
@@ -1,6 +1,6 @@
;;; pcmpl-unix.el --- standard UNIX completions -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Package: pcomplete
diff --git a/lisp/pcmpl-x.el b/lisp/pcmpl-x.el
index 0fd426e3d1f..61d88666798 100644
--- a/lisp/pcmpl-x.el
+++ b/lisp/pcmpl-x.el
@@ -1,6 +1,6 @@
;;; pcmpl-x.el --- completion for miscellaneous tools -*- lexical-binding: t; -*-
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; Author: Leo Liu <sdl.web@gmail.com>
;; Keywords: processes, tools, convenience
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
index 014f9628b99..0dd99cec66d 100644
--- a/lisp/pcomplete.el
+++ b/lisp/pcomplete.el
@@ -1,6 +1,6 @@
;;; pcomplete.el --- programmable completion -*- lexical-binding: t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
;; Keywords: processes abbrev
@@ -291,9 +291,8 @@ generate the completions list. This means that the hook
`(pcomplete--here (lambda () ,form) ,stub ,paring ,form-only))
(defcustom pcomplete-command-completion-function
- (function
- (lambda ()
- (pcomplete-here (pcomplete-executables))))
+ (lambda ()
+ (pcomplete-here (pcomplete-executables)))
"Function called for completing the initial command argument."
:type 'function)
@@ -302,9 +301,8 @@ generate the completions list. This means that the hook
:type 'function)
(defcustom pcomplete-default-completion-function
- (function
- (lambda ()
- (while (pcomplete-here (pcomplete-entries)))))
+ (lambda ()
+ (while (pcomplete-here (pcomplete-entries))))
"Function called when no completion rule can be found.
This function is used to generate completions for every argument."
:type 'function)
@@ -352,7 +350,7 @@ modified to be an empty string, or the desired separation string."
(defvar pcomplete-show-list nil)
(defvar pcomplete-expand-only-p nil)
-;; for the sake of the bye-compiler, when compiling other files that
+;; for the sake of the byte-compiler, when compiling other files that
;; contain completion functions
(defvar pcomplete-args nil)
(defvar pcomplete-begins nil)
@@ -740,8 +738,8 @@ user actually typed in."
COMPLETEF-SYM should be the symbol where the
dynamic-complete-functions are kept. For comint mode itself,
this is `comint-dynamic-complete-functions'."
- (set (make-local-variable 'pcomplete-parse-arguments-function)
- #'pcomplete-parse-comint-arguments)
+ (setq-local pcomplete-parse-arguments-function
+ #'pcomplete-parse-comint-arguments)
(add-hook 'completion-at-point-functions
#'pcomplete-completions-at-point nil 'local)
(set (make-local-variable completef-sym)
@@ -988,9 +986,8 @@ Arguments NO-GANGING and ARGS-FOLLOW are currently ignored."
(setq index (1+ index))))
(throw 'pcomplete-completions
(mapcar
- (function
- (lambda (opt)
- (concat "-" opt)))
+ (lambda (opt)
+ (concat "-" opt))
(pcomplete-uniquify-list choices))))
(let ((arg (pcomplete-arg)))
(when (and (> (length arg) 1)
diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el
index bd05d91e2da..68dc0fb94b3 100644
--- a/lisp/pixel-scroll.el
+++ b/lisp/pixel-scroll.el
@@ -1,6 +1,6 @@
;;; pixel-scroll.el --- Scroll a line smoothly
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; Author: Tak Kunihiro <tkk@misasa.okayama-u.ac.jp>
;; Keywords: mouse
;; Package: emacs
@@ -26,9 +26,8 @@
;;
;; M-x pixel-scroll-mode RET
;;
-;; To make the mode permanent, put these in your init file:
+;; To make the mode permanent, put this in your Init file:
;;
-;; (require 'pixel-scroll)
;; (pixel-scroll-mode 1)
;;; Commentary:
@@ -133,8 +132,10 @@ This is an alternative of `scroll-up'. Scope moves downward."
(pixel-line-height))))
(if (pixel-eob-at-top-p) ; when end-of-the-buffer is close
(scroll-up 1) ; relay on robust method
- (while (pixel-point-at-top-p amt) ; prevent too late (multi tries)
- (vertical-motion 1)) ; move point downward
+ (catch 'no-movement
+ (while (pixel-point-at-top-p amt) ; prevent too late (multi tries)
+ (unless (>= (vertical-motion 1) 1) ; move point downward
+ (throw 'no-movement nil)))) ; exit loop when point did not move
(pixel-scroll-pixel-up amt)))))) ; move scope downward
(defun pixel-scroll-down (&optional arg)
@@ -150,8 +151,10 @@ This is and alternative of `scroll-down'. Scope moves upward."
pixel-resolution-fine-flag
(frame-char-height))
(pixel-line-height -1))))
- (while (pixel-point-at-bottom-p amt) ; prevent too late (multi tries)
- (vertical-motion -1)) ; move point upward
+ (catch 'no-movement
+ (while (pixel-point-at-bottom-p amt) ; prevent too late (multi tries)
+ (unless (<= (vertical-motion -1) -1) ; move point upward
+ (throw 'no-movement nil)))) ; exit loop when point did not move
(if (or (pixel-bob-at-top-p amt) ; when beginning-of-the-buffer is seen
(pixel-eob-at-top-p)) ; for file with a long line
(scroll-down 1) ; relay on robust method
diff --git a/lisp/play/5x5.el b/lisp/play/5x5.el
index 3d4843a39c6..07ef30c07d1 100644
--- a/lisp/play/5x5.el
+++ b/lisp/play/5x5.el
@@ -1,6 +1,6 @@
;;; 5x5.el --- simple little puzzle game
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Dave Pearson <davep@davep.org>
;; Created: 1998-10-03
@@ -31,7 +31,7 @@
;; o The code for updating the grid needs to be re-done. At the moment it
;; simply re-draws the grid every time a move is made.
;;
-;; o Look into tarting up the display with color. gamegrid.el looks
+;; o Look into improving the display with color. gamegrid.el looks
;; interesting, perhaps that is the way to go?
;;; Thanks:
@@ -47,8 +47,6 @@
;;; Code:
-;; Things we need.
-
(eval-when-compile (require 'cl-lib))
;; Customize options.
@@ -60,33 +58,27 @@
(defcustom 5x5-grid-size 5
"Size of the playing area."
- :type 'integer
- :group '5x5)
+ :type 'integer)
(defcustom 5x5-x-scale 4
"X scaling factor for drawing the grid."
- :type 'integer
- :group '5x5)
+ :type 'integer)
(defcustom 5x5-y-scale 3
"Y scaling factor for drawing the grid."
- :type 'integer
- :group '5x5)
+ :type 'integer)
(defcustom 5x5-animate-delay .01
"Delay in seconds when animating a solution crack."
- :type 'number
- :group '5x5)
+ :type 'number)
(defcustom 5x5-hassle-me t
"Should 5x5 ask you when you want to do a destructive operation?"
- :type 'boolean
- :group '5x5)
+ :type 'boolean)
(defcustom 5x5-mode-hook nil
"Hook run on starting 5x5."
- :type 'hook
- :group '5x5)
+ :type 'hook)
;; Non-customize variables.
diff --git a/lisp/play/animate.el b/lisp/play/animate.el
index 8dec55178b1..7eb1b277179 100644
--- a/lisp/play/animate.el
+++ b/lisp/play/animate.el
@@ -1,6 +1,6 @@
;;; animate.el --- make text dance -*- lexical-binding:t -*-
-;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Maintainer: Richard Stallman <rms@gnu.org>
;; Keywords: games
diff --git a/lisp/play/blackbox.el b/lisp/play/blackbox.el
index 2b4a10c9288..e3854b55a14 100644
--- a/lisp/play/blackbox.el
+++ b/lisp/play/blackbox.el
@@ -1,6 +1,6 @@
;;; blackbox.el --- blackbox game in Emacs Lisp
-;; Copyright (C) 1985-1987, 1992, 2001-2020 Free Software Foundation,
+;; Copyright (C) 1985-1987, 1992, 2001-2021 Free Software Foundation,
;; Inc.
;; Author: F. Thomas May <uw-nsr!uw-warp!tom@beaver.cs.washington.edu>
diff --git a/lisp/play/bubbles.el b/lisp/play/bubbles.el
index d512a718b48..f317ad51cfc 100644
--- a/lisp/play/bubbles.el
+++ b/lisp/play/bubbles.el
@@ -1,6 +1,6 @@
;;; bubbles.el --- Puzzle game for Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Ulf Jasper <ulf.jasper@web.de>
;; URL: http://ulf.epplejasper.de/
@@ -30,13 +30,6 @@
;; Bubbles is an implementation of the "Same Game", similar to "Same
;; GNOME" and many others, see <https://en.wikipedia.org/wiki/SameGame>.
-;; Installation
-;; ------------
-
-;; Add the following lines to your init file:
-;; (add-to-list 'load-path "/path/to/bubbles/")
-;; (autoload 'bubbles "bubbles" "Play Bubbles" t)
-
;; ======================================================================
;;; History:
diff --git a/lisp/play/cookie1.el b/lisp/play/cookie1.el
index 44a82c4dac4..9cecb706f98 100644
--- a/lisp/play/cookie1.el
+++ b/lisp/play/cookie1.el
@@ -1,6 +1,6 @@
;;; cookie1.el --- retrieve random phrases from fortune cookie files
-;; Copyright (C) 1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 2001-2021 Free Software Foundation, Inc.
;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/play/decipher.el b/lisp/play/decipher.el
index 7a7f96c3bc3..a7a4b89c372 100644
--- a/lisp/play/decipher.el
+++ b/lisp/play/decipher.el
@@ -1,6 +1,6 @@
;;; decipher.el --- cryptanalyze monoalphabetic substitution ciphers
;;
-;; Copyright (C) 1995-1996, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995-1996, 2001-2021 Free Software Foundation, Inc.
;;
;; Author: Christopher J. Madsen <chris_madsen@geocities.com>
;; Keywords: games
@@ -292,8 +292,8 @@ The most useful commands are:
(set-syntax-table decipher-mode-syntax-table)
(unless (= (point-min) (point-max))
(decipher-read-alphabet))
- (set (make-local-variable 'font-lock-defaults)
- '(decipher-font-lock-keywords t))
+ (setq-local font-lock-defaults
+ '(decipher-font-lock-keywords t))
;; Make the buffer writable when we exit Decipher mode:
(add-hook 'change-major-mode-hook
(lambda () (setq buffer-read-only nil
diff --git a/lisp/play/dissociate.el b/lisp/play/dissociate.el
index 9a6300c0fd2..a1cc4727b54 100644
--- a/lisp/play/dissociate.el
+++ b/lisp/play/dissociate.el
@@ -1,6 +1,6 @@
;;; dissociate.el --- scramble text amusingly for Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1985, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 2001-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: games
diff --git a/lisp/play/doctor.el b/lisp/play/doctor.el
index a6f92881857..028f04c325b 100644
--- a/lisp/play/doctor.el
+++ b/lisp/play/doctor.el
@@ -1,6 +1,6 @@
;;; doctor.el --- psychological help for frustrated users
-;; Copyright (C) 1985, 1987, 1994, 1996, 2000-2020 Free Software
+;; Copyright (C) 1985, 1987, 1994, 1996, 2000-2021 Free Software
;; Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
@@ -145,399 +145,399 @@ reads the sentence before point, and prints the Doctor's answer."
(insert "\n"))
(defun make-doctor-variables ()
- (set (make-local-variable 'doctor--typos)
- (mapcar (lambda (x)
- (put (car x) 'doctor-correction (cadr x))
- (put (cadr x) 'doctor-expansion (car (cddr x)))
- (car x))
- '((theyll they\'ll (they will))
- (theyre they\'re (they are))
- (hes he\'s (he is))
- (he7s he\'s (he is))
- (im i\'m (you are))
- (i7m i\'m (you are))
- (isa is\ a (is a))
- (thier their (their))
- (dont don\'t (do not))
- (don7t don\'t (do not))
- (you7re you\'re (i am))
- (you7ve you\'ve (i have))
- (you7ll you\'ll (i will)))))
- (set (make-local-variable 'doctor-sent) nil)
- (set (make-local-variable 'doctor-found) nil)
- (set (make-local-variable 'doctor-owner) nil)
- (set (make-local-variable 'doctor--history) nil)
- (set (make-local-variable 'doctor--inter) '((well\,)
- (hmmm \.\.\.\ so\,)
- (so)
- (\.\.\.and)
- (then)))
- (set (make-local-variable 'doctor--continue) '((continue)
- (proceed)
- (go on)
- (keep going)))
- (set (make-local-variable 'doctor--relation)
- '((your relationship with)
- (something you remember about)
- (your feelings toward)
- (some experiences you have had with)
- (how you feel about)))
- (set (make-local-variable 'doctor--fears)
- '(((doc$ doctor--whysay) you are (doc$ doctor--afraidof) (doc// doctor--feared) \?)
- (you seem terrified by (doc// doctor--feared) \.)
- (when did you first feel (doc$ doctor--afraidof) (doc// doctor--feared) \?)))
- (set (make-local-variable 'doctor--sure) '((sure)
- (positive)
- (certain)
- (absolutely sure)))
- (set (make-local-variable 'doctor--afraidof) '((afraid of)
- (frightened by)
- (scared of)))
- (set (make-local-variable 'doctor--areyou) '((are you)
- (have you been)
- (have you been)))
- (set (make-local-variable 'doctor--isrelated)
- '((has something to do with)
- (is related to)
- (could be the reason for)
- (is caused by)
- (is because of)))
- (set (make-local-variable 'doctor--arerelated) '((have something to do with)
- (are related to)
- (could have caused)
- (could be the reason for)
- (are caused by)
- (are because of)))
- (set (make-local-variable 'doctor--moods)
- '(((doc$ doctor--areyou) (doc// doctor-found) often \?)
- (what causes you to be (doc// doctor-found) \?)
- ((doc$ doctor--whysay) you are (doc// doctor-found) \?)))
- (set (make-local-variable 'doctor--maybe) '((maybe)
- (perhaps)
- (possibly)))
- (set (make-local-variable 'doctor--whatwhen) '((what happened when)
- (what would happen if)))
- (set (make-local-variable 'doctor--hello) '((how do you do \?)
- (hello \.)
- (howdy!)
- (hello \.)
- (hi \.)
- (hi there \.)))
- (set (make-local-variable 'doctor--drnk)
- '((do you drink a lot of (doc// doctor-found) \?)
- (do you get drunk often \?)
- ((doc$ doctor--describe) your drinking habits \.)))
- (set (make-local-variable 'doctor--drugs)
- '((do you use (doc// doctor-found) often \?)
- ((doc$ doctor--areyou) addicted to (doc// doctor-found) \?)
- (do you realize that drugs can be very harmful \?)
- ((doc$ doctor--maybe) you should try to quit using (doc// doctor-found) \.)))
- (set (make-local-variable 'doctor--whywant)
- '(((doc$ doctor--whysay) (doc// doctor-subj) might (doc$ doctor--want) (doc// doctor-obj) \?)
- (how does it feel to want \?)
- (why should (doc// doctor-subj) get (doc// doctor-obj) \?)
- (when did (doc// doctor-subj) first (doc$ doctor--want) (doc// doctor-obj) \?)
- ((doc$ doctor--areyou) obsessed with (doc// doctor-obj) \?)
- (why should i give (doc// doctor-obj) to (doc// doctor-subj) \?)
- (have you ever gotten (doc// doctor-obj) \?)))
- (set (make-local-variable 'doctor--canyou)
- '((of course i can \.)
- (why should i \?)
- (what makes you think i would even want to \?)
- (i am the doctor\, i can do anything i damn please \.)
- (not really\, it\'s not up to me \.)
- (depends\, how important is it \?)
- (i could\, but i don\'t think it would be a wise thing to do \.)
- (can you \?)
- (maybe i can\, maybe i can\'t \.\.\.)
- (i don\'t think i should do that \.)))
- (set (make-local-variable 'doctor--want) '((want) (desire) (wish) (want) (hope)))
- (set (make-local-variable 'doctor--shortlst)
- '((can you elaborate on that \?)
- ((doc$ doctor--please) continue \.)
- (go on\, don\'t be afraid \.)
- (i need a little more detail please \.)
- (you\'re being a bit brief\, (doc$ doctor--please) go into detail \.)
- (can you be more explicit \?)
- (and \?)
- ((doc$ doctor--please) go into more detail \?)
- (you aren\'t being very talkative today\!)
- (is that all there is to it \?)
- (why must you respond so briefly \?)))
- (set (make-local-variable 'doctor--famlst)
- '((tell me (doc$ doctor--something) about (doc// doctor-owner) family \.)
- (you seem to dwell on (doc// doctor-owner) family \.)
- ((doc$ doctor--areyou) hung up on (doc// doctor-owner) family \?)))
- (set (make-local-variable 'doctor--huhlst)
- '(((doc$ doctor--whysay) (doc// doctor-sent) \?)
- (is it because of (doc$ doctor--things) that you say (doc// doctor-sent) \?)))
- (set (make-local-variable 'doctor--longhuhlst)
- '(((doc$ doctor--whysay) that \?)
- (i don\'t understand \.)
- ((doc$ doctor--thlst))
- ((doc$ doctor--areyou) (doc$ doctor--afraidof) that \?)))
- (set (make-local-variable 'doctor--feelings-about) '((feelings about)
- (apprehensions toward)
- (thoughts on)
- (emotions toward)))
- (set (make-local-variable 'doctor--random-adjective)
- '((vivid)
- (emotionally stimulating)
- (exciting)
- (boring)
- (interesting)
- (recent)
- (random) ; how can we omit this?
- (unusual)
- (shocking)
- (embarrassing)))
- (set (make-local-variable 'doctor--whysay) '((why do you say)
- (what makes you believe)
- (are you sure that)
- (do you really think)
- (what makes you think)))
- (set (make-local-variable 'doctor--isee) '((i see \.\.\.)
- (yes\,)
- (i understand \.)
- (oh \.) ))
- (set (make-local-variable 'doctor--please) '((please\,)
- (i would appreciate it if you would)
- (perhaps you could)
- (please\,)
- (would you please)
- (why don\'t you)
- (could you)))
- (set (make-local-variable 'doctor--bye)
- '((my secretary will send you a bill \.)
- (bye bye \.)
- (see ya \.)
- (ok\, talk to you some other time \.)
- (talk to you later \.)
- (ok\, have fun \.)
- (ciao \.)))
- (set (make-local-variable 'doctor--something) '((something)
- (more)
- (how you feel)))
- (set (make-local-variable 'doctor--thing) '((your life)
- (your sex life)))
- (set (make-local-variable 'doctor--things) '((your plans)
- (the people you hang around with)
- (problems at school)
- (any hobbies you have)
- (hangups you have)
- (your inhibitions)
- (some problems in your childhood)
- (some problems at home)))
- (set (make-local-variable 'doctor--describe) '((describe)
- (tell me about)
- (talk about)
- (discuss)
- (tell me more about)
- (elaborate on)))
- (set (make-local-variable 'doctor--ibelieve)
- '((i believe) (i think) (i have a feeling) (it seems to me that)
- (it looks like)))
- (set (make-local-variable 'doctor--problems) '((problems)
- (inhibitions)
- (hangups)
- (difficulties)
- (anxieties)
- (frustrations)))
- (set (make-local-variable 'doctor--bother) '((does it bother you that)
- (are you annoyed that)
- (did you ever regret)
- (are you sorry)
- (are you satisfied with the fact that)))
- (set (make-local-variable 'doctor--machlst)
- '((you have your mind on (doc// doctor-found) \, it seems \.)
- (you think too much about (doc// doctor-found) \.)
- (you should try taking your mind off of (doc// doctor-found)\.)
- (are you a computer hacker \?)))
- (set (make-local-variable 'doctor--qlist)
- '((what do you think \?)
- (i\'ll ask the questions\, if you don\'t mind!)
- (i could ask the same thing myself \.)
- ((doc$ doctor--please) allow me to do the questioning \.)
- (i have asked myself that question many times \.)
- ((doc$ doctor--please) try to answer that question yourself \.)))
- (set (make-local-variable 'doctor--foullst)
- '(((doc$ doctor--please) watch your tongue!)
- ((doc$ doctor--please) avoid such unwholesome thoughts \.)
- ((doc$ doctor--please) get your mind out of the gutter \.)
- (such lewdness is not appreciated \.)))
- (set (make-local-variable 'doctor--deathlst)
- '((this is not a healthy way of thinking \.)
- ((doc$ doctor--bother) you\, too\, may die someday \?)
- (i am worried by your obsession with this topic!)
- (did you watch a lot of crime and violence on television as a child \?)))
- (set (make-local-variable 'doctor--sexlst)
- '(((doc$ doctor--areyou) (doc$ doctor--afraidof) sex \?)
- ((doc$ doctor--describe) (doc$ doctor--something) about your sexual history \.)
- ((doc$ doctor--please) (doc$ doctor--describe) your sex life \.\.\.)
- ((doc$ doctor--describe) your (doc$ doctor--feelings-about) your sexual partner \.)
- ((doc$ doctor--describe) your most (doc$ doctor--random-adjective) sexual experience \.)
- ((doc$ doctor--areyou) satisfied with (doc// doctor--lover) \.\.\. \?)))
- (set (make-local-variable 'doctor--neglst) '((why not \?)
- ((doc$ doctor--bother) i ask that \?)
- (why not \?)
- (why not \?)
- (how come \?)
- ((doc$ doctor--bother) i ask that \?)))
- (set (make-local-variable 'doctor--beclst)
- '((is it because (doc// doctor-sent) that you came to me \?)
- ((doc$ doctor--bother) (doc// doctor-sent) \?)
- (when did you first know that (doc// doctor-sent) \?)
- (is the fact that (doc// doctor-sent) the real reason \?)
- (does the fact that (doc// doctor-sent) explain anything else \?)
- ((doc$ doctor--areyou) (doc$ doctor--sure) (doc// doctor-sent) \? )))
- (set (make-local-variable 'doctor--shortbeclst)
- '(((doc$ doctor--bother) i ask you that \?)
- (that\'s not much of an answer!)
- ((doc$ doctor--inter) why won\'t you talk about it \?)
- (speak up!)
- ((doc$ doctor--areyou) (doc$ doctor--afraidof) talking about it \?)
- (don\'t be (doc$ doctor--afraidof) elaborating \.)
- ((doc$ doctor--please) go into more detail \.)))
- (set (make-local-variable 'doctor--thlst)
- '(((doc$ doctor--maybe) (doc$ doctor--thing) (doc$ doctor--isrelated) this \.)
- ((doc$ doctor--maybe) (doc$ doctor--things) (doc$ doctor--arerelated) this \.)
- (is it because of (doc$ doctor--things) that you are going through all this \?)
- (how do you reconcile (doc$ doctor--things) \? )
- ((doc$ doctor--maybe) this (doc$ doctor--isrelated) (doc$ doctor--things) \?)))
- (set (make-local-variable 'doctor--remlst)
- '((earlier you said (doc$ doctor--history) \?)
- (you mentioned that (doc$ doctor--history) \?)
- ((doc$ doctor--whysay) (doc$ doctor--history) \? )))
- (set (make-local-variable 'doctor--toklst)
- '((is this how you relax \?)
- (how long have you been smoking grass \?)
- ((doc$ doctor--areyou) (doc$ doctor--afraidof) of being drawn to using harder stuff \?)))
- (set (make-local-variable 'doctor--states)
- '((do you get (doc// doctor-found) often \?)
- (do you enjoy being (doc// doctor-found) \?)
- (what makes you (doc// doctor-found) \?)
- (how often (doc$ doctor--areyou) (doc// doctor-found) \?)
- (when were you last (doc// doctor-found) \?)))
- (set (make-local-variable 'doctor--replist) '((i . (you))
- (my . (your))
- (me . (you))
- (you . (me))
- (your . (my))
- (mine . (yours))
- (yours . (mine))
- (our . (your))
- (ours . (yours))
- (we . (you))
- (dunno . (do not know))
- ;; (yes . ())
- (no\, . ())
- (yes\, . ())
- (ya . (i))
- (aint . (am not))
- (wanna . (want to))
- (gimme . (give me))
- (gotta . (have to))
- (gonna . (going to))
- (never . (not ever))
- (doesn\'t . (does not))
- (don\'t . (do not))
- (aren\'t . (are not))
- (isn\'t . (is not))
- (won\'t . (will not))
- (can\'t . (cannot))
- (haven\'t . (have not))
- (i\'m . (you are))
- (ourselves . (yourselves))
- (myself . (yourself))
- (yourself . (myself))
- (you\'re . (i am))
- (you\'ve . (i have))
- (i\'ve . (you have))
- (i\'ll . (you will))
- (you\'ll . (i shall))
- (i\'d . (you would))
- (you\'d . (i would))
- (here . (there))
- (please . ())
- (eh\, . ())
- (eh . ())
- (oh\, . ())
- (oh . ())
- (shouldn\'t . (should not))
- (wouldn\'t . (would not))
- (won\'t . (will not))
- (hasn\'t . (has not))))
- (set (make-local-variable 'doctor--stallmanlst)
- '(((doc$ doctor--describe) your (doc$ doctor--feelings-about) him \.)
- ((doc$ doctor--areyou) a friend of Stallman \?)
- ((doc$ doctor--bother) Stallman is (doc$ doctor--random-adjective) \?)
- ((doc$ doctor--ibelieve) you are (doc$ doctor--afraidof) him \.)))
- (set (make-local-variable 'doctor--schoollst)
- '(((doc$ doctor--describe) your (doc// doctor-found) \.)
- ((doc$ doctor--bother) your grades could (doc$ doctor--improve) \?)
- ((doc$ doctor--areyou) (doc$ doctor--afraidof) (doc// doctor-found) \?)
- ((doc$ doctor--maybe) this (doc$ doctor--isrelated) to your attitude \.)
- ((doc$ doctor--areyou) absent often \?)
- ((doc$ doctor--maybe) you should study (doc$ doctor--something) \.)))
- (set (make-local-variable 'doctor--improve)
- '((improve) (be better) (be improved) (be higher)))
- (set (make-local-variable 'doctor--elizalst)
- '(((doc$ doctor--areyou) (doc$ doctor--sure) \?)
- ((doc$ doctor--ibelieve) you have (doc$ doctor--problems) with (doc// doctor-found) \.)
- ((doc$ doctor--whysay) (doc// doctor-sent) \?)))
- (set (make-local-variable 'doctor--sportslst)
- '((tell me (doc$ doctor--something) about (doc// doctor-found) \.)
- ((doc$ doctor--describe) (doc$ doctor--relation) (doc// doctor-found) \.)
- (do you find (doc// doctor-found) (doc$ doctor--random-adjective) \?)))
- (set (make-local-variable 'doctor--mathlst)
- '(((doc$ doctor--describe) (doc$ doctor--something) about math \.)
- ((doc$ doctor--maybe) your (doc$ doctor--problems) (doc$ doctor--arerelated) (doc// doctor-found) \.)
- (i don\'t know much (doc// doctor-found) \, but (doc$ doctor--continue)
- anyway \.)))
- (set (make-local-variable 'doctor--zippylst)
- '(((doc$ doctor--areyou) Zippy \?)
- ((doc$ doctor--ibelieve) you have some serious (doc$ doctor--problems) \.)
- ((doc$ doctor--bother) you are a pinhead \?)))
- (set (make-local-variable 'doctor--chatlst)
- '(((doc$ doctor--maybe) we could chat \.)
- ((doc$ doctor--please) (doc$ doctor--describe) (doc$ doctor--something) about chat mode \.)
- ((doc$ doctor--bother) our discussion is so (doc$ doctor--random-adjective) \?)))
- (set (make-local-variable 'doctor--abuselst)
- '(((doc$ doctor--please) try to be less abusive \.)
- ((doc$ doctor--describe) why you call me (doc// doctor-found) \.)
- (i\'ve had enough of you!)))
- (set (make-local-variable 'doctor--abusewords)
- '(boring bozo clown clumsy cretin dumb dummy
- fool foolish gnerd gnurd idiot jerk
- lose loser louse lousy luse luser
- moron nerd nurd oaf oafish reek
- stink stupid tool toolish twit))
- (set (make-local-variable 'doctor--howareyoulst)
- '((how are you) (hows it going) (hows it going eh)
- (how\'s it going) (how\'s it going eh) (how goes it)
- (whats up) (whats new) (what\'s up) (what\'s new)
- (howre you) (how\'re you) (how\'s everything)
- (how is everything) (how do you do)
- (how\'s it hanging) (que pasa)
- (how are you doing) (what do you say)))
- (set (make-local-variable 'doctor--whereoutp) '(huh remem rthing))
- (set (make-local-variable 'doctor-subj) nil)
- (set (make-local-variable 'doctor-verb) nil)
- (set (make-local-variable 'doctor-obj) nil)
- (set (make-local-variable 'doctor--feared) nil)
- (set (make-local-variable 'doctor--repetitive-shortness) '(0 . 0))
- (set (make-local-variable 'doctor--**mad**) nil)
- (set (make-local-variable 'doctor--rms-flag) nil)
- (set (make-local-variable 'doctor--eliza-flag) nil)
- (set (make-local-variable 'doctor--zippy-flag) nil)
- (set (make-local-variable 'doctor--suicide-flag) nil)
- (set (make-local-variable 'doctor--lover) '(your partner))
- (set (make-local-variable 'doctor--bak) nil)
- (set (make-local-variable 'doctor--lincount) 0)
- (set (make-local-variable 'doctor--*print-upcase*) nil)
- (set (make-local-variable 'doctor--*print-space*) nil)
- (set (make-local-variable 'doctor--howdyflag) nil)
- (set (make-local-variable 'doctor-object) nil))
+ (setq-local doctor--typos
+ (mapcar (lambda (x)
+ (put (car x) 'doctor-correction (cadr x))
+ (put (cadr x) 'doctor-expansion (car (cddr x)))
+ (car x))
+ '((theyll they\'ll (they will))
+ (theyre they\'re (they are))
+ (hes he\'s (he is))
+ (he7s he\'s (he is))
+ (im i\'m (you are))
+ (i7m i\'m (you are))
+ (isa is\ a (is a))
+ (thier their (their))
+ (dont don\'t (do not))
+ (don7t don\'t (do not))
+ (you7re you\'re (i am))
+ (you7ve you\'ve (i have))
+ (you7ll you\'ll (i will)))))
+ (setq-local doctor-sent nil)
+ (setq-local doctor-found nil)
+ (setq-local doctor-owner nil)
+ (setq-local doctor--history nil)
+ (setq-local doctor--inter '((well\,)
+ (hmmm \.\.\.\ so\,)
+ (so)
+ (\.\.\.and)
+ (then)))
+ (setq-local doctor--continue '((continue)
+ (proceed)
+ (go on)
+ (keep going)))
+ (setq-local doctor--relation
+ '((your relationship with)
+ (something you remember about)
+ (your feelings toward)
+ (some experiences you have had with)
+ (how you feel about)))
+ (setq-local doctor--fears
+ '(((doc$ doctor--whysay) you are (doc$ doctor--afraidof) (doc// doctor--feared) \?)
+ (you seem terrified by (doc// doctor--feared) \.)
+ (when did you first feel (doc$ doctor--afraidof) (doc// doctor--feared) \?)))
+ (setq-local doctor--sure '((sure)
+ (positive)
+ (certain)
+ (absolutely sure)))
+ (setq-local doctor--afraidof '((afraid of)
+ (frightened by)
+ (scared of)))
+ (setq-local doctor--areyou '((are you)
+ (have you been)
+ (have you been)))
+ (setq-local doctor--isrelated
+ '((has something to do with)
+ (is related to)
+ (could be the reason for)
+ (is caused by)
+ (is because of)))
+ (setq-local doctor--arerelated '((have something to do with)
+ (are related to)
+ (could have caused)
+ (could be the reason for)
+ (are caused by)
+ (are because of)))
+ (setq-local doctor--moods
+ '(((doc$ doctor--areyou) (doc// doctor-found) often \?)
+ (what causes you to be (doc// doctor-found) \?)
+ ((doc$ doctor--whysay) you are (doc// doctor-found) \?)))
+ (setq-local doctor--maybe '((maybe)
+ (perhaps)
+ (possibly)))
+ (setq-local doctor--whatwhen '((what happened when)
+ (what would happen if)))
+ (setq-local doctor--hello '((how do you do \?)
+ (hello \.)
+ (howdy!)
+ (hello \.)
+ (hi \.)
+ (hi there \.)))
+ (setq-local doctor--drnk
+ '((do you drink a lot of (doc// doctor-found) \?)
+ (do you get drunk often \?)
+ ((doc$ doctor--describe) your drinking habits \.)))
+ (setq-local doctor--drugs
+ '((do you use (doc// doctor-found) often \?)
+ ((doc$ doctor--areyou) addicted to (doc// doctor-found) \?)
+ (do you realize that drugs can be very harmful \?)
+ ((doc$ doctor--maybe) you should try to quit using (doc// doctor-found) \.)))
+ (setq-local doctor--whywant
+ '(((doc$ doctor--whysay) (doc// doctor-subj) might (doc$ doctor--want) (doc// doctor-obj) \?)
+ (how does it feel to want \?)
+ (why should (doc// doctor-subj) get (doc// doctor-obj) \?)
+ (when did (doc// doctor-subj) first (doc$ doctor--want) (doc// doctor-obj) \?)
+ ((doc$ doctor--areyou) obsessed with (doc// doctor-obj) \?)
+ (why should i give (doc// doctor-obj) to (doc// doctor-subj) \?)
+ (have you ever gotten (doc// doctor-obj) \?)))
+ (setq-local doctor--canyou
+ '((of course i can \.)
+ (why should i \?)
+ (what makes you think i would even want to \?)
+ (i am the doctor\, i can do anything i damn please \.)
+ (not really\, it\'s not up to me \.)
+ (depends\, how important is it \?)
+ (i could\, but i don\'t think it would be a wise thing to do \.)
+ (can you \?)
+ (maybe i can\, maybe i can\'t \.\.\.)
+ (i don\'t think i should do that \.)))
+ (setq-local doctor--want '((want) (desire) (wish) (want) (hope)))
+ (setq-local doctor--shortlst
+ '((can you elaborate on that \?)
+ ((doc$ doctor--please) continue \.)
+ (go on\, don\'t be afraid \.)
+ (i need a little more detail please \.)
+ (you\'re being a bit brief\, (doc$ doctor--please) go into detail \.)
+ (can you be more explicit \?)
+ (and \?)
+ ((doc$ doctor--please) go into more detail \?)
+ (you aren\'t being very talkative today\!)
+ (is that all there is to it \?)
+ (why must you respond so briefly \?)))
+ (setq-local doctor--famlst
+ '((tell me (doc$ doctor--something) about (doc// doctor-owner) family \.)
+ (you seem to dwell on (doc// doctor-owner) family \.)
+ ((doc$ doctor--areyou) hung up on (doc// doctor-owner) family \?)))
+ (setq-local doctor--huhlst
+ '(((doc$ doctor--whysay) (doc// doctor-sent) \?)
+ (is it because of (doc$ doctor--things) that you say (doc// doctor-sent) \?)))
+ (setq-local doctor--longhuhlst
+ '(((doc$ doctor--whysay) that \?)
+ (i don\'t understand \.)
+ ((doc$ doctor--thlst))
+ ((doc$ doctor--areyou) (doc$ doctor--afraidof) that \?)))
+ (setq-local doctor--feelings-about '((feelings about)
+ (apprehensions toward)
+ (thoughts on)
+ (emotions toward)))
+ (setq-local doctor--random-adjective
+ '((vivid)
+ (emotionally stimulating)
+ (exciting)
+ (boring)
+ (interesting)
+ (recent)
+ (random) ; how can we omit this?
+ (unusual)
+ (shocking)
+ (embarrassing)))
+ (setq-local doctor--whysay '((why do you say)
+ (what makes you believe)
+ (are you sure that)
+ (do you really think)
+ (what makes you think)))
+ (setq-local doctor--isee '((i see \.\.\.)
+ (yes\,)
+ (i understand \.)
+ (oh \.) ))
+ (setq-local doctor--please '((please\,)
+ (i would appreciate it if you would)
+ (perhaps you could)
+ (please\,)
+ (would you please)
+ (why don\'t you)
+ (could you)))
+ (setq-local doctor--bye
+ '((my secretary will send you a bill \.)
+ (bye bye \.)
+ (see ya \.)
+ (ok\, talk to you some other time \.)
+ (talk to you later \.)
+ (ok\, have fun \.)
+ (ciao \.)))
+ (setq-local doctor--something '((something)
+ (more)
+ (how you feel)))
+ (setq-local doctor--thing '((your life)
+ (your sex life)))
+ (setq-local doctor--things '((your plans)
+ (the people you hang around with)
+ (problems at school)
+ (any hobbies you have)
+ (hangups you have)
+ (your inhibitions)
+ (some problems in your childhood)
+ (some problems at home)))
+ (setq-local doctor--describe '((describe)
+ (tell me about)
+ (talk about)
+ (discuss)
+ (tell me more about)
+ (elaborate on)))
+ (setq-local doctor--ibelieve
+ '((i believe) (i think) (i have a feeling) (it seems to me that)
+ (it looks like)))
+ (setq-local doctor--problems '((problems)
+ (inhibitions)
+ (hangups)
+ (difficulties)
+ (anxieties)
+ (frustrations)))
+ (setq-local doctor--bother '((does it bother you that)
+ (are you annoyed that)
+ (did you ever regret)
+ (are you sorry)
+ (are you satisfied with the fact that)))
+ (setq-local doctor--machlst
+ '((you have your mind on (doc// doctor-found) \, it seems \.)
+ (you think too much about (doc// doctor-found) \.)
+ (you should try taking your mind off of (doc// doctor-found)\.)
+ (are you a computer hacker \?)))
+ (setq-local doctor--qlist
+ '((what do you think \?)
+ (i\'ll ask the questions\, if you don\'t mind!)
+ (i could ask the same thing myself \.)
+ ((doc$ doctor--please) allow me to do the questioning \.)
+ (i have asked myself that question many times \.)
+ ((doc$ doctor--please) try to answer that question yourself \.)))
+ (setq-local doctor--foullst
+ '(((doc$ doctor--please) watch your tongue!)
+ ((doc$ doctor--please) avoid such unwholesome thoughts \.)
+ ((doc$ doctor--please) get your mind out of the gutter \.)
+ (such lewdness is not appreciated \.)))
+ (setq-local doctor--deathlst
+ '((this is not a healthy way of thinking \.)
+ ((doc$ doctor--bother) you\, too\, may die someday \?)
+ (i am worried by your obsession with this topic!)
+ (did you watch a lot of crime and violence on television as a child \?)))
+ (setq-local doctor--sexlst
+ '(((doc$ doctor--areyou) (doc$ doctor--afraidof) sex \?)
+ ((doc$ doctor--describe) (doc$ doctor--something) about your sexual history \.)
+ ((doc$ doctor--please) (doc$ doctor--describe) your sex life \.\.\.)
+ ((doc$ doctor--describe) your (doc$ doctor--feelings-about) your sexual partner \.)
+ ((doc$ doctor--describe) your most (doc$ doctor--random-adjective) sexual experience \.)
+ ((doc$ doctor--areyou) satisfied with (doc// doctor--lover) \.\.\. \?)))
+ (setq-local doctor--neglst '((why not \?)
+ ((doc$ doctor--bother) i ask that \?)
+ (why not \?)
+ (why not \?)
+ (how come \?)
+ ((doc$ doctor--bother) i ask that \?)))
+ (setq-local doctor--beclst
+ '((is it because (doc// doctor-sent) that you came to me \?)
+ ((doc$ doctor--bother) (doc// doctor-sent) \?)
+ (when did you first know that (doc// doctor-sent) \?)
+ (is the fact that (doc// doctor-sent) the real reason \?)
+ (does the fact that (doc// doctor-sent) explain anything else \?)
+ ((doc$ doctor--areyou) (doc$ doctor--sure) (doc// doctor-sent) \? )))
+ (setq-local doctor--shortbeclst
+ '(((doc$ doctor--bother) i ask you that \?)
+ (that\'s not much of an answer!)
+ ((doc$ doctor--inter) why won\'t you talk about it \?)
+ (speak up!)
+ ((doc$ doctor--areyou) (doc$ doctor--afraidof) talking about it \?)
+ (don\'t be (doc$ doctor--afraidof) elaborating \.)
+ ((doc$ doctor--please) go into more detail \.)))
+ (setq-local doctor--thlst
+ '(((doc$ doctor--maybe) (doc$ doctor--thing) (doc$ doctor--isrelated) this \.)
+ ((doc$ doctor--maybe) (doc$ doctor--things) (doc$ doctor--arerelated) this \.)
+ (is it because of (doc$ doctor--things) that you are going through all this \?)
+ (how do you reconcile (doc$ doctor--things) \? )
+ ((doc$ doctor--maybe) this (doc$ doctor--isrelated) (doc$ doctor--things) \?)))
+ (setq-local doctor--remlst
+ '((earlier you said (doc$ doctor--history) \?)
+ (you mentioned that (doc$ doctor--history) \?)
+ ((doc$ doctor--whysay) (doc$ doctor--history) \? )))
+ (setq-local doctor--toklst
+ '((is this how you relax \?)
+ (how long have you been smoking grass \?)
+ ((doc$ doctor--areyou) (doc$ doctor--afraidof) of being drawn to using harder stuff \?)))
+ (setq-local doctor--states
+ '((do you get (doc// doctor-found) often \?)
+ (do you enjoy being (doc// doctor-found) \?)
+ (what makes you (doc// doctor-found) \?)
+ (how often (doc$ doctor--areyou) (doc// doctor-found) \?)
+ (when were you last (doc// doctor-found) \?)))
+ (setq-local doctor--replist '((i . (you))
+ (my . (your))
+ (me . (you))
+ (you . (me))
+ (your . (my))
+ (mine . (yours))
+ (yours . (mine))
+ (our . (your))
+ (ours . (yours))
+ (we . (you))
+ (dunno . (do not know))
+ ;; (yes . ())
+ (no\, . ())
+ (yes\, . ())
+ (ya . (i))
+ (aint . (am not))
+ (wanna . (want to))
+ (gimme . (give me))
+ (gotta . (have to))
+ (gonna . (going to))
+ (never . (not ever))
+ (doesn\'t . (does not))
+ (don\'t . (do not))
+ (aren\'t . (are not))
+ (isn\'t . (is not))
+ (won\'t . (will not))
+ (can\'t . (cannot))
+ (haven\'t . (have not))
+ (i\'m . (you are))
+ (ourselves . (yourselves))
+ (myself . (yourself))
+ (yourself . (myself))
+ (you\'re . (i am))
+ (you\'ve . (i have))
+ (i\'ve . (you have))
+ (i\'ll . (you will))
+ (you\'ll . (i shall))
+ (i\'d . (you would))
+ (you\'d . (i would))
+ (here . (there))
+ (please . ())
+ (eh\, . ())
+ (eh . ())
+ (oh\, . ())
+ (oh . ())
+ (shouldn\'t . (should not))
+ (wouldn\'t . (would not))
+ (won\'t . (will not))
+ (hasn\'t . (has not))))
+ (setq-local doctor--stallmanlst
+ '(((doc$ doctor--describe) your (doc$ doctor--feelings-about) him \.)
+ ((doc$ doctor--areyou) a friend of Stallman \?)
+ ((doc$ doctor--bother) Stallman is (doc$ doctor--random-adjective) \?)
+ ((doc$ doctor--ibelieve) you are (doc$ doctor--afraidof) him \.)))
+ (setq-local doctor--schoollst
+ '(((doc$ doctor--describe) your (doc// doctor-found) \.)
+ ((doc$ doctor--bother) your grades could (doc$ doctor--improve) \?)
+ ((doc$ doctor--areyou) (doc$ doctor--afraidof) (doc// doctor-found) \?)
+ ((doc$ doctor--maybe) this (doc$ doctor--isrelated) to your attitude \.)
+ ((doc$ doctor--areyou) absent often \?)
+ ((doc$ doctor--maybe) you should study (doc$ doctor--something) \.)))
+ (setq-local doctor--improve
+ '((improve) (be better) (be improved) (be higher)))
+ (setq-local doctor--elizalst
+ '(((doc$ doctor--areyou) (doc$ doctor--sure) \?)
+ ((doc$ doctor--ibelieve) you have (doc$ doctor--problems) with (doc// doctor-found) \.)
+ ((doc$ doctor--whysay) (doc// doctor-sent) \?)))
+ (setq-local doctor--sportslst
+ '((tell me (doc$ doctor--something) about (doc// doctor-found) \.)
+ ((doc$ doctor--describe) (doc$ doctor--relation) (doc// doctor-found) \.)
+ (do you find (doc// doctor-found) (doc$ doctor--random-adjective) \?)))
+ (setq-local doctor--mathlst
+ '(((doc$ doctor--describe) (doc$ doctor--something) about math \.)
+ ((doc$ doctor--maybe) your (doc$ doctor--problems) (doc$ doctor--arerelated) (doc// doctor-found) \.)
+ (i don\'t know much (doc// doctor-found) \, but (doc$ doctor--continue)
+ anyway \.)))
+ (setq-local doctor--zippylst
+ '(((doc$ doctor--areyou) Zippy \?)
+ ((doc$ doctor--ibelieve) you have some serious (doc$ doctor--problems) \.)
+ ((doc$ doctor--bother) you are a pinhead \?)))
+ (setq-local doctor--chatlst
+ '(((doc$ doctor--maybe) we could chat \.)
+ ((doc$ doctor--please) (doc$ doctor--describe) (doc$ doctor--something) about chat mode \.)
+ ((doc$ doctor--bother) our discussion is so (doc$ doctor--random-adjective) \?)))
+ (setq-local doctor--abuselst
+ '(((doc$ doctor--please) try to be less abusive \.)
+ ((doc$ doctor--describe) why you call me (doc// doctor-found) \.)
+ (i\'ve had enough of you!)))
+ (setq-local doctor--abusewords
+ '(boring bozo clown clumsy cretin dumb dummy
+ fool foolish gnerd gnurd idiot jerk
+ lose loser louse lousy luse luser
+ moron nerd nurd oaf oafish reek
+ stink stupid tool toolish twit))
+ (setq-local doctor--howareyoulst
+ '((how are you) (hows it going) (hows it going eh)
+ (how\'s it going) (how\'s it going eh) (how goes it)
+ (whats up) (whats new) (what\'s up) (what\'s new)
+ (howre you) (how\'re you) (how\'s everything)
+ (how is everything) (how do you do)
+ (how\'s it hanging) (que pasa)
+ (how are you doing) (what do you say)))
+ (setq-local doctor--whereoutp '(huh remem rthing))
+ (setq-local doctor-subj nil)
+ (setq-local doctor-verb nil)
+ (setq-local doctor-obj nil)
+ (setq-local doctor--feared nil)
+ (setq-local doctor--repetitive-shortness '(0 . 0))
+ (setq-local doctor--**mad** nil)
+ (setq-local doctor--rms-flag nil)
+ (setq-local doctor--eliza-flag nil)
+ (setq-local doctor--zippy-flag nil)
+ (setq-local doctor--suicide-flag nil)
+ (setq-local doctor--lover '(your partner))
+ (setq-local doctor--bak nil)
+ (setq-local doctor--lincount 0)
+ (setq-local doctor--*print-upcase* nil)
+ (setq-local doctor--*print-space* nil)
+ (setq-local doctor--howdyflag nil)
+ (setq-local doctor-object nil))
;; Define equivalence classes of words that get treated alike.
diff --git a/lisp/play/dunnet.el b/lisp/play/dunnet.el
index 8a69f9decf0..3916e35f769 100644
--- a/lisp/play/dunnet.el
+++ b/lisp/play/dunnet.el
@@ -1,6 +1,6 @@
;;; dunnet.el --- text adventure for Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1992-1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1992-1993, 2001-2021 Free Software Foundation, Inc.
;; Author: Ron Schnell <ronnie@driver-aces.com>
;; Created: 25 Jul 1992
@@ -25,7 +25,8 @@
;;; Commentary:
;; This game can be run in batch mode. To do this, use:
-;; emacs -batch -l dunnet
+;;
+;; emacs --batch -f dunnet
;;; Code:
@@ -46,10 +47,10 @@
;;;;
;;;; This section defines the globals that are used in dunnet.
-;;;;
-;;;; IMPORTANT
-;;;; All globals which can change must be saved from 'save-game. Add
-;;;; all new globals to bottom of this section.
+;;
+;; IMPORTANT
+;; All globals which can change must be saved from 'save-game.
+;; Add all new globals to bottom of this section.
(defvar dun-visited '(27))
(defvar dun-current-room 1)
@@ -771,7 +772,6 @@ A hole leads north."
)
-;;; How the user references *all* objects, permanent and regular.
(defconst dun-objnames
'((shovel . 0)
(lamp . 1)
@@ -831,7 +831,8 @@ A hole leads north."
(ladder . -27)
(subway . -28) (train . -28)
(pc . -29) (drive . -29) (coconut . -30) (coconuts . -30)
- (lake . -32) (water . -32)))
+ (lake . -32) (water . -32))
+ "How the user references *all* objects, permanent and regular.")
(dolist (x dun-objnames)
(let (name)
@@ -840,13 +841,6 @@ A hole leads north."
(defconst obj-special 255)
-;;; The initial setup of what objects are in each room.
-;;; Regular objects have whole numbers lower than 255.
-;;; Objects that cannot be taken but might move and are
-;;; described during room description are negative.
-;;; Stuff that is described and might change are 255, and are
-;;; handled specially by 'dun-describe-room.
-
(defvar dun-room-objects (list nil
(list obj-shovel) ;; treasure-room
@@ -899,10 +893,13 @@ A hole leads north."
nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
-nil))
-
-;;; These are objects in a room that are only described in the
-;;; room description. They are permanent.
+nil)
+ "The initial setup of what objects are in each room.
+Regular objects have whole numbers lower than 255.
+Objects that cannot be taken but might move and are
+described during room description are negative.
+Stuff that is described and might change are 255, and are
+handled specially by 'dun-describe-room.")
(defconst dun-room-silents (list nil
(list obj-tree obj-coconut) ;; dead-end
@@ -947,12 +944,11 @@ nil))
nil nil nil nil nil nil nil nil
(list obj-pc) ;; pc-area
nil nil nil nil nil nil
-))
+ )
+ "These are objects in a room that are only described in the
+room description. They are permanent.")
(defvar dun-inventory '(1))
-;;; Descriptions of objects, as they appear in the room description, and
-;;; the inventory.
-
(defconst dun-objects
'(("There is a shovel here." "A shovel") ;0
("There is a lamp nearby." "A lamp") ;1
@@ -982,26 +978,24 @@ nil))
("There is a valuable amethyst here." "An amethyst") ;24
("The Mona Lisa is here." "The Mona Lisa") ;25
("There is a 100 dollar bill here." "A $100 bill") ;26
- ("There is a floppy disk here." "A floppy disk"))) ;27
-
-;;; Weight of objects
+ ("There is a floppy disk here." "A floppy disk")) ;27
+ "Descriptions of objects, as they appear in the room description, and
+the inventory.")
(defconst dun-object-lbs
- '(2 1 1 1 1 0 2 2 10 3 1 1 1 0 1 1 0 1 1 1 1 0 0 2 2 1 0 0))
+ '(2 1 1 1 1 0 2 2 10 3 1 1 1 0 1 1 0 1 1 1 1 0 0 2 2 1 0 0)
+ "Weight of objects.")
(defconst dun-object-pts
'(0 0 0 0 0 0 0 10 0 0 10 10 10 0 0 10 0 10 10 0 0 0 0 10 10 10 10 0))
-;;; Unix representation of objects.
(defconst dun-objfiles
'("shovel.o" "lamp.o" "cpu.o" "food.o" "key.o" "paper.o"
"rms.o" "diamond.o" "weight.o" "preserver.o" "bracelet.o"
"gold.o" "platinum.o" "towel.o" "axe.o" "silver.o" "license.o"
"coins.o" "egg.o" "jar.o" "bone.o" "nitric.o" "glycerine.o"
- "ruby.o" "amethyst.o"))
-
-;;; These are the descriptions for the negative numbered objects from
-;;; dun-room-objects
+ "ruby.o" "amethyst.o")
+ "Unix representation of objects.")
(defconst dun-perm-objects
'(nil
@@ -1016,11 +1010,10 @@ nil))
("There is a box with a slit in it, bolted to the wall here.")
nil nil
("There is a bus here.")
- nil nil nil))
-
+ nil nil nil)
+ "These are the descriptions for the negative numbered objects from
+`dun-room-objects'.")
-;;; These are the descriptions the user gets when regular objects are
-;;; examined.
(defconst dun-physobj-desc '(
"It is a normal shovel with a price tag attached that says $19.99."
@@ -1043,10 +1036,8 @@ nil nil
"They are old coins from the 19th century."
"It is a valuable Fabrege egg."
"It is a plain glass jar."
-nil nil nil nil nil))
-
-;;; These are the descriptions the user gets when non-regular objects
-;;; are examined.
+nil nil nil nil nil)
+ "The descriptions the user gets when regular objects are examined.")
(defconst dun-permobj-desc
'(nil
@@ -1087,7 +1078,8 @@ it. It is very big, though."
nil nil nil nil
"It is a normal ladder that is permanently attached to the hole."
"It is a passenger train that is ready to go."
-"It is a personal computer that has only one floppy disk drive."))
+"It is a personal computer that has only one floppy disk drive.")
+ "The descriptions the user gets when non-regular objects are examined.")
(defconst dun-diggables
(list nil nil nil (list obj-cpu) nil nil nil nil nil nil nil
@@ -1144,8 +1136,7 @@ treasures for points?" "4" "four")
(define-derived-mode dun-mode text-mode "Dungeon"
"Major mode for running dunnet."
- (make-local-variable 'scroll-step)
- (setq scroll-step 2))
+ (setq-local scroll-step 2))
(defun dun-parse (_arg)
"Function called when return is pressed in interactive mode to parse line."
@@ -1180,20 +1171,21 @@ treasures for points?" "4" "four")
(defun dunnet ()
"Switch to *dungeon* buffer and start game."
(interactive)
- (pop-to-buffer-same-window "*dungeon*")
- (dun-mode)
- (setq dun-dead nil)
- (setq dun-room 0)
- (dun-messages))
+ (if noninteractive
+ (dun--batch)
+ (pop-to-buffer-same-window "*dungeon*")
+ (dun-mode)
+ (setq dun-dead nil)
+ (setq dun-room 0)
+ (dun-messages)))
;;;;
;;;; This section contains all of the verbs and commands.
;;;;
-;;; Give long description of room if haven't been there yet. Otherwise
-;;; short. Also give long if we were called with negative room number.
-
(defun dun-describe-room (room)
+ "Give long description of room if haven't been there yet.
+Otherwise short. Also give long if we were called with negative room number."
(if (and (not (member (abs room) dun-light-rooms))
(not (member obj-lamp dun-inventory))
(not (member obj-lamp (nth dun-current-room dun-room-objects))))
@@ -1223,10 +1215,9 @@ treasures for points?" "4" "four")
(if (and (member obj-bus (nth dun-current-room dun-room-objects)) dun-inbus)
(dun-mprincl "You are on the bus."))))
-;;; There is a special object in the room. This object's description,
-;;; or lack thereof, depends on certain conditions.
-
(defun dun-special-object ()
+ "There is a special object in the room. This object's description,
+or lack thereof, depends on certain conditions."
(cond
((= dun-current-room computer-room)
(if dun-computer
@@ -1299,10 +1290,9 @@ disk bursts into flames, and disintegrates.")
(defun dun-quit (_args)
(dun-die nil))
-;;; Print every object in player's inventory. Special case for the jar,
-;;; as we must also print what is in it.
-
(defun dun-inven (_args)
+ "Print every object in player's inventory.
+Special case for the jar, as we must also print what is in it."
(dun-mprincl "You currently have:")
(dolist (curobj dun-inventory)
(when curobj
@@ -1353,9 +1343,8 @@ on your head.")
(if (member objnum (list obj-food obj-weight obj-jar))
(dun-drop-check objnum)))))))
-;;; Dropping certain things causes things to happen.
-
(defun dun-drop-check (objnum)
+ "Dropping certain things causes things to happen."
(cond
((and (= objnum obj-food) (= dun-room bear-hangout)
(member obj-bear (nth bear-hangout dun-room-objects)))
@@ -1382,9 +1371,8 @@ through.")))
((and (= objnum obj-weight) (= dun-current-room maze-button-room))
(dun-mprincl "A passageway opens."))))
-;;; Give long description of current room, or an object.
-
(defun dun-examine (obj)
+ "Give long description of current room, or an object."
(let ((objnum (dun-objnum-from-args obj)))
(cond
((eq objnum obj-special)
@@ -1475,10 +1463,9 @@ For an explosive time, go to Fourth St. and Vermont.")
(setq total (+ total (nth x dun-object-lbs))))
total))
-;;; We try to take an object that is untakable. Print a message
-;;; depending on what it is.
-
(defun dun-try-take (_obj)
+ "We try to take an object that is untakable.
+Print a message depending on what it is."
(dun-mprinc "You cannot take that."))
(defun dun-dig (_args)
@@ -1671,15 +1658,15 @@ just try dropping it."))
(defun dun-go (args)
(if (or (not (car args))
(eq (dun-doverb dun-ignore dun-verblist (car args)
- (cdr (cdr args))) -1))
+ (cdr (cdr args)))
+ -1))
(dun-mprincl "I don't understand where you want me to go.")))
-;;; Uses the dungeon-map to figure out where we are going. If the
-;;; requested direction yields 255, we know something special is
-;;; supposed to happen, or perhaps you can't go that way unless
-;;; certain conditions are met.
-
(defun dun-move (dir)
+ ;; Uses the dungeon-map to figure out where we are going. If the
+ ;; requested direction yields 255, we know something special is
+ ;; supposed to happen, or perhaps you can't go that way unless
+ ;; certain conditions are met.
(if (and (not (member dun-current-room dun-light-rooms))
(not (member obj-lamp dun-inventory))
(not (member obj-lamp (nth dun-current-room dun-room-objects))))
@@ -1710,17 +1697,17 @@ body.")
(list obj-bus)))))
(setq dun-current-room newroom)))))))
-;;; Movement in this direction causes something special to happen if the
-;;; right conditions exist. It may be that you can't go this way unless
-;;; you have a key, or a passage has been opened.
+(defun dun-special-move (dir)
+ ;; Movement in this direction causes something special to happen if the
+ ;; right conditions exist. It may be that you can't go this way unless
+ ;; you have a key, or a passage has been opened.
-;;; coding note: Each check of the current room is on the same 'if' level,
-;;; i.e. there aren't else's. If two rooms next to each other have
-;;; specials, and they are connected by specials, this could cause
-;;; a problem. Be careful when adding them to consider this, and
-;;; perhaps use else's.
+ ;; coding note: Each check of the current room is on the same 'if' level,
+ ;; i.e. there aren't else's. If two rooms next to each other have
+ ;; specials, and they are connected by specials, this could cause
+ ;; a problem. Be careful when adding them to consider this, and
+ ;; perhaps use else's.
-(defun dun-special-move (dir)
(if (= dun-current-room building-front)
(if (not (member obj-key dun-inventory))
(dun-mprincl "You don't have a key that can open this door.")
@@ -2153,10 +2140,10 @@ for a moment, then straighten yourself up.\n")
;;;;
-;;; Function which takes a verb and a list of other words. Calls proper
-;;; function associated with the verb, and passes along the other words.
-
(defun dun-doverb (ignore verblist verb rest)
+ "Take a verb and a list of other words.
+Calls proper function associated with the verb, and passes along the
+other words."
(when verb
(if (member (intern verb) ignore)
(if (not (car rest)) -1
@@ -2166,9 +2153,8 @@ for a moment, then straighten yourself up.\n")
(funcall (cdr (assq (intern verb) verblist)) rest)))))
-;;; Function to take a string and change it into a list of lowercase words.
-
(defun dun-listify-string (strin)
+ "Take a string and change it into a list of lowercase words."
(let (pos ret-list end-pos)
(setq pos 0)
(setq ret-list nil)
@@ -2178,7 +2164,8 @@ for a moment, then straighten yourself up.\n")
(setq ret-list (append ret-list (list
(downcase
(substring strin pos end-pos))))))
- (setq pos (+ end-pos 1))) ret-list))
+ (setq pos (+ end-pos 1)))
+ ret-list))
(defun dun-listify-string2 (strin)
(let (pos ret-list end-pos)
@@ -2195,10 +2182,8 @@ for a moment, then straighten yourself up.\n")
(defun dun-replace (list n number)
(rplaca (nthcdr n list) number))
-
-;;; Get the first non-ignored word from a list.
-
(defun dun-firstword (list)
+ "Get the first non-ignored word from a list."
(when (car list)
(while (and list (memq (intern (car list)) dun-ignore))
(setq list (cdr list)))
@@ -2210,10 +2195,9 @@ for a moment, then straighten yourself up.\n")
(setq list (cdr list)))
list))
-;;; parse a line passed in as a string Call the proper verb with the
-;;; rest of the line passed in as a list.
-
(defun dun-vparse (ignore verblist line)
+ "Parse a line passed in as a string.
+Call the proper verb with the rest of the line passed in as a list."
(dun-mprinc "\n")
(setq dun-line-list (dun-listify-string (concat line " ")))
(dun-doverb ignore verblist (car dun-line-list) (cdr dun-line-list)))
@@ -2223,54 +2207,47 @@ for a moment, then straighten yourself up.\n")
(setq dun-line-list (dun-listify-string2 (concat line " ")))
(dun-doverb ignore verblist (car dun-line-list) (cdr dun-line-list)))
-;;; Read a line, in window mode
-
(defun dun-read-line ()
+ "Read a line, in window mode."
(let ((line (read-string "")))
(dun-mprinc line)
line))
-;;; Insert something into the window buffer
-
(defun dun-minsert (&rest args)
+ "Insert something into the window buffer."
(dolist (arg args)
(if (stringp arg)
(insert arg)
(insert (prin1-to-string arg)))))
-;;; Print something out, in window mode
-
(defun dun-mprinc (&rest args)
+ "Print something out, in window mode."
(dolist (arg args)
(if (stringp arg)
(insert arg)
(insert (prin1-to-string arg)))))
-;;; In window mode, keep screen from jumping by keeping last line at
-;;; the bottom of the screen.
-
(defun dun-fix-screen ()
+ "In window mode, keep screen from jumping by keeping last line at
+the bottom of the screen."
(interactive)
(forward-line (- 0 (- (window-height) 2 )))
(set-window-start (selected-window) (point))
(goto-char (point-max)))
-;;; Insert something into the buffer, followed by newline.
-
(defun dun-minsertl (&rest args)
+ "Insert something into the buffer, followed by newline."
(apply #'dun-minsert args)
(dun-minsert "\n"))
-;;; Print something, followed by a newline.
-
(defun dun-mprincl (&rest args)
+ "Print something, followed by a newline."
(apply #'dun-mprinc args)
(dun-mprinc "\n"))
-;;; Function which will get an object number given the list of
-;;; words in the command, except for the verb.
-
(defun dun-objnum-from-args (obj)
+ "Get an object number given the list of words in the command,
+except for the verb."
(setq obj (dun-firstword obj))
(if (not obj)
obj-special
@@ -2286,9 +2263,8 @@ for a moment, then straighten yourself up.\n")
nil
result)))
-;;; Given a unix style pathname, build a list of path components (recursive)
-
(defun dun-get-path (dirstring startlist)
+ "Given a unix style pathname, build a list of path components (recursive)"
(let (slash)
(if (= (length dirstring) 0)
startlist
@@ -2300,10 +2276,9 @@ for a moment, then straighten yourself up.\n")
(append startlist
(list (substring dirstring 0 slash)))))))))
-;;; Function to put objects in the treasure room. Also prints current
-;;; score to let user know he has scored.
-
(defun dun-put-objs-in-treas (objlist)
+ "Put objects in the treasure room.
+Also prints current score to let user know he has scored."
(let (oscore newscore)
(setq oscore (dun-reg-score))
(dun-replace dun-room-objects 0 (append (nth 0 dun-room-objects) objlist))
@@ -2311,9 +2286,8 @@ for a moment, then straighten yourself up.\n")
(if (not (= oscore newscore))
(dun-score nil))))
-;;; Load an encrypted file, and eval it.
-
(defun dun-load-d (filename)
+ "Load an encrypted file, and eval it."
(let ((result t))
(with-temp-buffer
(condition-case nil
@@ -2351,15 +2325,10 @@ for a moment, then straighten yourself up.\n")
(define-key dun-mode-map "\r" 'dun-parse)
(defvar dungeon-batch-map (make-keymap))
-(if (string= (substring emacs-version 0 2) "18")
- (let (n)
- (setq n 32)
- (while (< 0 (setq n (- n 1)))
- (aset dungeon-batch-map n 'dungeon-nil)))
- (let (n)
- (setq n 32)
- (while (< 0 (setq n (- n 1)))
- (aset (car (cdr dungeon-batch-map)) n 'dungeon-nil))))
+(let (n)
+ (setq n 32)
+ (while (< 0 (setq n (- n 1)))
+ (aset (car (cdr dungeon-batch-map)) n 'dungeon-nil)))
(define-key dungeon-batch-map "\r" 'exit-minibuffer)
(define-key dungeon-batch-map "\n" 'exit-minibuffer)
@@ -3160,18 +3129,30 @@ File not found")))
(dun-mprinc "\n")
(dun-batch-loop))
-(when noninteractive
- (fset 'dun-mprinc 'dun-batch-mprinc)
- (fset 'dun-mprincl 'dun-batch-mprincl)
- (fset 'dun-vparse 'dun-batch-parse)
- (fset 'dun-parse2 'dun-batch-parse2)
- (fset 'dun-read-line 'dun-batch-read-line)
- (fset 'dun-dos-interface 'dun-batch-dos-interface)
- (fset 'dun-unix-interface 'dun-batch-unix-interface)
+(defun dun--batch ()
+ "Start `dunnet' in batch mode."
+ (fset 'dun-mprinc #'dun-batch-mprinc)
+ (fset 'dun-mprincl #'dun-batch-mprincl)
+ (fset 'dun-vparse #'dun-batch-parse)
+ (fset 'dun-parse2 #'dun-batch-parse2)
+ (fset 'dun-read-line #'dun-batch-read-line)
+ (fset 'dun-dos-interface #'dun-batch-dos-interface)
+ (fset 'dun-unix-interface #'dun-batch-unix-interface)
(dun-mprinc "\n")
(setq dun-batch-mode t)
(dun-batch-loop))
+;; Apparently, there are many references out there to running us via
+;;
+;; emacs --batch -l dunnet
+;;
+;; So try and accommodate those without interfering with other cases
+;; where `dunnet.el' might be loaded in batch mode with no intention
+;; to run the game.
+(when (and noninteractive
+ (equal '("-l" "dunnet") (member "-l" command-line-args)))
+ (dun--batch))
+
(provide 'dunnet)
;; Local Variables:
diff --git a/lisp/play/fortune.el b/lisp/play/fortune.el
index f8859d954f8..fb02edffe73 100644
--- a/lisp/play/fortune.el
+++ b/lisp/play/fortune.el
@@ -1,6 +1,6 @@
-;;; fortune.el --- use fortune to create signatures
+;;; fortune.el --- use fortune to create signatures -*- lexical-binding: t -*-
-;; Copyright (C) 1999, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2001-2021 Free Software Foundation, Inc.
;; Author: Holger Schauer <Holger.Schauer@gmx.de>
;; Keywords: games utils mail
@@ -63,76 +63,75 @@
:link '(emacs-commentary-link "fortune.el")
:version "21.1"
:group 'games)
-(defgroup fortune-signature nil
- "Settings for use of fortune for signatures."
- :group 'fortune
- :group 'mail)
(defcustom fortune-dir "~/docs/ascii/misc/fortunes/"
"The directory to look in for local fortune cookies files."
- :type 'directory
- :group 'fortune)
+ :type 'directory)
+
(defcustom fortune-file
(expand-file-name "usenet" fortune-dir)
"The file in which local fortune cookies will be stored."
- :type 'file
- :group 'fortune)
+ :type 'file)
+
(defcustom fortune-database-extension ".dat"
"The extension of the corresponding fortune database.
Normally you won't have a reason to change it."
- :type 'string
- :group 'fortune)
+ :type 'string)
+
(defcustom fortune-program "fortune"
"Program to select a fortune cookie."
- :type 'string
- :group 'fortune)
+ :type 'string)
+
(defcustom fortune-program-options ()
"List of options to pass to the fortune program."
:type '(choice (repeat (string :tag "Option"))
(string :tag "Obsolete string of options"))
- :version "23.1"
- :group 'fortune)
+ :version "23.1")
+
(defcustom fortune-strfile "strfile"
"Program to compute a new fortune database."
- :type 'string
- :group 'fortune)
+ :type 'string)
+
(defcustom fortune-strfile-options ""
"Options to pass to the strfile program (a string)."
- :type 'string
- :group 'fortune)
-(defcustom fortune-quiet-strfile-options "> /dev/null"
+ :type 'string)
+
+(defcustom fortune-quiet-strfile-options (concat "> " null-device)
"Text added to the command for running `strfile'.
By default it discards the output produced by `strfile'.
Set this to \"\" if you would like to see the output."
- :type 'string
- :group 'fortune)
+ :type 'string)
(defcustom fortune-always-compile t
"Non-nil means automatically compile fortune files.
If nil, you must invoke `fortune-compile' manually to do that."
- :type 'boolean
- :group 'fortune)
+ :type 'boolean)
+
+(defgroup fortune-signature nil
+ "Settings for use of fortune for signatures."
+ :group 'fortune
+ :group 'mail)
+
(defcustom fortune-author-line-prefix " -- "
"Prefix to put before the author name of a fortunate."
- :type 'string
- :group 'fortune-signature)
+ :type 'string)
+
(defcustom fortune-fill-column fill-column
"Fill column for fortune files."
- :type 'integer
- :group 'fortune-signature)
+ :type 'integer)
+
(defcustom fortune-from-mail "private e-mail"
"String to use to characterize that the fortune comes from an e-mail.
No need to add an `in'."
- :type 'string
- :group 'fortune-signature)
+ :type 'string)
+
(defcustom fortune-sigstart ""
"Some text to insert before the fortune cookie, in a mail signature."
- :type 'string
- :group 'fortune-signature)
+ :type 'string)
+
(defcustom fortune-sigend ""
"Some text to insert after the fortune cookie, in a mail signature."
- :type 'string
- :group 'fortune-signature)
+ :type 'string)
;; not customizable settings
@@ -297,7 +296,7 @@ specifies the file to choose the fortune from."
(erase-buffer)
(if fortune-always-compile
(fortune-compile fort-file))
- (apply 'call-process
+ (apply #'call-process
fortune-program ; program to call
nil fortune-buffer nil ; INFILE BUFFER DISPLAY
(append (if (stringp fortune-program-options)
@@ -334,7 +333,6 @@ and choose the directory as the fortune-file."
(setq buffer-read-only t))
-;;; Provide ourselves.
(provide 'fortune)
;;; fortune.el ends here
diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el
index bb8ae5693f6..e540ca723d0 100644
--- a/lisp/play/gamegrid.el
+++ b/lisp/play/gamegrid.el
@@ -1,6 +1,6 @@
;;; gamegrid.el --- library for implementing grid-based games on Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1997-1998, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2001-2021 Free Software Foundation, Inc.
;; Author: Glynn Clements <glynn@sensei.co.uk>
;; Old-Version: 1.02
diff --git a/lisp/play/gametree.el b/lisp/play/gametree.el
index a9417e9e0ac..1a1d2d76520 100644
--- a/lisp/play/gametree.el
+++ b/lisp/play/gametree.el
@@ -1,6 +1,6 @@
;;; gametree.el --- manage game analysis trees in Emacs
-;; Copyright (C) 1997, 1999, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1999, 2001-2021 Free Software Foundation, Inc.
;; Author: Ian T Zimmerman <itz@rahul.net>
;; Created: Wed Dec 10 07:41:46 PST 1997
diff --git a/lisp/play/gomoku.el b/lisp/play/gomoku.el
index 403398672b1..1856db8b8bf 100644
--- a/lisp/play/gomoku.el
+++ b/lisp/play/gomoku.el
@@ -1,6 +1,6 @@
;;; gomoku.el --- Gomoku game between you and Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1988, 1994, 1996, 2001-2020 Free Software Foundation,
+;; Copyright (C) 1988, 1994, 1996, 2001-2021 Free Software Foundation,
;; Inc.
;; Author: Philippe Schnoebelen <phs@lsv.ens-cachan.fr>
@@ -195,9 +195,8 @@ You play by moving the cursor over the square you choose and hitting \\[gomoku-h
Other useful commands:\n
\\{gomoku-mode-map}"
(gomoku-display-statistics)
- (make-local-variable 'font-lock-defaults)
- (setq font-lock-defaults '(gomoku-font-lock-keywords t)
- buffer-read-only t)
+ (setq-local font-lock-defaults '(gomoku-font-lock-keywords t))
+ (setq buffer-read-only t)
(add-hook 'post-command-hook #'gomoku--intangible nil t))
;;;
diff --git a/lisp/play/handwrite.el b/lisp/play/handwrite.el
index 7b4a59b6fcd..7ad3de6fb64 100644
--- a/lisp/play/handwrite.el
+++ b/lisp/play/handwrite.el
@@ -1,6 +1,6 @@
;;; handwrite.el --- turns your emacs buffer into a handwritten document
-;; Copyright (C) 1996, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 2001-2021 Free Software Foundation, Inc.
;; Author: Danny Roozendaal (was: <danny@tvs.kun.nl>)
;; Created: October 21 1996
@@ -41,16 +41,8 @@
;; If you are not satisfied with the type page there are a number of
;; variables you may want to set.
;;
-;;
-;; Installation
-;;
-;; type at your prompt "emacs -l handwrite.el" or put this file on your
-;; Emacs Lisp load path, add the following into your init file:
-;;
-;; (require 'handwrite)
-;;
-;; "M-x handwrite" or "Write by hand" in the edit menu should work now.
-;;
+;; To use this, say "M-x handwrite" or type at your prompt
+;; "emacs -l handwrite.el".
;;
;; I tried to make it `iso_8859_1'-friendly, but there are some exotic
;; characters missing.
@@ -241,7 +233,7 @@ Variables: `handwrite-linespace' (default 12)
))
(switch-to-buffer ps-buf-name)
(forward-line 1)
- (insert "showpage exec Hwsave restore\n\n")
+ (insert " showpage exec Hwsave restore\n\n")
(insert "%%Pages " (number-to-string ipage) " 0\n")
(insert "%%EOF\n")
;;To avoid cumbersome code we simply ignore formfeeds
diff --git a/lisp/play/life.el b/lisp/play/life.el
index 56ecc5273da..2abf8ccb74b 100644
--- a/lisp/play/life.el
+++ b/lisp/play/life.el
@@ -1,6 +1,6 @@
;;; life.el --- John Horton Conway's Game of Life -*- lexical-binding:t -*-
-;; Copyright (C) 1988, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 2001-2021 Free Software Foundation, Inc.
;; Author: Kyle Jones <kyleuunet.uu.net>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/play/morse.el b/lisp/play/morse.el
index da26835c8e7..8e09c225059 100644
--- a/lisp/play/morse.el
+++ b/lisp/play/morse.el
@@ -1,6 +1,6 @@
;;; morse.el --- convert text to morse code and back -*- lexical-binding: t -*-
-;; Copyright (C) 1995, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 2001-2021 Free Software Foundation, Inc.
;; Author: Rick Farnbach <rick_farnbach@MENTORG.COM>
;; Keywords: games
diff --git a/lisp/play/mpuz.el b/lisp/play/mpuz.el
index 24134670500..7fff604aead 100644
--- a/lisp/play/mpuz.el
+++ b/lisp/play/mpuz.el
@@ -1,6 +1,6 @@
;;; mpuz.el --- multiplication puzzle for GNU Emacs
-;; Copyright (C) 1990, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1990, 2001-2021 Free Software Foundation, Inc.
;; Author: Philippe Schnoebelen <phs@lsv.ens-cachan.fr>
;; Overhauled: Daniel Pfeiffer <occitan@esperanto.org>
diff --git a/lisp/play/pong.el b/lisp/play/pong.el
index 4e6d73b6e94..b73dbc1010e 100644
--- a/lisp/play/pong.el
+++ b/lisp/play/pong.el
@@ -1,6 +1,6 @@
;;; pong.el --- classical implementation of pong -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Benjamin Drieu <bdrieu@april.org>
;; Keywords: games
diff --git a/lisp/play/snake.el b/lisp/play/snake.el
index 8ea214d8025..5584bf88103 100644
--- a/lisp/play/snake.el
+++ b/lisp/play/snake.el
@@ -1,6 +1,6 @@
;;; snake.el --- implementation of Snake for Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1997, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
;; Author: Glynn Clements <glynn@sensei.co.uk>
;; Created: 1997-09-10
diff --git a/lisp/play/solitaire.el b/lisp/play/solitaire.el
index 5c1dd061c9c..e74ba98ca1b 100644
--- a/lisp/play/solitaire.el
+++ b/lisp/play/solitaire.el
@@ -1,6 +1,6 @@
-;;; solitaire.el --- game of solitaire in Emacs Lisp
+;;; solitaire.el --- game of solitaire in Emacs Lisp -*- lexical-binding: t -*-
-;; Copyright (C) 1994, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 2001-2021 Free Software Foundation, Inc.
;; Author: Jan Schormann <Jan.Schormann@rechen-gilde.de>
;; Created: Fri afternoon, Jun 3, 1994
@@ -38,8 +38,7 @@
(defcustom solitaire-mode-hook nil
"Hook to run upon entry to Solitaire."
- :type 'hook
- :group 'solitaire)
+ :type 'hook)
(defvar solitaire-mode-map
(let ((map (make-sparse-keymap)))
@@ -119,8 +118,7 @@ The usual mnemonic keys move the cursor around the board; in addition,
"Non-nil means check for possible moves after each major change.
This takes a while, so switch this on if you like to be informed when
the game is over, or off, if you are working on a slow machine."
- :type 'boolean
- :group 'solitaire)
+ :type 'boolean)
(defconst solitaire-valid-directions
'(solitaire-left solitaire-right solitaire-up solitaire-down))
diff --git a/lisp/play/spook.el b/lisp/play/spook.el
index ed91dadcbca..d0669eb1f46 100644
--- a/lisp/play/spook.el
+++ b/lisp/play/spook.el
@@ -1,6 +1,6 @@
;;; spook.el --- spook phrase utility for overloading the NSA line eater -*- lexical-binding:t -*-
-;; Copyright (C) 1988, 1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 1993, 2001-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: games
diff --git a/lisp/play/tetris.el b/lisp/play/tetris.el
index e25cacbb722..8205d3f79c5 100644
--- a/lisp/play/tetris.el
+++ b/lisp/play/tetris.el
@@ -1,9 +1,9 @@
;;; tetris.el --- implementation of Tetris for Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1997, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
;; Author: Glynn Clements <glynn@sensei.co.uk>
-;; Version: 2.01
+;; Old-Version: 2.01
;; Created: 1997-08-13
;; Keywords: games
@@ -39,22 +39,18 @@
(defcustom tetris-use-glyphs t
"Non-nil means use glyphs when available."
- :group 'tetris
:type 'boolean)
(defcustom tetris-use-color t
"Non-nil means use color when available."
- :group 'tetris
:type 'boolean)
(defcustom tetris-draw-border-with-glyphs t
"Non-nil means draw a border even when using glyphs."
- :group 'tetris
:type 'boolean)
(defcustom tetris-default-tick-period 0.3
"The default time taken for a shape to drop one row."
- :group 'tetris
:type 'number)
(defcustom tetris-update-speed-function
@@ -65,18 +61,15 @@ SHAPES is the number of shapes which have been dropped.
ROWS is the number of rows which have been completed.
If the return value is a number, it is used as the timer period."
- :group 'tetris
:type 'function)
(defcustom tetris-mode-hook nil
"Hook run upon starting Tetris."
- :group 'tetris
:type 'hook)
(defcustom tetris-tty-colors
["blue" "white" "yellow" "magenta" "cyan" "green" "red"]
"Vector of colors of the various shapes in text mode."
- :group 'tetris
:type '(vector (color :tag "Shape 1")
(color :tag "Shape 2")
(color :tag "Shape 3")
@@ -88,7 +81,6 @@ If the return value is a number, it is used as the timer period."
(defcustom tetris-x-colors
[[0 0 1] [0.7 0 1] [1 1 0] [1 0 1] [0 1 1] [0 1 0] [1 0 0]]
"Vector of RGB colors of the various shapes."
- :group 'tetris
:type '(vector (vector :tag "Shape 1" number number number)
(vector :tag "Shape 2" number number number)
(vector :tag "Shape 3" number number number)
@@ -99,37 +91,30 @@ If the return value is a number, it is used as the timer period."
(defcustom tetris-buffer-name "*Tetris*"
"Name used for Tetris buffer."
- :group 'tetris
:type 'string)
(defcustom tetris-buffer-width 30
"Width of used portion of buffer."
- :group 'tetris
:type 'number)
(defcustom tetris-buffer-height 22
"Height of used portion of buffer."
- :group 'tetris
:type 'number)
(defcustom tetris-width 10
"Width of playing area."
- :group 'tetris
:type 'number)
(defcustom tetris-height 20
"Height of playing area."
- :group 'tetris
:type 'number)
(defcustom tetris-top-left-x 3
"X position of top left of playing area."
- :group 'tetris
:type 'number)
(defcustom tetris-top-left-y 1
"Y position of top left of playing area."
- :group 'tetris
:type 'number)
(defvar tetris-next-x (+ (* 2 tetris-top-left-x) tetris-width)
@@ -335,11 +320,10 @@ each one of its four blocks.")
options))
(defun tetris-get-tick-period ()
- (if (boundp 'tetris-update-speed-function)
- (let ((period (apply tetris-update-speed-function
- tetris-n-shapes
- tetris-n-rows nil)))
- (and (numberp period) period))))
+ (let ((period (apply tetris-update-speed-function
+ tetris-n-shapes
+ tetris-n-rows nil)))
+ (and (numberp period) period)))
(defun tetris-get-shape-cell (block)
(aref (aref (aref tetris-shapes
@@ -646,17 +630,15 @@ rotate the shape to fit in with those at the bottom of the screen so
as to form complete rows.
tetris-mode keybindings:
- \\<tetris-mode-map>
-\\[tetris-start-game] Starts a new game of Tetris
-\\[tetris-end-game] Terminates the current game
-\\[tetris-pause-game] Pauses (or resumes) the current game
-\\[tetris-move-left] Moves the shape one square to the left
-\\[tetris-move-right] Moves the shape one square to the right
-\\[tetris-rotate-prev] Rotates the shape clockwise
-\\[tetris-rotate-next] Rotates the shape anticlockwise
-\\[tetris-move-bottom] Drops the shape to the bottom of the playing area
-
-"
+\\<tetris-mode-map>
+\\[tetris-start-game] Start a new game of Tetris
+\\[tetris-end-game] Terminate the current game
+\\[tetris-pause-game] Pause (or resume) the current game
+\\[tetris-move-left] Move the shape one square to the left
+\\[tetris-move-right] Move the shape one square to the right
+\\[tetris-rotate-prev] Rotate the shape clockwise
+\\[tetris-rotate-next] Rotate the shape anticlockwise
+\\[tetris-move-bottom] Drop the shape to the bottom of the playing area"
(interactive)
(select-window (or (get-buffer-window tetris-buffer-name)
diff --git a/lisp/play/zone.el b/lisp/play/zone.el
index 6e341e737ae..70b6a01a017 100644
--- a/lisp/play/zone.el
+++ b/lisp/play/zone.el
@@ -1,6 +1,6 @@
;;; zone.el --- idle display hacks
-;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;; Author: Victor Zandy <zandy@cs.wisc.edu>
;; Maintainer: Thien-Thi Nguyen <ttn@gnu.org>
diff --git a/lisp/plstore.el b/lisp/plstore.el
index c08e0792b4c..46533664d52 100644
--- a/lisp/plstore.el
+++ b/lisp/plstore.el
@@ -1,5 +1,5 @@
;;; plstore.el --- secure plist store -*- lexical-binding: t -*-
-;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@gnu.org>
;; Keywords: PGP, GnuPG
diff --git a/lisp/printing.el b/lisp/printing.el
index 90ef02fe7b1..2f234b7b052 100644
--- a/lisp/printing.el
+++ b/lisp/printing.el
@@ -1,6 +1,6 @@
;;; printing.el --- printing utilities -*- lexical-binding:t -*-
-;; Copyright (C) 2000-2001, 2003-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2001, 2003-2021 Free Software Foundation, Inc.
;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Keywords: wp, print, PostScript
diff --git a/lisp/proced.el b/lisp/proced.el
index 203d70331ce..d1a243df8e0 100644
--- a/lisp/proced.el
+++ b/lisp/proced.el
@@ -1,6 +1,6 @@
;;; proced.el --- operate on system processes like dired -*- lexical-binding:t -*-
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Roland Winkler <winkler@gnu.org>
;; Keywords: Processes, Unix
@@ -664,9 +664,9 @@ After displaying or updating a Proced buffer, Proced runs the normal hook
truncate-lines t
header-line-format '(:eval (proced-header-line)))
(add-hook 'post-command-hook #'force-mode-line-update nil t) ;; FIXME: Why?
- (set (make-local-variable 'revert-buffer-function) #'proced-revert)
- (set (make-local-variable 'font-lock-defaults)
- '(proced-font-lock-keywords t nil nil beginning-of-line))
+ (setq-local revert-buffer-function #'proced-revert)
+ (setq-local font-lock-defaults
+ '(proced-font-lock-keywords t nil nil beginning-of-line))
(if (and (not proced-auto-update-timer) proced-auto-update-interval)
(setq proced-auto-update-timer
(run-at-time t proced-auto-update-interval
diff --git a/lisp/profiler.el b/lisp/profiler.el
index bf8aacccc37..64d71f4aab2 100644
--- a/lisp/profiler.el
+++ b/lisp/profiler.el
@@ -1,6 +1,6 @@
;;; profiler.el --- UI and helper functions for Emacs's native profiler -*- lexical-binding: t -*-
-;; Copyright (C) 2012-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
;; Author: Tomohiro Matsuyama <tomo@cx4a.org>
;; Keywords: lisp
@@ -34,7 +34,7 @@
:version "24.3"
:prefix "profiler-")
-(defconst profiler-version "24.3")
+(defconst profiler-version "28.1")
(defcustom profiler-sampling-interval 1000000
"Default sampling interval in nanoseconds."
@@ -85,6 +85,9 @@
(t
(profiler-ensure-string arg)))
for len = (length str)
+ if (zerop width)
+ collect str into frags
+ else
if (< width len)
collect (progn (put-text-property (max 0 (- width 2)) len
'invisible 'profiler str)
@@ -445,14 +448,16 @@ Optional argument MODE means only check for the specified mode (cpu or mem)."
:group 'profiler)
(defvar profiler-report-cpu-line-format
- '((50 left)
- (24 right ((19 right)
- (5 right)))))
+ '((17 right ((12 right)
+ (5 right)))
+ (1 left "%s")
+ (0 left)))
(defvar profiler-report-memory-line-format
- '((55 left)
- (19 right ((14 right profiler-format-number)
- (5 right)))))
+ '((20 right ((15 right profiler-format-number)
+ (5 right)))
+ (1 left "%s")
+ (0 left)))
(defvar-local profiler-report-profile nil
"The current profile.")
@@ -495,7 +500,11 @@ RET: expand or collapse"))
(defun profiler-report-header-line-format (fmt &rest args)
(let* ((header (apply #'profiler-format fmt args))
(escaped (replace-regexp-in-string "%" "%%" header)))
- (concat " " escaped)))
+ (concat
+ (propertize " "
+ 'display '(space :align-to 0)
+ 'face 'fixed-pitch)
+ escaped)))
(defun profiler-report-line-format (tree)
(let ((diff-p (profiler-profile-diff-p profiler-report-profile))
@@ -505,13 +514,14 @@ RET: expand or collapse"))
(profiler-format (cl-ecase (profiler-profile-type profiler-report-profile)
(cpu profiler-report-cpu-line-format)
(memory profiler-report-memory-line-format))
- name-part
(if diff-p
(list (if (> count 0)
(format "+%s" count)
count)
"")
- (list count count-percent)))))
+ (list count count-percent))
+ " "
+ name-part)))
(defun profiler-report-insert-calltree (tree)
(let ((line (profiler-report-line-format tree)))
@@ -735,11 +745,11 @@ below entry at point."
(cpu
(profiler-report-header-line-format
profiler-report-cpu-line-format
- "Function" (list "CPU samples" "%")))
+ (list "Samples" "%") " " " Function"))
(memory
(profiler-report-header-line-format
profiler-report-memory-line-format
- "Function" (list "Bytes" "%")))))
+ (list "Bytes" "%") " " " Function"))))
(let ((predicate (cl-ecase order
(ascending #'profiler-calltree-count<)
(descending #'profiler-calltree-count>))))
diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el
index 9dacd5856cf..527cb03cfbe 100644
--- a/lisp/progmodes/antlr-mode.el
+++ b/lisp/progmodes/antlr-mode.el
@@ -1,6 +1,6 @@
;;; antlr-mode.el --- major mode for ANTLR grammar files
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Christoph Wedler <Christoph.Wedler@sap.com>
;; Keywords: languages, ANTLR, code generator
@@ -75,8 +75,8 @@
;; (add-hook 'speedbar-load-hook ; would be too late in antlr-mode.el
;; (lambda () (speedbar-add-supported-extension ".g")))
-;; I strongly recommend to use font-lock with a support mode like fast-lock,
-;; lazy-lock or better jit-lock (Emacs-21.1+) / lazy-shot (XEmacs).
+;; I strongly recommend to use font-lock with a support mode like
+;; jit-lock (Emacs) / lazy-shot (XEmacs).
;; To customize, use menu item "Antlr" -> "Customize Antlr".
@@ -2592,7 +2592,8 @@ the default language."
comment-start-skip "/\\*+ *\\|// *")
;; various -----------------------------------------------------------------
(set (make-local-variable 'font-lock-defaults) antlr-font-lock-defaults)
- (easy-menu-add antlr-mode-menu)
+ (when (featurep 'xemacs)
+ (easy-menu-add antlr-mode-menu))
(set (make-local-variable 'imenu-create-index-function)
'antlr-imenu-create-index-function)
(set (make-local-variable 'imenu-generic-expression) t) ; fool stupid test
diff --git a/lisp/progmodes/asm-mode.el b/lisp/progmodes/asm-mode.el
index 3fde01d0ba6..62ff783fbac 100644
--- a/lisp/progmodes/asm-mode.el
+++ b/lisp/progmodes/asm-mode.el
@@ -1,6 +1,6 @@
;;; asm-mode.el --- mode for editing assembler code -*- lexical-binding: t; -*-
-;; Copyright (C) 1991, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1991, 2001-2021 Free Software Foundation, Inc.
;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/progmodes/autoconf.el b/lisp/progmodes/autoconf.el
index d12bed7e27d..73cf290f43c 100644
--- a/lisp/progmodes/autoconf.el
+++ b/lisp/progmodes/autoconf.el
@@ -1,6 +1,6 @@
;;; autoconf.el --- mode for editing Autoconf configure.ac files -*- lexical-binding: t; -*-
-;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: languages
diff --git a/lisp/progmodes/bat-mode.el b/lisp/progmodes/bat-mode.el
index 98e58be2303..44295c3f679 100644
--- a/lisp/progmodes/bat-mode.el
+++ b/lisp/progmodes/bat-mode.el
@@ -1,6 +1,6 @@
;;; bat-mode.el --- Major mode for editing DOS/Windows scripts
-;; Copyright (C) 2003, 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2008-2021 Free Software Foundation, Inc.
;; Author: Arni Magnusson <arnima@hafro.is>
;; Keywords: languages
diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el
index c52331f84fa..a759394abeb 100644
--- a/lisp/progmodes/bug-reference.el
+++ b/lisp/progmodes/bug-reference.el
@@ -1,6 +1,6 @@
;; bug-reference.el --- buttonize bug references -*- lexical-binding: t; -*-
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Tom Tromey <tromey@redhat.com>
;; Created: 21 Mar 2007
diff --git a/lisp/progmodes/cc-align.el b/lisp/progmodes/cc-align.el
index 6172afecbcf..d14ef1744af 100644
--- a/lisp/progmodes/cc-align.el
+++ b/lisp/progmodes/cc-align.el
@@ -1,6 +1,6 @@
;;; cc-align.el --- custom indentation functions for CC Mode
-;; Copyright (C) 1985, 1987, 1992-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc.
;; Authors: 2004- Alan Mackenzie
;; 1998- Martin Stjernholm
@@ -1115,7 +1115,7 @@ arglist-cont."
(vector (+ (current-column) c-basic-offset))))
(vector 0)))))
-(defun c-lineup-2nd-brace-entry-in-arglist (langelem)
+(defun c-lineup-2nd-brace-entry-in-arglist (_langelem)
"Lineup the second entry of a brace block under the first, when the first
line is also contained in an arglist or an enclosing brace ON THAT LINE.
@@ -1156,7 +1156,7 @@ Works with brace-list-intro."
(eq (char-after) ?{))))
'c-lineup-arglist-intro-after-paren))
-(defun c-lineup-class-decl-init-+ (langelem)
+(defun c-lineup-class-decl-init-+ (_langelem)
"Line up the second entry of a class (etc.) initializer c-basic-offset
characters in from the identifier when:
\(i) The type is a class, struct, union, etc. (but not an enum);
@@ -1197,7 +1197,7 @@ Works with: brace-list-intro."
(eq (point) init-pos)
(vector (+ (current-column) c-basic-offset)))))))
-(defun c-lineup-class-decl-init-after-brace (langelem)
+(defun c-lineup-class-decl-init-after-brace (_langelem)
"Line up the second entry of a class (etc.) initializer after its opening
brace when:
\(i) The type is a class, struct, union, etc. (but not an enum);
diff --git a/lisp/progmodes/cc-awk.el b/lisp/progmodes/cc-awk.el
index 52e6da6f4ac..32289443725 100644
--- a/lisp/progmodes/cc-awk.el
+++ b/lisp/progmodes/cc-awk.el
@@ -1,6 +1,6 @@
;;; cc-awk.el --- AWK specific code within cc-mode.
-;; Copyright (C) 1988, 1994, 1996, 2000-2020 Free Software Foundation,
+;; Copyright (C) 1988, 1994, 1996, 2000-2021 Free Software Foundation,
;; Inc.
;; Author: Alan Mackenzie <acm@muc.de> (originally based on awk-mode.el)
@@ -49,9 +49,11 @@
(load "cc-bytecomp" nil t)))
(cc-require 'cc-defs)
+(cc-require-when-compile 'cc-langs)
+(cc-require-when-compile 'cc-fonts)
+(cc-require 'cc-engine)
;; Silence the byte compiler.
-(cc-bytecomp-defvar font-lock-mode) ; Checked with boundp before use.
(cc-bytecomp-defvar c-new-BEG)
(cc-bytecomp-defvar c-new-END)
@@ -649,6 +651,46 @@
;; several lines back. The elisp "advice" feature is used on these functions
;; to allow this.
+(defun c-awk-font-lock-invalid-namespace-separators (limit)
+ ;; This function will be called from font-lock for a region bounded by POINT
+ ;; and LIMIT, as though it were to identify a keyword for
+ ;; font-lock-keyword-face. It always returns NIL to inhibit this and
+ ;; prevent a repeat invocation. See elisp/lispref page "Search-based
+ ;; Fontification".
+ ;;
+ ;; This function gives invalid GAWK namepace separators (::)
+ ;; font-lock-warning-face. "Invalid" here means there are spaces, etc.,
+ ;; around a separator, or there are more than one of them in an identifier.
+ ;; Invalid separators inside function declaration parentheses are handled
+ ;; elsewhere.
+ (while (and
+ (< (point) limit)
+ (c-syntactic-re-search-forward
+ (eval-when-compile
+ (concat "\\([^" (c-lang-const c-symbol-chars awk) "]::\\)"
+ "\\|"
+ ;; "\\(::[^" (c-lang-const c-symbol-start awk) "]\\)"
+ "\\(::[^" c-alpha "_" "]\\)"
+ "\\|"
+ "\\(::[" (c-lang-const c-symbol-chars awk) "]*::\\)"))
+ limit 'bound))
+ (cond
+ ((match-beginning 1) ; " ::"
+ (c-put-font-lock-face (1+ (match-beginning 1)) (match-end 1)
+ 'font-lock-warning-face)
+ (goto-char (- (match-end 1) 2)))
+ ((match-beginning 2) ; ":: "
+ (c-put-font-lock-face (match-beginning 2) (1- (match-end 2))
+ 'font-lock-warning-face)
+ (goto-char (1- (match-end 2))))
+ (t ; "::foo::"
+ (c-put-font-lock-face (match-beginning 3) (+ 2 (match-beginning 3))
+ 'font-lock-warning-face)
+ (c-put-font-lock-face (- (match-end 3) 2) (match-end 3)
+ 'font-lock-warning-face)
+ (goto-char (- (match-end 3) 2)))))
+ nil)
+
(defun c-awk-beginning-of-logical-line (&optional pos)
;; Go back to the start of the (apparent) current line (or the start of the
;; line containing POS), returning the buffer position of that point. I.e.,
@@ -900,6 +942,13 @@
(goto-char c-new-BEG)
(c-awk-set-syntax-table-properties c-new-END)))
+(defun c-awk-context-expand-fl-region (beg end)
+ ;; Return a cons (NEW-BEG . NEW-END), where NEW-BEG is the beginning of the
+ ;; logical line BEG is on, and NEW-END is the beginning of the line after
+ ;; the end of the logical line that END is on.
+ (cons (save-excursion (c-awk-beginning-of-logical-line beg))
+ (c-awk-beyond-logical-line end)))
+
;; Awk regexps written with help from Peter Galbraith
;; <galbraith@mixing.qc.dfo.ca>.
;; Take GNU Emacs's 'words out of the following regexp-opts. They don't work
@@ -907,18 +956,34 @@
(defconst awk-font-lock-keywords
(eval-when-compile
(list
- ;; Function names.
- '("^\\s *\\(func\\(tion\\)?\\)\\>\\s *\\(\\sw+\\)?"
- (1 font-lock-keyword-face) (3 font-lock-function-name-face nil t))
- ;;
+ ;; Function declarations.
+ `(,(c-make-font-lock-search-function
+ "^\\s *\\(func\\(tion\\)?\\)\\s +\\(\\(\\sw+\\(::\\sw+\\)?\\)\\s *\\)?\\(([^()]*)\\)?"
+ '(1 font-lock-keyword-face t)
+ ;; We can't use LAXMATCH in `c-make-font-lock-search-function', so....
+ '((when (match-beginning 4)
+ (c-put-font-lock-face
+ (match-beginning 4) (match-end 4) font-lock-function-name-face)
+ nil))
+ ;; Put warning face on any use of :: inside the parens.
+ '((when (match-beginning 6)
+ (goto-char (1+ (match-beginning 6)))
+ (let ((end (1- (match-end 6))))
+ (while (and (< (point) end)
+ (c-syntactic-re-search-forward "::" end t))
+ (c-put-font-lock-face (- (point) 2) (point)
+ 'font-lock-warning-face)))
+ nil))))
+
;; Variable names.
(cons
(concat "\\<"
(regexp-opt
'("ARGC" "ARGIND" "ARGV" "BINMODE" "CONVFMT" "ENVIRON"
- "ERRNO" "FIELDWIDTHS" "FILENAME" "FNR" "FS" "IGNORECASE"
- "LINT" "NF" "NR" "OFMT" "OFS" "ORS" "PROCINFO" "RLENGTH"
- "RS" "RSTART" "RT" "SUBSEP" "TEXTDOMAIN") t) "\\>")
+ "ERRNO" "FIELDWIDTHS" "FILENAME" "FNR" "FPAT" "FS" "FUNCTAB"
+ "IGNORECASE" "LINT" "NF" "NR" "OFMT" "OFS" "ORS" "PREC"
+ "PROCINFO" "RLENGTH" "ROUNDMODE" "RS" "RSTART" "RT" "SUBSEP"
+ "SYNTAB" "TEXTDOMAIN") t) "\\>")
'font-lock-variable-name-face)
;; Special file names. (acm, 2002/7/22)
@@ -949,7 +1014,8 @@ std\\(err\\|in\\|out\\)\\|user\\)\\)\\>\
;; Keywords.
(concat "\\<"
(regexp-opt
- '("BEGIN" "END" "break" "case" "continue" "default" "delete"
+ '("BEGIN" "BEGINFILE" "END" "ENDFILE"
+ "break" "case" "continue" "default" "delete"
"do" "else" "exit" "for" "getline" "if" "in" "next"
"nextfile" "return" "switch" "while")
t) "\\>")
@@ -959,16 +1025,20 @@ std\\(err\\|in\\|out\\)\\|user\\)\\)\\>\
,(concat
"\\<"
(regexp-opt
- '("adump" "and" "asort" "atan2" "bindtextdomain" "close"
- "compl" "cos" "dcgettext" "exp" "extension" "fflush"
- "gensub" "gsub" "index" "int" "length" "log" "lshift"
- "match" "mktime" "or" "print" "printf" "rand" "rshift"
+ '("adump" "and" "asort" "asorti" "atan2" "bindtextdomain" "close"
+ "compl" "cos" "dcgettext" "dcngettext" "exp" "extension" "fflush"
+ "gensub" "gsub" "index" "int" "isarray" "length" "log" "lshift"
+ "match" "mktime" "or" "patsplit" "print" "printf" "rand" "rshift"
"sin" "split" "sprintf" "sqrt" "srand" "stopme"
"strftime" "strtonum" "sub" "substr" "system"
- "systime" "tolower" "toupper" "xor") t)
+ "systime" "tolower" "toupper" "typeof" "xor")
+ t)
"\\>")
0 c-preprocessor-face-name))
+ ;; Directives
+ `(eval . '("@\\(include\\|load\\|namespace\\)\\>" 0 ,c-preprocessor-face-name))
+
;; gawk debugging keywords. (acm, 2002/7/21)
;; (Removed, 2003/6/6. These functions are now fontified as built-ins)
;; (list (concat "\\<" (regexp-opt '("adump" "stopme") t) "\\>")
@@ -980,6 +1050,9 @@ std\\(err\\|in\\|out\\)\\|user\\)\\)\\>\
c-awk-escaped-nls*-with-space* "(")
(0 'font-lock-warning-face))
+ ;; Double :: tokens, or the same with space(s) around them.
+ #'c-awk-font-lock-invalid-namespace-separators
+
;; Space after \ in what looks like an escaped newline. 2002/5/31
'("\\\\\\s +$" 0 font-lock-warning-face t)
diff --git a/lisp/progmodes/cc-bytecomp.el b/lisp/progmodes/cc-bytecomp.el
index 959261c9eb6..3f7caf3c2e9 100644
--- a/lisp/progmodes/cc-bytecomp.el
+++ b/lisp/progmodes/cc-bytecomp.el
@@ -1,6 +1,6 @@
;;; cc-bytecomp.el --- compile time setup for proper compilation
-;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;; Author: Martin Stjernholm
;; Maintainer: bug-cc-mode@gnu.org
diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el
index 4425e275ac9..33a03602070 100644
--- a/lisp/progmodes/cc-cmds.el
+++ b/lisp/progmodes/cc-cmds.el
@@ -1,6 +1,6 @@
;;; cc-cmds.el --- user level commands for CC Mode
-;; Copyright (C) 1985, 1987, 1992-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc.
;; Authors: 2003- Alan Mackenzie
;; 1998- Martin Stjernholm
@@ -907,7 +907,6 @@ settings of `c-cleanup-list' are done."
(when (and (boundp 'electric-pair-mode)
electric-pair-mode)
(let ((size (buffer-size))
- (c-in-electric-pair-functionality t)
post-self-insert-hook)
(electric-pair-post-self-insert-function)
(setq got-pair-} (and at-eol
@@ -2327,7 +2326,7 @@ with a brace block, at the outermost level of nesting."
(c-save-buffer-state ((paren-state (c-parse-state))
(orig-point-min (point-min))
(orig-point-max (point-max))
- lim name where limits fdoc)
+ lim name limits where)
(setq lim (c-widen-to-enclosing-decl-scope
paren-state orig-point-min orig-point-max))
(and lim (setq lim (1- lim)))
@@ -2358,7 +2357,7 @@ With a prefix arg, push the name onto the kill ring too."
(put 'c-display-defun-name 'isearch-scroll t)
(defun c-mark-function ()
- "Put mark at end of the current top-level declaration or macro, point at beginning.
+ "Put mark at end of current top-level declaration or macro, point at beginning.
If point is not inside any then the closest following one is
chosen. Each successive call of this command extends the marked
region by one function.
diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el
index 77e263f1aad..38fe23b0eaf 100644
--- a/lisp/progmodes/cc-defs.el
+++ b/lisp/progmodes/cc-defs.el
@@ -1,6 +1,6 @@
;;; cc-defs.el --- compile time definitions for CC Mode
-;; Copyright (C) 1985, 1987, 1992-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc.
;; Authors: 2003- Alan Mackenzie
;; 1998- Martin Stjernholm
@@ -87,7 +87,7 @@
;;; Variables also used at compile time.
-(defconst c-version "5.34.2"
+(defconst c-version "5.35.1"
"CC Mode version number.")
(defconst c-version-sym (intern c-version))
@@ -434,9 +434,8 @@ to it is returned. This function does not modify the point or the mark."
(setq count (+ count (skip-chars-backward "\\\\"))))
(not (zerop (logand count 1))))))
-(defmacro c-will-be-unescaped (beg end)
- ;; Would the character after END be unescaped after the removal of (BEG END)?
- ;; This is regardless of its current status. It is assumed that (>= POS END).
+(defmacro c-will-be-unescaped (beg)
+ ;; Would the character after BEG be unescaped?
`(save-excursion
(let (count)
(goto-char ,beg)
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index 1649f507363..3fce7dbafae 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -1,6 +1,6 @@
;;; cc-engine.el --- core syntax guessing engine for CC mode -*- coding: utf-8 -*-
-;; Copyright (C) 1985, 1987, 1992-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc.
;; Authors: 2001- Alan Mackenzie
;; 1998- Martin Stjernholm
@@ -972,7 +972,7 @@ comment at the start of cc-engine.el for more info."
;; that we've moved.
(while (progn
(setq pos (point))
- (c-backward-syntactic-ws)
+ (c-backward-syntactic-ws lim)
;; Protect post-++/-- operators just before a virtual semicolon.
(and (not (c-at-vsemi-p))
(/= (skip-chars-backward "-+!*&~@`#") 0))))
@@ -984,7 +984,7 @@ comment at the start of cc-engine.el for more info."
(if (and (memq (char-before) delims)
(progn (forward-char -1)
(setq saved (point))
- (c-backward-syntactic-ws)
+ (c-backward-syntactic-ws lim)
(or (memq (char-before) delims)
(memq (char-before) '(?: nil))
(eq (char-syntax (char-before)) ?\()
@@ -1164,7 +1164,7 @@ comment at the start of cc-engine.el for more info."
;; HERE IS THE SINGLE PLACE INSIDE THE PDA LOOP WHERE WE MOVE
;; BACKWARDS THROUGH THE SOURCE.
- (c-backward-syntactic-ws)
+ (c-backward-syntactic-ws lim)
(let ((before-sws-pos (point))
;; The end position of the area to search for statement
;; barriers in this round.
@@ -1174,33 +1174,35 @@ comment at the start of cc-engine.el for more info."
;; Go back over exactly one logical sexp, taking proper
;; account of macros and escaped EOLs.
(while
- (progn
- (setq comma-delimited (and (not comma-delim)
- (eq (char-before) ?\,)))
- (unless (c-safe (c-backward-sexp) t)
- ;; Give up if we hit an unbalanced block. Since the
- ;; stack won't be empty the code below will report a
- ;; suitable error.
- (setq pre-stmt-found t)
- (throw 'loop nil))
- (cond
- ;; Have we moved into a macro?
- ((and (not macro-start)
- (c-beginning-of-macro))
- (save-excursion
- (c-backward-syntactic-ws)
- (setq before-sws-pos (point)))
- ;; Have we crossed a statement boundary? If not,
- ;; keep going back until we find one or a "real" sexp.
- (and
+ (and
+ (progn
+ (setq comma-delimited (and (not comma-delim)
+ (eq (char-before) ?\,)))
+ (unless (c-safe (c-backward-sexp) t)
+ ;; Give up if we hit an unbalanced block. Since the
+ ;; stack won't be empty the code below will report a
+ ;; suitable error.
+ (setq pre-stmt-found t)
+ (throw 'loop nil))
+ (cond
+ ;; Have we moved into a macro?
+ ((and (not macro-start)
+ (c-beginning-of-macro))
(save-excursion
- (c-end-of-macro)
- (not (c-crosses-statement-barrier-p
- (point) maybe-after-boundary-pos)))
- (setq maybe-after-boundary-pos (point))))
- ;; Have we just gone back over an escaped NL? This
- ;; doesn't count as a sexp.
- ((looking-at "\\\\$")))))
+ (c-backward-syntactic-ws lim)
+ (setq before-sws-pos (point)))
+ ;; Have we crossed a statement boundary? If not,
+ ;; keep going back until we find one or a "real" sexp.
+ (and
+ (save-excursion
+ (c-end-of-macro)
+ (not (c-crosses-statement-barrier-p
+ (point) maybe-after-boundary-pos)))
+ (setq maybe-after-boundary-pos (point))))
+ ;; Have we just gone back over an escaped NL? This
+ ;; doesn't count as a sexp.
+ ((looking-at "\\\\$"))))
+ (>= (point) lim)))
;; Have we crossed a statement boundary?
(setq boundary-pos
@@ -1412,12 +1414,14 @@ comment at the start of cc-engine.el for more info."
(setq ret 'label)))
;; Skip over the unary operators that can start the statement.
- (while (progn
- (c-backward-syntactic-ws)
- ;; protect AWK post-inc/decrement operators, etc.
- (and (not (c-at-vsemi-p (point)))
- (/= (skip-chars-backward "-.+!*&~@`#") 0)))
+ (while (and (> (point) lim)
+ (progn
+ (c-backward-syntactic-ws lim)
+ ;; protect AWK post-inc/decrement operators, etc.
+ (and (not (c-at-vsemi-p (point)))
+ (/= (skip-chars-backward "-.+!*&~@`#") 0))))
(setq pos (point)))
+
(goto-char pos)
ret)))
@@ -2705,7 +2709,7 @@ comment at the start of cc-engine.el for more info."
(if (and (consp elt) (>= (length elt) 3))
;; Inside a string or comment
(let ((depth 0) (containing nil) (last nil)
- in-string in-comment (after-quote nil)
+ in-string in-comment
(min-depth 0) com-style com-str-start (intermediate nil)
(char-1 (nth 3 elt)) ; first char of poss. 2-char construct
(pos (car elt))
@@ -3024,7 +3028,7 @@ comment at the start of cc-engine.el for more info."
(defun c-full-trim-near-cache ()
;; Remove stale entries in `c-full-lit-near-cache', i.e. those whose END
;; entries, or positions, are above `c-full-near-cache-limit'.
- (let ((nc-list c-full-lit-near-cache) elt)
+ (let ((nc-list c-full-lit-near-cache))
(while nc-list
(let ((elt (car nc-list)))
(if (if (car (cddr elt))
@@ -3148,7 +3152,7 @@ comment at the start of cc-engine.el for more info."
((nth 7 s) 'c++)
(t 'c)))
(setq start (nth 8 s))
- (unless end
+ (unless (and end (>= end here))
(setq s1 (parse-partial-sexp here (point-max)
nil ; TARGETDEPTH
nil ; STOPBEFORE
@@ -3565,18 +3569,23 @@ mhtml-mode."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Defuns which analyze the buffer, yet don't change `c-state-cache'.
(defun c-get-fallback-scan-pos (here)
- ;; Return a start position for building `c-state-cache' from
- ;; scratch. This will be at the top level, 2 defuns back.
+ ;; Return a start position for building `c-state-cache' from scratch. This
+ ;; will be at the top level, 2 defuns back. Return nil if we don't find
+ ;; these defun starts a reasonable way back.
(save-excursion
- ;; Go back 2 bods, but ignore any bogus positions returned by
- ;; beginning-of-defun (i.e. open paren in column zero).
- (goto-char here)
- (let ((cnt 2))
- (while (not (or (bobp) (zerop cnt)))
- (c-beginning-of-defun-1) ; Pure elisp BOD.
- (if (eq (char-after) ?\{)
- (setq cnt (1- cnt)))))
- (point)))
+ (save-restriction
+ (when (> here (* 10 c-state-cache-too-far))
+ (narrow-to-region (- here (* 10 c-state-cache-too-far)) here))
+ ;; Go back 2 bods, but ignore any bogus positions returned by
+ ;; beginning-of-defun (i.e. open paren in column zero).
+ (goto-char here)
+ (let ((cnt 2))
+ (while (not (or (bobp) (zerop cnt)))
+ (c-beginning-of-defun-1) ; Pure elisp BOD.
+ (if (eq (char-after) ?\{)
+ (setq cnt (1- cnt)))))
+ (and (not (bobp))
+ (point)))))
(defun c-state-balance-parens-backwards (here- here+ top)
;; Return the position of the opening paren/brace/bracket before HERE- which
@@ -3667,9 +3676,7 @@ mhtml-mode."
how-far 0))
((<= good-pos here)
(setq strategy 'forward
- start-point (if changed-macro-start
- cache-pos
- (max good-pos cache-pos))
+ start-point (max good-pos cache-pos)
how-far (- here start-point)))
((< (- good-pos here) (- here cache-pos)) ; FIXME!!! ; apply some sort of weighting.
(setq strategy 'backward
@@ -3688,7 +3695,8 @@ mhtml-mode."
;; (not (c-major-mode-is 'c++-mode))
(> how-far c-state-cache-too-far))
(setq BOD-pos (c-get-fallback-scan-pos here)) ; somewhat EXPENSIVE!!!
- (if (< (- here BOD-pos) how-far)
+ (if (and BOD-pos
+ (< (- here BOD-pos) how-far))
(setq strategy 'BOD
start-point BOD-pos)))
@@ -4337,8 +4345,12 @@ mhtml-mode."
(if (and dropped-cons
(<= too-high-pa here))
(c-append-lower-brace-pair-to-state-cache too-high-pa here here-bol))
- (setq c-state-cache-good-pos (or (c-state-cache-after-top-paren)
- (c-state-get-min-scan-pos)))))
+ (if (and c-state-cache-good-pos (< here c-state-cache-good-pos))
+ (setq c-state-cache-good-pos
+ (or (save-excursion
+ (goto-char here)
+ (c-literal-start))
+ here)))))
;; The brace-pair desert marker:
(when (car c-state-brace-pair-desert)
@@ -4796,7 +4808,7 @@ comment at the start of cc-engine.el for more info."
;; Handle the "operator +" syntax in C++.
(when (and c-overloadable-operators-regexp
- (= (c-backward-token-2 0) 0))
+ (= (c-backward-token-2 0 nil (c-determine-limit 500)) 0))
(cond ((and (looking-at c-overloadable-operators-regexp)
(or (not c-opt-op-identifier-prefix)
@@ -5065,7 +5077,8 @@ See `c-forward-token-2' for details."
(while (and
(> count 0)
(progn
- (c-backward-syntactic-ws)
+ (c-backward-syntactic-ws
+ limit)
(backward-char)
(if (looking-at jump-syntax)
(goto-char (scan-sexps (1+ (point)) -1))
@@ -5402,8 +5415,12 @@ comment at the start of cc-engine.el for more info."
;; Optimize for, in particular, large blocks of comments from
;; `comment-region'.
(progn (when opt-ws
- (c-backward-syntactic-ws)
- (setq paren-level-pos (point)))
+ (let ((opt-pos (point)))
+ (c-backward-syntactic-ws limit)
+ (if (or (null limit)
+ (> (point) limit))
+ (setq paren-level-pos (point))
+ (goto-char opt-pos))))
t)
;; Move back to a candidate end point which isn't in a literal
;; or in a macro we didn't start in.
@@ -5423,7 +5440,11 @@ comment at the start of cc-engine.el for more info."
(setq macro-start (point))))
(goto-char macro-start))))
(when opt-ws
- (c-backward-syntactic-ws)))
+ (let ((opt-pos (point)))
+ (c-backward-syntactic-ws limit)
+ (if (and limit
+ (<= (point) limit))
+ (goto-char opt-pos)))))
(< (point) pos))
;; Check whether we're at the wrong level of nesting (when
@@ -5474,7 +5495,7 @@ comment at the start of cc-engine.el for more info."
(progn
;; Skip syntactic ws afterwards so that we don't stop at the
;; end of a comment if `skip-chars' is something like "^/".
- (c-backward-syntactic-ws)
+ (c-backward-syntactic-ws limit)
(point)))))
;; We might want to extend this with more useful return values in
@@ -5762,12 +5783,23 @@ comment at the start of cc-engine.el for more info."
(t 'c))) ; Assuming the range is valid.
range))
+(defun c-determine-limit-no-macro (here org-start)
+ ;; If HERE is inside a macro, and ORG-START is not also in the same macro,
+ ;; return the beginning of the macro. Otherwise return HERE. Point is not
+ ;; preserved by this function.
+ (goto-char here)
+ (let ((here-BOM (and (c-beginning-of-macro) (point))))
+ (if (and here-BOM
+ (not (eq (progn (goto-char org-start)
+ (and (c-beginning-of-macro) (point)))
+ here-BOM)))
+ here-BOM
+ here)))
+
(defsubst c-determine-limit-get-base (start try-size)
;; Get a "safe place" approximately TRY-SIZE characters before START.
;; This defsubst doesn't preserve point.
(goto-char start)
- (c-backward-syntactic-ws)
- (setq start (point))
(let* ((pos (max (- start try-size) (point-min)))
(s (c-semi-pp-to-literal pos))
(cand (or (car (cddr s)) pos)))
@@ -5776,20 +5808,23 @@ comment at the start of cc-engine.el for more info."
(parse-partial-sexp pos start nil nil (car s) 'syntax-table)
(point))))
-(defun c-determine-limit (how-far-back &optional start try-size)
+(defun c-determine-limit (how-far-back &optional start try-size org-start)
;; Return a buffer position approximately HOW-FAR-BACK non-literal
;; characters from START (default point). The starting position, either
;; point or START may not be in a comment or string.
;;
;; The position found will not be before POINT-MIN and won't be in a
- ;; literal.
+ ;; literal. It will also not be inside a macro, unless START/point is also
+ ;; in the same macro.
;;
;; We start searching for the sought position TRY-SIZE (default
;; twice HOW-FAR-BACK) bytes back from START.
;;
;; This function must be fast. :-)
+
(save-excursion
(let* ((start (or start (point)))
+ (org-start (or org-start start))
(try-size (or try-size (* 2 how-far-back)))
(base (c-determine-limit-get-base start try-size))
(pos base)
@@ -5842,21 +5877,27 @@ comment at the start of cc-engine.el for more info."
(setq elt (car stack)
stack (cdr stack))
(setq count (+ count (cdr elt))))
-
- ;; Have we found enough yet?
(cond
((null elt) ; No non-literal characters found.
- (if (> base (point-min))
- (c-determine-limit how-far-back base (* 2 try-size))
- (point-min)))
+ (cond
+ ((> pos start) ; Nothing but literals
+ base)
+ ((> base (point-min))
+ (c-determine-limit how-far-back base (* 2 try-size) org-start))
+ (t base)))
((>= count how-far-back)
- (+ (car elt) (- count how-far-back)))
+ (c-determine-limit-no-macro
+ (+ (car elt) (- count how-far-back))
+ org-start))
((eq base (point-min))
(point-min))
((> base (- start try-size)) ; Can only happen if we hit point-min.
- (car elt))
+ (c-determine-limit-no-macro
+ (car elt)
+ org-start))
(t
- (c-determine-limit (- how-far-back count) base (* 2 try-size)))))))
+ (c-determine-limit (- how-far-back count) base (* 2 try-size)
+ org-start))))))
(defun c-determine-+ve-limit (how-far &optional start-pos)
;; Return a buffer position about HOW-FAR non-literal characters forward
@@ -6248,8 +6289,14 @@ comment at the start of cc-engine.el for more info."
;; preceding syntactic ws to set `cfd-match-pos' and to catch
;; any decl spots in the syntactic ws.
(unless cfd-re-match
- (c-backward-syntactic-ws)
- (setq cfd-re-match (point))))
+ (let ((cfd-cbsw-lim
+ (max (- (point) 1000) (point-min))))
+ (c-backward-syntactic-ws cfd-cbsw-lim)
+ (setq cfd-re-match
+ (if (or (bobp) (> (point) cfd-cbsw-lim))
+ (point)
+ (point-min)))) ; Set BOB case if the token's too far back.
+ ))
;; Choose whichever match is closer to the start.
(if (< cfd-re-match cfd-prop-match)
@@ -6410,7 +6457,7 @@ comment at the start of cc-engine.el for more info."
(while (and (not (bobp))
(c-got-face-at (1- (point)) c-literal-faces))
(goto-char (previous-single-property-change
- (point) 'face nil (point-min))))
+ (point) 'face nil (point-min)))) ; No limit. FIXME, perhaps? 2020-12-07.
;; XEmacs doesn't fontify the quotes surrounding string
;; literals.
@@ -6482,12 +6529,15 @@ comment at the start of cc-engine.el for more info."
(c-invalidate-find-decl-cache cfd-start-pos)
(setq syntactic-pos (point))
- (unless (eq syntactic-pos c-find-decl-syntactic-pos)
+ (unless
+ (eq syntactic-pos c-find-decl-syntactic-pos)
;; Don't have to do this if the cache is relevant here,
;; typically if the same line is refontified again. If
;; we're just some syntactic whitespace further down we can
;; still use the cache to limit the skipping.
- (c-backward-syntactic-ws c-find-decl-syntactic-pos))
+ (c-backward-syntactic-ws
+ (max (or c-find-decl-syntactic-pos (point-min))
+ (- (point) 10000) (point-min))))
;; If we hit `c-find-decl-syntactic-pos' and
;; `c-find-decl-match-pos' is set then we install the cached
@@ -6613,7 +6663,8 @@ comment at the start of cc-engine.el for more info."
;; syntactic ws.
(when (and cfd-match-pos (< cfd-match-pos syntactic-pos))
(goto-char syntactic-pos)
- (c-forward-syntactic-ws)
+ (c-forward-syntactic-ws
+ (min (+ (point) 2000) (point-max)))
(and cfd-continue-pos
(< cfd-continue-pos (point))
(setq cfd-token-pos (point))))
@@ -6654,7 +6705,8 @@ comment at the start of cc-engine.el for more info."
;; can't be nested, and that's already been done in
;; `c-find-decl-prefix-search'.
(when (> cfd-continue-pos cfd-token-pos)
- (c-forward-syntactic-ws)
+ (c-forward-syntactic-ws
+ (min (+ (point) 2000) (point-max)))
(setq cfd-token-pos (point)))
;; Continue if the following token fails the
@@ -7625,8 +7677,7 @@ comment at the start of cc-engine.el for more info."
;; entire raw string (when properly terminated) or just the delimiter
;; (otherwise). In either of these cases, return t, otherwise return nil.
;;
- (let ((here (point))
- in-macro macro-end id Rquote found)
+ (let (in-macro macro-end)
(when
(and
(eq (char-before (1- (point))) ?R)
@@ -8263,7 +8314,8 @@ comment at the start of cc-engine.el for more info."
;; typically called from `c-forward-type' in this case, and
;; the caller only wants the top level type that it finds to
;; be promoted.
- c-promote-possible-types)
+ c-promote-possible-types
+ (lim+ (c-determine-+ve-limit 500)))
(while
(and
(looking-at c-identifier-key)
@@ -8293,7 +8345,7 @@ comment at the start of cc-engine.el for more info."
;; Handle a C++ operator or template identifier.
(goto-char id-end)
- (c-forward-syntactic-ws)
+ (c-forward-syntactic-ws lim+)
(cond ((eq (char-before id-end) ?e)
;; Got "... ::template".
(let ((subres (c-forward-name)))
@@ -8323,13 +8375,13 @@ comment at the start of cc-engine.el for more info."
(looking-at "::")
(progn
(goto-char (match-end 0))
- (c-forward-syntactic-ws)
+ (c-forward-syntactic-ws lim+)
(eq (char-after) ?*))
(progn
(forward-char)
t))))
(while (progn
- (c-forward-syntactic-ws)
+ (c-forward-syntactic-ws lim+)
(setq pos (point))
(looking-at c-opt-type-modifier-key))
(goto-char (match-end 1))))))
@@ -8339,7 +8391,7 @@ comment at the start of cc-engine.el for more info."
(setq c-last-identifier-range
(cons (point) (match-end 0)))
(goto-char (match-end 0))
- (c-forward-syntactic-ws)
+ (c-forward-syntactic-ws lim+)
(setq pos (point)
res 'operator)))
@@ -8353,7 +8405,7 @@ comment at the start of cc-engine.el for more info."
(setq c-last-identifier-range
(cons id-start id-end)))
(goto-char id-end)
- (c-forward-syntactic-ws)
+ (c-forward-syntactic-ws lim+)
(setq pos (point)
res t)))
@@ -8369,7 +8421,7 @@ comment at the start of cc-engine.el for more info."
;; cases with tricky syntactic whitespace that aren't
;; covered in `c-identifier-key'.
(goto-char (match-end 0))
- (c-forward-syntactic-ws)
+ (c-forward-syntactic-ws lim+)
t)
((and c-recognize-<>-arglists
@@ -8378,7 +8430,7 @@ comment at the start of cc-engine.el for more info."
(when (let (c-last-identifier-range)
(c-forward-<>-arglist nil))
- (c-forward-syntactic-ws)
+ (c-forward-syntactic-ws lim+)
(unless (eq (char-after) ?\()
(setq c-last-identifier-range nil)
(c-add-type start (1+ pos)))
@@ -8393,7 +8445,7 @@ comment at the start of cc-engine.el for more info."
(when (and c-record-type-identifiers id-start)
(c-record-ref-id (cons id-start id-end)))
(forward-char 2)
- (c-forward-syntactic-ws)
+ (c-forward-syntactic-ws lim+)
t)
(when (and c-record-type-identifiers id-start
@@ -8818,7 +8870,7 @@ comment at the start of cc-engine.el for more info."
(or res (goto-char here))
res))
-(defmacro c-back-over-list-of-member-inits ()
+(defmacro c-back-over-list-of-member-inits (limit)
;; Go back over a list of elements, each looking like:
;; <symbol> (<expression>) ,
;; or <symbol> {<expression>} , (with possibly a <....> expressions
@@ -8827,21 +8879,21 @@ comment at the start of cc-engine.el for more info."
;; a comma. If either of <symbol> or bracketed <expression> is missing,
;; throw nil to 'level. If the terminating } or ) is unmatched, throw nil
;; to 'done. This is not a general purpose macro!
- '(while (eq (char-before) ?,)
+ `(while (eq (char-before) ?,)
(backward-char)
- (c-backward-syntactic-ws)
+ (c-backward-syntactic-ws ,limit)
(when (not (memq (char-before) '(?\) ?})))
(throw 'level nil))
(when (not (c-go-list-backward))
(throw 'done nil))
- (c-backward-syntactic-ws)
+ (c-backward-syntactic-ws ,limit)
(while (eq (char-before) ?>)
(when (not (c-backward-<>-arglist nil))
(throw 'done nil))
- (c-backward-syntactic-ws))
+ (c-backward-syntactic-ws ,limit))
(when (not (c-back-over-compound-identifier))
(throw 'level nil))
- (c-backward-syntactic-ws)))
+ (c-backward-syntactic-ws ,limit)))
(defun c-back-over-member-initializers (&optional limit)
;; Test whether we are in a C++ member initializer list, and if so, go back
@@ -8860,14 +8912,14 @@ comment at the start of cc-engine.el for more info."
(catch 'done
(setq level-plausible
(catch 'level
- (c-backward-syntactic-ws)
+ (c-backward-syntactic-ws limit)
(when (memq (char-before) '(?\) ?}))
(when (not (c-go-list-backward))
(throw 'done nil))
- (c-backward-syntactic-ws))
+ (c-backward-syntactic-ws limit))
(when (c-back-over-compound-identifier)
- (c-backward-syntactic-ws))
- (c-back-over-list-of-member-inits)
+ (c-backward-syntactic-ws limit))
+ (c-back-over-list-of-member-inits limit)
(and (eq (char-before) ?:)
(save-excursion
(c-backward-token-2)
@@ -8881,14 +8933,14 @@ comment at the start of cc-engine.el for more info."
(setq level-plausible
(catch 'level
(goto-char pos)
- (c-backward-syntactic-ws)
+ (c-backward-syntactic-ws limit)
(when (not (c-back-over-compound-identifier))
(throw 'level nil))
- (c-backward-syntactic-ws)
- (c-back-over-list-of-member-inits)
+ (c-backward-syntactic-ws limit)
+ (c-back-over-list-of-member-inits limit)
(and (eq (char-before) ?:)
(save-excursion
- (c-backward-token-2)
+ (c-backward-token-2 nil nil limit)
(not (looking-at c-:$-multichar-token-regexp)))
(c-just-after-func-arglist-p)))))
@@ -9377,8 +9429,8 @@ This function might do hidden buffer changes."
maybe-typeless
;; Save the value of kwd-sym between loops of the "Check for a
;; type" loop. Needed to distinguish a C++11 "auto" from a pre
- ;; C++11 one.
- prev-kwd-sym
+ ;; C++11 one. (Commented out, 2020-11-01).
+ ;; prev-kwd-sym
;; If a specifier is found that also can be a type prefix,
;; these flags are set instead of those above. If we need to
;; back up an identifier, they are copied to the real flag
@@ -9537,7 +9589,7 @@ This function might do hidden buffer changes."
;; specifier keyword and we know we're in a
;; declaration.
(setq at-decl-or-cast t)
- (setq prev-kwd-sym kwd-sym)
+ ;; (setq prev-kwd-sym kwd-sym)
(goto-char kwd-clause-end))))
@@ -9894,8 +9946,9 @@ This function might do hidden buffer changes."
(throw 'at-decl-or-cast t))
(when (and got-parens
- (not got-function-name-prefix)
- ;; (not got-suffix-after-parens)
+ (or (not got-function-name-prefix)
+ (and (not got-suffix-after-parens)
+ at-decl-end))
(or backup-at-type
maybe-typeless
backup-maybe-typeless
@@ -10837,11 +10890,11 @@ comment at the start of cc-engine.el for more info."
(low-lim (max (or lim (point-min)) (or macro-start (point-min))))
before-lparen after-rparen
(here (point))
- (pp-count-out 20) ; Max number of paren/brace constructs before
- ; we give up.
+ (pp-count-out 20) ; Max number of paren/brace constructs before
+ ; we give up
ids ; List of identifiers in the parenthesized list.
- id-start after-prec-token decl-or-cast decl-res
- c-last-identifier-range identifier-ok)
+ id-start after-prec-token decl-or-cast
+ c-last-identifier-range semi-position+1)
(narrow-to-region low-lim (or macro-end (point-max)))
;; Search backwards for the defun's argument list. We give up if we
@@ -10875,8 +10928,8 @@ comment at the start of cc-engine.el for more info."
(setq after-rparen (point)))
((eq (char-before) ?\])
(setq after-rparen nil))
- (t ; either } (hit previous defun) or = or no more
- ; parens/brackets.
+ (t ; either } (hit previous defun) or = or no more
+ ; parens/brackets.
(throw 'knr nil)))
(if after-rparen
@@ -10933,31 +10986,35 @@ comment at the start of cc-engine.el for more info."
(forward-char) ; over the )
(setq after-prec-token after-rparen)
(c-forward-syntactic-ws)
+ ;; Each time around the following checks one
+ ;; declaration (which may contain several identifiers).
(while (and
- (or (consp (setq decl-or-cast
- (c-forward-decl-or-cast-1
- after-prec-token
- nil ; Or 'arglist ???
- nil)))
- (progn
- (goto-char after-prec-token)
- (c-forward-syntactic-ws)
- (setq identifier-ok (eq (char-after) ?{))
- nil))
- (eq (char-after) ?\;)
- (setq after-prec-token (1+ (point)))
+ (consp (setq decl-or-cast
+ (c-forward-decl-or-cast-1
+ after-prec-token
+ nil ; Or 'arglist ???
+ nil)))
+ (memq (char-after) '(?\; ?\,))
(goto-char (car decl-or-cast))
- (setq decl-res (c-forward-declarator))
- (setq identifier-ok
- (member (buffer-substring-no-properties
- (car decl-res) (cadr decl-res))
- ids))
- (progn
- (goto-char after-prec-token)
- (prog1 (< (point) here)
- (c-forward-syntactic-ws))))
- (setq identifier-ok nil))
- identifier-ok))
+ (save-excursion
+ (setq semi-position+1
+ (c-syntactic-re-search-forward
+ ";" (+ (point) 1000) t)))
+ (c-do-declarators
+ semi-position+1 t nil nil
+ (lambda (id-start id-end _next _not-top
+ _func _init)
+ (if (not (member
+ (buffer-substring-no-properties
+ id-start id-end)
+ ids))
+ (throw 'knr nil))))
+
+ (progn (forward-char)
+ (<= (point) here))
+ (progn (c-forward-syntactic-ws)
+ t)))
+ t))
;; ...Yes. We've identified the function's argument list.
(throw 'knr
(progn (goto-char after-rparen)
@@ -11123,6 +11180,7 @@ comment at the start of cc-engine.el for more info."
(c-backward-syntactic-ws lim)
(not (or (memq (char-before) '(?\; ?} ?: nil))
(c-at-vsemi-p))))
+ (not (and lim (<= (point) lim)))
(save-excursion
(backward-char)
(not (looking-at "\\s(")))
@@ -11251,7 +11309,7 @@ comment at the start of cc-engine.el for more info."
(c-syntactic-re-search-forward ";" nil 'move t)))
nil)))
-(defun c-looking-at-decl-block (_containing-sexp goto-start &optional limit)
+(defun c-looking-at-decl-block (goto-start &optional limit)
;; Assuming the point is at an open brace, check if it starts a
;; block that contains another declaration level, i.e. that isn't a
;; statement block or a brace list, and if so return non-nil.
@@ -11431,9 +11489,7 @@ comment at the start of cc-engine.el for more info."
; *c-looking-at-decl-block
; containing-sexp goto-start &optional
; limit)
- (when (and (c-looking-at-decl-block
- (c-pull-open-brace paren-state)
- nil)
+ (when (and (c-looking-at-decl-block nil)
(looking-at c-class-key))
(goto-char (match-end 1))
(c-forward-syntactic-ws)
@@ -11452,9 +11508,7 @@ comment at the start of cc-engine.el for more info."
(save-excursion
(goto-char open-paren-pos)
(when (and (eq (char-after) ?{)
- (c-looking-at-decl-block
- (c-safe-position open-paren-pos paren-state)
- nil))
+ (c-looking-at-decl-block nil))
(back-to-indentation)
(vector (point) open-paren-pos))))))
@@ -11467,7 +11521,7 @@ comment at the start of cc-engine.el for more info."
(while (and open-brace
(save-excursion
(goto-char open-brace)
- (not (c-looking-at-decl-block next-open-brace nil))))
+ (not (c-looking-at-decl-block nil))))
(setq open-brace next-open-brace
next-open-brace (c-pull-open-brace paren-state)))
open-brace))
@@ -11565,6 +11619,194 @@ comment at the start of cc-engine.el for more info."
(or (looking-at c-brace-list-key)
(progn (goto-char here) nil))))
+(defun c-laomib-loop (lim)
+ ;; The "expensive" loop from `c-looking-at-or-maybe-in-bracelist'. Move
+ ;; backwards over comma separated sexps as far as possible, but no further
+ ;; than LIM, which may be nil, meaning no limit. Return the final value of
+ ;; `braceassignp', which is t if we encountered "= {", usually nil
+ ;; otherwise.
+ (let ((braceassignp 'dontknow)
+ (class-key
+ ;; Pike can have class definitions anywhere, so we must
+ ;; check for the class key here.
+ (and (c-major-mode-is 'pike-mode)
+ c-decl-block-key)))
+ (while (eq braceassignp 'dontknow)
+ (cond ((eq (char-after) ?\;)
+ (setq braceassignp nil))
+ ((and class-key
+ (looking-at class-key))
+ (setq braceassignp nil))
+ ((and c-has-compound-literals
+ (looking-at c-return-key))
+ (setq braceassignp t)
+ nil)
+ ((eq (char-after) ?=)
+ ;; We've seen a =, but must check earlier tokens so
+ ;; that it isn't something that should be ignored.
+ (setq braceassignp 'maybe)
+ (while (and (eq braceassignp 'maybe)
+ (zerop (c-backward-token-2 1 t lim)))
+ (setq braceassignp
+ (cond
+ ;; Check for operator =
+ ((and c-opt-op-identifier-prefix
+ (looking-at c-opt-op-identifier-prefix))
+ nil)
+ ;; Check for `<opchar>= in Pike.
+ ((and (c-major-mode-is 'pike-mode)
+ (or (eq (char-after) ?`)
+ ;; Special case for Pikes
+ ;; `[]=, since '[' is not in
+ ;; the punctuation class.
+ (and (eq (char-after) ?\[)
+ (eq (char-before) ?`))))
+ nil)
+ ((looking-at "\\s.") 'maybe)
+ ;; make sure we're not in a C++ template
+ ;; argument assignment
+ ((and
+ (c-major-mode-is 'c++-mode)
+ (save-excursion
+ (let ((here (point))
+ (pos< (progn
+ (skip-chars-backward "^<>")
+ (point))))
+ (and (eq (char-before) ?<)
+ (not (c-crosses-statement-barrier-p
+ pos< here))
+ (not (c-in-literal))
+ ))))
+ nil)
+ (t t)))))
+ ((and
+ (c-major-mode-is 'c++-mode)
+ (eq (char-after) ?\[)
+ ;; Be careful of "operator []"
+ (not (save-excursion
+ (c-backward-token-2 1 nil lim)
+ (looking-at c-opt-op-identifier-prefix))))
+ (setq braceassignp t)
+ nil))
+ (when (eq braceassignp 'dontknow)
+ (cond ((and
+ (not (eq (char-after) ?,))
+ (save-excursion
+ (c-backward-syntactic-ws)
+ (eq (char-before) ?})))
+ (setq braceassignp nil))
+ ((/= (c-backward-token-2 1 t lim) 0)
+ (if (save-excursion
+ (and c-has-compound-literals
+ (eq (c-backward-token-2 1 nil lim) 0)
+ (eq (char-after) ?\()))
+ (setq braceassignp t)
+ (setq braceassignp nil))))))
+ braceassignp))
+
+;; The following variable is a cache of up to four entries, each entry of
+;; which is a list representing a call to c-laomib-loop. It contains the
+;; following elements:
+;; 0: `lim' argument - used as an alist key, never nil.
+;; 1: Position in buffer where the scan started.
+;; 2: Position in buffer where the scan ended.
+;; 3: Result of the call to `c-laomib-loop'.
+(defvar c-laomib-cache nil)
+(make-variable-buffer-local 'c-laomib-cache)
+
+(defun c-laomib-get-cache (containing-sexp)
+ ;; Get an element from `c-laomib-cache' matching CONTAINING-SEXP.
+ ;; Return that element or nil if one wasn't found.
+ (let ((elt (assq containing-sexp c-laomib-cache)))
+ (when elt
+ ;; Move the fetched `elt' to the front of the cache.
+ (setq c-laomib-cache (delq elt c-laomib-cache))
+ (push elt c-laomib-cache)
+ elt)))
+
+(defun c-laomib-put-cache (lim start end result)
+ ;; Insert a new element into `c-laomib-cache', removing another element to
+ ;; make room, if necessary. The four parameters LIM, START, END, RESULT are
+ ;; the components of the new element (see comment for `c-laomib-cache').
+ ;; The return value is of no significance.
+ (when lim
+ (let ((old-elt (assq lim c-laomib-cache))
+ ;; (elt (cons containing-sexp (cons start nil)))
+ (new-elt (list lim start end result))
+ big-ptr
+ (cur-ptr c-laomib-cache)
+ togo (size 0) cur-size
+ )
+ (if old-elt (setq c-laomib-cache (delq old-elt c-laomib-cache)))
+
+ (while (>= (length c-laomib-cache) 4)
+ ;; We delete the least recently used elt which doesn't enclose START,
+ ;; or..
+ (dolist (elt c-laomib-cache)
+ (if (or (<= start (cadr elt))
+ (> start (car (cddr elt))))
+ (setq togo elt)))
+
+ ;; ... delete the least recently used elt which isn't the biggest.
+ (when (not togo)
+ (while (cdr cur-ptr)
+ (setq cur-size (- (nth 2 (cadr cur-ptr)) (car (cadr cur-ptr))))
+ (when (> cur-size size)
+ (setq size cur-size
+ big-ptr cur-ptr))
+ (setq cur-ptr (cdr cur-ptr)))
+ (setq togo (if (cddr big-ptr)
+ (car (last big-ptr))
+ (car big-ptr))))
+
+ (setq c-laomib-cache (delq togo c-laomib-cache)))
+
+ (push new-elt c-laomib-cache))))
+
+(defun c-laomib-fix-elt (lwm elt paren-state)
+ ;; Correct a c-laomib-cache entry ELT with respect to buffer changes, either
+ ;; doing nothing, signalling it is to be deleted, or replacing its start
+ ;; point with one lower in the buffer than LWM. PAREN-STATE is the paren
+ ;; state at LWM. Return the corrected entry, or nil (if it needs deleting).
+ ;; Note that corrections are made by `setcar'ing the original structure,
+ ;; which thus remains intact.
+ (cond
+ ((or (not lwm) (> lwm (cadr elt)))
+ elt)
+ ((<= lwm (nth 2 elt))
+ nil)
+ (t
+ ;; Search for the last brace in `paren-state' before (car `lim'). This
+ ;; brace will become our new 2nd element of `elt'.
+ (while
+ ;; Search one brace level per iteration.
+ (and paren-state
+ (progn
+ ;; (setq cur-brace (c-laomib-next-BRACE paren-state))
+ (while
+ ;; Go past non-brace levels, one per iteration.
+ (and paren-state
+ (not (eq (char-after
+ (c-state-cache-top-lparen paren-state))
+ ?{)))
+ (setq paren-state (cdr paren-state)))
+ (cadr paren-state))
+ (> (c-state-cache-top-lparen (cdr paren-state)) (car elt)))
+ (setq paren-state (cdr paren-state)))
+ (when (cadr paren-state)
+ (setcar (cdr elt) (c-state-cache-top-lparen paren-state))
+ elt))))
+
+(defun c-laomib-invalidate-cache (beg _end)
+ ;; Called from late in c-before-change. Amend `c-laomib-cache' to remove
+ ;; details pertaining to the buffer after position BEG.
+ (save-excursion
+ (goto-char beg)
+ (let ((paren-state (c-parse-state)))
+ (dolist (elt c-laomib-cache)
+ (when (not (c-laomib-fix-elt beg elt paren-state))
+ (setq c-laomib-cache (delq elt c-laomib-cache)))))))
+
(defun c-looking-at-or-maybe-in-bracelist (&optional containing-sexp lim)
;; Point is at an open brace. If this starts a brace list, return a list
;; whose car is the buffer position of the start of the construct which
@@ -11585,14 +11827,10 @@ comment at the start of cc-engine.el for more info."
;; Here, "brace list" does not include the body of an enum.
(save-excursion
(let ((start (point))
- (class-key
- ;; Pike can have class definitions anywhere, so we must
- ;; check for the class key here.
- (and (c-major-mode-is 'pike-mode)
- c-decl-block-key))
(braceassignp 'dontknow)
inexpr-brace-list bufpos macro-start res pos after-type-id-pos
- in-paren parens-before-brace)
+ in-paren parens-before-brace
+ paren-state paren-pos)
(setq res (c-backward-token-2 1 t lim))
;; Checks to do only on the first sexp before the brace.
@@ -11601,8 +11839,10 @@ comment at the start of cc-engine.el for more info."
(cond
((and (or (not (eq res 0))
(eq (char-after) ?,))
- (c-go-up-list-backward nil lim) ; FIXME!!! Check ; `lim' 2016-07-12.
- (eq (char-after) ?\())
+ (setq paren-state (c-parse-state))
+ (setq paren-pos (c-pull-open-brace paren-state))
+ (eq (char-after paren-pos) ?\())
+ (goto-char paren-pos)
(setq braceassignp 'c++-noassign
in-paren 'in-paren))
((looking-at c-pre-id-bracelist-key)
@@ -11619,9 +11859,11 @@ comment at the start of cc-engine.el for more info."
(cond
((or (not (eq res 0))
(eq (char-after) ?,))
- (and (c-go-up-list-backward nil lim) ; FIXME!!! Check `lim' 2016-07-12.
- (eq (char-after) ?\()
- (setq in-paren 'in-paren)))
+ (and (setq paren-state (c-parse-state))
+ (setq paren-pos (c-pull-open-brace paren-state))
+ (eq (char-after paren-pos) ?\()
+ (setq in-paren 'in-paren)
+ (goto-char paren-pos)))
((looking-at c-pre-id-bracelist-key))
((looking-at c-return-key))
(t (setq after-type-id-pos (point))
@@ -11674,79 +11916,36 @@ comment at the start of cc-engine.el for more info."
(t
(goto-char pos)
- ;; Checks to do on all sexps before the brace, up to the
- ;; beginning of the statement.
- (while (eq braceassignp 'dontknow)
- (cond ((eq (char-after) ?\;)
- (setq braceassignp nil))
- ((and class-key
- (looking-at class-key))
- (setq braceassignp nil))
- ((and c-has-compound-literals
- (looking-at c-return-key))
- (setq braceassignp t)
- nil)
- ((eq (char-after) ?=)
- ;; We've seen a =, but must check earlier tokens so
- ;; that it isn't something that should be ignored.
- (setq braceassignp 'maybe)
- (while (and (eq braceassignp 'maybe)
- (zerop (c-backward-token-2 1 t lim)))
- (setq braceassignp
- (cond
- ;; Check for operator =
- ((and c-opt-op-identifier-prefix
- (looking-at c-opt-op-identifier-prefix))
- nil)
- ;; Check for `<opchar>= in Pike.
- ((and (c-major-mode-is 'pike-mode)
- (or (eq (char-after) ?`)
- ;; Special case for Pikes
- ;; `[]=, since '[' is not in
- ;; the punctuation class.
- (and (eq (char-after) ?\[)
- (eq (char-before) ?`))))
- nil)
- ((looking-at "\\s.") 'maybe)
- ;; make sure we're not in a C++ template
- ;; argument assignment
- ((and
- (c-major-mode-is 'c++-mode)
- (save-excursion
- (let ((here (point))
- (pos< (progn
- (skip-chars-backward "^<>")
- (point))))
- (and (eq (char-before) ?<)
- (not (c-crosses-statement-barrier-p
- pos< here))
- (not (c-in-literal))
- ))))
- nil)
- (t t)))))
- ((and
- (c-major-mode-is 'c++-mode)
- (eq (char-after) ?\[)
- ;; Be careful of "operator []"
- (not (save-excursion
- (c-backward-token-2 1 nil lim)
- (looking-at c-opt-op-identifier-prefix))))
- (setq braceassignp t)
- nil))
- (when (eq braceassignp 'dontknow)
- (cond ((and
- (not (eq (char-after) ?,))
- (save-excursion
- (c-backward-syntactic-ws)
- (eq (char-before) ?})))
- (setq braceassignp nil))
- ((/= (c-backward-token-2 1 t lim) 0)
- (if (save-excursion
- (and c-has-compound-literals
- (eq (c-backward-token-2 1 nil lim) 0)
- (eq (char-after) ?\()))
- (setq braceassignp t)
- (setq braceassignp nil))))))
+ (when (eq braceassignp 'dontknow)
+ (let* ((cache-entry (and containing-sexp
+ (c-laomib-get-cache containing-sexp)))
+ (lim2 (or (cadr cache-entry) lim))
+ sub-bassign-p)
+ (if cache-entry
+ (cond
+ ((<= (point) (cadr cache-entry))
+ ;; We're inside the region we've already scanned over, so
+ ;; just go to that scan's end position.
+ (goto-char (nth 2 cache-entry))
+ (setq braceassignp (nth 3 cache-entry)))
+ ((> (point) (cadr cache-entry))
+ ;; We're beyond the previous scan region, so just scan as
+ ;; far as the end of that region.
+ (setq sub-bassign-p (c-laomib-loop lim2))
+ (if (<= (point) (cadr cache-entry))
+ (progn
+ (c-laomib-put-cache containing-sexp
+ start (nth 2 cache-entry)
+ (nth 3 cache-entry) ;; sub-bassign-p
+ )
+ (setq braceassignp (nth 3 cache-entry))
+ (goto-char (nth 2 cache-entry)))
+ (setq braceassignp sub-bassign-p)))
+ (t))
+
+ (setq braceassignp (c-laomib-loop lim))
+ (when lim
+ (c-laomib-put-cache lim start (point) braceassignp)))))
(cond
(braceassignp
@@ -11785,7 +11984,7 @@ comment at the start of cc-engine.el for more info."
(goto-char (car res))
(c-do-declarators
(point-max) t nil nil
- (lambda (id-start id-end tok not-top func init)
+ (lambda (id-start _id-end _tok _not-top _func _init)
(cond
((> id-start after-type-id-pos)
(throw 'find-decl nil))
@@ -11875,7 +12074,7 @@ comment at the start of cc-engine.el for more info."
(or accept-in-paren (not (eq (cdr bufpos) 'in-paren)))
(car bufpos))))))
-(defun c-looking-at-special-brace-list (&optional _lim)
+(defun c-looking-at-special-brace-list ()
;; If we're looking at the start of a pike-style list, i.e., `({ })',
;; `([ ])', `(< >)', etc., a cons of a cons of its starting and ending
;; positions and its entry in c-special-brace-lists is returned, nil
@@ -12016,7 +12215,7 @@ comment at the start of cc-engine.el for more info."
(goto-char haskell-op-pos))
(while (and (eq res 'maybe)
- (progn (c-backward-syntactic-ws)
+ (progn (c-backward-syntactic-ws lim)
(> (point) closest-lim))
(not (bobp))
(progn (backward-char)
@@ -12505,8 +12704,7 @@ comment at the start of cc-engine.el for more info."
(defun c-add-class-syntax (symbol
containing-decl-open
containing-decl-start
- containing-decl-kwd
- _paren-state)
+ containing-decl-kwd)
;; The inclass and class-close syntactic symbols are added in
;; several places and some work is needed to fix everything.
;; Therefore it's collected here.
@@ -12555,7 +12753,7 @@ comment at the start of cc-engine.el for more info."
;; CASE B.1: class-open
((save-excursion
(and (eq (char-after) ?{)
- (c-looking-at-decl-block containing-sexp t)
+ (c-looking-at-decl-block t)
(setq beg-of-same-or-containing-stmt (point))))
(c-add-syntax 'class-open beg-of-same-or-containing-stmt))
@@ -12722,7 +12920,7 @@ comment at the start of cc-engine.el for more info."
literal char-before-ip before-ws-ip char-after-ip macro-start
in-macro-expr c-syntactic-context placeholder
step-type tmpsymbol keyword injava-inher special-brace-list tmp-pos
- containing-<
+ tmp-pos2 containing-<
;; The following record some positions for the containing
;; declaration block if we're directly within one:
;; `containing-decl-open' is the position of the open
@@ -12758,10 +12956,7 @@ comment at the start of cc-engine.el for more info."
(goto-char containing-sexp)
(eq (char-after) ?{))
(setq placeholder
- (c-looking-at-decl-block
- (c-most-enclosing-brace paren-state
- containing-sexp)
- t)))
+ (c-looking-at-decl-block t)))
(setq containing-decl-open containing-sexp
containing-decl-start (point)
containing-sexp nil)
@@ -12791,7 +12986,7 @@ comment at the start of cc-engine.el for more info."
(setq paren-state (cons containing-sexp paren-state)
containing-sexp nil)))
(setq lim (1+ containing-sexp))))
- (setq lim (point-min)))
+ (setq lim (c-determine-limit 1000)))
;; If we're in a parenthesis list then ',' delimits the
;; "statements" rather than being an operator (with the
@@ -13003,8 +13198,7 @@ comment at the start of cc-engine.el for more info."
(setq placeholder (c-add-class-syntax 'inclass
containing-decl-open
containing-decl-start
- containing-decl-kwd
- paren-state))
+ containing-decl-kwd))
;; Append access-label with the same anchor point as
;; inclass gets.
(c-append-syntax 'access-label placeholder))
@@ -13034,7 +13228,9 @@ comment at the start of cc-engine.el for more info."
;; CASE 4: In-expression statement. C.f. cases 7B, 16A and
;; 17E.
((setq placeholder (c-looking-at-inexpr-block
- (c-safe-position containing-sexp paren-state)
+ (or
+ (c-safe-position containing-sexp paren-state)
+ (c-determine-limit 1000 containing-sexp))
containing-sexp
;; Have to turn on the heuristics after
;; the point even though it doesn't work
@@ -13076,7 +13272,7 @@ comment at the start of cc-engine.el for more info."
((save-excursion
(let (tmp)
(and (eq char-after-ip ?{)
- (setq tmp (c-looking-at-decl-block containing-sexp t))
+ (setq tmp (c-looking-at-decl-block t))
(progn
(setq placeholder (point))
(goto-char tmp)
@@ -13097,7 +13293,7 @@ comment at the start of cc-engine.el for more info."
(goto-char indent-point)
(skip-chars-forward " \t")
(and (eq (char-after) ?{)
- (c-looking-at-decl-block containing-sexp t)
+ (c-looking-at-decl-block t)
(setq placeholder (point))))
(c-add-syntax 'class-open placeholder))
@@ -13137,8 +13333,7 @@ comment at the start of cc-engine.el for more info."
(c-add-class-syntax 'inclass
containing-decl-open
containing-decl-start
- containing-decl-kwd
- paren-state))
+ containing-decl-kwd))
;; CASE 5A.5: ordinary defun open
(t
@@ -13160,7 +13355,8 @@ comment at the start of cc-engine.el for more info."
;; init lists can, in practice, be very large.
((save-excursion
(when (and (c-major-mode-is 'c++-mode)
- (setq placeholder (c-back-over-member-initializers)))
+ (setq placeholder (c-back-over-member-initializers
+ lim)))
(setq tmp-pos (point))))
(if (= (c-point 'bosws) (1+ tmp-pos))
(progn
@@ -13201,8 +13397,7 @@ comment at the start of cc-engine.el for more info."
(c-add-class-syntax 'inclass
containing-decl-open
containing-decl-start
- containing-decl-kwd
- paren-state)))
+ containing-decl-kwd)))
;; CASE 5B.4: Nether region after a C++ or Java func
;; decl, which could include a `throws' declaration.
@@ -13272,8 +13467,7 @@ comment at the start of cc-engine.el for more info."
(c-add-class-syntax 'inclass
containing-decl-open
containing-decl-start
- containing-decl-kwd
- paren-state)))
+ containing-decl-kwd)))
;; CASE 5C.3: in a Java implements/extends
(injava-inher
@@ -13459,8 +13653,7 @@ comment at the start of cc-engine.el for more info."
(c-add-class-syntax 'class-close
containing-decl-open
containing-decl-start
- containing-decl-kwd
- paren-state))
+ containing-decl-kwd))
;; CASE 5H: we could be looking at subsequent knr-argdecls
((and c-recognize-knr-p
@@ -13482,7 +13675,7 @@ comment at the start of cc-engine.el for more info."
;; CASE 5I: ObjC method definition.
((and c-opt-method-key
(looking-at c-opt-method-key))
- (c-beginning-of-statement-1 nil t)
+ (c-beginning-of-statement-1 (c-determine-limit 1000) t)
(if (= (point) indent-point)
;; Handle the case when it's the first (non-comment)
;; thing in the buffer. Can't look for a 'same return
@@ -13555,7 +13748,16 @@ comment at the start of cc-engine.el for more info."
(if (>= (point) indent-point)
(throw 'not-in-directive t))
(setq placeholder (point)))
- nil)))))
+ nil))
+ (and macro-start
+ (not (c-beginning-of-statement-1 lim nil nil nil t))
+ (setq placeholder
+ (let ((ps-top (car paren-state)))
+ (if (consp ps-top)
+ (progn
+ (goto-char (cdr ps-top))
+ (c-forward-syntactic-ws indent-point))
+ (point-min))))))))
;; For historic reasons we anchor at bol of the last
;; line of the previous declaration. That's clearly
;; highly bogus and useless, and it makes our lives hard
@@ -13581,8 +13783,7 @@ comment at the start of cc-engine.el for more info."
(c-add-class-syntax 'inclass
containing-decl-open
containing-decl-start
- containing-decl-kwd
- paren-state)))
+ containing-decl-kwd)))
(when (and c-syntactic-indentation-in-macros
macro-start
(/= macro-start (c-point 'boi indent-point)))
@@ -13605,31 +13806,47 @@ comment at the start of cc-engine.el for more info."
(eq (char-before) ?<)
(not (and c-overloadable-operators-regexp
(c-after-special-operator-id lim))))
- (c-beginning-of-statement-1 (c-safe-position (point) paren-state))
+ (c-beginning-of-statement-1
+ (or
+ (c-safe-position (point) paren-state)
+ (c-determine-limit 1000)))
(c-add-syntax 'template-args-cont (c-point 'boi)))
;; CASE 5Q: we are at a statement within a macro.
- (macro-start
- (c-beginning-of-statement-1 containing-sexp)
+ ((and
+ macro-start
+ (save-excursion
+ (prog1
+ (not (eq (c-beginning-of-statement-1
+ (or containing-sexp (c-determine-limit 1000))
+ nil nil nil t)
+ nil)))
+ (setq placeholder (point))))
+ (goto-char placeholder)
(c-add-stmt-syntax 'statement nil t containing-sexp paren-state))
- ;;CASE 5N: We are at a topmost continuation line and the only
+ ;;CASE 5S: We are at a topmost continuation line and the only
;;preceding items are annotations.
((and (c-major-mode-is 'java-mode)
(setq placeholder (point))
- (c-beginning-of-statement-1)
+ (c-beginning-of-statement-1 lim)
(progn
- (while (and (c-forward-annotation))
- (c-forward-syntactic-ws))
+ (while (and (setq tmp-pos (point))
+ (< (point) placeholder)
+ (c-forward-annotation))
+ (c-forward-syntactic-ws)
+ (setq tmp-pos2 tmp-pos))
t)
(prog1
(>= (point) placeholder)
(goto-char placeholder)))
- (c-add-syntax 'annotation-top-cont (c-point 'boi)))
+ (c-add-syntax 'annotation-top-cont (c-point 'boi tmp-pos2)))
;; CASE 5M: we are at a topmost continuation line
(t
- (c-beginning-of-statement-1 (c-safe-position (point) paren-state))
+ (c-beginning-of-statement-1
+ (or (c-safe-position (point) paren-state)
+ (c-determine-limit 1000)))
(when (c-major-mode-is 'objc-mode)
(setq placeholder (point))
(while (and (c-forward-objc-directive)
@@ -13685,8 +13902,9 @@ comment at the start of cc-engine.el for more info."
(setq tmpsymbol '(block-open . inexpr-statement)
placeholder
(cdr-safe (c-looking-at-inexpr-block
- (c-safe-position containing-sexp
- paren-state)
+ (or
+ (c-safe-position containing-sexp paren-state)
+ (c-determine-limit 1000 containing-sexp))
containing-sexp)))
;; placeholder is nil if it's a block directly in
;; a function arglist. That makes us skip out of
@@ -13818,7 +14036,9 @@ comment at the start of cc-engine.el for more info."
(setq placeholder (c-guess-basic-syntax))))
(setq c-syntactic-context placeholder)
(c-beginning-of-statement-1
- (c-safe-position (1- containing-sexp) paren-state))
+ (or
+ (c-safe-position (1- containing-sexp) paren-state)
+ (c-determine-limit 1000 (1- containing-sexp))))
(c-forward-token-2 0)
(while (cond
((looking-at c-specifier-key)
@@ -13852,7 +14072,8 @@ comment at the start of cc-engine.el for more info."
(c-add-syntax 'brace-list-close (point))
(setq lim (or (save-excursion
(and
- (c-back-over-member-initializers)
+ (c-back-over-member-initializers
+ (c-determine-limit 1000))
(point)))
(c-most-enclosing-brace state-cache (point))))
(c-beginning-of-statement-1 lim nil nil t)
@@ -13885,7 +14106,8 @@ comment at the start of cc-engine.el for more info."
(c-add-syntax 'brace-list-intro (point))
(setq lim (or (save-excursion
(and
- (c-back-over-member-initializers)
+ (c-back-over-member-initializers
+ (c-determine-limit 1000))
(point)))
(c-most-enclosing-brace state-cache (point))))
(c-beginning-of-statement-1 lim nil nil t)
@@ -13898,7 +14120,7 @@ comment at the start of cc-engine.el for more info."
(save-excursion
(goto-char indent-point)
(c-forward-syntactic-ws (c-point 'eol))
- (c-looking-at-special-brace-list (point)))))
+ (c-looking-at-special-brace-list))))
(c-add-syntax 'brace-entry-open (point))
(c-add-stmt-syntax 'brace-list-entry nil t containing-sexp
paren-state (point))
@@ -13941,7 +14163,9 @@ comment at the start of cc-engine.el for more info."
;; CASE 16A: closing a lambda defun or an in-expression
;; block? C.f. cases 4, 7B and 17E.
((setq placeholder (c-looking-at-inexpr-block
- (c-safe-position containing-sexp paren-state)
+ (or
+ (c-safe-position containing-sexp paren-state)
+ (c-determine-limit 1000 containing-sexp))
nil))
(setq tmpsymbol (if (eq (car placeholder) 'inlambda)
'inline-close
@@ -13964,9 +14188,7 @@ comment at the start of cc-engine.el for more info."
(and lim
(progn
(goto-char lim)
- (c-looking-at-decl-block
- (c-most-enclosing-brace paren-state lim)
- nil))
+ (c-looking-at-decl-block nil))
(setq placeholder (point))))
(c-backward-to-decl-anchor lim)
(back-to-indentation)
@@ -14106,7 +14328,9 @@ comment at the start of cc-engine.el for more info."
;; CASE 17E: first statement in an in-expression block.
;; C.f. cases 4, 7B and 16A.
((setq placeholder (c-looking-at-inexpr-block
- (c-safe-position containing-sexp paren-state)
+ (or
+ (c-safe-position containing-sexp paren-state)
+ (c-determine-limit 1000 containing-sexp))
nil))
(setq tmpsymbol (if (eq (car placeholder) 'inlambda)
'defun-block-intro
@@ -14134,9 +14358,7 @@ comment at the start of cc-engine.el for more info."
(and (progn
(goto-char placeholder)
(eq (char-after) ?{))
- (c-looking-at-decl-block (c-most-enclosing-brace
- paren-state (point))
- nil))))
+ (c-looking-at-decl-block nil))))
(c-backward-to-decl-anchor lim)
(back-to-indentation)
(c-add-syntax 'defun-block-intro (point)))
diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el
index bb7e5bea6e6..4e283764ceb 100644
--- a/lisp/progmodes/cc-fonts.el
+++ b/lisp/progmodes/cc-fonts.el
@@ -1,6 +1,6 @@
;;; cc-fonts.el --- font lock support for CC Mode
-;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Authors: 2003- Alan Mackenzie
;; 2002- Martin Stjernholm
@@ -76,9 +76,6 @@
(cc-require-when-compile 'cc-langs)
(cc-require 'cc-vars)
(cc-require 'cc-engine)
-(cc-require-when-compile 'cc-awk) ; Change from cc-require, 2003/6/18 to
-;; prevent cc-awk being loaded when it's not needed. There is now a (require
-;; 'cc-awk) in (defun awk-mode ..).
;; Avoid repeated loading through the eval-after-load directive in
;; cc-mode.el.
@@ -947,7 +944,7 @@ casts and declarations are fontified. Used on level 2 and higher."
;; closest token before the region.
(save-excursion
(let ((pos (point)))
- (c-backward-syntactic-ws)
+ (c-backward-syntactic-ws (max (- (point) 500) (point-min)))
(c-clear-char-properties
(if (and (not (bobp))
(memq (c-get-char-property (1- (point)) 'c-type)
@@ -969,7 +966,7 @@ casts and declarations are fontified. Used on level 2 and higher."
;; The declared identifiers are font-locked correctly as types, if
;; that is what they are.
(let ((prop (save-excursion
- (c-backward-syntactic-ws)
+ (c-backward-syntactic-ws (max (- (point) 500) (point-min)))
(unless (bobp)
(c-get-char-property (1- (point)) 'c-type)))))
(when (memq prop '(c-decl-id-start c-decl-type-start))
@@ -1008,66 +1005,75 @@ casts and declarations are fontified. Used on level 2 and higher."
(boundp 'parse-sexp-lookup-properties)))
(c-parse-and-markup-<>-arglists t)
c-restricted-<>-arglists
- id-start id-end id-face pos kwd-sym)
+ id-start id-end id-face pos kwd-sym
+ old-pos)
(while (and (< (point) limit)
- (re-search-forward c-opt-<>-arglist-start limit t))
-
- (setq id-start (match-beginning 1)
- id-end (match-end 1)
- pos (point))
-
- (goto-char id-start)
- (unless (c-skip-comments-and-strings limit)
- (setq kwd-sym nil
- c-restricted-<>-arglists nil
- id-face (get-text-property id-start 'face))
-
- (if (cond
- ((eq id-face 'font-lock-type-face)
- ;; The identifier got the type face so it has already been
- ;; handled in `c-font-lock-declarations'.
- nil)
-
- ((eq id-face 'font-lock-keyword-face)
- (when (looking-at c-opt-<>-sexp-key)
- ;; There's a special keyword before the "<" that tells
- ;; that it's an angle bracket arglist.
- (setq kwd-sym (c-keyword-sym (match-string 1)))))
-
- (t
- ;; There's a normal identifier before the "<". If we're not in
- ;; a declaration context then we set `c-restricted-<>-arglists'
- ;; to avoid recognizing templates in function calls like "foo (a
- ;; < b, c > d)".
- (c-backward-syntactic-ws)
- (when (and (memq (char-before) '(?\( ?,))
- (not (eq (get-text-property (1- (point)) 'c-type)
- 'c-decl-arg-start)))
- (setq c-restricted-<>-arglists t))
- t))
+ (setq old-pos (point))
+ (c-syntactic-re-search-forward "<" limit t nil t))
+ (setq pos (point))
+ (save-excursion
+ (backward-char)
+ (c-backward-syntactic-ws old-pos)
+ (if (re-search-backward
+ (concat "\\(\\`\\|" c-nonsymbol-key "\\)\\(" c-symbol-key"\\)\\=")
+ old-pos t)
+ (setq id-start (match-beginning 2)
+ id-end (match-end 2))
+ (setq id-start nil id-end nil)))
+
+ (when id-start
+ (goto-char id-start)
+ (unless (c-skip-comments-and-strings limit)
+ (setq kwd-sym nil
+ c-restricted-<>-arglists nil
+ id-face (get-text-property id-start 'face))
+
+ (if (cond
+ ((eq id-face 'font-lock-type-face)
+ ;; The identifier got the type face so it has already been
+ ;; handled in `c-font-lock-declarations'.
+ nil)
- (progn
- (goto-char (1- pos))
- ;; Check for comment/string both at the identifier and
- ;; at the "<".
- (unless (c-skip-comments-and-strings limit)
-
- (c-fontify-types-and-refs ()
- (when (c-forward-<>-arglist (c-keyword-member
- kwd-sym 'c-<>-type-kwds))
- (when (and c-opt-identifier-concat-key
- (not (get-text-property id-start 'face)))
- (c-forward-syntactic-ws)
- (cond ((looking-at c-opt-identifier-concat-key)
- (c-put-font-lock-face id-start id-end
- c-reference-face-name))
- ((eq (char-after) ?\())
- (t (c-put-font-lock-face id-start id-end
- 'font-lock-type-face))))))
-
- (goto-char pos)))
- (goto-char pos))))))
+ ((eq id-face 'font-lock-keyword-face)
+ (when (looking-at c-opt-<>-sexp-key)
+ ;; There's a special keyword before the "<" that tells
+ ;; that it's an angle bracket arglist.
+ (setq kwd-sym (c-keyword-sym (match-string 2)))))
+
+ (t
+ ;; There's a normal identifier before the "<". If we're not in
+ ;; a declaration context then we set `c-restricted-<>-arglists'
+ ;; to avoid recognizing templates in function calls like "foo (a
+ ;; < b, c > d)".
+ (c-backward-syntactic-ws)
+ (when (and (memq (char-before) '(?\( ?,))
+ (not (eq (get-text-property (1- (point)) 'c-type)
+ 'c-decl-arg-start)))
+ (setq c-restricted-<>-arglists t))
+ t))
+
+ (progn
+ (goto-char (1- pos))
+ ;; Check for comment/string both at the identifier and
+ ;; at the "<".
+ (unless (c-skip-comments-and-strings limit)
+
+ (c-fontify-types-and-refs ()
+ (when (c-forward-<>-arglist (c-keyword-member
+ kwd-sym 'c-<>-type-kwds))
+ (when (and c-opt-identifier-concat-key
+ (not (get-text-property id-start 'face)))
+ (c-forward-syntactic-ws)
+ (cond ((looking-at c-opt-identifier-concat-key)
+ (c-put-font-lock-face id-start id-end
+ c-reference-face-name))
+ ((eq (char-after) ?\())
+ (t (c-put-font-lock-face id-start id-end
+ 'font-lock-type-face))))))
+
+ (goto-char pos)))
+ (goto-char pos)))))))
nil)
(defun c-font-lock-declarators (limit list types not-top
@@ -1496,7 +1502,8 @@ casts and declarations are fontified. Used on level 2 and higher."
;; Check we haven't missed a preceding "typedef".
(when (not (looking-at c-typedef-key))
- (c-backward-syntactic-ws)
+ (c-backward-syntactic-ws
+ (max (- (point) 1000) (point-min)))
(c-backward-token-2)
(or (looking-at c-typedef-key)
(goto-char start-pos)))
@@ -1536,8 +1543,10 @@ casts and declarations are fontified. Used on level 2 and higher."
(c-backward-token-2)
(and
(not (looking-at c-opt-<>-sexp-key))
- (progn (c-backward-syntactic-ws)
- (memq (char-before) '(?\( ?,)))
+ (progn
+ (c-backward-syntactic-ws
+ (max (- (point) 1000) (point-min)))
+ (memq (char-before) '(?\( ?,)))
(not (eq (c-get-char-property (1- (point))
'c-type)
'c-decl-arg-start))))))
@@ -2295,7 +2304,8 @@ need for `c-font-lock-extra-types'.")
(and c-colon-type-list-re
(c-go-up-list-backward)
(eq (char-after) ?{)
- (eq (car (c-beginning-of-decl-1)) 'same)
+ (eq (car (c-beginning-of-decl-1
+ (c-determine-limit 1000))) 'same)
(looking-at c-colon-type-list-re)))
;; Inherited protected member: leave unfontified
)
diff --git a/lisp/progmodes/cc-guess.el b/lisp/progmodes/cc-guess.el
index 8c4b3814e1a..1b852ec4910 100644
--- a/lisp/progmodes/cc-guess.el
+++ b/lisp/progmodes/cc-guess.el
@@ -1,6 +1,6 @@
;;; cc-guess.el --- guess indentation values by scanning existing code
-;; Copyright (C) 1985, 1987, 1992-2006, 2011-2020 Free Software
+;; Copyright (C) 1985, 1987, 1992-2006, 2011-2021 Free Software
;; Foundation, Inc.
;; Author: 1994-1995 Barry A. Warsaw
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el
index 80c461c76cb..f4dcbcda962 100644
--- a/lisp/progmodes/cc-langs.el
+++ b/lisp/progmodes/cc-langs.el
@@ -1,6 +1,6 @@
;;; cc-langs.el --- language specific settings for CC Mode -*- coding: utf-8 -*-
-;; Copyright (C) 1985, 1987, 1992-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc.
;; Authors: 2002- Alan Mackenzie
;; 1998- Martin Stjernholm
@@ -457,13 +457,11 @@ so that all identifiers are recognized as words.")
c-before-change-check-raw-strings
c-before-change-check-<>-operators
c-depropertize-CPP
- c-invalidate-macro-cache
c-truncate-bs-cache
c-before-change-check-unbalanced-strings
c-parse-quotes-before-change)
(c objc) '(c-extend-region-for-CPP
c-depropertize-CPP
- c-invalidate-macro-cache
c-truncate-bs-cache
c-before-change-check-unbalanced-strings
c-parse-quotes-before-change)
@@ -549,7 +547,7 @@ parameters (point-min), (point-max) and <buffer size>.")
(c-lang-defconst c-before-context-fontification-functions
t 'c-context-expand-fl-region
- awk nil)
+ awk 'c-awk-context-expand-fl-region)
;; For documentation see the following c-lang-defvar of the same name.
;; The value here may be a list of functions or a single function.
(c-lang-defvar c-before-context-fontification-functions
@@ -581,12 +579,14 @@ don't have EOL terminated statements. "
(c-lang-defvar c-at-vsemi-p-fn (c-lang-const c-at-vsemi-p-fn))
(c-lang-defconst c-vsemi-status-unknown-p-fn
- "Contains a function \"are we unsure whether there is a virtual semicolon on this line?\".
-The (admittedly kludgy) purpose of such a function is to prevent an infinite
-recursion in c-beginning-of-statement-1 when point starts at a `while' token.
-The function MUST NOT UNDER ANY CIRCUMSTANCES call c-beginning-of-statement-1,
-even indirectly. This variable contains nil for languages which don't have
-EOL terminated statements."
+ "Contains a predicate regarding the presence of virtual semicolons.
+More precisely, the function answers the question, \"are we unsure whether a
+virtual semicolon exists on this line?\". The (admittedly kludgy) purpose of
+such a function is to prevent an infinite recursion in
+`c-beginning-of-statement-1' when point starts at a `while' token. The function
+MUST NOT UNDER ANY CIRCUMSTANCES call `c-beginning-of-statement-1', even
+indirectly. This variable contains nil for languages which don't have EOL
+terminated statements."
t nil
(c c++ objc) 'c-macro-vsemi-status-unknown-p
awk 'c-awk-vsemi-status-unknown-p)
@@ -699,6 +699,7 @@ It's assumed to not contain any submatchers."
;; The same thing regarding Unicode identifiers applies here as to
;; `c-symbol-key'.
t (concat "[" (c-lang-const c-nonsymbol-chars) "]"))
+(c-lang-defvar c-nonsymbol-key (c-lang-const c-nonsymbol-key))
(c-lang-defconst c-identifier-ops
"The operators that make up fully qualified identifiers. nil in
@@ -3683,7 +3684,7 @@ When \"(\" is present, that defun will attempt to parse a
parenthesized expression inside the template. When \")\" is
present it will treat an unbalanced closing paren as a sign of
the invalidity of the putative template construct."
- t "[<;{},|+&->)]"
+ t "[<;{},|+&>)-]"
c++ "[<;{},>()]")
(c-lang-defvar c-<>-notable-chars-re (c-lang-const c-<>-notable-chars-re))
diff --git a/lisp/progmodes/cc-menus.el b/lisp/progmodes/cc-menus.el
index 97037dea6e8..0ff6efb7d37 100644
--- a/lisp/progmodes/cc-menus.el
+++ b/lisp/progmodes/cc-menus.el
@@ -1,6 +1,6 @@
;;; cc-menus.el --- imenu support for CC Mode
-;; Copyright (C) 1985, 1987, 1992-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc.
;; Authors: 1998- Martin Stjernholm
;; 1992-1999 Barry A. Warsaw
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index c6dd671051d..cfb23d0d45e 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -1,6 +1,6 @@
;;; cc-mode.el --- major mode for editing C and similar languages
-;; Copyright (C) 1985, 1987, 1992-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc.
;; Authors: 2003- Alan Mackenzie
;; 1998- Martin Stjernholm
@@ -113,6 +113,7 @@
;; Silence the compiler.
(cc-bytecomp-defvar adaptive-fill-first-line-regexp) ; Emacs
(cc-bytecomp-defun run-mode-hooks) ; Emacs 21.1
+(cc-bytecomp-defvar awk-mode-syntax-table)
;; We set this variable during mode init, yet we don't require
;; font-lock.
@@ -499,11 +500,14 @@ preferably use the `c-mode-menu' language constant directly."
(save-excursion
(when (< beg end)
(goto-char beg)
+ (let ((lim (c-determine-limit 1000))
+ (lim+ (c-determine-+ve-limit 1000 end)))
(when
(and (not (bobp))
- (progn (c-backward-syntactic-ws) (eq (point) beg))
+ (progn (c-backward-syntactic-ws lim) (eq (point) beg))
(/= (skip-chars-backward c-symbol-chars (1- (point))) 0)
- (progn (goto-char beg) (c-forward-syntactic-ws) (<= (point) end))
+ (progn (goto-char beg) (c-forward-syntactic-ws lim+)
+ (<= (point) end))
(> (point) beg)
(goto-char end)
(looking-at c-symbol-char-key))
@@ -514,14 +518,14 @@ preferably use the `c-mode-menu' language constant directly."
(goto-char end)
(when
(and (not (eobp))
- (progn (c-forward-syntactic-ws) (eq (point) end))
+ (progn (c-forward-syntactic-ws lim+) (eq (point) end))
(looking-at c-symbol-char-key)
- (progn (c-backward-syntactic-ws) (>= (point) beg))
+ (progn (c-backward-syntactic-ws lim) (>= (point) beg))
(< (point) end)
(/= (skip-chars-backward c-symbol-chars (1- (point))) 0))
(goto-char (1+ end))
(c-end-of-current-token)
- (c-unfind-type (buffer-substring-no-properties end (point)))))))
+ (c-unfind-type (buffer-substring-no-properties end (point))))))))
;; c-maybe-stale-found-type records a place near the region being
;; changed where an element of `found-types' might become stale. It
@@ -636,6 +640,8 @@ that requires a literal mode spec at compile time."
;; doesn't work with filladapt but it's better than nothing.
(set (make-local-variable 'fill-paragraph-function) 'c-fill-paragraph)
+ ;; Initialize the cache for `c-looking-at-or-maybe-in-bracelist'.
+ (setq c-laomib-cache nil)
;; Initialize the three literal sub-caches.
(c-truncate-lit-pos-cache 1)
;; Initialize the cache of brace pairs, and opening braces/brackets/parens.
@@ -725,8 +731,8 @@ that requires a literal mode spec at compile time."
;; ;; Put submode indicators onto minor-mode-alist, but only once.
;; (or (assq 'c-submode-indicators minor-mode-alist)
;; (setq minor-mode-alist
-;; (cons '(c-submode-indicators c-submode-indicators)
-;; minor-mode-alist)))
+;; (cons '(c-submode-indicators c-submode-indicators)
+;; minor-mode-alist)))
(c-update-modeline)
;; Install the functions that ensure that various internal caches
@@ -1252,7 +1258,7 @@ Note that the style variables are always made local to the buffer."
;; Set both the syntax-table and the c-fl-syn-tab text properties at POS to
;; VALUE (which should not be nil).
;; `(let ((-pos- ,pos)
- ;; (-value- ,value))
+ ;; (-value- ,value))
(c-put-char-property pos 'syntax-table value)
(c-put-char-property pos 'c-fl-syn-tab value)
(cond
@@ -1482,7 +1488,7 @@ Note that the style variables are always made local to the buffer."
((and
(c-is-escaped end)
(or (eq beg end) ; .... by inserting stuff between \ and \n?
- (c-will-be-unescaped beg end))) ; ... by removing an odd number of \s?
+ (c-will-be-unescaped beg))) ; ... by removing an odd number of \s?
(goto-char (1+ end))) ; To after the NL which is being unescaped.
(t
(goto-char end)))
@@ -1996,7 +2002,7 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".")
;; We search for appropriate c-type properties "near"
;; the change. First, find an appropriate boundary
;; for this property search.
- (let (lim
+ (let (lim lim-2
type type-pos
marked-id term-pos
(end1
@@ -2007,8 +2013,11 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".")
(when (>= end1 beg) ; Don't hassle about changes entirely in
; comments.
;; Find a limit for the search for a `c-type' property
+ ;; Point is currently undefined. A `goto-char' somewhere is needed. (2020-12-06).
+ (setq lim-2 (c-determine-limit 1000 (point) ; that is wrong. FIXME!!! (2020-12-06)
+ ))
(while
- (and (/= (skip-chars-backward "^;{}") 0)
+ (and (/= (skip-chars-backward "^;{}" lim-2) 0)
(> (point) (point-min))
(memq (c-get-char-property (1- (point)) 'face)
'(font-lock-comment-face font-lock-string-face))))
@@ -2032,7 +2041,8 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".")
(buffer-substring-no-properties (point) type-pos)))
(goto-char end1)
- (skip-chars-forward "^;{}") ; FIXME!!! loop for
+ (setq lim-2 (c-determine-+ve-limit 1000))
+ (skip-chars-forward "^;{}" lim-2) ; FIXME!!! loop for
; comment, maybe
(setq lim (point))
(setq term-pos
@@ -2047,13 +2057,19 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".")
(if c-get-state-before-change-functions
(mapc (lambda (fn)
(funcall fn beg end))
- c-get-state-before-change-functions))))
+ c-get-state-before-change-functions))
+
+ (c-laomib-invalidate-cache beg end)))
(c-clear-string-fences))))
(c-truncate-lit-pos-cache beg)
;; The following must be done here rather than in `c-after-change'
;; because newly inserted parens would foul up the invalidation
;; algorithm.
- (c-invalidate-state-cache beg)))
+ (c-invalidate-state-cache beg)
+ ;; The following must happen after the previous, which likely alters
+ ;; the macro cache.
+ (when c-opt-cpp-symbol
+ (c-invalidate-macro-cache beg end))))
(defvar c-in-after-change-fontification nil)
(make-variable-buffer-local 'c-in-after-change-fontification)
@@ -2198,7 +2214,8 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".")
old-pos
(new-pos pos)
capture-opener
- bod-lim bo-decl)
+ bod-lim bo-decl
+ paren-state containing-brace)
(goto-char (c-point 'bol new-pos))
(unless lit-start
(setq bod-lim (c-determine-limit 500))
@@ -2217,12 +2234,16 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".")
(setq old-pos (point))
(let (pseudo)
(while
- (progn
- (c-syntactic-skip-backward "^;{}" bod-lim t)
- (and (eq (char-before) ?})
- (save-excursion
- (backward-char)
- (setq pseudo (c-cheap-inside-bracelist-p (c-parse-state))))))
+ (and
+ ;; N.B. `c-syntactic-skip-backward' doesn't check (> (point)
+ ;; lim) and can loop if that's not the case.
+ (> (point) bod-lim)
+ (progn
+ (c-syntactic-skip-backward "^;{}" bod-lim t)
+ (and (eq (char-before) ?})
+ (save-excursion
+ (backward-char)
+ (setq pseudo (c-cheap-inside-bracelist-p (c-parse-state)))))))
(goto-char pseudo))
t)
(> (point) bod-lim)
@@ -2255,7 +2276,14 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".")
(and (eq (char-before) ?{)
(save-excursion
(backward-char)
- (consp (c-looking-at-or-maybe-in-bracelist))))
+ (setq paren-state (c-parse-state))
+ (while
+ (and
+ (setq containing-brace
+ (c-pull-open-brace paren-state))
+ (not (eq (char-after containing-brace) ?{))))
+ (consp (c-looking-at-or-maybe-in-bracelist
+ containing-brace containing-brace))))
)))
(not (bobp)))
(backward-char)) ; back over (, [, <.
@@ -2270,9 +2298,11 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".")
;; preserved.
(goto-char pos)
(let ((lit-start (c-literal-start))
+ (lim (c-determine-limit 1000))
enclosing-attribute pos1)
(unless lit-start
- (c-backward-syntactic-ws)
+ (c-backward-syntactic-ws
+ lim)
(when (setq enclosing-attribute (c-enclosing-c++-attribute))
(goto-char (car enclosing-attribute))) ; Only happens in C++ Mode.
(when (setq pos1 (c-on-identifier))
@@ -2296,14 +2326,14 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".")
(setq pos1 (c-on-identifier))
(goto-char pos1)
(progn
- (c-backward-syntactic-ws)
+ (c-backward-syntactic-ws lim)
(eq (char-before) ?\())
(c-fl-decl-end (1- (point))))
- (c-backward-syntactic-ws)
+ (c-backward-syntactic-ws lim)
(point))))
(and (progn (c-forward-syntactic-ws lim)
(not (eobp)))
- (c-backward-syntactic-ws)
+ (c-backward-syntactic-ws lim)
(point)))))))))
(defun c-change-expand-fl-region (_beg _end _old-len)
@@ -2597,7 +2627,8 @@ Key bindings:
(setq abbrev-mode t)
(c-init-language-vars-for 'c-mode)
(c-common-init 'c-mode)
- (easy-menu-add c-c-menu)
+ (when (featurep 'xemacs)
+ (easy-menu-add c-c-menu))
(cc-imenu-init cc-imenu-c-generic-expression)
(add-hook 'flymake-diagnostic-functions 'flymake-cc nil t)
(c-run-mode-hooks 'c-mode-common-hook))
@@ -2688,7 +2719,8 @@ Key bindings:
(setq abbrev-mode t)
(c-init-language-vars-for 'c++-mode)
(c-common-init 'c++-mode)
- (easy-menu-add c-c++-menu)
+ (when (featurep 'xemacs)
+ (easy-menu-add c-c++-menu))
(cc-imenu-init cc-imenu-c++-generic-expression)
(add-hook 'flymake-diagnostic-functions 'flymake-cc nil t)
(c-run-mode-hooks 'c-mode-common-hook))
@@ -2735,7 +2767,8 @@ Key bindings:
(setq abbrev-mode t)
(c-init-language-vars-for 'objc-mode)
(c-common-init 'objc-mode)
- (easy-menu-add c-objc-menu)
+ (when (featurep 'xemacs)
+ (easy-menu-add c-objc-menu))
(cc-imenu-init nil 'cc-imenu-objc-function)
(c-run-mode-hooks 'c-mode-common-hook))
@@ -2785,7 +2818,8 @@ Key bindings:
(setq abbrev-mode t)
(c-init-language-vars-for 'java-mode)
(c-common-init 'java-mode)
- (easy-menu-add c-java-menu)
+ (when (featurep 'xemacs)
+ (easy-menu-add c-java-menu))
(cc-imenu-init cc-imenu-java-generic-expression)
(c-run-mode-hooks 'c-mode-common-hook))
@@ -2827,7 +2861,8 @@ Key bindings:
(c-initialize-cc-mode t)
(c-init-language-vars-for 'idl-mode)
(c-common-init 'idl-mode)
- (easy-menu-add c-idl-menu)
+ (when (featurep 'xemacs)
+ (easy-menu-add c-idl-menu))
;;(cc-imenu-init cc-imenu-idl-generic-expression) ;TODO
(c-run-mode-hooks 'c-mode-common-hook))
@@ -2872,7 +2907,8 @@ Key bindings:
(setq abbrev-mode t)
(c-init-language-vars-for 'pike-mode)
(c-common-init 'pike-mode)
- (easy-menu-add c-pike-menu)
+ (when (featurep 'xemacs)
+ (easy-menu-add c-pike-menu))
;;(cc-imenu-init cc-imenu-pike-generic-expression) ;TODO
(c-run-mode-hooks 'c-mode-common-hook))
diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el
index 855e467571d..aec259f1b38 100644
--- a/lisp/progmodes/cc-styles.el
+++ b/lisp/progmodes/cc-styles.el
@@ -1,6 +1,6 @@
;;; cc-styles.el --- support for styles in CC Mode
-;; Copyright (C) 1985, 1987, 1992-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc.
;; Authors: 2004- Alan Mackenzie
;; 1998- Martin Stjernholm
diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el
index 9e6f9527ca1..88ee092da79 100644
--- a/lisp/progmodes/cc-vars.el
+++ b/lisp/progmodes/cc-vars.el
@@ -1,6 +1,6 @@
;;; cc-vars.el --- user customization variables for CC Mode
-;; Copyright (C) 1985, 1987, 1992-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc.
;; Authors: 2002- Alan Mackenzie
;; 1998- Martin Stjernholm
@@ -575,7 +575,8 @@ comment styles:
javadoc -- Javadoc style for \"/** ... */\" comments (default in Java mode).
autodoc -- Pike autodoc style for \"//! ...\" comments (default in Pike mode).
- gtkdoc -- GtkDoc style for \"/** ... **/\" comments (default in C and C++ modes).
+ gtkdoc -- GtkDoc style for \"/** ... **/\" comments
+ (default in C and C++ modes).
doxygen -- Doxygen style.
The value may also be a list of doc comment styles, in which case all
diff --git a/lisp/progmodes/cfengine.el b/lisp/progmodes/cfengine.el
index a8fe485b702..f516664f7f4 100644
--- a/lisp/progmodes/cfengine.el
+++ b/lisp/progmodes/cfengine.el
@@ -1,6 +1,6 @@
;;; cfengine.el --- mode for editing Cfengine files
-;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Maintainer: Ted Zlatanov <tzz@lifelogs.com>
@@ -1314,19 +1314,19 @@ see. Use it by enabling `eldoc-mode'."
(append bounds (list (cdr flist))))))
(defun cfengine-common-settings ()
- (set (make-local-variable 'syntax-propertize-function)
- ;; In the main syntax-table, \ is marked as a punctuation, because
- ;; of its use in DOS-style directory separators. Here we try to
- ;; recognize the cases where \ is used as an escape inside strings.
- (syntax-propertize-rules ("\\(\\(?:\\\\\\)+\\)\"" (1 "\\"))))
- (set (make-local-variable 'parens-require-spaces) nil)
- (set (make-local-variable 'comment-start) "# ")
- (set (make-local-variable 'comment-start-skip)
- "\\(\\(?:^\\|[^\\\n]\\)\\(?:\\\\\\\\\\)*\\)#+[ \t]*")
+ (setq-local syntax-propertize-function
+ ;; In the main syntax-table, \ is marked as a punctuation, because
+ ;; of its use in DOS-style directory separators. Here we try to
+ ;; recognize the cases where \ is used as an escape inside strings.
+ (syntax-propertize-rules ("\\(\\(?:\\\\\\)+\\)\"" (1 "\\"))))
+ (setq-local parens-require-spaces nil)
+ (setq-local comment-start "# ")
+ (setq-local comment-start-skip
+ "\\(\\(?:^\\|[^\\\n]\\)\\(?:\\\\\\\\\\)*\\)#+[ \t]*")
;; Like Lisp mode. Without this, we lose with, say,
;; `backward-up-list' when there's an unbalanced quote in a
;; preceding comment.
- (set (make-local-variable 'parse-sexp-ignore-comments) t))
+ (setq-local parse-sexp-ignore-comments t))
(defun cfengine-common-syntax (table)
;; The syntax defaults seem OK to give reasonable word movement.
@@ -1374,7 +1374,7 @@ to the action header."
(cfengine-common-settings)
(cfengine-common-syntax cfengine3-mode-syntax-table)
- (set (make-local-variable 'indent-line-function) #'cfengine3-indent-line)
+ (setq-local indent-line-function #'cfengine3-indent-line)
(setq font-lock-defaults
'(cfengine3-font-lock-keywords
@@ -1384,11 +1384,11 @@ to the action header."
;; `compile-command' is almost never a `make' call with CFEngine so
;; we override it
(when cfengine-cf-promises
- (set (make-local-variable 'compile-command)
- (concat cfengine-cf-promises
- " -f "
- (when buffer-file-name
- (shell-quote-argument buffer-file-name)))))
+ (setq-local compile-command
+ (concat cfengine-cf-promises
+ " -f "
+ (when buffer-file-name
+ (shell-quote-argument buffer-file-name)))))
(add-hook 'eldoc-documentation-functions
#'cfengine3-documentation-function nil t)
@@ -1418,20 +1418,18 @@ to the action header."
;; should avoid potential confusion in some cases.
(modify-syntax-entry ?\` "\"" cfengine2-mode-syntax-table)
- (set (make-local-variable 'indent-line-function) #'cfengine2-indent-line)
- (set (make-local-variable 'outline-regexp) "[ \t]*\\(\\sw\\|\\s_\\)+:+")
- (set (make-local-variable 'outline-level) #'cfengine2-outline-level)
- (set (make-local-variable 'fill-paragraph-function)
- #'cfengine-fill-paragraph)
+ (setq-local indent-line-function #'cfengine2-indent-line)
+ (setq-local outline-regexp "[ \t]*\\(\\sw\\|\\s_\\)+:+")
+ (setq-local outline-level #'cfengine2-outline-level)
+ (setq-local fill-paragraph-function #'cfengine-fill-paragraph)
(define-abbrev-table 'cfengine2-mode-abbrev-table cfengine-mode-abbrevs)
(setq font-lock-defaults
'(cfengine2-font-lock-keywords nil nil nil beginning-of-line))
;; Fixme: set the args of functions in evaluated classes to string
;; syntax, and then obey syntax properties.
(setq imenu-generic-expression cfengine2-imenu-expression)
- (set (make-local-variable 'beginning-of-defun-function)
- #'cfengine2-beginning-of-defun)
- (set (make-local-variable 'end-of-defun-function) #'cfengine2-end-of-defun))
+ (setq-local beginning-of-defun-function #'cfengine2-beginning-of-defun)
+ (setq-local end-of-defun-function #'cfengine2-end-of-defun))
;;;###autoload
(defun cfengine-auto-mode ()
diff --git a/lisp/progmodes/cl-font-lock.el b/lisp/progmodes/cl-font-lock.el
index cb6bd6c34bb..178fe944f30 100644
--- a/lisp/progmodes/cl-font-lock.el
+++ b/lisp/progmodes/cl-font-lock.el
@@ -1,5 +1,5 @@
;;; cl-font-lock.el --- Pretty Common Lisp font locking -*- lexical-binding: t; -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; Author: Yue Daian <sheepduke@gmail.com>
;; Maintainer: Spenser Truex <web@spensertruex.com>
diff --git a/lisp/progmodes/cmacexp.el b/lisp/progmodes/cmacexp.el
index 78e0a5bba08..d3a33bdf870 100644
--- a/lisp/progmodes/cmacexp.el
+++ b/lisp/progmodes/cmacexp.el
@@ -1,6 +1,6 @@
;;; cmacexp.el --- expand C macros in a region
-;; Copyright (C) 1992, 1994, 1996, 2000-2020 Free Software Foundation,
+;; Copyright (C) 1992, 1994, 1996, 2000-2021 Free Software Foundation,
;; Inc.
;; Author: Francesco Potortì <pot@gnu.org>
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index de0ea428d5e..94e4f3c6fa7 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -1,6 +1,6 @@
;;; compile.el --- run compiler as inferior of Emacs, parse error messages -*- lexical-binding:t -*-
-;; Copyright (C) 1985-1987, 1993-1999, 2001-2020 Free Software
+;; Copyright (C) 1985-1987, 1993-1999, 2001-2021 Free Software
;; Foundation, Inc.
;; Authors: Roland McGrath <roland@gnu.org>,
@@ -214,10 +214,6 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
"^\"\\([^,\" \n\t]+\\)\", line \\([0-9]+\\)\
\\(?:[(. pos]+\\([0-9]+\\))?\\)?[:.,; (-]\\( warning:\\|[-0-9 ]*(W)\\)?" 1 2 3 (4))
- (cucumber
- "\\(?:^cucumber\\(?: -p [^[:space:]]+\\)?\\|#\\)\
-\\(?: \\)\\([^(].*\\):\\([1-9][0-9]*\\)" 1 2)
-
(msft
;; Must be before edg-1, so that MSVC's longer messages are
;; considered before EDG.
@@ -245,11 +241,20 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
;; GradleStyleMessagerRenderer.kt in kotlin sources, see
;; https://youtrack.jetbrains.com/issue/KT-34683).
(gradle-kotlin
- ,(concat
- "^\\(?:\\(w\\)\\|.\\): *" ;type
- "\\(\\(?:[A-Za-z]:\\)?[^:\n]+\\): *" ;file
- "(\\([0-9]+\\), *\\([0-9]+\\))") ;line, column
- 2 3 4 (1))
+ ,(rx bol
+ (| (group "w") ; 1: warning
+ (group (in "iv")) ; 2: info
+ "e") ; error
+ ": "
+ (group ; 3: file
+ (? (in "A-Za-z") ":")
+ (+ (not (in "\n:"))))
+ ": ("
+ (group (+ digit)) ; 4: line
+ ", "
+ (group (+ digit)) ; 5: column
+ "): ")
+ 3 4 5 (1 . 2))
(iar
"^\"\\(.*\\)\",\\([0-9]+\\)\\s-+\\(?:Error\\|Warnin\\(g\\)\\)\\[[0-9]+\\]:"
@@ -268,17 +273,20 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
"^\\(?:[ \t]+at \\|==[0-9]+== +\\(?:at\\|b\\(y\\)\\)\\).+(\\([^()\n]+\\):\\([0-9]+\\))$" 2 3 nil (1))
(javac
- ,(concat
- ;; line1
- "^\\(\\(?:[A-Za-z]:\\)?[^:\n]+\\):" ;file
- "\\([0-9]+\\): " ;line
- "\\(warning: \\)?.*\n" ;type (optional) and message
- ;; line2: source line containing error
- ".*\n"
- ;; line3: single "^" under error position in line2
- " *\\^$")
+ ,(rx bol
+ (group ; file
+ (? (in "A-Za-z") ":")
+ (+ (not (in "\n:"))))
+ ":"
+ (group (+ (in "0-9"))) ; line number
+ ": "
+ (? (group "warning: ")) ; type (optional)
+ (* nonl) "\n" ; message
+ (* nonl) "\n" ; source line containing error
+ (* " ") "^" ; caret line; ^ marks error
+ eol)
1 2
- ,(lambda () (1- (current-column)))
+ ,#'current-column
(3))
(jikes-file
@@ -331,48 +339,44 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
": \\*\\*\\* \\[\\(\\(.+?\\):\\([0-9]+\\): .+\\)\\]" 2 3 nil 0 1)
(gnu
- ;; The first line matches the program name for
-
- ;; PROGRAM:SOURCE-FILE-NAME:LINENO: MESSAGE
-
- ;; format, which is used for non-interactive programs other than
- ;; compilers (e.g. the "jade:" entry in compilation.txt).
-
- ;; This first line makes things ambiguous with output such as
- ;; "foo:344:50:blabla" since the "foo" part can match this first
- ;; line (in which case the file name as "344"). To avoid this,
- ;; the second line disallows filenames exclusively composed of
- ;; digits.
-
- ;; Similarly, we get lots of false positives with messages including
- ;; times of the form "HH:MM:SS" where MM is taken as a line number, so
- ;; the last line tries to rule out message where the info after the
- ;; line number starts with "SS". --Stef
-
- ;; The core of the regexp is the one with *?. It says that a file name
- ;; can be composed of any non-newline char, but it also rules out some
- ;; valid but unlikely cases, such as a trailing space or a space
- ;; followed by a -, or a colon followed by a space.
- ;;
- ;; The "in \\|from " exception was added to handle messages from Ruby.
,(rx
bol
+ ;; Match an optional program name in the format
+ ;; PROGRAM:SOURCE-FILE-NAME:LINENO: MESSAGE
+ ;; which is used for non-interactive programs other than
+ ;; compilers (e.g. the "jade:" entry in compilation.txt).
(? (| (regexp "[[:alpha:]][-[:alnum:].]+: ?")
+ ;; FIXME: This pattern was added for handling messages
+ ;; from Ruby, but it is unclear whether it is actually
+ ;; used since the gcc-include rule above seems to cover
+ ;; it.
(regexp "[ \t]+\\(?:in \\|from\\)")))
- (group-n 1 (: (regexp "[0-9]*[^0-9\n]")
- (*? (| (regexp "[^\n :]")
- (regexp " [^-/\n]")
- (regexp ":[^ \n]")))))
+
+ ;; File name group.
+ (group-n 1
+ ;; Avoid matching the file name as a program in the pattern
+ ;; above by disallow file names entirely composed of digits.
+ (: (regexp "[0-9]*[^0-9\n]")
+ ;; This rule says that a file name can be composed
+ ;; of any non-newline char, but it also rules out
+ ;; some valid but unlikely cases, such as a
+ ;; trailing space or a space followed by a -, or a
+ ;; colon followed by a space.
+ (*? (| (regexp "[^\n :]")
+ (regexp " [^-/\n]")
+ (regexp ":[^ \n]")))))
(regexp ": ?")
+
+ ;; Line number group.
(group-n 2 (regexp "[0-9]+"))
(? (| (: "-"
- (group-n 4 (regexp "[0-9]+"))
- (? "." (group-n 5 (regexp "[0-9]+"))))
+ (group-n 4 (regexp "[0-9]+")) ; ending line
+ (? "." (group-n 5 (regexp "[0-9]+")))) ; ending column
(: (in ".:")
- (group-n 3 (regexp "[0-9]+"))
+ (group-n 3 (regexp "[0-9]+")) ; starting column
(? "-"
- (? (group-n 4 (regexp "[0-9]+")) ".")
- (group-n 5 (regexp "[0-9]+"))))))
+ (? (group-n 4 (regexp "[0-9]+")) ".") ; ending line
+ (group-n 5 (regexp "[0-9]+")))))) ; ending column
":"
(| (: (* " ")
(group-n 6 (| "FutureWarning"
@@ -389,12 +393,28 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
(regexp "[Nn]ote"))))
(: (* " ")
(regexp "[Ee]rror"))
+
+ ;; Avoid matching time stamps on the form "HH:MM:SS" where
+ ;; MM is interpreted as a line number by trying to rule out
+ ;; messages where the text after the line number starts with
+ ;; a 2-digit number.
(: (regexp "[0-9]?")
(| (regexp "[^0-9\n]")
eol))
(regexp "[0-9][0-9][0-9]")))
1 (2 . 4) (3 . 5) (6 . 7))
+ (cucumber
+ ,(rx (| (: bol
+ (| (: "cucumber" (? " -p " (+ (not space))))
+ " "))
+ "#")
+ " "
+ (group (not "(") (* nonl)) ; file
+ ":"
+ (group (in "1-9") (* (in "0-9")))) ; line
+ 1 2)
+
(lcc
"^\\(?:E\\|\\(W\\)\\), \\([^(\n]+\\)(\\([0-9]+\\),[ \t]*\\([0-9]+\\)"
2 3 4 (1))
@@ -796,7 +816,7 @@ You might also use mode hooks to specify it in certain modes, like this:
(lambda ()
(unless (or (file-exists-p \"makefile\")
(file-exists-p \"Makefile\"))
- (set (make-local-variable \\='compile-command)
+ (setq-local compile-command
(concat \"make -k \"
(if buffer-file-name
(shell-quote-argument
@@ -1557,10 +1577,10 @@ to `compilation-error-regexp-alist' if RULES is nil."
(put-text-property
(match-beginning mn) (match-end mn)
'font-lock-face face))
- ((and (listp face)
- (eq (car face) 'face)
- (or (symbolp (cadr face))
- (stringp (cadr face))))
+ ((and (listp face)
+ (eq (car face) 'face)
+ (or (symbolp (cadr face))
+ (stringp (cadr face))))
(compilation--put-prop mn 'font-lock-face (cadr face))
(add-text-properties
(match-beginning mn) (match-end mn)
@@ -1828,14 +1848,13 @@ Returns the compilation buffer created."
;; default-directory' can't be used reliably for that because it may be
;; affected by the special handling of "cd ...;".
;; NB: must be done after (funcall mode) as that resets local variables
- (set (make-local-variable 'compilation-directory) thisdir)
- (set (make-local-variable 'compilation-environment) thisenv)
+ (setq-local compilation-directory thisdir)
+ (setq-local compilation-environment thisenv)
(if highlight-regexp
- (set (make-local-variable 'compilation-highlight-regexp)
- highlight-regexp))
+ (setq-local compilation-highlight-regexp highlight-regexp))
(if (or compilation-auto-jump-to-first-error
(eq compilation-scroll-output 'first-error))
- (set (make-local-variable 'compilation-auto-jump-to-next) t))
+ (setq-local compilation-auto-jump-to-next t))
;; Output a mode setter, for saving and later reloading this buffer.
(insert "-*- mode: " name-of-mode
"; default-directory: "
@@ -1857,13 +1876,13 @@ Returns the compilation buffer created."
(let ((process-environment
(append
compilation-environment
- (comint-term-environment)
+ (and (derived-mode-p 'comint-mode)
+ (comint-term-environment))
(list (format "INSIDE_EMACS=%s,compile" emacs-version))
(copy-sequence process-environment))))
- (set (make-local-variable 'compilation-arguments)
- (list command mode name-function highlight-regexp))
- (set (make-local-variable 'revert-buffer-function)
- 'compilation-revert-buffer)
+ (setq-local compilation-arguments
+ (list command mode name-function highlight-regexp))
+ (setq-local revert-buffer-function 'compilation-revert-buffer)
(and outwin
;; Forcing the window-start overrides the usual redisplay
;; feature of bringing point into view, so setting the
@@ -2168,20 +2187,19 @@ Runs `compilation-mode-hook' with `run-mode-hooks' (which see).
(kill-all-local-variables)
(use-local-map compilation-mode-map)
;; Let windows scroll along with the output.
- (set (make-local-variable 'window-point-insertion-type) t)
- (set (make-local-variable 'tool-bar-map) compilation-mode-tool-bar-map)
+ (setq-local window-point-insertion-type t)
+ (setq-local tool-bar-map compilation-mode-tool-bar-map)
(setq major-mode 'compilation-mode ; FIXME: Use define-derived-mode.
mode-name (or name-of-mode "Compilation"))
- (set (make-local-variable 'page-delimiter)
- compilation-page-delimiter)
- ;; (set (make-local-variable 'compilation-buffer-modtime) nil)
+ (setq-local page-delimiter compilation-page-delimiter)
+ ;; (setq-local compilation-buffer-modtime nil)
(compilation-setup)
;; Turn off deferred fontifications in the compilation buffer, if
;; the user turned them on globally. This is because idle timers
;; aren't re-run after receiving input from a subprocess, so the
;; buffer is left unfontified after the compilation exits, until
;; some other input event happens.
- (set (make-local-variable 'jit-lock-defer-time) nil)
+ (setq-local jit-lock-defer-time nil)
(setq buffer-read-only t)
(run-mode-hooks 'compilation-mode-hook))
@@ -2251,7 +2269,7 @@ Optional argument MINOR indicates this is called from
(setq-local compilation-num-errors-found 0)
(setq-local compilation-num-warnings-found 0)
(setq-local compilation-num-infos-found 0)
- (set (make-local-variable 'overlay-arrow-string) "")
+ (setq-local overlay-arrow-string "")
(setq next-error-overlay-arrow-position nil)
(add-hook 'kill-buffer-hook
(lambda () (setq next-error-overlay-arrow-position nil)) nil t)
@@ -2259,10 +2277,10 @@ Optional argument MINOR indicates this is called from
;; with the next-error function in simple.el, and it's only
;; coincidentally named similarly to compilation-next-error.
(setq next-error-function 'compilation-next-error-function)
- (set (make-local-variable 'comint-file-name-prefix)
- (or (file-remote-p default-directory) ""))
- (set (make-local-variable 'compilation-locs)
- (make-hash-table :test 'equal :weakness 'value))
+ (setq-local comint-file-name-prefix
+ (or (file-remote-p default-directory) ""))
+ (setq-local compilation-locs
+ (make-hash-table :test 'equal :weakness 'value))
;; It's generally preferable to use after-change-functions since they
;; can be subject to combine-after-change-calls, but if we do that, we risk
;; running our hook after font-lock, resulting in incorrect refontification.
@@ -2400,8 +2418,7 @@ and runs `compilation-filter-hook'."
(set-marker (process-mark proc) (point))
;; Update the number of errors in compilation-mode-line-errors
(compilation--ensure-parse (point))
- ;; (set (make-local-variable 'compilation-buffer-modtime)
- ;; (current-time))
+ ;; (setq-local compilation-buffer-modtime (current-time))
(run-hooks 'compilation-filter-hook))
(goto-char pos)
(narrow-to-region min max)
@@ -3155,9 +3172,9 @@ TRUE-DIRNAME is the `file-truename' of DIRNAME, if given."
;; Again, since this command is used in buffers that contain several
;; compilations, to set the beginning of "this compilation", it's a good
;; place to reset compilation-auto-jump-to-next.
- (set (make-local-variable 'compilation-auto-jump-to-next)
- (or compilation-auto-jump-to-first-error
- (eq compilation-scroll-output 'first-error))))
+ (setq-local compilation-auto-jump-to-next
+ (or compilation-auto-jump-to-first-error
+ (eq compilation-scroll-output 'first-error))))
(provide 'compile)
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index ebbea6bed92..d401513646f 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -1,6 +1,6 @@
;;; cperl-mode.el --- Perl code editing commands for Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1985-1987, 1991-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1987, 1991-2021 Free Software Foundation, Inc.
;; Author: Ilya Zakharevich
;; Bob Olson
@@ -54,8 +54,6 @@
;; of other details.
;; The mode information (on C-h m) provides some customization help.
-;; If you use font-lock feature of this mode, it is advisable to use
-;; either lazy-lock-mode or fast-lock-mode. I prefer lazy-lock.
;; Faces used now: three faces for first-class and second-class keywords
;; and control flow words, one for each: comments, string, labels,
@@ -234,7 +232,9 @@ Versions 5.2 ... 5.20 behaved as if this were nil."
:group 'cperl-indentation-details)
(defcustom cperl-indent-subs-specially t
- "Non-nil means indent subs that are inside other blocks (hash values, for example) relative to the beginning of the \"sub\" keyword, rather than relative to the statement that contains the declaration."
+ "If non-nil, indent subs inside other blocks relative to \"sub\" keyword.
+Otherwise, indent them relative to statement that contains the declaration.
+This applies to, for example, hash values."
:type 'boolean
:group 'cperl-indentation-details)
@@ -402,7 +402,7 @@ Font for POD headers."
:version "21.1"
:group 'cperl-faces)
-(defcustom cperl-pod-here-fontify '(featurep 'font-lock)
+(defcustom cperl-pod-here-fontify t
"Not-nil after evaluation means to highlight POD and here-docs sections."
:type 'boolean
:group 'cperl-faces)
@@ -933,19 +933,12 @@ In regular expressions (including character classes):
(defun cperl-putback-char (c) ; Emacs 19
(push c unread-command-events)) ; Avoid undefined warning
-(defvar cperl-do-not-fontify
- ;; FIXME: This is not doing what it claims!
- (if (string< emacs-version "19.30")
- 'fontified
- 'lazy-lock)
- "Text property which inhibits refontification.")
-
(defsubst cperl-put-do-not-fontify (from to &optional post)
;; If POST, do not do it with postponed fontification
(if (and post cperl-syntaxify-by-font-lock)
nil
(put-text-property (max (point-min) (1- from))
- to cperl-do-not-fontify t)))
+ to 'fontified t)))
(defcustom cperl-mode-hook nil
"Hook run by CPerl mode."
@@ -1256,11 +1249,7 @@ versions of Emacs."
["Speed" (describe-variable 'cperl-speed) t]
["Praise" (describe-variable 'cperl-praise) t]
["Faces" (describe-variable 'cperl-tips-faces) t]
- ["CPerl mode" (describe-function 'cperl-mode) t]
- ["CPerl version"
- (message "The version of master-file for this CPerl is %s-Emacs"
- cperl-version)
- t]))))
+ ["CPerl mode" (describe-function 'cperl-mode) t]))))
(error nil))
(autoload 'c-macro-expand "cmacexp"
@@ -1606,119 +1595,115 @@ or as help on variables `cperl-tips', `cperl-problems',
(if (cperl-val 'cperl-electric-keywords)
(abbrev-mode 1))
(set-syntax-table cperl-mode-syntax-table)
+ ;; Workaround for Bug#30393, needed for Emacs 26.
+ (when (< emacs-major-version 27)
+ (setq-local open-paren-in-column-0-is-defun-start nil))
;; Until Emacs is multi-threaded, we do not actually need it local:
(make-local-variable 'cperl-font-lock-multiline-start)
(make-local-variable 'cperl-font-locking)
- (set (make-local-variable 'outline-regexp) cperl-outline-regexp)
- (set (make-local-variable 'outline-level) 'cperl-outline-level)
- (set (make-local-variable 'add-log-current-defun-function)
- (lambda ()
- (save-excursion
- (if (re-search-backward "^sub[ \t]+\\([^({ \t\n]+\\)" nil t)
- (match-string-no-properties 1)))))
-
- (set (make-local-variable 'paragraph-start) (concat "^$\\|" page-delimiter))
- (set (make-local-variable 'paragraph-separate) paragraph-start)
- (set (make-local-variable 'paragraph-ignore-fill-prefix) t)
- (set (make-local-variable 'indent-line-function) #'cperl-indent-line)
- (set (make-local-variable 'require-final-newline) mode-require-final-newline)
- (set (make-local-variable 'comment-start) "# ")
- (set (make-local-variable 'comment-end) "")
- (set (make-local-variable 'comment-column) cperl-comment-column)
- (set (make-local-variable 'comment-start-skip) "#+ *")
+ (setq-local outline-regexp cperl-outline-regexp)
+ (setq-local outline-level 'cperl-outline-level)
+ (setq-local add-log-current-defun-function
+ (lambda ()
+ (save-excursion
+ (if (re-search-backward "^sub[ \t]+\\([^({ \t\n]+\\)" nil t)
+ (match-string-no-properties 1)))))
+
+ (setq-local paragraph-start (concat "^$\\|" page-delimiter))
+ (setq-local paragraph-separate paragraph-start)
+ (setq-local paragraph-ignore-fill-prefix t)
+ (setq-local indent-line-function #'cperl-indent-line)
+ (setq-local require-final-newline mode-require-final-newline)
+ (setq-local comment-start "# ")
+ (setq-local comment-end "")
+ (setq-local comment-column cperl-comment-column)
+ (setq-local comment-start-skip "#+ *")
;; "[ \t]*sub"
;; (cperl-after-sub-regexp 'named nil) ; 8=name 11=proto 14=attr-start
;; cperl-maybe-white-and-comment-rex ; 15=pre-block
- (set (make-local-variable 'defun-prompt-regexp)
- (concat "^[ \t]*\\("
- cperl-sub-regexp
- (cperl-after-sub-regexp 'named 'attr-groups)
- "\\|" ; per toke.c
- "\\(BEGIN\\|UNITCHECK\\|CHECK\\|INIT\\|END\\|AUTOLOAD\\|DESTROY\\)"
- "\\)"
- cperl-maybe-white-and-comment-rex))
- (set (make-local-variable 'comment-indent-function) #'cperl-comment-indent)
- (set (make-local-variable 'fill-paragraph-function)
- #'cperl-fill-paragraph)
- (set (make-local-variable 'parse-sexp-ignore-comments) t)
- (set (make-local-variable 'indent-region-function) #'cperl-indent-region)
+ (setq-local defun-prompt-regexp
+ (concat "^[ \t]*\\("
+ cperl-sub-regexp
+ (cperl-after-sub-regexp 'named 'attr-groups)
+ "\\|" ; per toke.c
+ "\\(BEGIN\\|UNITCHECK\\|CHECK\\|INIT\\|END\\|AUTOLOAD\\|DESTROY\\)"
+ "\\)"
+ cperl-maybe-white-and-comment-rex))
+ (setq-local comment-indent-function #'cperl-comment-indent)
+ (setq-local fill-paragraph-function #'cperl-fill-paragraph)
+ (setq-local parse-sexp-ignore-comments t)
+ (setq-local indent-region-function #'cperl-indent-region)
;;(setq auto-fill-function #'cperl-do-auto-fill) ; Need to switch on and off!
- (set (make-local-variable 'imenu-create-index-function)
- #'cperl-imenu--create-perl-index)
- (set (make-local-variable 'imenu-sort-function) nil)
- (set (make-local-variable 'vc-rcs-header) cperl-vc-rcs-header)
- (set (make-local-variable 'vc-sccs-header) cperl-vc-sccs-header)
+ (setq-local imenu-create-index-function #'cperl-imenu--create-perl-index)
+ (setq-local imenu-sort-function nil)
+ (setq-local vc-rcs-header cperl-vc-rcs-header)
+ (setq-local vc-sccs-header cperl-vc-sccs-header)
(cond ((boundp 'compilation-error-regexp-alist-alist);; xemacs 20.x
- (set (make-local-variable 'compilation-error-regexp-alist-alist)
- (cons (cons 'cperl (car cperl-compilation-error-regexp-alist))
- compilation-error-regexp-alist-alist))
+ (setq-local compilation-error-regexp-alist-alist
+ (cons (cons 'cperl (car cperl-compilation-error-regexp-alist))
+ compilation-error-regexp-alist-alist))
(if (fboundp 'compilation-build-compilation-error-regexp-alist)
(let ((f 'compilation-build-compilation-error-regexp-alist))
(funcall f))
(make-local-variable 'compilation-error-regexp-alist)
(push 'cperl compilation-error-regexp-alist)))
((boundp 'compilation-error-regexp-alist);; xemacs 19.x
- (set (make-local-variable 'compilation-error-regexp-alist)
- (append cperl-compilation-error-regexp-alist
- compilation-error-regexp-alist))))
- (set (make-local-variable 'font-lock-defaults)
- '((cperl-load-font-lock-keywords
- cperl-load-font-lock-keywords-1
- cperl-load-font-lock-keywords-2) nil nil ((?_ . "w"))))
+ (setq-local compilation-error-regexp-alist
+ (append cperl-compilation-error-regexp-alist
+ compilation-error-regexp-alist))))
+ (setq-local font-lock-defaults
+ '((cperl-load-font-lock-keywords
+ cperl-load-font-lock-keywords-1
+ cperl-load-font-lock-keywords-2)
+ nil nil ((?_ . "w"))))
;; Reset syntaxification cache.
- (set (make-local-variable 'cperl-syntax-state) nil)
+ (setq-local cperl-syntax-state nil)
(if cperl-use-syntax-table-text-property
(if (eval-when-compile (fboundp 'syntax-propertize-rules))
(progn
;; Reset syntaxification cache.
- (set (make-local-variable 'cperl-syntax-done-to) nil)
- (set (make-local-variable 'syntax-propertize-function)
- (lambda (start end)
- (goto-char start)
- ;; Even if cperl-fontify-syntaxically has already gone
- ;; beyond `start', syntax-propertize has just removed
- ;; syntax-table properties between start and end, so we have
- ;; to re-apply them.
- (setq cperl-syntax-done-to start)
- (cperl-fontify-syntaxically end))))
+ (setq-local cperl-syntax-done-to nil)
+ (setq-local syntax-propertize-function
+ (lambda (start end)
+ (goto-char start)
+ ;; Even if cperl-fontify-syntaxically has already gone
+ ;; beyond `start', syntax-propertize has just removed
+ ;; syntax-table properties between start and end, so we have
+ ;; to re-apply them.
+ (setq cperl-syntax-done-to start)
+ (cperl-fontify-syntaxically end))))
;; Do not introduce variable if not needed, we check it!
- (set (make-local-variable 'parse-sexp-lookup-properties) t)
- ;; Fix broken font-lock:
- (or (boundp 'font-lock-unfontify-region-function)
- (setq font-lock-unfontify-region-function
- #'font-lock-default-unfontify-region))
+ (setq-local parse-sexp-lookup-properties t)
;; Our: just a plug for wrong font-lock
- (set (make-local-variable 'font-lock-unfontify-region-function)
- ;; not present with old Emacs
- #'cperl-font-lock-unfontify-region-function)
+ (setq-local font-lock-unfontify-region-function
+ ;; not present with old Emacs
+ #'cperl-font-lock-unfontify-region-function)
;; Reset syntaxification cache.
- (set (make-local-variable 'cperl-syntax-done-to) nil)
- (set (make-local-variable 'font-lock-syntactic-keywords)
- (if cperl-syntaxify-by-font-lock
- '((cperl-fontify-syntaxically))
- ;; unless font-lock-syntactic-keywords, font-lock (pre-22.1)
- ;; used to ignore syntax-table text-properties. (t) is a hack
- ;; to make font-lock think that font-lock-syntactic-keywords
- ;; are defined.
- '(t)))))
+ (setq-local cperl-syntax-done-to nil)
+ (setq-local font-lock-syntactic-keywords
+ (if cperl-syntaxify-by-font-lock
+ '((cperl-fontify-syntaxically))
+ ;; unless font-lock-syntactic-keywords, font-lock (pre-22.1)
+ ;; used to ignore syntax-table text-properties. (t) is a hack
+ ;; to make font-lock think that font-lock-syntactic-keywords
+ ;; are defined.
+ '(t)))))
(setq cperl-font-lock-multiline t) ; Not localized...
- (set (make-local-variable 'font-lock-multiline) t)
- (set (make-local-variable 'font-lock-fontify-region-function)
- #'cperl-font-lock-fontify-region-function)
+ (setq-local font-lock-multiline t)
+ (setq-local font-lock-fontify-region-function
+ #'cperl-font-lock-fontify-region-function)
(make-local-variable 'cperl-old-style)
- (set (make-local-variable 'normal-auto-fill-function)
- #'cperl-do-auto-fill)
+ (setq-local normal-auto-fill-function
+ #'cperl-do-auto-fill)
(if (cperl-val 'cperl-font-lock)
(progn (or cperl-faces-init (cperl-init-faces))
(font-lock-mode 1)))
- (set (make-local-variable 'facemenu-add-face-function)
- #'cperl-facemenu-add-face-function) ; XXXX What this guy is for???
+ (setq-local facemenu-add-face-function
+ #'cperl-facemenu-add-face-function) ; XXXX What this guy is for???
(and (boundp 'msb-menu-cond)
(not cperl-msb-fixed)
(cperl-msb-fix))
- (if (fboundp 'easy-menu-add)
- (easy-menu-add cperl-menu)) ; A NOP in Emacs.
(if cperl-hook-after-change
(add-hook 'after-change-functions #'cperl-after-change-function nil t))
;; After hooks since fontification will break this
@@ -3438,8 +3423,8 @@ Should be called with the point before leading colon of an attribute."
(match-beginning 4) (match-end 4)
'face dashface))
;; save match data (for looking-at)
- (setq lll (mapcar (function (lambda (elt) (cons (match-beginning elt)
- (match-end elt))))
+ (setq lll (mapcar (lambda (elt) (cons (match-beginning elt)
+ (match-end elt)))
l))
(while lll
(setq ll (car lll))
@@ -3490,49 +3475,18 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
(font-lock-string-face (if (boundp 'font-lock-string-face)
font-lock-string-face
'font-lock-string-face))
- (my-cperl-delimiters-face (if (boundp 'font-lock-constant-face)
- font-lock-constant-face
- 'font-lock-constant-face))
+ (my-cperl-delimiters-face
+ font-lock-constant-face)
(my-cperl-REx-spec-char-face ; [] ^.$ and wrapper-of ({})
- (if (boundp 'font-lock-function-name-face)
- font-lock-function-name-face
- 'font-lock-function-name-face))
- (font-lock-variable-name-face ; interpolated vars and ({})-code
- (if (boundp 'font-lock-variable-name-face)
- font-lock-variable-name-face
- 'font-lock-variable-name-face))
- (font-lock-function-name-face ; used in `cperl-find-sub-attrs'
- (if (boundp 'font-lock-function-name-face)
- font-lock-function-name-face
- 'font-lock-function-name-face))
- (font-lock-constant-face ; used in `cperl-find-sub-attrs'
- (if (boundp 'font-lock-constant-face)
- font-lock-constant-face
- 'font-lock-constant-face))
+ font-lock-function-name-face)
(my-cperl-REx-0length-face ; 0-length, (?:)etc, non-literal \
- (if (boundp 'font-lock-builtin-face)
- font-lock-builtin-face
- 'font-lock-builtin-face))
- (font-lock-comment-face
- (if (boundp 'font-lock-comment-face)
- font-lock-comment-face
- 'font-lock-comment-face))
- (font-lock-warning-face
- (if (boundp 'font-lock-warning-face)
- font-lock-warning-face
- 'font-lock-warning-face))
+ font-lock-builtin-face)
(my-cperl-REx-ctl-face ; (|)
- (if (boundp 'font-lock-keyword-face)
- font-lock-keyword-face
- 'font-lock-keyword-face))
+ font-lock-keyword-face)
(my-cperl-REx-modifiers-face ; //gims
- (if (boundp 'cperl-nonoverridable-face)
- cperl-nonoverridable-face
- 'cperl-nonoverridable-face))
+ 'cperl-nonoverridable-face)
(my-cperl-REx-length1-face ; length=1 escaped chars, POSIX classes
- (if (boundp 'font-lock-type-face)
- font-lock-type-face
- 'font-lock-type-face))
+ font-lock-type-face)
(stop-point (if ignore-max
(point-max)
max))
@@ -3742,13 +3696,14 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
;; ;; "\\([^= \t0-9$@%&]\\|[ \t]+[^ \t\n0-9$@%&]\\)" ; 6 + 1
;; "\\(\\)" ; To preserve count of pars :-( 6 + 1
;; "\\)"
- ((match-beginning 3) ; 2 + 1
+ ((match-beginning 3) ; 2 + 1: found "<<", detect its type
(setq b (point)
tb (match-beginning 0)
c (and ; not HERE-DOC
(match-beginning 6)
(save-match-data
(or (looking-at "[ \t]*(") ; << function_call()
+ (looking-at ">>") ; <<>> operator
(save-excursion ; 1 << func_name, or $foo << 10
(condition-case nil
(progn
@@ -3956,7 +3911,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
(not (memq (preceding-char)
'(?$ ?@ ?& ?%)))
(looking-at
- "\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\|print\\|say\\)\\>")))))
+ "\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\|print\\|say\\|return\\)\\>")))))
(and (eq (preceding-char) ?.)
(eq (char-after (- (point) 2)) ?.))
(bobp))
@@ -5439,11 +5394,10 @@ indentation and initial hashes. Behaves usually outside of comment."
(cperl-init-faces))))
((not cperl-faces-init)
(add-hook 'font-lock-mode-hook
- (function
- (lambda ()
- (if (memq major-mode '(perl-mode cperl-mode))
- (progn
- (or cperl-faces-init (cperl-init-faces)))))))
+ (lambda ()
+ (if (memq major-mode '(perl-mode cperl-mode))
+ (progn
+ (or cperl-faces-init (cperl-init-faces))))))
(eval-after-load
"ps-print"
'(or cperl-faces-init (cperl-init-faces))))))
@@ -5470,7 +5424,6 @@ indentation and initial hashes. Behaves usually outside of comment."
(defun cperl-init-faces ()
(condition-case errs
(progn
- (require 'font-lock)
(let (t-font-lock-keywords t-font-lock-keywords-1 font-lock-anchored)
(setq font-lock-anchored t)
(setq
@@ -5713,7 +5666,7 @@ indentation and initial hashes. Behaves usually outside of comment."
'cperl-hash-face
'cperl-array-face)
nil) ; arrays and hashes
- ("\\(\\([$@]+\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)[ \t]*\\([[{]\\)"
+ ("\\(\\([$@%]+\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)[ \t]*\\([[{]\\)"
1
(if (= (- (match-end 2) (match-beginning 2)) 1)
(if (eq (char-after (match-beginning 3)) ?{)
@@ -5980,6 +5933,7 @@ else
(cperl-continued-brace-offset . 0)
(cperl-label-offset . -2)
(cperl-continued-statement-offset . 4)
+ (cperl-close-paren-offset . -4)
(cperl-extra-newline-before-brace . nil)
(cperl-extra-newline-before-brace-multiline . nil)
(cperl-merge-trailing-else . nil)
@@ -6069,9 +6023,8 @@ side-effect of memorizing only. Examples in `cperl-style-examples'."
(list (completing-read "Enter style: " cperl-style-alist nil 'insist)))
(or cperl-old-style
(setq cperl-old-style
- (mapcar (function
- (lambda (name)
- (cons name (eval name))))
+ (mapcar (lambda (name)
+ (cons name (eval name)))
cperl-styles-entries)))
(let ((style (cdr (assoc style cperl-style-alist))) setting)
(while style
@@ -6121,7 +6074,7 @@ side-effect of memorizing only. Examples in `cperl-style-examples'."
(set-buffer "*info-perl-tmp*")
(rename-buffer "*info*")
(set-buffer bname)))
- (set (make-local-variable 'window-min-height) 2)
+ (setq-local window-min-height 2)
(current-buffer)))))
(defun cperl-word-at-point (&optional p)
@@ -6439,7 +6392,7 @@ by CPerl."
(if cperl-use-syntax-table-text-property-for-tags
(progn
;; Do not introduce variable if not needed, we check it!
- (set (make-local-variable 'parse-sexp-lookup-properties) t))))
+ (setq-local parse-sexp-lookup-properties t))))
;; Copied from imenu-example--name-and-position.
(defvar imenu-use-markers)
@@ -6523,22 +6476,21 @@ Does not move point."
(setq lst (cdr (assoc "+Unsorted List+..." ind))))
(setq lst
(mapcar
- (function
- (lambda (elt)
- (cond ((string-match "^[_a-zA-Z]" (car elt))
- (goto-char (cdr elt))
- (beginning-of-line) ; pos should be of the start of the line
- (list (car elt)
- (point)
- (1+ (count-lines 1 (point))) ; 1+ since at beg-o-l
- (buffer-substring (progn
- (goto-char (cdr elt))
- ;; After name now...
- (or (eolp) (forward-char 1))
- (point))
- (progn
- (beginning-of-line)
- (point))))))))
+ (lambda (elt)
+ (cond ((string-match "^[_a-zA-Z]" (car elt))
+ (goto-char (cdr elt))
+ (beginning-of-line) ; pos should be of the start of the line
+ (list (car elt)
+ (point)
+ (1+ (count-lines 1 (point))) ; 1+ since at beg-o-l
+ (buffer-substring (progn
+ (goto-char (cdr elt))
+ ;; After name now...
+ (or (eolp) (forward-char 1))
+ (point))
+ (progn
+ (beginning-of-line)
+ (point)))))))
lst))
(erase-buffer)
(while lst
@@ -6581,7 +6533,7 @@ Does not move point."
(defun cperl-add-tags-recurse-noxs ()
"Add to TAGS data for \"pure\" Perl files in the current directory and kids.
Use as
- emacs -batch -q -no-site-file -l emacs/cperl-mode.el \
+ emacs -batch -q -no-site-file -l emacs/cperl-mode.el \\
-f cperl-add-tags-recurse-noxs
"
(cperl-write-tags nil nil t t nil t))
@@ -6590,7 +6542,7 @@ Use as
"Add to TAGS data for \"pure\" Perl in the current directory and kids.
Writes down fullpath, so TAGS is relocatable (but if the build directory
is relocated, the file TAGS inside it breaks). Use as
- emacs -batch -q -no-site-file -l emacs/cperl-mode.el \
+ emacs -batch -q -no-site-file -l emacs/cperl-mode.el \\
-f cperl-add-tags-recurse-noxs-fullpath
"
(cperl-write-tags nil nil t t nil t ""))
@@ -6598,11 +6550,14 @@ is relocated, the file TAGS inside it breaks). Use as
(defun cperl-add-tags-recurse ()
"Add to TAGS file data for Perl files in the current directory and kids.
Use as
- emacs -batch -q -no-site-file -l emacs/cperl-mode.el \
+ emacs -batch -q -no-site-file -l emacs/cperl-mode.el \\
-f cperl-add-tags-recurse
"
(cperl-write-tags nil nil t t))
+(defvar cperl-tags-file-name "TAGS"
+ "TAGS file name to use in `cperl-write-tags'.")
+
(defun cperl-write-tags (&optional file erase recurse dir inbuffer noxs topdir)
;; If INBUFFER, do not select buffer, and do not save
;; If ERASE is `ignore', do not erase, and do not try to delete old info.
@@ -6612,7 +6567,7 @@ Use as
(if (and (not dir) (buffer-modified-p)) (error "Save buffer first!")))
(or topdir
(setq topdir default-directory))
- (let ((tags-file-name "TAGS")
+ (let ((tags-file-name cperl-tags-file-name)
(inhibit-read-only t)
(case-fold-search nil)
xs rel)
@@ -6641,16 +6596,15 @@ Use as
(setq cperl-unreadable-ok t)
nil) ; Return empty list
(error "Aborting: unreadable directory %s" file)))))))
- (mapc (function
- (lambda (file)
- (cond
- ((string-match cperl-noscan-files-regexp file)
- nil)
- ((not (file-directory-p file))
- (if (string-match cperl-scan-files-regexp file)
- (cperl-write-tags file erase recurse nil t noxs topdir)))
- ((not recurse) nil)
- (t (cperl-write-tags file erase recurse t t noxs topdir)))))
+ (mapc (lambda (file)
+ (cond
+ ((string-match cperl-noscan-files-regexp file)
+ nil)
+ ((not (file-directory-p file))
+ (if (string-match cperl-scan-files-regexp file)
+ (cperl-write-tags file erase recurse nil t noxs topdir)))
+ ((not recurse) nil)
+ (t (cperl-write-tags file erase recurse t t noxs topdir))))
files)))
(t
(setq xs (string-match "\\.xs$" file))
@@ -6754,21 +6708,20 @@ One may build such TAGS files from CPerl mode menu."
(require 'etags)
(require 'imenu)
(if (or update (null (nth 2 cperl-hierarchy)))
- (let ((remover (function (lambda (elt) ; (name (file1...) (file2..))
- (or (nthcdr 2 elt)
- ;; Only in one file
- (setcdr elt (cdr (nth 1 elt)))))))
+ (let ((remover (lambda (elt) ; (name (file1...) (file2..))
+ (or (nthcdr 2 elt)
+ ;; Only in one file
+ (setcdr elt (cdr (nth 1 elt))))))
to l1 l2 l3)
;; (setq cperl-hierarchy '(() () ())) ; Would write into '() later!
(setq cperl-hierarchy (list l1 l2 l3))
(or tags-table-list
(call-interactively 'visit-tags-table))
(mapc
- (function
- (lambda (tagsfile)
- (message "Updating list of classes... %s" tagsfile)
- (set-buffer (get-file-buffer tagsfile))
- (cperl-tags-hier-fill)))
+ (lambda (tagsfile)
+ (message "Updating list of classes... %s" tagsfile)
+ (set-buffer (get-file-buffer tagsfile))
+ (cperl-tags-hier-fill))
tags-table-list)
(message "Updating list of classes... postprocessing...")
(mapc remover (car cperl-hierarchy))
@@ -6812,24 +6765,23 @@ One may build such TAGS files from CPerl mode menu."
l1 head cons1 cons2 ord writeto recurse
root-packages root-functions
(move-deeper
- (function
- (lambda (elt)
- (cond ((and (string-match regexp (car elt))
- (or (eq ord 1) (match-end 2)))
- (setq head (substring (car elt) 0 (match-end 1))
- recurse t)
- (if (setq cons1 (assoc head writeto)) nil
- ;; Need to init new head
- (setcdr writeto (cons (list head (list "Packages: ")
- (list "Methods: "))
- (cdr writeto)))
- (setq cons1 (nth 1 writeto)))
- (setq cons2 (nth ord cons1)) ; Either packs or meths
- (setcdr cons2 (cons elt (cdr cons2))))
- ((eq ord 2)
- (setq root-functions (cons elt root-functions)))
- (t
- (setq root-packages (cons elt root-packages))))))))
+ (lambda (elt)
+ (cond ((and (string-match regexp (car elt))
+ (or (eq ord 1) (match-end 2)))
+ (setq head (substring (car elt) 0 (match-end 1))
+ recurse t)
+ (if (setq cons1 (assoc head writeto)) nil
+ ;; Need to init new head
+ (setcdr writeto (cons (list head (list "Packages: ")
+ (list "Methods: "))
+ (cdr writeto)))
+ (setq cons1 (nth 1 writeto)))
+ (setq cons2 (nth ord cons1)) ; Either packs or meths
+ (setcdr cons2 (cons elt (cdr cons2))))
+ ((eq ord 2)
+ (setq root-functions (cons elt root-functions)))
+ (t
+ (setq root-packages (cons elt root-packages)))))))
(setcdr to l1) ; Init to dynamic space
(setq writeto to)
(setq ord 1)
@@ -6837,33 +6789,33 @@ One may build such TAGS files from CPerl mode menu."
(setq ord 2)
(mapc move-deeper methods)
(if recurse
- (mapc (function (lambda (elt)
- (cperl-tags-treeify elt (1+ level))))
+ (mapc (lambda (elt)
+ (cperl-tags-treeify elt (1+ level)))
(cdr to)))
;;Now clean up leaders with one child only
- (mapc (function (lambda (elt)
- (if (not (and (listp (cdr elt))
- (eq (length elt) 2)))
- nil
- (setcar elt (car (nth 1 elt)))
- (setcdr elt (cdr (nth 1 elt))))))
+ (mapc (lambda (elt)
+ (if (not (and (listp (cdr elt))
+ (eq (length elt) 2)))
+ nil
+ (setcar elt (car (nth 1 elt)))
+ (setcdr elt (cdr (nth 1 elt)))))
(cdr to))
;; Sort the roots of subtrees
(if (default-value 'imenu-sort-function)
(setcdr to
(sort (cdr to) (default-value 'imenu-sort-function))))
;; Now add back functions removed from display
- (mapc (function (lambda (elt)
- (setcdr to (cons elt (cdr to)))))
+ (mapc (lambda (elt)
+ (setcdr to (cons elt (cdr to))))
(if (default-value 'imenu-sort-function)
(nreverse
(sort root-functions (default-value 'imenu-sort-function)))
root-functions))
;; Now add back packages removed from display
- (mapc (function (lambda (elt)
- (setcdr to (cons (cons (concat "package " (car elt))
- (cdr elt))
- (cdr to)))))
+ (mapc (lambda (elt)
+ (setcdr to (cons (cons (concat "package " (car elt))
+ (cdr elt))
+ (cdr to))))
(if (default-value 'imenu-sort-function)
(nreverse
(sort root-packages (default-value 'imenu-sort-function)))
@@ -6899,16 +6851,15 @@ One may build such TAGS files from CPerl mode menu."
(let (list)
(cons 'keymap
(mapcar
- (function
- (lambda (elt)
- (cond ((listp (cdr elt))
- (setq list (cperl-list-fold
- (cdr elt) (car elt) imenu-max-items))
- (cons nil
- (cons (car elt)
- (cperl-menu-to-keymap list))))
- (t
- (list (cdr elt) (car elt) t))))) ; t is needed in 19.34
+ (lambda (elt)
+ (cond ((listp (cdr elt))
+ (setq list (cperl-list-fold
+ (cdr elt) (car elt) imenu-max-items))
+ (cons nil
+ (cons (car elt)
+ (cperl-menu-to-keymap list))))
+ (t
+ (list (cdr elt) (car elt) t)))) ; t is needed in 19.34
(cperl-list-fold menu "Root" imenu-max-items)))))
@@ -7312,6 +7263,7 @@ __DATA__ Ends program source.
__FILE__ Current (source) filename.
__LINE__ Current line in current source.
__PACKAGE__ Current package.
+__SUB__ Current sub.
ARGV Default multi-file input filehandle. <ARGV> is a synonym for <>.
ARGVOUT Output filehandle with -i flag.
BEGIN { ... } Immediately executed (during compilation) piece of code.
@@ -7577,14 +7529,17 @@ use PACKAGE [SYMBOL1, ...] Compile-time `require' with consequent `import'.
prototype \\&SUB Returns prototype of the function given a reference.
=head1 Top-level heading.
=head2 Second-level heading.
-=head3 Third-level heading (is there such?).
+=head3 Third-level heading.
+=head4 Fourth-level heading.
=over [ NUMBER ] Start list.
=item [ TITLE ] Start new item in the list.
=back End list.
=cut Switch from POD to Perl.
=pod Switch from Perl to POD.
-=begin Switch from Perl6 to POD.
-=end Switch from POD to Perl6.
+=begin formatname Start directly formatted region.
+=end formatname End directly formatted region.
+=for formatname text Paragraph in special format.
+=encoding encodingname Encoding of the document.
")
(defun cperl-switch-to-doc-buffer (&optional interactive)
@@ -8160,7 +8115,7 @@ the appropriate statement modifier."
(defun cperl-pod2man-build-command ()
"Builds the entire background manpage and cleaning command."
- (let ((command (concat pod2man-program " %s 2>/dev/null"))
+ (let ((command (concat pod2man-program " %s 2>" null-device))
(flist (and (boundp 'Man-filter-list) Man-filter-list)))
(while (and flist (car flist))
(let ((pcom (car (car flist)))
@@ -8207,11 +8162,11 @@ a result of qr//, this is not a performance hit), t for the rest."
(and (eq (get-text-property beg 'syntax-type) 'string)
(setq beg (next-single-property-change beg 'syntax-type nil limit)))
(cperl-map-pods-heres
- (function (lambda (s _e _p)
- (if (memq (get-text-property s 'REx-interpolated) skip)
- t
- (setq pp s)
- nil))) ; nil stops
+ (lambda (s _e _p)
+ (if (memq (get-text-property s 'REx-interpolated) skip)
+ t
+ (setq pp s)
+ nil)) ; nil stops
'REx-interpolated beg limit)
(if pp (goto-char pp)
(message "No more interpolated REx"))))
@@ -8235,15 +8190,14 @@ If a region is highlighted, restricts to the region."
end (max (mark) (point)))
(setq beg (point-min)
end (point-max)))
- (cperl-map-pods-heres (function
- (lambda (s e _p)
- (if do-heres
- (setq e (save-excursion
- (goto-char e)
- (forward-line -1)
- (point))))
- (ispell-region s e)
- t))
+ (cperl-map-pods-heres (lambda (s e _p)
+ (if do-heres
+ (setq e (save-excursion
+ (goto-char e)
+ (forward-line -1)
+ (point))))
+ (ispell-region s e)
+ t)
(if do-heres 'here-doc-group 'in-pod)
beg end))))
@@ -8330,7 +8284,7 @@ start with default arguments, then refine the slowdown regions."
(or l (setq l 1))
(or step (setq step 500))
(or lim (setq lim 40))
- (let* ((timems (function (lambda () (car (cperl--time-convert nil 1000)))))
+ (let* ((timems (lambda () (car (cperl--time-convert nil 1000))))
(tt (funcall timems)) (c 0) delta tot)
(goto-char (point-min))
(forward-line (1- l))
@@ -8364,7 +8318,7 @@ may be used to debug problems with delayed incremental fontification."
(goto-char pos)
(normal-mode)
;; Why needed??? With older font-locks???
- (set (make-local-variable 'font-lock-cache-position) (make-marker))
+ (setq-local font-lock-cache-position (make-marker))
(while (if (> window-size 0)
(< pos (point-max))
(> pos (point-min)))
@@ -8535,6 +8489,11 @@ do extra unwind via `cperl-unwind-to-safe'."
(string-match ":\\s *\\([0-9.]+\\)" v)
(substring v (match-beginning 1) (match-end 1)))
"Version of IZ-supported CPerl package this file is based on.")
+(make-obsolete-variable 'cperl-version 'emacs-version "28.1")
+
+(defvar cperl-do-not-fontify 'fontified
+ "Text property which inhibits refontification.")
+(make-obsolete-variable 'cperl-do-not-fontify nil "28.1")
(provide 'cperl-mode)
diff --git a/lisp/progmodes/cpp.el b/lisp/progmodes/cpp.el
index 65ef83f7698..4ea1674db02 100644
--- a/lisp/progmodes/cpp.el
+++ b/lisp/progmodes/cpp.el
@@ -1,6 +1,6 @@
;;; cpp.el --- highlight or hide text according to cpp conditionals -*- lexical-binding: t -*-
-;; Copyright (C) 1994-1995, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1995, 2001-2021 Free Software Foundation, Inc.
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: c, faces, tools
diff --git a/lisp/progmodes/cwarn.el b/lisp/progmodes/cwarn.el
index 6e84f4f1bcc..042030da396 100644
--- a/lisp/progmodes/cwarn.el
+++ b/lisp/progmodes/cwarn.el
@@ -1,6 +1,6 @@
;;; cwarn.el --- highlight suspicious C and C++ constructions
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Anders Lindgren
;; Keywords: c, languages, faces
@@ -104,8 +104,6 @@
;;{{{ Dependencies
-(require 'custom)
-(require 'font-lock)
(require 'cc-mode)
;;}}}
diff --git a/lisp/progmodes/dcl-mode.el b/lisp/progmodes/dcl-mode.el
index ca45795adc0..3815b176503 100644
--- a/lisp/progmodes/dcl-mode.el
+++ b/lisp/progmodes/dcl-mode.el
@@ -1,6 +1,6 @@
;;; dcl-mode.el --- major mode for editing DCL command files
-;; Copyright (C) 1997, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
;; Author: Odd Gripenstam <gripenstamol@decus.se>
;; Maintainer: emacs-devel@gnu.org
@@ -588,17 +588,17 @@ $
There is some minimal font-lock support (see vars
`dcl-font-lock-defaults' and `dcl-font-lock-keywords')."
- (set (make-local-variable 'indent-line-function) 'dcl-indent-line)
- (set (make-local-variable 'comment-start) "!")
- (set (make-local-variable 'comment-end) "")
- (set (make-local-variable 'comment-multi-line) nil)
+ (setq-local indent-line-function 'dcl-indent-line)
+ (setq-local comment-start "!")
+ (setq-local comment-end "")
+ (setq-local comment-multi-line nil)
;; This used to be "^\\$[ \t]*![ \t]*" which looks more correct.
;; The drawback was that you couldn't make empty comment lines by pressing
;; C-M-j repeatedly - only the first line became a comment line.
;; This version has the drawback that the "$" can be anywhere in the line,
;; and something inappropriate might be interpreted as a comment.
- (set (make-local-variable 'comment-start-skip) "\\$[ \t]*![ \t]*")
+ (setq-local comment-start-skip "\\$[ \t]*![ \t]*")
(if (boundp 'imenu-generic-expression)
(progn (setq imenu-generic-expression dcl-imenu-generic-expression)
@@ -619,7 +619,7 @@ There is some minimal font-lock support (see vars
(make-local-variable 'dcl-electric-reindent-regexps)
;; font lock
- (set (make-local-variable 'font-lock-defaults) dcl-font-lock-defaults)
+ (setq-local font-lock-defaults dcl-font-lock-defaults)
(tempo-use-tag-list 'dcl-tempo-tags))
diff --git a/lisp/progmodes/ebnf-abn.el b/lisp/progmodes/ebnf-abn.el
index be82c72910b..9e570b6c03f 100644
--- a/lisp/progmodes/ebnf-abn.el
+++ b/lisp/progmodes/ebnf-abn.el
@@ -1,6 +1,6 @@
;;; ebnf-abn.el --- parser for ABNF (Augmented BNF)
-;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Keywords: wp, ebnf, PostScript
diff --git a/lisp/progmodes/ebnf-bnf.el b/lisp/progmodes/ebnf-bnf.el
index 4e11862c1dc..93ebfe8654d 100644
--- a/lisp/progmodes/ebnf-bnf.el
+++ b/lisp/progmodes/ebnf-bnf.el
@@ -1,6 +1,6 @@
;;; ebnf-bnf.el --- parser for EBNF
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Keywords: wp, ebnf, PostScript
diff --git a/lisp/progmodes/ebnf-dtd.el b/lisp/progmodes/ebnf-dtd.el
index ddddb27a11c..66e5dd095ea 100644
--- a/lisp/progmodes/ebnf-dtd.el
+++ b/lisp/progmodes/ebnf-dtd.el
@@ -1,6 +1,6 @@
;;; ebnf-dtd.el --- parser for DTD (Data Type Description for XML)
-;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Keywords: wp, ebnf, PostScript
diff --git a/lisp/progmodes/ebnf-ebx.el b/lisp/progmodes/ebnf-ebx.el
index 546f1f8a87f..389049e39a9 100644
--- a/lisp/progmodes/ebnf-ebx.el
+++ b/lisp/progmodes/ebnf-ebx.el
@@ -1,6 +1,6 @@
;;; ebnf-ebx.el --- parser for EBNF used to specify XML (EBNFX)
-;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Keywords: wp, ebnf, PostScript
diff --git a/lisp/progmodes/ebnf-iso.el b/lisp/progmodes/ebnf-iso.el
index 466e7785053..d25ff3ecb4b 100644
--- a/lisp/progmodes/ebnf-iso.el
+++ b/lisp/progmodes/ebnf-iso.el
@@ -1,6 +1,6 @@
;;; ebnf-iso.el --- parser for ISO EBNF
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Keywords: wp, ebnf, PostScript
diff --git a/lisp/progmodes/ebnf-otz.el b/lisp/progmodes/ebnf-otz.el
index a5105746284..b724d75a7e5 100644
--- a/lisp/progmodes/ebnf-otz.el
+++ b/lisp/progmodes/ebnf-otz.el
@@ -1,6 +1,6 @@
;;; ebnf-otz.el --- syntactic chart OpTimiZer
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Keywords: wp, ebnf, PostScript
diff --git a/lisp/progmodes/ebnf-yac.el b/lisp/progmodes/ebnf-yac.el
index a657c637f82..2765d03acba 100644
--- a/lisp/progmodes/ebnf-yac.el
+++ b/lisp/progmodes/ebnf-yac.el
@@ -1,6 +1,6 @@
;;; ebnf-yac.el --- parser for Yacc/Bison
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Keywords: wp, ebnf, PostScript
diff --git a/lisp/progmodes/ebnf2ps.el b/lisp/progmodes/ebnf2ps.el
index 991cd6fc519..6f9509d152b 100644
--- a/lisp/progmodes/ebnf2ps.el
+++ b/lisp/progmodes/ebnf2ps.el
@@ -1,6 +1,6 @@
;;; ebnf2ps.el --- translate an EBNF to a syntactic chart on PostScript -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Keywords: wp, ebnf, PostScript
diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el
index ffd7d03d7a9..a174d4851e5 100644
--- a/lisp/progmodes/ebrowse.el
+++ b/lisp/progmodes/ebrowse.el
@@ -1,6 +1,6 @@
;;; ebrowse.el --- Emacs C++ class browser & tags facility -*- lexical-binding:t -*-
-;; Copyright (C) 1992-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1992-2021 Free Software Foundation, Inc.
;; Author: Gerd Moellmann <gerd@gnu.org>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index ce2b924d514..9348a7f0d2f 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -1,6 +1,6 @@
;;; elisp-mode.el --- Emacs Lisp mode -*- lexical-binding:t -*-
-;; Copyright (C) 1985-1986, 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1986, 1999-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: lisp, languages
@@ -38,9 +38,10 @@ It has `lisp-mode-abbrev-table' as its parent."
:parents (list lisp-mode-abbrev-table))
(defvar emacs-lisp-mode-syntax-table
- (let ((table (make-syntax-table lisp--mode-syntax-table)))
- (modify-syntax-entry ?\[ "(] " table)
- (modify-syntax-entry ?\] ")[ " table)
+ (let ((table (make-syntax-table lisp-data-mode-syntax-table)))
+ ;; These are redundant, now.
+ ;;(modify-syntax-entry ?\[ "(] " table)
+ ;;(modify-syntax-entry ?\] ")[ " table)
table)
"Syntax table used in `emacs-lisp-mode'.")
@@ -681,7 +682,7 @@ otherwise build the summary from TYPE and SYMBOL."
(xref-make-elisp-location symbol type file)))
(defvar elisp-xref-find-def-functions nil
- "List of functions to be run from `elisp--xref-find-definitions' to add additional xrefs.
+ "List of functions run from `elisp--xref-find-definitions' to add more xrefs.
Called with one arg; the symbol whose definition is desired.
Each function should return a list of xrefs, or nil; the first
non-nil result supersedes the xrefs produced by
@@ -1416,12 +1417,13 @@ which see."
(defun elisp--documentation-one-liner ()
(let* (str
(callback (lambda (doc &rest plist)
- (setq str
- (format "%s: %s"
- (propertize (prin1-to-string
- (plist-get plist :thing))
- 'face (plist-get plist :face))
- doc)))))
+ (when doc
+ (setq str
+ (format "%s: %s"
+ (propertize (prin1-to-string
+ (plist-get plist :thing))
+ 'face (plist-get plist :face))
+ doc))))))
(or (progn (elisp-eldoc-var-docstring callback) str)
(progn (elisp-eldoc-funcall callback) str))))
@@ -1718,7 +1720,8 @@ Calls REPORT-FN directly."
collect
(flymake-make-diagnostic
(current-buffer)
- start end :note text)))
+ (or start 1) (or end (1+ (or start 1)))
+ :note text)))
collected))
(defun elisp-flymake--byte-compile-done (report-fn
@@ -1825,12 +1828,9 @@ Runs in a batch-mode Emacs. Interactively use variable
(interactive (list buffer-file-name))
(let* ((file (or file
(car command-line-args-left)))
- (dummy-elc-file)
(byte-compile-log-buffer
(generate-new-buffer " *dummy-byte-compile-log-buffer*"))
- (byte-compile-dest-file-function
- (lambda (source)
- (setq dummy-elc-file (make-temp-file (file-name-nondirectory source)))))
+ (byte-compile-dest-file-function #'ignore)
(collected)
(byte-compile-log-warning-function
(lambda (string &optional position fill level)
@@ -1840,7 +1840,6 @@ Runs in a batch-mode Emacs. Interactively use variable
(unwind-protect
(byte-compile-file file)
(ignore-errors
- (delete-file dummy-elc-file)
(kill-buffer byte-compile-log-buffer)))
(prin1 :elisp-flymake-output-start)
(terpri)
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index 8879726ad59..869529ab2db 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -1,6 +1,6 @@
;;; etags.el --- etags facility for Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1986, 1988-1989, 1992-1996, 1998, 2000-2020 Free
+;; Copyright (C) 1985-1986, 1988-1989, 1992-1996, 1998, 2000-2021 Free
;; Software Foundation, Inc.
;; Author: Roland McGrath <roland@gnu.org>
@@ -34,7 +34,6 @@
;; prefixes but somewhere within the name.
(require 'ring)
-(require 'button)
(require 'xref)
(require 'fileloop)
@@ -259,9 +258,9 @@ One argument, the tag info returned by `snarf-tag-function'.")
Return non-nil if it is a valid tags table, and
in that case, also make the tags table state variables
buffer-local and set them to nil."
- (set (make-local-variable 'tags-table-files) nil)
- (set (make-local-variable 'tags-completion-table) nil)
- (set (make-local-variable 'tags-included-tables) nil)
+ (setq-local tags-table-files nil)
+ (setq-local tags-completion-table nil)
+ (setq-local tags-included-tables nil)
;; We used to initialize find-tag-marker-ring and tags-location-ring
;; here, to new empty rings. But that is wrong, because those
;; are global.
@@ -1235,34 +1234,29 @@ error message."
"If `etags-verify-tags-table', make buffer-local format variables.
If current buffer is a valid etags TAGS file, then give it
buffer-local values of tags table format variables."
- (and (etags-verify-tags-table)
- ;; It is annoying to flash messages on the screen briefly,
- ;; and this message is not useful. -- rms
- ;; (message "%s is an `etags' TAGS file" buffer-file-name)
- (mapc (lambda (elt) (set (make-local-variable (car elt)) (cdr elt)))
- '((file-of-tag-function . etags-file-of-tag)
- (tags-table-files-function . etags-tags-table-files)
- (tags-completion-table-function . etags-tags-completion-table)
- (snarf-tag-function . etags-snarf-tag)
- (goto-tag-location-function . etags-goto-tag-location)
- (find-tag-regexp-search-function . re-search-forward)
- (find-tag-regexp-tag-order . (tag-re-match-p))
- (find-tag-regexp-next-line-after-failure-p . t)
- (find-tag-search-function . search-forward)
- (find-tag-tag-order . (tag-exact-file-name-match-p
- tag-file-name-match-p
- tag-exact-match-p
- tag-implicit-name-match-p
- tag-symbol-match-p
- tag-word-match-p
- tag-partial-file-name-match-p
- tag-any-match-p))
- (find-tag-next-line-after-failure-p . nil)
- (list-tags-function . etags-list-tags)
- (tags-apropos-function . etags-tags-apropos)
- (tags-included-tables-function . etags-tags-included-tables)
- (verify-tags-table-function . etags-verify-tags-table)
- ))))
+ (when (etags-verify-tags-table)
+ (setq-local file-of-tag-function 'etags-file-of-tag)
+ (setq-local tags-table-files-function 'etags-tags-table-files)
+ (setq-local tags-completion-table-function 'etags-tags-completion-table)
+ (setq-local snarf-tag-function 'etags-snarf-tag)
+ (setq-local goto-tag-location-function 'etags-goto-tag-location)
+ (setq-local find-tag-regexp-search-function 're-search-forward)
+ (setq-local find-tag-regexp-tag-order '(tag-re-match-p))
+ (setq-local find-tag-regexp-next-line-after-failure-p t)
+ (setq-local find-tag-search-function 'search-forward)
+ (setq-local find-tag-tag-order '(tag-exact-file-name-match-p
+ tag-file-name-match-p
+ tag-exact-match-p
+ tag-implicit-name-match-p
+ tag-symbol-match-p
+ tag-word-match-p
+ tag-partial-file-name-match-p
+ tag-any-match-p))
+ (setq-local find-tag-next-line-after-failure-p nil)
+ (setq-local list-tags-function 'etags-list-tags)
+ (setq-local tags-apropos-function 'etags-tags-apropos)
+ (setq-local tags-included-tables-function 'etags-tags-included-tables)
+ (setq-local verify-tags-table-function 'etags-verify-tags-table)))
(defun etags-verify-tags-table ()
"Return non-nil if the current buffer is a valid etags TAGS file."
@@ -1594,16 +1588,16 @@ hits the start of file."
"Return non-nil if current buffer is empty.
If empty, make buffer-local values of the tags table format variables
that do nothing."
- (and (zerop (buffer-size))
- (mapc (lambda (sym) (set (make-local-variable sym) 'ignore))
- '(tags-table-files-function
- tags-completion-table-function
- find-tag-regexp-search-function
- find-tag-search-function
- tags-apropos-function
- tags-included-tables-function))
- (set (make-local-variable 'verify-tags-table-function)
- (lambda () (zerop (buffer-size))))))
+ (when (zerop (buffer-size))
+ (setq-local tags-table-files-function #'ignore)
+ (setq-local tags-completion-table-function #'ignore)
+ (setq-local find-tag-regexp-search-function #'ignore)
+ (setq-local find-tag-search-function #'ignore)
+ (setq-local tags-apropos-function #'ignore)
+ (setq-local tags-included-tables-function #'ignore)
+ (setq-local verify-tags-table-function
+ (lambda () (zerop (buffer-size))))))
+
;; Match qualifier functions for tagnames.
;; These functions assume the etags file format defined in etc/ETAGS.EBNF.
@@ -1820,8 +1814,8 @@ argument is passed to `next-file', which see)."
Stops when a match is found.
To continue searching for next match, use command \\[tags-loop-continue].
-If FILES if non-nil should be a list or an iterator returning the files to search.
-The search will be restricted to these files.
+If FILES if non-nil should be a list or an iterator returning the
+files to search. The search will be restricted to these files.
Also see the documentation of the `tags-file-name' variable."
(interactive "sTags search (regexp): ")
diff --git a/lisp/progmodes/executable.el b/lisp/progmodes/executable.el
index bae2bb66403..fa5724a3800 100644
--- a/lisp/progmodes/executable.el
+++ b/lisp/progmodes/executable.el
@@ -1,6 +1,6 @@
;;; executable.el --- base functionality for executable interpreter scripts
-;; Copyright (C) 1994-1996, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1996, 2000-2021 Free Software Foundation, Inc.
;; Author: Daniel Pfeiffer <occitan@esperanto.org>
;; Keywords: languages, unix
@@ -197,7 +197,7 @@ command to find the next error. The buffer is also in `comint-mode' and
buffer-file-name))))
(require 'compile)
(save-some-buffers (not compilation-ask-about-save))
- (set (make-local-variable 'executable-command) command)
+ (setq-local executable-command command)
(let ((compilation-error-regexp-alist executable-error-regexp-alist))
(compilation-start command t (lambda (_x) "*interpretation*"))))
diff --git a/lisp/progmodes/f90.el b/lisp/progmodes/f90.el
index 1fbbc892c03..2641387986d 100644
--- a/lisp/progmodes/f90.el
+++ b/lisp/progmodes/f90.el
@@ -1,6 +1,6 @@
;;; f90.el --- Fortran-90 mode (free format) -*- lexical-binding: t -*-
-;; Copyright (C) 1995-1997, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995-1997, 2000-2021 Free Software Foundation, Inc.
;; Author: Torbjörn Einarsson <Torbjorn.Einarsson@era.ericsson.se>
;; Maintainer: emacs-devel@gnu.org
@@ -1179,29 +1179,26 @@ Turning on F90 mode calls the value of the variable `f90-mode-hook'
with no args, if that value is non-nil."
:group 'f90
:abbrev-table f90-mode-abbrev-table
- (set (make-local-variable 'indent-line-function) 'f90-indent-line)
- (set (make-local-variable 'indent-region-function) 'f90-indent-region)
- (set (make-local-variable 'comment-start) "!")
- (set (make-local-variable 'comment-start-skip) "!+ *")
- (set (make-local-variable 'comment-indent-function) 'f90-comment-indent)
- (set (make-local-variable 'abbrev-all-caps) t)
- (set (make-local-variable 'normal-auto-fill-function) 'f90-do-auto-fill)
+ (setq-local indent-line-function #'f90-indent-line)
+ (setq-local indent-region-function #'f90-indent-region)
+ (setq-local comment-start "!")
+ (setq-local comment-start-skip "!+ *")
+ (setq-local comment-indent-function 'f90-comment-indent)
+ (setq-local abbrev-all-caps t)
+ (setq-local normal-auto-fill-function #'f90-do-auto-fill)
(setq indent-tabs-mode nil) ; auto buffer local
- (set (make-local-variable 'fill-paragraph-function) 'f90-fill-paragraph)
- (set (make-local-variable 'font-lock-defaults)
- '((f90-font-lock-keywords f90-font-lock-keywords-1
- f90-font-lock-keywords-2
- f90-font-lock-keywords-3
- f90-font-lock-keywords-4)
- nil t))
- (set (make-local-variable 'imenu-case-fold-search) t)
- (set (make-local-variable 'imenu-generic-expression)
- f90-imenu-generic-expression)
- (set (make-local-variable 'beginning-of-defun-function)
- 'f90-beginning-of-subprogram)
- (set (make-local-variable 'end-of-defun-function) 'f90-end-of-subprogram)
- (set (make-local-variable 'add-log-current-defun-function)
- #'f90-current-defun))
+ (setq-local fill-paragraph-function #'f90-fill-paragraph)
+ (setq-local font-lock-defaults
+ '((f90-font-lock-keywords f90-font-lock-keywords-1
+ f90-font-lock-keywords-2
+ f90-font-lock-keywords-3
+ f90-font-lock-keywords-4)
+ nil t))
+ (setq-local imenu-case-fold-search t)
+ (setq-local imenu-generic-expression f90-imenu-generic-expression)
+ (setq-local beginning-of-defun-function #'f90-beginning-of-subprogram)
+ (setq-local end-of-defun-function #'f90-end-of-subprogram)
+ (setq-local add-log-current-defun-function #'f90-current-defun))
;; Inline-functions.
diff --git a/lisp/progmodes/flymake-cc.el b/lisp/progmodes/flymake-cc.el
index d1985b4f777..bd403faf7c4 100644
--- a/lisp/progmodes/flymake-cc.el
+++ b/lisp/progmodes/flymake-cc.el
@@ -1,6 +1,6 @@
;;; flymake-cc.el --- Flymake support for GNU tools for C/C++ -*- lexical-binding: t; -*-
-;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2018-2021 Free Software Foundation, Inc.
;; Author: João Távora <joaotavora@gmail.com>
;; Keywords: languages, c
@@ -50,7 +50,7 @@ SOURCE."
;; TODO: if you can understand it, use `compilation-mode's regexps
;; or even some of its machinery here.
;;
- ;; (set (make-local-variable 'compilation-locs)
+ ;; (setq-local compilation-locs
;; (make-hash-table :test 'equal :weakness 'value))
;; (compilation-parse-errors (point-min) (point-max)
;; 'gnu 'gcc-include)
diff --git a/lisp/progmodes/flymake-proc.el b/lisp/progmodes/flymake-proc.el
index 152dc725c74..9cbad121d1f 100644
--- a/lisp/progmodes/flymake-proc.el
+++ b/lisp/progmodes/flymake-proc.el
@@ -1,6 +1,6 @@
;;; flymake-proc.el --- Flymake backend for external tools -*- lexical-binding: t; -*-
-;; Copyright (C) 2003-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
;; Author: Pavel Kobyakov <pk_at_work@yahoo.com>
;; Maintainer: João Távora <joaotavora@gmail.com>
@@ -120,8 +120,10 @@ This is an alist with elements of the form:
REGEXP INIT [CLEANUP [NAME]]
REGEXP is a regular expression that matches a file name.
INIT is the init function to use.
-CLEANUP is the cleanup function to use, default `flymake-proc-simple-cleanup'.
-NAME is the file name function to use, default `flymake-proc-get-real-file-name'."
+CLEANUP is the cleanup function to use, default
+ `flymake-proc-simple-cleanup'.
+NAME is the file name function to use, default
+ `flymake-proc-get-real-file-name'."
:group 'flymake
:type '(alist :key-type (regexp :tag "File regexp")
:value-type
@@ -429,16 +431,15 @@ instead of reading master file from disk."
(defun flymake-proc--read-file-to-temp-buffer (file-name)
"Insert contents of FILE-NAME into newly created temp buffer."
- (let* ((temp-buffer (get-buffer-create (generate-new-buffer-name (concat "flymake:" (file-name-nondirectory file-name))))))
- (with-current-buffer temp-buffer
- (insert-file-contents file-name))
- temp-buffer))
+ (with-current-buffer (generate-new-buffer
+ (concat "flymake:" (file-name-nondirectory file-name)))
+ (insert-file-contents file-name)
+ (current-buffer)))
(defun flymake-proc--copy-buffer-to-temp-buffer (buffer)
"Copy contents of BUFFER into newly created temp buffer."
- (with-current-buffer
- (get-buffer-create (generate-new-buffer-name
- (concat "flymake:" (buffer-name buffer))))
+ (with-current-buffer (generate-new-buffer
+ (concat "flymake:" (buffer-name buffer)))
(insert-buffer-substring buffer)
(current-buffer)))
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index b286208fff9..460af718aad 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -1,10 +1,10 @@
;;; flymake.el --- A universal on-the-fly syntax checker -*- lexical-binding: t; -*-
-;; Copyright (C) 2003-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
;; Author: Pavel Kobyakov <pk_at_work@yahoo.com>
;; Maintainer: João Távora <joaotavora@gmail.com>
-;; Version: 1.0.9
+;; Version: 1.1.1
;; Keywords: c languages tools
;; Package-Requires: ((emacs "26.1") (eldoc "1.1.0"))
@@ -412,44 +412,46 @@ verify FILTER, a function, and sort them by COMPARE (using KEY)."
(defun flymake-diag-region (buffer line &optional col)
"Compute BUFFER's region (BEG . END) corresponding to LINE and COL.
If COL is nil, return a region just for LINE. Return nil if the
-region is invalid."
+region is invalid. This function saves match data."
(condition-case-unless-debug _err
(with-current-buffer buffer
(let ((line (min (max line 1)
(line-number-at-pos (point-max) 'absolute))))
(save-excursion
- (goto-char (point-min))
- (forward-line (1- line))
- (cl-flet ((fallback-bol
- ()
- (back-to-indentation)
- (if (eobp)
- (line-beginning-position 0)
- (point)))
- (fallback-eol
- (beg)
- (progn
- (end-of-line)
- (skip-chars-backward " \t\f\n" beg)
- (if (eq (point) beg)
- (line-beginning-position 2)
- (point)))))
- (if (and col (cl-plusp col))
- (let* ((beg (progn (forward-char (1- col))
- (point)))
- (sexp-end (ignore-errors (end-of-thing 'sexp)))
- (end (or (and sexp-end
- (not (= sexp-end beg))
- sexp-end)
- (and (< (goto-char (1+ beg)) (point-max))
- (point)))))
- (if end
- (cons beg end)
- (cons (setq beg (fallback-bol))
- (fallback-eol beg))))
- (let* ((beg (fallback-bol))
- (end (fallback-eol beg)))
- (cons beg end)))))))
+ (save-match-data
+ (goto-char (point-min))
+ (forward-line (1- line))
+ (cl-flet ((fallback-bol
+ ()
+ (back-to-indentation)
+ (if (eobp)
+ (line-beginning-position 0)
+ (point)))
+ (fallback-eol
+ (beg)
+ (progn
+ (end-of-line)
+ (skip-chars-backward " \t\f\n" beg)
+ (if (eq (point) beg)
+ (line-beginning-position 2)
+ (point)))))
+ (if (and col (cl-plusp col))
+ (let* ((beg (progn (forward-char (1- col))
+ (point)))
+ (sexp-end (or (ignore-errors (end-of-thing 'sexp))
+ (ignore-errors (end-of-thing 'symbol))))
+ (end (or (and sexp-end
+ (not (= sexp-end beg))
+ sexp-end)
+ (and (< (goto-char (1+ beg)) (point-max))
+ (point)))))
+ (if end
+ (cons beg end)
+ (cons (setq beg (fallback-bol))
+ (fallback-eol beg))))
+ (let* ((beg (fallback-bol))
+ (end (fallback-eol beg)))
+ (cons beg end))))))))
(error (flymake-log :warning "Invalid region line=%s col=%s" line col)
nil)))
@@ -995,7 +997,7 @@ suitable for the current buffer. The commands
`flymake-running-backends', `flymake-disabled-backends' and
`flymake-reporting-backends' summarize the situation, as does the
special *Flymake log* buffer." :group 'flymake :lighter
- flymake--mode-line-format :keymap flymake-mode-map
+ flymake-mode-line-format :keymap flymake-mode-map
(cond
;; Turning the mode ON.
(flymake-mode
@@ -1184,123 +1186,144 @@ default) no filter is applied."
[ "Go to log buffer" flymake-switch-to-log-buffer t ]
[ "Turn off Flymake" flymake-mode t ]))
-(defvar flymake--mode-line-format '(:eval (flymake--mode-line-format)))
-
-(put 'flymake--mode-line-format 'risky-local-variable t)
-
-
-(defun flymake--mode-line-format ()
- "Produce a pretty minor mode indicator."
- (let* ((known (hash-table-keys flymake--backend-state))
- (running (flymake-running-backends))
- (disabled (flymake-disabled-backends))
- (reported (flymake-reporting-backends))
- (diags-by-type (make-hash-table))
- (all-disabled (and disabled (null running)))
- (some-waiting (cl-set-difference running reported)))
- (maphash (lambda (_b state)
- (mapc (lambda (diag)
- (push diag
- (gethash (flymake--diag-type diag)
- diags-by-type)))
- (flymake--backend-state-diags state)))
- flymake--backend-state)
- `((:propertize " Flymake"
- mouse-face mode-line-highlight
- help-echo
- ,(concat (format "%s known backends\n" (length known))
- (format "%s running\n" (length running))
- (format "%s disabled\n" (length disabled))
- "mouse-1: Display minor mode menu\n"
- "mouse-2: Show help for minor mode")
- keymap
- ,(let ((map (make-sparse-keymap)))
- (define-key map [mode-line down-mouse-1]
- flymake-menu)
- (define-key map [mode-line mouse-2]
- (lambda ()
- (interactive)
- (describe-function 'flymake-mode)))
- map))
- ,@(pcase-let ((`(,ind ,face ,explain)
- (cond ((null known)
- '("?" mode-line "No known backends"))
- (some-waiting
- `("Wait" compilation-mode-line-run
- ,(format "Waiting for %s running backend(s)"
- (length some-waiting))))
- (all-disabled
- '("!" compilation-mode-line-run
- "All backends disabled"))
- (t
- '(nil nil nil)))))
- (when ind
- `((":"
- (:propertize ,ind
- face ,face
- help-echo ,explain
- keymap
- ,(let ((map (make-sparse-keymap)))
+(defcustom flymake-mode-line-format
+ '(" " flymake-mode-line-title flymake-mode-line-exception
+ flymake-mode-line-counters)
+ "Mode line construct for customizing Flymake information."
+ :group 'flymake
+ :type '(repeat (choice string symbol)))
+
+(defcustom flymake-mode-line-counter-format
+ '("["
+ flymake-mode-line-error-counter
+ flymake-mode-line-warning-counter
+ flymake-mode-line-note-counter "]")
+ "Mode-line construct for formatting Flymake diagnostic counters.
+This is a suitable place for placing the `flymake-error-counter',
+`flymake-warning-counter' and `flymake-note-counter' constructs.
+Separating each of these with space is not necessary."
+ :group 'flymake
+ :type '(repeat (choice string symbol)))
+
+(defvar flymake-mode-line-title '(:eval (flymake--mode-line-title))
+ "Mode-line construct to show Flymake's mode name and menu.")
+
+(defvar flymake-mode-line-exception '(:eval (flymake--mode-line-exception))
+ "Mode-line construct to report on exceptional Flymake status.")
+
+(defvar flymake-mode-line-counters '(:eval (flymake--mode-line-counters))
+ "Mode-line construct for counting Flymake diagnostics.
+The counters are only placed if some Flymake backend initialized
+correctly.")
+
+(defvar flymake-mode-line-error-counter
+ `(:eval (flymake--mode-line-counter :error t)))
+(defvar flymake-mode-line-warning-counter
+ `(:eval (flymake--mode-line-counter :warning)))
+(defvar flymake-mode-line-note-counter
+ `(:eval (flymake--mode-line-counter :note)))
+
+(put 'flymake-mode-line-format 'risky-local-variable t)
+(put 'flymake-mode-line-title 'risky-local-variable t)
+(put 'flymake-mode-line-exception 'risky-local-variable t)
+(put 'flymake-mode-line-counters 'risky-local-variable t)
+(put 'flymake-mode-line-error-counter 'risky-local-variable t)
+(put 'flymake-mode-line-warning-counter 'risky-local-variable t)
+(put 'flymake-mode-line-note-counter 'risky-local-variable t)
+
+(defun flymake--mode-line-title ()
+ `(:propertize
+ "Flymake"
+ mouse-face mode-line-highlight
+ help-echo
+ (lambda (&rest whatever)
+ (concat
+ (format "%s known backends\n" (hash-table-count flymake--backend-state))
+ (format "%s running\n" (length (flymake-running-backends)))
+ (format "%s disabled\n" (length (flymake-disabled-backends)))
+ "mouse-1: Display minor mode menu\n"
+ "mouse-2: Show help for minor mode"))
+ keymap
+ ,(let ((map (make-sparse-keymap)))
+ (define-key map [mode-line down-mouse-1]
+ flymake-menu)
+ (define-key map [mode-line mouse-2]
+ (lambda ()
+ (interactive)
+ (describe-function 'flymake-mode)))
+ map)))
+
+(defun flymake--mode-line-exception ()
+ "Helper for `flymake-mode-line-exception'."
+ (pcase-let* ((running) (reported)
+ (`(,ind ,face ,explain)
+ (cond ((zerop (hash-table-count flymake--backend-state))
+ '("?" nil "No known backends"))
+ ((cl-set-difference
+ (setq running (flymake-running-backends))
+ (setq reported (flymake-reporting-backends)))
+ `("Wait" compilation-mode-line-run
+ ,(format "Waiting for %s running backend(s)"
+ (length (cl-set-difference running reported)))))
+ ((and (flymake-disabled-backends) (null running))
+ '("!" compilation-mode-line-run
+ "All backends disabled"))
+ (t
+ '(nil nil nil)))))
+ (when ind
+ `(":"
+ (:propertize ,ind face ,face
+ help-echo ,explain
+ keymap ,(let ((map (make-sparse-keymap)))
(define-key map [mode-line mouse-1]
'flymake-switch-to-log-buffer)
map))))))
- ,@(unless (or all-disabled
- (null known))
- (cl-loop
- with types = (hash-table-keys diags-by-type)
- with _augmented = (cl-loop for extra in '(:error :warning)
- do (cl-pushnew extra types
- :key #'flymake--severity))
- for type in (cl-sort types #'> :key #'flymake--severity)
- for diags = (gethash type diags-by-type)
- for face = (flymake--lookup-type-property type
- 'mode-line-face
- 'compilation-error)
- when (or diags
- (cond ((eq flymake-suppress-zero-counters t)
- nil)
- (flymake-suppress-zero-counters
- (>= (flymake--severity type)
- (warning-numeric-level
- flymake-suppress-zero-counters)))
- (t t)))
- collect `(:propertize
- ,(format "%d" (length diags))
- face ,face
- mouse-face mode-line-highlight
- keymap
- ,(let ((map (make-sparse-keymap))
- (type type))
- (define-key map (vector 'mode-line
- mouse-wheel-down-event)
- (lambda (event)
- (interactive "e")
- (with-selected-window (posn-window (event-start event))
- (flymake-goto-prev-error 1 (list type) t))))
- (define-key map (vector 'mode-line
- mouse-wheel-up-event)
- (lambda (event)
- (interactive "e")
- (with-selected-window (posn-window (event-start event))
- (flymake-goto-next-error 1 (list type) t))))
- map)
- help-echo
- ,(concat (format "%s diagnostics of type %s\n"
- (propertize (format "%d"
- (length diags))
- 'face face)
- (propertize (format "%s" type)
- 'face face))
- (format "%s/%s: previous/next of this type"
- mouse-wheel-down-event
- mouse-wheel-up-event)))
- into forms
- finally return
- `((:propertize "[")
- ,@(cl-loop for (a . rest) on forms by #'cdr
- collect a when rest collect
- '(:propertize " "))
- (:propertize "]")))))))
+
+(defun flymake--mode-line-counters ()
+ (when (flymake-running-backends) flymake-mode-line-counter-format))
+
+(defun flymake--mode-line-counter (type &optional no-space)
+ "Compute number of diagnostics in buffer with TYPE's severity.
+TYPE is usually keyword `:error', `:warning' or `:note'."
+ (let ((count 0)
+ (face (flymake--lookup-type-property type
+ 'mode-line-face
+ 'compilation-error)))
+ (maphash (lambda
+ (_b state)
+ (dolist (d (flymake--backend-state-diags state))
+ (when (= (flymake--severity type)
+ (flymake--severity (flymake--diag-type d)))
+ (cl-incf count))))
+ flymake--backend-state)
+ (when (or (cl-plusp count)
+ (cond ((eq flymake-suppress-zero-counters t)
+ nil)
+ (flymake-suppress-zero-counters
+ (>= (flymake--severity type)
+ (warning-numeric-level
+ flymake-suppress-zero-counters)))
+ (t t)))
+ `(,(if no-space "" '(:propertize " "))
+ (:propertize
+ ,(format "%d" count)
+ face ,face
+ mouse-face mode-line-highlight
+ keymap
+ ,(let ((map (make-sparse-keymap)))
+ (define-key map (vector 'mode-line
+ mouse-wheel-down-event)
+ (lambda (event)
+ (interactive "e")
+ (with-selected-window (posn-window (event-start event))
+ (flymake-goto-prev-error 1 (list type) t))))
+ (define-key map (vector 'mode-line
+ mouse-wheel-up-event)
+ (lambda (event)
+ (interactive "e")
+ (with-selected-window (posn-window (event-start event))
+ (flymake-goto-next-error 1 (list type) t))))
+ map))))))
;;; Diagnostics buffer
diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el
index d84c3795653..3bef3986a10 100644
--- a/lisp/progmodes/fortran.el
+++ b/lisp/progmodes/fortran.el
@@ -1,6 +1,6 @@
;;; fortran.el --- Fortran mode for GNU Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1986, 1993-1995, 1997-2020 Free Software Foundation,
+;; Copyright (C) 1986, 1993-1995, 1997-2021 Free Software Foundation,
;; Inc.
;; Author: Michael D. Prange <prange@erl.mit.edu>
@@ -861,36 +861,34 @@ with no args, if that value is non-nil."
:group 'fortran
:syntax-table fortran-mode-syntax-table
:abbrev-table fortran-mode-abbrev-table
- (set (make-local-variable 'indent-line-function) 'fortran-indent-line)
- (set (make-local-variable 'indent-region-function)
+ (setq-local indent-line-function 'fortran-indent-line)
+ (setq-local indent-region-function
(lambda (start end)
(let (fortran-blink-matching-if ; avoid blinking delay
indent-region-function)
(indent-region start end nil))))
- (set (make-local-variable 'require-final-newline) mode-require-final-newline)
+ (setq-local require-final-newline mode-require-final-newline)
;; The syntax tables don't understand the column-0 comment-markers.
- (set (make-local-variable 'comment-use-syntax) nil)
- (set (make-local-variable 'comment-padding) "$$$")
- (set (make-local-variable 'comment-start) fortran-comment-line-start)
- (set (make-local-variable 'comment-start-skip)
+ (setq-local comment-use-syntax nil)
+ (setq-local comment-padding "$$$")
+ (setq-local comment-start fortran-comment-line-start)
+ (setq-local comment-start-skip
;; We can't reuse `fortran-comment-line-start-skip' directly because
;; it contains backrefs whereas we need submatch-1 to end at the
;; beginning of the comment delimiter.
;; (concat "\\(\\)\\(![ \t]*\\|" fortran-comment-line-start-skip "\\)")
"\\(\\)\\(?:^[CcDd*]\\|!\\)\\(?:\\([^ \t\n]\\)\\2+\\)?[ \t]*")
- (set (make-local-variable 'comment-indent-function) 'fortran-comment-indent)
- (set (make-local-variable 'comment-region-function) 'fortran-comment-region)
- (set (make-local-variable 'uncomment-region-function)
- 'fortran-uncomment-region)
- (set (make-local-variable 'comment-insert-comment-function)
- 'fortran-indent-comment)
- (set (make-local-variable 'abbrev-all-caps) t)
- (set (make-local-variable 'normal-auto-fill-function) 'fortran-auto-fill)
- (set (make-local-variable 'indent-tabs-mode) (fortran-analyze-file-format))
+ (setq-local comment-indent-function 'fortran-comment-indent)
+ (setq-local comment-region-function 'fortran-comment-region)
+ (setq-local uncomment-region-function 'fortran-uncomment-region)
+ (setq-local comment-insert-comment-function 'fortran-indent-comment)
+ (setq-local abbrev-all-caps t)
+ (setq-local normal-auto-fill-function 'fortran-auto-fill)
+ (setq-local indent-tabs-mode (fortran-analyze-file-format))
(setq mode-line-process '(indent-tabs-mode fortran-tab-mode-string))
- (set (make-local-variable 'fill-column) fortran-line-length)
- (set (make-local-variable 'fill-paragraph-function) 'fortran-fill-paragraph)
- (set (make-local-variable 'font-lock-defaults)
+ (setq-local fill-column fortran-line-length)
+ (setq-local fill-paragraph-function 'fortran-fill-paragraph)
+ (setq-local font-lock-defaults
'((fortran-font-lock-keywords
fortran-font-lock-keywords-1
fortran-font-lock-keywords-2
@@ -898,20 +896,19 @@ with no args, if that value is non-nil."
fortran-font-lock-keywords-4)
nil t ((?/ . "$/") ("_$" . "w"))
fortran-beginning-of-subprogram))
- (set (make-local-variable 'syntax-propertize-function)
+ (setq-local syntax-propertize-function
(fortran-make-syntax-propertize-function fortran-line-length))
- (set (make-local-variable 'imenu-case-fold-search) t)
- (set (make-local-variable 'imenu-generic-expression)
- fortran-imenu-generic-expression)
- (set (make-local-variable 'imenu-syntax-alist) '(("_$" . "w")))
- (set (make-local-variable 'beginning-of-defun-function)
- #'fortran-beginning-of-subprogram)
- (set (make-local-variable 'end-of-defun-function)
- #'fortran-end-of-subprogram)
- (set (make-local-variable 'add-log-current-defun-function)
- #'fortran-current-defun)
- (set (make-local-variable 'dabbrev-case-fold-search) 'case-fold-search)
- (set (make-local-variable 'gud-find-expr-function) 'fortran-gud-find-expr)
+ (setq-local imenu-case-fold-search t)
+ (setq-local imenu-generic-expression fortran-imenu-generic-expression)
+ (setq-local imenu-syntax-alist '(("_$" . "w")))
+ (setq-local beginning-of-defun-function
+ #'fortran-beginning-of-subprogram)
+ (setq-local end-of-defun-function
+ #'fortran-end-of-subprogram)
+ (setq-local add-log-current-defun-function
+ #'fortran-current-defun)
+ (setq-local dabbrev-case-fold-search 'case-fold-search)
+ (setq-local gud-find-expr-function 'fortran-gud-find-expr)
(add-hook 'hack-local-variables-hook 'fortran-hack-local-variables nil t))
@@ -1221,25 +1218,32 @@ Auto-indent does not happen if a numeric ARG is used."
;; Note that unlike the latter, we don't have to worry about nested
;; subprograms (?).
;; FIXME push-mark?
-(defun fortran-beginning-of-subprogram ()
- "Move point to the beginning of the current Fortran subprogram."
+(defun fortran-beginning-of-subprogram (&optional arg)
+ "Move point to the beginning of the current Fortran subprogram.
+If ARG is negative, and point is between subprograms, the
+\"current\" subprogram is the next one."
(interactive)
- (let ((case-fold-search t))
- ;; If called already at the start of subprogram, go to the previous.
- (beginning-of-line (if (bolp) 0 1))
- (save-match-data
- (or (looking-at fortran-start-prog-re)
- ;; This leaves us at bob if before the first subprogram.
- (eq (fortran-previous-statement) 'first-statement)
- (if (or (catch 'ok
- (while (re-search-backward fortran-end-prog-re nil 'move)
- (if (fortran-check-end-prog-re) (throw 'ok t))))
- ;; If the search failed, must be at bob.
- ;; First code line is the start of the subprogram.
- ;; FIXME use a more rigorous test, cf fortran-next-statement?
- ;; Though that needs to handle continuations too.
- (not (looking-at "^\\([ \t]*[0-9]\\|[ \t]+[^!#]\\)")))
- (fortran-next-statement))))))
+ (if (and arg
+ (< arg 0))
+ (progn
+ (fortran-end-of-subprogram)
+ (fortran-beginning-of-subprogram))
+ (let ((case-fold-search t))
+ ;; If called already at the start of subprogram, go to the previous.
+ (beginning-of-line (if (bolp) 0 1))
+ (save-match-data
+ (or (looking-at fortran-start-prog-re)
+ ;; This leaves us at bob if before the first subprogram.
+ (eq (fortran-previous-statement) 'first-statement)
+ (if (or (catch 'ok
+ (while (re-search-backward fortran-end-prog-re nil 'move)
+ (if (fortran-check-end-prog-re) (throw 'ok t))))
+ ;; If the search failed, must be at bob.
+ ;; First code line is the start of the subprogram.
+ ;; FIXME use a more rigorous test, cf fortran-next-statement?
+ ;; Though that needs to handle continuations too.
+ (not (looking-at "^\\([ \t]*[0-9]\\|[ \t]+[^!#]\\)")))
+ (fortran-next-statement)))))))
;; This is simpler than f-beginning-of-s because the end of a
;; subprogram is never implicit.
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index 4bebf88d356..1a96755bcf0 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -1,6 +1,6 @@
;;; gdb-mi.el --- User Interface for running GDB -*- lexical-binding: t -*-
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Nick Roberts <nickrob@gnu.org>
;; Maintainer: emacs-devel@gnu.org
@@ -373,19 +373,17 @@ were not yet received."
(dolist (handler gdb-handler-list)
(setf (gdb-handler-pending-trigger handler) nil)))
-(defmacro gdb-wait-for-pending (&rest body)
- "Wait for all pending GDB commands to finish and evaluate BODY.
+(defun gdb-wait-for-pending (func)
+ "Wait for all pending GDB commands to finish and call FUNC.
This function checks every 0.5 seconds if there are any pending
triggers in `gdb-handler-list'."
- `(run-with-timer
- 0.5 nil
- '(lambda ()
- (if (not (cl-find-if (lambda (handler)
- (gdb-handler-pending-trigger handler))
- gdb-handler-list))
- (progn ,@body)
- (gdb-wait-for-pending ,@body)))))
+ (run-with-timer
+ 0.5 nil
+ (lambda ()
+ (if (cl-some #'gdb-handler-pending-trigger gdb-handler-list)
+ (gdb-wait-for-pending func)
+ (funcall func)))))
;; Publish-subscribe
@@ -746,7 +744,7 @@ NOARG must be t when this macro is used outside `gud-def'."
;; Use the old gud-gbd filter, not because it works, but because it
;; will properly display GDB's answers rather than hanging waiting for
;; answers that aren't coming.
- (set (make-local-variable 'gud-marker-filter) #'gud-gdb-marker-filter))
+ (setq-local gud-marker-filter #'gud-gdb-marker-filter))
(funcall filter proc string)))
(defvar gdb-control-level 0)
@@ -833,8 +831,8 @@ detailed description of this mode.
(let ((proc (get-buffer-process gud-comint-buffer)))
(add-function :around (process-filter proc) #'gdb--check-interpreter))
- (set (make-local-variable 'gud-minor-mode) 'gdbmi)
- (set (make-local-variable 'gdb-control-level) 0)
+ (setq-local gud-minor-mode 'gdbmi)
+ (setq-local gdb-control-level 0)
(setq comint-input-sender 'gdb-send)
(when (ring-empty-p comint-input-ring) ; cf shell-mode
(let ((hfile (expand-file-name (or (getenv "GDBHISTFILE")
@@ -863,9 +861,9 @@ detailed description of this mode.
(and (stringp hsize)
(integerp (setq hsize (string-to-number hsize)))
(> hsize 0)
- (set (make-local-variable 'comint-input-ring-size) hsize))
+ (setq-local comint-input-ring-size hsize))
(if (stringp hfile)
- (set (make-local-variable 'comint-input-ring-file-name) hfile))
+ (setq-local comint-input-ring-file-name hfile))
(comint-read-input-ring t)))
(gud-def gud-tbreak "tbreak %f:%l" "\C-t"
"Set temporary breakpoint at current line.")
@@ -968,8 +966,7 @@ detailed description of this mode.
(define-key gud-minor-mode-map [left-margin C-mouse-3]
'gdb-mouse-jump)
- (set (make-local-variable 'gud-gdb-completion-function)
- 'gud-gdbmi-completions)
+ (setq-local gud-gdb-completion-function 'gud-gdbmi-completions)
(add-hook 'completion-at-point-functions #'gud-gdb-completion-at-point
nil 'local)
@@ -1143,8 +1140,8 @@ no input, and GDB is waiting for input."
(lambda () (gdb-tooltip-print expr)))))))
(defun gdb-init-buffer ()
- (set (make-local-variable 'gud-minor-mode) 'gdbmi)
- (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
+ (setq-local gud-minor-mode 'gdbmi)
+ (setq-local tool-bar-map gud-tool-bar-map)
(when gud-tooltip-mode
(make-local-variable 'gdb-define-alist)
(gdb-create-define-alist)
@@ -1560,10 +1557,10 @@ this trigger is subscribed to `gdb-buf-publisher' and called with
(when mode (funcall mode))
(setq gdb-buffer-type buffer-type)
(when thread
- (set (make-local-variable 'gdb-thread-number) thread))
- (set (make-local-variable 'gud-minor-mode)
- (buffer-local-value 'gud-minor-mode gud-comint-buffer))
- (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
+ (setq-local gdb-thread-number thread))
+ (setq-local gud-minor-mode
+ (buffer-local-value 'gud-minor-mode gud-comint-buffer))
+ (setq-local tool-bar-map gud-tool-bar-map)
(rename-buffer (funcall (gdb-rules-name-maker rules)))
(when trigger
(gdb-add-subscriber gdb-buf-publisher
@@ -1617,17 +1614,16 @@ this trigger is subscribed to `gdb-buf-publisher' and called with
;; (if it has an associated update trigger)
(add-hook
'kill-buffer-hook
- (function
- (lambda ()
- (let ((trigger (gdb-rules-update-trigger
- (gdb-current-buffer-rules))))
- (when trigger
- (gdb-delete-subscriber
- gdb-buf-publisher
- ;; This should match gdb-add-subscriber done in
- ;; gdb-get-buffer-create
- (cons (current-buffer)
- (gdb-bind-function-to-buffer trigger (current-buffer))))))))
+ (lambda ()
+ (let ((trigger (gdb-rules-update-trigger
+ (gdb-current-buffer-rules))))
+ (when trigger
+ (gdb-delete-subscriber
+ gdb-buf-publisher
+ ;; This should match gdb-add-subscriber done in
+ ;; gdb-get-buffer-create
+ (cons (current-buffer)
+ (gdb-bind-function-to-buffer trigger (current-buffer)))))))
nil t))
;; Partial-output buffer : This accumulates output from a command executed on
@@ -2455,7 +2451,7 @@ the end of the current result or async record is reached."
;; files, values of string variables in the inferior, etc., are all
;; encoded in the same encoding.
-(defcustom gdb-mi-decode-strings nil
+(defcustom gdb-mi-decode-strings t
"When non-nil, decode octal escapes in GDB output into non-ASCII text.
If the value is a coding-system, use that coding-system to decode
@@ -2525,7 +2521,7 @@ Unset `gdb-thread-number' if current thread exited and update threads list."
;; disallow us to properly call -thread-info without --thread option.
;; Thus we need to use gdb-wait-for-pending.
(gdb-wait-for-pending
- (gdb-emit-signal gdb-buf-publisher 'update-threads))))
+ (lambda () (gdb-emit-signal gdb-buf-publisher 'update-threads)))))
(defun gdb-thread-selected (_token output-field)
"Handler for =thread-selected MI output record.
@@ -2539,11 +2535,10 @@ Sets `gdb-thread-number' to new id."
;; as usually. Things happen too fast and second call (from
;; gdb-thread-selected handler) gets cut off by our beloved
;; pending triggers.
- ;; Solution is `gdb-wait-for-pending' macro: it guarantees that its
- ;; body will get executed when `gdb-handler-list' if free of
+ ;; Solution is `gdb-wait-for-pending': it guarantees that its
+ ;; argument will get called when `gdb-handler-list' if free of
;; pending triggers.
- (gdb-wait-for-pending
- (gdb-update))))
+ (gdb-wait-for-pending #'gdb-update)))
(defun gdb-running (_token output-field)
(let* ((thread-id
@@ -3014,7 +3009,7 @@ If NOPRESERVE is non-nil, window point is not restored after CUSTOM-DEFUN."
(,custom-defun)
(gdb-update-buffer-name)
,@(when (not nopreserve)
- '((set-window-start window start)
+ '((set-window-start window start t)
(set-window-point window p))))))
(defmacro def-gdb-trigger-and-handler (trigger-name gdb-command
@@ -3132,24 +3127,27 @@ See `def-gdb-auto-update-handler'."
(concat "fullname=\\(" gdb--string-regexp "\\)"))
(defun gdb-get-location (bptno line flag)
- "Find the directory containing the relevant source file.
-Put in buffer and place breakpoint icon."
+ "Glean name of source file using `gdb-source-file-regexp', and visit it.
+Place breakpoint icon in its buffer."
(goto-char (point-min))
(catch 'file-not-found
- (if (re-search-forward gdb-source-file-regexp nil t)
- (delete (cons bptno "File not found") gdb-location-alist)
- ;; FIXME: Why/how do we use (match-string 1) when the search failed?
- (push (cons bptno (match-string 1)) gdb-location-alist)
- (gdb-resync)
- (unless (assoc bptno gdb-location-alist)
- (push (cons bptno "File not found") gdb-location-alist)
- (message-box "Cannot find source file for breakpoint location.
+ (let (source-file)
+ (if (re-search-forward gdb-source-file-regexp nil t)
+ (progn
+ (setq source-file (gdb-mi--c-string-from-string (match-string 1)))
+ (delete (cons bptno "File not found") gdb-location-alist)
+ (push (cons bptno source-file) gdb-location-alist))
+ (gdb-resync)
+ (unless (assoc bptno gdb-location-alist)
+ (push (cons bptno "File not found") gdb-location-alist)
+ (message-box "Cannot find source file for breakpoint location.
Add directory to search path for source files using the GDB command, dir."))
- (throw 'file-not-found nil))
- (with-current-buffer (find-file-noselect (match-string 1))
- (gdb-init-buffer)
- ;; only want one breakpoint icon at each location
- (gdb-put-breakpoint-icon (eq flag ?y) bptno (string-to-number line)))))
+ (throw 'file-not-found nil))
+ (with-current-buffer (find-file-noselect source-file)
+ (gdb-init-buffer)
+ ;; Only want one breakpoint icon at each location.
+ (gdb-put-breakpoint-icon (string-equal flag "y") bptno
+ (string-to-number line))))))
(add-hook 'find-file-hook 'gdb-find-file-hook)
@@ -3368,8 +3366,7 @@ corresponding to the mode line clicked."
(setq gdb-thread-position (make-marker))
(add-to-list 'overlay-arrow-variable-list 'gdb-thread-position)
(setq header-line-format gdb-threads-header)
- (set (make-local-variable 'font-lock-defaults)
- '(gdb-threads-font-lock-keywords))
+ (setq-local font-lock-defaults '(gdb-threads-font-lock-keywords))
'gdb-invalidate-threads)
(defun gdb-thread-list-handler-custom ()
@@ -3924,8 +3921,7 @@ DOC is an optional documentation string."
(define-derived-mode gdb-memory-mode gdb-parent-mode "Memory"
"Major mode for examining memory."
(setq header-line-format gdb-memory-header)
- (set (make-local-variable 'font-lock-defaults)
- '(gdb-memory-font-lock-keywords))
+ (setq-local font-lock-defaults '(gdb-memory-font-lock-keywords))
'gdb-invalidate-memory)
(defun gdb-memory-buffer-name ()
@@ -4017,9 +4013,8 @@ DOC is an optional documentation string."
;; TODO Rename overlay variable for disassembly mode
(add-to-list 'overlay-arrow-variable-list 'gdb-disassembly-position)
(setq fringes-outside-margins t)
- (set (make-local-variable 'gdb-disassembly-position) (make-marker))
- (set (make-local-variable 'font-lock-defaults)
- '(gdb-disassembly-font-lock-keywords))
+ (setq-local gdb-disassembly-position (make-marker))
+ (setq-local font-lock-defaults '(gdb-disassembly-font-lock-keywords))
'gdb-invalidate-disassembly)
(defun gdb-disassembly-handler-custom ()
@@ -4226,8 +4221,7 @@ member."
(setq gdb-stack-position (make-marker))
(add-to-list 'overlay-arrow-variable-list 'gdb-stack-position)
(setq truncate-lines t) ;; Make it easier to see overlay arrow.
- (set (make-local-variable 'font-lock-defaults)
- '(gdb-frames-font-lock-keywords))
+ (setq-local font-lock-defaults '(gdb-frames-font-lock-keywords))
'gdb-invalidate-frames)
(defun gdb-select-frame (&optional event)
diff --git a/lisp/progmodes/glasses.el b/lisp/progmodes/glasses.el
index ab65a1590c0..a0f5d36bb65 100644
--- a/lisp/progmodes/glasses.el
+++ b/lisp/progmodes/glasses.el
@@ -1,6 +1,6 @@
;;; glasses.el --- make cantReadThis readable -*- lexical-binding: t; -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Milan Zamazal <pdm@zamazal.org>
;; Keywords: tools
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el
index 96838269749..1a8435fde33 100644
--- a/lisp/progmodes/grep.el
+++ b/lisp/progmodes/grep.el
@@ -1,6 +1,6 @@
;;; grep.el --- run `grep' and display the results -*- lexical-binding:t -*-
-;; Copyright (C) 1985-1987, 1993-1999, 2001-2020 Free Software
+;; Copyright (C) 1985-1987, 1993-1999, 2001-2021 Free Software
;; Foundation, Inc.
;; Author: Roland McGrath <roland@gnu.org>
@@ -79,7 +79,7 @@ This option sets the environment variable GREP_COLORS to specify
markers for highlighting and adds the --color option in front of
any explicit grep options before starting the grep.
-When this option is `auto', grep uses `--color' to highlight
+When this option is `auto', grep uses `--color=auto' to highlight
matches only when it outputs to a terminal (when `grep' is the last
command in the pipe), thus avoiding the use of any potentially-harmful
escape sequences when standard output goes to a file or pipe.
@@ -95,12 +95,12 @@ To change the default value, use \\[customize] or call the function
:type '(choice (const :tag "Do not highlight matches with grep markers" nil)
(const :tag "Highlight matches with grep markers" t)
(const :tag "Use --color=always" always)
- (const :tag "Use --color" auto)
+ (const :tag "Use --color=auto" auto)
(other :tag "Not Set" auto-detect))
:set #'grep-apply-setting
:version "22.1")
-(defcustom grep-match-regexp "\033\\[0?1;31m\\(.*?\\)\033\\[[0-9]*m"
+(defcustom grep-match-regexp "\033\\[\\(?:0?1;\\)?31m\\(.*?\\)\033\\[[0-9]*m"
"Regular expression matching grep markers to highlight.
It matches SGR ANSI escape sequences which are emitted by grep to
color its output. This variable is used in `grep-filter'."
@@ -296,8 +296,10 @@ See `compilation-error-screen-columns'."
:help "Kill the currently running grep process"))
(define-key map [menu-bar grep compilation-separator2] '("----"))
(define-key map [menu-bar grep compilation-compile]
- '(menu-item "Compile..." compile
- :help "Compile the program including the current buffer. Default: run `make'"))
+ '(menu-item
+ "Compile..." compile
+ :help
+ "Compile the program including the current buffer. Default: run `make'"))
(define-key map [menu-bar grep compilation-rgrep]
'(menu-item "Recursive grep..." rgrep
:help "User-friendly recursive grep in directory tree"))
@@ -308,15 +310,18 @@ See `compilation-error-screen-columns'."
'(menu-item "Grep via Find..." grep-find
:help "Run grep via find, with user-specified args"))
(define-key map [menu-bar grep compilation-grep]
- '(menu-item "Another grep..." grep
- :help "Run grep, with user-specified args, and collect output in a buffer."))
+ '(menu-item
+ "Another grep..." grep
+ :help
+ "Run grep, with user-specified args, and collect output in a buffer."))
(define-key map [menu-bar grep compilation-recompile]
'(menu-item "Repeat grep" recompile
:help "Run grep again"))
(define-key map [menu-bar grep compilation-separator1] '("----"))
(define-key map [menu-bar grep compilation-first-error]
- '(menu-item "First Match" first-error
- :help "Restart at the first match, visit corresponding location"))
+ '(menu-item
+ "First Match" first-error
+ :help "Restart at the first match, visit corresponding location"))
(define-key map [menu-bar grep compilation-previous-error]
'(menu-item "Previous Match" previous-error
:help "Visit the previous match and corresponding location"))
@@ -389,7 +394,8 @@ Notice that using \\[next-error] or \\[compile-goto-error] modifies
(when grep-highlight-matches
(let* ((beg (match-end 0))
(end (save-excursion (goto-char beg) (line-end-position)))
- (mbeg (text-property-any beg end 'font-lock-face grep-match-face)))
+ (mbeg
+ (text-property-any beg end 'font-lock-face grep-match-face)))
(when mbeg
(- mbeg beg)))))
.
@@ -397,13 +403,16 @@ Notice that using \\[next-error] or \\[compile-goto-error] modifies
(when grep-highlight-matches
(let* ((beg (match-end 0))
(end (save-excursion (goto-char beg) (line-end-position)))
- (mbeg (text-property-any beg end 'font-lock-face grep-match-face))
- (mend (and mbeg (next-single-property-change mbeg 'font-lock-face nil end))))
+ (mbeg
+ (text-property-any beg end 'font-lock-face grep-match-face))
+ (mend
+ (and mbeg (next-single-property-change
+ mbeg 'font-lock-face nil end))))
(when mend
(- mend beg))))))
nil nil
(3 '(face nil display ":")))
- ("^Binary file \\(.+\\) matches$" 1 nil nil 0 1))
+ ("^Binary file \\(.+\\) matches" 1 nil nil 0 1))
"Regexp used to match grep hits.
See `compilation-error-regexp-alist' for format details.")
@@ -559,8 +568,7 @@ Set up `compilation-exit-message-function' and run `grep-setup-hook'."
;; GREP_COLORS is used in GNU grep 2.5.2 and later versions
(setenv "GREP_COLORS" "mt=01;31:fn=:ln=:bn=:se=:sl=:cx=:ne"))
(setq-local grep-num-matches-found 0)
- (set (make-local-variable 'compilation-exit-message-function)
- #'grep-exit-message)
+ (setq-local compilation-exit-message-function #'grep-exit-message)
(run-hooks 'grep-setup-hook))
(defun grep-exit-message (status code msg)
@@ -614,6 +622,15 @@ This function is called from `compilation-filter-hook'."
(error nil))
(or result 0))))
+(defun grep-hello-file ()
+ (let ((result
+ (if (file-remote-p default-directory)
+ (make-temp-file (file-name-as-directory (temporary-file-directory)))
+ (expand-file-name "HELLO" data-directory))))
+ (when (file-remote-p result)
+ (write-region "Copyright\n" nil result))
+ result))
+
;;;###autoload
(defun grep-compute-defaults ()
"Compute the defaults for the `grep' command.
@@ -655,37 +672,46 @@ The value depends on `grep-command', `grep-template',
(unless (or (not grep-use-null-device) (eq grep-use-null-device t))
(setq grep-use-null-device
(with-temp-buffer
- (let ((hello-file (expand-file-name "HELLO" data-directory)))
- (not
- (and (if grep-command
- ;; `grep-command' is already set, so
- ;; use that for testing.
- (grep-probe grep-command
- `(nil t nil "^Copyright" ,hello-file)
- #'call-process-shell-command)
- ;; otherwise use `grep-program'
- (grep-probe grep-program
- `(nil t nil "-nH" "^Copyright" ,hello-file)))
- (progn
- (goto-char (point-min))
- (looking-at
- (concat (regexp-quote hello-file)
- ":[0-9]+:Copyright")))))))))
+ (let ((hello-file (grep-hello-file)))
+ (prog1
+ (not
+ (and (if grep-command
+ ;; `grep-command' is already set, so
+ ;; use that for testing.
+ (grep-probe
+ grep-command
+ `(nil t nil "^Copyright"
+ ,(file-local-name hello-file))
+ #'process-file-shell-command)
+ ;; otherwise use `grep-program'
+ (grep-probe
+ grep-program
+ `(nil t nil "-nH" "^Copyright"
+ ,(file-local-name hello-file))))
+ (progn
+ (goto-char (point-min))
+ (looking-at
+ (concat (regexp-quote (file-local-name hello-file))
+ ":[0-9]+:Copyright")))))
+ (when (file-remote-p hello-file) (delete-file hello-file)))))))
(when (eq grep-use-null-filename-separator 'auto-detect)
(setq grep-use-null-filename-separator
(with-temp-buffer
- (let* ((hello-file (expand-file-name "HELLO" data-directory))
- (args `("--null" "-ne" "^Copyright" ,hello-file)))
+ (let* ((hello-file (grep-hello-file))
+ (args `("--null" "-ne" "^Copyright"
+ ,(file-local-name hello-file))))
(if grep-use-null-device
- (setq args (append args (list null-device)))
+ (setq args (append args (list (null-device))))
(push "-H" args))
- (and (grep-probe grep-program `(nil t nil ,@args))
- (progn
- (goto-char (point-min))
- (looking-at
- (concat (regexp-quote hello-file)
- "\0[0-9]+:Copyright"))))))))
+ (prog1
+ (and (grep-probe grep-program `(nil t nil ,@args))
+ (progn
+ (goto-char (point-min))
+ (looking-at
+ (concat (regexp-quote (file-local-name hello-file))
+ "\0[0-9]+:Copyright"))))
+ (when (file-remote-p hello-file) (delete-file hello-file)))))))
(when (eq grep-highlight-matches 'auto-detect)
(setq grep-highlight-matches
@@ -704,7 +730,7 @@ The value depends on `grep-command', `grep-template',
(concat (if grep-use-null-device "-n" "-nH")
(if grep-use-null-filename-separator " --null")
(when (grep-probe grep-program
- `(nil nil nil "-e" "foo" ,null-device)
+ `(nil nil nil "-e" "foo" ,(null-device))
nil 1)
" -e"))))
(unless grep-command
@@ -712,13 +738,14 @@ The value depends on `grep-command', `grep-template',
(format "%s %s %s " grep-program
(or
(and grep-highlight-matches
- (grep-probe grep-program
- `(nil nil nil "--color" "x" ,null-device)
- nil 1)
+ (grep-probe
+ grep-program
+ `(nil nil nil "--color" "x" ,(null-device))
+ nil 1)
(if (eq grep-highlight-matches 'always)
- "--color=always" "--color"))
+ "--color=always" "--color=auto"))
"")
- grep-options)))
+ grep-options)))
(unless grep-template
(setq grep-template
(format "%s <X> <C> %s <R> <F>" grep-program grep-options)))
@@ -726,11 +753,12 @@ The value depends on `grep-command', `grep-template',
(setq grep-find-use-xargs
(cond
((grep-probe find-program
- `(nil nil nil ,null-device "-exec" "echo"
+ `(nil nil nil ,(null-device) "-exec" "echo"
"{}" "+"))
'exec-plus)
((and
- (grep-probe find-program `(nil nil nil ,null-device "-print0"))
+ (grep-probe
+ find-program `(nil nil nil ,(null-device) "-print0"))
(grep-probe xargs-program '(nil nil nil "-0" "echo")))
'gnu)
(t
@@ -750,12 +778,13 @@ The value depends on `grep-command', `grep-template',
(let ((cmd0 (format "%s . -type f -exec %s"
find-program grep-command))
(null (if grep-use-null-device
- (format "%s " null-device)
+ (format "%s " (null-device))
"")))
(cons
(if (eq grep-find-use-xargs 'exec-plus)
(format "%s %s%s +" cmd0 null quot-braces)
- (format "%s %s %s%s" cmd0 quot-braces null quot-scolon))
+ (format "%s %s %s%s"
+ cmd0 quot-braces null quot-scolon))
(1+ (length cmd0)))))
(t
(format "%s . -type f -print | \"%s\" %s"
@@ -765,7 +794,7 @@ The value depends on `grep-command', `grep-template',
(let ((gcmd (format "%s <C> %s <R>"
grep-program grep-options))
(null (if grep-use-null-device
- (format "%s " null-device)
+ (format "%s " (null-device))
"")))
(cond ((eq grep-find-use-xargs 'gnu)
(format "%s <D> <X> -type f <F> -print0 | \"%s\" -0 %s"
@@ -814,7 +843,8 @@ The value depends on `grep-command', `grep-template',
(let ((tag-default (shell-quote-argument (grep-tag-default)))
;; This a regexp to match single shell arguments.
;; Could someone please add comments explaining it?
- (sh-arg-re "\\(\\(?:\"\\(?:[^\"]\\|\\\\\"\\)+\"\\|'[^']+'\\|[^\"' \t\n]\\)+\\)")
+ (sh-arg-re
+ "\\(\\(?:\"\\(?:[^\"]\\|\\\\\"\\)+\"\\|'[^']+'\\|[^\"' \t\n]\\)+\\)")
(grep-default (or (car grep-history) grep-command)))
;; In the default command, find the arg that specifies the pattern.
(when (or (string-match
@@ -849,22 +879,22 @@ The value depends on `grep-command', `grep-template',
(define-compilation-mode grep-mode "Grep"
"Sets `grep-last-buffer' and `compilation-window-height'."
(setq grep-last-buffer (current-buffer))
- (set (make-local-variable 'tool-bar-map) grep-mode-tool-bar-map)
- (set (make-local-variable 'compilation-error-face)
- grep-hit-face)
- (set (make-local-variable 'compilation-error-regexp-alist)
- grep-regexp-alist)
- (set (make-local-variable 'compilation-mode-line-errors)
- grep-mode-line-matches)
+ (setq-local tool-bar-map grep-mode-tool-bar-map)
+ (setq-local compilation-error-face
+ grep-hit-face)
+ (setq-local compilation-error-regexp-alist
+ grep-regexp-alist)
+ (setq-local compilation-mode-line-errors
+ grep-mode-line-matches)
;; compilation-directory-matcher can't be nil, so we set it to a regexp that
;; can never match.
- (set (make-local-variable 'compilation-directory-matcher)
- (list regexp-unmatchable))
- (set (make-local-variable 'compilation-process-setup-function)
- #'grep-process-setup)
- (set (make-local-variable 'compilation-disable-input) t)
- (set (make-local-variable 'compilation-error-screen-columns)
- grep-error-screen-columns)
+ (setq-local compilation-directory-matcher
+ (list regexp-unmatchable))
+ (setq-local compilation-process-setup-function
+ #'grep-process-setup)
+ (setq-local compilation-disable-input t)
+ (setq-local compilation-error-screen-columns
+ grep-error-screen-columns)
(add-hook 'compilation-filter-hook #'grep-filter nil t))
(defun grep--save-buffers ()
@@ -909,8 +939,8 @@ list is empty)."
(grep--save-buffers)
;; Setting process-setup-function makes exit-message-function work
;; even when async processes aren't supported.
- (compilation-start (if (and grep-use-null-device null-device)
- (concat command-args " " null-device)
+ (compilation-start (if (and grep-use-null-device null-device (null-device))
+ (concat command-args " " (null-device))
command-args)
#'grep-mode))
@@ -948,7 +978,7 @@ easily repeat a find command."
'(("<C>" . (mapconcat #'identity opts " "))
("<D>" . (or dir "."))
("<F>" . files)
- ("<N>" . null-device)
+ ("<N>" . (null-device))
("<X>" . excl)
("<R>" . (shell-quote-argument (or regexp ""))))
"List of substitutions performed by `grep-expand-template'.
@@ -970,7 +1000,7 @@ these include `opts', `dir', `files', `null-device', `excl' and
((eq grep-highlight-matches 'always)
(push "--color=always" opts))
((eq grep-highlight-matches 'auto)
- (push "--color" opts)))
+ (push "--color=auto" opts)))
opts))
(excl . ,excl)
(dir . ,dir)
@@ -1052,8 +1082,9 @@ REGEXP is used as a string in the prompt."
#'read-file-name-internal
nil nil nil 'grep-files-history
(delete-dups
- (delq nil (append (list default default-alias default-extension)
- (mapcar #'car grep-files-aliases)))))))
+ (delq nil
+ (append (list default default-alias default-extension)
+ (mapcar #'car grep-files-aliases)))))))
(and files
(or (cdr (assoc files grep-files-aliases))
files))))
@@ -1105,11 +1136,12 @@ command before it's run."
(if (string= command grep-command)
(setq command nil))
(setq dir (file-name-as-directory (expand-file-name dir)))
- (unless (or (not grep-use-directories-skip) (eq grep-use-directories-skip t))
+ (unless (or (not grep-use-directories-skip)
+ (eq grep-use-directories-skip t))
(setq grep-use-directories-skip
(grep-probe grep-program
`(nil nil nil "--directories=skip" "foo"
- ,null-device)
+ ,(null-device))
nil 1)))
(setq command (grep-expand-template
grep-template
@@ -1141,10 +1173,11 @@ command before it's run."
;; Setting process-setup-function makes exit-message-function work
;; even when async processes aren't supported.
(grep--save-buffers)
- (compilation-start (if (and grep-use-null-device null-device)
- (concat command " " null-device)
- command)
- 'grep-mode))
+ (compilation-start
+ (if (and grep-use-null-device null-device (null-device))
+ (concat command " " (null-device))
+ command)
+ 'grep-mode))
;; Set default-directory if we started lgrep in the *grep* buffer.
(if (eq next-error-last-buffer (current-buffer))
(setq default-directory dir))))))
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index 81021bc64f4..259da2fd019 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -1,6 +1,6 @@
;;; gud.el --- Grand Unified Debugger mode for running GDB and other debuggers -*- lexical-binding:t -*-
-;; Copyright (C) 1992-1996, 1998, 2000-2020 Free Software Foundation,
+;; Copyright (C) 1992-1996, 1998, 2000-2021 Free Software Foundation,
;; Inc.
;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
@@ -758,7 +758,7 @@ the buffer in which this command was invoked."
"Multiple debugging requires restarting in text command mode"))
(gud-common-init command-line nil 'gud-gdb-marker-filter)
- (set (make-local-variable 'gud-minor-mode) 'gdb)
+ (setq-local gud-minor-mode 'gdb)
(gud-def gud-break "break %f:%l" "\C-b" "Set breakpoint at current line.")
(gud-def gud-tbreak "tbreak %f:%l" "\C-t"
@@ -788,7 +788,7 @@ the buffer in which this command was invoked."
(add-hook 'completion-at-point-functions #'gud-gdb-completion-at-point
nil 'local)
- (set (make-local-variable 'gud-gdb-completion-function) 'gud-gdb-completions)
+ (setq-local gud-gdb-completion-function 'gud-gdb-completions)
(local-set-key "\C-i" 'completion-at-point)
(setq comint-prompt-regexp "^(.*gdb[+]?) *")
@@ -1044,7 +1044,7 @@ and source-file directory for your debugger."
(error "The sdb support requires a valid tags table to work"))
(gud-common-init command-line nil 'gud-sdb-marker-filter 'gud-sdb-find-file)
- (set (make-local-variable 'gud-minor-mode) 'sdb)
+ (setq-local gud-minor-mode 'sdb)
(gud-def gud-break "%l b" "\C-b" "Set breakpoint at current line.")
(gud-def gud-tbreak "%l c" "\C-t" "Set temporary breakpoint at current line.")
@@ -1323,7 +1323,7 @@ and source-file directory for your debugger."
(gud-common-init command-line 'gud-dbx-massage-args
'gud-dbx-marker-filter)))
- (set (make-local-variable 'gud-minor-mode) 'dbx)
+ (setq-local gud-minor-mode 'dbx)
(cond
(gud-mips-p
@@ -1424,7 +1424,7 @@ directories if your program contains sources from more than one directory."
(gud-common-init command-line 'gud-xdb-massage-args
'gud-xdb-marker-filter)
- (set (make-local-variable 'gud-minor-mode) 'xdb)
+ (setq-local gud-minor-mode 'xdb)
(gud-def gud-break "b %f:%l" "\C-b" "Set breakpoint at current line.")
(gud-def gud-tbreak "b %f:%l\\t" "\C-t"
@@ -1578,7 +1578,7 @@ and source-file directory for your debugger."
(gud-common-init command-line 'gud-perldb-massage-args
'gud-perldb-marker-filter)
- (set (make-local-variable 'gud-minor-mode) 'perldb)
+ (setq-local gud-minor-mode 'perldb)
(gud-def gud-break "b %l" "\C-b" "Set breakpoint at current line.")
(gud-def gud-remove "B %l" "\C-d" "Remove breakpoint at current line")
@@ -1683,7 +1683,7 @@ and source-file directory for your debugger."
;;;###autoload
(defun pdb (command-line)
- "Run COMMAND-LINE in the `*gud-FILE*' buffer.
+ "Run COMMAND-LINE in the `*gud-FILE*' buffer to debug Python programs.
COMMAND-LINE should include the pdb executable
name (`gud-pdb-command-name') and the file to be debugged.
@@ -1696,7 +1696,7 @@ directory and source-file directory for your debugger."
(list (gud-query-cmdline 'pdb)))
(gud-common-init command-line nil 'gud-pdb-marker-filter)
- (set (make-local-variable 'gud-minor-mode) 'pdb)
+ (setq-local gud-minor-mode 'pdb)
(gud-def gud-break "break %d%f:%l" "\C-b" "Set breakpoint at current line.")
(gud-def gud-remove "clear %d%f:%l" "\C-d" "Remove breakpoint at current line")
@@ -2418,7 +2418,7 @@ gud, see `gud-mode'."
(gud-common-init command-line 'gud-jdb-massage-args
'gud-jdb-marker-filter)
- (set (make-local-variable 'gud-minor-mode) 'jdb)
+ (setq-local gud-minor-mode 'jdb)
;; If a -classpath option was provided, set gud-jdb-classpath
(if gud-jdb-classpath-string
@@ -2566,17 +2566,21 @@ You may use the `gud-def' macro in the initialization hook to define other
commands.
Other commands for interacting with the debugger process are inherited from
-comint mode, which see."
+`comint-mode', which see.
+
+Commands:
+
+\\{gud-mode-map}"
(setq mode-line-process '(":%s"))
(define-key (current-local-map) "\C-c\C-l" 'gud-refresh)
- (set (make-local-variable 'gud-last-frame) nil)
+ (setq-local gud-last-frame nil)
(if (boundp 'tool-bar-map) ; not --without-x
(setq-local tool-bar-map gud-tool-bar-map))
(make-local-variable 'comint-prompt-regexp)
;; Don't put repeated commands in command history many times.
- (set (make-local-variable 'comint-input-ignoredups) t)
+ (setq-local comint-input-ignoredups t)
(make-local-variable 'paragraph-start)
- (set (make-local-variable 'gud-delete-prompt-marker) (make-marker))
+ (setq-local gud-delete-prompt-marker (make-marker))
(add-hook 'kill-buffer-hook 'gud-kill-buffer-hook nil t))
(defcustom gud-chdir-before-run t
@@ -2649,10 +2653,10 @@ comint mode, which see."
(if massage-args (funcall massage-args file args) args))
;; Since comint clobbered the mode, we don't set it until now.
(gud-mode)
- (set (make-local-variable 'gud-target-name)
+ (setq-local gud-target-name
(and file-word (file-name-nondirectory file))))
- (set (make-local-variable 'gud-marker-filter) marker-filter)
- (if find-file (set (make-local-variable 'gud-find-file) find-file))
+ (setq-local gud-marker-filter marker-filter)
+ (if find-file (setq-local gud-find-file find-file))
(setq gud-last-last-frame nil)
(set-process-filter (get-buffer-process (current-buffer)) 'gud-filter)
@@ -3348,23 +3352,23 @@ Treats actions as defuns."
;;;###autoload
(define-derived-mode gdb-script-mode prog-mode "GDB-Script"
"Major mode for editing GDB scripts."
- (set (make-local-variable 'comment-start) "#")
- (set (make-local-variable 'comment-start-skip) "#+\\s-*")
- (set (make-local-variable 'outline-regexp) "[ \t]")
- (set (make-local-variable 'imenu-generic-expression)
- '((nil "^define[ \t]+\\(\\w+\\)" 1)))
- (set (make-local-variable 'indent-line-function) 'gdb-script-indent-line)
- (set (make-local-variable 'beginning-of-defun-function)
- #'gdb-script-beginning-of-defun)
- (set (make-local-variable 'end-of-defun-function)
- #'gdb-script-end-of-defun)
- (set (make-local-variable 'font-lock-defaults)
- '(gdb-script-font-lock-keywords nil nil ((?_ . "w")) nil
- (font-lock-syntactic-face-function
- . gdb-script-font-lock-syntactic-face)))
+ (setq-local comment-start "#")
+ (setq-local comment-start-skip "#+\\s-*")
+ (setq-local outline-regexp "[ \t]")
+ (setq-local imenu-generic-expression
+ '((nil "^define[ \t]+\\(\\w+\\)" 1)))
+ (setq-local indent-line-function 'gdb-script-indent-line)
+ (setq-local beginning-of-defun-function
+ #'gdb-script-beginning-of-defun)
+ (setq-local end-of-defun-function
+ #'gdb-script-end-of-defun)
+ (setq-local font-lock-defaults
+ '(gdb-script-font-lock-keywords nil nil ((?_ . "w")) nil
+ (font-lock-syntactic-face-function
+ . gdb-script-font-lock-syntactic-face)))
;; Recognize docstrings.
- (set (make-local-variable 'syntax-propertize-function)
- gdb-script-syntax-propertize-function)
+ (setq-local syntax-propertize-function
+ gdb-script-syntax-propertize-function)
(add-hook 'syntax-propertize-extend-region-functions
#'syntax-propertize-multiline 'append 'local))
@@ -3471,8 +3475,8 @@ only tooltips in the buffer containing the overlay arrow."
ACTIVATEP non-nil means activate mouse motion events."
(if activatep
(progn
- (set (make-local-variable 'gud-tooltip-mouse-motions-active) t)
- (set (make-local-variable 'track-mouse) t))
+ (setq-local gud-tooltip-mouse-motions-active t)
+ (setq-local track-mouse t))
(when gud-tooltip-mouse-motions-active
(kill-local-variable 'gud-tooltip-mouse-motions-active)
(kill-local-variable 'track-mouse))))
diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el
index 25e75235aa4..923f85fd4dd 100644
--- a/lisp/progmodes/hideif.el
+++ b/lisp/progmodes/hideif.el
@@ -1,6 +1,6 @@
;;; hideif.el --- hides selected code within ifdef -*- lexical-binding:t -*-
-;; Copyright (C) 1988, 1994, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 1994, 2001-2021 Free Software Foundation, Inc.
;; Author: Brian Marick
;; Daniel LaLiberte <liberte@holonexus.org>
@@ -153,8 +153,8 @@ The first time we visit such a file, _XXX_HEADER_FILE_INCLUDED_ is
undefined, and so nothing is hidden. The next time we visit it, everything will
be hidden.
-This behavior is generally undesirable. If this option is non-nil, the outermost
-#if is always visible."
+This behavior is generally undesirable. If this option is non-nil, the
+outermost #if is always visible."
:type 'boolean
:version "25.1")
@@ -302,17 +302,17 @@ Several variables affect how the hiding is done:
;; We can still simulate the behavior of older hideif versions (i.e.
;; `hide-ifdef-env' being buffer local) by clearing this variable
;; (C-c @ C) every time before hiding current buffer.
-;; (set (make-local-variable 'hide-ifdef-env)
+;; (setq-local hide-ifdef-env
;; (default-value 'hide-ifdef-env))
- (set 'hide-ifdef-env (default-value 'hide-ifdef-env))
+ (setq hide-ifdef-env (default-value 'hide-ifdef-env))
;; Some C/C++ headers might have other ways to prevent reinclusion and
;; thus would like `hide-ifdef-expand-reinclusion-protection' to be nil.
- (set (make-local-variable 'hide-ifdef-expand-reinclusion-protection)
- (default-value 'hide-ifdef-expand-reinclusion-protection))
- (set (make-local-variable 'hide-ifdef-hiding)
- (default-value 'hide-ifdef-hiding))
- (set (make-local-variable 'hif-outside-read-only) buffer-read-only)
- (set (make-local-variable 'line-move-ignore-invisible) t)
+ (setq-local hide-ifdef-expand-reinclusion-protection
+ (default-value 'hide-ifdef-expand-reinclusion-protection))
+ (setq-local hide-ifdef-hiding
+ (default-value 'hide-ifdef-hiding))
+ (setq-local hif-outside-read-only buffer-read-only)
+ (setq-local line-move-ignore-invisible t)
(add-hook 'change-major-mode-hook
(lambda () (hide-ifdef-mode -1)) nil t)
@@ -1792,7 +1792,7 @@ It does not do the work that's pointless to redo on a recursive entry."
(defun hide-ifdef-toggle-shadowing ()
"Toggle shadowing."
(interactive)
- (set (make-local-variable 'hide-ifdef-shadow) (not hide-ifdef-shadow))
+ (setq-local hide-ifdef-shadow (not hide-ifdef-shadow))
(message "Shadowing %s" (if hide-ifdef-shadow "ON" "OFF"))
(save-restriction
(widen)
diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el
index 2ad66ccc5e0..73d09e00591 100644
--- a/lisp/progmodes/hideshow.el
+++ b/lisp/progmodes/hideshow.el
@@ -1,6 +1,6 @@
;;; hideshow.el --- minor mode cmds to selectively display code/comment blocks -*- lexical-binding:t -*-
-;; Copyright (C) 1994-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2021 Free Software Foundation, Inc.
;; Author: Thien-Thi Nguyen <ttn@gnu.org>
;; Dan Nicolaescu <dann@ics.uci.edu>
@@ -948,8 +948,7 @@ Key bindings:
(add-hook 'change-major-mode-hook
#'turn-off-hideshow
nil t)
- (easy-menu-add hs-minor-mode-menu)
- (set (make-local-variable 'line-move-ignore-invisible) t)
+ (setq-local line-move-ignore-invisible t)
(add-to-invisibility-spec '(hs . t)))
(remove-from-invisibility-spec '(hs . t))
;; hs-show-all does nothing unless h-m-m is non-nil.
diff --git a/lisp/progmodes/icon.el b/lisp/progmodes/icon.el
index bb43215c33e..933cb333dfb 100644
--- a/lisp/progmodes/icon.el
+++ b/lisp/progmodes/icon.el
@@ -1,6 +1,6 @@
;;; icon.el --- mode for editing Icon code
-;; Copyright (C) 1989, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1989, 2001-2021 Free Software Foundation, Inc.
;; Author: Chris Smith <csmith@convex.com>
;; Created: 15 Feb 89
@@ -163,25 +163,24 @@ Variables controlling indentation style:
Turning on Icon mode calls the value of the variable `icon-mode-hook'
with no args, if that value is non-nil."
:abbrev-table icon-mode-abbrev-table
- (set (make-local-variable 'paragraph-start) (concat "$\\|" page-delimiter))
- (set (make-local-variable 'paragraph-separate) paragraph-start)
- (set (make-local-variable 'indent-line-function) #'icon-indent-line)
- (set (make-local-variable 'comment-start) "# ")
- (set (make-local-variable 'comment-end) "")
- (set (make-local-variable 'comment-start-skip) "# *")
- (set (make-local-variable 'comment-indent-function) 'icon-comment-indent)
- (set (make-local-variable 'indent-line-function) 'icon-indent-line)
+ (setq-local paragraph-start (concat "$\\|" page-delimiter))
+ (setq-local paragraph-separate paragraph-start)
+ (setq-local indent-line-function #'icon-indent-line)
+ (setq-local comment-start "# ")
+ (setq-local comment-end "")
+ (setq-local comment-start-skip "# *")
+ (setq-local comment-indent-function 'icon-comment-indent)
+ (setq-local indent-line-function 'icon-indent-line)
;; font-lock support
- (set (make-local-variable 'font-lock-defaults)
- '((icon-font-lock-keywords
- icon-font-lock-keywords-1 icon-font-lock-keywords-2)
- nil nil ((?_ . "w")) beginning-of-defun
- ;; Obsoleted by Emacs 19.35 parse-partial-sexp's COMMENTSTOP.
- ;;(font-lock-comment-start-regexp . "#")
- (font-lock-mark-block-function . mark-defun)))
+ (setq-local font-lock-defaults
+ '((icon-font-lock-keywords
+ icon-font-lock-keywords-1 icon-font-lock-keywords-2)
+ nil nil ((?_ . "w")) beginning-of-defun
+ ;; Obsoleted by Emacs 19.35 parse-partial-sexp's COMMENTSTOP.
+ ;;(font-lock-comment-start-regexp . "#")
+ (font-lock-mark-block-function . mark-defun)))
;; imenu support
- (set (make-local-variable 'imenu-generic-expression)
- icon-imenu-generic-expression)
+ (setq-local imenu-generic-expression icon-imenu-generic-expression)
;; hideshow support
;; we start from the assertion that `hs-special-modes-alist' is autoloaded.
(unless (assq 'icon-mode hs-special-modes-alist)
diff --git a/lisp/progmodes/idlw-complete-structtag.el b/lisp/progmodes/idlw-complete-structtag.el
index 4cb82786aef..25bc5ad881b 100644
--- a/lisp/progmodes/idlw-complete-structtag.el
+++ b/lisp/progmodes/idlw-complete-structtag.el
@@ -1,6 +1,6 @@
;;; idlw-complete-structtag.el --- Completion of structure tags.
-;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <dominik@astro.uva.nl>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/progmodes/idlw-help.el b/lisp/progmodes/idlw-help.el
index 2d4ea465c42..2e7b0aa7ef1 100644
--- a/lisp/progmodes/idlw-help.el
+++ b/lisp/progmodes/idlw-help.el
@@ -1,6 +1,6 @@
;;; idlw-help.el --- HTML Help code for IDLWAVE
-;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;;
;; Authors: JD Smith <jd.smith@utoledo.edu>
;; Carsten Dominik <dominik@science.uva.nl>
@@ -306,7 +306,6 @@ Jump: [h] to function doclib header
Here are all keybindings.
\\{idlwave-help-mode-map}"
(buffer-disable-undo)
- (easy-menu-add idlwave-help-menu idlwave-help-mode-map)
(setq truncate-lines t)
(setq case-fold-search t)
(setq mode-line-format
@@ -1173,17 +1172,16 @@ When DING is non-nil, ring the bell as well."
Useful when source code is displayed as help. See the option
`idlwave-help-fontify-source-code'."
(interactive)
- (if (featurep 'font-lock)
- (let ((major-mode 'idlwave-mode)
- (font-lock-verbose
- (if (called-interactively-p 'interactive) font-lock-verbose nil)))
- (with-syntax-table idlwave-mode-syntax-table
- (set (make-local-variable 'font-lock-defaults)
- idlwave-font-lock-defaults)
- (if (fboundp 'font-lock-ensure) ; Emacs >= 25.1
- (font-lock-ensure)
- ;; Silence "interactive use only" warning on Emacs >= 25.1.
- (with-no-warnings (font-lock-fontify-buffer)))))))
+ (let ((major-mode 'idlwave-mode)
+ (font-lock-verbose
+ (if (called-interactively-p 'interactive) font-lock-verbose nil)))
+ (with-syntax-table idlwave-mode-syntax-table
+ (set (make-local-variable 'font-lock-defaults)
+ idlwave-font-lock-defaults)
+ (if (fboundp 'font-lock-ensure) ; Emacs >= 25.1
+ (font-lock-ensure)
+ ;; Silence "interactive use only" warning on Emacs >= 25.1.
+ (with-no-warnings (font-lock-fontify-buffer))))))
(defun idlwave-help-error (name type class keyword)
@@ -1202,16 +1200,9 @@ Useful when source code is displayed as help. See the option
(setq idlwave-help-frame
(make-frame idlwave-help-frame-parameters))
;; Strip menubar (?) and toolbar from the Help frame.
- (if (fboundp 'set-specifier)
- (progn
- ;; XEmacs
- (let ((sval (cons idlwave-help-frame nil)))
- ;; (set-specifier menubar-visible-p sval)
- (set-specifier default-toolbar-visible-p sval)))
- ;; Emacs
- (modify-frame-parameters idlwave-help-frame
- '(;;(menu-bar-lines . 0)
- (tool-bar-lines . 0)))))
+ (modify-frame-parameters idlwave-help-frame
+ '(;;(menu-bar-lines . 0)
+ (tool-bar-lines . 0))))
(select-frame idlwave-help-frame))
(defun idlwave-help-get-help-buffer ()
diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el
index 38127fccbc3..4bc52247d86 100644
--- a/lisp/progmodes/idlw-shell.el
+++ b/lisp/progmodes/idlw-shell.el
@@ -1,6 +1,6 @@
;; idlw-shell.el --- run IDL as an inferior process of Emacs. -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Authors: JD Smith <jd.smith@utoledo.edu>
;; Carsten Dominik <dominik@astro.uva.nl>
@@ -26,8 +26,7 @@
;;; Commentary:
;;
-;; This mode is for IDL version 5 or later. It should work on
-;; Emacs>20.3 or XEmacs>20.4.
+;; This mode is for IDL version 5 or later.
;;
;; Runs IDL as an inferior process of Emacs, much like the Emacs
;; `shell' or `telnet' commands. Provides command history and
@@ -68,15 +67,6 @@
;; maintainers webpage (see under SOURCE)
;;
;;
-;; KNOWN PROBLEMS
-;; ==============
-;;
-;; Under XEmacs the Debug menu in the shell does not display the
-;; keybindings in the prefix map. There bindings are available anyway - so
-;; it is a bug in XEmacs.
-;; The Debug menu in source buffers *does* display the bindings correctly.
-;;
-;;
;; CUSTOMIZATION VARIABLES
;; =======================
;;
@@ -166,7 +156,6 @@ t Arrows force the cursor back to the current command line and
"Non-nil means, use the debugging toolbar in all IDL related buffers.
Starting the shell will then add the toolbar to all idlwave-mode buffers.
Exiting the shell will removed everywhere.
-Available on XEmacs and on Emacs 21.x or later.
At any time you can toggle the display of the toolbar with
`C-c C-d C-t' (`idlwave-shell-toggle-toolbar')."
:group 'idlwave-shell-general-setup
@@ -606,12 +595,6 @@ the directory stack.")
(defvar idlwave-shell-last-save-and-action-file nil
"The last file which was compiled with `idlwave-shell-save-and-...'.")
-;; Highlighting uses overlays. When necessary, require the emulation.
-(if (not (fboundp 'make-overlay))
- (condition-case nil
- (require 'overlay)
- (error nil)))
-
(defvar idlwave-shell-stop-line-overlay nil
"The overlay for where IDL is currently stopped.")
(defvar idlwave-shell-is-stopped nil)
@@ -967,13 +950,10 @@ IDL has currently stepped.")
(setq idlwave-shell-default-directory default-directory)
(setq idlwave-shell-hide-output nil)
- ;; NB: `make-local-hook' needed for older/alternative Emacs compatibility
- ;; (make-local-hook 'kill-buffer-hook)
(add-hook 'kill-buffer-hook 'idlwave-shell-kill-shell-buffer-confirm
nil 'local)
(add-hook 'kill-buffer-hook 'idlwave-shell-delete-temp-files nil 'local)
(add-hook 'kill-emacs-hook 'idlwave-shell-delete-temp-files)
- (easy-menu-add idlwave-shell-mode-menu idlwave-shell-mode-map)
;; Set the optional comint variables
(when idlwave-shell-comint-settings
@@ -1007,8 +987,6 @@ IDL has currently stepped.")
(set (make-local-variable 'comment-start) ";")
(setq abbrev-mode t)
- ;; NB: `make-local-hook' needed for older/alternative Emacs compatibility
- ;; make-local-hook 'post-command-hook)
(add-hook 'post-command-hook 'idlwave-command-hook nil t)
;; Read the command history?
@@ -2751,6 +2729,7 @@ Runs to the last statement and then steps 1 statement. Use the .out command."
;; Begin terrible hack section -- XEmacs tests for button2 explicitly
;; on drag events, calling drag-n-drop code if detected. Ughhh...
(defun idlwave-default-mouse-track-event-is-with-button (_event _n)
+ (declare (obsolete nil "28.1"))
t)
(define-obsolete-function-alias 'idlwave-xemacs-hack-mouse-track 'ignore "27.1")
@@ -3612,10 +3591,8 @@ Existing overlays are recycled, in order to minimize consumption."
(when use-glyph
(if old-buffers
(setq old-buffers (delq (current-buffer) old-buffers)))
- (if (fboundp 'set-specifier) ;; XEmacs
- (set-specifier left-margin-width (cons (current-buffer) 2))
- (if (< left-margin-width 2)
- (setq left-margin-width 2)))
+ (if (< left-margin-width 2)
+ (setq left-margin-width 2))
(let ((window (get-buffer-window (current-buffer) 0)))
(if window
(set-window-margins
@@ -3623,9 +3600,7 @@ Existing overlays are recycled, in order to minimize consumption."
(if use-glyph
(while (setq buf (pop old-buffers))
(with-current-buffer buf
- (if (fboundp 'set-specifier) ;; XEmacs
- (set-specifier left-margin-width (cons (current-buffer) 0))
- (setq left-margin-width 0))
+ (setq left-margin-width 0)
(let ((window (get-buffer-window buf 0)))
(if window
(set-window-margins
@@ -4352,21 +4327,12 @@ Shell debugging commands are available as single key sequences."
["Toggle Toolbar" idlwave-shell-toggle-toolbar t]
["Exit IDL" idlwave-shell-quit t]))
-(if (or (featurep 'easymenu) (load "easymenu" t))
- (progn
- (easy-menu-define
- idlwave-mode-debug-menu idlwave-mode-map "IDL debugging menus"
- idlwave-shell-menu-def)
- (easy-menu-define
- idlwave-shell-mode-menu idlwave-shell-mode-map "IDL shell menus"
- idlwave-shell-menu-def)
- (save-current-buffer
- (dolist (buf (buffer-list))
- (set-buffer buf)
- (if (derived-mode-p 'idlwave-mode)
- (progn
- (easy-menu-remove idlwave-mode-debug-menu)
- (easy-menu-add idlwave-mode-debug-menu)))))))
+(easy-menu-define
+ idlwave-mode-debug-menu idlwave-mode-map "IDL debugging menus"
+ idlwave-shell-menu-def)
+(easy-menu-define
+ idlwave-shell-mode-menu idlwave-shell-mode-map "IDL shell menus"
+ idlwave-shell-menu-def)
;; The Breakpoint Glyph -------------------------------------------------------
diff --git a/lisp/progmodes/idlw-toolbar.el b/lisp/progmodes/idlw-toolbar.el
index 1866e50d680..4bd0afb2ba1 100644
--- a/lisp/progmodes/idlw-toolbar.el
+++ b/lisp/progmodes/idlw-toolbar.el
@@ -1,6 +1,6 @@
;;; idlw-toolbar.el --- a debugging toolbar for IDLWAVE
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <dominik@astro.uva.nl>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el
index 86f9f336723..c11892492de 100644
--- a/lisp/progmodes/idlwave.el
+++ b/lisp/progmodes/idlwave.el
@@ -1,6 +1,6 @@
;; idlwave.el --- IDL editing mode for GNU Emacs
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Authors: JD Smith <jd.smith@utoledo.edu>
;; Carsten Dominik <dominik@science.uva.nl>
@@ -1355,8 +1355,8 @@ Normally a space.")
(defmacro idlwave-keyword-abbrev (&rest args)
"Creates a function for abbrev hooks to call `idlwave-check-abbrev' with args."
- `(quote (lambda ()
- ,(append '(idlwave-check-abbrev) args))))
+ `(lambda ()
+ ,(append '(idlwave-check-abbrev) args)))
;; If I take the time I can replace idlwave-keyword-abbrev with
;; idlwave-code-abbrev and remove the quoted abbrev check from
@@ -1873,10 +1873,6 @@ The main features of this mode are
(set (make-local-variable 'indent-tabs-mode) nil)
(set (make-local-variable 'completion-ignore-case) t)
- (when (featurep 'easymenu)
- (easy-menu-add idlwave-mode-menu idlwave-mode-map)
- (easy-menu-add idlwave-mode-debug-menu idlwave-mode-map))
-
(setq abbrev-mode t)
(set (make-local-variable idlwave-fill-function) 'idlwave-auto-fill)
@@ -1920,15 +1916,10 @@ The main features of this mode are
'idlwave-forward-block nil))
;; Make a local post-command-hook and add our hook to it
- ;; NB: `make-local-hook' needed for older/alternative Emacs compatibility
- ;; (make-local-hook 'post-command-hook)
(add-hook 'post-command-hook 'idlwave-command-hook nil 'local)
;; Make local hooks for buffer updates
- ;; NB: `make-local-hook' needed for older/alternative Emacs compatibility
- ;; (make-local-hook 'kill-buffer-hook)
(add-hook 'kill-buffer-hook 'idlwave-kill-buffer-update nil 'local)
- ;; (make-local-hook 'after-save-hook)
(add-hook 'after-save-hook 'idlwave-save-buffer-update nil 'local)
(add-hook 'after-save-hook 'idlwave-revoke-license-to-kill nil 'local)
@@ -2781,10 +2772,7 @@ If the optional argument EXPAND is non-nil then the actions in
;; Adjust parallel comment
(end-of-line)
(if (idlwave-in-comment)
- ;; Emacs 21 is too smart with fill-column on comment indent
- (let ((fill-column (if (fboundp 'comment-indent-new-line)
- (1- (frame-width))
- fill-column)))
+ (let ((fill-column (1- (frame-width))))
(indent-for-comment)))))
(goto-char mloc)
;; Get rid of marker
@@ -3996,12 +3984,7 @@ blank lines."
;; skip blank lines
(skip-chars-forward " \t\n")
(if (looking-at (concat "[ \t]*\\(" comment-start "+\\)"))
- (if (fboundp 'uncomment-region)
- (uncomment-region beg end)
- (comment-region beg end
- (- (length (buffer-substring
- (match-beginning 1)
- (match-end 1))))))
+ (uncomment-region beg end)
(comment-region beg end)))))
@@ -4047,11 +4030,6 @@ blank lines."
(defun idlwave-reset-sintern (&optional what)
"Reset all sintern hashes."
;; Make sure the hash functions are accessible.
- (unless (and (fboundp 'gethash)
- (fboundp 'puthash))
- (require 'cl)
- (or (fboundp 'puthash)
- (defalias 'puthash 'cl-puthash)))
(let ((entries '((idlwave-sint-routines 1000 10)
(idlwave-sint-keywords 1000 10)
(idlwave-sint-methods 100 10)
@@ -7642,14 +7620,13 @@ associated TAG, if any."
(defun idlwave-completion-fontify-classes ()
"Goto the *Completions* buffer and fontify the class info."
- (when (featurep 'font-lock)
- (with-current-buffer "*Completions*"
- (save-excursion
- (goto-char (point-min))
- (let ((buffer-read-only nil))
- (while (re-search-forward "\\.*<[^>]+>" nil t)
- (put-text-property (match-beginning 0) (match-end 0)
- 'face 'font-lock-string-face)))))))
+ (with-current-buffer "*Completions*"
+ (save-excursion
+ (goto-char (point-min))
+ (let ((buffer-read-only nil))
+ (while (re-search-forward "\\.*<[^>]+>" nil t)
+ (put-text-property (match-beginning 0) (match-end 0)
+ 'face 'font-lock-string-face))))))
(defun idlwave-uniquify (list)
(let ((ht (make-hash-table :size (length list) :test 'equal)))
@@ -8892,9 +8869,7 @@ Assumes that point is at the beginning of the unit as found by
(let ((begin (point)))
(re-search-forward
"[a-zA-Z_][a-zA-Z0-9$_]+\\(::[a-zA-Z_][a-zA-Z0-9$_]+\\)?")
- (if (fboundp 'buffer-substring-no-properties)
- (buffer-substring-no-properties begin (point))
- (buffer-substring begin (point)))))
+ (buffer-substring-no-properties begin (point))))
(defalias 'idlwave-function-menu
(condition-case nil
@@ -9010,8 +8985,7 @@ Assumes that point is at the beginning of the unit as found by
("Customize"
["Browse IDLWAVE Group" idlwave-customize t]
"--"
- ["Build Full Customize Menu" idlwave-create-customize-menu
- (fboundp 'customize-menu-create)])
+ ["Build Full Customize Menu" idlwave-create-customize-menu t])
("Documentation"
["Describe Mode" describe-mode t]
["Abbreviation List" idlwave-list-abbrevs t]
@@ -9032,14 +9006,12 @@ Assumes that point is at the beginning of the unit as found by
(and (boundp 'idlwave-shell-automatic-start)
idlwave-shell-automatic-start)]))
-(if (or (featurep 'easymenu) (load "easymenu" t))
- (progn
- (easy-menu-define idlwave-mode-menu idlwave-mode-map
- "IDL and WAVE CL editing menu"
- idlwave-mode-menu-def)
- (easy-menu-define idlwave-mode-debug-menu idlwave-mode-map
- "IDL and WAVE CL editing menu"
- idlwave-mode-debug-menu-def)))
+(easy-menu-define idlwave-mode-menu idlwave-mode-map
+ "IDL and WAVE CL editing menu"
+ idlwave-mode-menu-def)
+(easy-menu-define idlwave-mode-debug-menu idlwave-mode-map
+ "IDL and WAVE CL editing menu"
+ idlwave-mode-debug-menu-def)
(defun idlwave-customize ()
"Call the customize function with `idlwave' as argument."
@@ -9053,24 +9025,21 @@ Assumes that point is at the beginning of the unit as found by
(defun idlwave-create-customize-menu ()
"Create a full customization menu for IDLWAVE, insert it into the menu."
(interactive)
- (if (fboundp 'customize-menu-create)
- (progn
- ;; Try to load the code for the shell, so that we can customize it
- ;; as well.
- (or (featurep 'idlw-shell)
- (load "idlw-shell" t))
- (easy-menu-change
- '("IDLWAVE") "Customize"
- `(["Browse IDLWAVE group" idlwave-customize t]
- "--"
- ,(customize-menu-create 'idlwave)
- ["Set" Custom-set t]
- ["Save" Custom-save t]
- ["Reset to Current" Custom-reset-current t]
- ["Reset to Saved" Custom-reset-saved t]
- ["Reset to Standard Settings" Custom-reset-standard t]))
- (message "\"IDLWAVE\"-menu now contains full customization menu"))
- (error "Cannot expand menu (outdated version of cus-edit.el)")))
+ ;; Try to load the code for the shell, so that we can customize it
+ ;; as well.
+ (or (featurep 'idlw-shell)
+ (load "idlw-shell" t))
+ (easy-menu-change
+ '("IDLWAVE") "Customize"
+ `(["Browse IDLWAVE group" idlwave-customize t]
+ "--"
+ ,(customize-menu-create 'idlwave)
+ ["Set" Custom-set t]
+ ["Save" Custom-save t]
+ ["Reset to Current" Custom-reset-current t]
+ ["Reset to Saved" Custom-reset-saved t]
+ ["Reset to Standard Settings" Custom-reset-standard t]))
+ (message "\"IDLWAVE\"-menu now contains full customization menu"))
(defun idlwave-show-commentary ()
"Use the finder to view the file documentation from `idlwave.el'."
diff --git a/lisp/progmodes/inf-lisp.el b/lisp/progmodes/inf-lisp.el
index 59db646ff32..ac230596240 100644
--- a/lisp/progmodes/inf-lisp.el
+++ b/lisp/progmodes/inf-lisp.el
@@ -1,6 +1,6 @@
;;; inf-lisp.el --- an inferior-lisp mode
-;; Copyright (C) 1988, 1993-1994, 2001-2020 Free Software Foundation,
+;; Copyright (C) 1988, 1993-1994, 2001-2021 Free Software Foundation,
;; Inc.
;; Author: Olin Shivers <shivers@cs.cmu.edu>
@@ -124,9 +124,9 @@ mode. Default is whitespace followed by 0 or 1 single-letter colon-keyword
(define-key lisp-mode-map "\C-c\C-v" 'lisp-show-variable-documentation)
-;;; This function exists for backwards compatibility.
-;;; Previous versions of this package bound commands to C-c <letter>
-;;; bindings, which is not allowed by the Emacs standard.
+;; This function exists for backwards compatibility.
+;; Previous versions of this package bound commands to C-c <letter>
+;; bindings, which is not allowed by the Emacs standard.
;;; "This function binds many inferior-lisp commands to C-c <letter> bindings,
;;;where they are more accessible. C-c <letter> bindings are reserved for the
@@ -274,7 +274,8 @@ If you accidentally suspend your process, use \\[comint-continue-subjob]
to continue it."
(setq comint-prompt-regexp inferior-lisp-prompt)
(setq mode-line-process '(":%s"))
- (lisp-mode-variables t)
+ (lisp-mode-variables)
+ (set-syntax-table lisp-mode-syntax-table)
(setq comint-get-old-input (function lisp-get-old-input))
(setq comint-input-filter (function lisp-input-filter)))
diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el
index f3cfbbb948f..33bea59e3ba 100644
--- a/lisp/progmodes/js.el
+++ b/lisp/progmodes/js.el
@@ -1,6 +1,6 @@
;;; js.el --- Major mode for editing JavaScript -*- lexical-binding: t -*-
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Karl Landstrom <karl.landstrom@brgeight.se>
;; Daniel Colascione <dancol@dancol.org>
diff --git a/lisp/progmodes/ld-script.el b/lisp/progmodes/ld-script.el
index b17f255ba6a..c4ea8e158d8 100644
--- a/lisp/progmodes/ld-script.el
+++ b/lisp/progmodes/ld-script.el
@@ -1,6 +1,6 @@
;;; ld-script.el --- GNU linker script editing mode for Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Author: Masatake YAMATO <yamato@redhat.com>
;; Keywords: languages, faces
@@ -173,10 +173,9 @@
;;;###autoload
(define-derived-mode ld-script-mode prog-mode "LD-Script"
"A major mode to edit GNU ld script files"
- (set (make-local-variable 'comment-start) "/* ")
- (set (make-local-variable 'comment-end) " */")
- (set (make-local-variable 'font-lock-defaults)
- '(ld-script-font-lock-keywords nil)))
+ (setq-local comment-start "/* ")
+ (setq-local comment-end " */")
+ (setq-local font-lock-defaults '(ld-script-font-lock-keywords nil)))
(provide 'ld-script)
diff --git a/lisp/progmodes/m4-mode.el b/lisp/progmodes/m4-mode.el
index ec0f425de92..99f4be38721 100644
--- a/lisp/progmodes/m4-mode.el
+++ b/lisp/progmodes/m4-mode.el
@@ -1,6 +1,6 @@
;;; m4-mode.el --- m4 code editing commands for Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1996-1997, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1997, 2001-2021 Free Software Foundation, Inc.
;; Author: Andrew Csillag <drew@thecsillags.com>
;; Keywords: languages, faces
diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el
index ac3d0817097..a0e09f51ce3 100644
--- a/lisp/progmodes/make-mode.el
+++ b/lisp/progmodes/make-mode.el
@@ -1,6 +1,6 @@
;;; make-mode.el --- makefile editing commands for Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1992, 1994, 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 1994, 1999-2021 Free Software Foundation, Inc.
;; Author: Thomas Neumann <tom@smart.bo.open.de>
;; Eric S. Raymond <esr@snark.thyrsus.com>
@@ -343,8 +343,9 @@ not be enclosed in { } or ( )."
"List of keywords understood by gmake.")
(defconst makefile-bsdmake-statements
- '(".elif" ".elifdef" ".elifmake" ".elifndef" ".elifnmake" ".else" ".endfor"
- ".endif" ".for" ".if" ".ifdef" ".ifmake" ".ifndef" ".ifnmake" ".undef")
+ '("elif" "elifdef" "elifmake" "elifndef" "elifnmake" "else" "endfor"
+ "endif" "for" "if" "ifdef" "ifmake" "ifndef" "ifnmake" "poison"
+ "undef" "include")
"List of keywords understood by BSD make.")
(defun makefile-make-font-lock-keywords (var keywords space
@@ -376,8 +377,9 @@ not be enclosed in { } or ( )."
("[^$]\\(\\$[@%*]\\)"
1 'makefile-targets append)
- ;; Fontify conditionals and includes.
- (,(concat "^\\(?: [ \t]*\\)?"
+ ,@(if keywords
+ ;; Fontify conditionals and includes.
+ `((,(concat "^\\(?: [ \t]*\\)?"
(replace-regexp-in-string
" " "[ \t]+"
(if (eq (car keywords) t)
@@ -385,7 +387,7 @@ not be enclosed in { } or ( )."
(regexp-opt (cdr keywords) t))
(regexp-opt keywords t)))
"\\>[ \t]*\\([^: \t\n#]*\\)")
- (1 font-lock-keyword-face) (2 font-lock-variable-name-face))
+ (1 font-lock-keyword-face) (2 font-lock-variable-name-face))))
,@(if negation
`((,negation (1 font-lock-negation-char-face prepend)
@@ -493,13 +495,17 @@ not be enclosed in { } or ( )."
1 'makefile-makepp-perl t)))
(defconst makefile-bsdmake-font-lock-keywords
- (makefile-make-font-lock-keywords
- ;; A lot more could be done for variables here:
- makefile-var-use-regex
- makefile-bsdmake-statements
- t
- "^\\(?: [ \t]*\\)?\\.\\(?:el\\)?if\\(n?\\)\\(?:def\\|make\\)?\\>[ \t]*\\(!?\\)"
- '("^[ \t]*\\.for[ \t].+[ \t]\\(in\\)\\>" 1 font-lock-keyword-face)))
+ (append
+ (makefile-make-font-lock-keywords
+ ;; A lot more could be done for variables here:
+ makefile-var-use-regex
+ nil
+ t
+ "^\\(?: [ \t]*\\)?\\.\\(?:el\\)?if\\(n?\\)\\(?:def\\|make\\)?\\>[ \t]*\\(!?\\)"
+ '("^[ \t]*\\.for[ \t].+[ \t]\\(in\\)\\>" 1 font-lock-keyword-face))
+ `((,(concat "^\\. *" (regexp-opt makefile-bsdmake-statements) "\\>") 0
+ font-lock-keyword-face))))
+
(defconst makefile-imake-font-lock-keywords
(append
@@ -1370,13 +1376,11 @@ Fill comments, backslashed lines, and variable definitions specially."
(goto-char (point-min))
(erase-buffer)
(mapconcat
- (function
- (lambda (item) (insert (makefile-browser-format-target-line (car item) nil) "\n")))
+ (lambda (item) (insert (makefile-browser-format-target-line (car item) nil) "\n"))
targets
"")
(mapconcat
- (function
- (lambda (item) (insert (makefile-browser-format-macro-line (car item) nil) "\n")))
+ (lambda (item) (insert (makefile-browser-format-macro-line (car item) nil) "\n"))
macros
"")
(sort-lines nil (point-min) (point-max))
@@ -1600,20 +1604,19 @@ Checks each target in TARGET-TABLE using
and generates the overview, one line per target name."
(insert
(mapconcat
- (function (lambda (item)
- (let* ((target-name (car item))
- (no-prereqs (not (member target-name prereq-list)))
- (needs-rebuild (or no-prereqs
- (funcall
- makefile-query-one-target-method-function
- target-name
- filename))))
- (format "\t%s%s"
- target-name
- (cond (no-prereqs " .. has no prerequisites")
- (needs-rebuild " .. NEEDS REBUILD")
- (t " .. is up to date"))))
- ))
+ (lambda (item)
+ (let* ((target-name (car item))
+ (no-prereqs (not (member target-name prereq-list)))
+ (needs-rebuild (or no-prereqs
+ (funcall
+ makefile-query-one-target-method-function
+ target-name
+ filename))))
+ (format "\t%s%s"
+ target-name
+ (cond (no-prereqs " .. has no prerequisites")
+ (needs-rebuild " .. NEEDS REBUILD")
+ (t " .. is up to date")))))
target-table "\n"))
(goto-char (point-min))
(delete-file filename)) ; remove the tmpfile
@@ -1687,9 +1690,9 @@ Then prompts for all required parameters."
(defun makefile-prompt-for-gmake-funargs (function-name prompt-list)
(mapconcat
- (function (lambda (one-prompt)
- (read-string (format "[%s] %s: " function-name one-prompt)
- nil)))
+ (lambda (one-prompt)
+ (read-string (format "[%s] %s: " function-name one-prompt)
+ nil))
prompt-list
","))
diff --git a/lisp/progmodes/meta-mode.el b/lisp/progmodes/meta-mode.el
index 4a5d872b790..9da968c8314 100644
--- a/lisp/progmodes/meta-mode.el
+++ b/lisp/progmodes/meta-mode.el
@@ -1,6 +1,6 @@
;;; meta-mode.el --- major mode for editing Metafont or MetaPost sources -*- lexical-binding:t -*-
-;; Copyright (C) 1997, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
;; Author: Ulrik Vieth <vieth@thphy.uni-duesseldorf.de>
;; Version: 1.0
@@ -919,60 +919,55 @@ The environment marked is the one that contains point or follows point."
(define-derived-mode meta-common-mode prog-mode "-Meta-common-"
"Common initialization for Metafont or MetaPost mode."
:abbrev-table meta-mode-abbrev-table
- (set (make-local-variable 'paragraph-start)
- (concat page-delimiter "\\|$"))
- (set (make-local-variable 'paragraph-separate)
- (concat page-delimiter "\\|$"))
+ (setq-local paragraph-start (concat page-delimiter "\\|$"))
+ (setq-local paragraph-separate (concat page-delimiter "\\|$"))
- (set (make-local-variable 'paragraph-ignore-fill-prefix) t)
+ (setq-local paragraph-ignore-fill-prefix t)
- (set (make-local-variable 'comment-start-skip) "%+[ \t\f]*")
- (set (make-local-variable 'comment-start) "%")
- (set (make-local-variable 'comment-end) "")
- (set (make-local-variable 'comment-multi-line) nil)
+ (setq-local comment-start-skip "%+[ \t\f]*")
+ (setq-local comment-start "%")
+ (setq-local comment-end "")
+ (setq-local comment-multi-line nil)
;; We use `back-to-indentation' but \f is no indentation sign.
(modify-syntax-entry ?\f "_ ")
- (set (make-local-variable 'parse-sexp-ignore-comments) t)
+ (setq-local parse-sexp-ignore-comments t)
(add-hook 'completion-at-point-functions #'meta-completions-at-point nil t)
- (set (make-local-variable 'comment-indent-function) #'meta-comment-indent)
- (set (make-local-variable 'indent-line-function) #'meta-indent-line)
+ (setq-local comment-indent-function #'meta-comment-indent)
+ (setq-local indent-line-function #'meta-indent-line)
;; No need to define a mode-specific 'indent-region-function.
;; Simply use the generic 'indent-region and 'comment-region.
;; Set defaults for font-lock mode.
- (set (make-local-variable 'font-lock-defaults)
- '(meta-font-lock-keywords
- nil nil ((?_ . "w")) nil
- (font-lock-comment-start-regexp . "%")))
-
- ;; Activate syntax table, keymap and menu.
- (easy-menu-add meta-mode-menu))
+ (setq-local font-lock-defaults
+ '(meta-font-lock-keywords
+ nil nil ((?_ . "w")) nil
+ (font-lock-comment-start-regexp . "%"))))
;;;###autoload
(define-derived-mode metafont-mode meta-common-mode "Metafont"
"Major mode for editing Metafont sources."
;; Set defaults for completion function.
- (set (make-local-variable 'meta-symbol-list) nil)
- (set (make-local-variable 'meta-symbol-changed) nil)
+ (setq-local meta-symbol-list nil)
+ (setq-local meta-symbol-changed nil)
(apply 'meta-add-symbols metafont-symbol-list)
- (set (make-local-variable 'meta-complete-list)
- (list (list "\\<\\(\\sw+\\)" 1 'meta-symbol-list)
- (list "" 'ispell-complete-word))))
+ (setq-local meta-complete-list
+ (list (list "\\<\\(\\sw+\\)" 1 'meta-symbol-list)
+ (list "" 'ispell-complete-word))))
;;;###autoload
(define-derived-mode metapost-mode meta-common-mode "MetaPost"
"Major mode for editing MetaPost sources."
;; Set defaults for completion function.
- (set (make-local-variable 'meta-symbol-list) nil)
- (set (make-local-variable 'meta-symbol-changed) nil)
+ (setq-local meta-symbol-list nil)
+ (setq-local meta-symbol-changed nil)
(apply 'meta-add-symbols metapost-symbol-list)
- (set (make-local-variable 'meta-complete-list)
- (list (list "\\<\\(\\sw+\\)" 1 'meta-symbol-list)
- (list "" 'ispell-complete-word))))
+ (setq-local meta-complete-list
+ (list (list "\\<\\(\\sw+\\)" 1 'meta-symbol-list)
+ (list "" 'ispell-complete-word))))
;;; Just in case ...
diff --git a/lisp/progmodes/mixal-mode.el b/lisp/progmodes/mixal-mode.el
index b9f60598f63..59e87b87411 100644
--- a/lisp/progmodes/mixal-mode.el
+++ b/lisp/progmodes/mixal-mode.el
@@ -1,6 +1,6 @@
;;; mixal-mode.el --- Major mode for the mix asm language. -*- lexical-binding:t -*-
-;; Copyright (C) 2003-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
;; Author: Pieter E.J. Pareit <pieter.pareit@gmail.com>
;; Maintainer: Jose A Ortega Ruiz <jao@gnu.org>
@@ -1141,18 +1141,18 @@ Assumes that file has been compiled with debugging support."
;;;###autoload
(define-derived-mode mixal-mode prog-mode "mixal"
"Major mode for the mixal asm language."
- (set (make-local-variable 'comment-start) "*")
- (set (make-local-variable 'comment-start-skip) "^\\*[ \t]*")
- (set (make-local-variable 'font-lock-defaults)
- '(mixal-font-lock-keywords))
- (set (make-local-variable 'syntax-propertize-function)
- mixal-syntax-propertize-function)
+ (setq-local comment-start "*")
+ (setq-local comment-start-skip "^\\*[ \t]*")
+ (setq-local font-lock-defaults
+ '(mixal-font-lock-keywords))
+ (setq-local syntax-propertize-function
+ mixal-syntax-propertize-function)
;; might add an indent function in the future
- ;; (set (make-local-variable 'indent-line-function) 'mixal-indent-line)
- (set (make-local-variable 'compile-command)
- (concat "mixasm "
- (if buffer-file-name
- (shell-quote-argument buffer-file-name)))))
+ ;; (setq-local indent-line-function 'mixal-indent-line)
+ (setq-local compile-command
+ (concat "mixasm "
+ (if buffer-file-name
+ (shell-quote-argument buffer-file-name)))))
(provide 'mixal-mode)
diff --git a/lisp/progmodes/modula2.el b/lisp/progmodes/modula2.el
index aa412304c59..a77a4e2b216 100644
--- a/lisp/progmodes/modula2.el
+++ b/lisp/progmodes/modula2.el
@@ -308,14 +308,14 @@ followed by the first character of the construct.
`m2-indent' controls the number of spaces for each indentation.
`m2-compile-command' holds the command to compile a Modula-2 program.
`m2-link-command' holds the command to link a Modula-2 program."
- (set (make-local-variable 'paragraph-start) (concat "$\\|" page-delimiter))
- (set (make-local-variable 'paragraph-separate) paragraph-start)
- (set (make-local-variable 'paragraph-ignore-fill-prefix) t)
- (set (make-local-variable 'comment-start) "(* ")
- (set (make-local-variable 'comment-end) " *)")
- (set (make-local-variable 'comment-start-skip) "\\(?:(\\*+\\|//+\\) *")
- (set (make-local-variable 'parse-sexp-ignore-comments) t)
- (set (make-local-variable 'font-lock-defaults)
+ (setq-local paragraph-start (concat "$\\|" page-delimiter))
+ (setq-local paragraph-separate paragraph-start)
+ (setq-local paragraph-ignore-fill-prefix t)
+ (setq-local comment-start "(* ")
+ (setq-local comment-end " *)")
+ (setq-local comment-start-skip "\\(?:(\\*+\\|//+\\) *")
+ (setq-local parse-sexp-ignore-comments t)
+ (setq-local font-lock-defaults
'((m3-font-lock-keywords
m3-font-lock-keywords-1 m3-font-lock-keywords-2)
nil nil ((?_ . "w") (?. . "w") (?< . ". 1") (?> . ". 4")) nil
diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el
index 55a78c6cc85..a14a8d75a78 100644
--- a/lisp/progmodes/octave.el
+++ b/lisp/progmodes/octave.el
@@ -1,6 +1,6 @@
;;; octave.el --- editing octave source files under emacs -*- lexical-binding: t; -*-
-;; Copyright (C) 1997, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
;; Author: Kurt Hornik <Kurt.Hornik@wu-wien.ac.at>
;; John Eaton <jwe@octave.org>
@@ -619,9 +619,7 @@ Key bindings:
(add-hook 'before-save-hook 'octave-sync-function-file-names nil t)
(setq-local beginning-of-defun-function 'octave-beginning-of-defun)
(and octave-font-lock-texinfo-comment (octave-font-lock-texinfo-comment))
- (add-hook 'eldoc-documentation-functions 'octave-eldoc-function nil t)
-
- (easy-menu-add octave-mode-menu))
+ (add-hook 'eldoc-documentation-functions 'octave-eldoc-function nil t))
(defcustom inferior-octave-program "octave"
@@ -1514,28 +1512,12 @@ current buffer file unless called with a prefix arg \\[universal-argument]."
(interactive "r")
(inferior-octave t)
(let ((proc inferior-octave-process)
- (string (buffer-substring-no-properties beg end))
- line)
+ (string (buffer-substring-no-properties beg end)))
(with-current-buffer inferior-octave-buffer
;; https://lists.gnu.org/r/emacs-devel/2013-10/msg00095.html
(compilation-forget-errors)
- (setq inferior-octave-output-list nil)
- (while (not (string-equal string ""))
- (if (string-match "\n" string)
- (setq line (substring string 0 (match-beginning 0))
- string (substring string (match-end 0)))
- (setq line string string ""))
- (setq inferior-octave-receive-in-progress t)
- (inferior-octave-send-list-and-digest (list (concat line "\n")))
- (while inferior-octave-receive-in-progress
- (accept-process-output proc))
- (insert-before-markers
- (mapconcat 'identity
- (append
- (if octave-send-echo-input (list line) (list ""))
- inferior-octave-output-list
- (list inferior-octave-output-string))
- "\n")))))
+ (insert-before-markers string "\n")
+ (comint-send-string proc (concat string "\n"))))
(if octave-send-show-buffer
(display-buffer inferior-octave-buffer)))
@@ -1607,8 +1589,9 @@ code line."
(defun octave-eldoc-function-signatures (fn)
(unless (equal fn (car octave-eldoc-cache))
- (inferior-octave-send-list-and-digest
- (list (format "print_usage ('%s');\n" fn)))
+ (while-no-input
+ (inferior-octave-send-list-and-digest
+ (list (format "print_usage ('%s');\n" fn))))
(let (result)
(dolist (line inferior-octave-output-list)
;; The help output has changed a few times in GNU Octave.
diff --git a/lisp/progmodes/opascal.el b/lisp/progmodes/opascal.el
index 8c060991f42..662d2b4b74f 100644
--- a/lisp/progmodes/opascal.el
+++ b/lisp/progmodes/opascal.el
@@ -1,6 +1,6 @@
;;; opascal.el --- major mode for editing Object Pascal source in Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1998-1999, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-1999, 2001-2021 Free Software Foundation, Inc.
;; Authors: Ray Blaak <blaak@infomatch.com>,
;; Simon South <ssouth@member.fsf.org>
diff --git a/lisp/progmodes/pascal.el b/lisp/progmodes/pascal.el
index fce059bafc7..59f90d7293b 100644
--- a/lisp/progmodes/pascal.el
+++ b/lisp/progmodes/pascal.el
@@ -1,6 +1,6 @@
;;; pascal.el --- major mode for editing pascal source in Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1993-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993-2021 Free Software Foundation, Inc.
;; Author: Espen Skoglund <esk@gnu.org>
;; Keywords: languages
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index 7265aeee45d..d047dd543c2 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -1,6 +1,6 @@
;;; perl-mode.el --- Perl code editing commands for GNU Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1990, 1994, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1990, 1994, 2001-2021 Free Software Foundation, Inc.
;; Author: William F. Mann
;; Maintainer: emacs-devel@gnu.org
@@ -95,6 +95,12 @@
:prefix "perl-"
:group 'languages)
+(defface perl-non-scalar-variable
+ '((t :inherit font-lock-variable-name-face :underline t))
+ "Face used for non-scalar variables."
+ :version "28.1"
+ :group 'perl)
+
(defvar perl-mode-abbrev-table nil
"Abbrev table in use in perl-mode buffers.")
(define-abbrev-table 'perl-mode-abbrev-table ())
@@ -187,11 +193,12 @@
;;
;; Fontify function, variable and file name references.
("&\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-function-name-face)
- ;; Additionally underline non-scalar variables. Maybe this is a bad idea.
+ ;; Additionally fontify non-scalar variables. `perl-non-scalar-variable'
+ ;; will underline them by default.
;;'("[$@%*][#{]?\\(\\sw+\\)" 1 font-lock-variable-name-face)
("[$*]{?\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-variable-name-face)
("\\([@%]\\|\\$#\\)\\(\\sw+\\(::\\sw+\\)*\\)"
- (2 (cons font-lock-variable-name-face '(underline))))
+ (2 'perl-non-scalar-variable))
("<\\(\\sw+\\)>" 1 font-lock-constant-face)
;;
;; Fontify keywords with/and labels as we do in `c++-font-lock-keywords'.
@@ -209,7 +216,7 @@
(eval-and-compile
(defconst perl--syntax-exp-intro-keywords
'("split" "if" "unless" "until" "while" "print"
- "grep" "map" "not" "or" "and" "for" "foreach"))
+ "grep" "map" "not" "or" "and" "for" "foreach" "return"))
(defconst perl--syntax-exp-intro-regexp
(concat "\\(?:\\(?:^\\|[^$@&%[:word:]]\\)"
@@ -299,12 +306,21 @@
;; $a = "foo y \"toto\" bar" where we'd end up changing the
;; syntax of the backslash and hence de-escaping the embedded
;; double quote.
- (put-text-property (match-beginning 3) (match-end 3)
- 'syntax-table
- (if (assoc (char-after (match-beginning 3))
- perl-quote-like-pairs)
- (string-to-syntax "|")
- (string-to-syntax "\"")))
+ (let* ((b3 (match-beginning 3))
+ (c (char-after b3)))
+ (put-text-property
+ b3 (match-end 3) 'syntax-table
+ (cond
+ ((assoc c perl-quote-like-pairs)
+ (string-to-syntax "|"))
+ ;; If the separator is a normal quote and the operation
+ ;; only takes a single arg, then there's nothing
+ ;; special to do.
+ ((and (memq c '(?\" ?\'))
+ (memq (char-after (match-beginning 2)) '(?m ?q)))
+ nil)
+ (t
+ (string-to-syntax "\"")))))
(perl-syntax-propertize-special-constructs end))))))
;; Here documents.
((concat
@@ -315,13 +331,33 @@
;; disambiguate with the left-bitshift operator.
"\\|" perl--syntax-exp-intro-regexp "<<\\(?2:\\sw+\\)\\)"
".*\\(\n\\)")
- (4 (let* ((st (get-text-property (match-beginning 4) 'syntax-table))
+ (4 (let* ((eol (match-beginning 4))
+ (st (get-text-property eol 'syntax-table))
(name (match-string 2))
(indented (match-beginning 1)))
(goto-char (match-end 2))
(if (save-excursion (nth 8 (syntax-ppss (match-beginning 0))))
+ ;; '<<' occurred in a string, or in a comment.
;; Leave the property of the newline unchanged.
st
+ ;; Beware of `foo <<'BAR' #baz` because
+ ;; the newline needs to start the here-doc
+ ;; and can't be used to close the comment.
+ (let ((eol-state (save-excursion (syntax-ppss eol))))
+ (when (nth 4 eol-state)
+ (if (/= (1- eol) (nth 8 eol-state))
+ ;; make the last char of the comment closing it
+ (put-text-property (1- eol) eol
+ 'syntax-table (string-to-syntax ">"))
+ ;; In `foo <<'BAR' #` the # is the last character
+ ;; before eol and can't both open and close the
+ ;; comment. Workaround: disguise the "#" as
+ ;; whitespace and fontify it as a comment.
+ (put-text-property (1- eol) eol
+ 'syntax-table (string-to-syntax "-"))
+ (put-text-property (1- eol) eol
+ 'font-lock-face
+ 'font-lock-comment-face))))
(cons (car (string-to-syntax "< c"))
;; Remember the names of heredocs found on this line.
(cons (cons (pcase (aref name 0)
@@ -379,7 +415,8 @@
(put-text-property (1- (point)) (point) 'syntax-table
(string-to-syntax "> c"))))))
((or (null (setq char (nth 3 state)))
- (and (characterp char) (eq (char-syntax (nth 3 state)) ?\")))
+ (and (characterp char)
+ (null (get-text-property (nth 8 state) 'syntax-table))))
;; Normal text, or comment, or docstring, or normal string.
nil)
((eq (nth 3 state) ?\n)
@@ -400,6 +437,7 @@
(point)))
'("tr" "s" "y"))))
(close (cdr (assq char perl-quote-like-pairs)))
+ (middle nil)
(st (perl-quote-syntax-table char)))
(when (with-syntax-table st
(if close
@@ -430,6 +468,7 @@
;; In the case of s{...}{...}, we only handle the
;; first part here and the next below.
(when (and twoargs (not close))
+ (setq middle (point))
(nth 8 (parse-partial-sexp
(point) limit
nil nil state 'syntax-table)))))))
@@ -437,11 +476,14 @@
(when (eq (char-before (1- (point))) ?$)
(put-text-property (- (point) 2) (1- (point))
'syntax-table '(1)))
- (put-text-property (1- (point)) (point)
- 'syntax-table
- (if close
- (string-to-syntax "|")
- (string-to-syntax "\"")))
+ (if (and middle (memq char '(?\" ?\')))
+ (put-text-property (1- middle) middle
+ 'syntax-table '(1))
+ (put-text-property (1- (point)) (point)
+ 'syntax-table
+ (if close
+ (string-to-syntax "|")
+ (string-to-syntax "\""))))
;; If we have two args with a non-self-paired starter (e.g.
;; s{...}{...}) we're right after the first arg, so we still have to
;; handle the second part.
@@ -468,8 +510,15 @@
;; as twoarg).
(perl-syntax-propertize-special-constructs limit)))))))))
+(defface perl-heredoc
+ '((t (:inherit font-lock-string-face)))
+ "The face for here-documents. Inherits from font-lock-string-face.")
+
(defun perl-font-lock-syntactic-face-function (state)
(cond
+ ((and (eq 2 (nth 7 state)) ; c-style comment
+ (cdr-safe (get-text-property (nth 8 state) 'syntax-table))) ; HERE doc
+ 'perl-heredoc)
((and (nth 3 state)
(eq ?e (cdr-safe (get-text-property (nth 8 state) 'syntax-table)))
;; This is a second-arg of s{..}{...} form; let's check if this second
diff --git a/lisp/progmodes/prog-mode.el b/lisp/progmodes/prog-mode.el
index d3d3deae4b1..d88d3505586 100644
--- a/lisp/progmodes/prog-mode.el
+++ b/lisp/progmodes/prog-mode.el
@@ -1,6 +1,6 @@
;;; prog-mode.el --- Generic major mode for programming -*- lexical-binding: t -*-
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 8f7482a23d7..18124227d1b 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -1,7 +1,7 @@
;;; project.el --- Operations on the current project -*- lexical-binding: t; -*-
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
-;; Version: 0.5.2
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
+;; Version: 0.5.3
;; Package-Requires: ((emacs "26.3") (xref "1.0.2"))
;; This is a GNU ELPA :core package. Avoid using functionality that
@@ -291,7 +291,8 @@ to find the list of ignores for each directory."
(localdir (file-local-name (expand-file-name dir)))
(command (format "%s %s %s -type f %s -print0"
find-program
- localdir
+ ;; In case DIR is a symlink.
+ (file-name-as-directory localdir)
(xref--find-ignores-arguments ignores localdir)
(if files
(concat (shell-quote-argument "(")
@@ -301,8 +302,8 @@ to find the list of ignores for each directory."
(split-string files)
(concat " -o " find-name-arg " "))
" "
- (shell-quote-argument ")"))"")
- )))
+ (shell-quote-argument ")"))
+ ""))))
(project--remote-file-names
(sort (split-string (shell-command-to-string command) "\0" t)
#'string<))))
@@ -322,7 +323,7 @@ to find the list of ignores for each directory."
:group 'project)
(defcustom project-vc-ignores nil
- "List of patterns to include in `project-ignores'."
+ "List of patterns to add to `project-ignores'."
:type '(repeat string)
:safe #'listp)
@@ -434,16 +435,17 @@ backend implementation of `project-external-roots'.")
(cl-defmethod project-files ((project (head vc)) &optional dirs)
(mapcan
(lambda (dir)
- (let (backend)
+ (let ((ignores (project--value-in-dir 'project-vc-ignores dir))
+ backend)
(if (and (file-equal-p dir (cdr project))
(setq backend (vc-responsible-backend dir))
(cond
((eq backend 'Hg))
((and (eq backend 'Git)
(or
- (not project-vc-ignores)
+ (not ignores)
(version<= "1.9" (vc-git--program-version)))))))
- (project--vc-list-files dir backend project-vc-ignores)
+ (project--vc-list-files dir backend ignores)
(project--files-in-directory
dir
(project--dir-ignores project dir)))))
@@ -467,9 +469,26 @@ backend implementation of `project-external-roots'.")
(cons "--"
(mapcar
(lambda (i)
- (if (string-match "\\./" i)
- (format ":!/:%s" (substring i 2))
- (format ":!:%s" i)))
+ (format
+ ":(exclude,glob,top)%s"
+ (if (string-match "\\*\\*" i)
+ ;; Looks like pathspec glob
+ ;; format already.
+ i
+ (if (string-match "\\./" i)
+ ;; ./abc -> abc
+ (setq i (substring i 2))
+ ;; abc -> **/abc
+ (setq i (concat "**/" i))
+ ;; FIXME: '**/abc' should also
+ ;; match a directory with that
+ ;; name, but doesn't (git 2.25.1).
+ ;; Maybe we should replace
+ ;; such entries with two.
+ (if (string-match "/\\'" i)
+ ;; abc/ -> abc/**
+ (setq i (concat i "**"))))
+ i)))
extra-ignores)))))
(setq files
(mapcar
@@ -534,12 +553,26 @@ backend implementation of `project-external-roots'.")
(append
(when (file-equal-p dir root)
(setq backend (vc-responsible-backend root))
- (mapcar
- (lambda (entry)
- (if (string-match "\\`/" entry)
- (replace-match "./" t t entry)
- entry))
- (vc-call-backend backend 'ignore-completion-table root)))
+ (delq
+ nil
+ (mapcar
+ (lambda (entry)
+ (cond
+ ((eq ?! (aref entry 0))
+ ;; No support for whitelisting (yet).
+ nil)
+ ((string-match "\\(/\\)[^/]" entry)
+ ;; FIXME: This seems to be Git-specific.
+ ;; And / in the entry (start or even the middle) means
+ ;; the pattern is "rooted". Or actually it is then
+ ;; relative to its respective .gitignore (of which there
+ ;; could be several), but we only support .gitignore at
+ ;; the root.
+ (if (= (match-beginning 0) 0)
+ (replace-match "./" t t entry 1)
+ (concat "./" entry)))
+ (t entry)))
+ (vc-call-backend backend 'ignore-completion-table root))))
(project--value-in-dir 'project-vc-ignores root)
(mapcar
(lambda (dir)
@@ -599,6 +632,7 @@ DIRS must contain directory names."
(define-key map "g" 'project-find-regexp)
(define-key map "G" 'project-or-external-find-regexp)
(define-key map "r" 'project-query-replace-regexp)
+ (define-key map "x" 'project-execute-extended-command)
map)
"Keymap for project commands.")
@@ -745,8 +779,9 @@ pattern to search for."
;;;###autoload
(defun project-find-file ()
"Visit a file (with completion) in the current project.
-The completion default is the filename at point, if one is
-recognized."
+
+The completion default is the filename at point, determined by
+`thing-at-point' (whether such file exists or not)."
(interactive)
(let* ((pr (project-current t))
(dirs (list (project-root pr))))
@@ -755,8 +790,9 @@ recognized."
;;;###autoload
(defun project-or-external-find-file ()
"Visit a file (with completion) in the current project or external roots.
-The completion default is the filename at point, if one is
-recognized."
+
+The completion default is the filename at point, determined by
+`thing-at-point' (whether such file exists or not)."
(interactive)
(let* ((pr (project-current t))
(dirs (cons
@@ -893,6 +929,7 @@ if one already exists."
(defun project-async-shell-command ()
"Run `async-shell-command' in the current project's root directory."
(interactive)
+ (declare (interactive-only async-shell-command))
(let ((default-directory (project-root (project-current t))))
(call-interactively #'async-shell-command)))
@@ -900,6 +937,7 @@ if one already exists."
(defun project-shell-command ()
"Run `shell-command' in the current project's root directory."
(interactive)
+ (declare (interactive-only shell-command))
(let ((default-directory (project-root (project-current t))))
(call-interactively #'shell-command)))
@@ -934,20 +972,12 @@ loop using the command \\[fileloop-continue]."
(declare-function compilation-read-command "compile")
;;;###autoload
-(defun project-compile (command &optional comint)
- "Run `compile' in the project root.
-Arguments the same as in `compile'."
- (interactive
- (list
- (let ((command (eval compile-command)))
- (require 'compile)
- (if (or compilation-read-command current-prefix-arg)
- (compilation-read-command command)
- command))
- (consp current-prefix-arg)))
- (let* ((pr (project-current t))
- (default-directory (project-root pr)))
- (compile command comint)))
+(defun project-compile ()
+ "Run `compile' in the project root."
+ (interactive)
+ (declare (interactive-only compile))
+ (let ((default-directory (project-root (project-current t))))
+ (call-interactively #'compile)))
(defun project--read-project-buffer ()
(let* ((pr (project-current t))
@@ -1160,7 +1190,9 @@ With some possible metadata (to be decided).")
(let ((filename project-list-file))
(with-temp-buffer
(insert ";;; -*- lisp-data -*-\n")
- (pp project--list (current-buffer))
+ (let ((print-length nil)
+ (print-level nil))
+ (pp project--list (current-buffer)))
(write-region nil nil filename nil 'silent))))
;;;###autoload
@@ -1210,48 +1242,104 @@ It's also possible to enter an arbitrary directory not in the list."
(project--ensure-read-project-list)
(mapcar #'car project--list))
+;;;###autoload
+(defun project-execute-extended-command ()
+ "Execute an extended command in project root."
+ (declare (interactive-only command-execute))
+ (interactive)
+ (let ((default-directory (project-root (project-current t))))
+ (call-interactively #'execute-extended-command)))
+
;;; Project switching
;;;###autoload
-(defvar project-switch-commands
- '((?f "Find file" project-find-file)
- (?g "Find regexp" project-find-regexp)
- (?d "Dired" project-dired)
- (?v "VC-Dir" project-vc-dir)
- (?e "Eshell" project-eshell))
- "Alist mapping keys to project switching menu entries.
+(defcustom project-switch-commands
+ '((project-find-file "Find file")
+ (project-find-regexp "Find regexp")
+ (project-dired "Dired")
+ (project-vc-dir "VC-Dir")
+ (project-eshell "Eshell"))
+ "Alist mapping commands to descriptions.
Used by `project-switch-project' to construct a dispatch menu of
commands available upon \"switching\" to another project.
-Each element is of the form (KEY LABEL COMMAND), where COMMAND is the
-command to run when KEY is pressed. LABEL is used to distinguish
-the menu entries in the dispatch menu.")
+Each element is of the form (COMMAND LABEL &optional KEY) where
+COMMAND is the command to run when KEY is pressed. LABEL is used
+to distinguish the menu entries in the dispatch menu. If KEY is
+absent, COMMAND must be bound in `project-prefix-map', and the
+key is looked up in that map."
+ :version "28.1"
+ :package-version '(project . "0.6.0")
+ :type '(repeat
+ (list
+ (symbol :tag "Command")
+ (string :tag "Label")
+ (choice :tag "Key to press"
+ (const :tag "Infer from the keymap" nil)
+ (character :tag "Explicit key")))))
+
+(defcustom project-switch-use-entire-map nil
+ "Make `project-switch-project' use entire `project-prefix-map'.
+If nil, `project-switch-project' will only recognize commands
+listed in `project-switch-commands' and signal an error when
+others are invoked. Otherwise, all keys in `project-prefix-map'
+are legal even if they aren't listed in the dispatch menu."
+ :type 'boolean
+ :version "28.1")
(defun project--keymap-prompt ()
"Return a prompt for the project switching dispatch menu."
(mapconcat
- (pcase-lambda (`(,key ,label))
- (format "[%s] %s"
- (propertize (key-description `(,key)) 'face 'bold)
- label))
+ (pcase-lambda (`(,cmd ,label ,key))
+ (when (characterp cmd) ; Old format, apparently user-customized.
+ (let ((tmp cmd))
+ ;; TODO: Add a deprecation warning, probably.
+ (setq cmd key
+ key tmp)))
+ (let ((key (if key
+ (vector key)
+ (where-is-internal cmd project-prefix-map t))))
+ (format "[%s] %s"
+ (propertize (key-description key) 'face 'bold)
+ label)))
project-switch-commands
" "))
;;;###autoload
-(defun project-switch-project ()
+(defun project-switch-project (dir)
"\"Switch\" to another project by running an Emacs command.
The available commands are presented as a dispatch menu
-made from `project-switch-commands'."
- (interactive)
- (let ((dir (project-prompt-project-dir))
- (choice nil))
- (while (not choice)
- (setq choice (assq (read-event (project--keymap-prompt))
- project-switch-commands)))
+made from `project-switch-commands'.
+
+When called in a program, it will use the project corresponding
+to directory DIR."
+ (interactive (list (project-prompt-project-dir)))
+ (let ((commands-menu
+ (mapcar
+ (lambda (row)
+ (if (characterp (car row))
+ ;; Deprecated format.
+ ;; XXX: Add a warning about it?
+ (reverse row)
+ row))
+ project-switch-commands))
+ command)
+ (while (not command)
+ (let ((choice (read-event (project--keymap-prompt))))
+ (when (setq command
+ (or (car
+ (seq-find (lambda (row) (equal choice (nth 2 row)))
+ commands-menu))
+ (lookup-key project-prefix-map (vector choice))))
+ (unless (or project-switch-use-entire-map
+ (assq command commands-menu))
+ ;; TODO: Add some hint to the prompt, like "key not
+ ;; recognized" or something.
+ (setq command nil)))))
(let ((default-directory dir)
(project-current-inhibit-prompt t))
- (call-interactively (nth 2 choice)))))
+ (call-interactively command))))
(provide 'project)
;;; project.el ends here
diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el
index 124f652ed69..9f5f9ed6d3d 100644
--- a/lisp/progmodes/prolog.el
+++ b/lisp/progmodes/prolog.el
@@ -1,6 +1,6 @@
;;; prolog.el --- major mode for Prolog (and Mercury) -*- lexical-binding:t -*-
-;; Copyright (C) 1986-1987, 1997-1999, 2002-2003, 2011-2020 Free
+;; Copyright (C) 1986-1987, 1997-1999, 2002-2003, 2011-2021 Free
;; Software Foundation, Inc.
;; Authors: Emil Åström <emil_astrom(at)hotmail(dot)com>
@@ -261,7 +261,6 @@
(require 'comint)
(eval-when-compile
- (require 'font-lock)
;; We need imenu everywhere because of the predicate index!
(require 'imenu)
;)
@@ -1202,7 +1201,9 @@ Commands:
(define-derived-mode mercury-mode prolog-mode "Prolog[Mercury]"
"Major mode for editing Mercury programs.
Actually this is just customized `prolog-mode'."
- (setq-local prolog-system 'mercury))
+ (setq-local prolog-system 'mercury)
+ ;; Run once more to set up based on `prolog-system'
+ (prolog-mode-variables))
;;-------------------------------------------------------------------
@@ -1293,8 +1294,7 @@ To find out what version of Prolog mode you are running, enter
(setq-local shell-dirstack-query "pwd.")
(setq-local compilation-error-regexp-alist
prolog-inferior-error-regexp-alist)
- (compilation-shell-minor-mode)
- (prolog-inferior-menu))
+ (compilation-shell-minor-mode))
(defun prolog-input-filter (str)
(cond ((string-match "\\`\\s *\\'" str) nil) ;whitespace
@@ -1883,8 +1883,6 @@ Argument BOUND is a buffer position limiting searching."
;; Set everything up
(defun prolog-font-lock-keywords ()
"Set up font lock keywords for the current Prolog system."
- ;;(when window-system
- (require 'font-lock)
;; Define Prolog faces
(defface prolog-redo-face
@@ -2086,7 +2084,7 @@ Argument BOUND is a buffer position limiting searching."
(delq
nil
(cond
- ((eq major-mode 'prolog-mode)
+ ((derived-mode-p 'prolog-mode)
(list
head-predicates
head-predicates-1
@@ -3381,9 +3379,6 @@ PREFIX is the prefix of the search regexp."
(defun prolog-menu ()
"Add the menus for the Prolog editing buffers."
- (easy-menu-add prolog-edit-menu-insert-move)
- (easy-menu-add prolog-edit-menu-runtime)
-
;; Add predicate index menu
(setq-local imenu-create-index-function
'imenu-default-create-index-function)
@@ -3394,9 +3389,7 @@ PREFIX is the prefix of the search regexp."
(if (and prolog-imenu-flag
(< (count-lines (point-min) (point-max)) prolog-imenu-max-lines))
- (imenu-add-to-menubar "Predicates"))
-
- (easy-menu-add prolog-menu-help))
+ (imenu-add-to-menubar "Predicates")))
(easy-menu-define
prolog-inferior-menu-all prolog-inferior-mode-map
@@ -3439,8 +3432,8 @@ PREFIX is the prefix of the search regexp."
"Create the menus for the Prolog inferior buffer.
This menu is dynamically created because one may change systems during
the life of an Emacs session."
- (easy-menu-add prolog-inferior-menu-all)
- (easy-menu-add prolog-menu-help))
+ (declare (obsolete nil "28.1"))
+ nil)
(defun prolog-mode-version ()
"Echo the current version of Prolog mode in the minibuffer."
diff --git a/lisp/progmodes/ps-mode.el b/lisp/progmodes/ps-mode.el
index 6db7a14a241..15fd2e84393 100644
--- a/lisp/progmodes/ps-mode.el
+++ b/lisp/progmodes/ps-mode.el
@@ -1,6 +1,6 @@
;;; ps-mode.el --- PostScript mode for GNU Emacs
-;; Copyright (C) 1999, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2001-2021 Free Software Foundation, Inc.
;; Author: Peter Kleiweg <p.c.j.kleiweg@rug.nl>
;; Created: 20 Aug 1997
@@ -501,18 +501,18 @@ point to the corresponding spot in the PostScript window, if input
to the interpreter was sent from that window.
Typing \\<ps-run-mode-map>\\[ps-run-goto-error] when the cursor is at the number has the same effect."
(setq-local syntax-propertize-function #'ps-mode-syntax-propertize)
- (set (make-local-variable 'font-lock-defaults)
- '((ps-mode-font-lock-keywords
- ps-mode-font-lock-keywords-1
- ps-mode-font-lock-keywords-2
- ps-mode-font-lock-keywords-3)
- nil))
+ (setq-local font-lock-defaults
+ '((ps-mode-font-lock-keywords
+ ps-mode-font-lock-keywords-1
+ ps-mode-font-lock-keywords-2
+ ps-mode-font-lock-keywords-3)
+ nil))
(smie-setup nil #'ps-mode-smie-rules)
(setq-local electric-indent-chars
(append '(?> ?\] ?\}) electric-indent-chars))
- (set (make-local-variable 'comment-start) "%")
+ (setq-local comment-start "%")
;; NOTE: `\' has a special meaning in strings only
- (set (make-local-variable 'comment-start-skip) "%+[ \t]*")
+ (setq-local comment-start-skip "%+[ \t]*")
;; enable doc-view-minor-mode => C-c C-c starts viewing the current ps file
;; with doc-view-mode.
(doc-view-minor-mode 1))
@@ -910,11 +910,11 @@ plus the usually uncoded characters inserted on positions 1 through 28."
(define-derived-mode ps-run-mode comint-mode "Interactive PS"
"Major mode in interactive PostScript window.
This mode is invoked from `ps-mode' and should not be called directly."
- (set (make-local-variable 'font-lock-defaults)
- '((ps-run-font-lock-keywords
- ps-run-font-lock-keywords-1
- ps-run-font-lock-keywords-2)
- t))
+ (setq-local font-lock-defaults
+ '((ps-run-font-lock-keywords
+ ps-run-font-lock-keywords-1
+ ps-run-font-lock-keywords-2)
+ t))
(setq mode-line-process '(":%s")))
(defun ps-run-running ()
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index 53b654001e3..d6c0a4d1dbf 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -1,11 +1,11 @@
;;; python.el --- Python's flying circus support for Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 2003-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
;; Author: Fabián E. Gallina <fgallina@gnu.org>
;; URL: https://github.com/fgallina/python.el
-;; Version: 0.27
-;; Package-Requires: ((emacs "24.1") (cl-lib "1.0"))
+;; Version: 0.27.1
+;; Package-Requires: ((emacs "24.2") (cl-lib "1.0"))
;; Maintainer: emacs-devel@gnu.org
;; Created: Jul 2010
;; Keywords: languages
@@ -29,7 +29,7 @@
;; Major mode for editing Python files with some fontification and
;; indentation bits extracted from original Dave Love's python.el
-;; found in GNU/Emacs.
+;; found in GNU Emacs.
;; Implements Syntax highlighting, Indentation, Movement, Shell
;; interaction, Shell completion, Shell virtualenv support, Shell
@@ -247,13 +247,6 @@
;; I'd recommend the first one since you'll get the same behavior for
;; all modes out-of-the-box.
-;;; Installation:
-
-;; Add this to your .emacs:
-
-;; (add-to-list 'load-path "/folder/containing/file")
-;; (require 'python)
-
;;; TODO:
;;; Code:
@@ -401,6 +394,12 @@ This variant of `rx' supports common Python named REGEXPS."
(any ?' ?\") "__main__" (any ?' ?\")
(* space) ?:))
(symbol-name (seq (any letter ?_) (* (any word ?_))))
+ (assignment-target (seq (? ?*)
+ (* symbol-name ?.) symbol-name
+ (? ?\[ (+ (not ?\])) ?\])))
+ (grouped-assignment-target (seq (? ?*)
+ (* symbol-name ?.) (group symbol-name)
+ (? ?\[ (+ (not ?\])) ?\])))
(open-paren (or "{" "[" "("))
(close-paren (or "}" "]" ")"))
(simple-operator (any ?+ ?- ?/ ?& ?^ ?~ ?| ?* ?< ?> ?= ?%))
@@ -612,6 +611,18 @@ This is the medium decoration level, including everything in
`python-font-lock-keywords-level-1', as well as keywords and
builtins.")
+(defun python-font-lock-assignment-matcher (regexp)
+ "Font lock matcher for assignments based on REGEXP.
+Return nil if REGEXP matched within a `paren' context (to avoid,
+e.g., default values for arguments or passing arguments by name
+being treated as assignments) or is followed by an '=' sign (to
+avoid '==' being treated as an assignment."
+ (lambda (limit)
+ (let ((res (re-search-forward regexp limit t)))
+ (unless (or (python-syntax-context 'paren)
+ (equal (char-after (point)) ?=))
+ res))))
+
(defvar python-font-lock-keywords-maximum-decoration
`((python--font-lock-f-strings)
,@python-font-lock-keywords-level-2
@@ -659,32 +670,57 @@ builtins.")
)
symbol-end)
. font-lock-type-face)
- ;; assignments
- ;; support for a = b = c = 5
- (,(lambda (limit)
- (let ((re (python-rx (group (+ (any word ?. ?_)))
- (? ?\[ (+ (not (any ?\]))) ?\]) (* space)
- ;; A type, like " : int ".
- (? ?: (* space) (+ (any word ?. ?_)) (* space))
- assignment-operator))
- (res nil))
- (while (and (setq res (re-search-forward re limit t))
- (or (python-syntax-context 'paren)
- (equal (char-after (point)) ?=))))
- res))
- (1 font-lock-variable-name-face nil nil))
- ;; support for a, b, c = (1, 2, 3)
- (,(lambda (limit)
- (let ((re (python-rx (group (+ (any word ?. ?_))) (* space)
- (* ?, (* space) (+ (any word ?. ?_)) (* space))
- ?, (* space) (+ (any word ?. ?_)) (* space)
- assignment-operator))
- (res nil))
- (while (and (setq res (re-search-forward re limit t))
- (goto-char (match-end 1))
- (python-syntax-context 'paren)))
- res))
- (1 font-lock-variable-name-face nil nil)))
+ ;; multiple assignment
+ ;; (note that type hints are not allowed for multiple assignments)
+ ;; a, b, c = 1, 2, 3
+ ;; a, *b, c = 1, 2, 3, 4, 5
+ ;; [a, b] = (1, 2)
+ ;; (l[1], l[2]) = (10, 11)
+ ;; (a, b, c, *d) = *x, y = 5, 6, 7, 8, 9
+ ;; (a,) = 'foo'
+ ;; (*a,) = ['foo', 'bar', 'baz']
+ ;; d.x, d.y[0], *d.z = 'a', 'b', 'c', 'd', 'e'
+ ;; and variants thereof
+ ;; the cases
+ ;; (a) = 5
+ ;; [a] = 5
+ ;; [*a] = 5, 6
+ ;; are handled separately below
+ (,(python-font-lock-assignment-matcher
+ (python-rx (? (or "[" "(") (* space))
+ grouped-assignment-target (* space) ?, (* space)
+ (* assignment-target (* space) ?, (* space))
+ (? assignment-target (* space))
+ (? ?, (* space))
+ (? (or ")" "]") (* space))
+ (group assignment-operator)))
+ (1 font-lock-variable-name-face)
+ (,(python-rx grouped-assignment-target)
+ (progn
+ (goto-char (match-end 1)) ; go back after the first symbol
+ (match-beginning 2)) ; limit the search until the assignment
+ nil
+ (1 font-lock-variable-name-face)))
+ ;; single assignment with type hints, e.g.
+ ;; a: int = 5
+ ;; b: Tuple[Optional[int], Union[Sequence[str], str]] = (None, 'foo')
+ ;; c: Collection = {1, 2, 3}
+ ;; d: Mapping[int, str] = {1: 'bar', 2: 'baz'}
+ (,(python-font-lock-assignment-matcher
+ (python-rx grouped-assignment-target (* space)
+ (? ?: (* space) (+ not-simple-operator) (* space))
+ assignment-operator))
+ (1 font-lock-variable-name-face))
+ ;; special cases
+ ;; (a) = 5
+ ;; [a] = 5
+ ;; [*a] = 5, 6
+ (,(python-font-lock-assignment-matcher
+ (python-rx (or "[" "(") (* space)
+ grouped-assignment-target (* space)
+ (or ")" "]") (* space)
+ assignment-operator))
+ (1 font-lock-variable-name-face)))
"Font lock keywords to use in python-mode for maximum decoration.
This decoration level includes everything in
@@ -881,7 +917,7 @@ work on `python-indent-calculate-indentation' instead."
(python-util-forward-comment)
(current-indentation))))
(if (and indentation (not (zerop indentation)))
- (set (make-local-variable 'python-indent-offset) indentation)
+ (setq-local python-indent-offset indentation)
(when python-indent-guess-indent-offset-verbose
(message "Can't guess python-indent-offset, using defaults: %s"
python-indent-offset))))))))
@@ -1410,7 +1446,7 @@ With positive ARG search backwards, else search forwards."
(line-beg-pos (line-beginning-position))
(line-content-start (+ line-beg-pos (current-indentation)))
(pos (point-marker))
- (beg-indentation
+ (body-indentation
(and (> arg 0)
(save-excursion
(while (and
@@ -1421,9 +1457,16 @@ With positive ARG search backwards, else search forwards."
0))))
(found
(progn
- (when (and (< arg 0)
- (python-info-looking-at-beginning-of-defun))
+ (when (and (python-info-looking-at-beginning-of-defun)
+ (or (< arg 0)
+ ;; If looking at beginning of defun, and if
+ ;; pos is > line-content-start, ensure a
+ ;; backward re search match this defun by
+ ;; going to end of line before calling
+ ;; re-search-fn bug#40563
+ (and (> arg 0) (> pos line-content-start))))
(end-of-line 1))
+
(while (and (funcall re-search-fn
python-nav-beginning-of-defun-regexp nil t)
(or (python-syntax-context-type)
@@ -1431,7 +1474,7 @@ With positive ARG search backwards, else search forwards."
;; backwards by checking indentation.
(and (> arg 0)
(not (= (current-indentation) 0))
- (>= (current-indentation) beg-indentation)))))
+ (>= (current-indentation) body-indentation)))))
(and (python-info-looking-at-beginning-of-defun)
(or (not (= (line-number-at-pos pos)
(line-number-at-pos)))
@@ -1984,8 +2027,12 @@ position, else returns nil."
:group 'python
:safe 'stringp)
-(defcustom python-shell-interpreter "python"
+(defcustom python-shell-interpreter
+ (cond ((executable-find "python3") "python3")
+ ((executable-find "python") "python")
+ (t "python3"))
"Default Python interpreter for shell."
+ :version "28.1"
:type 'string
:group 'python)
@@ -2629,7 +2676,7 @@ also `with-current-buffer'."
(set-buffer python-shell--font-lock-buffer)
(when (not font-lock-mode)
(font-lock-mode 1))
- (set (make-local-variable 'delay-mode-hooks) t)
+ (setq-local delay-mode-hooks t)
(let ((python-indent-guess-indent-offset nil))
(when (not (derived-mode-p 'python-mode))
(python-mode))
@@ -2708,7 +2755,7 @@ With argument MSG show activation message."
(interactive "p")
(python-shell-with-shell-buffer
(python-shell-font-lock-kill-buffer)
- (set (make-local-variable 'python-shell--font-lock-buffer) nil)
+ (setq-local python-shell--font-lock-buffer nil)
(add-hook 'post-command-hook
#'python-shell-font-lock-post-command-hook nil 'local)
(add-hook 'kill-buffer-hook
@@ -2731,7 +2778,7 @@ With argument MSG show deactivation message."
(cdr (python-util-comint-last-prompt))
(line-end-position)
'(face nil font-lock-face nil)))
- (set (make-local-variable 'python-shell--font-lock-buffer) nil)
+ (setq-local python-shell--font-lock-buffer nil)
(remove-hook 'post-command-hook
#'python-shell-font-lock-post-command-hook 'local)
(remove-hook 'kill-buffer-hook
@@ -2747,8 +2794,8 @@ With argument MSG show deactivation message."
With argument MSG show activation/deactivation message."
(interactive "p")
(python-shell-with-shell-buffer
- (set (make-local-variable 'python-shell-font-lock-enable)
- (not python-shell-font-lock-enable))
+ (setq-local python-shell-font-lock-enable
+ (not python-shell-font-lock-enable))
(if python-shell-font-lock-enable
(python-shell-font-lock-turn-on msg)
(python-shell-font-lock-turn-off msg))
@@ -2771,9 +2818,9 @@ eventually provide a shell."
(defun python-shell-comint-watch-for-first-prompt-output-filter (output)
"Run `python-shell-first-prompt-hook' when first prompt is found in OUTPUT."
(when (not python-shell--first-prompt-received)
- (set (make-local-variable 'python-shell--first-prompt-received-output-buffer)
- (concat python-shell--first-prompt-received-output-buffer
- (ansi-color-filter-apply output)))
+ (setq-local python-shell--first-prompt-received-output-buffer
+ (concat python-shell--first-prompt-received-output-buffer
+ (ansi-color-filter-apply output)))
(when (python-shell-comint-end-of-output-p
python-shell--first-prompt-received-output-buffer)
(if (string-match-p
@@ -2781,7 +2828,7 @@ eventually provide a shell."
(or python-shell--first-prompt-received-output-buffer ""))
;; Skip pdb prompts and reset the buffer.
(setq python-shell--first-prompt-received-output-buffer nil)
- (set (make-local-variable 'python-shell--first-prompt-received) t)
+ (setq-local python-shell--first-prompt-received t)
(setq python-shell--first-prompt-received-output-buffer nil)
(with-current-buffer (current-buffer)
(let ((inhibit-quit nil))
@@ -2821,30 +2868,30 @@ variable.
\(Type \\[describe-mode] in the process buffer for a list of commands.)"
(when python-shell--parent-buffer
(python-util-clone-local-variables python-shell--parent-buffer))
- (set (make-local-variable 'indent-tabs-mode) nil)
+ (setq-local indent-tabs-mode nil)
;; Users can interactively override default values for
;; `python-shell-interpreter' and `python-shell-interpreter-args'
;; when calling `run-python'. This ensures values let-bound in
;; `python-shell-make-comint' are locally set if needed.
- (set (make-local-variable 'python-shell-interpreter)
- (or python-shell--interpreter python-shell-interpreter))
- (set (make-local-variable 'python-shell-interpreter-args)
- (or python-shell--interpreter-args python-shell-interpreter-args))
- (set (make-local-variable 'python-shell--prompt-calculated-input-regexp) nil)
- (set (make-local-variable 'python-shell--block-prompt) nil)
- (set (make-local-variable 'python-shell--prompt-calculated-output-regexp) nil)
+ (setq-local python-shell-interpreter
+ (or python-shell--interpreter python-shell-interpreter))
+ (setq-local python-shell-interpreter-args
+ (or python-shell--interpreter-args python-shell-interpreter-args))
+ (setq-local python-shell--prompt-calculated-input-regexp nil)
+ (setq-local python-shell--block-prompt nil)
+ (setq-local python-shell--prompt-calculated-output-regexp nil)
(python-shell-prompt-set-calculated-regexps)
(setq comint-prompt-regexp python-shell--prompt-calculated-input-regexp)
- (set (make-local-variable 'comint-prompt-read-only) t)
+ (setq-local comint-prompt-read-only t)
(setq mode-line-process '(":%s"))
- (set (make-local-variable 'comint-output-filter-functions)
- '(ansi-color-process-output
- python-shell-comint-watch-for-first-prompt-output-filter
- python-comint-postoutput-scroll-to-bottom
- comint-watch-for-password-prompt))
+ (setq-local comint-output-filter-functions
+ '(ansi-color-process-output
+ python-shell-comint-watch-for-first-prompt-output-filter
+ python-comint-postoutput-scroll-to-bottom
+ comint-watch-for-password-prompt))
(setq-local comint-highlight-input nil)
- (set (make-local-variable 'compilation-error-regexp-alist)
- python-shell-compilation-regexp-alist)
+ (setq-local compilation-error-regexp-alist
+ python-shell-compilation-regexp-alist)
(add-hook 'completion-at-point-functions
#'python-shell-completion-at-point nil 'local)
(define-key inferior-python-mode-map "\t"
@@ -2921,7 +2968,7 @@ process buffer for a list of commands.)"
(python-shell-make-comint
(or cmd (python-shell-calculate-command))
(python-shell-get-process-name dedicated) show)))
- (pop-to-buffer buffer)
+ (set-buffer buffer)
(get-buffer-process buffer)))
(defun run-python-internal ()
@@ -3203,6 +3250,8 @@ the python shell:
(line-beginning-position) (line-end-position))))
(buffer-substring-no-properties (point-min) (point-max)))))
+(declare-function compilation-forget-errors "compile")
+
(defun python-shell-send-region (start end &optional send-main msg
no-cookie)
"Send the region delimited by START and END to inferior Python process.
@@ -3220,6 +3269,10 @@ process running; defaults to t when called interactively."
(original-string (buffer-substring-no-properties start end))
(_ (string-match "\\`\n*\\(.*\\)" original-string)))
(message "Sent: %s..." (match-string 1 original-string))
+ ;; Recalculate positions to avoid landing on the wrong line if
+ ;; lines have been removed/added.
+ (with-current-buffer (process-buffer process)
+ (compilation-forget-errors))
(python-shell-send-string string process)))
(defun python-shell-send-statement (&optional send-main msg)
@@ -3605,7 +3658,7 @@ __PYTHON_EL_native_completion_setup()" process)
With argument MSG show deactivation message."
(interactive "p")
(python-shell-with-shell-buffer
- (set (make-local-variable 'python-shell-completion-native-enable) nil)
+ (setq-local python-shell-completion-native-enable nil)
(when msg
(message "Shell native completion is disabled, using fallback"))))
@@ -3614,7 +3667,7 @@ With argument MSG show deactivation message."
With argument MSG show deactivation message."
(interactive "p")
(python-shell-with-shell-buffer
- (set (make-local-variable 'python-shell-completion-native-enable) t)
+ (setq-local python-shell-completion-native-enable t)
(python-shell-completion-native-turn-on-maybe msg)))
(defun python-shell-completion-native-turn-on-maybe (&optional msg)
@@ -3994,7 +4047,7 @@ Argument OUTPUT is a string with the output from the comint process."
(tracked-buffer-window (get-buffer-window tracked-buffer))
(tracked-buffer-line-pos))
(with-current-buffer tracked-buffer
- (set (make-local-variable 'overlay-arrow-position) (make-marker))
+ (setq-local overlay-arrow-position (make-marker))
(setq tracked-buffer-line-pos (progn
(goto-char (point-min))
(forward-line (1- line-number))
@@ -4011,8 +4064,8 @@ Argument OUTPUT is a string with the output from the comint process."
"Setup pdb tracking in current buffer."
(make-local-variable 'python-pdbtrack-buffers-to-kill)
(make-local-variable 'python-pdbtrack-tracked-buffer)
- (add-to-list (make-local-variable 'comint-input-filter-functions)
- #'python-pdbtrack-comint-input-filter-function)
+ (add-hook 'comint-input-filter-functions
+ #'python-pdbtrack-comint-input-filter-function nil t)
(add-to-list (make-local-variable 'comint-output-filter-functions)
#'python-pdbtrack-comint-output-filter-function)
(add-function :before (process-sentinel (get-buffer-process (current-buffer)))
@@ -5535,48 +5588,43 @@ REPORT-FN is Flymake's callback function."
"Major mode for editing Python files.
\\{python-mode-map}"
- (set (make-local-variable 'tab-width) 8)
- (set (make-local-variable 'indent-tabs-mode) nil)
+ (setq-local tab-width 8)
+ (setq-local indent-tabs-mode nil)
- (set (make-local-variable 'comment-start) "# ")
- (set (make-local-variable 'comment-start-skip) "#+\\s-*")
+ (setq-local comment-start "# ")
+ (setq-local comment-start-skip "#+\\s-*")
- (set (make-local-variable 'parse-sexp-lookup-properties) t)
- (set (make-local-variable 'parse-sexp-ignore-comments) t)
+ (setq-local parse-sexp-lookup-properties t)
+ (setq-local parse-sexp-ignore-comments t)
- (set (make-local-variable 'forward-sexp-function)
- 'python-nav-forward-sexp)
+ (setq-local forward-sexp-function #'python-nav-forward-sexp)
- (set (make-local-variable 'font-lock-defaults)
- `(,python-font-lock-keywords
- nil nil nil nil
- (font-lock-syntactic-face-function
- . python-font-lock-syntactic-face-function)))
+ (setq-local font-lock-defaults
+ `(,python-font-lock-keywords
+ nil nil nil nil
+ (font-lock-syntactic-face-function
+ . python-font-lock-syntactic-face-function)))
- (set (make-local-variable 'syntax-propertize-function)
- python-syntax-propertize-function)
+ (setq-local syntax-propertize-function
+ python-syntax-propertize-function)
- (set (make-local-variable 'indent-line-function)
- #'python-indent-line-function)
- (set (make-local-variable 'indent-region-function) #'python-indent-region)
+ (setq-local indent-line-function #'python-indent-line-function)
+ (setq-local indent-region-function #'python-indent-region)
;; Because indentation is not redundant, we cannot safely reindent code.
- (set (make-local-variable 'electric-indent-inhibit) t)
- (set (make-local-variable 'electric-indent-chars)
- (cons ?: electric-indent-chars))
+ (setq-local electric-indent-inhibit t)
+ (setq-local electric-indent-chars
+ (cons ?: electric-indent-chars))
;; Add """ ... """ pairing to electric-pair-mode.
(add-hook 'post-self-insert-hook
#'python-electric-pair-string-delimiter 'append t)
- (set (make-local-variable 'paragraph-start) "\\s-*$")
- (set (make-local-variable 'fill-paragraph-function)
- #'python-fill-paragraph)
- (set (make-local-variable 'normal-auto-fill-function) #'python-do-auto-fill)
+ (setq-local paragraph-start "\\s-*$")
+ (setq-local fill-paragraph-function #'python-fill-paragraph)
+ (setq-local normal-auto-fill-function #'python-do-auto-fill)
- (set (make-local-variable 'beginning-of-defun-function)
- #'python-nav-beginning-of-defun)
- (set (make-local-variable 'end-of-defun-function)
- #'python-nav-end-of-defun)
+ (setq-local beginning-of-defun-function #'python-nav-beginning-of-defun)
+ (setq-local end-of-defun-function #'python-nav-end-of-defun)
(add-hook 'completion-at-point-functions
#'python-completion-at-point nil 'local)
@@ -5584,26 +5632,25 @@ REPORT-FN is Flymake's callback function."
(add-hook 'post-self-insert-hook
#'python-indent-post-self-insert-function 'append 'local)
- (set (make-local-variable 'imenu-create-index-function)
- #'python-imenu-create-index)
+ (setq-local imenu-create-index-function
+ #'python-imenu-create-index)
- (set (make-local-variable 'add-log-current-defun-function)
- #'python-info-current-defun)
+ (setq-local add-log-current-defun-function
+ #'python-info-current-defun)
(add-hook 'which-func-functions #'python-info-current-defun nil t)
- (set (make-local-variable 'skeleton-further-elements)
- '((abbrev-mode nil)
- (< '(backward-delete-char-untabify (min python-indent-offset
- (current-column))))
- (^ '(- (1+ (current-indentation))))))
+ (setq-local skeleton-further-elements
+ '((abbrev-mode nil)
+ (< '(backward-delete-char-untabify (min python-indent-offset
+ (current-column))))
+ (^ '(- (1+ (current-indentation))))))
(with-no-warnings
;; suppress warnings about eldoc-documentation-function being obsolete
(if (null eldoc-documentation-function)
;; Emacs<25
- (set (make-local-variable 'eldoc-documentation-function)
- #'python-eldoc-function)
+ (setq-local eldoc-documentation-function #'python-eldoc-function)
(if (boundp 'eldoc-documentation-functions)
(add-hook 'eldoc-documentation-functions #'python-eldoc-function nil t)
(add-function :before-until (local 'eldoc-documentation-function)
@@ -5620,16 +5667,14 @@ REPORT-FN is Flymake's callback function."
python-hideshow-forward-sexp-function
nil))
- (set (make-local-variable 'outline-regexp)
- (python-rx (* space) block-start))
- (set (make-local-variable 'outline-heading-end-regexp) ":[^\n]*\n")
- (set (make-local-variable 'outline-level)
- #'(lambda ()
- "`outline-level' function for Python mode."
- (1+ (/ (current-indentation) python-indent-offset))))
+ (setq-local outline-regexp (python-rx (* space) block-start))
+ (setq-local outline-heading-end-regexp ":[^\n]*\n")
+ (setq-local outline-level
+ (lambda ()
+ "`outline-level' function for Python mode."
+ (1+ (/ (current-indentation) python-indent-offset))))
- (set (make-local-variable 'prettify-symbols-alist)
- python-prettify-symbols-alist)
+ (setq-local prettify-symbols-alist python-prettify-symbols-alist)
(python-skeleton-add-menu-items)
diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el
index 14f00597bfc..a8667acb9d5 100644
--- a/lisp/progmodes/ruby-mode.el
+++ b/lisp/progmodes/ruby-mode.el
@@ -1,6 +1,6 @@
;;; ruby-mode.el --- Major mode for editing Ruby files -*- lexical-binding: t -*-
-;; Copyright (C) 1994-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2021 Free Software Foundation, Inc.
;; Authors: Yukihiro Matsumoto
;; Nobuyoshi Nakada
@@ -28,18 +28,11 @@
;; Provides font-locking, indentation support, and navigation for Ruby code.
;;
-;; If you're installing manually, you should add this to your .emacs
-;; file after putting it on your load path:
-;;
-;; (autoload 'ruby-mode "ruby-mode" "Major mode for ruby files" t)
-;; (add-to-list 'auto-mode-alist '("\\.rb\\'" . ruby-mode))
-;; (add-to-list 'interpreter-mode-alist '("ruby" . ruby-mode))
-;;
;; Still needs more docstrings; search below for TODO.
;;; Code:
-(eval-when-compile (require 'cl-lib))
+(require 'cl-lib)
(defgroup ruby nil
"Major mode for editing Ruby code."
@@ -82,7 +75,7 @@
(defconst ruby-block-mid-re
(regexp-opt ruby-block-mid-keywords)
- "Regexp to match where the indentation gets shallower in middle of block statements.")
+ "Regexp for where the indentation gets shallower in middle of block statements.")
(defconst ruby-block-op-keywords
'("and" "or" "not")
@@ -108,7 +101,7 @@
"Regexp to match the beginning of a heredoc.")
(defconst ruby-expression-expansion-re
- "\\(?:[^\\]\\|\\=\\)\\(\\\\\\\\\\)*\\(#\\({[^}\n\\]*\\(\\\\.[^}\n\\]*\\)*}\\|\\(\\$\\|@\\|@@\\)\\(\\w\\|_\\)+\\|\\$[^a-zA-Z \n]\\)\\)"))
+ "#\\({[^}\n\\]*\\(\\\\.[^}\n\\]*\\)*}\\|\\(?:\\$\\|@\\|@@\\)\\(\\w\\|_\\)+\\|\\$[^a-zA-Z \n]\\)"))
(defun ruby-here-doc-end-match ()
"Return a regexp to find the end of a heredoc.
@@ -408,7 +401,10 @@ It is used when `ruby-encoding-magic-comment-style' is set to `custom'."
(or (and (bolp)
;; Newline is escaped.
(not (eq (char-before (1- (point))) ?\\)))
- (memq (char-before) '(?\; ?=)))))
+ (eq (char-before) ?\;)
+ (and (eq (char-before) ?=)
+ (equal (syntax-after (1- (point)))
+ (string-to-syntax "."))))))
(defun ruby-smie--implicit-semi-p ()
(save-excursion
@@ -602,7 +598,7 @@ It is used when `ruby-encoding-magic-comment-style' is set to `custom'."
(`(:before . ,(or "(" "[" "{"))
(cond
((and (equal token "{")
- (not (smie-rule-prev-p "(" "{" "[" "," "=>" "=" "return" ";"))
+ (not (smie-rule-prev-p "(" "{" "[" "," "=>" "=" "return" ";" "do"))
(save-excursion
(forward-comment -1)
(not (eq (preceding-char) ?:))))
@@ -787,24 +783,25 @@ The style of the comment is controlled by `ruby-encoding-magic-comment-style'."
(defun ruby-mode-set-encoding ()
"Insert a magic comment header with the proper encoding if necessary."
(save-excursion
- (widen)
- (goto-char (point-min))
- (when (ruby--encoding-comment-required-p)
+ (save-restriction
+ (widen)
(goto-char (point-min))
- (let ((coding-system (ruby--detect-encoding)))
- (when coding-system
- (if (looking-at "^#!") (beginning-of-line 2))
- (cond ((looking-at "\\s *#.*\\(en\\)?coding\\s *:\\s *\\([-a-z0-9_]*\\)")
- ;; update existing encoding comment if necessary
- (unless (string= (match-string 2) coding-system)
- (goto-char (match-beginning 2))
- (delete-region (point) (match-end 2))
- (insert coding-system)))
- ((looking-at "\\s *#.*coding\\s *[:=]"))
- (t (when ruby-insert-encoding-magic-comment
- (ruby--insert-coding-comment coding-system))))
- (when (buffer-modified-p)
- (basic-save-buffer-1)))))))
+ (when (ruby--encoding-comment-required-p)
+ (goto-char (point-min))
+ (let ((coding-system (ruby--detect-encoding)))
+ (when coding-system
+ (if (looking-at "^#!") (beginning-of-line 2))
+ (cond ((looking-at "\\s *#.*\\(en\\)?coding\\s *:\\s *\\([-a-z0-9_]*\\)")
+ ;; update existing encoding comment if necessary
+ (unless (string= (match-string 2) coding-system)
+ (goto-char (match-beginning 2))
+ (delete-region (point) (match-end 2))
+ (insert coding-system)))
+ ((looking-at "\\s *#.*coding\\s *[:=]"))
+ (t (when ruby-insert-encoding-magic-comment
+ (ruby--insert-coding-comment coding-system))))
+ (when (buffer-modified-p)
+ (basic-save-buffer-1))))))))
(defvar ruby--electric-indent-chars '(?. ?\) ?} ?\]))
@@ -1601,13 +1598,16 @@ See `add-log-current-defun-function'."
(let* ((indent 0) mname mlist
(start (point))
(make-definition-re
- (lambda (re)
+ (lambda (re &optional method-name?)
(concat "^[ \t]*" re "[ \t]+"
"\\("
;; \\. and :: for class methods
- "\\([A-Za-z_]" ruby-symbol-re "*[?!]?\\|\\.\\|::" "\\)"
+ "\\([A-Za-z_]" ruby-symbol-re "*[?!]?"
+ "\\|"
+ (if method-name? ruby-operator-re "\\.")
+ "\\|::" "\\)"
"+\\)")))
- (definition-re (funcall make-definition-re ruby-defun-beg-re))
+ (definition-re (funcall make-definition-re ruby-defun-beg-re t))
(module-re (funcall make-definition-re "\\(class\\|module\\)")))
;; Get the current method definition (or class/module).
(when (re-search-backward definition-re nil t)
@@ -1867,10 +1867,18 @@ It will be properly highlighted even when the call omits parens.")
'syntax-table (string-to-syntax "_"))
(string-to-syntax "'"))))
;; Symbols with special characters.
- ("\\(^\\|[^:]\\)\\(:\\([-+~]@?\\|[/%&|^`]\\|\\*\\*?\\|<\\(<\\|=>?\\)?\\|>[>=]?\\|===?\\|=~\\|![~=]?\\|\\[\\]=?\\)\\)"
- (3 (unless (nth 8 (syntax-ppss (match-beginning 3)))
+ (":\\([-+~]@?\\|[/%&|^`]\\|\\*\\*?\\|<\\(<\\|=>?\\)?\\|>[>=]?\\|===?\\|=~\\|![~=]?\\|\\[\\]=?\\)"
+ (1 (unless (or
+ (eq (char-before (match-beginning 0)) ?:)
+ (nth 8 (syntax-ppss (match-beginning 1))))
(goto-char (match-end 0))
(string-to-syntax "_"))))
+ ;; Symbols ending with '=' (bug#42846).
+ (":[[:alpha:]][[:alnum:]_]*\\(=\\)"
+ (1 (unless (or (nth 8 (syntax-ppss))
+ (eq (char-before (match-beginning 0)) ?:)
+ (eq (char-after (match-end 3)) ?>))
+ (string-to-syntax "_"))))
;; Part of method name when at the end of it.
("[!?]"
(0 (unless (save-excursion
@@ -1885,9 +1893,14 @@ It will be properly highlighted even when the call omits parens.")
;; (semi-important for indentation).
("\\(:\\)\\(?:[({]\\|\\[[^]]\\)"
(1 (string-to-syntax ".")))
- ;; Regular expressions. Start with matching unescaped slash.
- ("\\(?:\\=\\|[^\\]\\)\\(?:\\\\\\\\\\)*\\(/\\)"
- (1 (let ((state (save-excursion (syntax-ppss (match-beginning 1)))))
+ ;; Regular expressions.
+ ("\\(/\\)"
+ (1
+ ;; No unescaped slashes in front.
+ (when (save-excursion
+ (forward-char -1)
+ (cl-evenp (skip-chars-backward "\\\\")))
+ (let ((state (save-excursion (syntax-ppss (match-beginning 1)))))
(when (or
;; Beginning of a regexp.
(and (null (nth 8 state))
@@ -1900,11 +1913,17 @@ It will be properly highlighted even when the call omits parens.")
;; string interpolation inside, or span
;; several lines.
(eq ?/ (nth 3 state)))
- (string-to-syntax "\"/")))))
+ (string-to-syntax "\"/"))))))
;; Expression expansions in strings. We're handling them
;; here, so that the regexp rule never matches inside them.
(ruby-expression-expansion-re
- (0 (ignore (ruby-syntax-propertize-expansion))))
+ (0 (ignore
+ (if (save-excursion
+ (goto-char (match-beginning 0))
+ ;; The hash character is not escaped.
+ (cl-evenp (skip-chars-backward "\\\\")))
+ (ruby-syntax-propertize-expansion)
+ (goto-char (match-beginning 1))))))
("^=en\\(d\\)\\_>" (1 "!"))
("^\\(=\\)begin\\_>" (1 "!"))
;; Handle here documents.
@@ -1994,8 +2013,8 @@ It will be properly highlighted even when the call omits parens.")
(defun ruby-syntax-propertize-expansion ()
;; Save the match data to a text property, for font-locking later.
;; Set the syntax of all double quotes and backticks to punctuation.
- (let* ((beg (match-beginning 2))
- (end (match-end 2))
+ (let* ((beg (match-beginning 0))
+ (end (match-end 0))
(state (and beg (save-excursion (syntax-ppss beg)))))
(when (ruby-syntax-expansion-allowed-p state)
(put-text-property beg (1+ beg) 'ruby-expansion-match-data
@@ -2187,12 +2206,7 @@ It will be properly highlighted even when the call omits parens.")
(0 font-lock-builtin-face))
;; Symbols.
("\\(^\\|[^:]\\)\\(:@\\{0,2\\}\\(?:\\sw\\|\\s_\\)+\\)"
- (2 font-lock-constant-face)
- (3 (unless (and (eq (char-before (match-end 3)) ?=)
- (eq (char-after (match-end 3)) ?>))
- ;; bug#18644
- font-lock-constant-face)
- nil t))
+ (2 font-lock-constant-face))
;; Special globals.
(,(concat "\\$\\(?:[:\"!@;,/._><\\$?~=*&`'+0-9]\\|-[0adFiIlpvw]\\|"
(regexp-opt '("LOAD_PATH" "LOADED_FEATURES" "PROGRAM_NAME"
@@ -2227,7 +2241,7 @@ It will be properly highlighted even when the call omits parens.")
(1 font-lock-builtin-face))
;; Expression expansion.
(ruby-match-expression-expansion
- 2 font-lock-variable-name-face t)
+ 0 font-lock-variable-name-face t)
;; Negation char.
("\\(?:^\\|[^[:alnum:]_]\\)\\(!+\\)[^=~]"
1 font-lock-negation-char-face)
@@ -2436,7 +2450,7 @@ If there is no Rubocop config file, Rubocop will be passed a flag
"\\)"
"\\|/"
"\\(?:Gem\\|Rake\\|Cap\\|Thor"
- "\\|Puppet\\|Berks"
+ "\\|Puppet\\|Berks\\|Brew"
"\\|Vagrant\\|Guard\\|Pod\\)file"
"\\)\\'"))
'ruby-mode))
diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el
index 33ba0d11d80..f610efbfca5 100644
--- a/lisp/progmodes/scheme.el
+++ b/lisp/progmodes/scheme.el
@@ -1,6 +1,6 @@
;;; scheme.el --- Scheme (and DSSSL) editing mode -*- lexical-binding: t; -*-
-;; Copyright (C) 1986-1988, 1997-1998, 2001-2020 Free Software
+;; Copyright (C) 1986-1988, 1997-1998, 2001-2021 Free Software
;; Foundation, Inc.
;; Author: Bill Rozas <jinx@martigny.ai.mit.edu>
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index 3b24cabe8bd..a417de32640 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -1,6 +1,6 @@
;;; sh-script.el --- shell-script editing commands for Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1993-1997, 1999, 2001-2020 Free Software Foundation,
+;; Copyright (C) 1993-1997, 1999, 2001-2021 Free Software Foundation,
;; Inc.
;; Author: Daniel Pfeiffer <occitan@esperanto.org>
@@ -2801,12 +2801,12 @@ t means to return a list of all possible completions of STRING.
(not (bolp))
?\n)
"exit:\n"
- "rm $tmp* >&/dev/null" > \n)
+ "rm $tmp* >&" null-device > \n)
(es (file-name-nondirectory (buffer-file-name))
> "local( signals = $signals sighup sigint;" \n
> "tmp = `{ mktemp -t " str ".XXXXXX } ) {" \n
> "catch @ e {" \n
- > "rm $tmp^* >[2]/dev/null" \n
+ > "rm $tmp^* >[2]" null-device \n
"throw $e" \n
"} {" > \n
_ \n
@@ -2816,10 +2816,10 @@ t means to return a list of all possible completions of STRING.
7 "EXIT")
(rc (file-name-nondirectory (buffer-file-name))
> "tmp = `{ mktemp -t " str ".XXXXXX }" \n
- "fn sigexit { rm $tmp^* >[2]/dev/null }" \n)
+ "fn sigexit { rm $tmp^* >[2]" null-device " }" \n)
(sh (file-name-nondirectory (buffer-file-name))
> "TMP=`mktemp -t " str ".XXXXXX`" \n
- "trap \"rm $TMP* 2>/dev/null\" " ?0 \n))
+ "trap \"rm $TMP* 2>" null-device "\" " ?0 \n))
diff --git a/lisp/progmodes/simula.el b/lisp/progmodes/simula.el
index be3edfdc6e4..7806a6b46c8 100644
--- a/lisp/progmodes/simula.el
+++ b/lisp/progmodes/simula.el
@@ -1,6 +1,6 @@
;;; simula.el --- SIMULA 87 code editing commands for Emacs
-;; Copyright (C) 1992, 1994, 1996, 2001-2020 Free Software Foundation,
+;; Copyright (C) 1992, 1994, 1996, 2001-2021 Free Software Foundation,
;; Inc.
;; Author: Hans Henrik Eriksen <hhe@ifi.uio.no>
@@ -365,22 +365,22 @@ Variables controlling indentation style:
Turning on SIMULA mode calls the value of the variable simula-mode-hook
with no arguments, if that value is non-nil."
- (set (make-local-variable 'comment-column) 40)
- ;; (set (make-local-variable 'end-comment-column) 75)
- (set (make-local-variable 'paragraph-start) "[ \t]*$\\|\f")
- (set (make-local-variable 'paragraph-separate) paragraph-start)
- (set (make-local-variable 'indent-line-function) 'simula-indent-line)
- (set (make-local-variable 'comment-start) "! ")
- (set (make-local-variable 'comment-end) " ;")
- (set (make-local-variable 'comment-start-skip) "!+ *")
- (set (make-local-variable 'parse-sexp-ignore-comments) nil)
- (set (make-local-variable 'comment-multi-line) t)
- (set (make-local-variable 'font-lock-defaults)
- '((simula-font-lock-keywords simula-font-lock-keywords-1
- simula-font-lock-keywords-2 simula-font-lock-keywords-3)
- nil t ((?_ . "w"))))
- (set (make-local-variable 'syntax-propertize-function)
- simula-syntax-propertize-function)
+ (setq-local comment-column 40)
+ ;; (setq-local end-comment-column 75)
+ (setq-local paragraph-start "[ \t]*$\\|\f")
+ (setq-local paragraph-separate paragraph-start)
+ (setq-local indent-line-function 'simula-indent-line)
+ (setq-local comment-start "! ")
+ (setq-local comment-end " ;")
+ (setq-local comment-start-skip "!+ *")
+ (setq-local parse-sexp-ignore-comments nil)
+ (setq-local comment-multi-line t)
+ (setq-local font-lock-defaults
+ '((simula-font-lock-keywords simula-font-lock-keywords-1
+ simula-font-lock-keywords-2 simula-font-lock-keywords-3)
+ nil t ((?_ . "w"))))
+ (setq-local syntax-propertize-function
+ simula-syntax-propertize-function)
(abbrev-mode 1))
(defun simula-indent-exp ()
diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el
index 6b0df2d700d..4d027f3df53 100644
--- a/lisp/progmodes/sql.el
+++ b/lisp/progmodes/sql.el
@@ -1,12 +1,11 @@
;;; sql.el --- specialized comint.el for SQL interpreters -*- lexical-binding: t -*-
-;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: Alex Schroeder <alex@gnu.org>
;; Maintainer: Michael Mauger <michael@mauger.com>
;; Version: 3.6
;; Keywords: comm languages processes
-;; URL: https://savannah.gnu.org/projects/emacs/
;; This file is part of GNU Emacs.
@@ -232,7 +231,6 @@
(require 'cl-lib)
(require 'comint)
-(require 'custom)
(require 'thingatpt)
(require 'view)
(eval-when-compile (require 'subr-x)) ; string-empty-p
@@ -1726,7 +1724,7 @@ to add functions and PL/SQL keywords.")
"ORDER BY 2 DESC, 3 DESC, 4 DESC, 5 DESC, 6 DESC, 1;")
nil nil)
(with-current-buffer b
- (set (make-local-variable 'sql-product) 'oracle)
+ (setq-local sql-product 'oracle)
(sql-product-font-lock t nil)
(font-lock-mode +1)))))
@@ -2813,7 +2811,7 @@ configured."
((syntax-alist (sql-product-font-lock-syntax-alist)))
;; Get the product-specific keywords.
- (set (make-local-variable 'sql-mode-font-lock-keywords)
+ (setq-local sql-mode-font-lock-keywords
(append
(unless (eq sql-product 'ansi)
(sql-get-product-feature sql-product :font-lock))
@@ -2825,7 +2823,7 @@ configured."
;; Setup font-lock. Force re-parsing of `font-lock-defaults'.
(kill-local-variable 'font-lock-set-defaults)
- (set (make-local-variable 'font-lock-defaults)
+ (setq-local font-lock-defaults
(list 'sql-mode-font-lock-keywords
keywords-only t syntax-alist))
@@ -4135,8 +4133,8 @@ details or extends the listing to include other schemas objects."
(sql-execute-feature sqlbuf "*List All*" :list-all enhanced nil)
(with-current-buffer sqlbuf
;; Contains the name of database objects
- (set (make-local-variable 'sql-contains-names) t)
- (set (make-local-variable 'sql-buffer) sqlbuf))))
+ (setq-local sql-contains-names t)
+ (setq-local sql-buffer sqlbuf))))
(defun sql-list-table (name &optional enhanced)
"List the details of a database table named NAME.
@@ -4186,11 +4184,12 @@ must tell Emacs. Here's how to do that in your init file:
(modify-syntax-entry ?\\\\ \"\\\\\" sql-mode-syntax-table)))"
:abbrev-table sql-mode-abbrev-table
- (if sql-mode-menu
- (easy-menu-add sql-mode-menu)); XEmacs
+ (when (and (featurep 'xemacs)
+ sql-mode-menu)
+ (easy-menu-add sql-mode-menu))
;; (smie-setup sql-smie-grammar #'sql-smie-rules)
- (set (make-local-variable 'comment-start) "--")
+ (setq-local comment-start "--")
;; Make each buffer in sql-mode remember the "current" SQLi buffer.
(make-local-variable 'sql-buffer)
;; Add imenu support for sql-mode. Note that imenu-generic-expression
@@ -4200,12 +4199,12 @@ must tell Emacs. Here's how to do that in your init file:
imenu-case-fold-search t)
;; Make `sql-send-paragraph' work on paragraphs that contain indented
;; lines.
- (set (make-local-variable 'paragraph-separate) "[\f]*$")
- (set (make-local-variable 'paragraph-start) "[\n\f]")
+ (setq-local paragraph-separate "[\f]*$")
+ (setq-local paragraph-start "[\n\f]")
;; Abbrevs
(setq-local abbrev-all-caps 1)
;; Contains the name of database objects
- (set (make-local-variable 'sql-contains-names) t)
+ (setq-local sql-contains-names t)
(setq-local syntax-propertize-function
(syntax-propertize-rules
;; Handle escaped apostrophes within strings.
@@ -4304,16 +4303,16 @@ you entered, right above the output it created.
:after-hook (sql--adjust-interactive-setup)
;; Get the `sql-product' for this interactive session.
- (set (make-local-variable 'sql-product)
- (or sql-interactive-product
- sql-product))
+ (setq-local sql-product (or sql-interactive-product
+ sql-product))
;; Setup the mode.
(setq mode-name
(concat "SQLi[" (or (sql-get-product-feature sql-product :name)
(symbol-name sql-product)) "]"))
- (if sql-interactive-mode-menu
- (easy-menu-add sql-interactive-mode-menu)) ; XEmacs
+ (when (and (featurep 'xemacs)
+ sql-interactive-mode-menu)
+ (easy-menu-add sql-interactive-mode-menu))
;; Note that making KEYWORDS-ONLY nil will cause havoc if you try
;; SELECT 'x' FROM DUAL with SQL*Plus, because the title of the column
@@ -4322,7 +4321,7 @@ you entered, right above the output it created.
(sql-product-font-lock t nil)
;; Enable commenting and uncommenting of the region.
- (set (make-local-variable 'comment-start) "--")
+ (setq-local comment-start "--")
;; Abbreviation table init and case-insensitive. It is not activated
;; by default.
(setq local-abbrev-table sql-mode-abbrev-table)
@@ -4331,27 +4330,27 @@ you entered, right above the output it created.
(let ((proc (get-buffer-process (current-buffer))))
(when proc (set-process-sentinel proc #'sql-stop)))
;; Save the connection and login params
- (set (make-local-variable 'sql-user) sql-user)
- (set (make-local-variable 'sql-database) sql-database)
- (set (make-local-variable 'sql-server) sql-server)
- (set (make-local-variable 'sql-port) sql-port)
- (set (make-local-variable 'sql-connection) sql-connection)
+ (setq-local sql-user sql-user)
+ (setq-local sql-database sql-database)
+ (setq-local sql-server sql-server)
+ (setq-local sql-port sql-port)
+ (setq-local sql-connection sql-connection)
(setq-default sql-connection nil)
;; Contains the name of database objects
- (set (make-local-variable 'sql-contains-names) t)
+ (setq-local sql-contains-names t)
;; Keep track of existing object names
- (set (make-local-variable 'sql-completion-object) nil)
- (set (make-local-variable 'sql-completion-column) nil)
+ (setq-local sql-completion-object nil)
+ (setq-local sql-completion-column nil)
;; Create a useful name for renaming this buffer later.
- (set (make-local-variable 'sql-alternate-buffer-name)
- (sql-make-alternate-buffer-name))
+ (setq-local sql-alternate-buffer-name
+ (sql-make-alternate-buffer-name))
;; User stuff. Initialize before the hook.
- (set (make-local-variable 'sql-prompt-regexp)
- (or (sql-get-product-feature sql-product :prompt-regexp) "^"))
- (set (make-local-variable 'sql-prompt-length)
- (sql-get-product-feature sql-product :prompt-length))
- (set (make-local-variable 'sql-prompt-cont-regexp)
- (sql-get-product-feature sql-product :prompt-cont-regexp))
+ (setq-local sql-prompt-regexp
+ (or (sql-get-product-feature sql-product :prompt-regexp) "^"))
+ (setq-local sql-prompt-length
+ (sql-get-product-feature sql-product :prompt-length))
+ (setq-local sql-prompt-cont-regexp
+ (sql-get-product-feature sql-product :prompt-cont-regexp))
(make-local-variable 'sql-output-newline-count)
(make-local-variable 'sql-preoutput-hold)
(add-hook 'comint-preoutput-filter-functions
@@ -4369,7 +4368,7 @@ you entered, right above the output it created.
sql-prompt-regexp))
(setq left-margin (or sql-prompt-length 0))
;; Install input sender
- (set (make-local-variable 'comint-input-sender) #'sql-input-sender)
+ (setq-local comint-input-sender #'sql-input-sender)
;; People wanting a different history file for each
;; buffer/process/client/whatever can change separator and file-name
;; on the sql-interactive-mode-hook.
@@ -4650,8 +4649,7 @@ the call to \\[sql-product-interactive] with
;; Set the new buffer name
(setq new-sqli-buffer (current-buffer))
- (set (make-local-variable 'sql-buffer)
- (buffer-name new-sqli-buffer))
+ (setq-local sql-buffer (buffer-name new-sqli-buffer))
;; Set `sql-buffer' in the start buffer
(with-current-buffer start-buffer
diff --git a/lisp/progmodes/subword.el b/lisp/progmodes/subword.el
index 0f2c9431f6e..33b70d83bed 100644
--- a/lisp/progmodes/subword.el
+++ b/lisp/progmodes/subword.el
@@ -1,6 +1,6 @@
;;; subword.el --- Handling capitalized subwords in a nomenclature -*- lexical-binding: t -*-
-;; Copyright (C) 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;; Author: Masatake YAMATO
@@ -332,7 +332,7 @@ as parts of words: e.g., in `superword-mode',
searching subwords in order to avoid unwanted reentrancy.")
(defun subword-setup-buffer ()
- (set (make-local-variable 'find-word-boundary-function-table)
+ (setq-local find-word-boundary-function-table
(if (or subword-mode superword-mode)
subword-find-word-boundary-function-table
subword-empty-char-table)))
diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el
index d4d51e8b50c..0a0118a5eba 100644
--- a/lisp/progmodes/tcl.el
+++ b/lisp/progmodes/tcl.el
@@ -1,6 +1,6 @@
-;;; tcl.el --- Tcl code editing commands for Emacs
+;;; tcl.el --- Tcl code editing commands for Emacs -*- lexical-binding: t; -*-
-;; Copyright (C) 1994, 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 1998-2021 Free Software Foundation, Inc.
;; Author: Tom Tromey <tromey@redhat.com>
;; Chris Lindblad <cjl@lcs.mit.edu>
@@ -120,20 +120,17 @@
(defcustom tcl-indent-level 4
"Indentation of Tcl statements with respect to containing block."
- :type 'integer
- :group 'tcl)
-(put 'tcl-indent-level 'safe-local-variable 'integerp)
+ :type 'integer)
+(put 'tcl-indent-level 'safe-local-variable #'integerp)
(defcustom tcl-continued-indent-level 4
"Indentation of continuation line relative to first line of command."
- :type 'integer
- :group 'tcl)
-(put 'tcl-continued-indent-level 'safe-local-variable 'integerp)
+ :type 'integer)
+(put 'tcl-continued-indent-level 'safe-local-variable #'integerp)
(defcustom tcl-auto-newline nil
"Non-nil means automatically newline before and after braces you insert."
- :type 'boolean
- :group 'tcl)
+ :type 'boolean)
(defcustom tcl-tab-always-indent tab-always-indent
"Control effect of TAB key.
@@ -151,8 +148,7 @@ to take place:
6. Move backward to start of comment, indenting if necessary."
:type '(choice (const :tag "Always" t)
(const :tag "Beginning only" nil)
- (other :tag "Maybe move or make or delete comment" tcl))
- :group 'tcl)
+ (other :tag "Maybe move or make or delete comment" tcl)))
(defcustom tcl-electric-hash-style nil ;; 'smart
@@ -163,28 +159,23 @@ meaning that the choice between `backslash' and `quote' should be
made depending on the number of hashes inserted; or nil, meaning that
no quoting should be done. Any other value for this variable is
taken to mean `smart'. The default is nil."
- :type '(choice (const backslash) (const quote) (const smart) (const nil))
- :group 'tcl)
+ :type '(choice (const backslash) (const quote) (const smart) (const nil)))
(defcustom tcl-help-directory-list nil
"List of topmost directories containing TclX help files."
- :type '(repeat directory)
- :group 'tcl)
+ :type '(repeat directory))
(defcustom tcl-use-smart-word-finder t
"If not nil, use smart way to find current word, for Tcl help feature."
- :type 'boolean
- :group 'tcl)
+ :type 'boolean)
(defcustom tcl-application "wish"
"Name of Tcl program to run in inferior Tcl mode."
- :type 'string
- :group 'tcl)
+ :type 'string)
(defcustom tcl-command-switches nil
"List of switches to supply to the `tcl-application' program."
- :type '(repeat string)
- :group 'tcl)
+ :type '(repeat string))
(defcustom tcl-prompt-regexp "^\\(% \\|\\)"
"If not nil, a regexp that will match the prompt in the inferior process.
@@ -192,8 +183,7 @@ If nil, the prompt is the name of the application with \">\" appended.
The default is \"^\\(% \\|\\)\", which will match the default primary
and secondary prompts for tclsh and wish."
- :type 'regexp
- :group 'tcl)
+ :type 'regexp)
(defcustom inferior-tcl-source-command "source %s\n"
"Format-string for building a Tcl command to load a file.
@@ -201,12 +191,10 @@ This format string should use `%s' to substitute a file name
and should result in a Tcl expression that will command the
inferior Tcl to load that file. The filename will be appropriately
quoted for Tcl."
- :type 'string
- :group 'tcl)
+ :type 'string)
(defface tcl-escaped-newline '((t :inherit font-lock-string-face))
"Face used for (non-escaped) backslash at end of a line in Tcl mode."
- :group 'tcl
:version "22.1")
;;
@@ -266,16 +254,16 @@ quoted for Tcl."
;; Maybe someone has a better set?
(let ((map (make-sparse-keymap)))
;; Will inherit from `comint-mode-map' thanks to define-derived-mode.
- (define-key map "\t" 'completion-at-point)
- (define-key map "\M-?" 'comint-dynamic-list-filename-completions)
- (define-key map "\177" 'backward-delete-char-untabify)
- (define-key map "\M-\C-x" 'tcl-eval-defun)
- (define-key map "\C-c\C-i" 'tcl-help-on-word)
- (define-key map "\C-c\C-v" 'tcl-eval-defun)
- (define-key map "\C-c\C-f" 'tcl-load-file)
- (define-key map "\C-c\C-t" 'inferior-tcl)
- (define-key map "\C-c\C-x" 'tcl-eval-region)
- (define-key map "\C-c\C-s" 'switch-to-tcl)
+ (define-key map "\t" #'completion-at-point)
+ (define-key map "\M-?" #'comint-dynamic-list-filename-completions)
+ (define-key map "\177" #'backward-delete-char-untabify)
+ (define-key map "\M-\C-x" #'tcl-eval-defun)
+ (define-key map "\C-c\C-i" #'tcl-help-on-word)
+ (define-key map "\C-c\C-v" #'tcl-eval-defun)
+ (define-key map "\C-c\C-f" #'tcl-load-file)
+ (define-key map "\C-c\C-t" #'inferior-tcl)
+ (define-key map "\C-c\C-x" #'tcl-eval-region)
+ (define-key map "\C-c\C-s" #'switch-to-tcl)
map)
"Keymap used in `inferior-tcl-mode'.")
@@ -356,7 +344,7 @@ information):
Add functions to the hook with `add-hook':
- (add-hook 'tcl-mode-hook 'tcl-guess-application)")
+ (add-hook 'tcl-mode-hook #'tcl-guess-application)")
(defvar tcl-proc-list
@@ -461,6 +449,7 @@ This variable is generally set from `tcl-proc-regexp',
(string-to-syntax "."))))))))
(defconst tcl-syntax-propertize-function
+ ;; FIXME: Handle the [...] commands nested inside "..." strings.
(syntax-propertize-rules
;; Mark the few `#' that are not comment-markers.
((concat "[^" tcl--word-delimiters "][ \t]*\\(#\\)") (1 "."))
@@ -627,47 +616,43 @@ Turning on Tcl mode runs `tcl-mode-hook'. Read the documentation for
`tcl-mode-hook' to see what kinds of interesting hook functions
already exist."
(unless (and (boundp 'filladapt-mode) filladapt-mode)
- (set (make-local-variable 'paragraph-ignore-fill-prefix) t))
+ (setq-local paragraph-ignore-fill-prefix t))
- (set (make-local-variable 'indent-line-function) 'tcl-indent-line)
- (set (make-local-variable 'comment-indent-function) 'tcl-comment-indent)
+ (setq-local indent-line-function #'tcl-indent-line)
+ (setq-local comment-indent-function #'tcl-comment-indent)
;; Tcl doesn't require a final newline.
- ;; (make-local-variable 'require-final-newline)
- ;; (setq require-final-newline t)
+ ;; (setq-local require-final-newline t)
- (set (make-local-variable 'comment-start) "# ")
- (set (make-local-variable 'comment-start-skip)
- "\\(\\(^\\|[;{[]\\)\\s-*\\)#+ *")
- (set (make-local-variable 'comment-end) "")
+ (setq-local comment-start "# ")
+ (setq-local comment-start-skip
+ "\\(\\(^\\|[;{[]\\)\\s-*\\)#+ *")
+ (setq-local comment-end "")
- (set (make-local-variable 'outline-regexp) ".")
- (set (make-local-variable 'outline-level) 'tcl-outline-level)
+ (setq-local outline-regexp ".")
+ (setq-local outline-level 'tcl-outline-level)
- (set (make-local-variable 'font-lock-defaults)
- '(tcl-font-lock-keywords nil nil nil beginning-of-defun))
- (set (make-local-variable 'syntax-propertize-function)
- tcl-syntax-propertize-function)
+ (setq-local font-lock-defaults
+ '(tcl-font-lock-keywords nil nil nil beginning-of-defun))
+ (setq-local syntax-propertize-function
+ tcl-syntax-propertize-function)
(add-hook 'syntax-propertize-extend-region-functions
#'syntax-propertize-multiline 'append 'local)
- (set (make-local-variable 'imenu-generic-expression)
- tcl-imenu-generic-expression)
+ (setq-local imenu-generic-expression tcl-imenu-generic-expression)
;; Settings for new dabbrev code.
- (set (make-local-variable 'dabbrev-case-fold-search) nil)
- (set (make-local-variable 'dabbrev-case-replace) nil)
- (set (make-local-variable 'dabbrev-abbrev-skip-leading-regexp) "[$!]")
- (set (make-local-variable 'dabbrev-abbrev-char-regexp) "\\sw\\|\\s_")
+ (setq-local dabbrev-case-fold-search nil)
+ (setq-local dabbrev-case-replace nil)
+ (setq-local dabbrev-abbrev-skip-leading-regexp "[$!]")
+ (setq-local dabbrev-abbrev-char-regexp "\\sw\\|\\s_")
- (set (make-local-variable 'parse-sexp-ignore-comments) t)
- (set (make-local-variable 'defun-prompt-regexp) tcl-omit-ws-regexp)
- (set (make-local-variable 'add-log-current-defun-function)
- 'tcl-add-log-defun)
+ (setq-local parse-sexp-ignore-comments t)
+ (setq-local defun-prompt-regexp tcl-omit-ws-regexp)
+ (setq-local add-log-current-defun-function
+ #'tcl-add-log-defun)
(setq-local beginning-of-defun-function #'tcl-beginning-of-defun-function)
- (setq-local end-of-defun-function #'tcl-end-of-defun-function)
-
- (easy-menu-add tcl-mode-menu))
+ (setq-local end-of-defun-function #'tcl-end-of-defun-function))
@@ -1214,14 +1199,14 @@ Variables controlling Inferior Tcl mode:
The following commands are available:
\\{inferior-tcl-mode-map}"
- (set (make-local-variable 'comint-prompt-regexp)
- (or tcl-prompt-regexp
- (concat "^" (regexp-quote tcl-application) ">")))
+ (setq-local comint-prompt-regexp
+ (or tcl-prompt-regexp
+ (concat "^" (regexp-quote tcl-application) ">")))
(setq mode-line-process '(": %s"))
(setq local-abbrev-table tcl-mode-abbrev-table)
(set-syntax-table tcl-mode-syntax-table)
- (set (make-local-variable 'defun-prompt-regexp) tcl-omit-ws-regexp)
- (set (make-local-variable 'inferior-tcl-delete-prompt-marker) (make-marker))
+ (setq-local defun-prompt-regexp tcl-omit-ws-regexp)
+ (setq-local inferior-tcl-delete-prompt-marker (make-marker))
(set-process-filter (get-buffer-process (current-buffer)) 'tcl-filter))
;;;###autoload
@@ -1242,11 +1227,11 @@ See documentation for function `inferior-tcl-mode' for more information."
(unless (process-tty-name (inferior-tcl-proc))
(tcl-send-string (inferior-tcl-proc)
"set ::tcl_interactive 1; concat\n")))
- (set (make-local-variable 'tcl-application) cmd)
+ (setq-local tcl-application cmd)
(setq inferior-tcl-buffer "*inferior-tcl*")
(pop-to-buffer "*inferior-tcl*"))
-(defalias 'run-tcl 'inferior-tcl)
+(defalias 'run-tcl #'inferior-tcl)
@@ -1506,7 +1491,7 @@ Prefix argument means switch to the Tcl buffer afterwards."
(interactive "P")
(auto-fill-mode arg)
(if auto-fill-function
- (set (make-local-variable 'comment-auto-fill-only-comments) t)
+ (setq-local comment-auto-fill-only-comments t)
(kill-local-variable 'comment-auto-fill-only-comments)))
(defun tcl-electric-hash (&optional count)
@@ -1587,7 +1572,7 @@ The first line is assumed to look like \"#!.../program ...\"."
(save-excursion
(goto-char (point-min))
(if (looking-at "#![^ \t]*/\\([^ \t\n/]+\\)\\([ \t]\\|$\\)")
- (set (make-local-variable 'tcl-application) (match-string 1)))))
+ (setq-local tcl-application (match-string 1)))))
(defun tcl-popup-menu (_e)
"XEmacs menu support."
diff --git a/lisp/progmodes/vera-mode.el b/lisp/progmodes/vera-mode.el
index 8bde89e774e..c2e1719d54a 100644
--- a/lisp/progmodes/vera-mode.el
+++ b/lisp/progmodes/vera-mode.el
@@ -1,6 +1,6 @@
;;; vera-mode.el --- major mode for editing Vera files -*- lexical-binding: t; -*-
-;; Copyright (C) 1997-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
;; Author: Reto Zimmermann <reto@gnu.org>
;; Version: 2.28
diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el
index b1abefe534e..8dddcf0eef0 100644
--- a/lisp/progmodes/verilog-mode.el
+++ b/lisp/progmodes/verilog-mode.el
@@ -1,6 +1,6 @@
;;; verilog-mode.el --- major mode for editing verilog source in Emacs
-;; Copyright (C) 1996-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
;; Author: Michael McNamara <mac@verilog.com>
;; Wilson Snyder <wsnyder@wsnyder.org>
@@ -5193,7 +5193,7 @@ Useful for creating tri's and other expanded fields."
(verilog-expand-vector-internal "[" "]"))
(defun verilog-expand-vector-internal (bra ket)
- "Given BRA, the start brace and KET, the end brace, expand one line into many lines."
+ "Given start brace BRA, and end brace KET, expand one line into many lines."
(save-excursion
(forward-line 0)
(let ((signal-string (buffer-substring (point)
@@ -10112,7 +10112,8 @@ variables to build the path."
;; A modi is: [module-name-string file-name begin-point]
(defvar verilog-cache-enabled t
- "Non-nil enables caching of signals, etc. Set to nil for debugging to make things SLOW!")
+ "Non-nil enables caching of signals, etc.
+Set to nil for debugging to make things SLOW!")
(defvar verilog-modi-cache-list nil
"Cache of ((Module Function) Buf-Tick Buf-Modtime Func-Returns)...
@@ -10449,7 +10450,7 @@ if non-nil."
;;
(defun verilog-auto-re-search-do (search-for func)
- "Search for the given auto text regexp SEARCH-FOR, and perform FUNC where it occurs."
+ "Search for given auto text regexp SEARCH-FOR, and perform FUNC where it occurs."
(goto-char (point-min))
(while (verilog-re-search-forward-quick search-for nil t)
(funcall func)))
@@ -10861,7 +10862,8 @@ removed."
(defun verilog-delete-auto-buffer ()
"Perform `verilog-delete-auto' on the current buffer.
-Intended for internal use inside a `verilog-save-font-no-change-functions' block."
+Intended for internal use inside a
+`verilog-save-font-no-change-functions' block."
;; Allow user to customize
(verilog-run-hooks 'verilog-before-delete-auto-hook)
diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el
index 3d66483b83e..c4de800e332 100644
--- a/lisp/progmodes/vhdl-mode.el
+++ b/lisp/progmodes/vhdl-mode.el
@@ -1,6 +1,6 @@
;;; vhdl-mode.el --- major mode for editing VHDL code
-;; Copyright (C) 1992-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1992-2021 Free Software Foundation, Inc.
;; Authors: Reto Zimmermann <reto@gnu.org>
;; Rodney J. Whitby <software.vhdl-mode@rwhitby.net>
@@ -2286,7 +2286,7 @@ Ignore byte-compiler warnings you might see."
(setq contents
(nconc
(if (and (car dirs) (not full))
- (mapcar (function (lambda (name) (concat (car dirs) name)))
+ (mapcar (lambda (name) (concat (car dirs) name))
this-dir-contents)
this-dir-contents)
contents))))
@@ -2563,7 +2563,7 @@ conversion."
(defun vhdl-sort-alist (alist)
"Sort ALIST."
- (sort alist (function (lambda (a b) (string< (car a) (car b))))))
+ (sort alist (lambda (a b) (string< (car a) (car b)))))
(defun vhdl-get-subdirs (directory)
"Recursively get subdirectories of DIRECTORY."
@@ -2941,10 +2941,9 @@ STRING are replaced by `-' and substrings are converted to lower case."
;; set up electric character functions to work with
;; `delete-selection-mode' (Emacs) and `pending-delete-mode' (XEmacs)
(mapc
- (function
- (lambda (sym)
- (put sym 'delete-selection t) ; for `delete-selection-mode' (Emacs)
- (put sym 'pending-delete t))) ; for `pending-delete-mode' (XEmacs)
+ (lambda (sym)
+ (put sym 'delete-selection t) ; for `delete-selection-mode' (Emacs)
+ (put sym 'pending-delete t)) ; for `pending-delete-mode' (XEmacs)
'(vhdl-electric-space
vhdl-electric-tab
vhdl-electric-return
@@ -3317,7 +3316,7 @@ STRING are replaced by `-' and substrings are converted to lower case."
(setq menu-list
(if vhdl-project-sort
(sort menu-list
- (function (lambda (a b) (string< (elt a 0) (elt b 0)))))
+ (lambda (a b) (string< (elt a 0) (elt b 0))))
(nreverse menu-list)))
(vhdl-menu-split menu-list "Project"))
'("--" "--"
@@ -4205,9 +4204,11 @@ STRING are replaced by `-' and substrings are converted to lower case."
(defun vhdl-update-mode-menu ()
"Update VHDL Mode menu."
(interactive)
- (easy-menu-remove vhdl-mode-menu-list) ; for XEmacs
+ (when (featurep 'xemacs)
+ (easy-menu-remove vhdl-mode-menu-list))
(setq vhdl-mode-menu-list (vhdl-create-mode-menu))
- (easy-menu-add vhdl-mode-menu-list) ; for XEmacs
+ (when (featurep 'xemacs)
+ (easy-menu-add vhdl-mode-menu-list))
(easy-menu-define vhdl-mode-menu vhdl-mode-map
"Menu keymap for VHDL Mode." vhdl-mode-menu-list))
@@ -4313,7 +4314,8 @@ The directory of the current source file is scanned."
(push ["*Rescan*" vhdl-add-source-files-menu t] menu-list)
(push "Sources" menu-list)
;; Create menu
- (easy-menu-add menu-list)
+ (when (featurep 'xemacs)
+ (easy-menu-add menu-list))
(easy-menu-define vhdl-sources-menu newmap
"VHDL source files menu" menu-list))
(message ""))
@@ -4926,7 +4928,8 @@ Key bindings:
;; add source file menu
(if vhdl-source-file-menu (vhdl-add-source-files-menu))
;; add VHDL menu
- (easy-menu-add vhdl-mode-menu-list) ; for XEmacs
+ (when (featurep 'xemacs)
+ (easy-menu-add vhdl-mode-menu-list))
(easy-menu-define vhdl-mode-menu vhdl-mode-map
"Menu keymap for VHDL Mode." vhdl-mode-menu-list)
;; initialize hideshow and add menu
@@ -5336,9 +5339,6 @@ Key bindings:
(defvar vhdl-reserved-words-regexp nil
"Regexp for additional reserved words.")
-(defvar vhdl-directive-keywords-regexp nil
- "Regexp for compiler directive keywords.")
-
(defun vhdl-upcase-list (condition list)
"Upcase all elements in LIST based on CONDITION."
(when condition
@@ -5416,9 +5416,6 @@ Key bindings:
(concat vhdl-forbidden-syntax "\\|"))
(regexp-opt vhdl-reserved-words)
"\\)\\>"))
- (setq vhdl-directive-keywords-regexp
- (concat "\\<\\(" (mapconcat 'regexp-quote
- vhdl-directive-keywords "\\|") "\\)\\>"))
(vhdl-abbrev-list-init))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -5568,9 +5565,8 @@ offset for that syntactic element. Optional ADD-P says to add SYMBOL to
(if current-prefix-arg " or add" "")
": ")
(mapcar
- (function
- (lambda (langelem)
- (cons (format "%s" (car langelem)) nil)))
+ (lambda (langelem)
+ (cons (format "%s" (car langelem)) nil))
vhdl-offsets-alist)
nil (not current-prefix-arg)
;; initial contents tries to be the last element
@@ -5617,26 +5613,24 @@ argument. The styles are chosen from the `vhdl-style-alist' variable."
(error "ERROR: Invalid VHDL indentation style `%s'" style))
;; set all the variables
(mapc
- (function
- (lambda (varentry)
- (let ((var (car varentry))
- (val (cdr varentry)))
- ;; special case for vhdl-offsets-alist
- (if (not (eq var 'vhdl-offsets-alist))
- (set (if local (make-local-variable var) var) val)
- ;; reset vhdl-offsets-alist to the default value first
- (set (if local (make-local-variable var) var)
- (copy-alist vhdl-offsets-alist-default))
- ;; now set the langelems that are different
- (mapcar
- (function
- (lambda (langentry)
- (let ((langelem (car langentry))
- (offset (cdr langentry)))
- (vhdl-set-offset langelem offset)
- )))
- val))
- )))
+ (lambda (varentry)
+ (let ((var (car varentry))
+ (val (cdr varentry)))
+ ;; special case for vhdl-offsets-alist
+ (if (not (eq var 'vhdl-offsets-alist))
+ (set (if local (make-local-variable var) var) val)
+ ;; reset vhdl-offsets-alist to the default value first
+ (set (if local (make-local-variable var) var)
+ (copy-alist vhdl-offsets-alist-default))
+ ;; now set the langelems that are different
+ (mapcar
+ (lambda (langentry)
+ (let ((langelem (car langentry))
+ (offset (cdr langentry)))
+ (vhdl-set-offset langelem offset)
+ ))
+ val))
+ ))
vars))
(vhdl-keep-region-active))
@@ -7580,12 +7574,11 @@ ENDPOS is encountered."
(expurgated))
;; remove the library unit symbols
(mapc
- (function
- (lambda (elt)
- (if (memq (car elt) '(entity configuration context package
- package-body architecture))
- nil
- (setq expurgated (append expurgated (list elt))))))
+ (lambda (elt)
+ (if (memq (car elt) '(entity configuration context package
+ package-body architecture))
+ nil
+ (setq expurgated (append expurgated (list elt)))))
actual)
(if (and (not arg) expected (listp expected))
(if (not (equal expected expurgated))
@@ -7952,7 +7945,7 @@ the token in MATCH."
(push (cons start length) comment-list))
(beginning-of-line 2))
(setq comment-list
- (sort comment-list (function (lambda (a b) (> (car a) (car b))))))
+ (sort comment-list (lambda (a b) (> (car a) (car b)))))
;; reduce start positions
(setq start-list (list (caar comment-list)))
(setq comment-list (cdr comment-list))
@@ -13631,7 +13624,10 @@ This does background highlighting of translate-off regions.")
vhdl-template-prompt-syntax ">\\)")
2 'vhdl-font-lock-prompt-face t)
(list (concat "--\\s-*"
- vhdl-directive-keywords-regexp "\\s-+\\(.*\\)$")
+ "\\<"
+ (regexp-opt vhdl-directive-keywords t)
+ "\\>"
+ "\\s-+\\(.*\\)$")
2 'vhdl-font-lock-directive-face t)
;; highlight c-preprocessor directives
(list "^#[ \t]*\\(\\w+\\)\\([ \t]+\\(\\w+\\)\\)?"
@@ -15885,8 +15881,7 @@ NO-POSITION non-nil means do not re-position cursor."
(setq path-list-1
(append
(mapcar
- (function
- (lambda (var) (concat path-beg var path-end)))
+ (lambda (var) (concat path-beg var path-end))
(let ((all-list (vhdl-directory-files
(match-string 2 dir) t
(concat "\\<" (wildcard-to-regexp
@@ -17439,8 +17434,8 @@ specified by a target."
(setq tmp-list (cdr tmp-list)))
(setq rule-alist ; sort by first rule target
(sort rule-alist
- (function (lambda (a b)
- (string< (car (cadr a)) (car (cadr b)))))))
+ (lambda (a b)
+ (string< (car (cadr a)) (car (cadr b))))))
;; open and clear Makefile
(set-buffer (find-file-noselect makefile-path-name t t))
(erase-buffer)
@@ -17751,16 +17746,15 @@ specified by a target."
'vhdl-word-completion-in-minibuffer
'vhdl-underscore-is-part-of-word
'vhdl-mode-hook)
- (function
- (lambda ()
- (insert
- (if vhdl-special-indent-hook
- (concat "\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n"
- "vhdl-special-indent-hook is set to '"
- (format "%s" vhdl-special-indent-hook)
- ".\nPerhaps this is your problem?\n"
- "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n\n")
- "\n"))))
+ (lambda ()
+ (insert
+ (if vhdl-special-indent-hook
+ (concat "\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n"
+ "vhdl-special-indent-hook is set to '"
+ (format "%s" vhdl-special-indent-hook)
+ ".\nPerhaps this is your problem?\n"
+ "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n\n")
+ "\n")))
nil
"Hi Reto,"))))
diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el
index 266f40abbae..3303257c98c 100644
--- a/lisp/progmodes/which-func.el
+++ b/lisp/progmodes/which-func.el
@@ -1,6 +1,6 @@
;;; which-func.el --- print current function in mode line -*- lexical-binding:t -*-
-;; Copyright (C) 1994, 1997-1998, 2001-2020 Free Software Foundation,
+;; Copyright (C) 1994, 1997-1998, 2001-2021 Free Software Foundation,
;; Inc.
;; Author: Alex Rezinsky <alexr@msil.sps.mot.com>
@@ -186,7 +186,7 @@ and you want to simplify them for the mode line
"Non-nil means display current function name in mode line.
This makes a difference only if `which-function-mode' is non-nil.")
-(add-hook 'after-change-major-mode-hook 'which-func-ff-hook t)
+(add-hook 'after-change-major-mode-hook #'which-func-ff-hook t)
(defun which-func-try-to-enable ()
(unless (or (not which-function-mode)
@@ -216,7 +216,8 @@ It creates the Imenu index for the buffer, if necessary."
(defun which-func-update ()
;; "Update the Which-Function mode display for all windows."
;; (walk-windows 'which-func-update-1 nil 'visible))
- (which-func-update-1 (selected-window)))
+ (let ((non-essential t))
+ (which-func-update-1 (selected-window))))
(defun which-func-update-1 (window)
"Update the Which Function mode display for window WINDOW."
@@ -293,7 +294,7 @@ If no function name is found, return nil."
(null which-function-imenu-failed))
(ignore-errors (imenu--make-index-alist t))
(unless imenu--index-alist
- (set (make-local-variable 'which-function-imenu-failed) t)))
+ (setq-local which-function-imenu-failed t)))
;; If we have an index alist, use it.
(when (and (null name)
(boundp 'imenu--index-alist) imenu--index-alist)
@@ -356,7 +357,7 @@ This function is meant to be called from `ediff-select-hook'."
(when ediff-window-C
(which-func-update-1 ediff-window-C))))
-(add-hook 'ediff-select-hook 'which-func-update-ediff-windows)
+(add-hook 'ediff-select-hook #'which-func-update-ediff-windows)
(provide 'which-func)
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index a1c4c08c263..aecb30a0ad4 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -1,7 +1,7 @@
;;; xref.el --- Cross-referencing commands -*-lexical-binding:t-*-
-;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
-;; Version: 1.0.3
+;; Copyright (C) 2014-2021 Free Software Foundation, Inc.
+;; Version: 1.0.4
;; Package-Requires: ((emacs "26.3"))
;; This is a GNU ELPA :core package. Avoid functionality that is not
@@ -97,6 +97,10 @@ This is typically the filename.")
"Return the line number corresponding to the location."
nil)
+(cl-defgeneric xref-location-column (_location)
+ "Return the exact column corresponding to the location."
+ nil)
+
(cl-defgeneric xref-match-length (_item)
"Return the length of the match."
nil)
@@ -105,12 +109,20 @@ This is typically the filename.")
(defcustom xref-file-name-display 'abs
"Style of file name display in *xref* buffers.
+
If the value is the symbol `abs', the default, show the file names
in their full absolute form.
+
If `nondirectory', show only the nondirectory (a.k.a. \"base name\")
-part of the file name."
+part of the file name.
+
+If `project-relative', show only the file name relative to the
+current project root. If there is no current project, or if the
+file resides outside of its root, show that particular file name
+in its full absolute form."
:type '(choice (const :tag "absolute file name" abs)
- (const :tag "nondirectory file name" nondirectory))
+ (const :tag "nondirectory file name" nondirectory)
+ (const :tag "relative to project root" project-relative))
:version "27.1")
;; FIXME: might be useful to have an optional "hint" i.e. a string to
@@ -118,7 +130,7 @@ part of the file name."
(defclass xref-file-location (xref-location)
((file :type string :initarg :file)
(line :type fixnum :initarg :line :reader xref-location-line)
- (column :type fixnum :initarg :column :reader xref-file-location-column))
+ (column :type fixnum :initarg :column :reader xref-location-column))
:documentation "A file location is a file/line/column triple.
Line numbers start from 1 and columns from 0.")
@@ -145,10 +157,31 @@ Line numbers start from 1 and columns from 0.")
(forward-char column))
(point-marker))))))
+(defvar xref--project-root-memo nil
+ "Cons mapping `default-directory' value to the search root.")
+
(cl-defmethod xref-location-group ((l xref-file-location))
(cl-ecase xref-file-name-display
- (abs (oref l file))
- (nondirectory (file-name-nondirectory (oref l file)))))
+ (abs
+ (oref l file))
+ (nondirectory
+ (file-name-nondirectory (oref l file)))
+ (project-relative
+ (unless (and xref--project-root-memo
+ (equal (car xref--project-root-memo)
+ default-directory))
+ (setq xref--project-root-memo
+ (cons default-directory
+ (let ((root
+ (let ((pr (project-current)))
+ (and pr (xref--project-root pr)))))
+ (and root (expand-file-name root))))))
+ (let ((file (oref l file))
+ (search-root (cdr xref--project-root-memo)))
+ (if (and search-root
+ (string-prefix-p search-root file))
+ (substring file (length search-root))
+ file)))))
(defclass xref-buffer-location (xref-location)
((buffer :type buffer :initarg :buffer)
@@ -269,10 +302,7 @@ current project's main and external roots."
(xref-references-in-directory identifier dir))
(let ((pr (project-current t)))
(cons
- (if (fboundp 'project-root)
- (project-root pr)
- (with-no-warnings
- (project-roots pr)))
+ (xref--project-root pr)
(project-external-roots pr)))))
(cl-defgeneric xref-backend-apropos (backend pattern)
@@ -517,8 +547,7 @@ If SELECT is non-nil, select the target window."
"Goto and display position POS of buffer BUF in a window.
Honor `xref--original-window-intent', run `xref-after-jump-hook'
and finally return the window."
- (let* ((xref-buf (current-buffer))
- (pop-up-frames
+ (let* ((pop-up-frames
(or (eq xref--original-window-intent 'frame)
pop-up-frames))
(action
@@ -536,9 +565,6 @@ and finally return the window."
(with-selected-window (display-buffer buf action)
(xref--goto-char pos)
(run-hooks 'xref-after-jump-hook)
- (let ((buf (current-buffer)))
- (with-current-buffer xref-buf
- (setq-local other-window-scroll-buffer buf)))
(selected-window))))
(defun xref--display-buffer-in-other-window (buffer alist)
@@ -593,16 +619,35 @@ SELECT is `quit', also quit the *xref* window."
(xref--search-property 'xref-item t)
(xref-show-location-at-point))
+(defun xref-next-group ()
+ "Move to the first item of the next xref group and display its source."
+ (interactive)
+ (xref--search-property 'xref-group)
+ (xref--search-property 'xref-item)
+ (xref-show-location-at-point))
+
+(defun xref-prev-group ()
+ "Move to the first item of the previous xref group and display its source."
+ (interactive)
+ ;; Search for the xref group of the current item, provided that the
+ ;; point is not already in an xref group.
+ (unless (plist-member (text-properties-at (point)) 'xref-group)
+ (xref--search-property 'xref-group t))
+ ;; Search for the previous xref group.
+ (xref--search-property 'xref-group t)
+ (xref--search-property 'xref-item)
+ (xref-show-location-at-point))
+
(defun xref--item-at-point ()
- (save-excursion
- (back-to-indentation)
- (get-text-property (point) 'xref-item)))
+ (get-text-property
+ (if (eolp) (1- (point)) (point))
+ 'xref-item))
(defun xref-goto-xref (&optional quit)
"Jump to the xref on the current line and select its window.
-Non-interactively, non-nil QUIT means to first quit the *xref*
-buffer."
- (interactive)
+Non-interactively, non-nil QUIT, or interactively, with prefix argument
+means to first quit the *xref* buffer."
+ (interactive "P")
(let* ((buffer (current-buffer))
(xref (or (xref--item-at-point)
(user-error "No reference at point")))
@@ -618,6 +663,12 @@ buffer."
(interactive)
(xref-goto-xref t))
+(defun xref-quit-and-pop-marker-stack ()
+ "Quit *xref* buffer, then pop the xref marker stack."
+ (interactive)
+ (quit-window)
+ (xref-pop-marker-stack))
+
(defun xref-query-replace-in-results (from to)
"Perform interactive replacement of FROM with TO in all displayed xrefs.
@@ -738,6 +789,8 @@ references displayed in the current *xref* buffer."
(let ((map (make-sparse-keymap)))
(define-key map (kbd "n") #'xref-next-line)
(define-key map (kbd "p") #'xref-prev-line)
+ (define-key map (kbd "N") #'xref-next-group)
+ (define-key map (kbd "P") #'xref-prev-group)
(define-key map (kbd "r") #'xref-query-replace-in-results)
(define-key map (kbd "RET") #'xref-goto-xref)
(define-key map (kbd "TAB") #'xref-quit-and-goto-xref)
@@ -746,6 +799,7 @@ references displayed in the current *xref* buffer."
(define-key map (kbd ".") #'xref-next-line)
(define-key map (kbd ",") #'xref-prev-line)
(define-key map (kbd "g") #'xref-revert-buffer)
+ (define-key map (kbd "M-,") #'xref-quit-and-pop-marker-stack)
map))
(define-derived-mode xref--xref-buffer-mode special-mode "XREF"
@@ -832,17 +886,30 @@ GROUP is a string for decoration purposes and XREF is an
(length (and line (format "%d" line)))))
for line-format = (and max-line-width
(format "%%%dd: " max-line-width))
+ with prev-line-key = nil
do
(xref--insert-propertized '(face xref-file-header xref-group t)
group "\n")
(cl-loop for (xref . more2) on xrefs do
(with-slots (summary location) xref
(let* ((line (xref-location-line location))
+ (new-summary summary)
+ (line-key (list (xref-location-group location) line))
(prefix
(if line
(propertize (format line-format line)
'face 'xref-line-number)
" ")))
+ ;; Render multiple matches on the same line, together.
+ (when (and line (equal prev-line-key line-key))
+ (when-let ((column (xref-location-column location)))
+ (delete-region
+ (save-excursion
+ (forward-line -1)
+ (move-to-column (+ (length prefix) column))
+ (point))
+ (point))
+ (setq new-summary (substring summary column) prefix "")))
(xref--insert-propertized
(list 'xref-item xref
'mouse-face 'highlight
@@ -850,7 +917,8 @@ GROUP is a string for decoration purposes and XREF is an
'help-echo
(concat "mouse-2: display in another window, "
"RET or mouse-1: follow reference"))
- prefix summary)))
+ prefix new-summary)
+ (setq prev-line-key line-key)))
(insert "\n"))))
(defun xref--analyze (xrefs)
@@ -867,13 +935,21 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)."
(or
(assoc-default 'fetched-xrefs alist)
(funcall fetcher)))
- (xref-alist (xref--analyze xrefs)))
+ (xref-alist (xref--analyze xrefs))
+ (dd default-directory))
(with-current-buffer (get-buffer-create xref-buffer-name)
+ (setq default-directory dd)
(xref--xref-buffer-mode)
(xref--show-common-initialize xref-alist fetcher alist)
(pop-to-buffer (current-buffer))
(current-buffer))))
+(defun xref--project-root (project)
+ (if (fboundp 'project-root)
+ (project-root project)
+ (with-no-warnings
+ (car (project-roots project)))))
+
(defun xref--show-common-initialize (xref-alist fetcher alist)
(setq buffer-undo-list nil)
(let ((inhibit-read-only t)
@@ -902,7 +978,10 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)."
'face 'error))))
(goto-char (point-min)))))
-(defun xref--show-defs-buffer (fetcher alist)
+(defun xref-show-definitions-buffer (fetcher alist)
+ "Show the definitions list in a regular window.
+
+When only one definition found, jump to it right away instead."
(let ((xrefs (funcall fetcher)))
(cond
((not (cdr xrefs))
@@ -913,24 +992,97 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)."
(cons (cons 'fetched-xrefs xrefs)
alist))))))
-(defun xref--show-defs-buffer-at-bottom (fetcher alist)
- "Show definitions list in a window at the bottom.
+(define-obsolete-function-alias
+ 'xref--show-defs-buffer #'xref-show-definitions-buffer "28.1")
+
+(defun xref-show-definitions-buffer-at-bottom (fetcher alist)
+ "Show the definitions list in a window at the bottom.
+
When there is more than one definition, split the selected window
and show the list in a small window at the bottom. And use a
local keymap that binds `RET' to `xref-quit-and-goto-xref'."
- (let ((xrefs (funcall fetcher)))
+ (let* ((xrefs (funcall fetcher))
+ (dd default-directory)
+ ;; XXX: Make percentage customizable maybe?
+ (max-height (/ (window-height) 2))
+ (size-fun (lambda (window)
+ (fit-window-to-buffer window max-height))))
(cond
((not (cdr xrefs))
(xref-pop-to-location (car xrefs)
(assoc-default 'display-action alist)))
(t
(with-current-buffer (get-buffer-create xref-buffer-name)
+ (setq default-directory dd)
(xref--transient-buffer-mode)
(xref--show-common-initialize (xref--analyze xrefs) fetcher alist)
(pop-to-buffer (current-buffer)
- '(display-buffer-in-direction . ((direction . below))))
+ `(display-buffer-in-direction . ((direction . below)
+ (window-height . ,size-fun))))
(current-buffer))))))
+(define-obsolete-function-alias 'xref--show-defs-buffer-at-bottom
+ #'xref-show-definitions-buffer-at-bottom "28.1")
+
+(defun xref-show-definitions-completing-read (fetcher alist)
+ "Let the user choose the target definition with completion.
+
+When there is more than one definition, let the user choose
+between them by typing in the minibuffer with completion."
+ (let* ((xrefs (funcall fetcher))
+ (xref-alist (xref--analyze xrefs))
+ xref-alist-with-line-info
+ xref
+ (group-prefix-length
+ ;; FIXME: Groups are not always file names, but they often
+ ;; are. At least this shouldn't make the other kinds of
+ ;; groups look worse.
+ (let ((common-prefix (try-completion "" xref-alist)))
+ (if (> (length common-prefix) 0)
+ (length (file-name-directory common-prefix))
+ 0))))
+
+ (cl-loop for ((group . xrefs) . more1) on xref-alist
+ do
+ (cl-loop for (xref . more2) on xrefs do
+ (with-slots (summary location) xref
+ (let* ((line (xref-location-line location))
+ (line-fmt
+ (if line
+ (format #("%d:" 0 2 (face xref-line-number))
+ line)
+ ""))
+ (group-fmt
+ (propertize
+ (substring group group-prefix-length)
+ 'face 'xref-file-header))
+ (candidate
+ (format "%s:%s%s" group-fmt line-fmt summary)))
+ (push (cons candidate xref) xref-alist-with-line-info)))))
+
+ (setq xref (if (not (cdr xrefs))
+ (car xrefs)
+ (let* ((collection (reverse xref-alist-with-line-info))
+ (ctable
+ (lambda (string pred action)
+ (cond
+ ((eq action 'metadata)
+ '(metadata . ((category . xref-location))))
+ (t
+ (complete-with-action action collection string pred)))))
+ (def (caar collection)))
+ (cdr (assoc (completing-read "Choose definition: "
+ ctable nil t
+ nil nil
+ def)
+ collection)))))
+
+ (xref-pop-to-location xref (assoc-default 'display-action alist))))
+
+;; TODO: Can delete this alias before Emacs 28's release.
+(define-obsolete-function-alias
+ 'xref--show-defs-minibuffer #'xref-show-definitions-completing-read "28.1")
+
(defcustom xref-show-xrefs-function 'xref--show-xref-buffer
"Function to display a list of search results.
@@ -951,11 +1103,22 @@ displayed. The possible values are nil, `window' meaning the
other window, or `frame' meaning the other frame."
:type 'function)
-(defcustom xref-show-definitions-function 'xref--show-defs-buffer
- "Function to display a list of definitions.
+(defcustom xref-show-definitions-function 'xref-show-definitions-buffer
+ "Function to handle the definition search results.
-Accepts the same arguments as `xref-show-xrefs-function'."
- :type 'function)
+Accepts the same arguments as `xref-show-xrefs-function'.
+
+Generally, it is expected to jump to the definition if there's
+only one, and otherwise provide some way to choose among the
+definitions."
+ :type '(choice
+ (const :tag "Show a regular list of locations"
+ xref-show-definitions-buffer)
+ (const :tag "Show a \"transient\" list at the bottom of the window"
+ xref-show-definitions-buffer-at-bottom)
+ (const :tag "Choose the definition with completion"
+ xref-show-definitions-completing-read)
+ (function :tag "Custom function")))
(defvar xref--read-identifier-history nil)
@@ -1227,7 +1390,8 @@ IGNORES is a list of glob patterns for files to ignore."
;; do that reliably enough, without creating false negatives?
(command (xref--rgrep-command (xref--regexp-to-extended regexp)
files
- (file-local-name (expand-file-name dir))
+ (file-name-as-directory
+ (file-local-name (expand-file-name dir)))
ignores))
(def default-directory)
(buf (get-buffer-create " *xref-grep*"))
@@ -1262,12 +1426,61 @@ IGNORES is a list of glob patterns for files to ignore."
(declare-function tramp-tramp-file-p "tramp")
(declare-function tramp-file-local-name "tramp")
+;; TODO: Experiment with 'xargs -P4' (or any other number).
+;; This speeds up either command, even more than rg's '-j4' does.
+;; Ripgrep gets jumbled output, though, even with --line-buffered.
+;; But Grep seems to be stable. Even without --line-buffered.
+(defcustom xref-search-program-alist
+ '((grep
+ .
+ ;; '-s' because 'git ls-files' can output broken symlinks.
+ "xargs -0 grep <C> -snHE -e <R>")
+ (ripgrep
+ .
+ ;; Note: by default, ripgrep's output order is non-deterministic
+ ;; (https://github.com/BurntSushi/ripgrep/issues/152)
+ ;; because it does the search in parallel. You can use the template
+ ;; without the '| sort ...' part if GNU sort is not available on
+ ;; your system and/or stable ordering is not important to you.
+ ;; Note#2: '!*/' is there to filter out dirs (e.g. submodules).
+ "xargs -0 rg <C> -nH --no-messages -g '!*/' -e <R> | sort -t: -k1,1 -k2n,2"
+ ))
+ "Associative list mapping program identifiers to command templates.
+
+Program identifier should be a symbol, named after the search program.
+
+The command template must be a shell command (or usually a
+pipeline) that will search the files based on the list of file
+names that is piped from stdin, separated by null characters.
+The template should have the following fields:
+
+ <C> for extra arguments such as -i and --color
+ <R> for the regexp itself (in Extended format)"
+ :type '(repeat
+ (cons (symbol :tag "Program identifier")
+ (string :tag "Command template")))
+ :version "28.1"
+ :package-version '(xref . "1.0.4"))
+
+(defcustom xref-search-program 'grep
+ "The program to use for regexp search inside files.
+
+This must reference a corresponding entry in `xref-search-program-alist'."
+ :type `(choice
+ (const :tag "Use Grep" grep)
+ (const :tag "Use ripgrep" ripgrep)
+ (symbol :tag "User defined"))
+ :version "28.1"
+ :package-version '(xref . "1.0.4"))
+
;;;###autoload
(defun xref-matches-in-files (regexp files)
"Find all matches for REGEXP in FILES.
Return a list of xref values.
FILES must be a list of absolute file names."
(cl-assert (consp files))
+ (require 'grep)
+ (defvar grep-highlight-matches)
(pcase-let*
((output (get-buffer-create " *project grep output*"))
(`(,grep-re ,file-group ,line-group . ,_) (car grep-regexp-alist))
@@ -1277,13 +1490,17 @@ FILES must be a list of absolute file names."
;; first file is remote, they all are, and on the same host.
(dir (file-name-directory (car files)))
(remote-id (file-remote-p dir))
- ;; 'git ls-files' can output broken symlinks.
- (command (format "xargs -0 grep %s -snHE -e %s"
- (if (and case-fold-search
- (isearch-no-upper-case-p regexp t))
- "-i"
- "")
- (shell-quote-argument (xref--regexp-to-extended regexp)))))
+ ;; The 'auto' default would be fine too, but ripgrep can't handle
+ ;; the options we pass in that case.
+ (grep-highlight-matches nil)
+ (command (grep-expand-template (cdr
+ (or
+ (assoc
+ xref-search-program
+ xref-search-program-alist)
+ (user-error "Unknown search program `%s'"
+ xref-search-program)))
+ (xref--regexp-to-extended regexp))))
(when remote-id
(require 'tramp)
(setq files (mapcar
diff --git a/lisp/progmodes/xscheme.el b/lisp/progmodes/xscheme.el
index c6997862f7f..e85e3cfdbbd 100644
--- a/lisp/progmodes/xscheme.el
+++ b/lisp/progmodes/xscheme.el
@@ -1,6 +1,6 @@
;;; xscheme.el --- run MIT Scheme under Emacs -*- lexical-binding: t; -*-
-;; Copyright (C) 1986-1987, 1989-1990, 2001-2020 Free Software
+;; Copyright (C) 1986-1987, 1989-1990, 2001-2021 Free Software
;; Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
@@ -173,7 +173,7 @@ With argument, asks for a command line."
(setq-default xscheme-process-command-line command-line)
(switch-to-buffer
(xscheme-start-process command-line process-name buffer-name))
- (set (make-local-variable 'xscheme-process-command-line) command-line))
+ (setq-local xscheme-process-command-line command-line))
(defun xscheme-read-command-line (arg)
(let ((default
@@ -264,11 +264,11 @@ With argument, asks for a command line."
xscheme-buffer-name
t)))
(let ((process-name (verify-xscheme-buffer buffer-name t)))
- (set (make-local-variable 'xscheme-buffer-name) buffer-name)
- (set (make-local-variable 'xscheme-process-name) process-name)
- (set (make-local-variable 'xscheme-runlight)
- (with-current-buffer buffer-name
- xscheme-runlight))))
+ (setq-local xscheme-buffer-name buffer-name)
+ (setq-local xscheme-process-name process-name)
+ (setq-local xscheme-runlight
+ (with-current-buffer buffer-name
+ xscheme-runlight))))
(defun local-clear-scheme-interaction-buffer ()
"Make the current buffer use the default scheme interaction buffer."
@@ -375,10 +375,10 @@ Entry to this mode runs `scheme-mode-hook' and then
(kill-all-local-variables)
(make-local-variable 'xscheme-runlight-string)
(make-local-variable 'xscheme-runlight)
- (set (make-local-variable 'xscheme-previous-mode) previous-mode)
+ (setq-local xscheme-previous-mode previous-mode)
(let ((buffer (current-buffer)))
- (set (make-local-variable 'xscheme-buffer-name) (buffer-name buffer))
- (set (make-local-variable 'xscheme-last-input-end) (make-marker))
+ (setq-local xscheme-buffer-name (buffer-name buffer))
+ (setq-local xscheme-last-input-end (make-marker))
(let ((process (get-buffer-process buffer)))
(when process
(setq-local xscheme-process-name (process-name process))
diff --git a/lisp/ps-bdf.el b/lisp/ps-bdf.el
index 9216cfd91e9..7bf2f71822a 100644
--- a/lisp/ps-bdf.el
+++ b/lisp/ps-bdf.el
@@ -1,6 +1,6 @@
;;; ps-bdf.el --- BDF font file handler for ps-print
-;; Copyright (C) 1998-1999, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-1999, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
;; 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/ps-def.el b/lisp/ps-def.el
index 571e1a68c5e..b9c3ab57a26 100644
--- a/lisp/ps-def.el
+++ b/lisp/ps-def.el
@@ -1,6 +1,6 @@
;;; ps-def.el --- Emacs definitions for ps-print -*- lexical-binding: t -*-
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Kenichi Handa <handa@gnu.org> (multi-byte characters)
diff --git a/lisp/ps-mule.el b/lisp/ps-mule.el
index cba08737938..db86f9400e7 100644
--- a/lisp/ps-mule.el
+++ b/lisp/ps-mule.el
@@ -1,6 +1,6 @@
;;; ps-mule.el --- provide multi-byte character facility to ps-print
-;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Kenichi Handa <handa@gnu.org> (multi-byte characters)
diff --git a/lisp/ps-print.el b/lisp/ps-print.el
index 351c489f487..fcc6e1fd834 100644
--- a/lisp/ps-print.el
+++ b/lisp/ps-print.el
@@ -1,6 +1,6 @@
;;; ps-print.el --- print text from the buffer as PostScript -*- lexical-binding: t -*-
-;; Copyright (C) 1993-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993-2021 Free Software Foundation, Inc.
;; Author: Jim Thompson (was <thompson@wg2.waii.com>)
;; Jacques Duthen (was <duthen@cegelec-red.fr>)
@@ -4114,7 +4114,6 @@ If EXTENSION is any other symbol, it is ignored."
(defun ps-message-log-max ()
(and (not (string= (buffer-name) "*Messages*"))
- (boundp 'message-log-max)
message-log-max))
diff --git a/lisp/ps-samp.el b/lisp/ps-samp.el
index c5dcf494c0b..fdff0f182db 100644
--- a/lisp/ps-samp.el
+++ b/lisp/ps-samp.el
@@ -1,6 +1,6 @@
;;; ps-samp.el --- ps-print sample setup code
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Jim Thompson (was <thompson@wg2.waii.com>)
;; Jacques Duthen (was <duthen@cegelec-red.fr>)
diff --git a/lisp/recentf.el b/lisp/recentf.el
index 61c39de12b2..a28a3977a76 100644
--- a/lisp/recentf.el
+++ b/lisp/recentf.el
@@ -1,6 +1,6 @@
;;; recentf.el --- setup a menu of recently opened files
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
;; Created: July 19 1999
@@ -1127,7 +1127,7 @@ IGNORE arguments."
(unless recentf-list
(error "The list of recent files is empty"))
(recentf-dialog (format "*%s - Edit list*" recentf-menu-title)
- (set (make-local-variable 'recentf-edit-list) nil)
+ (setq-local recentf-edit-list nil)
(widget-insert
(format-message
"Click on OK to delete selected files from the recent list.
@@ -1196,8 +1196,8 @@ IGNORE other arguments."
(defun recentf-open-files-items (files)
"Return a list of widgets to display FILES in a dialog buffer."
- (set (make-local-variable 'recentf--files-with-key)
- (recentf-trunc-list files 10))
+ (setq-local recentf--files-with-key
+ (recentf-trunc-list files 10))
(mapcar 'recentf-open-files-item
(append
;; When requested group the files with shortcuts together
diff --git a/lisp/rect.el b/lisp/rect.el
index ebf309a88fe..cb941b46009 100644
--- a/lisp/rect.el
+++ b/lisp/rect.el
@@ -1,6 +1,6 @@
;;; rect.el --- rectangle functions for GNU Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1985, 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1999-2021 Free Software Foundation, Inc.
;; Maintainer: Didier Verna <didier@didierverna.net>
;; Keywords: internal
diff --git a/lisp/register.el b/lisp/register.el
index 2e8989f316f..11d98482cb4 100644
--- a/lisp/register.el
+++ b/lisp/register.el
@@ -1,6 +1,6 @@
;;; register.el --- register commands for Emacs -*- lexical-binding: t; -*-
-;; Copyright (C) 1985, 1993-1994, 2001-2020 Free Software Foundation,
+;; Copyright (C) 1985, 1993-1994, 2001-2021 Free Software Foundation,
;; Inc.
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/registry.el b/lisp/registry.el
index ef47f07aec5..a5c30f20efc 100644
--- a/lisp/registry.el
+++ b/lisp/registry.el
@@ -1,6 +1,6 @@
;;; registry.el --- Track and remember data items by various fields
-;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
;; Author: Teodor Zlatanov <tzz@lifelogs.com>
;; Keywords: data
diff --git a/lisp/repeat.el b/lisp/repeat.el
index 1dabd76e071..d4888893484 100644
--- a/lisp/repeat.el
+++ b/lisp/repeat.el
@@ -1,6 +1,6 @@
;;; repeat.el --- convenient way to repeat the previous command -*- lexical-binding: t -*-
-;; Copyright (C) 1998, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2001-2021 Free Software Foundation, Inc.
;; Author: Will Mengarini <seldon@eskimo.com>
;; Created: Mo 02 Mar 98
diff --git a/lisp/replace.el b/lisp/replace.el
index 3a2ab1d24c8..db5b340631a 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -1,6 +1,6 @@
;;; replace.el --- replace commands for Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1987, 1992, 1994, 1996-1997, 2000-2020 Free
+;; Copyright (C) 1985-1987, 1992, 1994, 1996-1997, 2000-2021 Free
;; Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
@@ -866,13 +866,10 @@ If nil, uses `regexp-history'."
;; Do not automatically add default to the history for empty input.
(history-add-new-input nil)
(input (read-from-minibuffer
- (cond ((string-match-p ":[ \t]*\\'" prompt)
- prompt)
- ((and default (> (length default) 0))
- (format "%s (default %s): " prompt
- (query-replace-descr default)))
- (t
- (format "%s: " prompt)))
+ (if (string-match-p ":[ \t]*\\'" prompt)
+ prompt
+ (format-prompt prompt (and (length> default 0)
+ (query-replace-descr default))))
nil nil nil (or history 'regexp-history) suggestions t)))
(if (equal input "")
;; Return the default value when the user enters empty input.
@@ -1706,7 +1703,7 @@ See also `multi-occur'."
(buffer-undo-list t)
(occur--final-pos nil))
(erase-buffer)
- (set (make-local-variable 'occur-highlight-regexp) regexp)
+ (setq-local occur-highlight-regexp regexp)
(let ((count
(if (stringp nlines)
;; Treat nlines as a regexp to collect.
@@ -2428,23 +2425,27 @@ It is called with three arguments, as if it were
(overlay-put replace-overlay 'priority 1001) ;higher than lazy overlays
(overlay-put replace-overlay 'face 'query-replace)))
- (when (and query-replace-highlight-submatches
- regexp-flag)
+ (when (and query-replace-highlight-submatches regexp-flag)
(mapc 'delete-overlay replace-submatches-overlays)
(setq replace-submatches-overlays nil)
- (let ((submatch-data (cddr (butlast (match-data t))))
+ ;; 'cddr' removes whole expression match from match-data
+ (let ((submatch-data (cddr (match-data t)))
(group 0)
- ov face)
+ b e ov face)
(while submatch-data
- (setq group (1+ group))
- (setq ov (make-overlay (pop submatch-data) (pop submatch-data))
- face (intern-soft (format "isearch-group-%d" group)))
- ;; Recycle faces from beginning.
- (unless (facep face)
- (setq group 1 face 'isearch-group-1))
- (overlay-put ov 'face face)
- (overlay-put ov 'priority 1002)
- (push ov replace-submatches-overlays))))
+ (setq b (pop submatch-data)
+ e (pop submatch-data))
+ (when (and (integer-or-marker-p b)
+ (integer-or-marker-p e))
+ (setq ov (make-overlay b e)
+ group (1+ group)
+ face (intern-soft (format "isearch-group-%d" group)))
+ ;; Recycle faces from beginning
+ (unless (facep face)
+ (setq group 1 face 'isearch-group-1))
+ (overlay-put ov 'face face)
+ (overlay-put ov 'priority 1002)
+ (push ov replace-submatches-overlays)))))
(if query-replace-lazy-highlight
(let ((isearch-string search-string)
diff --git a/lisp/reposition.el b/lisp/reposition.el
index 7561cc4c5f3..008fa009fdc 100644
--- a/lisp/reposition.el
+++ b/lisp/reposition.el
@@ -1,6 +1,6 @@
;;; reposition.el --- center a Lisp function or comment on the screen -*- lexical-binding: t -*-
-;; Copyright (C) 1991, 1994, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1991, 1994, 2001-2021 Free Software Foundation, Inc.
;; Author: Michael D. Ernst <mernst@theory.lcs.mit.edu>
;; Created: Jan 1991
diff --git a/lisp/reveal.el b/lisp/reveal.el
index f9e38646349..c01afd9739a 100644
--- a/lisp/reveal.el
+++ b/lisp/reveal.el
@@ -1,6 +1,6 @@
;;; reveal.el --- Automatically reveal hidden text at point -*- lexical-binding: t -*-
-;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: outlines
@@ -233,7 +233,7 @@ Also see the `reveal-auto-hide' variable."
:keymap reveal-mode-map
(if reveal-mode
(progn
- (set (make-local-variable 'search-invisible) t)
+ (setq-local search-invisible t)
(add-hook 'post-command-hook 'reveal-post-command nil t))
(kill-local-variable 'search-invisible)
(remove-hook 'post-command-hook 'reveal-post-command t)))
diff --git a/lisp/rfn-eshadow.el b/lisp/rfn-eshadow.el
index 0ed1c370983..378358feac2 100644
--- a/lisp/rfn-eshadow.el
+++ b/lisp/rfn-eshadow.el
@@ -1,6 +1,6 @@
-;;; rfn-eshadow.el --- Highlight `shadowed' part of read-file-name input text
+;;; rfn-eshadow.el --- Highlight `shadowed' part of read-file-name input text -*- lexical-binding: t; -*-
;;
-;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;;
;; Author: Miles Bader <miles@gnu.org>
;; Keywords: convenience minibuffer
diff --git a/lisp/rot13.el b/lisp/rot13.el
index 7a1f6077126..dfcf4adc179 100644
--- a/lisp/rot13.el
+++ b/lisp/rot13.el
@@ -1,6 +1,6 @@
;;; rot13.el --- display a buffer in ROT13 -*- lexical-binding: t -*-
-;; Copyright (C) 1988, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 2001-2021 Free Software Foundation, Inc.
;; Author: Howard Gayle
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/rtree.el b/lisp/rtree.el
index b790d050c28..166c7808184 100644
--- a/lisp/rtree.el
+++ b/lisp/rtree.el
@@ -1,6 +1,6 @@
;;; rtree.el --- functions for manipulating range trees -*- lexical-binding:t -*-
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el
index 82e6178da14..1e819044194 100644
--- a/lisp/ruler-mode.el
+++ b/lisp/ruler-mode.el
@@ -1,6 +1,6 @@
;;; ruler-mode.el --- display a ruler in the header line
-;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
;; Created: 24 Mar 2001
@@ -429,7 +429,7 @@ dragging. See also the variable `ruler-mode-dragged-symbol'."
;; `ding' flushes the next messages about setting goal
;; column. So here I force fetch the event(mouse-2) and
;; throw away.
- (read-event)
+ (read--potential-mouse-event)
;; Ding BEFORE `message' is OK.
(when ruler-mode-set-goal-column-ding-flag
(ding))
@@ -460,7 +460,7 @@ the mouse has been clicked."
(track-mouse
;; Signal the display engine to freeze the mouse pointer shape.
(setq track-mouse 'dragging)
- (while (mouse-movement-p (setq event (read-event)))
+ (while (mouse-movement-p (setq event (read--potential-mouse-event)))
(setq drags (1+ drags))
(when (eq window (posn-window (event-end event)))
(ruler-mode-mouse-drag-any-column event)
@@ -584,8 +584,8 @@ format first."
(when (and (not ruler-mode)
(local-variable-p 'header-line-format)
(not (local-variable-p 'ruler-mode-header-line-format-old)))
- (set (make-local-variable 'ruler-mode-header-line-format-old)
- header-line-format))
+ (setq-local ruler-mode-header-line-format-old
+ header-line-format))
(setq header-line-format ruler-mode-header-line-format))
;;;###autoload
diff --git a/lisp/savehist.el b/lisp/savehist.el
index 5d20239d17f..b8e9d6b427f 100644
--- a/lisp/savehist.el
+++ b/lisp/savehist.el
@@ -1,6 +1,6 @@
;;; savehist.el --- Save minibuffer history -*- lexical-binding:t -*-
-;; Copyright (C) 1997, 2005-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2005-2021 Free Software Foundation, Inc.
;; Author: Hrvoje Nikšić <hrvoje.niksic@avl.com>
;; Maintainer: emacs-devel@gnu.org
@@ -47,8 +47,6 @@
;;; Code:
-(require 'custom)
-
;; User variables
(defgroup savehist nil
diff --git a/lisp/saveplace.el b/lisp/saveplace.el
index d420bfb4e9f..f654702def4 100644
--- a/lisp/saveplace.el
+++ b/lisp/saveplace.el
@@ -1,6 +1,6 @@
;;; saveplace.el --- automatically save place in files -*- lexical-binding:t -*-
-;; Copyright (C) 1993-1994, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2001-2021 Free Software Foundation, Inc.
;; Author: Karl Fogel <kfogel@red-bean.com>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/scroll-all.el b/lisp/scroll-all.el
index d6e18aee642..25b245e4b63 100644
--- a/lisp/scroll-all.el
+++ b/lisp/scroll-all.el
@@ -1,6 +1,6 @@
;;; scroll-all.el --- scroll all buffers together minor mode
-;; Copyright (C) 1997, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
;; Author: Gary D. Foster <Gary.Foster@corp.sun.com>
;; Keywords: convenience scroll lock
diff --git a/lisp/scroll-bar.el b/lisp/scroll-bar.el
index 5b829345795..eecdb60f3a4 100644
--- a/lisp/scroll-bar.el
+++ b/lisp/scroll-bar.el
@@ -1,6 +1,6 @@
-;;; scroll-bar.el --- window system-independent scroll bar support
+;;; scroll-bar.el --- window system-independent scroll bar support -*- lexical-binding: t; -*-
-;; Copyright (C) 1993-1995, 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1995, 1999-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: hardware
diff --git a/lisp/scroll-lock.el b/lisp/scroll-lock.el
index f20ea1bcc87..e8f69b29565 100644
--- a/lisp/scroll-lock.el
+++ b/lisp/scroll-lock.el
@@ -1,6 +1,6 @@
;;; scroll-lock.el --- Scroll lock scrolling. -*- lexical-binding:t -*-
-;; Copyright (C) 2005-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2005-2021 Free Software Foundation, Inc.
;; Author: Ralf Angeli <angeli@iwi.uni-sb.de>
;; Maintainer: emacs-devel@gnu.org
@@ -64,7 +64,7 @@ MS-Windows systems if `w32-scroll-lock-modifier' is non-nil."
(progn
(setq scroll-lock-preserve-screen-pos-save
scroll-preserve-screen-position)
- (set (make-local-variable 'scroll-preserve-screen-position) 'always))
+ (setq-local scroll-preserve-screen-position 'always))
(setq scroll-preserve-screen-position
scroll-lock-preserve-screen-pos-save)))
diff --git a/lisp/select.el b/lisp/select.el
index 596335b0ecc..c39bc93deab 100644
--- a/lisp/select.el
+++ b/lisp/select.el
@@ -1,6 +1,6 @@
;;; select.el --- lisp portion of standard selection support -*- lexical-binding:t -*-
-;; Copyright (C) 1993-1994, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2001-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
diff --git a/lisp/server.el b/lisp/server.el
index a660deab8e8..b82e301d0aa 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -1,6 +1,6 @@
;;; server.el --- Lisp code for GNU Emacs running as server process -*- lexical-binding: t -*-
-;; Copyright (C) 1986-1987, 1992, 1994-2020 Free Software Foundation,
+;; Copyright (C) 1986-1987, 1992, 1994-2021 Free Software Foundation,
;; Inc.
;; Author: William Sommerfeld <wesommer@athena.mit.edu>
@@ -268,6 +268,12 @@ the \"-f\" switch otherwise."
:type 'string
:version "23.1")
+(defcustom server-client-instructions t
+ "If non-nil, display instructions on how to exit the client on connection.
+If nil, no instructions are displayed."
+ :version "28.1"
+ :type 'boolean)
+
;; We do not use `temporary-file-directory' here, because emacsclient
;; does not read the init file.
(defvar server-socket-dir
@@ -354,9 +360,11 @@ Updates `server-clients'."
(setq server-clients (delq proc server-clients))
- ;; Delete the client's tty, except on Windows (both GUI and console),
- ;; where there's only one terminal and does not make sense to delete it.
- (unless (eq system-type 'windows-nt)
+ ;; Delete the client's tty, except on Windows (both GUI and
+ ;; console), where there's only one terminal and does not make
+ ;; sense to delete it, or if we are explicitly told not.
+ (unless (or (eq system-type 'windows-nt)
+ (process-get proc 'no-delete-terminal))
(let ((terminal (process-get proc 'terminal)))
;; Only delete the terminal if it is non-nil.
(when (and terminal (eq (terminal-live-p terminal) t))
@@ -646,7 +654,17 @@ the `server-process' variable."
;; Remove any leftover socket or authentication file.
(ignore-errors
(let (delete-by-moving-to-trash)
- (delete-file server-file)))
+ (delete-file server-file)
+ ;; Also delete the directory that the server file was
+ ;; created in -- but only in /tmp (see bug#44644).
+ ;; There may be other servers running, too, so this may
+ ;; fail.
+ (when (equal (file-name-directory
+ (directory-file-name
+ (file-name-directory server-file)))
+ "/tmp/")
+ (ignore-errors
+ (delete-directory (file-name-directory server-file))))))
(setq server-mode nil) ;; already set by the minor mode code
(display-warning
'server
@@ -830,7 +848,6 @@ This handles splitting the command if it would be bigger than
(error "Invalid terminal device"))
(unless type
(error "Invalid terminal type"))
- (add-to-list 'frame-inherited-parameters 'client)
(let ((frame
(server-with-environment
(process-get proc 'env)
@@ -842,32 +859,19 @@ This handles splitting the command if it would be bigger than
"TERMINFO_DIRS" "TERMPATH"
;; rxvt wants these
"COLORFGBG" "COLORTERM")
- (make-frame `((window-system . nil)
- (tty . ,tty)
- (tty-type . ,type)
- ;; Ignore nowait here; we always need to
- ;; clean up opened ttys when the client dies.
- (client . ,proc)
- ;; This is a leftover from an earlier
- ;; attempt at making it possible for process
- ;; run in the server process to use the
- ;; environment of the client process.
- ;; It has no effect now and to make it work
- ;; we'd need to decide how to make
- ;; process-environment interact with client
- ;; envvars, and then to change the
- ;; C functions `child_setup' and
- ;; `getenv_internal' accordingly.
- (environment . ,(process-get proc 'env))
- ,@parameters)))))
+ (server--create-frame
+ ;; Ignore nowait here; we always need to
+ ;; clean up opened ttys when the client dies.
+ nil proc
+ `((window-system . nil)
+ (tty . ,tty)
+ (tty-type . ,type)
+ ,@parameters)))))
;; ttys don't use the `display' parameter, but callproc.c does to set
;; the DISPLAY environment on subprocesses.
(set-frame-parameter frame 'display
(getenv-internal "DISPLAY" (process-get proc 'env)))
- (select-frame frame)
- (process-put proc 'frame frame)
- (process-put proc 'terminal (frame-terminal frame))
frame))
(defun server-create-window-system-frame (display nowait proc parent-id
@@ -893,31 +897,56 @@ This handles splitting the command if it would be bigger than
)
(cond (w
- ;; Flag frame as client-created, but use a dummy client.
- ;; This will prevent the frame from being deleted when
- ;; emacsclient quits while also preventing
- ;; `server-save-buffers-kill-terminal' from unexpectedly
- ;; killing emacs on that frame.
- (let* ((params `((client . ,(if nowait 'nowait proc))
- ;; This is a leftover, see above.
- (environment . ,(process-get proc 'env))
- ,@parameters))
- frame)
- (if parent-id
- (push (cons 'parent-id (string-to-number parent-id)) params))
- (add-to-list 'frame-inherited-parameters 'client)
- (setq frame (make-frame-on-display display params))
- (server-log (format "%s created" frame) proc)
- (select-frame frame)
- (process-put proc 'frame frame)
- (process-put proc 'terminal (frame-terminal frame))
- frame))
+ (server--create-frame
+ nowait proc
+ `((display . ,display)
+ ,@(if parent-id
+ `((parent-id . ,(string-to-number parent-id))))
+ ,@parameters)))
(t
(server-log "Window system unsupported" proc)
(server-send-string proc "-window-system-unsupported \n")
nil))))
+(defun server-create-dumb-terminal-frame (nowait proc &optional parameters)
+ ;; If the destination is a dumb terminal, we can't really run Emacs
+ ;; in its tty. So instead, we use whichever terminal is currently
+ ;; selected. This situation typically occurs when `emacsclient' is
+ ;; running inside something like an Emacs shell buffer (bug#25547).
+ (let ((frame (server--create-frame nowait proc parameters)))
+ ;; The client is not the exclusive owner of this terminal, so don't
+ ;; delete the terminal when the client exits.
+ ;; FIXME: Maybe we just shouldn't set the `terminal' property instead?
+ (process-put proc 'no-delete-terminal t)
+ frame))
+
+(defun server--create-frame (nowait proc parameters)
+ (add-to-list 'frame-inherited-parameters 'client)
+ ;; When `nowait' is set, flag frame as client-created, but use
+ ;; a dummy client. This will prevent the frame from being deleted
+ ;; when emacsclient quits while also preventing
+ ;; `server-save-buffers-kill-terminal' from unexpectedly killing
+ ;; emacs on that frame.
+ (let ((frame (make-frame `((client . ,(if nowait 'nowait proc))
+ ;; This is a leftover from an earlier
+ ;; attempt at making it possible for process
+ ;; run in the server process to use the
+ ;; environment of the client process.
+ ;; It has no effect now and to make it work
+ ;; we'd need to decide how to make
+ ;; process-environment interact with client
+ ;; envvars, and then to change the
+ ;; C functions `child_setup' and
+ ;; `getenv_internal' accordingly.
+ (environment . ,(process-get proc 'env))
+ ,@parameters))))
+ (server-log (format "%s created" frame) proc)
+ (select-frame frame)
+ (process-put proc 'frame frame)
+ (process-put proc 'terminal (frame-terminal frame))
+ frame))
+
(defun server-goto-toplevel (proc)
(condition-case nil
;; If we're running isearch, we must abort it to allow Emacs to
@@ -1264,6 +1293,9 @@ The following commands are accepted by the client:
terminal-frame)))))
(setq tty-name nil tty-type nil)
(if display (server-select-display display)))
+ ((equal tty-type "dumb")
+ (server-create-dumb-terminal-frame nowait proc
+ frame-parameters))
((or (and (eq system-type 'windows-nt)
(daemonp)
(setq display "w32"))
@@ -1334,8 +1366,10 @@ The following commands are accepted by the client:
nil)
((and frame (null buffers))
(run-hooks 'server-after-make-frame-hook)
- (message "%s" (substitute-command-keys
- "When done with this frame, type \\[delete-frame]")))
+ (when server-client-instructions
+ (message "%s"
+ (substitute-command-keys
+ "When done with this frame, type \\[delete-frame]"))))
((not (null buffers))
(run-hooks 'server-after-make-frame-hook)
(server-switch-buffer
@@ -1346,9 +1380,11 @@ The following commands are accepted by the client:
;; where it may be displayed.
(plist-get (process-plist proc) 'frame))
(run-hooks 'server-switch-hook)
- (unless nowait
- (message "%s" (substitute-command-keys
- "When done with a buffer, type \\[server-edit]")))))
+ (when (and (not nowait)
+ server-client-instructions)
+ (message "%s"
+ (substitute-command-keys
+ "When done with a buffer, type \\[server-edit]")))))
(when (and frame (null tty-name))
(server-unselect-display frame)))
((quit error)
diff --git a/lisp/ses.el b/lisp/ses.el
index bfafc132bf5..d6090f3e8d7 100644
--- a/lisp/ses.el
+++ b/lisp/ses.el
@@ -1,6 +1,6 @@
;;; ses.el -- Simple Emacs Spreadsheet -*- lexical-binding:t -*-
-;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Author: Jonathan Yavner <jyavner@member.fsf.org>
;; Maintainer: Vincent Belaïche <vincentb1@users.sourceforge.net>
@@ -430,7 +430,8 @@ when to emit a progress message.")
local-printer-list)
(defmacro ses-cell-symbol (row &optional col)
- "From a CELL or a pair (ROW,COL), get the symbol that names the local-variable holding its value. (0,0) => A1."
+ "Return symbol of the local-variable holding value of CELL or pair (ROW,COL).
+For example, (0,0) => A1."
(declare (debug t))
`(ses-cell--symbol ,(if col `(ses-get-cell ,row ,col) row)))
(put 'ses-cell-symbol 'safe-function t)
diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el
index 6bea5e22567..a4f0eba4449 100644
--- a/lisp/shadowfile.el
+++ b/lisp/shadowfile.el
@@ -1,6 +1,6 @@
;;; shadowfile.el --- automatic file copying
-;; Copyright (C) 1993-1994, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2001-2021 Free Software Foundation, Inc.
;; Author: Boris Goldowsky <boris@gnu.org>
;; Keywords: comm files
@@ -524,10 +524,9 @@ call it manually."
(if (called-interactively-p 'interactive)
(message "No files need to be shadowed."))
(save-excursion
- (map-y-or-n-p (function
- (lambda (pair)
- (or arg shadow-noquery
- (format "Copy shadow file %s? " (cdr pair)))))
+ (map-y-or-n-p (lambda (pair)
+ (or arg shadow-noquery
+ (format "Copy shadow file %s? " (cdr pair))))
(function shadow-copy-file)
shadow-files-to-copy
'("shadow" "shadows" "copy"))
@@ -540,11 +539,11 @@ them again, unless you make more changes to the files. To cancel a shadow
permanently, remove the group from `shadow-literal-groups' or
`shadow-regexp-groups'."
(interactive)
- (map-y-or-n-p (function (lambda (pair)
- (format "Cancel copying %s to %s? "
- (car pair) (cdr pair))))
- (function (lambda (pair)
- (shadow-remove-from-todo pair)))
+ (map-y-or-n-p (lambda (pair)
+ (format "Cancel copying %s to %s? "
+ (car pair) (cdr pair)))
+ (lambda (pair)
+ (shadow-remove-from-todo pair))
shadow-files-to-copy
'("shadow" "shadows" "cancel copy"))
(message "There are %d shadows to be updated."
@@ -601,8 +600,8 @@ and to are absolute file names."
shadow-homedir))
(canonical-file (shadow-contract-file-name absolute-file))
(shadows
- (mapcar (function (lambda (shadow)
- (cons absolute-file shadow)))
+ (mapcar (lambda (shadow)
+ (cons absolute-file shadow))
(append
(shadow-shadows-of-1
canonical-file shadow-literal-groups nil)
@@ -632,9 +631,8 @@ Consider them as regular expressions if third arg REGEXP is true."
"shadow-shadows-of-1: %s %s %s"
file (shadow-parse-name file) realname))
(mapcar
- (function
- (lambda (x)
- (shadow-replace-name-component x realname)))
+ (lambda (x)
+ (shadow-replace-name-component x realname))
nonmatching)))
(t nonmatching))
(shadow-shadows-of-1 file (cdr groups) regexp)))))
@@ -791,9 +789,8 @@ look for files that have been changed and need to be copied to other systems."
(save-some-buffers arg t)
(shadow-copy-files)
(shadow-save-todo-file)
- (and (or (not (memq t (mapcar (function
- (lambda (buf) (and (buffer-file-name buf)
- (buffer-modified-p buf))))
+ (and (or (not (memq t (mapcar (lambda (buf) (and (buffer-file-name buf)
+ (buffer-modified-p buf)))
(buffer-list))))
(yes-or-no-p "Modified buffers exist; exit anyway? "))
(or (not (fboundp 'process-list))
diff --git a/lisp/shell.el b/lisp/shell.el
index 43ad58774b8..0f866158fe3 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -1,6 +1,6 @@
;;; shell.el --- specialized comint.el for running the shell -*- lexical-binding: t -*-
-;; Copyright (C) 1988, 1993-1997, 2000-2020 Free Software Foundation,
+;; Copyright (C) 1988, 1993-1997, 2000-2021 Free Software Foundation,
;; Inc.
;; Author: Olin Shivers <shivers@cs.cmu.edu>
@@ -265,10 +265,11 @@ see the function `dirtrack-mode'."
:group 'shell-directories)
(defcustom explicit-shell-file-name nil
- "If non-nil, is file name to use for explicitly requested inferior shell.
-When nil, such interactive shell sessions fallback to using either
-the shell specified in $ESHELL or in `shell-file-name'."
- :type '(choice (const :tag "None" nil) file)
+ "If non-nil, the file name to use for explicitly requested inferior shells.
+When nil, such interactive shell sessions fall back to using the
+shell specified in either the environment variable \"ESHELL\" or
+`shell-file-name'."
+ :type '(choice (const :tag "Default" nil) file)
:group 'shell)
;; Note: There are no explicit references to the variable `explicit-csh-args'.
@@ -470,32 +471,32 @@ Shell buffers. It implements `shell-completion-execonly' for
(defun shell-completion-vars ()
"Setup completion vars for `shell-mode' and `read-shell-command'."
- (set (make-local-variable 'comint-completion-fignore)
- shell-completion-fignore)
- (set (make-local-variable 'comint-delimiter-argument-list)
- shell-delimiter-argument-list)
- (set (make-local-variable 'comint-file-name-chars) shell-file-name-chars)
- (set (make-local-variable 'comint-file-name-quote-list)
- shell-file-name-quote-list)
- (set (make-local-variable 'comint-file-name-prefix)
- (or (file-remote-p default-directory) ""))
- (set (make-local-variable 'comint-dynamic-complete-functions)
- shell-dynamic-complete-functions)
+ (setq-local comint-completion-fignore
+ shell-completion-fignore)
+ (setq-local comint-delimiter-argument-list
+ shell-delimiter-argument-list)
+ (setq-local comint-file-name-chars shell-file-name-chars)
+ (setq-local comint-file-name-quote-list
+ shell-file-name-quote-list)
+ (setq-local comint-file-name-prefix
+ (or (file-remote-p default-directory) ""))
+ (setq-local comint-dynamic-complete-functions
+ shell-dynamic-complete-functions)
(setq-local comint-unquote-function #'shell--unquote-argument)
(setq-local comint-requote-function #'shell--requote-argument)
- (set (make-local-variable 'pcomplete-parse-arguments-function)
- #'shell--parse-pcomplete-arguments)
- (set (make-local-variable 'pcomplete-termination-string)
- (cond ((not comint-completion-addsuffix) "")
- ((stringp comint-completion-addsuffix)
- comint-completion-addsuffix)
- ((not (consp comint-completion-addsuffix)) " ")
- (t (cdr comint-completion-addsuffix))))
- (set (make-local-variable 'pcomplete-command-completion-function)
- #'shell-command-completion-function)
+ (setq-local pcomplete-parse-arguments-function
+ #'shell--parse-pcomplete-arguments)
+ (setq-local pcomplete-termination-string
+ (cond ((not comint-completion-addsuffix) "")
+ ((stringp comint-completion-addsuffix)
+ comint-completion-addsuffix)
+ ((not (consp comint-completion-addsuffix)) " ")
+ (t (cdr comint-completion-addsuffix))))
+ (setq-local pcomplete-command-completion-function
+ #'shell-command-completion-function)
;; Don't use pcomplete's defaulting mechanism, rely on
;; shell-dynamic-complete-functions instead.
- (set (make-local-variable 'pcomplete-default-completion-function) #'ignore)
+ (setq-local pcomplete-default-completion-function #'ignore)
(setq-local comint-input-autoexpand shell-input-autoexpand)
;; Not needed in shell-mode because it's inherited from comint-mode, but
;; placed here for read-shell-command.
@@ -595,17 +596,18 @@ buffer."
(and (stringp hsize)
(integerp (setq hsize (string-to-number hsize)))
(> hsize 0)
- (set (make-local-variable 'comint-input-ring-size) hsize))
+ (setq-local comint-input-ring-size hsize))
(setq comint-input-ring-file-name
(concat
remote
(or hfile
(cond ((string-equal shell "bash") "~/.bash_history")
((string-equal shell "ksh") "~/.sh_history")
+ ((string-equal shell "zsh") "~/.zsh_history")
(t "~/.history")))))
(if (or (equal comint-input-ring-file-name "")
(equal (file-truename comint-input-ring-file-name)
- (file-truename "/dev/null")))
+ (file-truename null-device)))
(setq comint-input-ring-file-name nil))
;; Arrange to write out the input ring on exit, if the shell doesn't
;; do this itself.
@@ -748,16 +750,15 @@ Make the shell buffer the current buffer, and return it.
(with-connection-local-variables
;; On remote hosts, the local `shell-file-name' might be useless.
- (when (file-remote-p default-directory)
- (if (and (called-interactively-p 'any)
+ (when (and (file-remote-p default-directory)
+ (called-interactively-p 'any)
(null explicit-shell-file-name)
(null (getenv "ESHELL")))
- (set (make-local-variable 'explicit-shell-file-name)
- (file-local-name
- (expand-file-name
- (read-file-name
- "Remote shell path: " default-directory shell-file-name
- t shell-file-name))))))
+ (setq-local explicit-shell-file-name
+ (file-local-name
+ (expand-file-name
+ (read-file-name "Remote shell path: " default-directory
+ shell-file-name t shell-file-name)))))
;; Rain or shine, BUFFER must be current by now.
(unless (comint-check-proc buffer)
diff --git a/lisp/simple.el b/lisp/simple.el
index e96c7c9a6ea..37c0885dcc5 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -1,6 +1,6 @@
;;; simple.el --- basic editing commands for Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1987, 1993-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1987, 1993-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
@@ -1264,7 +1264,6 @@ that uses or sets the mark."
;; minibuffer, this is at the end of the prompt.
(goto-char (minibuffer-prompt-end)))
-
;; Counting lines, one way or another.
(defvar goto-line-history nil
@@ -1276,15 +1275,8 @@ that uses or sets the mark."
(if (and current-prefix-arg (not (consp current-prefix-arg)))
(list (prefix-numeric-value current-prefix-arg))
;; Look for a default, a number in the buffer at point.
- (let* ((default
- (save-excursion
- (skip-chars-backward "0-9")
- (if (looking-at "[0-9]")
- (string-to-number
- (buffer-substring-no-properties
- (point)
- (progn (skip-chars-forward "0-9")
- (point)))))))
+ (let* ((number (number-at-point))
+ (default (and (natnump number) number))
;; Decide if we're switching buffers.
(buffer
(if (consp current-prefix-arg)
@@ -1922,7 +1914,7 @@ to get different commands to edit and resubmit."
(setq execute-extended-command--last-typed
(minibuffer-contents)))
nil 'local)
- (set (make-local-variable 'minibuffer-default-add-function)
+ (setq-local minibuffer-default-add-function
(lambda ()
;; Get a command name at point in the original buffer
;; to propose it after M-n.
@@ -1958,22 +1950,27 @@ to get different commands to edit and resubmit."
(lambda (string pred action)
(if (and suggest-key-bindings (eq action 'metadata))
'(metadata
- (annotation-function . read-extended-command--annotation)
+ (affixation-function . read-extended-command--affixation)
(category . command))
(complete-with-action action obarray string pred)))
#'commandp t nil 'extended-command-history)))
-(defun read-extended-command--annotation (command-name)
- (let* ((fun (and (stringp command-name) (intern-soft command-name)))
- (binding (where-is-internal fun overriding-local-map t))
- (obsolete (get fun 'byte-obsolete-info))
- (alias (symbol-function fun)))
- (cond ((symbolp alias)
- (format " (%s)" alias))
- (obsolete
- (format " (%s)" (car obsolete)))
- ((and binding (not (stringp binding)))
- (format " (%s)" (key-description binding))))))
+(defun read-extended-command--affixation (command-names)
+ (with-selected-window (or (minibuffer-selected-window) (selected-window))
+ (mapcar
+ (lambda (command-name)
+ (let* ((fun (and (stringp command-name) (intern-soft command-name)))
+ (binding (where-is-internal fun overriding-local-map t))
+ (obsolete (get fun 'byte-obsolete-info))
+ (alias (symbol-function fun))
+ (suffix (cond ((symbolp alias)
+ (format " (%s)" alias))
+ (obsolete
+ (format " (%s)" (car obsolete)))
+ ((and binding (not (stringp binding)))
+ (format " (%s)" (key-description binding))))))
+ (if suffix (list command-name suffix) command-name)))
+ command-names)))
(defcustom suggest-key-bindings t
"Non-nil means show the equivalent key-binding when M-x command has one.
@@ -2195,7 +2192,8 @@ in this use of the minibuffer.")
"Minibuffer history variables for which matching should ignore case.
If a history variable is a member of this list, then the
\\[previous-matching-history-element] and \\[next-matching-history-element]\
- commands ignore case when searching it, regardless of `case-fold-search'."
+ commands ignore case when searching it,
+regardless of `case-fold-search'."
:type '(repeat variable)
:group 'minibuffer)
@@ -2372,10 +2370,10 @@ negative number -N means the Nth entry of \"future history.\""
(unless (memq last-command '(next-history-element
previous-history-element))
(let ((prompt-end (minibuffer-prompt-end)))
- (set (make-local-variable 'minibuffer-temporary-goal-position)
- (cond ((<= (point) prompt-end) prompt-end)
- ((eobp) nil)
- (t (point))))))
+ (setq-local minibuffer-temporary-goal-position
+ (cond ((<= (point) prompt-end) prompt-end)
+ ((eobp) nil)
+ (t (point))))))
(goto-char (point-max))
(delete-minibuffer-contents)
(setq minibuffer-history-position nabs)
@@ -2548,14 +2546,14 @@ Return 0 if current buffer is not a minibuffer."
(defun minibuffer-history-isearch-setup ()
"Set up a minibuffer for using isearch to search the minibuffer history.
Intended to be added to `minibuffer-setup-hook'."
- (set (make-local-variable 'isearch-search-fun-function)
- 'minibuffer-history-isearch-search)
- (set (make-local-variable 'isearch-message-function)
- 'minibuffer-history-isearch-message)
- (set (make-local-variable 'isearch-wrap-function)
- 'minibuffer-history-isearch-wrap)
- (set (make-local-variable 'isearch-push-state-function)
- 'minibuffer-history-isearch-push-state)
+ (setq-local isearch-search-fun-function
+ #'minibuffer-history-isearch-search)
+ (setq-local isearch-message-function
+ #'minibuffer-history-isearch-message)
+ (setq-local isearch-wrap-function
+ #'minibuffer-history-isearch-wrap)
+ (setq-local isearch-push-state-function
+ #'minibuffer-history-isearch-push-state)
(add-hook 'isearch-mode-end-hook 'minibuffer-history-isearch-end nil t))
(defun minibuffer-history-isearch-end ()
@@ -3585,8 +3583,8 @@ to `shell-command-history'."
(minibuffer-with-setup-hook
(lambda ()
(shell-completion-vars)
- (set (make-local-variable 'minibuffer-default-add-function)
- 'minibuffer-default-add-shell-commands))
+ (setq-local minibuffer-default-add-function
+ #'minibuffer-default-add-shell-commands))
(apply #'read-from-minibuffer prompt initial-contents
minibuffer-local-shell-command-map
nil
@@ -3786,6 +3784,7 @@ a shell (with its need to quote arguments)."
(shell-command command output-buffer error-buffer))
(declare-function comint-output-filter "comint" (process string))
+(declare-function comint-term-environment "comint" ())
(defun shell-command (command &optional output-buffer error-buffer)
"Execute string COMMAND in inferior shell; display output, if any.
@@ -3964,15 +3963,19 @@ impose the use of a shell (with its need to quote arguments)."
(with-current-buffer buffer
(shell-command-save-pos-or-erase)
(setq default-directory directory)
- (let ((process-environment
- (if (natnump async-shell-command-width)
- (cons (format "COLUMNS=%d" async-shell-command-width)
- process-environment)
- process-environment)))
+ (require 'shell)
+ (let ((process-environment
+ (append
+ (and (natnump async-shell-command-width)
+ (list
+ (format "COLUMNS=%d"
+ async-shell-command-width)))
+ (comint-term-environment)
+ process-environment)))
(setq proc
(start-process-shell-command "Shell" buffer command)))
(setq mode-line-process '(":%s"))
- (require 'shell) (shell-mode)
+ (shell-mode)
(set-process-sentinel proc #'shell-command-sentinel)
;; Use the comint filter for proper handling of
;; carriage motion (see comint-inhibit-carriage-motion).
@@ -4296,8 +4299,7 @@ characters."
(defun shell-command-to-string (command)
"Execute shell command COMMAND and return its output as a string."
(with-output-to-string
- (with-current-buffer
- standard-output
+ (with-current-buffer standard-output
(shell-command command t))))
(defun process-file (program &optional infile buffer display &rest args)
@@ -5087,11 +5089,20 @@ visual feedback indicating the extent of the region being copied."
(if (called-interactively-p 'interactive)
(indicate-copied-region)))
+(defcustom copy-region-blink-delay 1
+ "Time in seconds to delay after showing the other end of the region.
+It's used by the command `kill-ring-save' and the function
+`indicate-copied-region' to blink the cursor between point and mark.
+The value 0 disables blinking."
+ :type 'number
+ :group 'killing
+ :version "28.1")
+
(defun indicate-copied-region (&optional message-len)
"Indicate that the region text has been copied interactively.
-If the mark is visible in the selected window, blink the cursor
-between point and mark if there is currently no active region
-highlighting.
+If the mark is visible in the selected window, blink the cursor between
+point and mark if there is currently no active region highlighting.
+The option `copy-region-blink-delay' can disable blinking.
If the mark lies outside the selected window, display an
informative message containing a sample of the copied text. The
@@ -5105,12 +5116,14 @@ of this sample text; it defaults to 40."
(if (pos-visible-in-window-p mark (selected-window))
;; Swap point-and-mark quickly so as to show the region that
;; was selected. Don't do it if the region is highlighted.
- (unless (and (region-active-p)
- (face-background 'region nil t))
+ (when (and (numberp copy-region-blink-delay)
+ (> copy-region-blink-delay 0)
+ (or (not (region-active-p))
+ (not (face-background 'region nil t))))
;; Swap point and mark.
(set-marker (mark-marker) (point) (current-buffer))
(goto-char mark)
- (sit-for blink-matching-delay)
+ (sit-for copy-region-blink-delay)
;; Swap back.
(set-marker (mark-marker) mark (current-buffer))
(goto-char point)
@@ -5121,11 +5134,14 @@ of this sample text; it defaults to 40."
(let ((len (min (abs (- mark point))
(or message-len 40))))
(if (< point mark)
- ;; Don't say "killed"; that is misleading.
- (message "Saved text until \"%s\""
- (buffer-substring-no-properties (- mark len) mark))
- (message "Saved text from \"%s\""
- (buffer-substring-no-properties mark (+ mark len))))))))
+ ;; Don't say "killed" or "saved"; that is misleading.
+ (message "Copied text until \"%s\""
+ ;; Don't show newlines literally
+ (query-replace-descr
+ (buffer-substring-no-properties (- mark len) mark)))
+ (message "Copied text from \"%s\""
+ (query-replace-descr
+ (buffer-substring-no-properties mark (+ mark len)))))))))
(defun append-next-kill (&optional interactive)
"Cause following command, if it kills, to add to previous kill.
@@ -5330,7 +5346,7 @@ Normally set from the UNDO element of a yank-handler; see `insert-for-yank'.")
(defun yank-pop (&optional arg)
"Replace just-yanked stretch of killed text with a different stretch.
-This command is allowed only immediately after a `yank' or a
+The main use of this command is immediately after a `yank' or a
`yank-pop'. At such a time, the region contains a stretch of
reinserted previously-killed text. `yank-pop' deletes that text
and inserts in its place a different stretch of killed text by
@@ -5345,30 +5361,36 @@ comes the newest one.
This command honors the `yank-handled-properties' and
`yank-excluded-properties' variables, and the `yank-handler' text
-property, in the way that `yank' does."
- (interactive "*p")
+property, in the way that `yank' does.
+
+When this command is called not immediately after a `yank' or a
+`yank-pop', then it activates the minibuffer with its completion
+and history filled with previously-killed items from the
+`kill-ring' variable, and reads a string to yank at point.
+See `yank-from-kill-ring' for more details."
+ (interactive "p")
(if (not (eq last-command 'yank))
- (user-error "Previous command was not a yank"))
- (setq this-command 'yank)
- (unless arg (setq arg 1))
- (let ((inhibit-read-only t)
- (before (< (point) (mark t))))
- (if before
- (funcall (or yank-undo-function 'delete-region) (point) (mark t))
- (funcall (or yank-undo-function 'delete-region) (mark t) (point)))
- (setq yank-undo-function nil)
- (set-marker (mark-marker) (point) (current-buffer))
- (insert-for-yank (current-kill arg))
- ;; Set the window start back where it was in the yank command,
- ;; if possible.
- (set-window-start (selected-window) yank-window-start t)
- (if before
- ;; This is like exchange-point-and-mark, but doesn't activate the mark.
- ;; It is cleaner to avoid activation, even though the command
- ;; loop would deactivate the mark because we inserted text.
- (goto-char (prog1 (mark t)
- (set-marker (mark-marker) (point) (current-buffer))))))
- nil)
+ (yank-from-kill-ring (read-from-kill-ring) current-prefix-arg)
+ (setq this-command 'yank)
+ (unless arg (setq arg 1))
+ (let ((inhibit-read-only t)
+ (before (< (point) (mark t))))
+ (if before
+ (funcall (or yank-undo-function 'delete-region) (point) (mark t))
+ (funcall (or yank-undo-function 'delete-region) (mark t) (point)))
+ (setq yank-undo-function nil)
+ (set-marker (mark-marker) (point) (current-buffer))
+ (insert-for-yank (current-kill arg))
+ ;; Set the window start back where it was in the yank command,
+ ;; if possible.
+ (set-window-start (selected-window) yank-window-start t)
+ (if before
+ ;; This is like exchange-point-and-mark, but doesn't activate the mark.
+ ;; It is cleaner to avoid activation, even though the command
+ ;; loop would deactivate the mark because we inserted text.
+ (goto-char (prog1 (mark t)
+ (set-marker (mark-marker) (point) (current-buffer))))))
+ nil))
(defun yank (&optional arg)
"Reinsert (\"paste\") the last stretch of killed text.
@@ -5435,6 +5457,79 @@ See also the command `yank-pop' (\\[yank-pop])."
With ARG, rotate that many kills forward (or backward, if negative)."
(interactive "p")
(current-kill arg))
+
+(defvar read-from-kill-ring-history)
+(defun read-from-kill-ring ()
+ "Read a string from `kill-ring' using completion and minibuffer history."
+ ;; `current-kill' updates `kill-ring' with a possible interprogram-paste
+ (current-kill 0)
+ (let* ((history-add-new-input nil)
+ (ellipsis (if (char-displayable-p ?…) "…" "..."))
+ ;; Remove keymaps from text properties of copied string,
+ ;; because typing RET in the minibuffer might call
+ ;; an irrelevant command from the map of copied string.
+ (read-from-kill-ring-history
+ (mapcar (lambda (s)
+ (remove-list-of-text-properties
+ 0 (length s)
+ '(
+ keymap local-map action mouse-action
+ button category help-args)
+ s)
+ s)
+ kill-ring))
+ (completions
+ (mapcar (lambda (s)
+ (let* ((s (query-replace-descr s))
+ (b 0)
+ (limit (frame-text-cols)))
+ ;; Add ellipsis on leading whitespace
+ (when (string-match "\\`[[:space:]]+" s)
+ (setq b (match-end 0))
+ (add-text-properties 0 b `(display ,ellipsis) s))
+ ;; Add ellipsis at the end of a long string
+ (when (> (length s) (+ limit b))
+ (add-text-properties
+ (min (+ limit b) (length s)) (length s)
+ `(display ,ellipsis) s))
+ s))
+ read-from-kill-ring-history)))
+ (minibuffer-with-setup-hook
+ (lambda ()
+ ;; Allow ‘SPC’ to be self-inserting
+ (use-local-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map (current-local-map))
+ (define-key map " " nil)
+ (define-key map "?" nil)
+ map)))
+ (completing-read
+ "Yank from kill-ring: "
+ (lambda (string pred action)
+ (if (eq action 'metadata)
+ ;; Keep sorted by recency
+ '(metadata (display-sort-function . identity))
+ (complete-with-action action completions string pred)))
+ nil nil nil
+ 'read-from-kill-ring-history))))
+
+(defun yank-from-kill-ring (string &optional arg)
+ "Insert the `kill-ring' item selected from the minibuffer history.
+Use minibuffer navigation and search commands to browse the
+previously-killed items from the `kill-ring' variable in the
+minibuffer history before typing RET to insert the selected item,
+or use completion on the elements of `kill-ring'. You can edit
+the item in the minibuffer before inserting it.
+
+With \\[universal-argument] as argument, put point at beginning,
+and mark at end, like `yank' does."
+ (interactive (list (read-from-kill-ring) current-prefix-arg))
+ (push-mark)
+ (insert-for-yank string)
+ (if (consp arg)
+ ;; Swap point and mark like in `yank'.
+ (goto-char (prog1 (mark t)
+ (set-marker (mark-marker) (point) (current-buffer))))))
;; Some kill commands.
@@ -5511,7 +5606,9 @@ See also `zap-up-to-char'."
;; kill-line and its subroutines.
(defcustom kill-whole-line nil
- "If non-nil, `kill-line' with no arg at start of line kills the whole line."
+ "If non-nil, `kill-line' with no arg at start of line kills the whole line.
+This variable also affects `kill-visual-line' in the same way as
+it does `kill-line'."
:type 'boolean
:group 'killing)
@@ -6328,7 +6425,8 @@ for it.")
(<= position (point-max)))
(if widen-automatically
(widen)
- (error "Global mark position is outside accessible part of buffer")))
+ (error "Global mark position is outside accessible part of buffer %s"
+ (buffer-name buffer))))
(goto-char position)
(switch-to-buffer buffer)))
@@ -7103,6 +7201,12 @@ rests."
"Move point to visible beginning of current logical line.
This disregards any invisible newline characters.
+When moving from position that has no `field' property, this
+command doesn't enter text which has non-nil `field' property.
+In particular, when invoked in the minibuffer, the command will
+stop short of entering the text of the minibuffer prompt.
+See `inhibit-field-text-motion' for how to inhibit this.
+
With argument ARG not nil or 1, move forward ARG - 1 lines first.
If point reaches the beginning or end of buffer, it stops there.
\(But if the buffer doesn't end in a newline, it stops at the
@@ -7217,6 +7321,10 @@ If ARG is negative, kill visual lines backward.
If ARG is zero, kill the text before point on the current visual
line.
+If the variable `kill-whole-line' is non-nil, and this command is
+invoked at start of a line that ends in a newline, kill the newline
+as well.
+
If you want to append the killed line to the last killed text,
use \\[append-next-kill] before \\[kill-line].
@@ -7229,18 +7337,30 @@ even beep.)"
;; Like in `kill-line', it's better to move point to the other end
;; of the kill before killing.
(let ((opoint (point))
- (kill-whole-line (and kill-whole-line (bolp))))
+ (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)))
(if arg
(vertical-motion (prefix-numeric-value arg))
(end-of-visual-line 1)
(if (= (point) opoint)
(vertical-motion 1)
- ;; Skip any trailing whitespace at the end of the visual line.
- ;; We used to do this only if `show-trailing-whitespace' is
- ;; nil, but that's wrong; the correct thing would be to check
- ;; whether the trailing whitespace is highlighted. But, it's
- ;; OK to just do this unconditionally.
- (skip-chars-forward " \t")))
+ ;; The first condition below verifies we are still on the same
+ ;; screen line, i.e. that the line isn't continued, and that
+ ;; 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)
+ ;; 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.
+ (or (looking-at-p "[ \t]")
+ (and word-wrap-by-category
+ (aref (char-category-set (following-char)) ?\|)))
+ (forward-char))))
(kill-region opoint (if (and kill-whole-line (= (following-char) ?\n))
(1+ (point))
(point)))))
@@ -7332,8 +7452,8 @@ Mode' for details."
(if (local-variable-p var)
(push (cons var (symbol-value var))
visual-line--saved-state))))
- (set (make-local-variable 'line-move-visual) t)
- (set (make-local-variable 'truncate-partial-width-windows) nil)
+ (setq-local line-move-visual t)
+ (setq-local truncate-partial-width-windows nil)
(setq truncate-lines nil
word-wrap t
fringe-indicator-alist
@@ -7421,18 +7541,17 @@ are interchanged."
With argument ARG, takes previous line and moves it past ARG lines.
With argument 0, interchanges line point is in with line mark is in."
(interactive "*p")
- (transpose-subr (function
- (lambda (arg)
- (if (> arg 0)
- (progn
- ;; Move forward over ARG lines,
- ;; but create newlines if necessary.
- (setq arg (forward-line arg))
- (if (/= (preceding-char) ?\n)
- (setq arg (1+ arg)))
- (if (> arg 0)
- (newline arg)))
- (forward-line arg))))
+ (transpose-subr (lambda (arg)
+ (if (> arg 0)
+ (progn
+ ;; Move forward over ARG lines,
+ ;; but create newlines if necessary.
+ (setq arg (forward-line arg))
+ (if (/= (preceding-char) ?\n)
+ (setq arg (1+ arg)))
+ (if (> arg 0)
+ (newline arg)))
+ (forward-line arg)))
arg))
;; FIXME seems to leave point BEFORE the current object when ARG = 0,
@@ -8727,11 +8846,12 @@ Called from `temp-buffer-show-hook'."
(let ((base-position completion-base-position)
(insert-fun completion-list-insert-choice-function))
(completion-list-mode)
- (set (make-local-variable 'completion-base-position) base-position)
- (set (make-local-variable 'completion-list-insert-choice-function)
- insert-fun))
- (set (make-local-variable 'completion-reference-buffer) mainbuf)
+ (setq-local completion-base-position base-position)
+ (setq-local completion-list-insert-choice-function insert-fun))
+ (setq-local completion-reference-buffer mainbuf)
(if base-dir (setq default-directory base-dir))
+ (when completion-tab-width
+ (setq tab-width completion-tab-width))
;; Maybe insert help string.
(when completion-show-help
(goto-char (point-min))
@@ -9188,8 +9308,7 @@ to a non-nil value."
(cond
((and (not buffer-read-only) view-mode)
(View-exit-and-edit)
- (make-local-variable 'view-read-only)
- (setq view-read-only t)) ; Must leave view mode.
+ (setq-local view-read-only t)) ; Must leave view mode.
((and buffer-read-only view-read-only
;; If view-mode is already active, `view-mode-enter' is a nop.
(not view-mode)
@@ -9207,8 +9326,8 @@ and setting it to nil."
(setq buffer-invisibility-spec vis-mode-saved-buffer-invisibility-spec)
(kill-local-variable 'vis-mode-saved-buffer-invisibility-spec))
(when visible-mode
- (set (make-local-variable 'vis-mode-saved-buffer-invisibility-spec)
- buffer-invisibility-spec)
+ (setq-local vis-mode-saved-buffer-invisibility-spec
+ buffer-invisibility-spec)
(setq buffer-invisibility-spec nil)))
(defvar messages-buffer-mode-map
diff --git a/lisp/skeleton.el b/lisp/skeleton.el
index 6e2c10d9711..48491e43cae 100644
--- a/lisp/skeleton.el
+++ b/lisp/skeleton.el
@@ -1,6 +1,6 @@
;;; skeleton.el --- Lisp language extension for writing statement skeletons -*- lexical-binding: t; -*-
-;; Copyright (C) 1993-1996, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1996, 2001-2021 Free Software Foundation, Inc.
;; Author: Daniel Pfeiffer <occitan@esperanto.org>
;; Maintainer: emacs-devel@gnu.org
@@ -312,10 +312,15 @@ automatically, and you are prompted to fill in the variable parts.")))
(save-excursion (insert "\n")))
(unwind-protect
(setq prompt (cond ((stringp prompt)
- (read-string (format prompt skeleton-subprompt)
- (setq initial-input
- (or initial-input
- (symbol-value 'input)))))
+ ;; The user may issue commands to move
+ ;; around (like `C-M-v'). Ensure that we
+ ;; insert the skeleton at the correct
+ ;; (initial) point.
+ (save-excursion
+ (read-string (format prompt skeleton-subprompt)
+ (setq initial-input
+ (or initial-input
+ (symbol-value 'input))))))
((functionp prompt)
(funcall prompt))
(t (eval prompt))))
diff --git a/lisp/so-long.el b/lisp/so-long.el
index 6ae8d0aec8a..f44d41dc5eb 100644
--- a/lisp/so-long.el
+++ b/lisp/so-long.el
@@ -1,6 +1,6 @@
;;; so-long.el --- Say farewell to performance problems with minified code. -*- lexical-binding:t -*-
;;
-;; Copyright (C) 2015-2016, 2018-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2016, 2018-2021 Free Software Foundation, Inc.
;; Author: Phil Sainty <psainty@orcon.net.nz>
;; Maintainer: Phil Sainty <psainty@orcon.net.nz>
@@ -41,24 +41,23 @@
;; simply aren't optimised (remotely) for this scenario, so performance can
;; suffer significantly.
;;
-;; When such files are detected, the command `so-long' is automatically called,
-;; overriding certain minor modes and variables with performance implications
-;; (all configurable), in order to enhance performance in the buffer.
+;; When so-long detects such a file, it calls the command `so-long', which
+;; overrides certain minor modes and variables (you can configure the details)
+;; to improve performance in the buffer.
;;
;; The default action enables the major mode `so-long-mode' in place of the mode
;; that Emacs selected. This ensures that the original major mode cannot affect
;; performance further, as well as making the so-long activity more obvious to
;; the user. These kinds of minified files are typically not intended to be
;; edited, so not providing the usual editing mode in such cases will rarely be
-;; an issue. However, should the user wish to do so, the original state of the
-;; buffer may be reinstated by calling `so-long-revert' (the key binding for
-;; which is advertised when the major mode change occurs). If you prefer that
-;; the major mode not be changed, the `so-long-minor-mode' action can be
-;; configured.
+;; an issue. However, you can reinstate the original state of the buffer by
+;; calling `so-long-revert' (the key binding of which is advertised when the major
+;; mode change occurs). If you prefer that the major mode not be changed, you
+;; can customize the `so-long-minor-mode' action.
;;
;; The user options `so-long-action' and `so-long-action-alist' determine what
-;; will happen when `so-long' and `so-long-revert' are invoked, allowing
-;; alternative actions (including custom actions) to be configured. As well as
+;; actions `so-long' and `so-long-revert' will take. This allows you to configure
+;; alternative actions (including custom actions). As well as
;; the major and minor mode actions provided by this library, `longlines-mode'
;; is also supported by default as an alternative action.
;;
diff --git a/lisp/sort.el b/lisp/sort.el
index f878db24a3c..0d2fd416649 100644
--- a/lisp/sort.el
+++ b/lisp/sort.el
@@ -1,6 +1,6 @@
;;; sort.el --- commands to sort text in an Emacs buffer -*- lexical-binding: t -*-
-;; Copyright (C) 1986-1987, 1994-1995, 2001-2020 Free Software
+;; Copyright (C) 1986-1987, 1994-1995, 2001-2021 Free Software
;; Foundation, Inc.
;; Author: Howie Kaye
@@ -251,7 +251,7 @@ the sort order."
(narrow-to-region beg end)
(goto-char (point-min))
(sort-subr reverse
- (function (lambda () (skip-chars-forward "\n")))
+ (lambda () (skip-chars-forward "\n"))
'forward-page))))
(defvar sort-fields-syntax-table nil)
@@ -316,16 +316,16 @@ FIELD, BEG and END. BEG and END specify region to sort."
;;region to sort."
;; (interactive "p\nr")
;; (sort-fields-1 field beg end
-;; (function (lambda ()
-;; (sort-skip-fields field)
-;; (string-to-number
-;; (buffer-substring
-;; (point)
-;; (save-excursion
-;; (re-search-forward
-;; "[+-]?[0-9]*\\.?[0-9]*\\([eE][+-]?[0-9]+\\)?")
-;; (point))))))
-;; nil))
+;; (lambda ()
+;; (sort-skip-fields field)
+;; (string-to-number
+;; (buffer-substring
+;; (point)
+;; (save-excursion
+;; (re-search-forward
+;; "[+-]?[0-9]*\\.?[0-9]*\\([eE][+-]?[0-9]+\\)?")
+;; (point)))))
+;; nil))
;;;###autoload
(defun sort-fields (field beg end)
@@ -340,10 +340,10 @@ the sort order."
(let ;; To make `end-of-line' and etc. to ignore fields.
((inhibit-field-text-motion t))
(sort-fields-1 field beg end
- (function (lambda ()
- (sort-skip-fields field)
- nil))
- (function (lambda () (skip-chars-forward "^ \t\n"))))))
+ (lambda ()
+ (sort-skip-fields field)
+ nil)
+ (lambda () (skip-chars-forward "^ \t\n")))))
(defun sort-fields-1 (field beg end startkeyfun endkeyfun)
(let ((tbl (syntax-table)))
@@ -457,21 +457,21 @@ sRegexp specifying key within record: \nr")
(goto-char (match-beginning 0))
(sort-subr reverse
'sort-regexp-fields-next-record
- (function (lambda ()
- (goto-char sort-regexp-record-end)))
- (function (lambda ()
- (let ((n 0))
- (cond ((numberp key-regexp)
- (setq n key-regexp))
- ((re-search-forward
- key-regexp sort-regexp-record-end t)
- (setq n 0))
- (t (throw 'key nil)))
- (condition-case ()
- (cons (match-beginning n)
- (match-end n))
- ;; if there was no such register
- (error (throw 'key nil)))))))))))
+ (lambda ()
+ (goto-char sort-regexp-record-end))
+ (lambda ()
+ (let ((n 0))
+ (cond ((numberp key-regexp)
+ (setq n key-regexp))
+ ((re-search-forward
+ key-regexp sort-regexp-record-end t)
+ (setq n 0))
+ (t (throw 'key nil)))
+ (condition-case ()
+ (cons (match-beginning n)
+ (match-end n))
+ ;; if there was no such register
+ (error (throw 'key nil))))))))))
(defvar sort-columns-subprocess t)
diff --git a/lisp/soundex.el b/lisp/soundex.el
index fac63b160eb..ed98c65e809 100644
--- a/lisp/soundex.el
+++ b/lisp/soundex.el
@@ -1,6 +1,6 @@
;;; soundex.el --- implement Soundex algorithm -*- lexical-binding: t -*-
-;; Copyright (C) 1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 2001-2021 Free Software Foundation, Inc.
;; Author: Christian Plaunt <chris@bliss.berkeley.edu>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/speedbar.el b/lisp/speedbar.el
index 991c8a33d46..7f751ec3476 100644
--- a/lisp/speedbar.el
+++ b/lisp/speedbar.el
@@ -1,6 +1,6 @@
;;; speedbar --- quick access to files and tags in a frame
-;; Copyright (C) 1996-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: file, tags, tools
@@ -979,10 +979,9 @@ supported at a time.
(speedbar-set-timer dframe-update-speed)
)
;; Frame modifications
- (set (make-local-variable 'dframe-delete-frame-function)
- 'speedbar-handle-delete-frame)
+ (setq-local dframe-delete-frame-function 'speedbar-handle-delete-frame)
;; hscroll
- (set (make-local-variable 'auto-hscroll-mode) nil)
+ (setq-local auto-hscroll-mode nil)
;; reset the selection variable
(setq speedbar-last-selected-file nil))
@@ -1075,9 +1074,8 @@ in the selected file.
(save-excursion
(setq font-lock-keywords nil) ;; no font-locking please
(setq truncate-lines t)
- (make-local-variable 'frame-title-format)
- (setq frame-title-format "Speedbar"
- case-fold-search nil
+ (setq-local frame-title-format "Speedbar")
+ (setq case-fold-search nil
buffer-read-only t)
(speedbar-set-mode-line-format)
;; Add in our dframe hooks.
@@ -1144,6 +1142,7 @@ frame and window to be the currently active frame and window."
(defvar speedbar-previous-menu nil
"The menu before the last `speedbar-reconfigure-keymaps' was called.")
+(make-obsolete-variable 'speedbar-previous-menu "no longer used." "28.1")
(defun speedbar-reconfigure-keymaps ()
"Reconfigure the menu-bar in a speedbar frame.
@@ -1195,10 +1194,7 @@ and the existence of packages."
(speedbar-initial-keymap)
;; This creates a small keymap we can glom the
;; menu adjustments into.
- (speedbar-make-specialized-keymap)))
- ;; Delete the old menu if applicable.
- (if speedbar-previous-menu (easy-menu-remove speedbar-previous-menu))
- (setq speedbar-previous-menu md)
+ (speedbar-make-specialized-keymap)))
;; Now add the new menu
(easy-menu-define speedbar-menu-map (current-local-map)
"Speedbar menu" md))
@@ -1816,16 +1812,13 @@ of the special mode functions."
(setq v (intern-soft (concat ms "-speedbar-key-map")))
(if (not v)
nil ;; don't add special keymap
- (make-local-variable 'speedbar-special-mode-key-map)
- (setq speedbar-special-mode-key-map
- (symbol-value v)))
+ (setq-local speedbar-special-mode-key-map
+ (symbol-value v)))
(setq v (intern-soft (concat ms "-speedbar-menu-items")))
(if (not v)
nil ;; don't add special menus
- (make-local-variable 'speedbar-easymenu-definition-special)
- (setq speedbar-easymenu-definition-special
- (symbol-value v)))
- )))))))
+ (setq-local speedbar-easymenu-definition-special
+ (symbol-value v))))))))))
(defun speedbar-remove-localized-speedbar-support (buffer)
"Remove any traces that BUFFER supports speedbar in a specialized way."
@@ -1874,9 +1867,9 @@ matches the user directory ~, then it is replaced with a ~.
INDEX is not used, but is required by the caller."
(let* ((tilde (expand-file-name "~/"))
(dd (expand-file-name directory))
- (junk (string-match (regexp-quote tilde) dd))
+ (junk (string-prefix-p "~/" dd))
(displayme (if junk
- (concat "~/" (substring dd (match-end 0)))
+ (concat "~/" (substring dd 2 nil))
dd))
(p (point)))
(if (string-match "^~[/\\]?\\'" displayme) (setq displayme tilde))
diff --git a/lisp/startup.el b/lisp/startup.el
index b6793e0b776..c508af7bb26 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -1,6 +1,6 @@
;;; startup.el --- process Emacs shell arguments -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1986, 1992, 1994-2020 Free Software Foundation,
+;; Copyright (C) 1985-1986, 1992, 1994-2021 Free Software Foundation,
;; Inc.
;; Maintainer: emacs-devel@gnu.org
@@ -633,7 +633,7 @@ It is the default value of the variable `top-level'."
(with-current-buffer "*Messages*"
(messages-buffer-mode)
;; Make it easy to do like "tail -f".
- (set (make-local-variable 'window-point-insertion-type) t)
+ (setq-local window-point-insertion-type t)
;; Give *Messages* the same default-directory as *scratch*,
;; just to keep things predictable.
(setq default-directory (or dir (expand-file-name "~/")))))
@@ -921,7 +921,8 @@ the name of the init-file to load. If this file cannot be
loaded, and ALTERNATE-FILENAME-FUNCTION is non-nil, then it is
called with no arguments and should return the name of an
alternate init-file to load. If LOAD-DEFAULTS is non-nil, then
-load default.el after the init-file.
+load default.el after the init-file, unless `inhibit-default-init'
+is non-nil.
This function sets `user-init-file' to the name of the loaded
init-file, or to a default value if loading is not possible."
@@ -949,10 +950,10 @@ init-file, or to a default value if loading is not possible."
(when (and (eq user-init-file t) alternate-filename-function)
(let ((alt-file (funcall alternate-filename-function)))
- (and (equal (file-name-extension alt-file) "el")
- (setq alt-file (file-name-sans-extension alt-file)))
(unless init-file-name
(setq init-file-name alt-file))
+ (and (equal (file-name-extension alt-file) "el")
+ (setq alt-file (file-name-sans-extension alt-file)))
(load alt-file 'noerror 'nomessage)))
;; If we did not find the user's init file, set
@@ -977,8 +978,8 @@ init-file, or to a default value if loading is not possible."
(sit-for 1))
(setq user-init-file source))))
- (when load-defaults
-
+ (when (and load-defaults
+ (not inhibit-default-init))
;; Prevent default.el from changing the value of
;; `inhibit-startup-screen'.
(let ((inhibit-startup-screen nil))
@@ -1166,12 +1167,12 @@ please check its value")
;; Re-evaluate predefined variables whose initial value depends on
;; the runtime context.
- (let (current-load-list) ; c-r-s may call defvar, and hence LOADHIST_ATTACH
- (setq custom-delayed-init-variables
- ;; Initialize them in the same order they were loaded, in case there
- ;; are dependencies between them.
- (nreverse custom-delayed-init-variables))
- (mapc 'custom-reevaluate-setting custom-delayed-init-variables))
+ (setq custom-delayed-init-variables
+ ;; Initialize them in the same order they were loaded, in case there
+ ;; are dependencies between them.
+ (nreverse custom-delayed-init-variables))
+ (mapc #'custom-reevaluate-setting custom-delayed-init-variables)
+ (setq custom-delayed-init-variables nil)
;; Warn for invalid user name.
(when init-file-user
@@ -1230,18 +1231,7 @@ please check its value")
package-enable-at-startup
(not (bound-and-true-p package--activated))
(catch 'package-dir-found
- (let (dirs)
- (if (boundp 'package-directory-list)
- (setq dirs package-directory-list)
- (dolist (f load-path)
- (and (stringp f)
- (equal (file-name-nondirectory f) "site-lisp")
- (push (expand-file-name "elpa" f) dirs)))
- (push "/usr/share/emacs-snapshot/site-lisp/elpa" dirs))
- (push (if (boundp 'package-user-dir)
- package-user-dir
- (locate-user-emacs-file "elpa"))
- dirs)
+ (let ((dirs (cons package-user-dir package-directory-list)))
(dolist (dir dirs)
(when (file-directory-p dir)
(dolist (subdir (directory-files dir))
@@ -1299,8 +1289,7 @@ please check its value")
(if (or noninteractive emacs-basic-display)
(setq menu-bar-mode nil
tab-bar-mode nil
- tool-bar-mode nil
- no-blinking-cursor t))
+ tool-bar-mode nil))
(frame-initialize))
(when (fboundp 'x-create-frame)
@@ -1309,26 +1298,10 @@ please check its value")
(unless noninteractive
(tool-bar-setup)))
- ;; Turn off blinking cursor if so specified in X resources. This is here
- ;; only because all other settings of no-blinking-cursor are here.
- (unless (or noninteractive
- emacs-basic-display
- (and (memq window-system '(x w32 ns))
- (not (member (x-get-resource "cursorBlink" "CursorBlink")
- '("no" "off" "false" "0")))))
- (setq no-blinking-cursor t))
-
(unless noninteractive
(startup--setup-quote-display)
(setq internal--text-quoting-flag t))
- ;; Re-evaluate again the predefined variables whose initial value
- ;; depends on the runtime context, in case some of them depend on
- ;; the window-system features. Example: blink-cursor-mode.
- (let (current-load-list) ; c-r-s may call defvar, and hence LOADHIST_ATTACH
- (mapc 'custom-reevaluate-setting custom-delayed-init-variables)
- (setq custom-delayed-init-variables nil))
-
(normal-erase-is-backspace-setup-frame)
;; Register default TTY colors for the case the terminal hasn't a
@@ -1384,9 +1357,9 @@ please check its value")
"~/.emacs")))
(lambda ()
(expand-file-name
- "init"
+ "init.el"
startup-init-directory))
- (not inhibit-default-init))
+ t)
(when (and deactivate-mark transient-mark-mode)
(with-current-buffer (window-buffer)
@@ -1510,13 +1483,13 @@ to reading the init file), or afterwards when the user first
opens a graphical frame.
This can set the values of `menu-bar-mode', `tool-bar-mode',
-`tab-bar-mode', and `no-blinking-cursor', as well as the `cursor' face.
+`tab-bar-mode', and `blink-cursor-mode', as well as the `cursor' face.
Changed settings will be marked as \"CHANGED outside of Customize\"."
(let ((no-vals '("no" "off" "false" "0"))
(settings '(("menuBar" "MenuBar" menu-bar-mode nil)
("toolBar" "ToolBar" tool-bar-mode nil)
("scrollBar" "ScrollBar" scroll-bar-mode nil)
- ("cursorBlink" "CursorBlink" no-blinking-cursor t))))
+ ("cursorBlink" "CursorBlink" blink-cursor-mode nil))))
(dolist (x settings)
(if (member (x-get-resource (nth 0 x) (nth 1 x)) no-vals)
(set (nth 2 x) (nth 3 x)))))
@@ -2001,7 +1974,7 @@ splash screen in another window."
(setq buffer-read-only nil)
(erase-buffer)
(setq default-directory command-line-default-directory)
- (set (make-local-variable 'tab-width) 8)
+ (setq-local tab-width 8)
(if pure-space-overflow
(insert pure-space-overflow-message))
diff --git a/lisp/strokes.el b/lisp/strokes.el
index c2f03cac0f1..55f2ae8cc47 100644
--- a/lisp/strokes.el
+++ b/lisp/strokes.el
@@ -1,6 +1,6 @@
;;; strokes.el --- control Emacs through mouse strokes
-;; Copyright (C) 1997, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2000-2021 Free Software Foundation, Inc.
;; Author: David Bakhash <cadet@alum.mit.edu>
;; Maintainer: emacs-devel@gnu.org
@@ -574,9 +574,8 @@ Optional GRID-RESOLUTION may be used in place of `strokes-grid-resolution'.
The grid is a square whose dimension is [0,GRID-RESOLUTION)."
(or grid-resolution (setq grid-resolution strokes-grid-resolution))
(let ((stroke-extent (strokes-get-stroke-extent positions)))
- (mapcar (function
- (lambda (pos)
- (strokes-get-grid-position stroke-extent pos grid-resolution)))
+ (mapcar (lambda (pos)
+ (strokes-get-grid-position stroke-extent pos grid-resolution))
positions)))
(defun strokes-fill-stroke (unfilled-stroke &optional force)
@@ -757,12 +756,12 @@ Optional EVENT is acceptable as the starting event of the stroke."
(strokes-fill-current-buffer-with-whitespace))
(when prompt
(message "%s" prompt)
- (setq event (read-event))
+ (setq event (read--potential-mouse-event))
(or (strokes-button-press-event-p event)
(error "You must draw with the mouse")))
(unwind-protect
(track-mouse
- (or event (setq event (read-event)
+ (or event (setq event (read--potential-mouse-event)
safe-to-draw-p t))
(while (not (strokes-button-release-event-p event))
(if (strokes-mouse-event-p event)
@@ -777,7 +776,7 @@ Optional EVENT is acceptable as the starting event of the stroke."
(setq safe-to-draw-p t))
(push (cdr (mouse-pixel-position))
pix-locs)))
- (setq event (read-event)))))
+ (setq event (read--potential-mouse-event)))))
;; protected
;; clean up strokes buffer and then bury it.
(when (equal (buffer-name) strokes-buffer-name)
@@ -788,16 +787,16 @@ Optional EVENT is acceptable as the starting event of the stroke."
;; Otherwise, don't use strokes buffer and read stroke silently
(when prompt
(message "%s" prompt)
- (setq event (read-event))
+ (setq event (read--potential-mouse-event))
(or (strokes-button-press-event-p event)
(error "You must draw with the mouse")))
(track-mouse
- (or event (setq event (read-event)))
+ (or event (setq event (read--potential-mouse-event)))
(while (not (strokes-button-release-event-p event))
(if (strokes-mouse-event-p event)
(push (cdr (mouse-pixel-position))
pix-locs))
- (setq event (read-event))))
+ (setq event (read--potential-mouse-event))))
(setq grid-locs (strokes-renormalize-to-grid (nreverse pix-locs)))
(strokes-fill-stroke
(strokes-eliminate-consecutive-redundancies grid-locs)))))
@@ -818,10 +817,10 @@ Optional EVENT is acceptable as the starting event of the stroke."
(if prompt
(while (not (strokes-button-press-event-p event))
(message "%s" prompt)
- (setq event (read-event))))
+ (setq event (read--potential-mouse-event))))
(unwind-protect
(track-mouse
- (or event (setq event (read-event)))
+ (or event (setq event (read--potential-mouse-event)))
(while (not (and (strokes-button-press-event-p event)
(eq 'mouse-3
(car (get (car event)
@@ -835,14 +834,15 @@ Optional EVENT is acceptable as the starting event of the stroke."
?\s strokes-character))
(push (cdr (mouse-pixel-position))
pix-locs)))
- (setq event (read-event)))
+ (setq event (read--potential-mouse-event)))
(push strokes-lift pix-locs)
(while (not (strokes-button-press-event-p event))
- (setq event (read-event))))
+ (setq event (read--potential-mouse-event))))
;; ### KLUDGE! ### sit and wait
;; for some useless event to
;; happen to fix the minibuffer bug.
- (while (not (strokes-button-release-event-p (read-event))))
+ (while (not (strokes-button-release-event-p
+ (read--potential-mouse-event))))
(setq pix-locs (nreverse (cdr pix-locs))
grid-locs (strokes-renormalize-to-grid pix-locs))
(strokes-fill-stroke
@@ -1232,8 +1232,8 @@ the stroke as a character in some language."
;; mode-popup-menu edit-strokes-menu) ; what about extent-specific stuff?
;; (and (featurep 'menubar)
;; current-menubar
-;; (set (make-local-variable 'current-menubar)
-;; (copy-sequence current-menubar))
+;; (setq-local current-menubar
+;; (copy-sequence current-menubar))
;; (add-submenu nil edit-strokes-menu)))
;;(let ((map edit-strokes-mode-map))
@@ -1364,13 +1364,13 @@ If STROKES-MAP is not given, `strokes-global-map' will be used instead."
finally do (unless (eobp)
(kill-region (1+ (point)) (point-max))))
(view-buffer "*Strokes List*" nil)
- (set (make-local-variable 'view-mode-map)
- (let ((map (copy-keymap view-mode-map)))
- (define-key map "q" `(lambda ()
- (interactive)
- (View-quit)
- (set-window-configuration ,config)))
- map))
+ (setq-local view-mode-map
+ (let ((map (copy-keymap view-mode-map)))
+ (define-key map "q" `(lambda ()
+ (interactive)
+ (View-quit)
+ (set-window-configuration ,config)))
+ map))
(goto-char (point-min))))
(defun strokes-alphabetic-lessp (stroke1 stroke2)
diff --git a/lisp/subr.el b/lisp/subr.el
index 286851dfc83..f249ec3578c 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1,6 +1,6 @@
;;; subr.el --- basic lisp subroutines for Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1985-1986, 1992, 1994-1995, 1999-2020 Free Software
+;; Copyright (C) 1985-1986, 1992, 1994-1995, 1999-2021 Free Software
;; Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
@@ -995,6 +995,22 @@ a menu, so this function is not useful for non-menu keymaps."
(setq inserted t)))
(setq tail (cdr tail)))))
+(defun define-prefix-command (command &optional mapvar name)
+ "Define COMMAND as a prefix command. COMMAND should be a symbol.
+A new sparse keymap is stored as COMMAND's function definition and its
+value.
+This prepares COMMAND for use as a prefix key's binding.
+If a second optional argument MAPVAR is given, it should be a symbol.
+The map is then stored as MAPVAR's value instead of as COMMAND's
+value; but COMMAND is still defined as a function.
+The third optional argument NAME, if given, supplies a menu name
+string for the map. This is required to use the keymap as a menu.
+This function returns COMMAND."
+ (let ((map (make-sparse-keymap name)))
+ (fset command map)
+ (set (or mapvar command) map)
+ command))
+
(defun map-keymap-sorted (function keymap)
"Implement `map-keymap' with sorting.
Don't call this function; it is for internal use only."
@@ -1162,6 +1178,30 @@ KEY is a string or vector representing a sequence of keystrokes."
(if (current-local-map)
(local-set-key key nil))
nil)
+
+(defun local-key-binding (keys &optional accept-default)
+ "Return the binding for command KEYS in current local keymap only.
+KEYS is a string or vector, a sequence of keystrokes.
+The binding is probably a symbol with a function definition.
+
+If optional argument ACCEPT-DEFAULT is non-nil, recognize default
+bindings; see the description of `lookup-key' for more details
+about this."
+ (let ((map (current-local-map)))
+ (when map (lookup-key map keys accept-default))))
+
+(defun global-key-binding (keys &optional accept-default)
+ "Return the binding for command KEYS in current global keymap only.
+KEYS is a string or vector, a sequence of keystrokes.
+The binding is probably a symbol with a function definition.
+This function's return values are the same as those of `lookup-key'
+\(which see).
+
+If optional argument ACCEPT-DEFAULT is non-nil, recognize default
+bindings; see the description of `lookup-key' for more details
+about this."
+ (lookup-key (current-global-map) keys accept-default))
+
;;;; substitute-key-definition and its subroutines.
@@ -1239,35 +1279,85 @@ in a cleaner way with command remapping, like this:
;;;; The global keymap tree.
-;; global-map, esc-map, and ctl-x-map have their values set up in
-;; keymap.c; we just give them docstrings here.
-
-(defvar global-map nil
- "Default global keymap mapping Emacs keyboard input into commands.
-The value is a keymap that is usually (but not necessarily) Emacs's
-global map.")
-
-(defvar esc-map nil
+(defvar esc-map
+ (let ((map (make-keymap)))
+ (define-key map "u" #'upcase-word)
+ (define-key map "l" #'downcase-word)
+ (define-key map "c" #'capitalize-word)
+ (define-key map "x" #'execute-extended-command)
+ map)
"Default keymap for ESC (meta) commands.
The normal global definition of the character ESC indirects to this keymap.")
-
-(defvar ctl-x-map nil
- "Default keymap for C-x commands.
-The normal global definition of the character C-x indirects to this keymap.")
+(fset 'ESC-prefix esc-map)
+(make-obsolete 'ESC-prefix 'esc-map "28.1")
(defvar ctl-x-4-map (make-sparse-keymap)
"Keymap for subcommands of C-x 4.")
(defalias 'ctl-x-4-prefix ctl-x-4-map)
-(define-key ctl-x-map "4" 'ctl-x-4-prefix)
(defvar ctl-x-5-map (make-sparse-keymap)
"Keymap for frame commands.")
(defalias 'ctl-x-5-prefix ctl-x-5-map)
-(define-key ctl-x-map "5" 'ctl-x-5-prefix)
(defvar tab-prefix-map (make-sparse-keymap)
"Keymap for tab-bar related commands.")
-(define-key ctl-x-map "t" tab-prefix-map)
+
+(defvar ctl-x-map
+ (let ((map (make-keymap)))
+ (define-key map "4" 'ctl-x-4-prefix)
+ (define-key map "5" 'ctl-x-5-prefix)
+ (define-key map "t" tab-prefix-map)
+
+ (define-key map "b" #'switch-to-buffer)
+ (define-key map "k" #'kill-buffer)
+ (define-key map "\C-u" #'upcase-region) (put 'upcase-region 'disabled t)
+ (define-key map "\C-l" #'downcase-region) (put 'downcase-region 'disabled t)
+ (define-key map "<" #'scroll-left)
+ (define-key map ">" #'scroll-right)
+ map)
+ "Default keymap for C-x commands.
+The normal global definition of the character C-x indirects to this keymap.")
+(fset 'Control-X-prefix ctl-x-map)
+(make-obsolete 'Control-X-prefix 'ctl-x-map "28.1")
+
+(defvar global-map
+ (let ((map (make-keymap)))
+ (define-key map "\C-[" 'ESC-prefix)
+ (define-key map "\C-x" 'Control-X-prefix)
+
+ (define-key map "\C-i" #'self-insert-command)
+ (let* ((vec1 (make-vector 1 nil))
+ (f (lambda (from to)
+ (while (< from to)
+ (aset vec1 0 from)
+ (define-key map vec1 #'self-insert-command)
+ (setq from (1+ from))))))
+ (funcall f #o040 #o0177)
+ (when (eq system-type 'ms-dos) ;FIXME: Why?
+ (funcall f #o0200 #o0240))
+ (funcall f #o0240 #o0400))
+
+ (define-key map "\C-a" #'beginning-of-line)
+ (define-key map "\C-b" #'backward-char)
+ (define-key map "\C-e" #'end-of-line)
+ (define-key map "\C-f" #'forward-char)
+
+ (define-key map "\C-z" #'suspend-emacs) ;FIXME: Re-bound later!
+ (define-key map "\C-x\C-z" #'suspend-emacs) ;FIXME: Re-bound later!
+
+ (define-key map "\C-v" #'scroll-up-command)
+ (define-key map "\M-v" #'scroll-down-command)
+ (define-key map "\M-\C-v" #'scroll-other-window)
+
+ (define-key map "\M-\C-c" #'exit-recursive-edit)
+ (define-key map "\C-]" #'abort-recursive-edit)
+ map)
+ "Default global keymap mapping Emacs keyboard input into commands.
+The value is a keymap that is usually (but not necessarily) Emacs's
+global map.
+
+See also `current-global-map'.")
+(use-global-map global-map)
;;;; Event manipulation functions.
@@ -1278,10 +1368,10 @@ The normal global definition of the character C-x indirects to this keymap.")
"Convert a key sequence to a list of events."
(if (vectorp key)
(append key nil)
- (mapcar (function (lambda (c)
- (if (> c 127)
- (logxor c listify-key-sequence-1)
- c)))
+ (mapcar (lambda (c)
+ (if (> c 127)
+ (logxor c listify-key-sequence-1)
+ c))
key)))
(defun eventp (object)
@@ -1742,7 +1832,36 @@ FUNCTION isn't the value of HOOK, or, if FUNCTION doesn't appear in the
list of hooks to run in HOOK, then nothing is done. See `add-hook'.
The optional third argument, LOCAL, if non-nil, says to modify
-the hook's buffer-local value rather than its default value."
+the hook's buffer-local value rather than its default value.
+
+Interactively, prompt for the various arguments (skipping local
+unless HOOK has both local and global functions). If multiple
+functions have the same representation under `princ', the first
+one will be removed."
+ (interactive
+ (let* ((default (and (symbolp (variable-at-point))
+ (symbol-name (variable-at-point))))
+ (hook (intern (completing-read
+ (format-prompt "Hook variable" default)
+ obarray #'boundp t nil nil default)))
+ (local
+ (and
+ (local-variable-p hook)
+ (symbol-value hook)
+ ;; No need to prompt if there's nothing global
+ (or (not (default-value hook))
+ (y-or-n-p (format "%s has a buffer-local binding, use that? "
+ hook)))))
+ (fn-alist (mapcar
+ (lambda (x) (cons (with-output-to-string (prin1 x)) x))
+ (if local (symbol-value hook) (default-value hook))))
+ (function (alist-get (completing-read
+ (format "%s hook to remove: "
+ (if local "Buffer-local" "Global"))
+ fn-alist
+ nil t)
+ fn-alist nil nil 'string=)))
+ (list hook function local)))
(or (boundp hook) (set hook nil))
(or (default-boundp hook) (set-default hook nil))
;; Do nothing if LOCAL is t but this hook has no local binding.
@@ -1781,9 +1900,33 @@ all symbols are bound before any of the VALUEFORMs are evalled."
;; As a special-form, we could implement it more efficiently (and cleanly,
;; making the vars actually unbound during evaluation of the binders).
(declare (debug let) (indent 1))
- `(let ,(mapcar #'car binders)
- ,@(mapcar (lambda (binder) `(setq ,@binder)) binders)
- ,@body))
+ ;; Use plain `let*' for the non-recursive definitions.
+ ;; This only handles the case where the first few definitions are not
+ ;; recursive. Nothing as fancy as an SCC analysis.
+ (let ((seqbinds nil))
+ ;; Our args haven't yet been macro-expanded, so `macroexp--fgrep'
+ ;; may fail to see references that will be introduced later by
+ ;; macroexpansion. We could call `macroexpand-all' to avoid that,
+ ;; but in order to avoid that, we instead check to see if the binders
+ ;; appear in the macroexp environment, since that's how references can be
+ ;; introduced later on.
+ (unless (macroexp--fgrep binders macroexpand-all-environment)
+ (while (and binders
+ (null (macroexp--fgrep binders (nth 1 (car binders)))))
+ (push (pop binders) seqbinds)))
+ (let ((nbody (if (null binders)
+ (macroexp-progn body)
+ `(let ,(mapcar #'car binders)
+ ,@(mapcar (lambda (binder) `(setq ,@binder)) binders)
+ ,@body))))
+ (cond
+ ;; All bindings are recursive.
+ ((null seqbinds) nbody)
+ ;; Special case for trivial uses.
+ ((and (symbolp nbody) (null (cdr seqbinds)) (eq nbody (caar seqbinds)))
+ (nth 1 (car seqbinds)))
+ ;; General case.
+ (t `(let* ,(nreverse seqbinds) ,nbody))))))
(defmacro dlet (binders &rest body)
"Like `let*' but using dynamic scoping."
@@ -1950,9 +2093,8 @@ can do the job."
"Add ELEMENT to the value of LIST-VAR if it isn't there yet.
The test for presence of ELEMENT is done with `eq'.
-The resulting list is reordered so that the elements are in the
-order given by each element's numeric list order. Elements
-without a numeric list order are placed at the end of the list.
+The value of LIST-VAR is kept ordered based on the ORDER
+parameter.
If the third optional argument ORDER is a number (integer or
float), set the element's list order to the given value. If
@@ -2427,23 +2569,52 @@ It can be retrieved with `(process-get PROCESS PROPNAME)'."
;;;; Input and display facilities.
-(defconst read-key-empty-map (make-sparse-keymap))
+;; The following maps are used by `read-key' to remove all key
+;; bindings while calling `read-key-sequence'. This way the keys
+;; returned are independent of the key binding state.
+
+(defconst read-key-empty-map (make-sparse-keymap)
+ "Used internally by `read-key'.")
+
+(defconst read-key-full-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [t] 'dummy)
+
+ ;; ESC needs to be unbound so that escape sequences in
+ ;; `input-decode-map' are still processed by `read-key-sequence'.
+ (define-key map [?\e] nil)
+ map)
+ "Used internally by `read-key'.")
(defvar read-key-delay 0.01) ;Fast enough for 100Hz repeat rate, hopefully.
-(defun read-key (&optional prompt)
+(defun read-key (&optional prompt disable-fallbacks)
"Read a key from the keyboard.
Contrary to `read-event' this will not return a raw event but instead will
obey the input decoding and translations usually done by `read-key-sequence'.
So escape sequences and keyboard encoding are taken into account.
When there's an ambiguity because the key looks like the prefix of
-some sort of escape sequence, the ambiguity is resolved via `read-key-delay'."
+some sort of escape sequence, the ambiguity is resolved via `read-key-delay'.
+
+If the optional argument PROMPT is non-nil, display that as a
+prompt.
+
+If the optional argument DISABLE-FALLBACKS is non-nil, all
+unbound fallbacks usually done by `read-key-sequence' are
+disabled such as discarding mouse down events. This is generally
+what you want as `read-key' temporarily removes all bindings
+while calling `read-key-sequence'. If nil or unspecified, the
+only unbound fallback disabled is downcasing of the last event."
;; This overriding-terminal-local-map binding also happens to
;; disable quail's input methods, so although read-key-sequence
;; always inherits the input method, in practice read-key does not
;; inherit the input method (at least not if it's based on quail).
(let ((overriding-terminal-local-map nil)
- (overriding-local-map read-key-empty-map)
+ (overriding-local-map
+ ;; FIXME: Audit existing uses of `read-key' to see if they
+ ;; should always specify disable-fallbacks to be more in line
+ ;; with `read-event'.
+ (if disable-fallbacks read-key-full-map read-key-empty-map))
(echo-keystrokes 0)
(old-global-map (current-global-map))
(timer (run-with-idle-timer
@@ -2497,6 +2668,23 @@ some sort of escape sequence, the ambiguity is resolved via `read-key-delay'."
(message nil)
(use-global-map old-global-map))))
+;; FIXME: Once there's a safe way to transition away from read-event,
+;; callers to this function should be updated to that way and this
+;; function should be deleted.
+(defun read--potential-mouse-event ()
+ "Read an event that might be a mouse event.
+
+This function exists for backward compatibility in code packaged
+with Emacs. Do not call it directly in your own packages."
+ ;; `xterm-mouse-mode' events must go through `read-key' as they
+ ;; are decoded via `input-decode-map'.
+ (if xterm-mouse-mode
+ (read-key nil
+ ;; Normally `read-key' discards all mouse button
+ ;; down events. However, we want them here.
+ t)
+ (read-event)))
+
(defvar read-passwd-map
;; BEWARE: `defconst' would purecopy it, breaking the sharing with
;; minibuffer-local-map along the way!
@@ -2601,58 +2789,60 @@ This function is used by the `interactive' code letter `n'."
t)))
n))
+(defvar read-char-choice-use-read-key nil
+ "Prefer `read-key' when reading a character by `read-char-choice'.
+Otherwise, use the minibuffer.")
+
(defun read-char-choice (prompt chars &optional inhibit-keyboard-quit)
"Read and return one of CHARS, prompting for PROMPT.
Any input that is not one of CHARS is ignored.
If optional argument INHIBIT-KEYBOARD-QUIT is non-nil, ignore
-keyboard-quit events while waiting for a valid input."
- (unless (consp chars)
- (error "Called `read-char-choice' without valid char choices"))
- (let (char done show-help (helpbuf " *Char Help*"))
- (let ((cursor-in-echo-area t)
- (executing-kbd-macro executing-kbd-macro)
- (esc-flag nil))
- (save-window-excursion ; in case we call help-form-show
- (while (not done)
- (unless (get-text-property 0 'face prompt)
- (setq prompt (propertize prompt 'face 'minibuffer-prompt)))
- (setq char (let ((inhibit-quit inhibit-keyboard-quit))
- (read-char-from-minibuffer
- prompt
- ;; If we have a dynamically bound `help-form'
- ;; here, then the `C-h' (i.e., `help-char')
- ;; character should output that instead of
- ;; being a command char.
- (if help-form
- (cons help-char chars)
- chars))))
- (and show-help (buffer-live-p (get-buffer helpbuf))
- (kill-buffer helpbuf))
- (cond
- ((not (numberp char)))
- ;; If caller has set help-form, that's enough.
- ;; They don't explicitly have to add help-char to chars.
- ((and help-form
- (eq char help-char)
- (setq show-help t)
- (help-form-show)))
- ((memq char chars)
- (setq done t))
- ((and executing-kbd-macro (= char -1))
- ;; read-event returns -1 if we are in a kbd macro and
- ;; there are no more events in the macro. Attempt to
- ;; get an event interactively.
- (setq executing-kbd-macro nil))
- ((not inhibit-keyboard-quit)
- (cond
- ((and (null esc-flag) (eq char ?\e))
- (setq esc-flag t))
- ((memq char '(?\C-g ?\e))
- (keyboard-quit))))))))
- ;; Display the question with the answer. But without cursor-in-echo-area.
- (message "%s%s" prompt (char-to-string char))
- char))
+keyboard-quit events while waiting for a valid input.
+
+If you bind the variable `help-form' to a non-nil value
+while calling this function, then pressing `help-char'
+causes it to evaluate `help-form' and display the result."
+ (if (not read-char-choice-use-read-key)
+ (read-char-from-minibuffer prompt chars)
+ (unless (consp chars)
+ (error "Called `read-char-choice' without valid char choices"))
+ (let (char done show-help (helpbuf " *Char Help*"))
+ (let ((cursor-in-echo-area t)
+ (executing-kbd-macro executing-kbd-macro)
+ (esc-flag nil))
+ (save-window-excursion ; in case we call help-form-show
+ (while (not done)
+ (unless (get-text-property 0 'face prompt)
+ (setq prompt (propertize prompt 'face 'minibuffer-prompt)))
+ (setq char (let ((inhibit-quit inhibit-keyboard-quit))
+ (read-key prompt)))
+ (and show-help (buffer-live-p (get-buffer helpbuf))
+ (kill-buffer helpbuf))
+ (cond
+ ((not (numberp char)))
+ ;; If caller has set help-form, that's enough.
+ ;; They don't explicitly have to add help-char to chars.
+ ((and help-form
+ (eq char help-char)
+ (setq show-help t)
+ (help-form-show)))
+ ((memq char chars)
+ (setq done t))
+ ((and executing-kbd-macro (= char -1))
+ ;; read-event returns -1 if we are in a kbd macro and
+ ;; there are no more events in the macro. Attempt to
+ ;; get an event interactively.
+ (setq executing-kbd-macro nil))
+ ((not inhibit-keyboard-quit)
+ (cond
+ ((and (null esc-flag) (eq char ?\e))
+ (setq esc-flag t))
+ ((memq char '(?\C-g ?\e))
+ (keyboard-quit))))))))
+ ;; Display the question with the answer. But without cursor-in-echo-area.
+ (message "%s%s" prompt (char-to-string char))
+ char)))
(defun sit-for (seconds &optional nodisp obsolete)
"Redisplay, then wait for SECONDS seconds. Stop when input is available.
@@ -2723,6 +2913,15 @@ floating point support."
(push (cons t read) unread-command-events)
nil))))))
+(defun goto-char--read-natnum-interactive (prompt)
+ "Get a natural number argument, optionally prompting with PROMPT.
+If there is a natural number at point, use it as default."
+ (if (and current-prefix-arg (not (consp current-prefix-arg)))
+ (list (prefix-numeric-value current-prefix-arg))
+ (let* ((number (number-at-point))
+ (default (and (natnump number) number)))
+ (list (read-number prompt (list default (point)))))))
+
(defvar read-char-history nil
"The default history for the `read-char-from-minibuffer' function.")
@@ -2743,50 +2942,73 @@ floating point support."
"Keymap for the `read-char-from-minibuffer' function.")
(defconst read-char-from-minibuffer-map-hash
- (make-hash-table :weakness 'key :test 'equal))
+ (make-hash-table :test 'equal))
(defun read-char-from-minibuffer-insert-char ()
"Insert the character you type in the minibuffer and exit.
Discard all previous input before inserting and exiting the minibuffer."
(interactive)
- (delete-minibuffer-contents)
- (insert last-command-event)
- (exit-minibuffer))
+ (when (minibufferp)
+ (delete-minibuffer-contents)
+ (insert last-command-event)
+ (exit-minibuffer)))
(defun read-char-from-minibuffer-insert-other ()
"Handle inserting of a character other than allowed.
Display an error on trying to insert a disallowed character.
Also discard all previous input in the minibuffer."
(interactive)
- (delete-minibuffer-contents)
- (ding)
- (discard-input)
- (minibuffer-message "Wrong answer")
- (sit-for 2))
+ (when (minibufferp)
+ (delete-minibuffer-contents)
+ (ding)
+ (discard-input)
+ (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 PROMPT.
+ "Read a character from the minibuffer, prompting for it with PROMPT.
Like `read-char', but uses the minibuffer to read and return a character.
-When CHARS is non-nil, any input that is not one of CHARS is ignored.
-When HISTORY is a symbol, then allows navigating in a history.
-The navigation commands are `M-p' and `M-n', with `RET' to select
-a character from history."
+Optional argument CHARS, if non-nil, should be a list of characters;
+the function will ignore any input that is not one of CHARS.
+Optional argument HISTORY, if non-nil, should be a symbol that
+specifies the history list variable to use for navigating in input
+history using `M-p' and `M-n', with `RET' to select a character from
+history.
+If you bind the variable `help-form' to a non-nil value
+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'."
(let* ((empty-history '())
(map (if (consp chars)
- (or (gethash chars read-char-from-minibuffer-map-hash)
- (puthash chars
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map read-char-from-minibuffer-map)
- (dolist (char chars)
- (define-key map (vector char)
- 'read-char-from-minibuffer-insert-char))
- (define-key map [remap self-insert-command]
- 'read-char-from-minibuffer-insert-other)
- map)
- read-char-from-minibuffer-map-hash))
+ (or (gethash (list help-form (cons help-char chars))
+ read-char-from-minibuffer-map-hash)
+ (let ((map (make-sparse-keymap))
+ (msg help-form))
+ (set-keymap-parent map read-char-from-minibuffer-map)
+ ;; If we have a dynamically bound `help-form'
+ ;; here, then the `C-h' (i.e., `help-char')
+ ;; character should output that instead of
+ ;; being a command char.
+ (when help-form
+ (define-key map (vector help-char)
+ (lambda ()
+ (interactive)
+ (let ((help-form msg)) ; lexically bound msg
+ (help-form-show)))))
+ (dolist (char chars)
+ (define-key map (vector char)
+ 'read-char-from-minibuffer-insert-char))
+ (define-key map [remap self-insert-command]
+ 'read-char-from-minibuffer-insert-other)
+ (puthash (list help-form (cons help-char chars))
+ map read-char-from-minibuffer-map-hash)
+ map))
read-char-from-minibuffer-map))
+ ;; Protect this-command when called from pre-command-hook (bug#45029)
+ (this-command this-command)
(result
(read-from-minibuffer prompt nil map nil
(or history 'empty-history)))
@@ -2817,7 +3039,7 @@ a character from history."
(define-key map [remap skip] 'y-or-n-p-insert-n)
- (dolist (symbol '(help backup undo undo-all edit edit-replacement
+ (dolist (symbol '(backup undo undo-all edit edit-replacement
delete-and-edit ignore self-insert-command))
(define-key map (vector 'remap symbol) 'y-or-n-p-insert-other))
@@ -2841,28 +3063,35 @@ a character from history."
"Insert the answer \"y\" and exit the minibuffer of `y-or-n-p'.
Discard all previous input before inserting and exiting the minibuffer."
(interactive)
- (delete-minibuffer-contents)
- (insert "y")
- (exit-minibuffer))
+ (when (minibufferp)
+ (delete-minibuffer-contents)
+ (insert "y")
+ (exit-minibuffer)))
(defun y-or-n-p-insert-n ()
"Insert the answer \"n\" and exit the minibuffer of `y-or-n-p'.
Discard all previous input before inserting and exiting the minibuffer."
(interactive)
- (delete-minibuffer-contents)
- (insert "n")
- (exit-minibuffer))
+ (when (minibufferp)
+ (delete-minibuffer-contents)
+ (insert "n")
+ (exit-minibuffer)))
(defun y-or-n-p-insert-other ()
"Handle inserting of other answers in the minibuffer of `y-or-n-p'.
Display an error on trying to insert a disallowed character.
Also discard all previous input in the minibuffer."
(interactive)
- (delete-minibuffer-contents)
- (ding)
- (discard-input)
- (minibuffer-message "Please answer y or n")
- (sit-for 2))
+ (when (minibufferp)
+ (delete-minibuffer-contents)
+ (ding)
+ (discard-input)
+ (minibuffer-message "Please answer y or n")
+ (sit-for 2)))
+
+(defvar y-or-n-p-use-read-key nil
+ "Prefer `read-key' when answering a \"y or n\" question by `y-or-n-p'.
+Otherwise, use the minibuffer.")
(defvar empty-history)
@@ -2872,6 +3101,12 @@ Return t if answer is \"y\" and nil if it is \"n\".
PROMPT is the string to display to ask the question. It should
end in a space; `y-or-n-p' adds \"(y or n) \" to it.
+If you bind the variable `help-form' to a non-nil value
+while calling this function, then pressing `help-char'
+causes it to evaluate `help-form' and display the result.
+PROMPT is also updated to show `help-char' like \"(y, n or C-h) \",
+where `help-char' is automatically bound to `help-form-show'.
+
No confirmation of the answer is requested; a single character is
enough. SPC also means yes, and DEL means no.
@@ -2894,7 +3129,13 @@ is nil and `use-dialog-box' is non-nil."
(concat prompt
(if (or (zerop l) (eq ?\s (aref prompt (1- l))))
"" " ")
- (if dialog "" "(y or n) "))))))
+ (if dialog ""
+ (if help-form
+ (format "(y, n or %s) "
+ (key-description
+ (vector help-char)))
+ "(y or n) "
+ )))))))
(cond
(noninteractive
(setq prompt (funcall padded prompt))
@@ -2903,6 +3144,7 @@ is nil and `use-dialog-box' is non-nil."
(let ((str (read-string temp-prompt)))
(cond ((member str '("y" "Y")) (setq answer 'act))
((member str '("n" "N")) (setq answer 'skip))
+ ((and (member str '("h" "H")) help-form) (print help-form))
(t (setq temp-prompt (concat "Please answer y or n. "
prompt))))))))
((and (display-popup-menus-p)
@@ -2911,14 +3153,61 @@ is nil and `use-dialog-box' is non-nil."
use-dialog-box)
(setq prompt (funcall padded prompt t)
answer (x-popup-dialog t `(,prompt ("Yes" . act) ("No" . skip)))))
+ (y-or-n-p-use-read-key
+ ;; ¡Beware! when I tried to edebug this code, Emacs got into a weird state
+ ;; where all the keys were unbound (i.e. it somehow got triggered
+ ;; within read-key, apparently). I had to kill it.
+ (setq prompt (funcall padded prompt))
+ (while
+ (let* ((scroll-actions '(recenter scroll-up scroll-down
+ scroll-other-window scroll-other-window-down))
+ (key
+ (let ((cursor-in-echo-area t))
+ (when minibuffer-auto-raise
+ (raise-frame (window-frame (minibuffer-window))))
+ (read-key (propertize (if (memq answer scroll-actions)
+ prompt
+ (concat "Please answer y or n. "
+ prompt))
+ 'face 'minibuffer-prompt)))))
+ (setq answer (lookup-key query-replace-map (vector key) t))
+ (cond
+ ((memq answer '(skip act)) nil)
+ ((eq answer 'recenter)
+ (recenter) t)
+ ((eq answer 'scroll-up)
+ (ignore-errors (scroll-up-command)) t)
+ ((eq answer 'scroll-down)
+ (ignore-errors (scroll-down-command)) t)
+ ((eq answer 'scroll-other-window)
+ (ignore-errors (scroll-other-window)) t)
+ ((eq answer 'scroll-other-window-down)
+ (ignore-errors (scroll-other-window-down)) t)
+ ((or (memq answer '(exit-prefix quit)) (eq key ?\e))
+ (signal 'quit nil) t)
+ (t t)))
+ (ding)
+ (discard-input)))
(t
(setq prompt (funcall padded prompt))
(let* ((empty-history '())
(enable-recursive-minibuffers t)
+ (msg help-form)
+ (keymap (let ((map (make-composed-keymap
+ y-or-n-p-map query-replace-map)))
+ (when help-form
+ ;; Create a new map before modifying
+ (setq map (copy-keymap map))
+ (define-key map (vector help-char)
+ (lambda ()
+ (interactive)
+ (let ((help-form msg)) ; lexically bound msg
+ (help-form-show)))))
+ map))
+ ;; Protect this-command when called from pre-command-hook (bug#45029)
+ (this-command this-command)
(str (read-from-minibuffer
- prompt nil
- (make-composed-keymap y-or-n-p-map query-replace-map)
- nil
+ prompt nil keymap nil
(or y-or-n-p-history-variable 'empty-history))))
(setq answer (if (member str '("y" "Y")) 'act 'skip)))))
(let ((ret (eq answer 'act)))
@@ -2998,7 +3287,21 @@ to `accept-change-group' or `cancel-change-group'."
(dolist (elt handle)
(with-current-buffer (car elt)
(if (eq buffer-undo-list t)
- (setq buffer-undo-list nil)))))
+ (setq buffer-undo-list nil)
+ ;; Add a boundary to make sure the upcoming changes won't be
+ ;; merged/combined with any previous changes (bug#33341).
+ ;; We're not supposed to introduce a real (visible)
+ ;; `undo-boundary', tho, so we have to push something else
+ ;; that acts like a boundary w.r.t preventing merges while
+ ;; being harmless.
+ ;; We use for that an "empty insertion", but in order to be harmless,
+ ;; it has to be at a harmless position. Currently only
+ ;; insertions are ever merged/combined, so we use such a "boundary"
+ ;; only when the last change was an insertion and we use the position
+ ;; of the last insertion.
+ (when (numberp (caar buffer-undo-list))
+ (push (cons (caar buffer-undo-list) (caar buffer-undo-list))
+ buffer-undo-list))))))
(defun accept-change-group (handle)
"Finish a change group made with `prepare-change-group' (which see).
@@ -3490,7 +3793,7 @@ Do nothing if FACE is nil."
;;;; Synchronous shell commands.
-(defun start-process-shell-command (name buffer &rest args)
+(defun start-process-shell-command (name buffer command)
"Start a program in a subprocess. Return the process object for it.
NAME is name for process. It is modified if necessary to make it unique.
BUFFER is the buffer (or buffer name) to associate with the process.
@@ -3498,27 +3801,18 @@ BUFFER is the buffer (or buffer name) to associate with the process.
an output stream or filter function to handle the output.
BUFFER may be also nil, meaning that this process is not associated
with any buffer
-COMMAND is the shell command to run.
-
-An old calling convention accepted any number of arguments after COMMAND,
-which were just concatenated to COMMAND. This is still supported but strongly
-discouraged."
- (declare (advertised-calling-convention (name buffer command) "23.1"))
+COMMAND is the shell command to run."
;; We used to use `exec' to replace the shell with the command,
;; but that failed to handle (...) and semicolon, etc.
- (start-process name buffer shell-file-name shell-command-switch
- (mapconcat 'identity args " ")))
+ (start-process name buffer shell-file-name shell-command-switch command))
-(defun start-file-process-shell-command (name buffer &rest args)
+(defun start-file-process-shell-command (name buffer command)
"Start a program in a subprocess. Return the process object for it.
Similar to `start-process-shell-command', but calls `start-file-process'."
- (declare (advertised-calling-convention (name buffer command) "23.1"))
;; On remote hosts, the local `shell-file-name' might be useless.
(with-connection-local-variables
(start-file-process
- name buffer
- shell-file-name shell-command-switch
- (mapconcat 'identity args " "))))
+ name buffer shell-file-name shell-command-switch command)))
(defun call-process-shell-command (command &optional infile buffer display
&rest args)
@@ -3631,10 +3925,11 @@ also `with-temp-buffer'."
(when (window-live-p (nth 1 state))
(select-window (nth 1 state) 'norecord)))
-(defun generate-new-buffer (name)
+(defun generate-new-buffer (name &optional inhibit-buffer-hooks)
"Create and return a buffer with a name based on NAME.
-Choose the buffer's name using `generate-new-buffer-name'."
- (get-buffer-create (generate-new-buffer-name name)))
+Choose the buffer's name using `generate-new-buffer-name'.
+See `get-buffer-create' for the meaning of INHIBIT-BUFFER-HOOKS."
+ (get-buffer-create (generate-new-buffer-name name) inhibit-buffer-hooks))
(defmacro with-selected-window (window &rest body)
"Execute the forms in BODY with WINDOW as the selected window.
@@ -3796,12 +4091,14 @@ See the related form `with-temp-buffer-window'."
(defmacro with-temp-file (file &rest body)
"Create a new buffer, evaluate BODY there, and write the buffer to FILE.
The value returned is the value of the last form in BODY.
+The buffer does not run the hooks `kill-buffer-hook',
+`kill-buffer-query-functions', and `buffer-list-update-hook'.
See also `with-temp-buffer'."
(declare (indent 1) (debug t))
(let ((temp-file (make-symbol "temp-file"))
(temp-buffer (make-symbol "temp-buffer")))
`(let ((,temp-file ,file)
- (,temp-buffer (generate-new-buffer " *temp file*")))
+ (,temp-buffer (generate-new-buffer " *temp file*" t)))
(unwind-protect
(prog1
(with-current-buffer ,temp-buffer
@@ -3836,10 +4133,12 @@ Use a MESSAGE of \"\" to temporarily clear the echo area."
(defmacro with-temp-buffer (&rest body)
"Create a temporary buffer, and evaluate BODY there like `progn'.
+The buffer does not run the hooks `kill-buffer-hook',
+`kill-buffer-query-functions', and `buffer-list-update-hook'.
See also `with-temp-file' and `with-output-to-string'."
(declare (indent 0) (debug t))
(let ((temp-buffer (make-symbol "temp-buffer")))
- `(let ((,temp-buffer (generate-new-buffer " *temp*")))
+ `(let ((,temp-buffer (generate-new-buffer " *temp*" t)))
;; `kill-buffer' can change current-buffer in some odd cases.
(with-current-buffer ,temp-buffer
(unwind-protect
@@ -3874,7 +4173,7 @@ of that nature."
(defmacro with-output-to-string (&rest body)
"Execute BODY, return the text it sent to `standard-output', as a string."
(declare (indent 0) (debug t))
- `(let ((standard-output (generate-new-buffer " *string-output*")))
+ `(let ((standard-output (generate-new-buffer " *string-output*" t)))
(unwind-protect
(progn
(let ((standard-output standard-output))
@@ -3903,7 +4202,7 @@ is allowed once again. (Immediately, if `inhibit-quit' is nil.)"
;; Don't throw `throw-on-input' on those events by default.
(setq while-no-input-ignore-events
'(focus-in focus-out help-echo iconify-frame
- make-frame-visible selection-request buffer-switch))
+ make-frame-visible selection-request))
(defmacro while-no-input (&rest body)
"Execute BODY only as long as there's no pending input.
@@ -4207,11 +4506,7 @@ Optional FIXEDCASE, LITERAL, STRING and SUBEXP have the same
meaning as for `replace-match'."
(let ((match (match-string 0 string)))
(save-match-data
- (set-match-data (mapcar (lambda (x)
- (if (numberp x)
- (- x (match-beginning 0))
- x))
- (match-data t)))
+ (match-data--translate (- (match-beginning 0)))
(replace-match replacement fixedcase literal match subexp))))
@@ -4508,10 +4803,9 @@ and replace a sub-expression, e.g.
(when (= me mb) (setq me (min l (1+ mb))))
;; Generate a replacement for the matched substring.
;; Operate on only the substring to minimize string consing.
- ;; Set up match data for the substring for replacement;
- ;; presumably this is likely to be faster than munging the
- ;; match data directly in Lisp.
- (string-match regexp (setq str (substring string mb me)))
+ ;; Translate the match data so that it applies to the matched substring.
+ (match-data--translate (- mb))
+ (setq str (substring string mb me))
(setq matches
(cons (replace-match (if (stringp rep)
rep
@@ -5211,6 +5505,8 @@ use `called-interactively-p'.
To test whether a function can be called interactively, use
`commandp'."
+ ;; Kept around for now. See discussion at:
+ ;; https://lists.gnu.org/r/emacs-devel/2020-08/msg00564.html
(declare (obsolete called-interactively-p "23.2"))
(called-interactively-p 'interactive))
@@ -5779,6 +6075,22 @@ This is the simplest safe way to acquire and release a mutex."
(mutex-unlock ,sym)))))
+;;; Apropos.
+
+(defun apropos-internal (regexp &optional predicate)
+ "Show all symbols whose names contain match for REGEXP.
+If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done
+for each symbol and a symbol is mentioned only if that returns non-nil.
+Return list of symbols found."
+ (let (found)
+ (mapatoms (lambda (symbol)
+ (when (and (string-match regexp (symbol-name symbol))
+ (or (not predicate)
+ (funcall predicate symbol)))
+ (push symbol found))))
+ (sort found #'string-lessp)))
+
+
;;; Misc.
(defvar definition-prefixes (make-hash-table :test 'equal)
@@ -5851,4 +6163,40 @@ returned list are in the same order as in TREE.
(defconst regexp-unmatchable "\\`a\\`"
"Standard regexp guaranteed not to match any string at all.")
+(defun run-hook-query-error-with-timeout (hook)
+ "Run HOOK, catching errors, and querying the user about whether to continue.
+If a function in HOOK signals an error, the user will be prompted
+whether to continue or not. If the user doesn't respond,
+evaluation will continue if the user doesn't respond within five
+seconds."
+ (run-hook-wrapped
+ hook
+ (lambda (fun)
+ (condition-case err
+ (funcall fun)
+ (error
+ (unless (y-or-n-p-with-timeout (format "Error %s; continue?" err)
+ 5 t)
+ (error err))))
+ ;; Continue running.
+ nil)))
+
+(defun internal--fill-string-single-line (str)
+ "Fill string STR to `fill-column'.
+This is intended for very simple filling while bootstrapping
+Emacs itself, and does not support all the customization options
+of fill.el (for example `fill-region')."
+ (if (< (string-width str) fill-column)
+ str
+ (let ((fst (substring str 0 fill-column))
+ (lst (substring str fill-column)))
+ (if (string-match ".*\\( \\(.+\\)\\)$" fst)
+ (setq fst (replace-match "\n\\2" nil nil fst 1)))
+ (concat fst (internal--fill-string-single-line lst)))))
+
+(defun internal--format-docstring-line (string &rest objects)
+ "Format a documentation string out of STRING and OBJECTS.
+This is intended for internal use only."
+ (internal--fill-string-single-line (apply #'format string objects)))
+
;;; subr.el ends here
diff --git a/lisp/svg.el b/lisp/svg.el
index eeb945f53b5..717c84788f0 100644
--- a/lisp/svg.el
+++ b/lisp/svg.el
@@ -1,6 +1,6 @@
;;; svg.el --- SVG image creation functions -*- lexical-binding: t -*-
-;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Felix E. Klee <felix.klee@inka.de>
@@ -184,6 +184,19 @@ otherwise. IMAGE-TYPE should be a MIME image type, like
`((xlink:href . ,(svg--image-data image image-type datap))
,@(svg--arguments svg args)))))
+(defun svg-embed-base-uri-image (svg relative-filename &rest args)
+ "Insert image placed at RELATIVE-FILENAME into the SVG structure.
+RELATIVE-FILENAME will be searched in `file-name-directory' of the
+image's `:base-uri' property. If `:base-uri' is not specified for the
+image, then embedding won't work. Embedding large images using this
+function is much faster than `svg-embed'."
+ (svg--append
+ svg
+ (dom-node
+ 'image
+ `((xlink:href . ,relative-filename)
+ ,@(svg--arguments svg args)))))
+
(defun svg-text (svg text &rest args)
"Add TEXT to SVG."
(svg--append
diff --git a/lisp/t-mouse.el b/lisp/t-mouse.el
index 4feab71401e..ec36f543789 100644
--- a/lisp/t-mouse.el
+++ b/lisp/t-mouse.el
@@ -4,7 +4,7 @@
;; Maintainer: emacs-devel@gnu.org
;; Keywords: mouse gpm linux
-;; Copyright (C) 1994-1995, 1998, 2006-2020 Free Software Foundation,
+;; Copyright (C) 1994-1995, 1998, 2006-2021 Free Software Foundation,
;; Inc.
;; This file is part of GNU Emacs.
diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el
index 26049552242..7e556550daa 100644
--- a/lisp/tab-bar.el
+++ b/lisp/tab-bar.el
@@ -1,6 +1,6 @@
;;; tab-bar.el --- frame-local tabs with named persistent window configurations -*- lexical-binding: t; -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; Author: Juri Linkov <juri@linkov.net>
;; Keywords: frames tabs
@@ -95,23 +95,26 @@ Possible modifier keys are `control', `meta', `shift', `hyper', `super' and
:version "27.1")
-(define-minor-mode tab-bar-mode
- "Toggle the tab bar in all graphical frames (Tab Bar mode)."
- :global t
- ;; It's defined in C/cus-start, this stops the d-m-m macro defining it again.
- :variable tab-bar-mode
- (let ((val (if tab-bar-mode 1 0)))
- (dolist (frame (frame-list))
- (set-frame-parameter frame 'tab-bar-lines val))
- ;; If the user has given `default-frame-alist' a `tab-bar-lines'
- ;; parameter, replace it.
- (if (assq 'tab-bar-lines default-frame-alist)
- (setq default-frame-alist
- (cons (cons 'tab-bar-lines val)
- (assq-delete-all 'tab-bar-lines
- default-frame-alist)))))
-
- (when (and tab-bar-mode tab-bar-new-button
+(defun tab-bar--define-keys ()
+ "Install key bindings for switching between tabs if the user has configured them."
+ (when tab-bar-select-tab-modifiers
+ (global-set-key (vector (append tab-bar-select-tab-modifiers (list ?0)))
+ 'tab-bar-switch-to-recent-tab)
+ (dotimes (i 9)
+ (global-set-key (vector (append tab-bar-select-tab-modifiers
+ (list (+ i 1 ?0))))
+ 'tab-bar-select-tab)))
+ ;; Don't override user customized key bindings
+ (unless (global-key-binding [(control tab)])
+ (global-set-key [(control tab)] 'tab-next))
+ (unless (global-key-binding [(control shift tab)])
+ (global-set-key [(control shift tab)] 'tab-previous))
+ (unless (global-key-binding [(control shift iso-lefttab)])
+ (global-set-key [(control shift iso-lefttab)] 'tab-previous)))
+
+(defun tab-bar--load-buttons ()
+ "Load the icons for the tab buttons."
+ (when (and tab-bar-new-button
(not (get-text-property 0 'display tab-bar-new-button)))
;; This file is pre-loaded so only here we can use the right data-directory:
(add-text-properties 0 (length tab-bar-new-button)
@@ -121,7 +124,7 @@ Possible modifier keys are `control', `meta', `shift', `hyper', `super' and
:ascent center))
tab-bar-new-button))
- (when (and tab-bar-mode tab-bar-close-button
+ (when (and tab-bar-close-button
(not (get-text-property 0 'display tab-bar-close-button)))
;; This file is pre-loaded so only here we can use the right data-directory:
(add-text-properties 0 (length tab-bar-close-button)
@@ -129,24 +132,27 @@ Possible modifier keys are `control', `meta', `shift', `hyper', `super' and
:file "tabs/close.xpm"
:margin (2 . 0)
:ascent center))
- tab-bar-close-button))
+ tab-bar-close-button)))
+(define-minor-mode tab-bar-mode
+ "Toggle the tab bar in all graphical frames (Tab Bar mode)."
+ :global t
+ ;; It's defined in C/cus-start, this stops the d-m-m macro defining it again.
+ :variable tab-bar-mode
+ (let ((val (if tab-bar-mode 1 0)))
+ (dolist (frame (frame-list))
+ (set-frame-parameter frame 'tab-bar-lines val))
+ ;; If the user has given `default-frame-alist' a `tab-bar-lines'
+ ;; parameter, replace it.
+ (if (assq 'tab-bar-lines default-frame-alist)
+ (setq default-frame-alist
+ (cons (cons 'tab-bar-lines val)
+ (assq-delete-all 'tab-bar-lines
+ default-frame-alist)))))
+ (when tab-bar-mode
+ (tab-bar--load-buttons))
(if tab-bar-mode
- (progn
- (when tab-bar-select-tab-modifiers
- (global-set-key (vector (append tab-bar-select-tab-modifiers (list ?0)))
- 'tab-bar-switch-to-recent-tab)
- (dotimes (i 9)
- (global-set-key (vector (append tab-bar-select-tab-modifiers
- (list (+ i 1 ?0))))
- 'tab-bar-select-tab)))
- ;; Don't override user customized key bindings
- (unless (global-key-binding [(control tab)])
- (global-set-key [(control tab)] 'tab-next))
- (unless (global-key-binding [(control shift tab)])
- (global-set-key [(control shift tab)] 'tab-previous))
- (unless (global-key-binding [(control shift iso-lefttab)])
- (global-set-key [(control shift iso-lefttab)] 'tab-previous)))
+ (tab-bar--define-keys)
;; Unset only keys bound by tab-bar
(when (eq (global-key-binding [(control tab)]) 'tab-next)
(global-unset-key [(control tab)]))
@@ -181,15 +187,27 @@ on a console which has no window system but does have a mouse."
;; Clicking anywhere outside existing tabs will add a new tab
(tab-bar-new-tab)))))
-;; Used in the Show/Hide menu, to have the toggle reflect the current frame.
(defun toggle-tab-bar-mode-from-frame (&optional arg)
"Toggle tab bar on or off, based on the status of the current frame.
+Used in the Show/Hide menu, to have the toggle reflect the current frame.
See `tab-bar-mode' for more information."
(interactive (list (or current-prefix-arg 'toggle)))
(if (eq arg 'toggle)
(tab-bar-mode (if (> (frame-parameter nil 'tab-bar-lines) 0) 0 1))
(tab-bar-mode arg)))
+(defun toggle-frame-tab-bar (&optional frame)
+ "Toggle tab bar of FRAME.
+This is useful when you want to enable the tab bar individually
+on each new frame when the global `tab-bar-mode' is disabled,
+or when you want to disable the tab bar individually on each
+new frame when the global `tab-bar-mode' is enabled, by using
+
+ (add-hook 'after-make-frame-functions 'toggle-frame-tab-bar)"
+ (interactive)
+ (set-frame-parameter frame 'tab-bar-lines
+ (if (> (frame-parameter frame 'tab-bar-lines) 0) 0 1)))
+
(defvar tab-bar-map (make-sparse-keymap)
"Keymap for the tab bar.
Define this locally to override the global tab bar.")
@@ -218,18 +236,31 @@ If the value is `1', then hide the tab bar when it has only one tab,
and show it again once more tabs are created.
If nil, always keep the tab bar hidden. In this case it's still
possible to use persistent named window configurations by relying on
-keyboard commands `tab-new', `tab-close', `tab-next', `tab-switcher', etc."
+keyboard commands `tab-new', `tab-close', `tab-next', `tab-switcher', etc.
+
+Setting this variable directly does not take effect; please customize
+it (see the info node `Easy Customization'), then it will automatically
+update the tab bar on all frames according to the new value.
+
+To enable or disable the tab bar individually on each frame,
+you can use the command `toggle-frame-tab-bar'."
:type '(choice (const :tag "Always" t)
(const :tag "When more than one tab" 1)
(const :tag "Never" nil))
:initialize 'custom-initialize-default
:set (lambda (sym val)
(set-default sym val)
- (tab-bar-mode
- (if (or (eq val t)
- (and (natnump val)
- (> (length (funcall tab-bar-tabs-function)) val)))
- 1 -1)))
+ ;; Preload button images
+ (tab-bar-mode 1)
+ ;; Then handle each frame individually
+ (dolist (frame (frame-list))
+ (set-frame-parameter
+ frame 'tab-bar-lines
+ (if (or (eq val t)
+ (and (natnump val)
+ (> (length (funcall tab-bar-tabs-function frame))
+ val)))
+ 1 0))))
:group 'tab-bar
:version "27.1")
@@ -296,6 +327,16 @@ If nil, don't show it at all."
(defvar tab-bar-forward-button " > "
"Button for going forward in tab history.")
+(defcustom tab-bar-history-buttons-show t
+ "Show back and forward buttons when `tab-bar-history-mode' is enabled."
+ :type 'boolean
+ :initialize 'custom-initialize-default
+ :set (lambda (sym val)
+ (set-default sym val)
+ (force-mode-line-update))
+ :group 'tab-bar
+ :version "28.1")
+
(defcustom tab-bar-tab-hints nil
"Show absolute numbers on tabs in the tab bar before the tab name.
This helps to select the tab by its number using `tab-bar-select-tab'
@@ -408,6 +449,30 @@ Return its existing value or a new value."
tabs))
+(defcustom tab-bar-tab-name-format-function #'tab-bar-tab-name-format-default
+ "Function to format a tab name.
+Function gets two arguments, the tab and its number, and should return
+the formatted tab name to display in the tab bar."
+ :type 'function
+ :initialize 'custom-initialize-default
+ :set (lambda (sym val)
+ (set-default sym val)
+ (force-mode-line-update))
+ :group 'tab-bar
+ :version "28.1")
+
+(defun tab-bar-tab-name-format-default (tab i)
+ (let ((current-p (eq (car tab) 'current-tab)))
+ (propertize
+ (concat (if tab-bar-tab-hints (format "%d " i) "")
+ (alist-get 'name tab)
+ (or (and tab-bar-close-button-show
+ (not (eq tab-bar-close-button-show
+ (if current-p 'non-selected 'selected)))
+ tab-bar-close-button)
+ ""))
+ 'face (if current-p 'tab-bar-tab 'tab-bar-tab-inactive))))
+
(defun tab-bar-make-keymap-1 ()
"Generate an actual keymap from `tab-bar-map', without caching."
(let* ((separator (or tab-bar-separator (if window-system " " "|")))
@@ -415,7 +480,7 @@ Return its existing value or a new value."
(tabs (funcall tab-bar-tabs-function)))
(append
'(keymap (mouse-1 . tab-bar-handle-mouse))
- (when tab-bar-history-mode
+ (when (and tab-bar-history-mode tab-bar-history-buttons-show)
`((sep-history-back menu-item ,separator ignore)
(history-back
menu-item ,tab-bar-back-button tab-bar-history-back
@@ -433,25 +498,13 @@ Return its existing value or a new value."
((eq (car tab) 'current-tab)
`((current-tab
menu-item
- ,(propertize (concat (if tab-bar-tab-hints (format "%d " i) "")
- (alist-get 'name tab)
- (or (and tab-bar-close-button-show
- (not (eq tab-bar-close-button-show
- 'non-selected))
- tab-bar-close-button) ""))
- 'face 'tab-bar-tab)
+ ,(funcall tab-bar-tab-name-format-function tab i)
ignore
:help "Current tab")))
(t
`((,(intern (format "tab-%i" i))
menu-item
- ,(propertize (concat (if tab-bar-tab-hints (format "%d " i) "")
- (alist-get 'name tab)
- (or (and tab-bar-close-button-show
- (not (eq tab-bar-close-button-show
- 'selected))
- tab-bar-close-button) ""))
- 'face 'tab-bar-tab-inactive)
+ ,(funcall tab-bar-tab-name-format-function tab i)
,(or
(alist-get 'binding tab)
`(lambda ()
@@ -762,6 +815,9 @@ After the tab is created, the hooks in
(from-tab (tab-bar--tab)))
(when tab-bar-new-tab-choice
+ ;; Handle the case when it's called in the active minibuffer.
+ (when (minibuffer-selected-window)
+ (select-window (minibuffer-selected-window)))
(delete-other-windows)
;; Create a new window to get rid of old window parameters
;; (e.g. prev/next buffers) of old window.
@@ -802,7 +858,10 @@ After the tab is created, the hooks in
((and (natnump tab-bar-show)
(> (length (funcall tab-bar-tabs-function)) tab-bar-show)
(zerop (frame-parameter nil 'tab-bar-lines)))
- (set-frame-parameter nil 'tab-bar-lines 1)))
+ (progn
+ (tab-bar--load-buttons)
+ (tab-bar--define-keys)
+ (set-frame-parameter nil 'tab-bar-lines 1))))
(force-mode-line-update)
(unless tab-bar-mode
@@ -839,8 +898,10 @@ If `recent', select the most recently visited tab."
"Defines what to do when the last tab is closed.
If nil, do nothing and show a message, like closing the last window or frame.
If `delete-frame', delete the containing frame, as a web browser would do.
-If `tab-bar-mode-disable', disable tab-bar-mode so that tabs no longer show in the frame.
-If the value is a function, call that function with the tab to be closed as an argument."
+If `tab-bar-mode-disable', disable tab-bar-mode so that tabs no longer show in
+the frame.
+If the value is a function, call that function with the tab to be closed as an
+ argument."
:type '(choice (const :tag "Do nothing and show message" nil)
(const :tag "Close the containing frame" delete-frame)
(const :tag "Disable tab-bar-mode" tab-bar-mode-disable)
@@ -1198,18 +1259,11 @@ Type q to remove the list of window configurations from the display.
The first column shows `D' for a window configuration you have
marked for deletion."
(interactive)
- (let ((dir default-directory)
- (minibuf (minibuffer-selected-window)))
- (let ((tab-bar-show nil)) ; don't enable tab-bar-mode if it's disabled
+ (let ((dir default-directory))
+ (let ((tab-bar-new-tab-choice t)
+ ;; Don't enable tab-bar-mode if it's disabled
+ (tab-bar-show nil))
(tab-bar-new-tab))
- ;; Handle the case when it's called in the active minibuffer.
- (when minibuf (select-window (minibuffer-selected-window)))
- (delete-other-windows)
- ;; Create a new window to replace the existing one, to not break the
- ;; window parameters (e.g. prev/next buffers) of the window just saved
- ;; to the window configuration. So when a saved window is restored,
- ;; its parameters left intact.
- (split-window) (delete-window)
(let ((switch-to-buffer-preserve-window-point nil))
(switch-to-buffer (tab-switcher-noselect)))
(setq default-directory dir))
diff --git a/lisp/tab-line.el b/lisp/tab-line.el
index 46bf89f14eb..2726947a4c2 100644
--- a/lisp/tab-line.el
+++ b/lisp/tab-line.el
@@ -1,6 +1,6 @@
;;; tab-line.el --- window-local tabs with window buffers -*- lexical-binding: t; -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; Author: Juri Linkov <juri@linkov.net>
;; Keywords: windows tabs
@@ -27,6 +27,7 @@
;;; Code:
+(require 'cl-lib)
(require 'seq) ; tab-line.el is not pre-loaded so it's safe to use it here
@@ -35,6 +36,18 @@
:group 'convenience
:version "27.1")
+(defcustom tab-line-tab-face-functions '(tab-line-tab-face-special)
+ "Functions called to modify tab faces.
+Each function is called with five arguments: the tab, a list of
+all tabs, the face returned by the previously called modifier,
+whether the tab is a buffer, and whether the tab is selected."
+ :type '(repeat
+ (choice (function-item tab-line-tab-face-special)
+ (function-item tab-line-tab-face-inactive-alternating)
+ (function :tag "Custom function")))
+ :group 'tab-line
+ :version "28.1")
+
(defgroup tab-line-faces '((tab-line custom-face)) ; tab-line is defined in faces.el
"Faces used in the tab line."
:group 'tab-line
@@ -63,6 +76,25 @@
:version "27.1"
:group 'tab-line-faces)
+(defface tab-line-tab-inactive-alternate
+ `((t (:inherit tab-line-tab-inactive :background "grey65")))
+ "Alternate face for inactive tab-line tabs.
+Applied to alternating tabs when option
+`tab-line-tab-face-functions' includes function
+`tab-line-tab-face-inactive-alternating'."
+ :version "28.1"
+ :group 'tab-line-faces)
+
+(defface tab-line-tab-special
+ '((default (:weight bold))
+ (((supports :slant italic))
+ (:slant italic :weight normal)))
+ "Face for special (i.e. non-file-backed) tabs.
+Applied when option `tab-line-tab-face-functions' includes
+function `tab-line-tab-face-special'."
+ :version "28.1"
+ :group 'tab-line-faces)
+
(defface tab-line-tab-current
'((default
:inherit tab-line-tab)
@@ -412,7 +444,14 @@ variable `tab-line-tabs-function'."
(cdr (assq 'selected tab))))
(name (if buffer-p
(funcall tab-line-tab-name-function tab tabs)
- (cdr (assq 'name tab)))))
+ (cdr (assq 'name tab))))
+ (face (if selected-p
+ (if (eq (selected-window) (old-selected-window))
+ 'tab-line-tab-current
+ 'tab-line-tab)
+ 'tab-line-tab-inactive)))
+ (dolist (fn tab-line-tab-face-functions)
+ (setf face (funcall fn tab tabs face buffer-p selected-p)))
(concat
separator
(apply 'propertize
@@ -425,11 +464,7 @@ variable `tab-line-tabs-function'."
`(
tab ,tab
,@(if selected-p '(selected t))
- face ,(if selected-p
- (if (eq (selected-window) (old-selected-window))
- 'tab-line-tab-current
- 'tab-line-tab)
- 'tab-line-tab-inactive)
+ face ,face
mouse-face tab-line-highlight)))))
tabs))
(hscroll-data (tab-line-auto-hscroll strings hscroll)))
@@ -453,6 +488,24 @@ variable `tab-line-tabs-function'."
tab-line-new-button)
(list tab-line-new-button)))))
+(defun tab-line-tab-face-inactive-alternating (tab tabs face _buffer-p selected-p)
+ "Return FACE for TAB in TABS with alternation.
+When TAB is an inactive buffer and is even-numbered, make FACE
+inherit from `tab-line-tab-inactive-alternate'. For use in
+`tab-line-tab-face-functions'."
+ (when (and (not selected-p) (cl-evenp (cl-position tab tabs)))
+ (setf face `(:inherit (tab-line-tab-inactive-alternate ,face))))
+ face)
+
+(defun tab-line-tab-face-special (tab _tabs face buffer-p _selected-p)
+ "Return FACE for TAB according to whether it's special.
+When TAB is a non-file-backed buffer, make FACE inherit from
+`tab-line-tab-special'. For use in
+`tab-line-tab-face-functions'."
+ (when (and buffer-p (not (buffer-file-name tab)))
+ (setf face `(:inherit (tab-line-tab-special ,face))))
+ face)
+
(defvar tab-line-auto-hscroll)
(defun tab-line-format ()
diff --git a/lisp/tabify.el b/lisp/tabify.el
index 7408fe1e233..f7360313fc6 100644
--- a/lisp/tabify.el
+++ b/lisp/tabify.el
@@ -1,6 +1,6 @@
;;; tabify.el --- tab conversion commands for Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1985, 1994, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1994, 2001-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Package: emacs
diff --git a/lisp/talk.el b/lisp/talk.el
index a18cf263435..473f8ac9218 100644
--- a/lisp/talk.el
+++ b/lisp/talk.el
@@ -1,6 +1,6 @@
;;; talk.el --- allow several users to talk to each other through Emacs
-;; Copyright (C) 1995, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 2001-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: comm, frames
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el
index 5cf09f9055e..cd53d7b6ff4 100644
--- a/lisp/tar-mode.el
+++ b/lisp/tar-mode.el
@@ -1,6 +1,6 @@
;;; tar-mode.el --- simple editing of tar files from GNU Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1990-1991, 1993-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1991, 1993-2021 Free Software Foundation, Inc.
;; Author: Jamie Zawinski <jwz@lucid.com>
;; Maintainer: emacs-devel@gnu.org
@@ -37,13 +37,6 @@
;; This code now understands the extra fields that GNU tar adds to tar files.
-;; This interacts correctly with "uncompress.el" in the Emacs library,
-;; which you get with
-;;
-;; (autoload 'uncompress-while-visiting "uncompress")
-;; (setq auto-mode-alist (cons '("\\.Z$" . uncompress-while-visiting)
-;; auto-mode-alist))
-;;
;; Do not attempt to use tar-mode.el with crypt.el, you will lose.
;; *************** TO DO ***************
@@ -595,7 +588,7 @@ For instance, if mode is #o700, then it produces `rwx------'."
(setq pos (tar-header-data-end descriptor))
(progress-reporter-update progress-reporter pos)))
- (set (make-local-variable 'tar-parse-info) (nreverse result))
+ (setq-local tar-parse-info (nreverse result))
;; A tar file should end with a block or two of nulls,
;; but let's not get a fatal error if it doesn't.
(if (null descriptor)
@@ -725,21 +718,21 @@ See also: variables `tar-update-datestamp' and `tar-anal-blocksize'.
(file-writable-p buffer-file-name)
(setq buffer-read-only nil)) ; undo what `special-mode' did
(make-local-variable 'tar-parse-info)
- (set (make-local-variable 'require-final-newline) nil) ; binary data, dude...
- (set (make-local-variable 'local-enable-local-variables) nil)
- (set (make-local-variable 'next-line-add-newlines) nil)
- (set (make-local-variable 'tar-file-name-coding-system)
- (or file-name-coding-system
- default-file-name-coding-system
- locale-coding-system))
+ (setq-local require-final-newline nil) ; binary data, dude...
+ (setq-local local-enable-local-variables nil)
+ (setq-local next-line-add-newlines nil)
+ (setq-local tar-file-name-coding-system
+ (or file-name-coding-system
+ default-file-name-coding-system
+ locale-coding-system))
;; Prevent loss of data when saving the file.
- (set (make-local-variable 'file-precious-flag) t)
+ (setq-local file-precious-flag t)
(buffer-disable-undo)
(widen)
;; Now move the Tar data into an auxiliary buffer, so we can use the main
;; buffer for the summary.
(cl-assert (not (tar-data-swapped-p)))
- (set (make-local-variable 'revert-buffer-function) #'tar-mode-revert)
+ (setq-local revert-buffer-function #'tar-mode-revert)
;; We started using write-contents-functions, but this hook is not
;; used during auto-save, so we now use
;; write-region-annotate-functions which hooks at a lower-level.
@@ -748,10 +741,10 @@ See also: variables `tar-update-datestamp' and `tar-anal-blocksize'.
(add-hook 'change-major-mode-hook #'tar-change-major-mode-hook nil t)
;; Tar data is made of bytes, not chars.
(set-buffer-multibyte nil) ;Hopefully a no-op.
- (set (make-local-variable 'tar-data-buffer)
- (generate-new-buffer (format " *tar-data %s*"
- (file-name-nondirectory
- (or buffer-file-name (buffer-name))))))
+ (setq-local tar-data-buffer (generate-new-buffer
+ (format " *tar-data %s*"
+ (file-name-nondirectory
+ (or buffer-file-name (buffer-name))))))
(condition-case err
(progn
(tar-swap-data)
@@ -1011,8 +1004,8 @@ return nil. Otherwise point is returned."
default-directory))
(set-buffer-modified-p nil)
(normal-mode) ; pick a mode.
- (set (make-local-variable 'tar-superior-buffer) tar-buffer)
- (set (make-local-variable 'tar-superior-descriptor) descriptor)
+ (setq-local tar-superior-buffer tar-buffer)
+ (setq-local tar-superior-descriptor descriptor)
(setq buffer-read-only read-only-p)
(tar-subfile-mode 1)))
(cond
diff --git a/lisp/tempo.el b/lisp/tempo.el
index f6612354b1c..87e274a527c 100644
--- a/lisp/tempo.el
+++ b/lisp/tempo.el
@@ -1,6 +1,6 @@
;;; tempo.el --- Flexible template insertion -*- lexical-binding: t; -*-
-;; Copyright (C) 1994-1995, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1995, 2001-2021 Free Software Foundation, Inc.
;; Author: David Kågedal <davidk@lysator.liu.se>
;; Created: 16 Feb 1994
@@ -353,9 +353,8 @@ possible."
((and (consp element)
(eq (car element) 's)) (tempo-insert-named (car (cdr element))))
((and (consp element)
- (eq (car element) 'l)) (mapcar (function
- (lambda (elt)
- (tempo-insert elt on-region)))
+ (eq (car element) 'l)) (mapcar (lambda (elt)
+ (tempo-insert elt on-region))
(cdr element)))
((eq element 'p) (tempo-insert-mark (point-marker)))
((eq element 'r) (if on-region
@@ -546,10 +545,9 @@ and insert the results."
(interactive)
(let ((next-mark (catch 'found
(mapc
- (function
- (lambda (mark)
- (if (< (point) mark)
- (throw 'found mark))))
+ (lambda (mark)
+ (if (< (point) mark)
+ (throw 'found mark)))
tempo-marks)
;; return nil if not found
nil)))
@@ -565,11 +563,10 @@ and insert the results."
(let ((prev-mark (catch 'found
(let (last)
(mapc
- (function
- (lambda (mark)
- (if (<= (point) mark)
- (throw 'found last))
- (setq last mark)))
+ (lambda (mark)
+ (if (<= (point) mark)
+ (throw 'found last))
+ (setq last mark))
tempo-marks)
last))))
(if prev-mark
diff --git a/lisp/term.el b/lisp/term.el
index 8cbbfff1b63..8a560e85d58 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -1,6 +1,6 @@
;;; term.el --- general command interpreter in a window stuff -*- lexical-binding: t -*-
-;; Copyright (C) 1988, 1990, 1992, 1994-1995, 2001-2020 Free Software
+;; Copyright (C) 1988, 1990, 1992, 1994-1995, 2001-2021 Free Software
;; Foundation, Inc.
;; Author: Per Bothner <per@bothner.com>
@@ -123,13 +123,12 @@
;; full advantage of this package
;;
;; (add-hook 'term-mode-hook
-;; (function
-;; (lambda ()
-;; (setq term-prompt-regexp "^[^#$%>\n]*[#$%>] *")
-;; (setq-local mouse-yank-at-point t)
-;; (setq-local transient-mark-mode nil)
-;; (auto-fill-mode -1)
-;; (setq tab-width 8 ))))
+;; (lambda ()
+;; (setq term-prompt-regexp "^[^#$%>\n]*[#$%>] *")
+;; (setq-local mouse-yank-at-point t)
+;; (setq-local transient-mark-mode nil)
+;; (auto-fill-mode -1)
+;; (setq tab-width 8)))
;;
;; ----------------------------------------
;;
@@ -265,7 +264,7 @@
;; M-p term-previous-input Cycle backwards in input history
;; M-n term-next-input Cycle forwards
;; M-r term-previous-matching-input Previous input matching a regexp
-;; M-s comint-next-matching-input Next input that matches
+;; M-s term-next-matching-input Next input that matches
;; return term-send-input
;; C-c C-a term-bol Beginning of line; skip prompt.
;; C-d term-delchar-or-maybe-eof Delete char unless at end of buff.
@@ -300,17 +299,13 @@
;; so it is important to increase it if there are protocol-relevant changes.
(defconst term-protocol-version "0.96")
-(eval-when-compile (require 'ange-ftp))
-(eval-when-compile (require 'cl-lib))
-(require 'ring)
-(require 'ehelp)
+(eval-when-compile
+ (require 'ange-ftp)
+ (require 'cl-lib))
(require 'comint) ; Password regexp.
-
-(declare-function ring-empty-p "ring" (ring))
-(declare-function ring-ref "ring" (ring index))
-(declare-function ring-insert-at-beginning "ring" (ring item))
-(declare-function ring-length "ring" (ring))
-(declare-function ring-insert "ring" (ring item))
+(require 'ehelp)
+(require 'ring)
+(require 'shell)
(defgroup term nil
"General command interpreter in a window."
@@ -370,8 +365,8 @@ not allowed.")
(defvar-local term-scroll-end nil
"Bottom-most line (inclusive) of the scrolling region.
`term-scroll-end' must be in the range [0,term-height). In addition, its
-value has to be greater than `term-scroll-start', i.e. one line scroll regions are
-not allowed.")
+value has to be greater than `term-scroll-start', i.e. one line scroll regions
+are not allowed.")
(defvar term-pager-count nil
"Number of lines before we need to page; if nil, paging is disabled.")
(defvar term-saved-cursor nil)
@@ -394,11 +389,6 @@ by moving term-home-marker. It is set to t if there is a
(defvar-local term-line-mode-buffer-read-only nil
"The `buffer-read-only' state to set in `term-line-mode'.")
-(defcustom explicit-shell-file-name nil
- "If non-nil, is file name to use for explicitly requested inferior shell."
- :type '(choice (const nil) file)
- :group 'term)
-
(defvar term-prompt-regexp "^"
"Regexp to recognize prompts in the inferior process.
Defaults to \"^\", the null string at BOL.
@@ -1015,12 +1005,12 @@ Entry to this mode runs the hooks on `term-mode-hook'."
;; we do not want indent to sneak in any tabs
(setq indent-tabs-mode nil)
(setq buffer-display-table term-display-table)
- (set (make-local-variable 'term-home-marker) (copy-marker 0))
- (set (make-local-variable 'term-height) (floor (window-screen-lines)))
- (set (make-local-variable 'term-width) (window-max-chars-per-line))
- (set (make-local-variable 'term-last-input-start) (make-marker))
- (set (make-local-variable 'term-last-input-end) (make-marker))
- (set (make-local-variable 'term-last-input-match) "")
+ (setq-local term-home-marker (copy-marker 0))
+ (setq-local term-height (floor (window-screen-lines)))
+ (setq-local term-width (window-max-chars-per-line))
+ (setq-local term-last-input-start (make-marker))
+ (setq-local term-last-input-end (make-marker))
+ (setq-local term-last-input-match "")
;; These local variables are set to their local values:
(make-local-variable 'term-saved-home-marker)
@@ -1038,9 +1028,9 @@ Entry to this mode runs the hooks on `term-mode-hook'."
;; a properly configured ange-ftp, I've decided to be conservative
;; and put them in. -mm
- (set (make-local-variable 'term-ansi-at-host) (system-name))
- (set (make-local-variable 'term-ansi-at-dir) default-directory)
- (set (make-local-variable 'term-ansi-at-message) nil)
+ (setq-local term-ansi-at-host (system-name))
+ (setq-local term-ansi-at-dir default-directory)
+ (setq-local term-ansi-at-message nil)
;; For user tracking purposes -mm
(make-local-variable 'ange-ftp-default-user)
@@ -1083,15 +1073,15 @@ Entry to this mode runs the hooks on `term-mode-hook'."
(make-local-variable 'term-scroll-to-bottom-on-output)
(make-local-variable 'term-scroll-show-maximum-output)
(make-local-variable 'term-ptyp)
- (set (make-local-variable 'term-vertical-motion) 'vertical-motion)
- (set (make-local-variable 'term-pending-delete-marker) (make-marker))
+ (setq-local term-vertical-motion 'vertical-motion)
+ (setq-local term-pending-delete-marker (make-marker))
(make-local-variable 'term-current-face)
(term-ansi-reset)
- (set (make-local-variable 'term-pending-frame) nil)
+ (setq-local term-pending-frame nil)
;; Cua-mode's keybindings interfere with the term keybindings, disable it.
- (set (make-local-variable 'cua-mode) nil)
+ (setq-local cua-mode nil)
- (set (make-local-variable 'font-lock-defaults) '(nil t))
+ (setq-local font-lock-defaults '(nil t))
(add-function :filter-return
(local 'filter-buffer-substring-function)
@@ -1108,8 +1098,6 @@ Entry to this mode runs the hooks on `term-mode-hook'."
(term--reset-scroll-region)
- (easy-menu-add term-terminal-menu)
- (easy-menu-add term-signals-menu)
(or term-input-ring
(setq term-input-ring (make-ring term-input-ring-size)))
(term-update-mode-line))
@@ -1294,8 +1282,6 @@ intervention from Emacs, except for the escape character (usually C-c)."
(when (term-in-line-mode)
(setq term-old-mode-map (current-local-map))
(use-local-map term-raw-map)
- (easy-menu-add term-terminal-menu)
- (easy-menu-add term-signals-menu)
;; Don't allow changes to the buffer or to point which are not
;; caused by the process filter.
@@ -1437,8 +1423,7 @@ buffer. The hook `term-exec-hook' is run after each exec."
(when proc (delete-process proc)))
;; Crank up a new process
(let ((proc (term-exec-1 name buffer command switches)))
- (make-local-variable 'term-ptyp)
- (setq term-ptyp process-connection-type) ; t if pty, nil if pipe.
+ (setq-local term-ptyp process-connection-type) ; t if pty, nil if pipe.
;; Jump to the end, and set the process mark.
(goto-char (point-max))
(set-marker (process-mark proc) (point))
@@ -1577,9 +1562,9 @@ Nil if unknown.")
process-environment))
(apply #'start-process name buffer
"/bin/sh" "-c"
- (format "stty -nl echo rows %d columns %d sane 2>/dev/null;\
+ (format "stty -nl echo rows %d columns %d sane 2>%s;\
if [ $1 = .. ]; then shift; fi; exec \"$@\""
- term-height term-width)
+ term-height term-width null-device)
".."
command switches)))
@@ -3081,8 +3066,7 @@ See `term-prompt-regexp'."
(aset term-terminal-undecoded-bytes 0 ?\r))
(goto-char (point-max)))
;; FIXME: Use (add-function :override (process-filter proc)
- (make-local-variable 'term-pager-old-filter)
- (setq term-pager-old-filter (process-filter proc))
+ (setq-local term-pager-old-filter (process-filter proc))
;; FIXME: Where is `term-pager-filter' set to a function?!
(set-process-filter proc term-pager-filter)
(setq i str-length))
@@ -3551,11 +3535,7 @@ The top-most line is line 0."
;; (stop-process process))
(setq term-pager-old-local-map (current-local-map))
(use-local-map term-pager-break-map)
- (easy-menu-add term-terminal-menu)
- (easy-menu-add term-signals-menu)
- (easy-menu-add term-pager-menu)
- (make-local-variable 'term-old-mode-line-format)
- (setq term-old-mode-line-format mode-line-format)
+ (setq-local term-old-mode-line-format mode-line-format)
(setq mode-line-format
(list "-- **MORE** "
mode-line-buffer-identification
diff --git a/lisp/term/AT386.el b/lisp/term/AT386.el
index 8ce7fbbcafd..3bedde503f6 100644
--- a/lisp/term/AT386.el
+++ b/lisp/term/AT386.el
@@ -1,6 +1,6 @@
;;; AT386.el --- terminal support package for IBM AT keyboards -*- lexical-binding: t -*-
-;; Copyright (C) 1992, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 2001-2021 Free Software Foundation, Inc.
;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
;; Keywords: terminals
diff --git a/lisp/term/README b/lisp/term/README
index 6276adc6809..9e986bd8bcb 100644
--- a/lisp/term/README
+++ b/lisp/term/README
@@ -1,4 +1,4 @@
-Copyright (C) 1993, 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 1993, 2001-2021 Free Software Foundation, Inc.
See the end of the file for license conditions.
diff --git a/lisp/term/common-win.el b/lisp/term/common-win.el
index 92f3f42f05c..8ae58718e3f 100644
--- a/lisp/term/common-win.el
+++ b/lisp/term/common-win.el
@@ -1,6 +1,6 @@
-;;; common-win.el --- common part of handling window systems
+;;; common-win.el --- common part of handling window systems -*- lexical-binding: t; -*-
-;; Copyright (C) 1993-1994, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2001-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: terminals
diff --git a/lisp/term/internal.el b/lisp/term/internal.el
index 9a6f4fac1ee..fd75ded081f 100644
--- a/lisp/term/internal.el
+++ b/lisp/term/internal.el
@@ -1,6 +1,6 @@
;;; internal.el --- support for PC internal terminal -*- lexical-binding: t -*-
-;; Copyright (C) 1993-1994, 1998-1999, 2001-2020 Free Software
+;; Copyright (C) 1993-1994, 1998-1999, 2001-2021 Free Software
;; Foundation, Inc.
;; Author: Morten Welinder <terra@diku.dk>
diff --git a/lisp/term/iris-ansi.el b/lisp/term/iris-ansi.el
index 7a92aa7adaa..e5b94eab76b 100644
--- a/lisp/term/iris-ansi.el
+++ b/lisp/term/iris-ansi.el
@@ -1,6 +1,6 @@
;;; iris-ansi.el --- configure Emacs for SGI xwsh and winterm apps -*- lexical-binding: t -*-
-;; Copyright (C) 1997, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
;; Author: Dan Nicolaescu <dann@ics.uci.edu>
diff --git a/lisp/term/konsole.el b/lisp/term/konsole.el
index 4af818b4a63..e38a5d34e75 100644
--- a/lisp/term/konsole.el
+++ b/lisp/term/konsole.el
@@ -1,5 +1,5 @@
;;; konsole.el --- terminal initialization for konsole -*- lexical-binding:t -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
(require 'term/xterm)
diff --git a/lisp/term/news.el b/lisp/term/news.el
index 33c7aa6ccaa..40aa58ef1c8 100644
--- a/lisp/term/news.el
+++ b/lisp/term/news.el
@@ -1,6 +1,6 @@
;;; news.el --- keypad and function key bindings for the Sony NEWS keyboard -*- lexical-binding: t -*-
-;; Copyright (C) 1989, 1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1989, 1993, 2001-2021 Free Software Foundation, Inc.
;; Author: FSF
;; Keywords: terminals
diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el
index cc7a3762b4a..5f4dd9ef587 100644
--- a/lisp/term/ns-win.el
+++ b/lisp/term/ns-win.el
@@ -1,6 +1,6 @@
;;; ns-win.el --- lisp side of interface with NeXT/Open/GNUstep/macOS window system -*- lexical-binding: t -*-
-;; Copyright (C) 1993-1994, 2005-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2005-2021 Free Software Foundation, Inc.
;; Authors: Carl Edman
;; Christian Limpach
@@ -47,7 +47,6 @@
;; Documentation-purposes only: actually loaded in loadup.el.
(require 'frame)
(require 'mouse)
-(require 'faces)
(require 'menu-bar)
(require 'fontset)
(require 'dnd)
@@ -148,9 +147,8 @@ The properties returned may include `top', `left', `height', and `width'."
(define-key global-map [?\s-|] 'shell-command-on-region)
(define-key global-map [s-kp-bar] 'shell-command-on-region)
(define-key global-map [?\C-\s- ] 'ns-do-show-character-palette)
-;; (as in Terminal.app)
-(define-key global-map [s-right] 'ns-next-frame)
-(define-key global-map [s-left] 'ns-prev-frame)
+(define-key global-map [s-right] 'move-end-of-line)
+(define-key global-map [s-left] 'move-beginning-of-line)
(define-key global-map [home] 'beginning-of-buffer)
(define-key global-map [end] 'end-of-buffer)
diff --git a/lisp/term/pc-win.el b/lisp/term/pc-win.el
index 76a48a86c73..8cff2ceaeec 100644
--- a/lisp/term/pc-win.el
+++ b/lisp/term/pc-win.el
@@ -1,6 +1,6 @@
;;; pc-win.el --- setup support for `PC windows' (whatever that is) -*- lexical-binding:t -*-
-;; Copyright (C) 1994, 1996-1997, 1999, 2001-2020 Free Software
+;; Copyright (C) 1994, 1996-1997, 1999, 2001-2021 Free Software
;; Foundation, Inc.
;; Author: Morten Welinder <terra@diku.dk>
diff --git a/lisp/term/rxvt.el b/lisp/term/rxvt.el
index 71ee9086937..9671e95aeb4 100644
--- a/lisp/term/rxvt.el
+++ b/lisp/term/rxvt.el
@@ -1,6 +1,6 @@
;;; rxvt.el --- define function key sequences and standard colors for rxvt -*- lexical-binding: t -*-
-;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Author: Eli Zaretskii
;; Keywords: terminals
diff --git a/lisp/term/screen.el b/lisp/term/screen.el
index 0623aa7b54b..04481e8358b 100644
--- a/lisp/term/screen.el
+++ b/lisp/term/screen.el
@@ -1,5 +1,5 @@
;;; screen.el --- terminal initialization for screen and tmux -*- lexical-binding: t -*-
-;; Copyright (C) 1995, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 2001-2021 Free Software Foundation, Inc.
(require 'term/xterm)
diff --git a/lisp/term/st.el b/lisp/term/st.el
index 617664bb263..08432c414af 100644
--- a/lisp/term/st.el
+++ b/lisp/term/st.el
@@ -1,6 +1,6 @@
;;; st.el --- terminal initialization for st -*- lexical-binding:t -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;;; Commentary:
diff --git a/lisp/term/sun.el b/lisp/term/sun.el
index 7d1cd9f2cfe..3dfd4c697a2 100644
--- a/lisp/term/sun.el
+++ b/lisp/term/sun.el
@@ -1,6 +1,6 @@
;;; sun.el --- keybinding for standard default sunterm keys -*- lexical-binding: t -*-
-;; Copyright (C) 1987, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1987, 2001-2021 Free Software Foundation, Inc.
;; Author: Jeff Peck <peck@sun.com>
;; Keywords: terminals
diff --git a/lisp/term/tmux.el b/lisp/term/tmux.el
index b67f9357e02..aa0c98364f3 100644
--- a/lisp/term/tmux.el
+++ b/lisp/term/tmux.el
@@ -1,5 +1,5 @@
;;; tmux.el --- terminal initialization for tmux -*- lexical-binding: t -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
(require 'term/xterm)
diff --git a/lisp/term/tty-colors.el b/lisp/term/tty-colors.el
index dda7fcc3691..740d0654a17 100644
--- a/lisp/term/tty-colors.el
+++ b/lisp/term/tty-colors.el
@@ -1,6 +1,6 @@
-;;; tty-colors.el --- color support for character terminals
+;;; tty-colors.el --- color support for character terminals -*- lexical-binding: t; -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Eli Zaretskii
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/term/tvi970.el b/lisp/term/tvi970.el
index fc8ad80ae5c..4447657d44f 100644
--- a/lisp/term/tvi970.el
+++ b/lisp/term/tvi970.el
@@ -1,6 +1,6 @@
;;; tvi970.el --- terminal support for the Televideo 970 -*- lexical-binding: t -*-
-;; Copyright (C) 1992, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 2001-2021 Free Software Foundation, Inc.
;; Author: Jim Blandy <jimb@occs.cs.oberlin.edu>
;; Keywords: terminals
diff --git a/lisp/term/vt100.el b/lisp/term/vt100.el
index 2df14145231..5e32e297921 100644
--- a/lisp/term/vt100.el
+++ b/lisp/term/vt100.el
@@ -1,6 +1,6 @@
;;; vt100.el --- define VT100 function key sequences in function-key-map -*- lexical-binding:t -*-
-;; Copyright (C) 1989, 1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1989, 1993, 2001-2021 Free Software Foundation, Inc.
;; Author: FSF
;; Keywords: terminals
diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el
index e866fdc36ce..e8451930133 100644
--- a/lisp/term/w32-win.el
+++ b/lisp/term/w32-win.el
@@ -1,6 +1,6 @@
;;; w32-win.el --- parse switches controlling interface with W32 window system -*- lexical-binding: t -*-
-;; Copyright (C) 1993-1994, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2001-2021 Free Software Foundation, Inc.
;; Author: Kevin Gallo
;; Keywords: terminals
@@ -72,7 +72,6 @@
(require 'frame)
(require 'mouse)
(require 'scroll-bar)
-(require 'faces)
(require 'select)
(require 'menu-bar)
(require 'dnd)
@@ -567,46 +566,45 @@ default font on FRAME, or its best approximation."
(x-list-fonts "-*-*-medium-r-normal-*-*-*-*-*-*-iso10646-1"
'default frame)))
val)
- (mapc (function
- (lambda (script-desc)
- (let* ((script (car script-desc))
- (script-chars (vconcat (cdr script-desc)))
- (nchars (length script-chars))
- (fntlist all-fonts)
- (entry (list script))
- fspec ffont font-obj glyphs idx)
- ;; For each font in FNTLIST, determine whether it
- ;; supports the representative character(s) of any
- ;; scripts that have no USBs defined for it.
- (dolist (fnt fntlist)
- (setq fspec (ignore-errors (font-spec :name fnt)))
- (if fspec
- (setq ffont (find-font fspec frame)))
- (when ffont
- (setq font-obj
- (open-font ffont size frame))
- ;; Ignore fonts for which open-font returns nil:
- ;; they are buggy fonts that we cannot use anyway.
- (setq glyphs
- (if font-obj
- (font-get-glyphs font-obj
- 0 nchars script-chars)
- '[nil]))
- ;; Does this font support ALL of the script's
- ;; representative characters?
- (setq idx 0)
- (while (and (< idx nchars) (not (null (aref glyphs idx))))
- (setq idx (1+ idx)))
- (if (= idx nchars)
- ;; It does; add this font to the script's entry in alist.
- (let ((font-family (font-get font-obj :family)))
- ;; Unifont is an ugly font, and it is already
- ;; present in the default fontset.
- (unless (string= (downcase (symbol-name font-family))
- "unifont")
- (push font-family entry))))))
- (if (> (length entry) 1)
- (push (nreverse entry) val)))))
+ (mapc (lambda (script-desc)
+ (let* ((script (car script-desc))
+ (script-chars (vconcat (cdr script-desc)))
+ (nchars (length script-chars))
+ (fntlist all-fonts)
+ (entry (list script))
+ fspec ffont font-obj glyphs idx)
+ ;; For each font in FNTLIST, determine whether it
+ ;; supports the representative character(s) of any
+ ;; scripts that have no USBs defined for it.
+ (dolist (fnt fntlist)
+ (setq fspec (ignore-errors (font-spec :name fnt)))
+ (if fspec
+ (setq ffont (find-font fspec frame)))
+ (when ffont
+ (setq font-obj
+ (open-font ffont size frame))
+ ;; Ignore fonts for which open-font returns nil:
+ ;; they are buggy fonts that we cannot use anyway.
+ (setq glyphs
+ (if font-obj
+ (font-get-glyphs font-obj
+ 0 nchars script-chars)
+ '[nil]))
+ ;; Does this font support ALL of the script's
+ ;; representative characters?
+ (setq idx 0)
+ (while (and (< idx nchars) (not (null (aref glyphs idx))))
+ (setq idx (1+ idx)))
+ (if (= idx nchars)
+ ;; It does; add this font to the script's entry in alist.
+ (let ((font-family (font-get font-obj :family)))
+ ;; Unifont is an ugly font, and it is already
+ ;; present in the default fontset.
+ (unless (string= (downcase (symbol-name font-family))
+ "unifont")
+ (push font-family entry))))))
+ (if (> (length entry) 1)
+ (push (nreverse entry) val))))
(w32--filter-USB-scripts))
;; We've opened a lot of fonts, so clear the font caches to free
;; some memory.
diff --git a/lisp/term/w32console.el b/lisp/term/w32console.el
index 36e9d896c77..8859f13bd20 100644
--- a/lisp/term/w32console.el
+++ b/lisp/term/w32console.el
@@ -1,6 +1,6 @@
;;; w32console.el -- Setup w32 console keys and colors.
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: FSF
;; Keywords: terminals
diff --git a/lisp/term/wyse50.el b/lisp/term/wyse50.el
index 6d72d4a05b6..d3b0fdad24b 100644
--- a/lisp/term/wyse50.el
+++ b/lisp/term/wyse50.el
@@ -1,6 +1,6 @@
;;; wyse50.el --- terminal support code for Wyse 50 -*- lexical-binding: t -*-
-;; Copyright (C) 1989, 1993-1994, 2001-2020 Free Software Foundation,
+;; Copyright (C) 1989, 1993-1994, 2001-2021 Free Software Foundation,
;; Inc.
;; Author: Daniel Pfeiffer <occitan@esperanto.org>,
@@ -126,9 +126,9 @@
;; On such terminals, Emacs should sacrifice the first and last character of
;; each mode line, rather than a whole screen column!
(add-hook 'kill-emacs-hook
- (function (lambda () (interactive)
- (send-string-to-terminal
- (concat "\ea23R" (1+ (frame-width)) "C\eG0"))))))
+ (lambda () (interactive)
+ (send-string-to-terminal
+ (concat "\ea23R" (1+ (frame-width)) "C\eG0")))))
(defun enable-arrow-keys ()
"To be called by `tty-setup-hook'. Overrides 6 Emacs standard keys
diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el
index 42a6f4030e5..e4521ff1876 100644
--- a/lisp/term/x-win.el
+++ b/lisp/term/x-win.el
@@ -1,6 +1,6 @@
;;; x-win.el --- parse relevant switches and set up for X -*- lexical-binding:t -*-
-;; Copyright (C) 1993-1994, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2001-2021 Free Software Foundation, Inc.
;; Author: FSF
;; Keywords: terminals, i18n
@@ -75,7 +75,6 @@
(require 'frame)
(require 'mouse)
(require 'scroll-bar)
-(require 'faces)
(require 'select)
(require 'menu-bar)
(require 'fontset)
diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el
index 1a727e3933e..eeaf805930b 100644
--- a/lisp/term/xterm.el
+++ b/lisp/term/xterm.el
@@ -1,6 +1,6 @@
;;; xterm.el --- define function key sequences and standard colors for xterm -*- lexical-binding: t -*-
-;; Copyright (C) 1995, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 2001-2021 Free Software Foundation, Inc.
;; Author: FSF
;; Keywords: terminals
@@ -710,15 +710,18 @@ Return the pasted text as a string."
(while (and (setq chr (xterm--read-event-for-query)) (not (equal chr ?c)))
(setq str (concat str (string chr))))
;; Since xterm-280, the terminal type (NUMBER1) is now 41 instead of 0.
- (when (string-match "\\([0-9]+\\);\\([0-9]+\\);0" str)
+ (when (string-match "\\([0-9]+\\);\\([0-9]+\\);[01]" str)
(let ((version (string-to-number (match-string 2 str))))
- (when (and (> version 2000) (equal (match-string 1 str) "1"))
+ (when (and (> version 2000)
+ (or (equal (match-string 1 str) "1")
+ (equal (match-string 1 str) "65")))
;; Hack attack! bug#16988: gnome-terminal reports "1;NNNN;0"
;; with a large NNNN but is based on a rather old xterm code.
;; Gnome terminal 2.32.1 reports 1;2802;0
;; Gnome terminal 3.6.1 reports 1;3406;0
;; Gnome terminal 3.22.2 reports 1;4601;0 and *does* support
;; background color querying (Bug#29716).
+ ;; Gnome terminal 3.38.0 reports 65;6200;1.
(when (> version 4000)
(xterm--query "\e]11;?\e\\"
'(("\e]11;" . xterm--report-background-handler))))
@@ -767,7 +770,8 @@ Can be nil to mean \"no timeout\".")
By not redisplaying right away for xterm queries, we can avoid
unsightly flashing during initialization. Give up and redisplay
anyway if we've been waiting a little while."
- (let ((start-time (current-time)))
+ (let ((start-time (current-time))
+ (inhibit--record-char t))
(or (let ((inhibit-redisplay t))
(read-event nil nil xterm-query-redisplay-timeout))
(read-event nil nil
diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el
index 5ce9a90ea65..50c00c95320 100644
--- a/lisp/textmodes/artist.el
+++ b/lisp/textmodes/artist.el
@@ -1,6 +1,6 @@
;;; artist.el --- draw ascii graphics with your mouse -*- lexical-binding: t -*-
-;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;; Author: Tomas Abrahamsson <tab@lysator.liu.se>
;; Keywords: mouse
@@ -1413,32 +1413,20 @@ Keymap summary
(aset artist-replacement-table ?\t ?\s)
(aset artist-replacement-table 0 ?\s)
;; More setup
- (make-local-variable 'artist-key-is-drawing)
- (make-local-variable 'artist-key-endpoint1)
- (make-local-variable 'artist-key-poly-point-list)
- (make-local-variable 'artist-key-shape)
- (make-local-variable 'artist-key-draw-how)
- (make-local-variable 'artist-popup-menu-table)
- (make-local-variable 'artist-key-compl-table)
- (make-local-variable 'artist-prev-next-op-alist)
- (make-local-variable 'artist-rb-save-data)
- (make-local-variable 'artist-arrow-point-1)
- (make-local-variable 'artist-arrow-point-2)
- (setq artist-key-is-drawing nil)
- (setq artist-key-endpoint1 nil)
- (setq artist-key-poly-point-list nil)
- (setq artist-key-shape nil)
- (setq artist-popup-menu-table (artist-compute-popup-menu-table artist-mt))
- (setq artist-key-compl-table (artist-compute-key-compl-table artist-mt))
- (setq artist-prev-next-op-alist
- (artist-make-prev-next-op-alist artist-key-compl-table))
- (setq artist-rb-save-data (make-vector 7 0))
- (setq artist-arrow-point-1 nil)
- (setq artist-arrow-point-2 nil)
- (make-local-variable 'next-line-add-newlines)
- (setq next-line-add-newlines t)
- (setq artist-key-draw-how
- (artist-go-get-draw-how-from-symbol artist-curr-go))
+ (setq-local artist-key-is-drawing nil)
+ (setq-local artist-key-endpoint1 nil)
+ (setq-local artist-key-poly-point-list nil)
+ (setq-local artist-key-shape nil)
+ (setq-local artist-popup-menu-table (artist-compute-popup-menu-table artist-mt))
+ (setq-local artist-key-compl-table (artist-compute-key-compl-table artist-mt))
+ (setq-local artist-prev-next-op-alist
+ (artist-make-prev-next-op-alist artist-key-compl-table))
+ (setq-local artist-rb-save-data (make-vector 7 0))
+ (setq-local artist-arrow-point-1 nil)
+ (setq-local artist-arrow-point-2 nil)
+ (setq-local next-line-add-newlines t)
+ (setq-local artist-key-draw-how
+ (artist-go-get-draw-how-from-symbol artist-curr-go))
(if (and artist-picture-compatibility (not (eq major-mode 'picture-mode)))
(progn
(picture-mode)
@@ -5016,7 +5004,7 @@ The event, EV, is the mouse event."
(setq timer (run-at-time interval interval draw-fn x1 y1))))
;; Read next event
- (setq ev (read-event))))
+ (setq ev (read--potential-mouse-event))))
;; Cleanup: get rid of any active timer.
(if timer
(cancel-timer timer)))
@@ -5224,7 +5212,7 @@ The event, EV, is the mouse event."
;; Read next event (only if we should not stop)
(if (not done)
- (setq ev (read-event)))))
+ (setq ev (read--potential-mouse-event)))))
;; Reverse point-list (last points are cond'ed first)
(setq point-list (reverse point-list))
@@ -5351,7 +5339,7 @@ The event, EV, is the mouse event."
;; Read next event
- (setq ev (read-event))))
+ (setq ev (read--potential-mouse-event))))
;; If we are not rubber-banding (that is, we were moving around the `2')
;; draw the shape
@@ -5398,10 +5386,9 @@ The event, EV, is the mouse event."
artist-arrow-point-2)))
;; Remove those variables from vars that are not bound
(mapc
- (function
- (lambda (x)
- (if (not (and (boundp x) (symbol-value x)))
- (setq vars (delq x vars))))) vars)
+ (lambda (x)
+ (if (not (and (boundp x) (symbol-value x)))
+ (setq vars (delq x vars)))) vars)
(reporter-submit-bug-report
artist-maintainer-address
(concat "artist.el " artist-version)
diff --git a/lisp/textmodes/bib-mode.el b/lisp/textmodes/bib-mode.el
index 5b4fa34a1ac..1e22287d32e 100644
--- a/lisp/textmodes/bib-mode.el
+++ b/lisp/textmodes/bib-mode.el
@@ -1,6 +1,6 @@
;;; bib-mode.el --- major mode for editing bib files
-;; Copyright (C) 1989, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1989, 2001-2021 Free Software Foundation, Inc.
;; Author: Henry Kautz
;; (according to authors.el)
diff --git a/lisp/textmodes/bibtex-style.el b/lisp/textmodes/bibtex-style.el
index 952b81621e9..66d245f9083 100644
--- a/lisp/textmodes/bibtex-style.el
+++ b/lisp/textmodes/bibtex-style.el
@@ -1,6 +1,6 @@
;;; bibtex-style.el --- Major mode for BibTeX Style files -*- lexical-binding: t -*-
-;; Copyright (C) 2005, 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2005, 2007-2021 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: tex
@@ -66,12 +66,12 @@
;;;###autoload
(define-derived-mode bibtex-style-mode nil "BibStyle"
"Major mode for editing BibTeX style files."
- (set (make-local-variable 'comment-start) "%")
- (set (make-local-variable 'outline-regexp) "^[a-z]")
- (set (make-local-variable 'imenu-generic-expression)
- '((nil "\\<\\(FUNCTION\\|MACRO\\)\\s-+{\\([^}\n]+\\)}" 2)))
- (set (make-local-variable 'indent-line-function) 'bibtex-style-indent-line)
- (set (make-local-variable 'parse-sexp-ignore-comments) t)
+ (setq-local comment-start "%")
+ (setq-local outline-regexp "^[a-z]")
+ (setq-local imenu-generic-expression
+ '((nil "\\<\\(FUNCTION\\|MACRO\\)\\s-+{\\([^}\n]+\\)}" 2)))
+ (setq-local indent-line-function 'bibtex-style-indent-line)
+ (setq-local parse-sexp-ignore-comments t)
(setq font-lock-defaults
'(bibtex-style-font-lock-keywords nil t
((?. . "w")))))
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el
index 715379fa80f..a22cd97b309 100644
--- a/lisp/textmodes/bibtex.el
+++ b/lisp/textmodes/bibtex.el
@@ -1,6 +1,6 @@
;;; bibtex.el --- BibTeX mode for GNU Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1992, 1994-1999, 2001-2020 Free Software Foundation,
+;; Copyright (C) 1992, 1994-1999, 2001-2021 Free Software Foundation,
;; Inc.
;; Author: Stefan Schoef <schoef@offis.uni-oldenburg.de>
@@ -40,7 +40,7 @@
;;; Code:
-(require 'button)
+(require 'iso8601)
;; User Options:
@@ -122,7 +122,8 @@ last-comma Add or delete comma on end of last field in entry,
according to value of `bibtex-comma-after-last-field'.
delimiters Change delimiters according to variables
`bibtex-field-delimiters' and `bibtex-entry-delimiters'.
-unify-case Change case of entry types and field names.
+unify-case Change case of entry and field names according to
+ `bibtex-unify-case-function'.
braces Enclose parts of field entries by braces according to
`bibtex-field-braces-alist'.
strings Replace parts of field entries by string constants
@@ -182,6 +183,17 @@ Space characters in REGEXP will be replaced by \"[ \\t\\n]+\"."
(regexp :tag "From regexp")
(regexp :tag "To string constant"))))
+(defcustom bibtex-unify-case-function #'identity
+ "Function for unifying case of entry and field names.
+It is called with one argument, the entry or field name."
+ :version "28.1"
+ :type '(choice (const :tag "Same case as in `bibtex-field-alist'" identity)
+ (const :tag "Downcase" downcase)
+ (const :tag "Capitalize" capitalize)
+ (const :tag "Upcase" upcase)
+ (function :tag "Conversion function"))
+ :safe (lambda (x) (memq x '(upcase downcase capitalize identity))))
+
(defcustom bibtex-clean-entry-hook nil
"List of functions to call when entry has been cleaned.
Functions are called with point inside the cleaned entry, and the buffer
@@ -192,20 +204,34 @@ narrowed to just the entry."
(defcustom bibtex-maintain-sorted-entries nil
"If non-nil, BibTeX mode maintains all entries in sorted order.
Allowed non-nil values are:
-plain or t All entries are sorted alphabetically.
-crossref All entries are sorted alphabetically unless an entry has a
+plain or t Sort entries alphabetically by keys.
+crossref Sort entries alphabetically by keys unless an entry has a
crossref field. These crossrefed entries are placed in
alphabetical order immediately preceding the main entry.
entry-class The entries are divided into classes according to their
entry type, see `bibtex-sort-entry-class'. Within each class
- the entries are sorted alphabetically.
+ sort entries alphabetically by keys.
+(INDEX-FUN PREDICATE)
+(INDEX-FUN PREDICATE INIT-FUN) Sort entries using INDEX-FUN and PREDICATE.
+ Function INDEX-FUN is called for each entry with point at the
+ end of the head of the entry. Its return values are used to
+ sort the entries using PREDICATE. Function PREDICATE takes two
+ arguments INDEX1 and INDEX2 as returned by INDEX-FUN.
+ It should return non-nil if INDEX1 should sort before INDEX2.
+ If INIT-FUN is non-nil, it should be a function that is called
+ with no arguments to initialize the sorting.
See also `bibtex-sort-ignore-string-entries'."
:group 'bibtex
+ :version "28.1"
:type '(choice (const nil)
+ (const t)
(const plain)
(const crossref)
(const entry-class)
- (const t))
+ (group :tag "Custom scheme"
+ (function :tag "Index-Fun")
+ (function :tag "Predicate")
+ (option (function :tag "Init-Fun"))))
:safe (lambda (a) (memq a '(nil t plain crossref entry-class))))
(defcustom bibtex-sort-entry-class
@@ -286,7 +312,9 @@ If parsing fails, try to set this variable to nil."
(option (choice :tag "Comment" :value nil
(const nil) string))
(option (choice :tag "Init" :value nil
- (const nil) string function)))))))
+ (const nil) string function))
+ (option (choice :tag "Alternative" :value nil
+ (const nil) integer)))))))
(define-obsolete-variable-alias 'bibtex-entry-field-alist
'bibtex-BibTeX-entry-alist "24.1")
@@ -387,13 +415,13 @@ If parsing fails, try to set this variable to nil."
(("author")
("howpublished" "The way in which the booklet was published")
("address") ("month") ("year") ("note")))
- ("PhdThesis" "PhD. Thesis"
+ ("PhdThesis" "PhD Thesis"
(("author")
- ("title" "Title of the PhD. thesis")
- ("school" "School where the PhD. thesis was written")
+ ("title" "Title of the PhD thesis")
+ ("school" "School where the PhD thesis was written")
("year"))
nil
- (("type" "Type of the PhD. thesis")
+ (("type" "Type of the PhD thesis")
("address" "Address of the school (if not part of field \"school\") or country")
("month") ("note")))
("MastersThesis" "Master's Thesis"
@@ -451,265 +479,380 @@ COMMENT is the comment string that appears in the echo area.
If COMMENT is nil use `bibtex-BibTeX-field-alist' if possible.
INIT is either the initial content of the field or a function,
which is called to determine the initial content of the field.
-ALTERNATIVE if non-nil is an integer that numbers sets of
-alternatives, starting from zero."
+ALTERNATIVE if non-nil is an integer N that numbers sets of
+alternatives. A negative integer -N indicates an alias for the
+field +N. Such aliases are ignored by `bibtex-entry' in the template
+for a new entry."
:group 'bibtex
- :version "26.1" ; add Conference
+ :version "28.1" ; extend alternatives
:type 'bibtex-entry-alist
:risky t)
(defcustom bibtex-biblatex-entry-alist
;; Compare in biblatex documentation:
;; Sec. 2.1.1 Regular types (required and optional fields)
+ ;; Sec. 2.2.5 Field Aliases
;; Appendix A Default Crossref setup
'(("Article" "Article in Journal"
- (("author") ("title") ("journaltitle")
- ("year" nil nil 0) ("date" nil nil 0))
+ (("author") ("title")
+ ("journaltitle" nil nil 3) ("journal" nil nil -3)
+ ("date" nil nil 1) ("year" nil nil -1))
nil
(("translator") ("annotator") ("commentator") ("subtitle") ("titleaddon")
- ("editor") ("editora") ("editorb") ("editorc")
- ("journalsubtitle") ("issuetitle") ("issuesubtitle")
+ ("editor") ("editora") ("editorb") ("editorc") ("journalsubtitle")
+ ("journaltitleaddon") ("issuetitle") ("issuesubtitle") ("issuetitleaddon")
("language") ("origlanguage") ("series") ("volume") ("number") ("eid")
("issue") ("month") ("pages") ("version") ("note") ("issn")
- ("addendum") ("pubstate") ("doi") ("eprint") ("eprintclass")
- ("eprinttype") ("url") ("urldate")))
+ ("addendum") ("pubstate") ("doi")
+ ("eprint") ("eprintclass" nil nil 4) ("primaryclass" nil nil -4)
+ ("eprinttype" nil nil 5) ("archiveprefix" nil nil -5)
+ ("url") ("urldate")))
("Book" "Single-Volume Book"
- (("author") ("title") ("year" nil nil 0) ("date" nil nil 0))
+ (("author") ("title")
+ ("date" nil nil 1) ("year" nil nil -1))
nil
(("editor") ("editora") ("editorb") ("editorc")
("translator") ("annotator") ("commentator")
("introduction") ("foreword") ("afterword") ("subtitle") ("titleaddon")
("maintitle") ("mainsubtitle") ("maintitleaddon")
("language") ("origlanguage") ("volume") ("part") ("edition") ("volumes")
- ("series") ("number") ("note") ("publisher") ("location") ("isbn")
+ ("series") ("number") ("note") ("publisher")
+ ("location" nil nil 2) ("address" nil nil -2) ("isbn") ("eid")
("chapter") ("pages") ("pagetotal") ("addendum") ("pubstate") ("doi")
- ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
+ ("eprint") ("eprintclass" nil nil 4) ("primaryclass" nil nil -4)
+ ("eprinttype" nil nil 5) ("archiveprefix" nil nil -5)
+ ("url") ("urldate")))
("MVBook" "Multi-Volume Book"
- (("author") ("title") ("year" nil nil 0) ("date" nil nil 0))
+ (("author") ("title")
+ ("date" nil nil 1) ("year" nil nil -1))
nil
(("editor") ("editora") ("editorb") ("editorc")
("translator") ("annotator") ("commentator")
("introduction") ("foreword") ("afterword") ("subtitle")
("titleaddon") ("language") ("origlanguage") ("edition") ("volumes")
("series") ("number") ("note") ("publisher")
- ("location") ("isbn") ("pagetotal") ("addendum") ("pubstate") ("doi")
- ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
+ ("location" nil nil 2) ("address" nil nil -2)
+ ("isbn") ("pagetotal") ("addendum") ("pubstate") ("doi")
+ ("eprint") ("eprintclass" nil nil 4) ("primaryclass" nil nil -4)
+ ("eprinttype" nil nil 5) ("archiveprefix" nil nil -5)
+ ("url") ("urldate")))
("InBook" "Chapter or Pages in a Book"
- (("title") ("year" nil nil 0) ("date" nil nil 0))
+ (("title") ("date" nil nil 1) ("year" nil nil -1))
(("author") ("booktitle"))
(("bookauthor") ("editor") ("editora") ("editorb") ("editorc")
("translator") ("annotator") ("commentator") ("introduction") ("foreword")
("afterword") ("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle")
("maintitleaddon") ("booksubtitle") ("booktitleaddon")
("language") ("origlanguage") ("volume") ("part") ("edition") ("volumes")
- ("series") ("number") ("note") ("publisher") ("location") ("isbn")
- ("chapter") ("pages") ("addendum") ("pubstate")
- ("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
+ ("series") ("number") ("note") ("publisher")
+ ("location" nil nil 2) ("address" nil nil -2) ("isbn") ("eid")
+ ("chapter") ("pages") ("addendum") ("pubstate") ("doi")
+ ("eprint") ("eprintclass" nil nil 4) ("primaryclass" nil nil -4)
+ ("eprinttype" nil nil 5) ("archiveprefix" nil nil -5)
+ ("url") ("urldate")))
("BookInBook" "Book in Collection" ; same as @inbook
- (("title") ("year" nil nil 0) ("date" nil nil 0))
+ (("title") ("date" nil nil 1) ("year" nil nil -1))
(("author") ("booktitle"))
(("bookauthor") ("editor") ("editora") ("editorb") ("editorc")
("translator") ("annotator") ("commentator") ("introduction") ("foreword")
("afterword") ("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle")
("maintitleaddon") ("booksubtitle") ("booktitleaddon")
("language") ("origlanguage") ("volume") ("part") ("edition") ("volumes")
- ("series") ("number") ("note") ("publisher") ("location") ("isbn")
- ("chapter") ("pages") ("addendum") ("pubstate")
- ("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
+ ("series") ("number") ("note") ("publisher")
+ ("location" nil nil 2) ("address" nil nil -2) ("isbn") ("eid")
+ ("chapter") ("pages") ("addendum") ("pubstate") ("doi")
+ ("eprint") ("eprintclass" nil nil 4) ("primaryclass" nil nil -4)
+ ("eprinttype" nil nil 5) ("archiveprefix" nil nil -5)
+ ("url") ("urldate")))
("SuppBook" "Supplemental Material in a Book" ; same as @inbook
- (("title") ("year" nil nil 0) ("date" nil nil 0))
+ (("title") ("date" nil nil 1) ("year" nil nil -1))
(("author") ("booktitle"))
(("bookauthor") ("editor") ("editora") ("editorb") ("editorc")
("translator") ("annotator") ("commentator") ("introduction") ("foreword")
("afterword") ("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle")
("maintitleaddon") ("booksubtitle") ("booktitleaddon")
("language") ("origlanguage") ("volume") ("part") ("edition") ("volumes")
- ("series") ("number") ("note") ("publisher") ("location") ("isbn")
- ("chapter") ("pages") ("addendum") ("pubstate")
- ("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
+ ("series") ("number") ("note") ("publisher")
+ ("location" nil nil 2) ("address" nil nil -2) ("isbn") ("eid")
+ ("chapter") ("pages") ("addendum") ("pubstate") ("doi")
+ ("eprint")("eprintclass" nil nil 4) ("primaryclass" nil nil -4)
+ ("eprinttype" nil nil 5) ("archiveprefix" nil nil -5)
+ ("url") ("urldate")))
("Booklet" "Booklet (Bound, but no Publisher)"
(("author" nil nil 0) ("editor" nil nil 0) ("title")
- ("year" nil nil 1) ("date" nil nil 1))
+ ("date" nil nil 1) ("year" nil nil -1))
nil
(("subtitle") ("titleaddon") ("language") ("howpublished") ("type")
- ("note") ("location") ("chapter") ("pages") ("pagetotal") ("addendum")
- ("pubstate") ("doi") ("eprint") ("eprintclass") ("eprinttype")
+ ("note") ("location" nil nil 2) ("address" nil nil -2)
+ ("eid") ("chapter") ("pages") ("pagetotal")
+ ("addendum") ("pubstate") ("doi")
+ ("eprint") ("eprintclass" nil nil 4) ("primaryclass" nil nil -4)
+ ("eprinttype" nil nil 5) ("archiveprefix" nil nil -5)
("url") ("urldate")))
("Collection" "Single-Volume Collection"
- (("editor") ("title") ("year" nil nil 0) ("date" nil nil 0))
+ (("editor") ("title")
+ ("date" nil nil 1) ("year" nil nil -1))
nil
(("editora") ("editorb") ("editorc") ("translator") ("annotator")
("commentator") ("introduction") ("foreword") ("afterword")
("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle")
("maintitleaddon") ("language") ("origlanguage") ("volume")
("part") ("edition") ("volumes") ("series") ("number") ("note")
- ("publisher") ("location") ("isbn") ("chapter") ("pages") ("pagetotal")
- ("addendum") ("pubstate") ("doi") ("eprint") ("eprintclass")
- ("eprinttype") ("url") ("urldate")))
+ ("publisher") ("location" nil nil 2) ("address" nil nil -2)
+ ("isbn") ("eid") ("chapter") ("pages")
+ ("pagetotal") ("addendum") ("pubstate") ("doi")
+ ("eprint") ("eprintclass" nil nil 4) ("primaryclass" nil nil -4)
+ ("eprinttype" nil nil 5) ("archiveprefix" nil nil -5)
+ ("url") ("urldate")))
("MVCollection" "Multi-Volume Collection"
- (("editor") ("title") ("year" nil nil 0) ("date" nil nil 0))
+ (("editor") ("title")
+ ("date" nil nil 1) ("year" nil nil -1))
nil
(("editora") ("editorb") ("editorc") ("translator") ("annotator")
("commentator") ("introduction") ("foreword") ("afterword")
("subtitle") ("titleaddon") ("language") ("origlanguage") ("edition")
("volumes") ("series") ("number") ("note") ("publisher")
- ("location") ("isbn") ("pagetotal") ("addendum") ("pubstate") ("doi")
- ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
+ ("location" nil nil 2) ("address" nil nil -2)
+ ("isbn") ("pagetotal") ("addendum") ("pubstate") ("doi")
+ ("eprint") ("eprintclass" nil nil 4) ("primaryclass" nil nil -4)
+ ("eprinttype" nil nil 5) ("archiveprefix" nil nil -5)
+ ("url") ("urldate")))
("InCollection" "Article in a Collection"
- (("author") ("title") ("year" nil nil 0) ("date" nil nil 0))
+ (("author") ("title")
+ ("date" nil nil 1) ("year" nil nil -1))
(("booktitle"))
- (("editor") ("editora") ("editorb") ("editorc") ("translator") ("annotator")
- ("commentator") ("introduction") ("foreword") ("afterword")
+ (("editor") ("editora") ("editorb") ("editorc") ("translator")
+ ("annotator") ("commentator") ("introduction") ("foreword") ("afterword")
("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle")
("maintitleaddon") ("booksubtitle") ("booktitleaddon")
("language") ("origlanguage") ("volume") ("part") ("edition")
- ("volumes") ("series") ("number") ("note") ("publisher") ("location")
- ("isbn") ("chapter") ("pages") ("addendum") ("pubstate") ("doi")
- ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
+ ("volumes") ("series") ("number") ("note") ("publisher")
+ ("location" nil nil 2) ("address" nil nil -2)
+ ("isbn") ("eid") ("chapter") ("pages") ("addendum") ("pubstate") ("doi")
+ ("eprint") ("eprintclass" nil nil 4) ("primaryclass" nil nil -4)
+ ("eprinttype" nil nil 5) ("archiveprefix" nil nil -5)
+ ("url") ("urldate")))
("SuppCollection" "Supplemental Material in a Collection" ; same as @incollection
- (("author") ("editor") ("title") ("year" nil nil 0) ("date" nil nil 0))
+ (("author") ("title")
+ ("date" nil nil 1) ("year" nil nil -1))
(("booktitle"))
- (("editora") ("editorb") ("editorc") ("translator") ("annotator")
- ("commentator") ("introduction") ("foreword") ("afterword")
+ (("editor") ("editora") ("editorb") ("editorc") ("translator")
+ ("annotator") ("commentator") ("introduction") ("foreword") ("afterword")
("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle")
("maintitleaddon") ("booksubtitle") ("booktitleaddon")
("language") ("origlanguage") ("volume") ("part") ("edition")
- ("volumes") ("series") ("number") ("note") ("publisher") ("location")
- ("isbn") ("chapter") ("pages") ("addendum") ("pubstate") ("doi")
- ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
+ ("volumes") ("series") ("number") ("note") ("publisher")
+ ("location" nil nil 2) ("address" nil nil -2)
+ ("isbn") ("eid") ("chapter") ("pages") ("addendum") ("pubstate") ("doi")
+ ("eprint") ("eprintclass" nil nil 4) ("primaryclass" nil nil -4)
+ ("eprinttype" nil nil 5) ("archiveprefix" nil nil -5)
+ ("url") ("urldate")))
+ ("Dataset" "Data Set"
+ (("author" nil nil 0) ("editor" nil nil 0) ("title")
+ ("date" nil nil 1) ("year" nil nil -1))
+ nil
+ (("subtitle") ("titleaddon") ("language") ("edition") ("type") ("series")
+ ("number") ("version") ("note") ("organization") ("publisher")
+ ("location" nil nil 2) ("address" nil nil -2)
+ ("addendum") ("pubstate") ("doi")
+ ("eprint") ("eprintclass" nil nil 4) ("primaryclass" nil nil -4)
+ ("eprinttype" nil nil 5) ("archiveprefix" nil nil -5)
+ ("url") ("urldate")))
("Manual" "Technical Manual"
(("author" nil nil 0) ("editor" nil nil 0) ("title")
- ("year" nil nil 1) ("date" nil nil 1))
+ ("date" nil nil 1) ("year" nil nil -1))
nil
(("subtitle") ("titleaddon") ("language") ("edition")
("type") ("series") ("number") ("version") ("note")
- ("organization") ("publisher") ("location") ("isbn") ("chapter")
- ("pages") ("pagetotal") ("addendum") ("pubstate")
- ("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
+ ("organization") ("publisher")
+ ("location" nil nil 2) ("address" nil nil -2)
+ ("isbn") ("eid") ("chapter")
+ ("pages") ("pagetotal") ("addendum") ("pubstate") ("doi")
+ ("eprint") ("eprintclass" nil nil 4) ("primaryclass" nil nil -4)
+ ("eprinttype" nil nil 5) ("archiveprefix" nil nil -5)
+ ("url") ("urldate")))
("Misc" "Miscellaneous"
(("author" nil nil 0) ("editor" nil nil 0) ("title")
- ("year" nil nil 1) ("date" nil nil 1))
+ ("date" nil nil 1) ("year" nil nil -1))
nil
(("subtitle") ("titleaddon") ("language") ("howpublished") ("type")
- ("version") ("note") ("organization") ("location")
- ("date") ("month") ("year") ("addendum") ("pubstate")
- ("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
+ ("version") ("note") ("organization")
+ ("location" nil nil 2) ("address" nil nil -2)
+ ("month") ("addendum") ("pubstate") ("doi")
+ ("eprint") ("eprintclass" nil nil 4) ("primaryclass" nil nil -4)
+ ("eprinttype" nil nil 5) ("archiveprefix" nil nil -5)
+ ("url") ("urldate")))
("Online" "Online Resource"
(("author" nil nil 0) ("editor" nil nil 0) ("title")
- ("year" nil nil 1) ("date" nil nil 1) ("url"))
+ ("date" nil nil 1) ("year" nil nil -1)
+ ("doi" nil nil 2) ("eprint" nil nil 2) ("url" nil nil 2))
nil
(("subtitle") ("titleaddon") ("language") ("version") ("note")
- ("organization") ("date") ("month") ("year") ("addendum")
- ("pubstate") ("urldate")))
+ ("organization") ("month") ("addendum")
+ ("pubstate") ("eprintclass" nil nil 4) ("primaryclass" nil nil -4)
+ ("eprinttype" nil nil 5) ("archiveprefix" nil nil -5) ("urldate")))
("Patent" "Patent"
- (("author") ("title") ("number") ("year" nil nil 0) ("date" nil nil 0))
+ (("author") ("title") ("number")
+ ("date" nil nil 1) ("year" nil nil -1))
nil
- (("holder") ("subtitle") ("titleaddon") ("type") ("version") ("location")
- ("note") ("date") ("month") ("year") ("addendum") ("pubstate")
- ("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
+ (("holder") ("subtitle") ("titleaddon") ("type") ("version")
+ ("location" nil nil 2) ("address" nil nil -2)
+ ("note") ("month") ("addendum") ("pubstate") ("doi")
+ ("eprint") ("eprintclass" nil nil 4) ("primaryclass" nil nil -4)
+ ("eprinttype" nil nil 5) ("archiveprefix" nil nil -5)
+ ("url") ("urldate")))
("Periodical" "Complete Issue of a Periodical"
- (("editor") ("title") ("year" nil nil 0) ("date" nil nil 0))
+ (("editor") ("title")
+ ("date" nil nil 1) ("year" nil nil -1))
nil
- (("editora") ("editorb") ("editorc") ("subtitle") ("issuetitle")
- ("issuesubtitle") ("language") ("series") ("volume") ("number") ("issue")
- ("date") ("month") ("year") ("note") ("issn") ("addendum") ("pubstate")
- ("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
+ (("editora") ("editorb") ("editorc") ("subtitle") ("titleaddon")
+ ("issuetitle") ("issuesubtitle") ("issuetitleaddon") ("language")
+ ("series") ("volume") ("number") ("issue")
+ ("month") ("note") ("issn") ("addendum") ("pubstate") ("doi")
+ ("eprint") ("eprintclass" nil nil 4) ("primaryclass" nil nil -4)
+ ("eprinttype" nil nil 5) ("archiveprefix" nil nil -5)
+ ("url") ("urldate")))
("SuppPeriodical" "Supplemental Material in a Periodical" ; same as @article
- (("author") ("title") ("journaltitle")
- ("year" nil nil 0) ("date" nil nil 0))
+ (("author") ("title")
+ ("journaltitle" nil nil 3) ("journal" nil nil -3)
+ ("date" nil nil 1) ("year" nil nil -1))
nil
(("translator") ("annotator") ("commentator") ("subtitle") ("titleaddon")
- ("editor") ("editora") ("editorb") ("editorc")
- ("journalsubtitle") ("issuetitle") ("issuesubtitle")
+ ("editor") ("editora") ("editorb") ("editorc") ("journalsubtitle")
+ ("journaltitleaddon") ("issuetitle") ("issuesubtitle") ("issuetitleaddon")
("language") ("origlanguage") ("series") ("volume") ("number") ("eid")
("issue") ("month") ("pages") ("version") ("note") ("issn")
- ("addendum") ("pubstate") ("doi") ("eprint") ("eprintclass")
- ("eprinttype") ("url") ("urldate")))
+ ("addendum") ("pubstate") ("doi")
+ ("eprint") ("eprintclass" nil nil 4) ("primaryclass" nil nil -4)
+ ("eprinttype" nil nil 5) ("archiveprefix" nil nil -5)
+ ("url") ("urldate")))
("Proceedings" "Single-Volume Conference Proceedings"
- (("title") ("year" nil nil 0) ("date" nil nil 0))
+ (("title") ("date" nil nil 1) ("year" nil nil -1))
nil
- (("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle")
- ("maintitleaddon") ("eventtitle") ("eventdate") ("venue") ("language")
- ("editor")
- ("volume") ("part") ("volumes") ("series") ("number") ("note")
- ("organization") ("publisher") ("location") ("month")
- ("isbn") ("chapter") ("pages") ("pagetotal") ("addendum") ("pubstate")
- ("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
+ (("editor") ("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle")
+ ("maintitleaddon") ("eventtitle") ("eventtitleaddon") ("eventdate")
+ ("venue") ("language") ("volume") ("part") ("volumes") ("series")
+ ("number") ("note") ("organization") ("publisher")
+ ("location" nil nil 2) ("address" nil nil -2) ("month")
+ ("isbn") ("eid") ("chapter") ("pages") ("pagetotal") ("addendum")
+ ("pubstate") ("doi")
+ ("eprint") ("eprintclass" nil nil 4) ("primaryclass" nil nil -4)
+ ("eprinttype" nil nil 5) ("archiveprefix" nil nil -5)
+ ("url") ("urldate")))
("MVProceedings" "Multi-Volume Conference Proceedings"
- (("editor") ("title") ("year" nil nil 0) ("date" nil nil 0))
+ (("title") ("date" nil nil 1) ("year" nil nil -1))
nil
- (("subtitle") ("titleaddon") ("eventtitle") ("eventdate") ("venue")
- ("language") ("volumes") ("series") ("number") ("note")
- ("organization") ("publisher") ("location") ("month")
- ("isbn") ("pagetotal") ("addendum") ("pubstate")
- ("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
+ (("editor") ("subtitle") ("titleaddon") ("eventtitle") ("eventtitleaddon")
+ ("eventdate") ("venue") ("language") ("volumes") ("series") ("number")
+ ("note") ("organization") ("publisher")
+ ("location" nil nil 2) ("address" nil nil -2) ("month")
+ ("isbn") ("pagetotal") ("addendum") ("pubstate") ("doi")
+ ("eprint") ("eprintclass" nil nil 4) ("primaryclass" nil nil -4)
+ ("eprinttype" nil nil 5) ("archiveprefix" nil nil -5)
+ ("url") ("urldate")))
("InProceedings" "Article in Conference Proceedings"
- (("author") ("title") ("year" nil nil 0) ("date" nil nil 0))
+ (("author") ("title")
+ ("date" nil nil 1) ("year" nil nil -1))
(("booktitle"))
(("editor") ("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle")
("maintitleaddon") ("booksubtitle") ("booktitleaddon")
- ("eventtitle") ("eventdate") ("venue") ("language")
+ ("eventtitle") ("eventtitleaddon") ("eventdate") ("venue") ("language")
("volume") ("part") ("volumes") ("series") ("number") ("note")
- ("organization") ("publisher") ("location") ("month") ("isbn")
- ("chapter") ("pages") ("addendum") ("pubstate")
- ("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
+ ("organization") ("publisher")
+ ("location" nil nil 2) ("address" nil nil -2) ("month") ("isbn") ("eid")
+ ("chapter") ("pages") ("addendum") ("pubstate") ("doi")
+ ("eprint") ("eprintclass" nil nil 4) ("primaryclass" nil nil -4)
+ ("eprinttype" nil nil 5) ("archiveprefix" nil nil -5)
+ ("url") ("urldate")))
("Reference" "Single-Volume Work of Reference" ; same as @collection
- (("editor") ("title") ("year" nil nil 0) ("date" nil nil 0))
+ (("editor") ("title") ("date" nil nil 1) ("year" nil nil -1))
nil
(("editora") ("editorb") ("editorc") ("translator") ("annotator")
("commentator") ("introduction") ("foreword") ("afterword")
("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle")
("maintitleaddon") ("language") ("origlanguage") ("volume")
("part") ("edition") ("volumes") ("series") ("number") ("note")
- ("publisher") ("location") ("isbn") ("chapter") ("pages") ("pagetotal")
- ("addendum") ("pubstate") ("doi") ("eprint") ("eprintclass")
- ("eprinttype") ("url") ("urldate")))
+ ("publisher") ("location" nil nil 2) ("address" nil nil -2)
+ ("isbn") ("eid") ("chapter") ("pages")
+ ("pagetotal") ("addendum") ("pubstate") ("doi")
+ ("eprint") ("eprintclass" nil nil 4) ("primaryclass" nil nil -4)
+ ("eprinttype" nil nil 5) ("archiveprefix" nil nil -5)
+ ("url") ("urldate")))
("MVReference" "Multi-Volume Work of Reference" ; same as @mvcollection
- (("editor") ("title") ("year" nil nil 0) ("date" nil nil 0))
+ (("editor") ("title") ("date" nil nil 1) ("year" nil nil -1))
nil
(("editora") ("editorb") ("editorc") ("translator") ("annotator")
("commentator") ("introduction") ("foreword") ("afterword")
("subtitle") ("titleaddon") ("language") ("origlanguage") ("edition")
("volumes") ("series") ("number") ("note") ("publisher")
- ("location") ("isbn") ("pagetotal") ("addendum") ("pubstate") ("doi")
- ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
+ ("location" nil nil 2) ("address" nil nil -2)
+ ("isbn") ("pagetotal") ("addendum") ("pubstate") ("doi")
+ ("eprint") ("eprintclass" nil nil 4) ("primaryclass" nil nil -4)
+ ("eprinttype" nil nil 5) ("archiveprefix" nil nil -5)
+ ("url") ("urldate")))
("InReference" "Article in a Work of Reference" ; same as @incollection
- (("author") ("editor") ("title") ("year" nil nil 0) ("date" nil nil 0))
+ (("author") ("title") ("date" nil nil 1) ("year" nil nil -1))
(("booktitle"))
- (("editora") ("editorb") ("editorc") ("translator") ("annotator")
- ("commentator") ("introduction") ("foreword") ("afterword")
+ (("editor") ("editora") ("editorb") ("editorc") ("translator")
+ ("annotator") ("commentator") ("introduction") ("foreword") ("afterword")
("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle")
("maintitleaddon") ("booksubtitle") ("booktitleaddon")
("language") ("origlanguage") ("volume") ("part") ("edition")
- ("volumes") ("series") ("number") ("note") ("publisher") ("location")
- ("isbn") ("chapter") ("pages") ("addendum") ("pubstate") ("doi")
- ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
+ ("volumes") ("series") ("number") ("note") ("publisher")
+ ("location" nil nil 2) ("address" nil nil -2)
+ ("isbn") ("eid") ("chapter") ("pages") ("addendum") ("pubstate") ("doi")
+ ("eprint") ("eprintclass" nil nil 4) ("primaryclass" nil nil -4)
+ ("eprinttype" nil nil 5) ("archiveprefix" nil nil -5)
+ ("url") ("urldate")))
("Report" "Technical or Research Report"
- (("author") ("title") ("type") ("institution")
- ("year" nil nil 0) ("date" nil nil 0))
+ (("author") ("title") ("type")
+ ("institution" nil nil 6) ("school" nil nil -6)
+ ("date" nil nil 1) ("year" nil nil -1))
nil
(("subtitle") ("titleaddon") ("language") ("number") ("version") ("note")
- ("location") ("month") ("isrn") ("chapter") ("pages") ("pagetotal")
- ("addendum") ("pubstate")
- ("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
- ("Thesis" "PhD. or Master's Thesis"
- (("author") ("title") ("type") ("institution")
- ("year" nil nil 0) ("date" nil nil 0))
+ ("location" nil nil 2) ("address" nil nil -2)
+ ("month") ("isrn") ("eid") ("chapter") ("pages")
+ ("pagetotal") ("addendum") ("pubstate") ("doi")
+ ("eprint") ("eprintclass" nil nil 4) ("primaryclass" nil nil -4)
+ ("eprinttype" nil nil 5) ("archiveprefix" nil nil -5)
+ ("url") ("urldate")))
+ ("Software" "Computer Software" ; Same as @misc.
+ (("author" nil nil 0) ("editor" nil nil 0) ("title")
+ ("date" nil nil 1) ("year" nil nil -1))
+ nil
+ (("subtitle") ("titleaddon") ("language") ("howpublished") ("type")
+ ("version") ("note") ("organization")
+ ("location" nil nil 2) ("address" nil nil -2)
+ ("month") ("addendum") ("pubstate") ("doi")
+ ("eprint") ("eprintclass" nil nil 4) ("primaryclass" nil nil -4)
+ ("eprinttype" nil nil 5) ("archiveprefix" nil nil -5)
+ ("url") ("urldate")))
+ ("Thesis" "PhD or Master's Thesis"
+ (("author") ("title") ("type")
+ ("institution" nil nil 6) ("school" nil nil -6)
+ ("date" nil nil 1) ("year" nil nil -1))
nil
- (("subtitle") ("titleaddon") ("language") ("note") ("location")
- ("month") ("isbn") ("chapter") ("pages") ("pagetotal")
- ("addendum") ("pubstate")
- ("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
+ (("subtitle") ("titleaddon") ("language") ("note")
+ ("location" nil nil 2) ("address" nil nil -2)
+ ("month") ("isbn") ("eid") ("chapter") ("pages") ("pagetotal")
+ ("addendum") ("pubstate") ("doi")
+ ("eprint") ("eprintclass" nil nil 4) ("primaryclass" nil nil -4)
+ ("eprinttype" nil nil 5) ("archiveprefix" nil nil -5)
+ ("url") ("urldate")))
("Unpublished" "Unpublished"
- (("author") ("title") ("year" nil nil 0) ("date" nil nil 0))
+ (("author") ("title") ("date" nil nil 1) ("year" nil nil -1))
nil
- (("subtitle") ("titleaddon") ("language") ("howpublished")
- ("note") ("location") ("isbn") ("date") ("month") ("year")
- ("addendum") ("pubstate") ("url") ("urldate"))))
+ (("subtitle") ("titleaddon") ("type") ("eventtitle") ("eventtitleaddon")
+ ("eventdate") ("venue") ("language") ("howpublished") ("note")
+ ("location" nil nil 2) ("address" nil nil -2)
+ ("isbn") ("month") ("addendum") ("pubstate") ("doi")
+ ("eprint") ("eprintclass" nil nil 4) ("primaryclass" nil nil -4)
+ ("eprinttype" nil nil 5) ("archiveprefix" nil nil -5)
+ ("url") ("urldate"))))
"Alist of biblatex entry types and their associated fields.
It has the same format as `bibtex-BibTeX-entry-alist'."
:group 'bibtex
- :version "24.1"
+ :version "28.1"
:type 'bibtex-entry-alist
:risky t)
@@ -766,6 +909,7 @@ if `bibtex-BibTeX-entry-alist' does not define a comment for FIELD."
("eprinttype" "Type of eprint identifier")
("eventdate" "Date of a conference or some other event")
("eventtitle" "Title of a conference or some other event")
+ ("eventtitleaddon" "Annex to the eventtitle (e.g., acronym of known event)")
("file" "Local link to an electronic version of the work")
("foreword" "Author(s) of a foreword to the work")
("holder" "Holder(s) of a patent")
@@ -781,9 +925,11 @@ if `bibtex-BibTeX-entry-alist' does not define a comment for FIELD."
("issue" "Issue of a journal")
("issuesubtitle" "Subtitle of a specific issue of a journal or other periodical.")
("issuetitle" "Title of a specific issue of a journal or other periodical.")
+ ("issuetitleaddon" "Annex to the issuetitle")
("iswc" "International Standard Work Code of a musical work")
("journalsubtitle" "Subtitle of a journal, a newspaper, or some other periodical.")
("journaltitle" "Name of a journal, a newspaper, or some other periodical.")
+ ("journaltitleaddon" "Annex to the journaltitle")
("label" "Substitute for the regular label to be used by the citation style")
("language" "Language(s) of the work")
("library" "Library name and a call number")
@@ -811,6 +957,8 @@ if `bibtex-BibTeX-entry-alist' does not define a comment for FIELD."
("series" "Name of a publication series")
("shortauthor" "Author(s) of the work, given in an abbreviated form")
("shorteditor" "Editor(s) of the work, given in an abbreviated form")
+ ("shorthand" "Special designation overriding the default label")
+ ("shorthandintro" "Phrase overriding the standard shorthand introduction")
("shortjournal" "Short version or an acronym of the journal title")
("shortseries" "Short version or an acronym of the series field")
("shorttitle" "Title in an abridged form")
@@ -829,7 +977,7 @@ if `bibtex-BibTeX-entry-alist' does not define a comment for FIELD."
"Alist of biblatex fields.
It has the same format as `bibtex-BibTeX-entry-alist'."
:group 'bibtex
- :version "24.1"
+ :version "28.1"
:type 'bibtex-field-alist)
(defcustom bibtex-dialect-list '(BibTeX biblatex)
@@ -866,7 +1014,8 @@ If nil prefix OPT is always removed."
(defcustom bibtex-comment-start "@Comment"
"String starting a BibTeX comment."
:group 'bibtex
- :type 'string)
+ :type 'string
+ :safe #'stringp)
(defcustom bibtex-add-entry-hook nil
"List of functions to call when BibTeX entry has been inserted."
@@ -1195,7 +1344,8 @@ and must return a string (the key to use)."
"Offset for BibTeX entries.
Added to the value of all other variables which determine columns."
:group 'bibtex
- :type 'integer)
+ :type 'integer
+ :safe #'integerp)
(defcustom bibtex-field-indentation 2
"Starting column for the name part in BibTeX fields."
@@ -1208,13 +1358,15 @@ Added to the value of all other variables which determine columns."
"Starting column for the text part in BibTeX fields.
Should be equal to the space needed for the longest name part."
:group 'bibtex
- :type 'integer)
+ :type 'integer
+ :safe #'integerp)
(defcustom bibtex-contline-indentation
(+ bibtex-text-indentation 1)
"Starting column for continuation lines of BibTeX fields."
:group 'bibtex
- :type 'integer)
+ :type 'integer
+ :safe #'integerp)
(defcustom bibtex-align-at-equal-sign nil
"If non-nil, align fields at equal sign instead of field text.
@@ -1701,7 +1853,7 @@ BibTeX field as necessary."
;; It can be confusing if non-editing commands try to
;; modify the buffer.
(if buffer-read-only
- (error "Comma missing at buffer position %s" (point)))
+ (user-error "Comma missing at buffer position %s" (point)))
(insert ",")
(forward-char -1)
;; Now try again.
@@ -1900,18 +2052,22 @@ If `bibtex-expand-strings' is non-nil, also expand BibTeX strings."
(bibtex-end-of-text-in-field bounds))))
(defun bibtex-text-in-field (field &optional follow-crossref)
- "Get content of field FIELD of current BibTeX entry.
-Return nil if not found.
+ "Return content of field FIELD of current BibTeX entry or nil if not found.
+FIELD may also be a list of fields that are tried in order.
If optional arg FOLLOW-CROSSREF is non-nil, follow crossref."
(save-excursion
- (let* ((end (if follow-crossref (bibtex-end-of-entry) t))
- (beg (bibtex-beginning-of-entry)) ; move point
- (bounds (bibtex-search-forward-field field end)))
+ (let ((end (if (and (not follow-crossref) (stringp field))
+ t ; try to minimize parsing
+ (bibtex-end-of-entry)))
+ bounds)
+ (bibtex-beginning-of-entry) ; move point
+ (let ((field (if (stringp field) (list field) field)))
+ (while (and field (not bounds))
+ (setq bounds (bibtex-search-forward-field (pop field) end))))
(cond (bounds (bibtex-text-in-field-bounds bounds t))
((and follow-crossref
- (progn (goto-char beg)
- (setq bounds (bibtex-search-forward-field
- "\\(OPT\\)?crossref" end))))
+ (setq bounds (bibtex-search-forward-field
+ "\\(OPT\\)?crossref" end)))
(let ((crossref-field (bibtex-text-in-field-bounds bounds t)))
(if (bibtex-search-crossref crossref-field)
;; Do not pass FOLLOW-CROSSREF because we want
@@ -2221,7 +2377,7 @@ On success return bounds, nil otherwise. Do not move point."
(>= (bibtex-end-of-field bounds) (point)))
bounds)
((not noerr)
- (error "Can't find enclosing BibTeX field"))))))
+ (user-error "Can't find enclosing BibTeX field"))))))
(defun bibtex-beginning-first-field (&optional beg)
"Move point to beginning of first field.
@@ -2233,7 +2389,7 @@ Optional arg BEG is beginning of entry."
(defun bibtex-insert-kill (n &optional comma)
"Reinsert the Nth stretch of killed BibTeX text (field or entry).
Optional arg COMMA is as in `bibtex-enclosing-field'."
- (unless bibtex-last-kill-command (error "BibTeX kill ring is empty"))
+ (unless bibtex-last-kill-command (user-error "BibTeX kill ring is empty"))
(let ((fun (lambda (kryp kr) ; adapted from `current-kill'
(car (set kryp (nthcdr (mod (- n (length (symbol-value kryp)))
(length kr))
@@ -2270,10 +2426,6 @@ Optional arg COMMA is as in `bibtex-enclosing-field'."
"Add NEWELT to the list stored in VEC at index IDX."
(aset vec idx (cons newelt (aref vec idx))))
-(defsubst bibtex-vec-incr (vec idx)
- "Increment by 1 the counter which is stored in VEC at index IDX."
- (aset vec idx (1+ (aref vec idx))))
-
(defun bibtex-format-entry ()
"Helper function for `bibtex-clean-entry'.
Formats current entry according to variable `bibtex-entry-format'."
@@ -2294,7 +2446,8 @@ Formats current entry according to variable `bibtex-entry-format'."
strings sort-fields)
bibtex-entry-format))
(left-delim-re (regexp-quote (bibtex-field-left-delimiter)))
- bounds crossref-key req-field-list default-field-list field-list
+ bounds crossref-key req-field-list opt-field-list
+ default-field-list field-list
num-alt alt-fields idx error-field-name)
(unwind-protect
;; formatting (undone if error occurs)
@@ -2312,7 +2465,7 @@ Formats current entry according to variable `bibtex-entry-format'."
;; identify entry type
(goto-char (point-min))
(or (re-search-forward bibtex-entry-type nil t)
- (error "Not inside a BibTeX entry"))
+ (user-error "Not inside a BibTeX entry"))
(let* ((beg-type (1+ (match-beginning 0)))
(end-type (match-end 0))
(entry-list (assoc-string (buffer-substring-no-properties
@@ -2322,7 +2475,7 @@ Formats current entry according to variable `bibtex-entry-format'."
;; unify case of entry type
(when (memq 'unify-case format)
(delete-region beg-type end-type)
- (insert (car entry-list)))
+ (insert (funcall bibtex-unify-case-function (car entry-list))))
;; update left entry delimiter
(when (memq 'delimiters format)
@@ -2341,16 +2494,22 @@ Formats current entry according to variable `bibtex-entry-format'."
;; list of required fields appropriate for an entry with
;; or without crossref key.
- (setq req-field-list (if crossref-key (nth 2 entry-list)
- (append (nth 2 entry-list) (nth 3 entry-list)))
+ (setq req-field-list (append (nth 2 entry-list)
+ (unless crossref-key
+ (nth 3 entry-list)))
+ opt-field-list (append (if crossref-key
+ (nth 3 entry-list))
+ (nth 4 entry-list)
+ bibtex-user-optional-fields)
;; default list of fields that may appear in this entry
- default-field-list (append (nth 2 entry-list) (nth 3 entry-list)
- (nth 4 entry-list)
- bibtex-user-optional-fields)
- ;; number of ALT fields we expect to find
- num-alt (length (delq nil (delete-dups
- (mapcar (lambda (x) (nth 3 x))
- req-field-list))))
+ default-field-list (append req-field-list opt-field-list)
+ ;; number of ALT fields we may find
+ num-alt (let ((n 0))
+ (mapc (lambda (x)
+ (if (nth 3 x)
+ (setq n (max n (abs (nth 3 x))))))
+ default-field-list)
+ (1+ n))
;; ALT fields of respective groups
alt-fields (make-vector num-alt nil))
@@ -2389,8 +2548,9 @@ Formats current entry according to variable `bibtex-entry-format'."
(if opt-alt (setq field-name (substring field-name 3)))
;; keep track of alternatives
- (if (setq idx (nth 3 (assoc-string field-name req-field-list t)))
- (bibtex-vec-push alt-fields idx field-name))
+ (if (and (not empty-field)
+ (setq idx (nth 3 (assoc-string field-name default-field-list t))))
+ (bibtex-vec-push alt-fields (abs idx) field-name))
(if (memq 'opts-or-alts format)
;; delete empty optional and alternative fields
@@ -2522,50 +2682,51 @@ Formats current entry according to variable `bibtex-entry-format'."
(memq 'required-fields format)
(assoc-string field-name req-field-list t))
(setq error-field-name field-name)
- (error "Mandatory field `%s' is empty" field-name))
+ (user-error "Mandatory field `%s' is empty" field-name))
;; unify case of field name
- (if (memq 'unify-case format)
- (let ((fname (car (assoc-string field-name
- default-field-list t))))
- (if fname
- (progn
- (delete-region beg-name end-name)
- (goto-char beg-name)
- (insert fname))
- ;; there are no rules we could follow
- (downcase-region beg-name end-name))))
+ (when (memq 'unify-case format)
+ (let ((fname (car (assoc-string field-name
+ default-field-list t)))
+ (curname (buffer-substring beg-name end-name)))
+ (delete-region beg-name end-name)
+ (goto-char beg-name)
+ (insert (funcall bibtex-unify-case-function
+ (or fname curname)))))
;; update point
(goto-char end-field))))
;; check whether all required fields are present
- (if (memq 'required-fields format)
- (let ((alt-expect (make-vector num-alt nil))
- (alt-found (make-vector num-alt 0)))
- (dolist (fname req-field-list)
- (cond ((setq idx (nth 3 fname))
- ;; t if field has alternative flag
- (bibtex-vec-push alt-expect idx (car fname))
- (if (member-ignore-case (car fname) field-list)
- (bibtex-vec-incr alt-found idx)))
- ((not (member-ignore-case (car fname) field-list))
- ;; If we use the crossref field, a required field
- ;; can have the OPT prefix. So if it was empty,
- ;; we have deleted by now. Nonetheless we can
- ;; move point on this empty field.
- (setq error-field-name (car fname))
- (error "Mandatory field `%s' is missing" (car fname)))))
- (dotimes (idx num-alt)
- (cond ((= 0 (aref alt-found idx))
- (setq error-field-name (car (last (aref alt-fields idx))))
- (error "Alternative mandatory field `%s' is missing"
- (aref alt-expect idx)))
- ((< 1 (aref alt-found idx))
- (setq error-field-name (car (last (aref alt-fields idx))))
- (error "Alternative fields `%s' are defined %s times"
- (aref alt-expect idx)
- (length (aref alt-fields idx))))))))
+ (when (memq 'required-fields format)
+ (let ((alt-expect (make-vector num-alt nil)))
+ (dolist (fname req-field-list)
+ (cond ((nth 3 fname)
+ ;; t if required field has alternative flag
+ (setq idx (abs (nth 3 fname)))
+ (bibtex-vec-push alt-expect idx (car fname)))
+ ((not (member-ignore-case (car fname) field-list))
+ (setq error-field-name (car fname))
+ (user-error "Mandatory field `%s' is missing"
+ (car fname)))))
+ (dotimes (idx num-alt)
+ (cond ((and (aref alt-expect idx)
+ (not (aref alt-fields idx)))
+ (setq error-field-name
+ (car (last (aref alt-fields idx))))
+ (user-error "Alternative mandatory fields `%s' are missing"
+ (mapconcat 'identity
+ (reverse
+ (aref alt-expect idx))
+ ", ")))
+ ((nth 1 (aref alt-fields idx))
+ (setq error-field-name
+ (car (last (aref alt-fields idx))))
+ (user-error "Fields `%s' are alternatives"
+ (mapconcat 'identity
+ (reverse
+ (aref alt-fields idx))
+ ", ")))))))
;; update comma after last field
(if (memq 'last-comma format)
@@ -2648,6 +2809,7 @@ is returned unchanged."
(defun bibtex-autokey-get-field (field &optional change-list)
"Get content of BibTeX field FIELD. Return empty string if not found.
+FIELD may also be a list of fields that are tried in order.
Optional arg CHANGE-LIST is a list of substitution patterns that is
applied to the content of FIELD. It is an alist with pairs
\(OLD-REGEXP . NEW-STRING)."
@@ -2710,15 +2872,23 @@ and `bibtex-autokey-names-stretch'."
;; name is of the form "First Middle Last" or "Last"
;; --> take the last token
(match-string 1 fullname))
- (t (error "Name `%s' is incorrectly formed" fullname)))))
+ (t (user-error "Name `%s' is incorrectly formed"
+ fullname)))))
(funcall bibtex-autokey-name-case-convert-function
(bibtex-autokey-abbrev name bibtex-autokey-name-length))))
(defun bibtex-autokey-get-year ()
"Return year field contents as a string obeying `bibtex-autokey-year-length'."
- (let ((yearfield (bibtex-autokey-get-field "year")))
- (substring yearfield (max 0 (- (length yearfield)
- bibtex-autokey-year-length)))))
+ (let* ((str (bibtex-autokey-get-field '("date" "year"))) ; possibly ""
+ (year (or (and (iso8601-valid-p str)
+ (let ((year (decoded-time-year (iso8601-parse str))))
+ (and year (number-to-string year))))
+ ;; BibTeX permits a year field "(about 1984)", where only
+ ;; the last four nonpunctuation characters must be numerals.
+ (and (string-match "\\([0-9][0-9][0-9][0-9]\\)[^[:alnum:]]*\\'" str)
+ (match-string 1 str))
+ (user-error "Year or date field `%s' invalid" str))))
+ (substring year (max 0 (- (length year) bibtex-autokey-year-length)))))
(defun bibtex-autokey-get-title ()
"Get title field contents up to a terminator.
@@ -2801,12 +2971,12 @@ The name part:
The year part:
1. Build the year part of the key by truncating the content of the year
- field to the rightmost `bibtex-autokey-year-length' digits (useful
- values are 2 and 4).
- 2. If the year field (or any other field required to generate the key)
- is absent, but the entry has a valid crossref field and
- `bibtex-autokey-use-crossref' is non-nil, use the field of the
- crossreferenced entry instead.
+ component of the date or year field to the rightmost
+ `bibtex-autokey-year-length' digits (useful values are 2 and 4).
+ 2. If both the year and date fields are absent, but the entry has a
+ valid crossref field and `bibtex-autokey-use-crossref' is
+ non-nil, use the date or year field of the crossreferenced entry
+ instead.
The title part
1. Change the content of the title field according to
@@ -2917,7 +3087,7 @@ for parsing BibTeX keys. If parsing fails, try to set this variable to nil."
(1+ (match-beginning 3)) (1- (match-end 3)))))
(unless (assoc key crossref-keys)
(push (list key) crossref-keys))))
- ;; We have probably have a non-bibtex file.
+ ;; We probably have a non-bibtex file.
((not (match-beginning bibtex-type-in-head))
(throw 'userkey nil))
;; only keys of known entries
@@ -3005,15 +3175,15 @@ Use `bibtex-predefined-strings' and BibTeX files `bibtex-string-files'."
(if (file-name-absolute-p filename)
(if (file-readable-p filename)
(push filename string-files)
- (error "BibTeX strings file %s not found" filename))
+ (user-error "BibTeX strings file %s not found" filename))
(dolist (dir dirlist)
(when (file-readable-p
(setq fullfilename (expand-file-name filename dir)))
(push fullfilename string-files)
(setq found t)))
(unless found
- (error "File %s not in paths defined via bibtex-string-file-path"
- filename))))
+ (user-error "File %s not in paths defined via bibtex-string-file-path"
+ filename))))
;; parse string files
(dolist (filename string-files)
(with-temp-buffer
@@ -3088,11 +3258,11 @@ does not use `bibtex-mode'."
(push expanded-file-name file-list)
(setq found t)))
(unless found
- (error "File `%s' not in paths defined via bibtex-file-path"
- file))))))
+ (user-error "File `%s' not in paths defined via bibtex-file-path"
+ file))))))
(dolist (file file-list)
(unless (file-readable-p file)
- (error "BibTeX file `%s' not found" file)))
+ (user-error "BibTeX file `%s' not found" file)))
;; expand dir-list
(dolist (dir dir-list)
(setq file-list
@@ -3169,7 +3339,7 @@ that is generated by calling `bibtex-url'."
(bibtex-beginning-of-entry)
(if (looking-at bibtex-entry-maybe-empty-head)
(kill-new (message "%s" (funcall bibtex-summary-function)))
- (error "No entry found")))))
+ (user-error "No entry found")))))
(defun bibtex-summary ()
"Return summary of current BibTeX entry.
@@ -3201,7 +3371,7 @@ Used as default value of `bibtex-summary-function'."
`((" " . ,names) (" " . ,year) (": " . ,title)
(", " . ,journal) (" " . ,volume) (":" . ,pages))
""))
- (error "Entry not found")))
+ (user-error "Entry not found")))
(defun bibtex-pop (arg direction)
"Fill current field from the ARGth same field's text in DIRECTION.
@@ -3235,8 +3405,8 @@ Generic function used by `bibtex-pop-previous' and `bibtex-pop-next'."
(goto-char (bibtex-end-of-field bounds))
(setq failure t))))
(if failure
- (error "No %s matching BibTeX field"
- (if (eq direction 'previous) "previous" "next"))
+ (user-error "No %s matching BibTeX field"
+ (if (eq direction 'previous) "previous" "next"))
;; Found a matching field. Remember boundaries.
(let ((new-text (bibtex-text-in-field-bounds bounds))
(nbeg (copy-marker (bibtex-start-of-field bounds)))
@@ -3410,37 +3580,41 @@ if that value is non-nil.
(setq bibtex-parse-idle-timer (run-with-idle-timer
bibtex-parse-keys-timeout t
'bibtex-parse-buffers-stealthily)))
- (set (make-local-variable 'paragraph-start) "[ \f\n\t]*$")
- (set (make-local-variable 'comment-start) bibtex-comment-start)
- (set (make-local-variable 'comment-start-skip)
- (concat (regexp-quote bibtex-comment-start) "\\>[ \t]*"))
- (set (make-local-variable 'comment-column) 0)
- (set (make-local-variable 'defun-prompt-regexp) "^[ \t]*@[[:alnum:]]+[ \t]*")
- (set (make-local-variable 'outline-regexp) "[ \t]*@")
- (set (make-local-variable 'fill-paragraph-function) #'bibtex-fill-field)
- (set (make-local-variable 'fill-prefix)
- (make-string (+ bibtex-entry-offset bibtex-contline-indentation) ?\s))
- (set (make-local-variable 'font-lock-defaults)
- '(bibtex-font-lock-keywords
- nil t ((?$ . "\"")
- ;; Mathematical expressions should be fontified as strings
- (?\" . ".")
- ;; Quotes are field delimiters and quote-delimited
- ;; entries should be fontified in the same way as
- ;; brace-delimited ones
- )
- nil
- (font-lock-extra-managed-props . (category))
- (font-lock-mark-block-function
- . (lambda ()
- (set-mark (bibtex-end-of-entry))
- (bibtex-beginning-of-entry)))))
- (set (make-local-variable 'syntax-propertize-function)
- (syntax-propertize-via-font-lock
- bibtex-font-lock-syntactic-keywords))
- (bibtex-set-dialect nil t)
- ;; Allow `bibtex-dialect' as a file-local variable.
- (add-hook 'hack-local-variables-hook #'bibtex-set-dialect nil t))
+ (setq-local paragraph-start "[ \f\n\t]*$")
+ (setq-local comment-column 0)
+ (setq-local defun-prompt-regexp "^[ \t]*@[[:alnum:]]+[ \t]*")
+ (setq-local outline-regexp "[ \t]*@")
+ (setq-local fill-paragraph-function #'bibtex-fill-field)
+ (setq-local font-lock-defaults
+ '(bibtex-font-lock-keywords
+ nil t ((?$ . "\"")
+ ;; Mathematical expressions should be fontified as strings
+ (?\" . ".")
+ ;; Quotes are field delimiters and quote-delimited
+ ;; entries should be fontified in the same way as
+ ;; brace-delimited ones
+ )
+ nil
+ (font-lock-extra-managed-props . (category))
+ (font-lock-mark-block-function
+ . (lambda ()
+ (set-mark (bibtex-end-of-entry))
+ (bibtex-beginning-of-entry)))))
+ (setq-local syntax-propertize-function
+ (syntax-propertize-via-font-lock
+ bibtex-font-lock-syntactic-keywords))
+ (let ((fun (lambda ()
+ (bibtex-set-dialect)
+ (setq-local comment-start bibtex-comment-start)
+ (setq-local comment-start-skip
+ (concat (regexp-quote bibtex-comment-start) "\\>[ \t]*"))
+ (setq-local fill-prefix
+ (make-string (+ bibtex-entry-offset
+ bibtex-contline-indentation)
+ ?\s)))))
+ (if (and buffer-file-name enable-local-variables)
+ (add-hook 'hack-local-variables-hook fun nil t)
+ (funcall fun))))
(defun bibtex-entry-alist (dialect)
"Return entry-alist for DIALECT."
@@ -3448,7 +3622,7 @@ if that value is non-nil.
entry-alist)
(if (boundp var)
(setq entry-alist (symbol-value var))
- (error "BibTeX dialect `%s' undefined" dialect))
+ (user-error "BibTeX dialect `%s' undefined" dialect))
(if (not (consp (nth 1 (car entry-alist))))
;; new format
entry-alist
@@ -3502,8 +3676,8 @@ LOCAL is t for interactive calls."
bibtex-dialect))))
(if (boundp var)
(symbol-value var)
- (error "Field types for BibTeX dialect `%s' undefined"
- bibtex-dialect))))
+ (user-error "Field types for BibTeX dialect `%s' undefined"
+ bibtex-dialect))))
(funcall setfun 'bibtex-entry-type
(concat "@[ \t]*\\(?:"
(regexp-opt (mapcar #'car bibtex-entry-alist)) "\\)"))
@@ -3574,15 +3748,14 @@ and `bibtex-user-optional-fields'."
(let ((e-list (assoc-string entry-type bibtex-entry-alist t))
required optional)
(unless e-list
- (error "Fields for BibTeX entry type %s not defined" entry-type))
+ (user-error "Fields for BibTeX entry type %s not defined" entry-type))
(if (member-ignore-case entry-type bibtex-include-OPTcrossref)
(setq required (nth 2 e-list)
optional (append (nth 3 e-list) (nth 4 e-list)))
(setq required (append (nth 2 e-list) (nth 3 e-list))
optional (nth 4 e-list)))
(if bibtex-include-OPTkey
- (push (list "key"
- "Used for reference key creation if author and editor fields are missing"
+ (push (list "key" "Used as label with certain BibTeX styles"
(if (or (stringp bibtex-include-OPTkey)
(functionp bibtex-include-OPTkey))
bibtex-include-OPTkey))
@@ -3591,7 +3764,41 @@ and `bibtex-user-optional-fields'."
(push '("crossref" "Reference key of the cross-referenced entry")
optional))
(setq optional (append optional bibtex-user-optional-fields))
- (cons required optional)))
+ (cons (bibtex--skip-field-aliases required)
+ (bibtex--skip-field-aliases optional))))
+
+(defun bibtex--skip-field-aliases (list)
+ "Skip fields in LIST that are aliases, return the shortened list.
+Aliases are fields for which the element ALTERNATIVE is a negative number,
+see `bibtex-BibTeX-entry-alist'. The shortened field list is used
+for the templates of `bibtex-entry', whereas entry validation performed by
+`bibtex-format-entry' uses the full list of fields for an entry."
+ ;; FIXME: `bibtex-entry' and `bibtex-format-entry' handle aliases
+ ;; under the hood in a manner that is largely invisible to users.
+ ;; If instead one wanted to display the aliases as alternatives
+ ;; in the usual way, field names may get both the ALT and the OPT prefix.
+ ;; That gets rather clumsy. Also, the code currently assumes that
+ ;; field names have either the ALT or the OPT prefix, but not both.
+ ;; Are there scenarios when it would be useful to display both?
+ (let (alt-list new-list)
+ (dolist (elt list) ; identify alternatives
+ (if (and (nth 3 elt)
+ (<= 0 (nth 3 elt)))
+ (push (nth 3 elt) alt-list)))
+ (setq alt-list (sort alt-list '<))
+ ;; Skip aliases. If ELT is marked as "proper alternative", but all
+ ;; alternatives for field ELT are aliases, we do not label ELT
+ ;; as an alternative either.
+ (dolist (elt list)
+ (let ((alt (nth 3 elt)))
+ (if alt
+ (if (<= 0 alt)
+ (push (if (eq alt (cadr (memq alt alt-list)))
+ elt ; ELT has proper alternatives
+ (butlast elt)) ; alternatives of ELT are alias
+ new-list))
+ (push elt new-list))))
+ (reverse new-list)))
(defun bibtex-entry (entry-type)
"Insert a template for a BibTeX entry of type ENTRY-TYPE.
@@ -3605,7 +3812,7 @@ is non-nil."
(bibtex-read-key (format "%s key: " entry-type))))
(field-list (bibtex-field-list entry-type)))
(unless (bibtex-prepare-new-entry (list key nil entry-type))
- (error "Entry with key `%s' already exists" key))
+ (user-error "Entry with key `%s' already exists" key))
(indent-to-column bibtex-entry-offset)
(insert "@" entry-type (bibtex-entry-left-delimiter))
(if key (insert key))
@@ -3817,7 +4024,7 @@ INIT is surrounded by field delimiters, unless NODELIM is non-nil."
(let ((init (nth 2 field)))
(if (not init) (setq init "")
(if (functionp init) (setq init (funcall init)))
- (unless (stringp init) (error "`%s' is not a string" init)))
+ (unless (stringp init) (user-error "`%s' is not a string" init)))
;; NODELIM is required by `bibtex-insert-kill'
(if nodelim (insert init)
(insert (bibtex-field-left-delimiter) init
@@ -3855,7 +4062,7 @@ Return the new location of point."
(goto-char (bibtex-end-of-string bounds)))
((looking-at bibtex-any-valid-entry-type)
;; Parsing of entry failed
- (error "Syntactically incorrect BibTeX entry starts here"))
+ (user-error "Syntactically incorrect BibTeX entry starts here"))
(t (if (called-interactively-p 'interactive)
(message "Not on a known BibTeX entry."))
(goto-char pnt)))
@@ -3930,7 +4137,7 @@ If mark is active count entries in region, if not in whole buffer."
(if bounds
(ispell-region (bibtex-start-of-text-in-field bounds)
(bibtex-end-of-text-in-field bounds))
- (error "No abstract in entry"))))
+ (user-error "No abstract in entry"))))
(defun bibtex-narrow-to-entry ()
"Narrow buffer to current BibTeX entry."
@@ -3940,38 +4147,54 @@ If mark is active count entries in region, if not in whole buffer."
(narrow-to-region (bibtex-beginning-of-entry)
(bibtex-end-of-entry))))
+(define-obsolete-function-alias 'bibtex-init-sort-entry-class-alist
+ #'bibtex-init-sort "28.1")
+(defun bibtex-init-sort (&optional parse)
+ "Initialize sorting of BibTeX entries.
+If PARSE is non-nil, also parse BibTeX keys."
+ (if (or parse
+ (and (eq bibtex-maintain-sorted-entries 'crossref)
+ (functionp bibtex-reference-keys)))
+ (bibtex-parse-keys))
+ (unless (local-variable-p 'bibtex-sort-entry-class-alist)
+ (setq-local bibtex-sort-entry-class-alist
+ (let ((i -1) alist)
+ (dolist (class bibtex-sort-entry-class)
+ (setq i (1+ i))
+ (dolist (entry class)
+ ;; All entry types should be downcase (for ease of comparison).
+ (push (cons (if (stringp entry) (downcase entry) entry) i)
+ alist)))
+ alist)))
+ ;; Custom sorting scheme
+ (if (and (consp bibtex-maintain-sorted-entries)
+ (nth 2 bibtex-maintain-sorted-entries))
+ (funcall (nth 2 bibtex-maintain-sorted-entries))))
+
(defun bibtex-entry-index ()
"Return index of BibTeX entry head at or past position of point.
The index is a list (KEY CROSSREF-KEY ENTRY-TYPE) that is used for sorting
-the entries of the BibTeX buffer. CROSSREF-KEY is nil unless the value
-of `bibtex-maintain-sorted-entries' is `crossref'. Move point to the end
-of the head of the entry found. Return nil if no entry found."
+the entries of the BibTeX buffer. CROSSREF-KEY is nil unless the value of
+`bibtex-maintain-sorted-entries' is `crossref'.
+If `bibtex-maintain-sorted-entries' is (INDEX-FUN ...), the index is the return
+value of INDEX-FUN. Return nil if no entry found.
+Move point to the end of the head of the entry found."
(let ((case-fold-search t))
(if (re-search-forward bibtex-entry-maybe-empty-head nil t)
- (let ((key (bibtex-key-in-head))
- ;; all entry types should be downcase (for ease of comparison)
- (entry-type (downcase (bibtex-type-in-head))))
- ;; Don't search CROSSREF-KEY if we don't need it.
- (if (eq bibtex-maintain-sorted-entries 'crossref)
- (let ((bounds (bibtex-search-forward-field
- "\\(OPT\\)?crossref" t)))
- (list key
- (if bounds (bibtex-text-in-field-bounds bounds t))
- entry-type))
- (list key nil entry-type))))))
-
-(defun bibtex-init-sort-entry-class-alist ()
- "Initialize `bibtex-sort-entry-class-alist' (buffer-local)."
- (unless (local-variable-p 'bibtex-sort-entry-class-alist)
- (set (make-local-variable 'bibtex-sort-entry-class-alist)
- (let ((i -1) alist)
- (dolist (class bibtex-sort-entry-class)
- (setq i (1+ i))
- (dolist (entry class)
- ;; All entry types should be downcase (for ease of comparison).
- (push (cons (if (stringp entry) (downcase entry) entry) i)
- alist)))
- alist))))
+ (if (consp bibtex-maintain-sorted-entries)
+ ;; Custom sorting scheme
+ (funcall (car bibtex-maintain-sorted-entries))
+ (let ((key (bibtex-key-in-head))
+ ;; ENTRY-TYPE should be downcase (for ease of comparison)
+ (entry-type (downcase (bibtex-type-in-head)))
+ bounds)
+ (list key
+ ;; Don't search CROSSREF-KEY if we don't need it.
+ (and (eq bibtex-maintain-sorted-entries 'crossref)
+ (setq bounds (bibtex-search-forward-field
+ "\\(OPT\\)?crossref" t))
+ (bibtex-text-in-field-bounds bounds t))
+ entry-type))))))
(defun bibtex-lessp (index1 index2)
"Predicate for sorting BibTeX entries with indices INDEX1 and INDEX2.
@@ -3980,6 +4203,8 @@ The predicate depends on the variable `bibtex-maintain-sorted-entries'.
If its value is nil use plain sorting."
(cond ((not index1) (not index2)) ; indices can be nil
((not index2) nil)
+ ((consp bibtex-maintain-sorted-entries)
+ (funcall (cadr bibtex-maintain-sorted-entries) index1 index2))
((eq bibtex-maintain-sorted-entries 'crossref)
;; CROSSREF-KEY may be nil or it can point to an entry
;; in another BibTeX file. In both cases we ignore CROSSREF-KEY.
@@ -4016,10 +4241,7 @@ affected. If `bibtex-sort-ignore-string-entries' is non-nil, @String entries
are ignored."
(interactive)
(bibtex-beginning-of-first-entry) ; Needed by `sort-subr'
- (bibtex-init-sort-entry-class-alist) ; Needed by `bibtex-lessp'.
- (if (and (eq bibtex-maintain-sorted-entries 'crossref)
- (functionp bibtex-reference-keys))
- (bibtex-parse-keys)) ; Needed by `bibtex-lessp'.
+ (bibtex-init-sort) ; Needed by `bibtex-lessp'.
(sort-subr nil
'bibtex-skip-to-valid-entry ; NEXTREC function
'bibtex-end-of-entry ; ENDREC function
@@ -4047,7 +4269,7 @@ for a crossref key, t otherwise."
(let* ((pnt (point))
(_ (bibtex-beginning-of-entry))
(end (cdr (bibtex-valid-entry t)))
- (_ (unless end (error "Not inside valid entry")))
+ (_ (unless end (user-error "Not inside valid entry")))
(beg (match-end 0)) ; set by `bibtex-valid-entry'
(bounds (bibtex-search-forward-field "\\(OPT\\)?crossref" end))
case-fold-search best temp crossref-key)
@@ -4087,7 +4309,7 @@ for a crossref key, t otherwise."
(bibtex-reposition-window pos)
(beginning-of-line)
(if (and eqb (> pnt pos) (not noerror))
- (error "The referencing entry must precede the crossrefed entry!"))))
+ (user-error "The referencing entry must precede the crossrefed entry"))))
;; `bibtex-search-crossref' is called noninteractively during
;; clean-up of an entry. Then it is not possible to check
;; whether the current entry and the crossrefed entry have
@@ -4170,10 +4392,7 @@ If `bibtex-maintain-sorted-entries' is non-nil, perform a binary
search to look for place for KEY. This requires that buffer is sorted,
see `bibtex-validate'.
Return t if preparation was successful or nil if entry KEY already exists."
- (bibtex-init-sort-entry-class-alist) ; Needed by `bibtex-lessp'.
- (if (and (eq bibtex-maintain-sorted-entries 'crossref)
- (functionp bibtex-reference-keys))
- (bibtex-parse-keys)) ; Needed by `bibtex-lessp'.
+ (bibtex-init-sort) ; Needed by `bibtex-lessp'.
(let ((key (nth 0 index))
key-exist)
(cond ((or (null key)
@@ -4264,9 +4483,7 @@ Return t if test was successful, nil otherwise."
(setq syntax-error t)
;; Check for duplicate keys and correct sort order
- (bibtex-init-sort-entry-class-alist) ; Needed by `bibtex-lessp'.
- (bibtex-parse-keys) ; Possibly needed by `bibtex-lessp'.
- ; Always needed by subsequent global key check.
+ (bibtex-init-sort t) ; Needed by `bibtex-lessp' and global key check.
(let (previous current key-list)
(bibtex-progress-message "Checking for duplicate keys")
(bibtex-map-entries
@@ -4317,12 +4534,19 @@ Return t if test was successful, nil otherwise."
(entry-list (assoc-string (bibtex-type-in-head)
bibtex-entry-alist t))
(crossref (bibtex-search-forward-field "crossref" end))
- (req (if crossref (copy-sequence (nth 2 entry-list))
- (append (nth 2 entry-list)
+ (req (append (nth 2 entry-list)
+ (unless crossref
(copy-sequence (nth 3 entry-list)))))
- (num-alt (length (delq nil (delete-dups
- (mapcar (lambda (x) (nth 3 x))
- req)))))
+ (opt (append (if crossref (nth 3 entry-list))
+ (nth 4 entry-list)
+ bibtex-user-optional-fields))
+ (default (append req opt))
+ (num-alt (let ((n 0))
+ (mapc (lambda (x)
+ (if (nth 3 x)
+ (setq n (max n (abs (nth 3 x))))))
+ default)
+ (1+ n)))
(alt-fields (make-vector num-alt nil))
bounds field idx)
(while (setq bounds (bibtex-parse-field))
@@ -4337,7 +4561,7 @@ Return t if test was successful, nil otherwise."
(push (cons (bibtex-current-line)
"Questionable month field")
error-list))
- (setq field (assoc-string field-name req t)
+ (setq field (assoc-string field-name default t)
req (delete field req))
(if (setq idx (nth 3 field))
(if (aref alt-fields idx)
@@ -4356,12 +4580,13 @@ Return t if test was successful, nil otherwise."
(car field)))
error-list)))
(dotimes (idx num-alt)
- (unless (aref alt-fields idx)
- (push (cons beg-line
- (format-message
- "Alternative fields `%s' missing"
- (aref alt-expect idx)))
- error-list))))))))
+ (if (and (aref alt-expect idx)
+ (not (aref alt-fields idx)))
+ (push (cons beg-line
+ (format-message
+ "Alternative fields `%s' missing"
+ (aref alt-expect idx)))
+ error-list))))))))
(bibtex-progress-message 'done)))))
(if error-list
@@ -4508,7 +4733,7 @@ interactive calls."
(if (memq (preceding-char) '(?} ?\"))
(forward-char -1)))
(if help (bibtex-print-help-message (car bounds))))
- ((not noerror) (error "Not on BibTeX field")))))
+ ((not noerror) (user-error "Not on BibTeX field")))))
(defun bibtex-find-text-internal (&optional noerror subfield comma)
"Find text part of current BibTeX field or entry head.
@@ -4584,8 +4809,8 @@ Optional arg COMMA is as in `bibtex-enclosing-field'."
(cond ((not failure)
(list name start-text end-text end string-const))
((and no-sub (not noerror))
- (error "Not on text part of BibTeX field"))
- ((not noerror) (error "Not on BibTeX field"))))))
+ (user-error "Not on text part of BibTeX field"))
+ ((not noerror) (user-error "Not on BibTeX field"))))))
(defun bibtex-remove-OPT-or-ALT (&optional comma)
"Remove the string starting optional/alternative fields.
@@ -4723,7 +4948,7 @@ The sequence of kills wraps around, so that after the oldest one
comes the newest one."
(interactive "*p")
(unless (eq last-command 'bibtex-yank)
- (error "Previous command was not a BibTeX yank"))
+ (user-error "Previous command was not a BibTeX yank"))
(setq this-command 'bibtex-yank)
(let ((inhibit-read-only t) key)
;; point is at end of yanked entry
@@ -4781,12 +5006,12 @@ At end of the cleaning process, the functions in
(let ((case-fold-search t)
(start (bibtex-beginning-of-entry))
(_ (or (looking-at bibtex-any-entry-maybe-empty-head)
- (error "Not inside a BibTeX entry")))
+ (user-error "Not inside a BibTeX entry")))
(entry-type (bibtex-type-in-head))
(key (bibtex-key-in-head)))
(cond ((bibtex-string= entry-type "preamble")
;; (bibtex-format-preamble)
- (error "No clean up of @Preamble entries"))
+ (user-error "No clean up of @Preamble entries"))
((bibtex-string= entry-type "string")
(setq entry-type 'string))
;; (bibtex-format-string)
@@ -4836,11 +5061,11 @@ At end of the cleaning process, the functions in
(setq error (or (/= (point) start)
(bibtex-search-entry key nil end))))
(if error
- (error "New inserted entry yields duplicate key"))
+ (user-error "New inserted entry yields duplicate key"))
(dolist (buffer (bibtex-initialize))
(with-current-buffer buffer
(if (cdr (assoc-string key bibtex-reference-keys))
- (error "Duplicate key in %s" (buffer-file-name)))))
+ (user-error "Duplicate key in %s" (buffer-file-name)))))
;; Only update `bibtex-strings' and `bibtex-reference-keys'
;; if they have been built already.
@@ -5142,7 +5367,7 @@ entries from minibuffer."
bibtex-maintain-sorted-entries))
endpos)
(unless (bibtex-prepare-new-entry (list key nil "String"))
- (error "Entry with key `%s' already exists" key))
+ (user-error "Entry with key `%s' already exists" key))
(if (zerop (length key)) (setq key nil))
(indent-to-column bibtex-entry-offset)
(insert "@String"
diff --git a/lisp/textmodes/conf-mode.el b/lisp/textmodes/conf-mode.el
index 722fc0a3137..d88964aa4f0 100644
--- a/lisp/textmodes/conf-mode.el
+++ b/lisp/textmodes/conf-mode.el
@@ -1,6 +1,6 @@
;;; conf-mode.el --- Simple major mode for editing conf/ini/properties files -*- lexical-binding: t; -*-
-;; Copyright (C) 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;; Author: Daniel Pfeiffer <occitan@esperanto.org>
;; Keywords: conf ini windows java
diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el
index 747657b1ed5..9186e520086 100644
--- a/lisp/textmodes/css-mode.el
+++ b/lisp/textmodes/css-mode.el
@@ -1,6 +1,6 @@
;;; css-mode.el --- Major mode to edit CSS files -*- lexical-binding: t -*-
-;; Copyright (C) 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2021 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Maintainer: Simen Heggestøyl <simenheg@gmail.com>
diff --git a/lisp/textmodes/dns-mode.el b/lisp/textmodes/dns-mode.el
index 6dfea8f1887..23a622992ad 100644
--- a/lisp/textmodes/dns-mode.el
+++ b/lisp/textmodes/dns-mode.el
@@ -1,6 +1,6 @@
;;; dns-mode.el --- a mode for viewing/editing Domain Name System master files
-;; Copyright (C) 2000-2001, 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2001, 2004-2021 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
;; Keywords: DNS master zone file SOA comm
@@ -178,14 +178,13 @@ variables for customizing indentation. It has its own abbrev
table and its own syntax table.
Turning on DNS mode runs `dns-mode-hook'."
- (set (make-local-variable 'comment-start) ";")
- (set (make-local-variable 'comment-end) "")
- (set (make-local-variable 'comment-start-skip) ";+ *")
- (set (make-local-variable 'font-lock-defaults)
- '(dns-mode-font-lock-keywords nil nil ((?_ . "w"))))
+ (setq-local comment-start ";")
+ (setq-local comment-end "")
+ (setq-local comment-start-skip ";+ *")
+ (setq-local font-lock-defaults
+ '(dns-mode-font-lock-keywords nil nil ((?_ . "w"))))
(add-hook 'before-save-hook 'dns-mode-soa-maybe-increment-serial
- nil t)
- (easy-menu-add dns-mode-menu dns-mode-map))
+ nil t))
;;;###autoload (defalias 'zone-mode 'dns-mode)
diff --git a/lisp/textmodes/enriched.el b/lisp/textmodes/enriched.el
index 1656f3cb5fe..1aac96413e4 100644
--- a/lisp/textmodes/enriched.el
+++ b/lisp/textmodes/enriched.el
@@ -1,6 +1,6 @@
;;; enriched.el --- read and save files in text/enriched format
-;; Copyright (C) 1994-1996, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1996, 2001-2021 Free Software Foundation, Inc.
;; Author: Boris Goldowsky <boris@gnu.org>
;; Keywords: wp, faces
@@ -247,9 +247,8 @@ Commands:
(list 'buffer-display-table buffer-display-table
'default-text-properties default-text-properties
'use-hard-newlines use-hard-newlines))
- (make-local-variable 'enriched-default-text-properties-local-flag)
- (setq enriched-default-text-properties-local-flag
- (local-variable-p 'default-text-properties))
+ (setq-local enriched-default-text-properties-local-flag
+ (local-variable-p 'default-text-properties))
(make-local-variable 'default-text-properties)
(setq buffer-display-table enriched-display-table)
(use-hard-newlines 1 (if enriched-rerun-flag 'never nil))
diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el
index 15b13af5681..6681b03913c 100644
--- a/lisp/textmodes/fill.el
+++ b/lisp/textmodes/fill.el
@@ -1,6 +1,6 @@
-;;; fill.el --- fill commands for Emacs
+;;; fill.el --- fill commands for Emacs -*- lexical-binding: t; -*-
-;; Copyright (C) 1985-1986, 1992, 1994-1997, 1999, 2001-2020 Free
+;; Copyright (C) 1985-1986, 1992, 1994-1997, 1999, 2001-2021 Free
;; Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
@@ -40,13 +40,11 @@ Non-nil means changing indent doesn't end a paragraph.
That mode can handle paragraphs with extra indentation on the first line,
but it requires separator lines between paragraphs.
A value of nil means that any change in indentation starts a new paragraph."
- :type 'boolean
- :group 'fill)
+ :type 'boolean)
(defcustom colon-double-space nil
"Non-nil means put two spaces after a colon when filling."
- :type 'boolean
- :group 'fill)
+ :type 'boolean)
(put 'colon-double-space 'safe-local-variable 'booleanp)
(defcustom fill-separate-heterogeneous-words-with-space nil
@@ -56,7 +54,6 @@ the beginning of the next line when concatenating them for
filling those lines. Whether to use a space depends on how the
words are categorized."
:type 'boolean
- :group 'fill
:version "26.1")
(defvar fill-paragraph-function nil
@@ -75,8 +72,7 @@ such as `fill-forward-paragraph-function'.")
Kinsoku processing is designed to prevent certain characters from being
placed at the beginning or end of a line by filling.
See the documentation of `kinsoku' for more information."
- :type 'boolean
- :group 'fill)
+ :type 'boolean)
(defun set-fill-prefix ()
"Set the fill prefix to the current line up to point.
@@ -96,8 +92,7 @@ reinserts the fill prefix in each resulting line."
(defcustom adaptive-fill-mode t
"Non-nil means determine a paragraph's fill prefix from its text."
- :type 'boolean
- :group 'fill)
+ :type 'boolean)
(defcustom adaptive-fill-regexp
;; Added `!' for doxygen comments starting with `//!' or `/*!'.
@@ -113,8 +108,7 @@ standard indentation for the whole paragraph.
If the paragraph has just one line, the indentation is taken from that
line, but in that case `adaptive-fill-first-line-regexp' also plays
a role."
- :type 'regexp
- :group 'fill)
+ :type 'regexp)
(defcustom adaptive-fill-first-line-regexp (purecopy "\\`[ \t]*\\'")
"Regexp specifying whether to set fill prefix from a one-line paragraph.
@@ -126,15 +120,13 @@ By default, this regexp matches sequences of just spaces and tabs.
However, we never use a prefix from a one-line paragraph
if it would act as a paragraph-starter on the second line."
- :type 'regexp
- :group 'fill)
+ :type 'regexp)
(defcustom adaptive-fill-function #'ignore
"Function to call to choose a fill prefix for a paragraph.
A nil return value means the function has not determined the fill prefix."
:version "27.1"
- :type 'function
- :group 'fill)
+ :type 'function)
(defvar fill-indent-according-to-mode nil ;Screws up CC-mode's filling tricks.
"Whether or not filling should try to use the major mode's indentation.")
@@ -367,15 +359,13 @@ which is an error according to some typographical conventions."
The predicates are called with no arguments, with point at the place to
be tested. If it returns a non-nil value, fill commands do not break
the line there."
- :group 'fill
:type 'hook
:options '(fill-french-nobreak-p fill-single-word-nobreak-p
fill-single-char-nobreak-p))
(defcustom fill-nobreak-invisible nil
"Non-nil means that fill commands do not break lines in invisible text."
- :type 'boolean
- :group 'fill)
+ :type 'boolean)
(defun fill-nobreak-p ()
"Return nil if breaking the line at point is allowed.
@@ -753,9 +743,16 @@ space does not end a sentence, so don't break a line there."
;; This is the actual filling loop.
(goto-char from)
- (let (linebeg)
+ (let ((first t)
+ linebeg)
(while (< (point) to)
- (setq linebeg (point))
+ ;; On the first line, there may be text in the fill prefix
+ ;; zone. In that case, don't consider that area when
+ ;; trying to find a place to put a line break (bug#45720).
+ (if (not first)
+ (setq linebeg (point))
+ (setq first nil
+ linebeg (+ (point) (length fill-prefix))))
(move-to-column (current-fill-column))
(if (when (< (point) to)
;; Find the position where we'll break the line.
@@ -1110,8 +1107,7 @@ The `justification' text-property can locally override this variable."
(const full)
(const center)
(const none))
- :safe 'symbolp
- :group 'fill)
+ :safe 'symbolp)
(make-variable-buffer-local 'default-justification)
(defun current-justification ()
diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el
index 2757074f9f8..d8503168846 100644
--- a/lisp/textmodes/flyspell.el
+++ b/lisp/textmodes/flyspell.el
@@ -1,6 +1,6 @@
;;; flyspell.el --- On-the-fly spell checker -*- lexical-binding:t -*-
-;; Copyright (C) 1998, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2000-2021 Free Software Foundation, Inc.
;; Author: Manuel Serrano <Manuel.Serrano@sophia.inria.fr>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index 05a4bd058c4..8d49a7c54c8 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -1,6 +1,6 @@
;;; ispell.el --- interface to spell checkers -*- lexical-binding:t -*-
-;; Copyright (C) 1994-1995, 1997-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1995, 1997-2021 Free Software Foundation, Inc.
;; Author: Ken Stevens <k.stevens@ieee.org>
@@ -684,13 +684,9 @@ Otherwise returns the library directory name, if that is defined."
(with-temp-buffer
(setq status (ispell-call-process
ispell-program-name nil t nil
- ;; aspell doesn't accept the -vv switch.
(let ((case-fold-search
- (memq system-type '(ms-dos windows-nt)))
- (speller
- (file-name-nondirectory ispell-program-name)))
- ;; Assume anything that isn't `aspell' is Ispell.
- (if (string-match "\\`aspell" speller) "-v" "-vv"))))
+ (memq system-type '(ms-dos windows-nt))))
+ "-vv")))
(goto-char (point-min))
(if interactivep
;; Report version information of ispell
@@ -771,18 +767,23 @@ Otherwise returns the library directory name, if that is defined."
(setq ispell-really-hunspell nil))))))
result))
+(defmacro ispell-with-safe-default-directory (&rest body)
+ "Execute the forms in BODY with a reasonable
+`default-directory'."
+ (declare (indent 0) (debug t))
+ `(let ((default-directory default-directory))
+ (unless (file-accessible-directory-p default-directory)
+ (setq default-directory (expand-file-name "~/")))
+ ,@body))
+
(defun ispell-call-process (&rest args)
- "Like `call-process' but defend against bad `default-directory'."
- (let ((default-directory default-directory))
- (unless (file-accessible-directory-p default-directory)
- (setq default-directory (expand-file-name "~/")))
+ "Like `call-process', but defend against bad `default-directory'."
+ (ispell-with-safe-default-directory
(apply 'call-process args)))
(defun ispell-call-process-region (&rest args)
- "Like `call-process-region' but defend against bad `default-directory'."
- (let ((default-directory default-directory))
- (unless (file-accessible-directory-p default-directory)
- (setq default-directory (expand-file-name "~/")))
+ "Like `call-process-region', but defend against bad `default-directory'."
+ (ispell-with-safe-default-directory
(apply 'call-process-region args)))
(defvar ispell-debug-buffer)
@@ -1216,13 +1217,14 @@ Internal use.")
(defun ispell--call-enchant-lsmod (&rest args)
"Call enchant-lsmod with ARGS and return the output as string."
(with-output-to-string
- (with-current-buffer
- standard-output
+ (with-current-buffer standard-output
(apply #'ispell-call-process
(replace-regexp-in-string "enchant\\(-[0-9]\\)?\\'"
"enchant-lsmod\\1"
ispell-program-name)
- nil t nil args))))
+ ;; We discard stderr here because enchant-lsmod can emit
+ ;; unrelated warnings that will confuse us.
+ nil '(t nil) nil args))))
(defun ispell--get-extra-word-characters (&optional lang)
"Get the extra word characters for LANG as a character class.
@@ -2462,14 +2464,14 @@ SPC: Accept word this time.
(progn
(require 'ehelp)
(with-electric-help
- (function (lambda ()
- ;;This shouldn't be necessary: with-electric-help needs
- ;; an optional argument telling it about the smallest
- ;; acceptable window-height of the help buffer.
- ;;(if (< (window-height) 15)
- ;; (enlarge-window
- ;; (- 15 (ispell-adjusted-window-height))))
- (princ "Selections are:
+ (lambda ()
+ ;;This shouldn't be necessary: with-electric-help needs
+ ;; an optional argument telling it about the smallest
+ ;; acceptable window-height of the help buffer.
+ ;;(if (< (window-height) 15)
+ ;; (enlarge-window
+ ;; (- 15 (ispell-adjusted-window-height))))
+ (princ "Selections are:
DIGIT: Replace the word with a digit offered in the *Choices* buffer.
SPC: Accept word this time.
@@ -2489,7 +2491,7 @@ SPC: Accept word this time.
`C-l': Redraw screen.
`C-r': Recursive edit.
`C-z': Suspend Emacs or iconify frame.")
- nil))))
+ nil)))
(let ((help-1 (concat "[r/R]eplace word; [a/A]ccept for this session; "
@@ -3272,15 +3274,15 @@ otherwise, the current line is skipped."
Generated from `ispell-tex-skip-alists'."
(concat
;; raw tex keys
- (mapconcat (function (lambda (lst) (car lst)))
+ (mapconcat (lambda (lst) (car lst))
(car ispell-tex-skip-alists)
"\\|")
"\\|"
;; keys wrapped in begin{}
- (mapconcat (function (lambda (lst)
- (concat "\\\\begin[ \t\n]*{[ \t\n]*"
- (car lst)
- "[ \t\n]*}")))
+ (mapconcat (lambda (lst)
+ (concat "\\\\begin[ \t\n]*{[ \t\n]*"
+ (car lst)
+ "[ \t\n]*}"))
(car (cdr ispell-tex-skip-alists))
"\\|")))
@@ -3702,11 +3704,10 @@ Standard ispell choices are then available."
((string-equal (upcase word) word)
(setq possibilities (mapcar #'upcase possibilities)))
((eq (upcase (aref word 0)) (aref word 0))
- (setq possibilities (mapcar (function
- (lambda (pos)
- (if (eq (aref word 0) (aref pos 0))
- pos
- (capitalize pos))))
+ (setq possibilities (mapcar (lambda (pos)
+ (if (eq (aref word 0) (aref pos 0))
+ pos
+ (capitalize pos)))
possibilities))))
(setq case-fold-search case-fold-search-val)
(save-window-excursion
@@ -4097,7 +4098,7 @@ Includes LaTeX/Nroff modes and extended character mode."
(progn
(ispell-send-string "+\n") ; set ispell mode to tex
(if (not (eq ispell-parser 'tex))
- (set (make-local-variable 'ispell-parser) 'tex)))
+ (setq-local ispell-parser 'tex)))
(ispell-send-string "-\n")) ; set mode to normal (nroff)
;; If needed, test for SGML & HTML modes and set a buffer local nil/t value.
(if (and ispell-skip-html (not (eq ispell-skip-html t)))
diff --git a/lisp/textmodes/less-css-mode.el b/lisp/textmodes/less-css-mode.el
index 30974b99881..9cacc175ba9 100644
--- a/lisp/textmodes/less-css-mode.el
+++ b/lisp/textmodes/less-css-mode.el
@@ -1,6 +1,6 @@
;;; less-css-mode.el --- Major mode for editing Less CSS files -*- lexical-binding: t; -*-
-;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
;; Author: Steve Purcell <steve@sanityinc.com>
;; Maintainer: Simen Heggestøyl <simenheg@gmail.com>
diff --git a/lisp/textmodes/makeinfo.el b/lisp/textmodes/makeinfo.el
index f41ed876e5f..e48649bae37 100644
--- a/lisp/textmodes/makeinfo.el
+++ b/lisp/textmodes/makeinfo.el
@@ -1,6 +1,6 @@
;;; makeinfo.el --- run makeinfo conveniently
-;; Copyright (C) 1991, 1993, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1991, 1993, 2001-2021 Free Software Foundation, Inc.
;; Author: Robert J. Chassell
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/textmodes/mhtml-mode.el b/lisp/textmodes/mhtml-mode.el
index 329f3e7241d..32542d0400f 100644
--- a/lisp/textmodes/mhtml-mode.el
+++ b/lisp/textmodes/mhtml-mode.el
@@ -1,6 +1,6 @@
;;; mhtml-mode.el --- HTML editing mode that handles CSS and JS -*- lexical-binding:t -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; Keywords: wp, hypermedia, comm, languages
diff --git a/lisp/textmodes/nroff-mode.el b/lisp/textmodes/nroff-mode.el
index bb2582cf7a2..896578513cf 100644
--- a/lisp/textmodes/nroff-mode.el
+++ b/lisp/textmodes/nroff-mode.el
@@ -1,6 +1,6 @@
;;; nroff-mode.el --- GNU Emacs major mode for editing nroff source
-;; Copyright (C) 1985-1986, 1994-1995, 1997, 2001-2020 Free Software
+;; Copyright (C) 1985-1986, 1994-1995, 1997, 2001-2021 Free Software
;; Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
@@ -134,35 +134,32 @@
Turning on Nroff mode runs `text-mode-hook', then `nroff-mode-hook'.
Also, try `nroff-electric-mode', for automatically inserting
closing requests for requests that are used in matched pairs."
- (set (make-local-variable 'font-lock-defaults)
- ;; SYNTAX-BEGIN is set to backward-paragraph to avoid slow-down
- ;; near the end of large buffers due to searching to buffer's
- ;; beginning.
- '(nroff-font-lock-keywords nil t nil backward-paragraph))
- (set (make-local-variable 'outline-regexp) "\\.H[ ]+[1-7]+ ")
- (set (make-local-variable 'outline-level) 'nroff-outline-level)
+ (setq-local font-lock-defaults
+ ;; SYNTAX-BEGIN is set to backward-paragraph to avoid slow-down
+ ;; near the end of large buffers due to searching to buffer's
+ ;; beginning.
+ '(nroff-font-lock-keywords nil t nil backward-paragraph))
+ (setq-local outline-regexp "\\.H[ ]+[1-7]+ ")
+ (setq-local outline-level 'nroff-outline-level)
;; now define a bunch of variables for use by commands in this mode
- (set (make-local-variable 'page-delimiter) "^\\.\\(bp\\|SK\\|OP\\)")
- (set (make-local-variable 'paragraph-start)
- (concat "[.']\\|" paragraph-start))
- (set (make-local-variable 'paragraph-separate)
- (concat "[.']\\|" paragraph-separate))
+ (setq-local page-delimiter "^\\.\\(bp\\|SK\\|OP\\)")
+ (setq-local paragraph-start (concat "[.']\\|" paragraph-start))
+ (setq-local paragraph-separate (concat "[.']\\|" paragraph-separate))
;; Don't auto-fill directive lines starting . or ' since they normally
;; have to be one line. But do auto-fill comments .\" .\# and '''.
;; Comment directives (those starting . or ') are [.'][ \t]*\\[#"]
;; or ''', and this regexp is everything except those. So [.']
;; followed by not backslash and not ' or followed by backslash but
;; then not # or "
- (set (make-local-variable 'auto-fill-inhibit-regexp)
- "[.'][ \t]*\\([^ \t\\']\\|\\\\[^#\"]\\)")
+ (setq-local auto-fill-inhibit-regexp
+ "[.'][ \t]*\\([^ \t\\']\\|\\\\[^#\"]\\)")
;; comment syntax added by mit-erl!gildea 18 Apr 86
- (set (make-local-variable 'comment-start) "\\\" ")
- (set (make-local-variable 'comment-start-skip) "\\\\[\"#][ \t]*")
- (set (make-local-variable 'comment-column) 24)
- (set (make-local-variable 'comment-indent-function) 'nroff-comment-indent)
- (set (make-local-variable 'comment-insert-comment-function)
- 'nroff-insert-comment-function)
- (set (make-local-variable 'imenu-generic-expression) nroff-imenu-expression))
+ (setq-local comment-start "\\\" ")
+ (setq-local comment-start-skip "\\\\[\"#][ \t]*")
+ (setq-local comment-column 24)
+ (setq-local comment-indent-function #'nroff-comment-indent)
+ (setq-local comment-insert-comment-function #'nroff-insert-comment-function)
+ (setq-local imenu-generic-expression nroff-imenu-expression))
(defun nroff-outline-level ()
(save-excursion
diff --git a/lisp/textmodes/page-ext.el b/lisp/textmodes/page-ext.el
index c2b7b66b9f7..c3e1fb14bc3 100644
--- a/lisp/textmodes/page-ext.el
+++ b/lisp/textmodes/page-ext.el
@@ -1,6 +1,6 @@
;;; page-ext.el --- extended page handling commands -*- lexical-binding:t -*-
-;; Copyright (C) 1990-1991, 1993-1994, 2001-2020 Free Software
+;; Copyright (C) 1990-1991, 1993-1994, 2001-2021 Free Software
;; Foundation, Inc.
;; Author: Robert J. Chassell <bob@gnu.org>
@@ -429,20 +429,19 @@ REVERSE (non-nil means reverse order), BEG and END (region to sort)."
;; NEXTRECFUN is called with point at the end of the
;; previous record. It moves point to the start of the
;; next record.
- (function (lambda ()
- (re-search-forward page-delimiter nil t)
- (skip-chars-forward " \t\n")
- ))
+ (lambda ()
+ (re-search-forward page-delimiter nil t)
+ (skip-chars-forward " \t\n"))
;; ENDRECFUN is called with point within the record.
;; It should move point to the end of the record.
- (function (lambda ()
- (if (re-search-forward
- page-delimiter
- nil
- t)
- (goto-char (match-beginning 0))
- (goto-char (point-max))))))))
+ (lambda ()
+ (if (re-search-forward
+ page-delimiter
+ nil
+ t)
+ (goto-char (match-beginning 0))
+ (goto-char (point-max)))))))
(define-obsolete-function-alias 'sort-pages-buffer #'pages-sort-buffer "27.1")
(defun pages-sort-buffer (&optional reverse)
diff --git a/lisp/textmodes/page.el b/lisp/textmodes/page.el
index 029ba966912..e1d7fb7431c 100644
--- a/lisp/textmodes/page.el
+++ b/lisp/textmodes/page.el
@@ -1,6 +1,6 @@
;;; page.el --- page motion commands for Emacs -*- lexical-binding: t; -*-
-;; Copyright (C) 1985, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 2001-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: wp convenience
diff --git a/lisp/textmodes/paragraphs.el b/lisp/textmodes/paragraphs.el
index b0975291428..96edfd6de36 100644
--- a/lisp/textmodes/paragraphs.el
+++ b/lisp/textmodes/paragraphs.el
@@ -1,6 +1,6 @@
;;; paragraphs.el --- paragraph and sentence parsing -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1987, 1991, 1994-1997, 1999-2020 Free Software
+;; Copyright (C) 1985-1987, 1991, 1994-1997, 1999-2021 Free Software
;; Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
@@ -371,50 +371,33 @@ See `forward-paragraph' for more information."
(defun mark-paragraph (&optional arg allow-extend)
"Put point at beginning of this paragraph, mark at end.
-The paragraph marked is the one that contains point or follows
-point.
+The paragraph marked is the one that contains point or follows point.
-With argument ARG, puts mark at the end of this or a following
-paragraph, so that the number of paragraphs marked equals ARG.
+With argument ARG, puts mark at end of a following paragraph, so that
+the number of paragraphs marked equals ARG.
-If ARG is negative, point is put at the end of this paragraph,
-mark is put at the beginning of this or a previous paragraph.
+If ARG is negative, point is put at end of this paragraph, mark is put
+at beginning of this or a previous paragraph.
Interactively (or if ALLOW-EXTEND is non-nil), if this command is
-repeated or (in Transient Mark mode) if the mark is active, it
-marks the next ARG paragraphs after the region already marked.
-This also means when activating the mark immediately before using
-this command, the current paragraph is only marked from point."
- (interactive "P\np")
- (let ((numeric-arg (prefix-numeric-value arg)))
- (cond ((zerop numeric-arg))
- ((and allow-extend
- (or (and (eq last-command this-command) mark-active)
- (region-active-p)))
- (if arg
- (setq arg numeric-arg)
- (if (< (mark) (point))
- (setq arg -1)
- (setq arg 1)))
- (set-mark
- (save-excursion
- (goto-char (mark))
- (forward-paragraph arg)
- (point))))
- ;; don't activate the mark when at eob
- ((and (eobp) (> numeric-arg 0)))
- (t
- (unless (save-excursion
- (forward-line 0)
- (looking-at paragraph-start))
- (backward-paragraph (cond ((> numeric-arg 0) 1)
- ((< numeric-arg 0) -1)
- (t 0))))
- (push-mark
- (save-excursion
- (forward-paragraph numeric-arg)
- (point))
- t t)))))
+repeated or (in Transient Mark mode) if the mark is active,
+it marks the next ARG paragraphs after the ones already marked."
+ (interactive "p\np")
+ (unless arg (setq arg 1))
+ (when (zerop arg)
+ (error "Cannot mark zero paragraphs"))
+ (cond ((and allow-extend
+ (or (and (eq last-command this-command) (mark t))
+ (and transient-mark-mode mark-active)))
+ (set-mark
+ (save-excursion
+ (goto-char (mark))
+ (forward-paragraph arg)
+ (point))))
+ (t
+ (forward-paragraph arg)
+ (push-mark nil t t)
+ (backward-paragraph arg))))
(defun kill-paragraph (arg)
"Kill forward to end of paragraph.
diff --git a/lisp/textmodes/picture.el b/lisp/textmodes/picture.el
index 5216812b587..3cb1043545a 100644
--- a/lisp/textmodes/picture.el
+++ b/lisp/textmodes/picture.el
@@ -1,6 +1,6 @@
;;; picture.el --- "Picture mode" -- editing using quarter-plane screen model -*- lexical-binding: t -*-
-;; Copyright (C) 1985, 1994, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1994, 2001-2021 Free Software Foundation, Inc.
;; Author: K. Shane Hartman
;; Maintainer: emacs-devel@gnu.org
@@ -764,18 +764,17 @@ they are not by default assigned to keys."
(interactive)
(if (eq major-mode 'picture-mode)
(error "You are already editing a picture")
- (set (make-local-variable 'picture-mode-old-local-map) (current-local-map))
+ (setq-local picture-mode-old-local-map (current-local-map))
(use-local-map picture-mode-map)
- (set (make-local-variable 'picture-mode-old-mode-name) mode-name)
- (set (make-local-variable 'picture-mode-old-major-mode) major-mode)
+ (setq-local picture-mode-old-mode-name mode-name)
+ (setq-local picture-mode-old-major-mode major-mode)
(setq major-mode 'picture-mode)
- (set (make-local-variable 'picture-killed-rectangle) nil)
- (set (make-local-variable 'tab-stop-list) (default-value 'tab-stop-list))
- (set (make-local-variable 'picture-tab-chars)
- (default-value 'picture-tab-chars))
+ (setq-local picture-killed-rectangle nil)
+ (setq-local tab-stop-list (default-value 'tab-stop-list))
+ (setq-local picture-tab-chars (default-value 'picture-tab-chars))
(make-local-variable 'picture-vertical-step)
(make-local-variable 'picture-horizontal-step)
- (set (make-local-variable 'picture-mode-old-truncate-lines) truncate-lines)
+ (setq-local picture-mode-old-truncate-lines truncate-lines)
(setq truncate-lines t)
(picture-set-motion 0 1)
diff --git a/lisp/textmodes/po.el b/lisp/textmodes/po.el
index 29c6d3f4608..1066e93af10 100644
--- a/lisp/textmodes/po.el
+++ b/lisp/textmodes/po.el
@@ -1,6 +1,6 @@
;;; po.el --- basic support of PO translation files -*- lexical-binding:t -*-
-;; Copyright (C) 1995-1998, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995-1998, 2000-2021 Free Software Foundation, Inc.
;; Authors: François Pinard <pinard@iro.umontreal.ca>,
;; Greg McGary <gkm@magilla.cichlid.com>,
diff --git a/lisp/textmodes/refbib.el b/lisp/textmodes/refbib.el
index a1df483801e..bff57128c51 100644
--- a/lisp/textmodes/refbib.el
+++ b/lisp/textmodes/refbib.el
@@ -1,6 +1,6 @@
;;; refbib.el --- convert refer-style references to ones usable by Latex bib
-;; Copyright (C) 1989, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1989, 2001-2021 Free Software Foundation, Inc.
;; Author: Henry Kautz <kautz@research.att.com>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/textmodes/refer.el b/lisp/textmodes/refer.el
index c8fd0bea004..ae1f7781686 100644
--- a/lisp/textmodes/refer.el
+++ b/lisp/textmodes/refer.el
@@ -1,6 +1,6 @@
;;; refer.el --- look up references in bibliography files
-;; Copyright (C) 1992, 1996, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 1996, 2001-2021 Free Software Foundation, Inc.
;; Author: Ashwin Ram <ashwin@cc.gatech.edu>
;; Maintainer: emacs-devel@gnu.org
@@ -249,9 +249,9 @@ found on the last `refer-find-entry' or `refer-find-next-entry'."
(forward-paragraph 1)
(setq end (point))
(setq found
- (refer-every (function (lambda (keyword)
- (goto-char begin)
- (re-search-forward keyword end t)))
+ (refer-every (lambda (keyword)
+ (goto-char begin)
+ (re-search-forward keyword end t))
keywords-list))
(if (not found)
(progn
diff --git a/lisp/textmodes/refill.el b/lisp/textmodes/refill.el
index a83e6b37583..6edd9aeb7ef 100644
--- a/lisp/textmodes/refill.el
+++ b/lisp/textmodes/refill.el
@@ -1,6 +1,6 @@
;;; refill.el --- `auto-fill' by refilling paragraphs on changes
-;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Maintainer: Miles Bader <miles@gnu.org>
@@ -237,16 +237,14 @@ For true \"word wrap\" behavior, use `visual-line-mode' instead."
(add-hook 'after-change-functions 'refill-after-change-function nil t)
(add-hook 'post-command-hook 'refill-post-command-function nil t)
(add-hook 'pre-command-hook 'refill-pre-command-function nil t)
- (set (make-local-variable 'refill-saved-state)
- (mapcar (lambda (s) (cons s (symbol-value s)))
- '(fill-paragraph-function auto-fill-function)))
+ (setq-local refill-saved-state
+ (mapcar (lambda (s) (cons s (symbol-value s)))
+ '(fill-paragraph-function auto-fill-function)))
;; This provides the test for recursive paragraph filling.
- (set (make-local-variable 'fill-paragraph-function)
- 'refill-fill-paragraph)
+ (setq-local fill-paragraph-function #'refill-fill-paragraph)
;; When using justification, doing DEL on 2 spaces should remove
;; both, otherwise, the subsequent refill will undo the DEL.
- (set (make-local-variable 'backward-delete-char-untabify-method)
- 'hungry)
+ (setq-local backward-delete-char-untabify-method 'hungry)
(setq refill-ignorable-overlay (make-overlay 1 1 nil nil t))
(overlay-put refill-ignorable-overlay 'modification-hooks
'(refill-adjust-ignorable-overlay))
diff --git a/lisp/textmodes/reftex-auc.el b/lisp/textmodes/reftex-auc.el
index de6d5338004..ae3faec4fdc 100644
--- a/lisp/textmodes/reftex-auc.el
+++ b/lisp/textmodes/reftex-auc.el
@@ -1,6 +1,6 @@
;;; reftex-auc.el --- RefTeX's interface to AUCTeX
-;; Copyright (C) 1997-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <dominik@science.uva.nl>
;; Maintainer: auctex-devel@gnu.org
diff --git a/lisp/textmodes/reftex-cite.el b/lisp/textmodes/reftex-cite.el
index 49e5b28f6a4..5579e401790 100644
--- a/lisp/textmodes/reftex-cite.el
+++ b/lisp/textmodes/reftex-cite.el
@@ -1,6 +1,6 @@
;;; reftex-cite.el --- creating citations with RefTeX
-;; Copyright (C) 1997-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <dominik@science.uva.nl>
;; Maintainer: auctex-devel@gnu.org
diff --git a/lisp/textmodes/reftex-dcr.el b/lisp/textmodes/reftex-dcr.el
index 8b2569a352d..e517cea2669 100644
--- a/lisp/textmodes/reftex-dcr.el
+++ b/lisp/textmodes/reftex-dcr.el
@@ -1,6 +1,6 @@
;;; reftex-dcr.el --- viewing cross references and citations with RefTeX
-;; Copyright (C) 1997-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <dominik@science.uva.nl>
;; Maintainer: auctex-devel@gnu.org
diff --git a/lisp/textmodes/reftex-global.el b/lisp/textmodes/reftex-global.el
index a4e8c9ffd33..4d021609019 100644
--- a/lisp/textmodes/reftex-global.el
+++ b/lisp/textmodes/reftex-global.el
@@ -1,6 +1,6 @@
;;; reftex-global.el --- operations on entire documents with RefTeX
-;; Copyright (C) 1997-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <dominik@science.uva.nl>
;; Maintainer: auctex-devel@gnu.org
diff --git a/lisp/textmodes/reftex-index.el b/lisp/textmodes/reftex-index.el
index a1e30269d29..5049ffb64b1 100644
--- a/lisp/textmodes/reftex-index.el
+++ b/lisp/textmodes/reftex-index.el
@@ -1,6 +1,6 @@
;;; reftex-index.el --- index support with RefTeX
-;; Copyright (C) 1997-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <dominik@science.uva.nl>
;; Maintainer: auctex-devel@gnu.org
@@ -408,7 +408,8 @@ Here are all local bindings.
(make-local-hook 'post-command-hook)
(make-local-hook 'pre-command-hook))
(make-local-variable 'reftex-last-follow-point)
- (easy-menu-add reftex-index-menu reftex-index-mode-map)
+ (when (featurep 'xemacs)
+ (easy-menu-add reftex-index-menu reftex-index-mode-map))
(add-hook 'post-command-hook 'reftex-index-post-command-hook nil t)
(add-hook 'pre-command-hook 'reftex-index-pre-command-hook nil t))
@@ -1386,7 +1387,8 @@ Here are all local bindings.
:syntax-table reftex-index-phrases-syntax-table
(set (make-local-variable 'font-lock-defaults)
reftex-index-phrases-font-lock-defaults)
- (easy-menu-add reftex-index-phrases-menu reftex-index-phrases-mode-map)
+ (when (featurep 'xemacs)
+ (easy-menu-add reftex-index-phrases-menu reftex-index-phrases-mode-map))
(set (make-local-variable 'reftex-index-phrases-marker) (make-marker)))
;; (add-hook 'reftex-index-phrases-mode-hook 'turn-on-font-lock)
diff --git a/lisp/textmodes/reftex-parse.el b/lisp/textmodes/reftex-parse.el
index 4f4afe9d2c6..98c61f56b48 100644
--- a/lisp/textmodes/reftex-parse.el
+++ b/lisp/textmodes/reftex-parse.el
@@ -1,6 +1,6 @@
;;; reftex-parse.el --- parser functions for RefTeX
-;; Copyright (C) 1997-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <dominik@science.uva.nl>
;; Maintainer: auctex-devel@gnu.org
@@ -1046,7 +1046,7 @@ When point is just after a { or [, limit string to matching parenthesis."
;;;###autoload
(defun reftex-init-section-numbers (&optional toc-entry appendix)
- "Initialize the section numbers with zeros or with what is found in the TOC-ENTRY."
+ "Initialize section numbers with zeros or with what is found in the TOC-ENTRY."
(let* ((level (or (nth 5 toc-entry) -1))
(numbers (nreverse (split-string (or (nth 6 toc-entry) "") "\\.")))
(depth (1- (length reftex-section-numbers)))
diff --git a/lisp/textmodes/reftex-ref.el b/lisp/textmodes/reftex-ref.el
index 4c780d8d8c3..439c02f8089 100644
--- a/lisp/textmodes/reftex-ref.el
+++ b/lisp/textmodes/reftex-ref.el
@@ -1,6 +1,6 @@
;;; reftex-ref.el --- code to create labels and references with RefTeX
-;; Copyright (C) 1997-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <dominik@science.uva.nl>
;; Maintainer: auctex-devel@gnu.org
diff --git a/lisp/textmodes/reftex-sel.el b/lisp/textmodes/reftex-sel.el
index 137a912cb60..d2e9974499b 100644
--- a/lisp/textmodes/reftex-sel.el
+++ b/lisp/textmodes/reftex-sel.el
@@ -1,6 +1,6 @@
;;; reftex-sel.el --- the selection modes for RefTeX
-;; Copyright (C) 1997-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <dominik@science.uva.nl>
;; Maintainer: auctex-devel@gnu.org
diff --git a/lisp/textmodes/reftex-toc.el b/lisp/textmodes/reftex-toc.el
index 02e7e3a8f12..3b9f970a3d2 100644
--- a/lisp/textmodes/reftex-toc.el
+++ b/lisp/textmodes/reftex-toc.el
@@ -1,6 +1,6 @@
;;; reftex-toc.el --- RefTeX's table of contents mode
-;; Copyright (C) 1997-2000, 2003-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2000, 2003-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <dominik@science.uva.nl>
;; Maintainer: auctex-devel@gnu.org
@@ -153,7 +153,8 @@ Here are all local bindings.
(make-local-variable 'reftex-last-follow-point)
(add-hook 'post-command-hook 'reftex-toc-post-command-hook nil t)
(add-hook 'pre-command-hook 'reftex-toc-pre-command-hook nil t)
- (easy-menu-add reftex-toc-menu reftex-toc-mode-map))
+ (when (featurep 'xemacs)
+ (easy-menu-add reftex-toc-menu reftex-toc-mode-map)))
(defvar reftex-last-toc-file nil
"Stores the file name from which `reftex-toc' was called. For redo command.")
@@ -850,7 +851,8 @@ if these sets are sorted blocks in the alist."
"Make sure all files of the document are being visited by buffers,
and that the scanning info is absolutely up to date.
We do this by rescanning with `reftex-keep-temporary-buffers' bound to t.
-The variable `reftex--pro-or-de' is assumed to be dynamically scoped into this function.
+The variable `reftex--pro-or-de' is assumed to be dynamically
+scoped into this function.
When finished, we exit with an error message."
(let ((reftex-keep-temporary-buffers t))
(reftex-toc-Rescan)
diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el
index c9fd19d2324..1b29eafabf7 100644
--- a/lisp/textmodes/reftex-vars.el
+++ b/lisp/textmodes/reftex-vars.el
@@ -1,6 +1,6 @@
;;; reftex-vars.el --- configuration variables for RefTeX
-;; Copyright (C) 1997-1999, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1999, 2001-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <dominik@science.uva.nl>
;; Maintainer: auctex-devel@gnu.org
@@ -741,8 +741,8 @@ The function must take an argument BOUND. If non-nil, BOUND is a
boundary for backwards searches which should be observed.
Here is an example. The LaTeX package linguex.sty defines list macros
-`\\ex.', `\\a.', etc for lists which are terminated by `\\z.' or an empty
-line.
+`\\ex.', `\\a.', etc for lists which are terminated by `\\z.' or an
+empty line.
\\ex. \\label{ex:12} Some text in an exotic language ...
\\a. \\label{ex:13} more stuff
@@ -766,10 +766,12 @@ And here is the setup for RefTeX:
(save-excursion
;; Search for any of the linguex item macros at the beginning of a line
(if (re-search-backward
- \"^[ \\t]*\\\\(\\\\\\\\\\\\(ex\\\\|a\\\\|b\\\\|c\\\\|d\\\\|e\\\\|f\\\\)g?\\\\.\\\\)\" bound t)
+ (concat \"^[ \\t]*\\\\(\\\\\\\\\\\\(ex\\\\|a\\\\|\"
+ \"b\\\\|c\\\\|d\\\\|e\\\\|f\\\\)g?\\\\.\\\\)\")
+ bound t)
(progn
(setq p1 (match-beginning 1))
- ;; Make sure no empty line or \\z. is between us and the item macro
+ ;; Make sure no empty line or \\z. is between us and item macro
(if (re-search-forward \"\\n[ \\t]*\\n\\\\|\\\\\\\\z\\\\.\" pos t)
;; Return nil because list was already closed
nil
@@ -898,13 +900,14 @@ DOWNCASE t: Downcase words before using them."
,(concat
;; Make sure we search only for optional arguments of
;; environments/macros and don't match any other [. ctable
- ;; provides a macro called \ctable, listings/breqn have
+ ;; provides a macro called \ctable, beamer/breqn/listings have
;; environments. Start with a backslash and a group for names
"\\\\\\(?:"
;; begin, optional spaces and opening brace
"begin[[:space:]]*{"
;; Build a regexp for env names
- (regexp-opt '("lstlisting" "dmath" "dseries" "dgroup" "darray"))
+ (regexp-opt '("lstlisting" "dmath" "dseries" "dgroup"
+ "darray" "frame"))
;; closing brace, optional spaces
"}[[:space:]]*"
;; Now for macros
@@ -917,9 +920,9 @@ DOWNCASE t: Downcase words before using them."
"\\[[^][]*"
;; Allow nested levels of chars enclosed in braces
"\\(?:{[^}{]*"
- "\\(?:{[^}{]*"
- "\\(?:{[^}{]*}[^}{]*\\)*"
- "}[^}{]*\\)*"
+ "\\(?:{[^}{]*"
+ "\\(?:{[^}{]*}[^}{]*\\)*"
+ "}[^}{]*\\)*"
"}[^][]*\\)*"
;; Match the label key
"\\<label[[:space:]]*=[[:space:]]*"
@@ -933,8 +936,9 @@ The default value matches usual \\label{...} definitions and
keyval style [..., label = {...}, ...] label definitions. The
regexp for keyval style explicitly looks for environments
provided by the packages \"listings\" (\"lstlisting\"),
-\"breqn\" (\"dmath\", \"dseries\", \"dgroup\", \"darray\") and
-the macro \"\\ctable\" provided by the package of the same name.
+\"beamer\" (\"frame\"), \"breqn\" (\"dmath\", \"dseries\",
+\"dgroup\", \"darray\") and the macro \"\\ctable\" provided by
+the package of the same name.
It is assumed that the regexp group 1 matches the label text, so
you have to define it using \\(?1:...\\) when adding new regexps.
@@ -942,7 +946,7 @@ you have to define it using \\(?1:...\\) when adding new regexps.
When changed from Lisp, make sure to call
`reftex-compile-variables' afterwards to make the change
effective."
- :version "27.1"
+ :version "28.1"
:set (lambda (symbol value)
(set symbol value)
(when (fboundp 'reftex-compile-variables)
diff --git a/lisp/textmodes/reftex.el b/lisp/textmodes/reftex.el
index 4071c0dd074..be9b23677cb 100644
--- a/lisp/textmodes/reftex.el
+++ b/lisp/textmodes/reftex.el
@@ -1,5 +1,5 @@
;;; reftex.el --- minor mode for doing \label, \ref, \cite, \index in LaTeX
-;; Copyright (C) 1997-2000, 2003-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2000, 2003-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <dominik@science.uva.nl>
;; Maintainer: auctex-devel@gnu.org
@@ -51,10 +51,6 @@
;;; Code:
(eval-when-compile (require 'cl-lib))
-
-;; Stuff that needs to be there when we use defcustom
-(require 'custom)
-
(require 'easymenu)
(defvar reftex-tables-dirty t
@@ -207,7 +203,8 @@ on the menu bar.
(if reftex-mode
(progn
;; Mode was turned on
- (easy-menu-add reftex-mode-menu)
+ (when (featurep 'xemacs)
+ (easy-menu-add reftex-mode-menu))
(and reftex-plug-into-AUCTeX
(reftex-plug-into-AUCTeX))
(unless (get 'reftex-auto-view-crossref 'initialized)
@@ -224,7 +221,8 @@ on the menu bar.
(run-hooks 'reftex-mode-hook))
;; Mode was turned off
- (easy-menu-remove reftex-mode-menu)))
+ (when (featurep 'xemacs)
+ (easy-menu-remove reftex-mode-menu))))
(defvar reftex-docstruct-symbol)
(defun reftex-kill-buffer-hook ()
diff --git a/lisp/textmodes/remember.el b/lisp/textmodes/remember.el
index 7bc7dc1762e..98d3a3856ea 100644
--- a/lisp/textmodes/remember.el
+++ b/lisp/textmodes/remember.el
@@ -1,6 +1,6 @@
;;; remember --- a mode for quickly jotting down things to remember
-;; Copyright (C) 1999-2001, 2003-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2001, 2003-2021 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
;; Maintainer: emacs-devel@gnu.org
@@ -638,9 +638,14 @@ to turn the *scratch* buffer into your notes buffer."
(interactive "p")
(let ((buf (or (find-buffer-visiting remember-data-file)
(with-current-buffer (find-file-noselect remember-data-file)
- (and remember-notes-buffer-name
- (not (get-buffer remember-notes-buffer-name))
- (rename-buffer remember-notes-buffer-name))
+ (when remember-notes-buffer-name
+ (when (and (get-buffer remember-notes-buffer-name)
+ (equal remember-notes-buffer-name "*scratch*"))
+ (kill-buffer remember-notes-buffer-name))
+ ;; Rename the buffer to the requested name (if
+ ;; it's not already in use).
+ (unless (get-buffer remember-notes-buffer-name)
+ (rename-buffer remember-notes-buffer-name)))
(funcall (or remember-notes-initial-major-mode
initial-major-mode))
(remember-notes-mode 1)
diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el
index adda28cb81b..18341716e3a 100644
--- a/lisp/textmodes/rst.el
+++ b/lisp/textmodes/rst.el
@@ -1,6 +1,6 @@
;;; rst.el --- Mode for viewing and editing reStructuredText-documents -*- lexical-binding: t -*-
-;; Copyright (C) 2003-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
;; Maintainer: Stefan Merten <stefan at merten-home dot de>
;; Author: Stefan Merten <stefan at merten-home dot de>,
@@ -568,9 +568,7 @@ After interpretation of ARGS the results are concatenated as for
(regexp-quote (char-to-string re)))
((listp re)
(let ((nested
- (mapcar (lambda (elt)
- (rst-re elt))
- (cdr re))))
+ (mapcar #'rst-re (cdr re))))
(cond
((eq (car re) :seq)
(mapconcat #'identity nested ""))
@@ -1302,7 +1300,8 @@ This inherits from Text mode.")
(modify-syntax-entry ?% "." st)
(modify-syntax-entry ?& "." st)
(modify-syntax-entry ?' "." st)
- (modify-syntax-entry ?* "." st)
+ (modify-syntax-entry ?` "\"` " st)
+ (modify-syntax-entry ?* "\"* " st)
(modify-syntax-entry ?+ "." st)
(modify-syntax-entry ?- "." st)
(modify-syntax-entry ?/ "." st)
@@ -1330,7 +1329,6 @@ The hook for `text-mode' is run before this one."
;; Pull in variable definitions silencing byte-compiler.
(require 'newcomment)
-(defvar electric-pair-pairs)
(defvar electric-indent-inhibit)
;; Use rst-mode for *.rst and *.rest files. Many ReStructured-Text files
@@ -1387,8 +1385,6 @@ highlighting.
(setq-local comment-region-function #'rst-comment-region)
(setq-local uncomment-region-function #'rst-uncomment-region)
- (setq-local electric-pair-pairs '((?\" . ?\") (?\* . ?\*) (?\` . ?\`)))
-
;; Imenu and which function.
;; FIXME: Check documentation of `which-function' for alternative ways to
;; determine the current function name.
@@ -1400,7 +1396,8 @@ highlighting.
t nil nil nil
(font-lock-multiline . t)
(font-lock-mark-block-function . mark-paragraph)))
- (add-hook 'font-lock-extend-region-functions #'rst-font-lock-extend-region t)
+ (add-hook 'font-lock-extend-region-functions
+ #'rst-font-lock-extend-region nil t)
;; Text after a changed line may need new fontification.
(setq-local jit-lock-contextually t)
@@ -3578,8 +3575,6 @@ Region is from BEG to END. With WITH-EMPTY prefix empty lines too."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Font lock
-(require 'font-lock)
-
;; FIXME: The obsolete variables need to disappear.
;; The following versions have been done inside Emacs and should not be
diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el
index f3d8695e248..8465e82b02a 100644
--- a/lisp/textmodes/sgml-mode.el
+++ b/lisp/textmodes/sgml-mode.el
@@ -1,6 +1,6 @@
;;; sgml-mode.el --- SGML- and HTML-editing modes -*- lexical-binding:t -*-
-;; Copyright (C) 1992, 1995-1996, 1998, 2001-2020 Free Software
+;; Copyright (C) 1992, 1995-1996, 1998, 2001-2021 Free Software
;; Foundation, Inc.
;; Author: James Clark <jjc@jclark.com>
@@ -2364,8 +2364,8 @@ have <h1>Very Major Headlines</h1> through <h6>Very Minor Headlines</h6>
<p>Paragraphs only need an opening tag. Line breaks and multiple spaces are
ignored unless the text is <pre>preformatted.</pre> Text can be marked as
-<strong>bold</strong>, <em>italic</em> or <u>underlined</u> using the normal M-o or
-Edit/Text Properties/Face commands.
+<strong>bold</strong>, <em>italic</em> or <u>underlined</u> using the normal M-o
+or Edit/Text Properties/Face commands.
Pages can have <a name=\"SOMENAME\">named points</a> and can link other points
to them with <a href=\"#SOMENAME\">see also somename</a>. In the same way <a
diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el
index 25aa58046f4..071684d3c4d 100644
--- a/lisp/textmodes/table.el
+++ b/lisp/textmodes/table.el
@@ -1,6 +1,6 @@
;;; table.el --- create and edit WYSIWYG text based embedded tables -*- lexical-binding: t -*-
-;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;; Keywords: wp, convenience
;; Author: Takaaki Ota <Takaaki.Ota@am.sony.com>
@@ -620,13 +620,6 @@
(defvar flyspell-mode)
(defvar real-last-command)
(defvar delete-selection-mode)
-;; This is evil!!
-;; (eval-when-compile
-;; (unless (fboundp 'set-face-property)
-;; (defun set-face-property (face prop value)))
-;; (unless (fboundp 'unibyte-char-to-multibyte)
-;; (defun unibyte-char-to-multibyte (char)))
-;; (defun table--point-in-cell-p (&optional location)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
@@ -811,13 +804,6 @@ simply by any key input."
(setplist 'table-disable-incompatibility-warning nil)
-(defvar table-disable-menu (null (and (locate-library "easymenu")
- (require 'easymenu)
- (fboundp 'easy-menu-add-item)))
- "When non-nil, use of menu by table package is disabled.
-It must be set before loading this package `table.el' for the first
-time.")
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
@@ -867,10 +853,12 @@ time.")
"Timer id for deferred cell update.")
(defvar table-inhibit-update nil
"Non-nil inhibits implicit cell and cache updates.
-It inhibits `table-with-cache-buffer' to update data in both direction, cell to cache and cache to cell.")
+It inhibits `table-with-cache-buffer' to update data in both directions,
+cell to cache and cache to cell.")
(defvar table-inhibit-auto-fill-paragraph nil
"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.")
+This is always set to nil at the entry to `table-with-cache-buffer' before
+executing body forms.")
(defvar table-mode-indicator nil
"For mode line indicator")
;; This is not a real minor-mode but placed in the minor-mode-alist
@@ -971,7 +959,7 @@ This is always set to nil at the entry to `table-with-cache-buffer' before execu
(describe-bindings . *table--cell-describe-bindings)
(dabbrev-expand . *table--cell-dabbrev-expand)
(dabbrev-completion . *table--cell-dabbrev-completion))
- "List of cons cells consisting of (ORIGINAL-COMMAND . TABLE-VERSION-OF-THE-COMMAND).")
+ "List of the form (ORIGINAL-COMMAND . TABLE-VERSION-OF-THE-COMMAND).")
(defvar table-command-list
;; Construct the real contents of the `table-command-list'.
@@ -1202,12 +1190,11 @@ This is always set to nil at the entry to `table-with-cache-buffer' before execu
))
;; register table menu under global tools menu
-(unless table-disable-menu
- (easy-menu-define table-global-menu-map nil
- "Table global menu" table-global-menu)
- (easy-menu-add-item (current-global-map) '("menu-bar" "tools") "--")
- (easy-menu-add-item (current-global-map)
- '("menu-bar" "tools") table-global-menu-map))
+(easy-menu-define table-global-menu-map nil
+ "Table global menu" table-global-menu)
+(easy-menu-add-item (current-global-map) '("menu-bar" "tools") "--")
+(easy-menu-add-item (current-global-map)
+ '("menu-bar" "tools") table-global-menu-map)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
@@ -1287,12 +1274,8 @@ the last cache point coordinate."
;; set up the update timer unless it is explicitly inhibited.
(unless table-inhibit-update
(table--update-cell)))))
-(if (null (fboundp 'font-lock-add-keywords))
- nil
- ;; Color it as a keyword.
- (font-lock-add-keywords
- 'emacs-lisp-mode
- '("\\<table-with-cache-buffer\\>")))
+;; Color it as a keyword.
+(font-lock-add-keywords 'emacs-lisp-mode '("\\<table-with-cache-buffer\\>"))
(defmacro table-put-source-info (prop value)
"Register source generation information."
@@ -1975,7 +1958,7 @@ is negative the cell becomes inactive, meaning that the cell becomes
plain text and loses all the table specific features."
(interactive "i\ni\np")
(table--make-cell-map)
- (if (or force (not (memq (table--get-last-command) table-command-list)))
+ (if (or force (not (memq real-last-command table-command-list)))
(let* ((cell (table--probe-cell (called-interactively-p 'interactive)))
(cache-buffer (get-buffer-create table-cache-buffer-name))
(modified-flag (buffer-modified-p))
@@ -2668,7 +2651,8 @@ Creates a cell above and a cell below the current point location."
;;;###autoload
(defun table-split-cell-horizontally ()
"Split current cell horizontally.
-Creates a cell on the left and a cell on the right of the current point location."
+Creates a cell on the left and a cell on the right of the current
+point location."
(interactive "*")
(table-recognize-cell 'force)
(let* ((o-coordinate (table--get-coordinate))
@@ -3270,34 +3254,33 @@ Currently this method is for LaTeX only."
(let* ((span 1) ;; spanning length
(first-p t) ;; first in a row
(insert-column ;; a function that processes one column/multicolumn
- (function
- (lambda (from to)
- (let ((line (table--buffer-substring-and-trim
- (table--goto-coordinate (cons from y))
- (table--goto-coordinate (cons to y)))))
- ;; escape special characters
- (with-temp-buffer
- (insert line)
- (goto-char (point-min))
- (while (re-search-forward "\\([#$~_^%{}&]\\)\\|\\(\\\\\\)\\|\\([<>|]\\)" nil t)
- (if (match-beginning 1)
- (save-excursion
- (goto-char (match-beginning 1))
- (insert "\\"))
- (if (match-beginning 2)
- (replace-match "$\\backslash$" t t)
- (replace-match (concat "$" (match-string 3) "$")) t t)))
- (setq line (buffer-substring (point-min) (point-max))))
- ;; insert a column separator and column/multicolumn contents
- (with-current-buffer dest-buffer
- (unless first-p
- (insert (if (eq (char-before) ?\s) "" " ") "& "))
- (if (> span 1)
- (insert (format "\\multicolumn{%d}{%sl|}{%s}" span (if first-p "|" "") line))
- (insert line)))
- (setq first-p nil)
- (setq span 1)
- (setq start (nth i col-list)))))))
+ (lambda (from to)
+ (let ((line (table--buffer-substring-and-trim
+ (table--goto-coordinate (cons from y))
+ (table--goto-coordinate (cons to y)))))
+ ;; escape special characters
+ (with-temp-buffer
+ (insert line)
+ (goto-char (point-min))
+ (while (re-search-forward "\\([#$~_^%{}&]\\)\\|\\(\\\\\\)\\|\\([<>|]\\)" nil t)
+ (if (match-beginning 1)
+ (save-excursion
+ (goto-char (match-beginning 1))
+ (insert "\\"))
+ (if (match-beginning 2)
+ (replace-match "$\\backslash$" t t)
+ (replace-match (concat "$" (match-string 3) "$")) t t)))
+ (setq line (buffer-substring (point-min) (point-max))))
+ ;; insert a column separator and column/multicolumn contents
+ (with-current-buffer dest-buffer
+ (unless first-p
+ (insert (if (eq (char-before) ?\s) "" " ") "& "))
+ (if (> span 1)
+ (insert (format "\\multicolumn{%d}{%sl|}{%s}" span (if first-p "|" "") line))
+ (insert line)))
+ (setq first-p nil)
+ (setq span 1)
+ (setq start (nth i col-list))))))
(setq start x0)
(setq i 1)
(while (setq c (nth i border-char-list))
@@ -3864,9 +3847,8 @@ converts a table into plain text without frames. It is a companion to
(setq table-cell-map map)
(fset 'table-cell-map map)))
;; Add menu for table cells.
- (unless table-disable-menu
- (easy-menu-define table-cell-menu-map table-cell-map
- "Table cell menu" table-cell-menu))
+ (easy-menu-define table-cell-menu-map table-cell-map
+ "Table cell menu" table-cell-menu)
(run-hooks 'table-cell-map-hook))
;; Create the keymap after running the user init file so that the user
@@ -4057,16 +4039,15 @@ key binding
(defun *table--present-cell-popup-menu (event)
"Present and handle cell popup menu."
(interactive "e")
- (unless table-disable-menu
- (select-window (posn-window (event-start event)))
- (goto-char (posn-point (event-start event)))
- (let ((item-list (x-popup-menu event table-cell-menu-map))
- (func table-cell-menu-map))
- (while item-list
- (setq func (nth 3 (assoc (car item-list) func)))
- (setq item-list (cdr item-list)))
- (if (and (symbolp func) (fboundp func))
- (call-interactively func)))))
+ (select-window (posn-window (event-start event)))
+ (goto-char (posn-point (event-start event)))
+ (let ((item-list (x-popup-menu event table-cell-menu-map))
+ (func table-cell-menu-map))
+ (while item-list
+ (setq func (nth 3 (assoc (car item-list) func)))
+ (setq item-list (cdr item-list)))
+ (if (and (symbolp func) (fboundp func))
+ (call-interactively func))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
@@ -4087,17 +4068,20 @@ cache buffer into the designated cell in the table buffer."
(and (boundp 'quail-translating)
quail-translating))
(setq table-update-timer
- (table--set-timer table-time-before-update
- (function table--update-cell)
- 'now))
+ (run-with-idle-timer table-time-before-update
+ nil
+ (function table--update-cell)
+ 'now))
(save-current-buffer
(set-buffer table-cell-buffer)
(let ((cache-buffer (get-buffer-create table-cache-buffer-name))
(org-coord (table--get-coordinate))
+ (fixed table-fixed-width-mode)
(in-cell (equal (table--cell-to-coord (table--probe-cell))
(cons table-cell-info-lu-coordinate table-cell-info-rb-coordinate)))
rectangle)
(set-buffer cache-buffer)
+ (setq-local table-fixed-width-mode fixed)
(setq rectangle
(extract-rectangle
1
@@ -4126,9 +4110,10 @@ cache buffer into the designated cell in the table buffer."
(setq table-widen-timer nil))
(if (not now)
(setq table-widen-timer
- (table--set-timer (+ table-time-before-update table-time-before-reformat)
- (function table--update-cell-widened)
- 'now))
+ (run-with-idle-timer (+ table-time-before-update table-time-before-reformat)
+ nil
+ (function table--update-cell-widened)
+ 'now))
(save-current-buffer
(if table-update-timer
(table--update-cell 'now))
@@ -4165,9 +4150,10 @@ cache buffer into the designated cell in the table buffer."
(setq table-heighten-timer nil))
(if (not now)
(setq table-heighten-timer
- (table--set-timer (+ table-time-before-update table-time-before-reformat)
- (function table--update-cell-heightened)
- 'now))
+ (run-with-idle-timer (+ table-time-before-update table-time-before-reformat)
+ nil
+ (function table--update-cell-heightened)
+ 'now))
(save-current-buffer
(if table-update-timer
(table--update-cell 'now))
@@ -4212,21 +4198,21 @@ cache buffer into the designated cell in the table buffer."
(1- (cdr (table--get-coordinate (car (table--vertical-cell-list t t))))))))
(defun table-goto-top-right-corner ()
- "Move point to top right corner of the current table and return the char position."
+ "Move point to top right corner of the current table and return char position."
(table--goto-coordinate
(cons
(car (table--get-coordinate (cdr (table--horizontal-cell-list nil t))))
(1- (cdr (table--get-coordinate (car (table--vertical-cell-list t t))))))))
(defun table-goto-bottom-left-corner ()
- "Move point to bottom left corner of the current table and return the char position."
+ "Move point to bottom left corner of the current table and return char position."
(table--goto-coordinate
(cons
(1- (car (table--get-coordinate (car (table--horizontal-cell-list t t)))))
(1+ (cdr (table--get-coordinate (cdr (table--vertical-cell-list nil t))))))))
(defun table-goto-bottom-right-corner ()
- "Move point to bottom right corner of the current table and return the char position."
+ "Move point to bottom right corner of the current table and return char position."
(table--goto-coordinate
(cons
(car (table--get-coordinate (cdr (table--horizontal-cell-list nil t))))
@@ -4711,8 +4697,7 @@ in the list."
(defun table--cell-insert-char (char &optional overwrite)
"Insert CHAR inside a table cell."
- (let ((delete-selection-p (and (boundp 'delete-selection-mode)
- delete-selection-mode
+ (let ((delete-selection-p (and delete-selection-mode
transient-mark-mode mark-active
(not buffer-read-only)))
(mark-coordinate (table--transcoord-table-to-cache (table--get-coordinate (mark t)))))
@@ -4941,7 +4926,7 @@ When optional LOCATION is provided the test is performed at that location."
t))
(defun table--region-in-cell-p (beg end)
- "Return t when location BEG and END are in a valid table cell in the current buffer."
+ "Return t when location BEG and END are in a valid table cell in current buffer."
(and (table--at-cell-p (min beg end))
(save-excursion
(let ((cell-beg (progn (goto-char beg) (table--probe-cell))))
@@ -5240,8 +5225,7 @@ This feature is disabled when `table-disable-incompatibility-warning'
is non-nil. The warning is done only once per session for each item."
(unless (and table-disable-incompatibility-warning
(not (called-interactively-p 'interactive)))
- (when (and (boundp 'flyspell-mode)
- flyspell-mode
+ (when (and flyspell-mode
(not (get 'table-disable-incompatibility-warning 'flyspell)))
(put 'table-disable-incompatibility-warning 'flyspell t)
(display-warning 'table
@@ -5262,7 +5246,7 @@ works better than the previous versions however not fully compatible.
str))
(defun table--remove-eol-spaces (beg end &optional bol force)
- "Remove spaces at the end of each line in the BEG END region of the current buffer.
+ "Remove spaces at the end of each line in the BEG END region of current buffer.
When optional BOL is non-nil spaces at the beginning of line are
removed. When optional FORCE is non-nil removal operation is enforced
even when point is within the removal area."
@@ -5403,7 +5387,8 @@ point"
(defun table--transcoord-table-to-cache (&optional coordinate)
"Transpose COORDINATE from table coordinate system to cache coordinate system.
-When COORDINATE is omitted or nil the point in current buffer is assumed in place."
+When COORDINATE is omitted or nil the point in current buffer is
+assumed in place."
(table--offset-coordinate
(or coordinate (table--get-coordinate))
table-cell-info-lu-coordinate
@@ -5411,7 +5396,8 @@ When COORDINATE is omitted or nil the point in current buffer is assumed in plac
(defun table--transcoord-cache-to-table (&optional coordinate)
"Transpose COORDINATE from cache coordinate system to table coordinate system.
-When COORDINATE is omitted or nil the point in current buffer is assumed in place."
+When COORDINATE is omitted or nil the point in current buffer is
+assumed in place."
(table--offset-coordinate
(or coordinate (table--get-coordinate))
table-cell-info-lu-coordinate))
@@ -5444,15 +5430,24 @@ It returns COLUMN unless STR contains some wide characters."
idx
nil)))
+
+;;;; Obsolete.
+
+(defvar table-disable-menu nil
+ "When non-nil, use of menu by table package is disabled.
+It must be set before loading this package `table.el' for the first
+time.")
+(make-obsolete-variable 'table-disable-menu "no longer used." "28.1")
+
(defun table--set-timer (seconds func args)
"Generic wrapper for setting up a timer."
+ (declare (obsolete run-with-idle-timer "28.1"))
(run-with-idle-timer seconds nil func args))
(defun table--get-last-command ()
"Generic wrapper for getting the real last command."
- (if (boundp 'real-last-command)
- real-last-command
- last-command))
+ (declare (obsolete real-last-command "28.1"))
+ real-last-command)
(run-hooks 'table-load-hook)
diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el
index 37ab11ad89f..c4e4864da17 100644
--- a/lisp/textmodes/tex-mode.el
+++ b/lisp/textmodes/tex-mode.el
@@ -1,6 +1,6 @@
;;; tex-mode.el --- TeX, LaTeX, and SliTeX mode commands -*- lexical-binding:t -*-
-;; Copyright (C) 1985-1986, 1989, 1992, 1994-1999, 2001-2020 Free
+;; Copyright (C) 1985-1986, 1989, 1992, 1994-1999, 2001-2021 Free
;; Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
@@ -2331,9 +2331,14 @@ FILE is typically the output DVI or PDF file."
:version "23.1"
:group 'tex-run)
+(defun tex--quote-spec (fspec)
+ (cl-loop for (char . file) in fspec
+ collect (cons char (shell-quote-argument file))))
+
(defun tex-format-cmd (format fspec)
"Like `format-spec' but adds user-specified args to the command.
Only applies the FSPEC to the args part of FORMAT."
+ (setq fspec (tex--quote-spec fspec))
(if (not (string-match "\\([^ /\\]+\\) " format))
(format-spec format fspec)
(let* ((prefix (substring format 0 (match-beginning 0)))
@@ -2430,8 +2435,8 @@ Only applies the FSPEC to the args part of FORMAT."
(prog1 (file-name-directory (expand-file-name file))
(setq file (file-name-nondirectory file))))
(root (file-name-sans-extension file))
- (fspec (list (cons ?r (shell-quote-argument root))
- (cons ?f (shell-quote-argument file))))
+ (fspec (list (cons ?r root)
+ (cons ?f file)))
(default (tex-compile-default fspec)))
(list default-directory
(completing-read
diff --git a/lisp/textmodes/texinfmt.el b/lisp/textmodes/texinfmt.el
index c38787d081b..ed0a367d01d 100644
--- a/lisp/textmodes/texinfmt.el
+++ b/lisp/textmodes/texinfmt.el
@@ -1,6 +1,6 @@
;;; texinfmt.el --- format Texinfo files into Info files
-;; Copyright (C) 1985-1986, 1988, 1990-1998, 2000-2020 Free Software
+;; Copyright (C) 1985-1986, 1988, 1990-1998, 2000-2021 Free Software
;; Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/textmodes/texinfo.el b/lisp/textmodes/texinfo.el
index b3bc634de9b..7799cdb5529 100644
--- a/lisp/textmodes/texinfo.el
+++ b/lisp/textmodes/texinfo.el
@@ -1,6 +1,6 @@
;;; texinfo.el --- major mode for editing Texinfo files
-;; Copyright (C) 1985, 1988-1993, 1996-1997, 2000-2020 Free Software
+;; Copyright (C) 1985, 1988-1993, 1996-1997, 2000-2021 Free Software
;; Foundation, Inc.
;; Author: Robert J. Chassell
diff --git a/lisp/textmodes/texnfo-upd.el b/lisp/textmodes/texnfo-upd.el
index 78f8b2783bb..ea35641a6c6 100644
--- a/lisp/textmodes/texnfo-upd.el
+++ b/lisp/textmodes/texnfo-upd.el
@@ -1,6 +1,6 @@
;;; texnfo-upd.el --- utilities for updating nodes and menus in Texinfo files
-;; Copyright (C) 1989-1992, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1989-1992, 2001-2021 Free Software Foundation, Inc.
;; Author: Robert J. Chassell
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/textmodes/text-mode.el b/lisp/textmodes/text-mode.el
index c0b3c35d6f3..1432ab6a300 100644
--- a/lisp/textmodes/text-mode.el
+++ b/lisp/textmodes/text-mode.el
@@ -1,6 +1,6 @@
;;; text-mode.el --- text mode, and its idiosyncratic commands -*- lexical-binding: t -*-
-;; Copyright (C) 1985, 1992, 1994, 2001-2020 Free Software Foundation,
+;; Copyright (C) 1985, 1992, 1994, 2001-2021 Free Software Foundation,
;; Inc.
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/textmodes/tildify.el b/lisp/textmodes/tildify.el
index 398f7fdc232..33a976aa7b0 100644
--- a/lisp/textmodes/tildify.el
+++ b/lisp/textmodes/tildify.el
@@ -1,6 +1,6 @@
;;; tildify.el --- adding hard spaces into texts -*- lexical-binding: t -*-
-;; Copyright (C) 1997-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
;; Author: Milan Zamazal <pdm@zamazal.org>
;; Michal Nazarewicz <mina86@mina86.com>
diff --git a/lisp/textmodes/two-column.el b/lisp/textmodes/two-column.el
index e75ff7a8102..36aad84c0e6 100644
--- a/lisp/textmodes/two-column.el
+++ b/lisp/textmodes/two-column.el
@@ -1,6 +1,6 @@
;;; two-column.el --- minor mode for editing of two-column text
-;; Copyright (C) 1992-1995, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1992-1995, 2001-2021 Free Software Foundation, Inc.
;; Author: Daniel Pfeiffer <occitan@esperanto.org>
;; Adapted-By: ESR, Daniel Pfeiffer
@@ -388,9 +388,8 @@ First column's text sSs Second column's text
(backward-char arg)
(setq chars (buffer-substring (point) point))
(skip-chars-forward " \t" point)
- (make-local-variable '2C-separator)
- (setq 2C-separator (buffer-substring (point) point)
- 2C-window-width (+ (fringe-columns 'left)
+ (setq-local 2C-separator (buffer-substring (point) point))
+ (setq 2C-window-width (+ (fringe-columns 'left)
(fringe-columns 'right)
(scroll-bar-columns 'left)
(scroll-bar-columns 'right)
diff --git a/lisp/textmodes/underline.el b/lisp/textmodes/underline.el
index cfd515055a8..3f4e63a349b 100644
--- a/lisp/textmodes/underline.el
+++ b/lisp/textmodes/underline.el
@@ -1,6 +1,6 @@
;;; underline.el --- insert/remove underlining (done by overstriking) in Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1985, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 2001-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: wp
diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el
index 558a3fd7368..d3ba941fcc2 100644
--- a/lisp/thingatpt.el
+++ b/lisp/thingatpt.el
@@ -1,6 +1,6 @@
;;; thingatpt.el --- get the `thing' at point -*- lexical-binding:t -*-
-;; Copyright (C) 1991-1998, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1991-1998, 2000-2021 Free Software Foundation, Inc.
;; Author: Mike Williams <mikew@gopher.dosli.govt.nz>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/thread.el b/lisp/thread.el
index 00a0084f81f..efb058c4361 100644
--- a/lisp/thread.el
+++ b/lisp/thread.el
@@ -1,6 +1,6 @@
;;; thread.el --- Thread support in Emacs Lisp -*- lexical-binding: t -*-
-;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2018-2021 Free Software Foundation, Inc.
;; Author: Gemini Lasswell <gazally@runbox.com>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/thumbs.el b/lisp/thumbs.el
index 3aa7ff0836b..7d6558d8f78 100644
--- a/lisp/thumbs.el
+++ b/lisp/thumbs.el
@@ -1,6 +1,6 @@
;;; thumbs.el --- Thumbnails previewer for images files
-;; Copyright (C) 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;; Author: Jean-Philippe Theberge <jphiltheberge@videotron.ca>
;; Maintainer: emacs-devel@gnu.org
@@ -347,8 +347,7 @@ If MARKED is non-nil, the image is marked."
:conversion ,(if marked 'disabled)
:margin ,thumbs-margin)))
(insert-image i)
- (set (make-local-variable 'thumbs-current-image-size)
- (image-size i t))))
+ (setq-local thumbs-current-image-size (image-size i t))))
(defun thumbs-insert-thumb (img &optional marked)
"Insert the thumbnail for IMG at point.
@@ -387,7 +386,7 @@ If MARKED is non-nil, the image is marked."
(if dir (setq default-directory dir))
(thumbs-do-thumbs-insertion list)
(goto-char (point-min))
- (set (make-local-variable 'thumbs-current-dir) default-directory)))
+ (setq-local thumbs-current-dir default-directory)))
;;;###autoload
(defun thumbs-show-from-dir (dir &optional reg same-window)
diff --git a/lisp/time-stamp.el b/lisp/time-stamp.el
index 7c64f2903be..b9eab95b232 100644
--- a/lisp/time-stamp.el
+++ b/lisp/time-stamp.el
@@ -1,6 +1,6 @@
-;;; time-stamp.el --- Maintain last change time stamps in files edited by Emacs
+;;; time-stamp.el --- Maintain last change time stamps in files edited by Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1989, 1993-1995, 1997, 2000-2020 Free Software
+;; Copyright (C) 1989, 1993-1995, 1997, 2000-2021 Free Software
;; Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -87,7 +87,6 @@ transitional behavior (again, as shown).
The behavior of `%5z' is new in Emacs 27. If your files might be
edited by older versions of Emacs also, do not use this format yet."
:type 'string
- :group 'time-stamp
:version "27.1")
;;;###autoload(put 'time-stamp-format 'safe-local-variable 'stringp)
@@ -102,8 +101,7 @@ when they are saved, either add this line to your init file:
or customize option `before-save-hook'.
See also the variable `time-stamp-warn-inactive'."
- :type 'boolean
- :group 'time-stamp)
+ :type 'boolean)
(defcustom time-stamp-warn-inactive t
"Have \\[time-stamp] warn if a buffer did not get time-stamped.
@@ -111,7 +109,6 @@ If non-nil, a warning is displayed if `time-stamp-active' has
deactivated time stamping and the buffer contains a template that
otherwise would have been updated."
:type 'boolean
- :group 'time-stamp
:version "19.29")
(defcustom time-stamp-time-zone nil
@@ -125,7 +122,6 @@ Its format is that of the ZONE argument of the `format-time-string' function."
(integer :tag "Offset (seconds east of UTC)")
(string :tag "Time zone abbreviation"))
(integer :tag "Offset (seconds east of UTC)"))
- :group 'time-stamp
:version "20.1")
;;;###autoload(put 'time-stamp-time-zone 'safe-local-variable 'time-stamp-zone-type-p)
diff --git a/lisp/time.el b/lisp/time.el
index eca9a0752e4..1403c4ac00a 100644
--- a/lisp/time.el
+++ b/lisp/time.el
@@ -1,6 +1,6 @@
;;; time.el --- display time, load and mail indicator in mode line of Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1987, 1993-1994, 1996, 2000-2020 Free Software
+;; Copyright (C) 1985-1987, 1993-1994, 1996, 2000-2021 Free Software
;; Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/timezone.el b/lisp/timezone.el
index 8ba70f17fde..2c96343a74b 100644
--- a/lisp/timezone.el
+++ b/lisp/timezone.el
@@ -1,6 +1,6 @@
-;;; timezone.el --- time zone package for GNU Emacs -- lexical-binding: t -*-
+;;; timezone.el --- time zone package for GNU Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1990-1993, 1996, 1999, 2001-2020 Free Software
+;; Copyright (C) 1990-1993, 1996, 1999, 2001-2021 Free Software
;; Foundation, Inc.
;; Author: Masanobu Umeda <umerin@mse.kyutech.ac.jp>
diff --git a/lisp/tmm.el b/lisp/tmm.el
index 4c2855751c2..e49246a5c4f 100644
--- a/lisp/tmm.el
+++ b/lisp/tmm.el
@@ -1,6 +1,6 @@
;;; tmm.el --- text mode access to menu-bar -*- lexical-binding: t -*-
-;; Copyright (C) 1994-1996, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1996, 2000-2021 Free Software Foundation, Inc.
;; Author: Ilya Zakharevich <ilya@math.mps.ohio-state.edu>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/tool-bar.el b/lisp/tool-bar.el
index 84562164300..6da401187b1 100644
--- a/lisp/tool-bar.el
+++ b/lisp/tool-bar.el
@@ -1,6 +1,6 @@
;;; tool-bar.el --- setting up the tool bar -*- lexical-binding: t -*-
-;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: mouse frames
@@ -159,7 +159,8 @@ To define items in any other map, use `tool-bar-local-item'."
((< (display-color-cells) 256)
',(list xpm-lo-spec xpm-spec pbm-spec xbm-spec))
(t
- ',(list xpm-spec pbm-spec xbm-spec))))))
+ ',(list xpm-spec pbm-spec xbm-spec)))
+ t)))
;;;###autoload
(defun tool-bar-local-item (icon def key map &rest props)
diff --git a/lisp/tooltip.el b/lisp/tooltip.el
index ffc3d499e30..8e00aa5c2a9 100644
--- a/lisp/tooltip.el
+++ b/lisp/tooltip.el
@@ -1,6 +1,6 @@
;;; tooltip.el --- show tooltip windows -*- lexical-binding:t -*-
-;; Copyright (C) 1997, 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1999-2021 Free Software Foundation, Inc.
;; Author: Gerd Moellmann <gerd@acm.org>
;; Keywords: help c mouse tools
diff --git a/lisp/tree-widget.el b/lisp/tree-widget.el
index 45d3f28ea07..44b29bffe87 100644
--- a/lisp/tree-widget.el
+++ b/lisp/tree-widget.el
@@ -1,6 +1,6 @@
;;; tree-widget.el --- Tree widget -*- lexical-binding:t -*-
-;; Copyright (C) 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
;; Created: 16 Feb 2001
@@ -260,10 +260,9 @@ Typically it should contain something like this:
\\='(:ascent center :mask (heuristic t)))"
(or name (setq name (or tree-widget-theme "default")))
(unless (string-equal name (tree-widget-theme-name))
- (set (make-local-variable 'tree-widget--theme)
- (make-vector 4 nil))
- (tree-widget-set-parent-theme name)
- (tree-widget-set-parent-theme "default")))
+ (setq-local tree-widget--theme (make-vector 4 nil))
+ (tree-widget-set-parent-theme name)
+ (tree-widget-set-parent-theme "default")))
(defun tree-widget--locate-sub-directory (name path)
"Locate all occurrences of the sub-directory NAME in PATH.
diff --git a/lisp/tutorial.el b/lisp/tutorial.el
index d07737e3332..6bda1ab0d50 100644
--- a/lisp/tutorial.el
+++ b/lisp/tutorial.el
@@ -1,6 +1,6 @@
;;; tutorial.el --- tutorial for Emacs
-;; Copyright (C) 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: help, internal
@@ -50,6 +50,9 @@
"Tutorial language.")
(make-variable-buffer-local 'tutorial--lang)
+(defvar tutorial--buffer nil
+ "The selected tutorial buffer.")
+
(defun tutorial--describe-nonstandard-key (value)
"Give more information about a changed key binding.
This is used in `help-with-tutorial'. The information includes
@@ -655,6 +658,15 @@ with some explanatory links."
(unless (eq prop-val 'key-sequence)
(delete-region prop-start prop-end))))))
+(defun tutorial--save-on-kill ()
+ "Query the user about saving the tutorial when killing Emacs."
+ (when (buffer-live-p tutorial--buffer)
+ (with-current-buffer tutorial--buffer
+ (if (y-or-n-p "Save your position in the tutorial? ")
+ (tutorial--save-tutorial-to (tutorial--saved-file))
+ (message "Tutorial position not saved"))))
+ t)
+
(defun tutorial--save-tutorial ()
"Save the tutorial buffer.
This saves the part of the tutorial before and after the area
@@ -802,6 +814,7 @@ Run the Viper tutorial? "))
;; (Re)build the tutorial buffer if it is not ok
(unless old-tut-is-ok
(switch-to-buffer (get-buffer-create tut-buf-name))
+ (setq tutorial--buffer (current-buffer))
;; (unless old-tut-buf (text-mode))
(unless lang (error "Variable lang is nil"))
(setq tutorial--lang lang)
@@ -814,6 +827,7 @@ Run the Viper tutorial? "))
;; a hook to save it when the buffer is killed.
(setq buffer-auto-save-file-name nil)
(add-hook 'kill-buffer-hook 'tutorial--save-tutorial nil t)
+ (add-hook 'kill-emacs-query-functions 'tutorial--save-on-kill)
;; Insert the tutorial. First offer to resume last tutorial
;; editing session.
diff --git a/lisp/type-break.el b/lisp/type-break.el
index a9ec19b2565..84c240c9f8c 100644
--- a/lisp/type-break.el
+++ b/lisp/type-break.el
@@ -1,6 +1,6 @@
;;; type-break.el --- encourage rests from typing at appropriate intervals -*- lexical-binding: t -*-
-;; Copyright (C) 1994-1995, 1997, 2000-2020 Free Software Foundation,
+;; Copyright (C) 1994-1995, 1997, 2000-2021 Free Software Foundation,
;; Inc.
;; Author: Noah Friedman <friedman@splode.com>
diff --git a/lisp/uniquify.el b/lisp/uniquify.el
index e6a1b35bc06..c1ec90e2908 100644
--- a/lisp/uniquify.el
+++ b/lisp/uniquify.el
@@ -1,6 +1,6 @@
;;; uniquify.el --- unique buffer names dependent on file name -*- lexical-binding: t -*-
-;; Copyright (C) 1989, 1995-1997, 2001-2020 Free Software Foundation,
+;; Copyright (C) 1989, 1995-1997, 2001-2021 Free Software Foundation,
;; Inc.
;; Author: Dick King <king@reasoning.com>
diff --git a/lisp/url/ChangeLog.1 b/lisp/url/ChangeLog.1
index 0309440defa..5a3bf3afd1a 100644
--- a/lisp/url/ChangeLog.1
+++ b/lisp/url/ChangeLog.1
@@ -3068,7 +3068,7 @@
;; coding: utf-8
;; End:
- Copyright (C) 1999, 2001-2002, 2004-2020 Free Software Foundation,
+ Copyright (C) 1999, 2001-2002, 2004-2021 Free Software Foundation,
Inc.
This file is part of GNU Emacs.
diff --git a/lisp/url/url-about.el b/lisp/url/url-about.el
index 5fe817cc0e8..bff5570f6df 100644
--- a/lisp/url/url-about.el
+++ b/lisp/url/url-about.el
@@ -1,6 +1,6 @@
;;; url-about.el --- Show internal URLs
-;; Copyright (C) 2001, 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2004-2021 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el
index 8f39b5ae010..f291414e81b 100644
--- a/lisp/url/url-auth.el
+++ b/lisp/url/url-auth.el
@@ -1,6 +1,6 @@
;;; url-auth.el --- Uniform Resource Locator authorization modules -*- lexical-binding: t -*-
-;; Copyright (C) 1996-1999, 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2021 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
@@ -23,7 +23,6 @@
(require 'url-vars)
(require 'url-parse)
-(autoload 'url-warn "url")
(autoload 'auth-source-search "auth-source")
(defsubst url-auth-user-prompt (url realm)
@@ -494,21 +493,19 @@ PROMPT is boolean - specifies whether to ask the user for a username/password
(car-safe
(sort
(mapcar
- (function
- (lambda (scheme)
- (if (fboundp (car (cdr scheme)))
- (cons (cdr (cdr scheme))
- (funcall (car (cdr scheme)) url nil nil realm))
- (cons 0 nil))))
+ (lambda (scheme)
+ (if (fboundp (car (cdr scheme)))
+ (cons (cdr (cdr scheme))
+ (funcall (car (cdr scheme)) url nil nil realm))
+ (cons 0 nil)))
url-registered-auth-schemes)
- (function
- (lambda (x y)
- (cond
- ((null (cdr x)) nil)
- ((and (cdr x) (null (cdr y))) t)
- ((and (cdr x) (cdr y))
- (>= (car x) (car y)))
- (t nil)))))))
+ (lambda (x y)
+ (cond
+ ((null (cdr x)) nil)
+ ((and (cdr x) (null (cdr y))) t)
+ ((and (cdr x) (cdr y))
+ (>= (car x) (car y)))
+ (t nil))))))
(if (symbolp type) (setq type (symbol-name type)))
(let* ((scheme (car-safe
(cdr-safe (assoc (downcase type)
@@ -542,7 +539,7 @@ RATING a rating between 1 and 10 of the strength of the authentication.
(t rating)))
(node (assoc type url-registered-auth-schemes)))
(if (not (fboundp function))
- (url-warn
+ (display-warning
'security
(format-message
"Tried to register `%s' as an auth scheme, but it is not a function!"
diff --git a/lisp/url/url-cache.el b/lisp/url/url-cache.el
index 056ad1e0188..acf88eb0212 100644
--- a/lisp/url/url-cache.el
+++ b/lisp/url/url-cache.el
@@ -1,6 +1,6 @@
;;; url-cache.el --- Uniform Resource Locator retrieval tool
-;; Copyright (C) 1996-1999, 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2021 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
@@ -110,18 +110,17 @@ The actual return value is the last modification time of the cache file."
(let ((slash nil))
(setq fname
(mapconcat
- (function
- (lambda (x)
- (cond
- ((and (= ?/ x) slash)
- (setq slash nil)
- "%2F")
- ((= ?/ x)
- (setq slash t)
- "/")
- (t
- (setq slash nil)
- (char-to-string x))))) fname ""))))
+ (lambda (x)
+ (cond
+ ((and (= ?/ x) slash)
+ (setq slash nil)
+ "%2F")
+ ((= ?/ x)
+ (setq slash t)
+ "/")
+ (t
+ (setq slash nil)
+ (char-to-string x)))) fname ""))))
(setq fname (and fname
(mapconcat
diff --git a/lisp/url/url-cid.el b/lisp/url/url-cid.el
index ace971462a1..d465cabc90c 100644
--- a/lisp/url/url-cid.el
+++ b/lisp/url/url-cid.el
@@ -1,6 +1,6 @@
;;; url-cid.el --- Content-ID URL loader
-;; Copyright (C) 1998-1999, 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-1999, 2004-2021 Free Software Foundation, Inc.
;; Keywords: comm, data, processes
diff --git a/lisp/url/url-cookie.el b/lisp/url/url-cookie.el
index bee3a6b85e4..085159cb500 100644
--- a/lisp/url/url-cookie.el
+++ b/lisp/url/url-cookie.el
@@ -1,6 +1,6 @@
;;; url-cookie.el --- URL cookie support -*- lexical-binding:t -*-
-;; Copyright (C) 1996-1999, 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2021 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
@@ -162,7 +162,7 @@ i.e. 1970-1-1) are loaded as expiring one year from now instead."
";; version-control: never\n"
";; no-byte-compile: t\n"
";; End:\n")
- (set (make-local-variable 'version-control) 'never)
+ (setq-local version-control 'never)
(write-file fname))
(setq url-cookies-changed-since-last-save nil))))
diff --git a/lisp/url/url-dav.el b/lisp/url/url-dav.el
index 3cd34b5a6fb..12d5a683e97 100644
--- a/lisp/url/url-dav.el
+++ b/lisp/url/url-dav.el
@@ -1,6 +1,6 @@
;;; url-dav.el --- WebDAV support
-;; Copyright (C) 2001, 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2004-2021 Free Software Foundation, Inc.
;; Author: Bill Perry <wmperry@gnu.org>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/url/url-dired.el b/lisp/url/url-dired.el
index ba68fe100e5..398113db139 100644
--- a/lisp/url/url-dired.el
+++ b/lisp/url/url-dired.el
@@ -1,6 +1,6 @@
-;;; url-dired.el --- URL Dired minor mode
+;;; url-dired.el --- URL Dired minor mode -*- lexical-binding: t -*-
-;; Copyright (C) 1996-1999, 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2021 Free Software Foundation, Inc.
;; Keywords: comm, files
diff --git a/lisp/url/url-domsuf.el b/lisp/url/url-domsuf.el
index c1cdf901d6c..59d70cbd0ee 100644
--- a/lisp/url/url-domsuf.el
+++ b/lisp/url/url-domsuf.el
@@ -1,6 +1,6 @@
;;; url-domsuf.el --- Say what domain names can have cookies set. -*- lexical-binding:t -*-
-;; Copyright (C) 2012-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
diff --git a/lisp/url/url-expand.el b/lisp/url/url-expand.el
index be9b5426dc4..a42b4c7ad23 100644
--- a/lisp/url/url-expand.el
+++ b/lisp/url/url-expand.el
@@ -1,6 +1,6 @@
;;; url-expand.el --- expand-file-name for URLs -*- lexical-binding: t -*-
-;; Copyright (C) 1999, 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2004-2021 Free Software Foundation, Inc.
;; Keywords: comm, data, processes
@@ -65,10 +65,10 @@ path components followed by `..' are removed, along with the `..' itself."
(if (and url (not (string-match "^#" url)))
;; Need to nuke newlines and spaces in the URL, or we open
;; ourselves up to potential security holes.
- (setq url (mapconcat (function (lambda (x)
- (if (memq x '(? ?\n ?\r))
- ""
- (char-to-string x))))
+ (setq url (mapconcat (lambda (x)
+ (if (memq x '(? ?\n ?\r))
+ ""
+ (char-to-string x)))
url "")))
;; Need to figure out how/where to expand the fragment relative to
diff --git a/lisp/url/url-file.el b/lisp/url/url-file.el
index eec7cdfbe8a..52a9588030e 100644
--- a/lisp/url/url-file.el
+++ b/lisp/url/url-file.el
@@ -1,6 +1,6 @@
;;; url-file.el --- File retrieval code -*- lexical-binding:t -*-
-;; Copyright (C) 1996-1999, 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2021 Free Software Foundation, Inc.
;; Keywords: comm, data, processes
diff --git a/lisp/url/url-ftp.el b/lisp/url/url-ftp.el
index a436a431db0..3cda29a086d 100644
--- a/lisp/url/url-ftp.el
+++ b/lisp/url/url-ftp.el
@@ -1,6 +1,6 @@
-;;; url-ftp.el --- FTP wrapper
+;;; url-ftp.el --- FTP wrapper -*- lexical-binding: t -*-
-;; Copyright (C) 1996-1999, 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2021 Free Software Foundation, Inc.
;; Keywords: comm, data, processes
diff --git a/lisp/url/url-future.el b/lisp/url/url-future.el
index e48ad3c7c8f..c5733175283 100644
--- a/lisp/url/url-future.el
+++ b/lisp/url/url-future.el
@@ -1,6 +1,6 @@
;;; url-future.el --- general futures facility for url.el -*- lexical-binding: t -*-
-;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
;; Author: Teodor Zlatanov <tzz@lifelogs.com>
;; Keywords: data
diff --git a/lisp/url/url-gw.el b/lisp/url/url-gw.el
index f16fc234025..68df67f6486 100644
--- a/lisp/url/url-gw.el
+++ b/lisp/url/url-gw.el
@@ -1,6 +1,6 @@
;;; url-gw.el --- Gateway munging for URL loading
-;; Copyright (C) 1997-1998, 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2004-2021 Free Software Foundation, Inc.
;; Author: Bill Perry <wmperry@gnu.org>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el
index 1c3607bb661..68556d6aa9c 100644
--- a/lisp/url/url-handlers.el
+++ b/lisp/url/url-handlers.el
@@ -1,6 +1,6 @@
;;; url-handlers.el --- file-name-handler stuff for URL loading -*- lexical-binding:t -*-
-;; Copyright (C) 1996-1999, 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2021 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
@@ -299,8 +299,8 @@ BUFFER should be a complete URL buffer as returned by `url-retrieve'.
If the headers specify a coding-system (and current buffer is multibyte),
it is applied to the body before it is inserted.
Returns a list of the form (SIZE CHARSET), where SIZE is the size in bytes
-of the inserted text and CHARSET is the charset that was specified in the header,
-or nil if none was found.
+of the inserted text and CHARSET is the charset that was specified in the
+header, or nil if none was found.
BEG and END can be used to only insert a subpart of the body.
They count bytes from the beginning of the body."
(let* ((handle (with-current-buffer buffer (mm-dissect-buffer t)))
diff --git a/lisp/url/url-history.el b/lisp/url/url-history.el
index 9942e6c88b9..10238a46607 100644
--- a/lisp/url/url-history.el
+++ b/lisp/url/url-history.el
@@ -1,6 +1,6 @@
;;; url-history.el --- Global history tracking for URL package -*- lexical-binding:t -*-
-;; Copyright (C) 1996-1999, 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2021 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index 8532da1d1fb..324cf99554d 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -1,6 +1,6 @@
;;; url-http.el --- HTTP retrieval routines -*- lexical-binding:t -*-
-;; Copyright (C) 1999, 2001, 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2001, 2004-2021 Free Software Foundation, Inc.
;; Author: Bill Perry <wmperry@gnu.org>
;; Maintainer: emacs-devel@gnu.org
@@ -741,12 +741,12 @@ should be shown to the user."
;; without changing the API. Instead url-retrieve should
;; either simply not return the "destination" buffer, or it
;; should take an optional `dest-buf' argument.
- (set (make-local-variable 'url-redirect-buffer)
- (url-retrieve-internal
- redirect-uri url-callback-function
- url-callback-arguments
- (url-silent url-current-object)
- (not (url-use-cookies url-current-object))))
+ (setq-local url-redirect-buffer
+ (url-retrieve-internal
+ redirect-uri url-callback-function
+ url-callback-arguments
+ (url-silent url-current-object)
+ (not (url-use-cookies url-current-object))))
(url-mark-buffer-as-dead buffer))
;; We hit url-max-redirections, so issue an error and
;; stop redirecting.
@@ -1119,9 +1119,7 @@ the end of the document."
(beginning-of-line)
(looking-at regexp))
(add-text-properties (match-beginning 0) (match-end 0)
- (list 'start-open t
- 'end-open t
- 'chunked-encoding t
+ (list 'chunked-encoding t
'face 'cursor
'invisible t))
(setq url-http-chunked-length (string-to-number (buffer-substring
diff --git a/lisp/url/url-imap.el b/lisp/url/url-imap.el
index 4ac22f5fa8e..05c3e73fb0e 100644
--- a/lisp/url/url-imap.el
+++ b/lisp/url/url-imap.el
@@ -1,6 +1,6 @@
;;; url-imap.el --- IMAP retrieval routines
-;; Copyright (C) 1999, 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2004-2021 Free Software Foundation, Inc.
;; Author: Simon Josefsson <jas@pdc.kth.se>
;; Keywords: comm, data, processes
diff --git a/lisp/url/url-irc.el b/lisp/url/url-irc.el
index 9647df1c13c..c895144ae2a 100644
--- a/lisp/url/url-irc.el
+++ b/lisp/url/url-irc.el
@@ -1,6 +1,6 @@
-;;; url-irc.el --- IRC URL interface
+;;; url-irc.el --- IRC URL interface -*- lexical-binding: t -*-
-;; Copyright (C) 1996-1999, 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2021 Free Software Foundation, Inc.
;; Keywords: comm, data, processes
@@ -48,6 +48,8 @@ PASSWORD - What password to use"
;; External.
(declare-function zenirc "ext:zenirc" (&optional prefix))
(declare-function zenirc-send-line "ext:zenirc" ())
+(defvar zenirc-server-alist)
+(defvar zenirc-buffer-name)
(defun url-irc-zenirc (host port channel user password)
(let ((zenirc-buffer-name (if (and user host port)
@@ -65,7 +67,7 @@ PASSWORD - What password to use"
(defun url-irc-rcirc (host port channel user password)
(let ((chan (when channel (concat "#" channel))))
- (rcirc-connect host port user nil nil (when chan (list chan)))
+ (rcirc-connect host port user nil nil (when chan (list chan)) password)
(when chan
(switch-to-buffer (concat chan "@" host)))))
diff --git a/lisp/url/url-ldap.el b/lisp/url/url-ldap.el
index a64515f0ac8..0fa9970fa47 100644
--- a/lisp/url/url-ldap.el
+++ b/lisp/url/url-ldap.el
@@ -1,6 +1,6 @@
;;; url-ldap.el --- LDAP Uniform Resource Locator retrieval code
-;; Copyright (C) 1998-1999, 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-1999, 2004-2021 Free Software Foundation, Inc.
;; Keywords: comm, data, processes
diff --git a/lisp/url/url-mailto.el b/lisp/url/url-mailto.el
index 67707e9c092..688f102cabd 100644
--- a/lisp/url/url-mailto.el
+++ b/lisp/url/url-mailto.el
@@ -1,6 +1,6 @@
;;; url-mail.el --- Mail Uniform Resource Locator retrieval code
-;; Copyright (C) 1996-1999, 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2021 Free Software Foundation, Inc.
;; Keywords: comm, data, processes
diff --git a/lisp/url/url-methods.el b/lisp/url/url-methods.el
index bcea0508795..7aad741210d 100644
--- a/lisp/url/url-methods.el
+++ b/lisp/url/url-methods.el
@@ -1,6 +1,6 @@
;;; url-methods.el --- Load URL schemes as needed
-;; Copyright (C) 1996-1999, 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2021 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
diff --git a/lisp/url/url-misc.el b/lisp/url/url-misc.el
index 587bde5216d..d3db31d612a 100644
--- a/lisp/url/url-misc.el
+++ b/lisp/url/url-misc.el
@@ -1,6 +1,6 @@
;;; url-misc.el --- Misc Uniform Resource Locator retrieval code
-;; Copyright (C) 1996-1999, 2002, 2004-2020 Free Software Foundation,
+;; Copyright (C) 1996-1999, 2002, 2004-2021 Free Software Foundation,
;; Inc.
;; Keywords: comm, data, processes
diff --git a/lisp/url/url-news.el b/lisp/url/url-news.el
index 9ef17cccd77..d5f8483ab7a 100644
--- a/lisp/url/url-news.el
+++ b/lisp/url/url-news.el
@@ -1,6 +1,6 @@
;;; url-news.el --- News Uniform Resource Locator retrieval code
-;; Copyright (C) 1996-1999, 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2021 Free Software Foundation, Inc.
;; Keywords: comm, data, processes
@@ -25,7 +25,6 @@
(require 'url-util)
(require 'url-parse)
(require 'nntp)
-(autoload 'url-warn "url")
(autoload 'gnus-group-read-ephemeral-group "gnus-group")
;; Unused.
@@ -42,7 +41,7 @@
(nntp-send-command "^.*\r?\n" "AUTHINFO USER" user)
(nntp-send-command "^.*\r?\n" "AUTHINFO PASS" pass)
(if (not (nntp-server-opened host))
- (url-warn 'url (format "NNTP authentication to `%s' as `%s' failed"
+ (display-warning 'url (format "NNTP authentication to `%s' as `%s' failed"
host user))))))
(defun url-news-fetch-message-id (host message-id)
diff --git a/lisp/url/url-nfs.el b/lisp/url/url-nfs.el
index f8efd12aeb7..3c80c8059b5 100644
--- a/lisp/url/url-nfs.el
+++ b/lisp/url/url-nfs.el
@@ -1,6 +1,6 @@
;;; url-nfs.el --- NFS URL interface
-;; Copyright (C) 1996-1999, 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2021 Free Software Foundation, Inc.
;; Keywords: comm, data, processes
diff --git a/lisp/url/url-parse.el b/lisp/url/url-parse.el
index b1588def8a0..cd332f5ff74 100644
--- a/lisp/url/url-parse.el
+++ b/lisp/url/url-parse.el
@@ -1,6 +1,6 @@
;;; url-parse.el --- Uniform Resource Locator parser -*- lexical-binding: t -*-
-;; Copyright (C) 1996-1999, 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2021 Free Software Foundation, Inc.
;; Keywords: comm, data, processes
diff --git a/lisp/url/url-privacy.el b/lisp/url/url-privacy.el
index 716e3107424..e3ca0f66d98 100644
--- a/lisp/url/url-privacy.el
+++ b/lisp/url/url-privacy.el
@@ -1,6 +1,6 @@
;;; url-privacy.el --- Global history tracking for URL package
-;; Copyright (C) 1996-1999, 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2021 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
diff --git a/lisp/url/url-proxy.el b/lisp/url/url-proxy.el
index 9513c3973a1..6bf65845098 100644
--- a/lisp/url/url-proxy.el
+++ b/lisp/url/url-proxy.el
@@ -1,6 +1,6 @@
;;; url-proxy.el --- Proxy server support
-;; Copyright (C) 1999, 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2004-2021 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
@@ -22,7 +22,6 @@
;;; Code:
(require 'url-parse)
-(autoload 'url-warn "url")
(defun url-default-find-proxy-for-url (urlobj host)
(cond
@@ -60,7 +59,7 @@
((string-match "^socks +" proxy)
(concat "socks://" (substring proxy (match-end 0))))
(t
- (url-warn 'url (format "Unknown proxy directive: %s" proxy) 'critical)
+ (display-warning 'url (format "Unknown proxy directive: %s" proxy) :error)
nil))))
(autoload 'url-http "url-http")
diff --git a/lisp/url/url-queue.el b/lisp/url/url-queue.el
index 46cdff0f724..0923731ad8e 100644
--- a/lisp/url/url-queue.el
+++ b/lisp/url/url-queue.el
@@ -1,6 +1,6 @@
;;; url-queue.el --- Fetching web pages in parallel -*- lexical-binding: t -*-
-;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: comm
diff --git a/lisp/url/url-tramp.el b/lisp/url/url-tramp.el
index 3757a681aea..325d25cb8e2 100644
--- a/lisp/url/url-tramp.el
+++ b/lisp/url/url-tramp.el
@@ -1,6 +1,6 @@
;;; url-tramp.el --- file-name-handler magic invoking Tramp for some protocols
-;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2021 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, data, processes, hypermedia
diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el
index 0a7e7e205e0..7c913bcb1a9 100644
--- a/lisp/url/url-util.el
+++ b/lisp/url/url-util.el
@@ -1,6 +1,6 @@
;;; url-util.el --- Miscellaneous helper routines for URL library -*- lexical-binding: t -*-
-;; Copyright (C) 1996-1999, 2001, 2004-2020 Free Software Foundation,
+;; Copyright (C) 1996-1999, 2001, 2004-2021 Free Software Foundation,
;; Inc.
;; Author: Bill Perry <wmperry@gnu.org>
@@ -574,8 +574,8 @@ Has a preference for looking backward when not directly on a symbol."
(save-excursion
(goto-char (point-min))
(unless url-current-mime-headers
- (set (make-local-variable 'url-current-mime-headers)
- (mail-header-extract)))))
+ (setq-local url-current-mime-headers
+ (mail-header-extract)))))
(defun url-make-private-file (file)
"Make FILE only readable and writable by the current user.
diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el
index f9dce2418f6..6493abfa056 100644
--- a/lisp/url/url-vars.el
+++ b/lisp/url/url-vars.el
@@ -1,6 +1,6 @@
;;; url-vars.el --- Variables for Uniform Resource Locator tool -*- lexical-binding:t -*-
-;; Copyright (C) 1996-1999, 2001, 2004-2020 Free Software Foundation,
+;; Copyright (C) 1996-1999, 2001, 2004-2021 Free Software Foundation,
;; Inc.
;; Keywords: comm, data, processes, hypermedia
diff --git a/lisp/url/url.el b/lisp/url/url.el
index 33a5ebcdccc..172a3af2b3b 100644
--- a/lisp/url/url.el
+++ b/lisp/url/url.el
@@ -1,6 +1,6 @@
;;; url.el --- Uniform Resource Locator retrieval tool -*- lexical-binding: t -*-
-;; Copyright (C) 1996-1999, 2001, 2004-2020 Free Software Foundation,
+;; Copyright (C) 1996-1999, 2001, 2004-2021 Free Software Foundation,
;; Inc.
;; Author: Bill Perry <wmperry@gnu.org>
@@ -365,19 +365,7 @@ how long to wait for a response before giving up."
(if (buffer-live-p buff)
(kill-buffer buff)))))
-(cond
- ((fboundp 'display-warning)
- (defalias 'url-warn 'display-warning))
- ((fboundp 'warn)
- (defun url-warn (class message &optional level)
- (warn "(%s/%s) %s" class (or level 'warning) message)))
- (t
- (defun url-warn (class message &optional level)
- (with-current-buffer (get-buffer-create "*URL-WARNINGS*")
- (goto-char (point-max))
- (save-excursion
- (insert (format "(%s/%s) %s\n" class (or level 'warning) message)))
- (display-buffer (current-buffer))))))
+(define-obsolete-function-alias 'url-warn #'display-warning "28.1")
(provide 'url)
diff --git a/lisp/userlock.el b/lisp/userlock.el
index ec763223379..a340ff85b2d 100644
--- a/lisp/userlock.el
+++ b/lisp/userlock.el
@@ -1,6 +1,6 @@
;;; userlock.el --- handle file access contention between multiple users
-;; Copyright (C) 1985-1986, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1986, 2001-2021 Free Software Foundation, Inc.
;; Author: Richard King
;; (according to authors.el)
@@ -159,7 +159,7 @@ really edit the buffer? (y, n, r or C-h) "
(message "%s" prompt)
(error "Cannot resolve conflict in batch mode"))
(while (null answer)
- (setq answer (read-char-from-minibuffer prompt choices))
+ (setq answer (read-char-choice prompt choices))
(cond ((memq answer '(?? ?\C-h))
(ask-user-about-supersession-help)
(setq answer nil))
diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el
index 54bb3569788..19765e0da34 100644
--- a/lisp/vc/add-log.el
+++ b/lisp/vc/add-log.el
@@ -1,6 +1,6 @@
;;; add-log.el --- change log maintenance commands for Emacs
-;; Copyright (C) 1985-1986, 1988, 1993-1994, 1997-1998, 2000-2020 Free
+;; Copyright (C) 1985-1986, 1988, 1993-1994, 1997-1998, 2000-2021 Free
;; Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
@@ -779,7 +779,7 @@ Optional arg BUFFER-FILE overrides `buffer-file-name'."
found)))))))
(if root (setq file-name (expand-file-name cbase root))))))
;; Make a local variable in this buffer so we needn't search again.
- (set (make-local-variable 'change-log-default-name) file-name))
+ (setq-local change-log-default-name file-name))
file-name)
(defun add-log-file-name (buffer-file log-file)
@@ -1134,40 +1134,40 @@ Runs `change-log-mode-hook'.
indent-tabs-mode t
tab-width 8
show-trailing-whitespace t)
- (set (make-local-variable 'fill-forward-paragraph-function)
- 'change-log-fill-forward-paragraph)
- (set (make-local-variable 'comment-start) nil)
+ (setq-local fill-forward-paragraph-function
+ 'change-log-fill-forward-paragraph)
+ (setq-local comment-start nil)
;; Make sure we call `change-log-indent' when filling.
- (set (make-local-variable 'fill-indent-according-to-mode) t)
+ (setq-local fill-indent-according-to-mode t)
;; Avoid that filling leaves behind a single "*" on a line.
(add-hook 'fill-nobreak-predicate
(lambda ()
(looking-back "^\\s *\\*\\s *" (line-beginning-position)))
nil t)
- (set (make-local-variable 'indent-line-function) 'change-log-indent)
- (set (make-local-variable 'tab-always-indent) nil)
- (set (make-local-variable 'copyright-at-end-flag) t)
+ (setq-local indent-line-function 'change-log-indent)
+ (setq-local tab-always-indent nil)
+ (setq-local copyright-at-end-flag t)
;; We really do want "^" in paragraph-start below: it is only the
;; lines that begin at column 0 (despite the left-margin of 8) that
;; we are looking for. Adding `* ' allows eliding the blank line
;; between entries for different files.
- (set (make-local-variable 'paragraph-start) "\\s *$\\|\f\\|^\\<")
- (set (make-local-variable 'paragraph-separate) paragraph-start)
+ (setq-local paragraph-start "\\s *$\\|\f\\|^\\<")
+ (setq-local paragraph-separate paragraph-start)
;; Match null string on the date-line so that the date-line
;; is grouped with what follows.
- (set (make-local-variable 'page-delimiter) "^\\<\\|^\f")
- (set (make-local-variable 'version-control) 'never)
- (set (make-local-variable 'smerge-resolve-function)
- 'change-log-resolve-conflict)
- (set (make-local-variable 'adaptive-fill-regexp) "\\s *")
- (set (make-local-variable 'font-lock-defaults)
- '(change-log-font-lock-keywords t nil nil backward-paragraph))
- (set (make-local-variable 'multi-isearch-next-buffer-function)
- 'change-log-next-buffer)
- (set (make-local-variable 'beginning-of-defun-function)
- 'change-log-beginning-of-defun)
- (set (make-local-variable 'end-of-defun-function)
- 'change-log-end-of-defun)
+ (setq-local page-delimiter "^\\<\\|^\f")
+ (setq-local version-control 'never)
+ (setq-local smerge-resolve-function
+ 'change-log-resolve-conflict)
+ (setq-local adaptive-fill-regexp "\\s *")
+ (setq-local font-lock-defaults
+ '(change-log-font-lock-keywords t nil nil backward-paragraph))
+ (setq-local multi-isearch-next-buffer-function
+ 'change-log-next-buffer)
+ (setq-local beginning-of-defun-function
+ 'change-log-beginning-of-defun)
+ (setq-local end-of-defun-function
+ 'change-log-end-of-defun)
;; next-error function glue
(setq next-error-function 'change-log-next-error))
diff --git a/lisp/vc/compare-w.el b/lisp/vc/compare-w.el
index c7da8940f9c..932dcd78920 100644
--- a/lisp/vc/compare-w.el
+++ b/lisp/vc/compare-w.el
@@ -1,6 +1,6 @@
;;; compare-w.el --- compare text between windows for Emacs
-;; Copyright (C) 1986, 1989, 1993, 1997, 2001-2020 Free Software
+;; Copyright (C) 1986, 1989, 1993, 1997, 2001-2021 Free Software
;; Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/vc/cvs-status.el b/lisp/vc/cvs-status.el
index 6192b934cb1..ff3a2944a17 100644
--- a/lisp/vc/cvs-status.el
+++ b/lisp/vc/cvs-status.el
@@ -1,6 +1,6 @@
;;; cvs-status.el --- major mode for browsing `cvs status' output -*- lexical-binding: t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: pcl-cvs cvs status tree vc tools
@@ -92,8 +92,8 @@
;;;###autoload
(define-derived-mode cvs-status-mode fundamental-mode "CVS-Status"
"Mode used for cvs status output."
- (set (make-local-variable 'font-lock-defaults) cvs-status-font-lock-defaults)
- (set (make-local-variable 'cvs-minor-wrap-function) 'cvs-status-minor-wrap))
+ (setq-local font-lock-defaults cvs-status-font-lock-defaults)
+ (setq-local cvs-minor-wrap-function #'cvs-status-minor-wrap))
;; Define cvs-status-next and cvs-status-prev
(easy-mmode-define-navigation cvs-status cvs-status-entry-leader-re "entry")
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index 5aeb8feb990..7a474201811 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -1,6 +1,6 @@
;;; diff-mode.el --- a mode for viewing/editing context diffs -*- lexical-binding: t -*-
-;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: convenience patch diff vc
@@ -403,7 +403,8 @@ well."
'((((class color))
:foreground "red" :background "black" :weight bold)
(t :weight bold))
- "`diff-mode' face for error messages from diff.")
+ "`diff-mode' face for error messages from diff."
+ :version "28.1")
(defconst diff-yank-handler '(diff-yank-function))
(defun diff-yank-function (text)
@@ -740,7 +741,7 @@ If the prefix ARG is given, restrict the view to the current file instead."
(interactive "P")
(apply 'narrow-to-region
(if arg (diff-bounds-of-file) (diff-bounds-of-hunk)))
- (set (make-local-variable 'diff-narrowed-to) (if arg 'file 'hunk)))
+ (setq-local diff-narrowed-to (if arg 'file 'hunk)))
(defun diff--some-hunks-p ()
(save-excursion
@@ -968,8 +969,8 @@ Non-nil NOPROMPT means to prefer returning nil than to prompt the user.
PREFIX is only used internally: don't use it."
(unless (equal diff-remembered-defdir default-directory)
;; Flush diff-remembered-files-alist if the default-directory is changed.
- (set (make-local-variable 'diff-remembered-defdir) default-directory)
- (set (make-local-variable 'diff-remembered-files-alist) nil))
+ (setq-local diff-remembered-defdir default-directory)
+ (setq-local diff-remembered-files-alist nil))
(save-excursion
(save-restriction
(widen)
@@ -1015,8 +1016,8 @@ PREFIX is only used internally: don't use it."
(read-file-name (format "Use file %s: " file)
(file-name-directory file) file t
(file-name-nondirectory file)))
- (set (make-local-variable 'diff-remembered-files-alist)
- (cons (cons fs file) diff-remembered-files-alist))
+ (setq-local diff-remembered-files-alist
+ (cons (cons fs file) diff-remembered-files-alist))
file)))))))
@@ -1474,27 +1475,25 @@ a diff with \\[diff-reverse-direction].
\\{diff-mode-map}"
- (set (make-local-variable 'font-lock-defaults) diff-font-lock-defaults)
+ (setq-local font-lock-defaults diff-font-lock-defaults)
(add-hook 'font-lock-mode-hook #'diff--font-lock-cleanup nil 'local)
- (set (make-local-variable 'outline-regexp) diff-outline-regexp)
- (set (make-local-variable 'imenu-generic-expression)
- diff-imenu-generic-expression)
+ (setq-local outline-regexp diff-outline-regexp)
+ (setq-local imenu-generic-expression
+ diff-imenu-generic-expression)
;; These are not perfect. They would be better done separately for
;; context diffs and unidiffs.
- ;; (set (make-local-variable 'paragraph-start)
+ ;; (setq-local paragraph-start
;; (concat "@@ " ; unidiff hunk
;; "\\|\\*\\*\\* " ; context diff hunk or file start
;; "\\|--- [^\t]+\t")) ; context or unidiff file
;; ; start (first or second line)
- ;; (set (make-local-variable 'paragraph-separate) paragraph-start)
- ;; (set (make-local-variable 'page-delimiter) "--- [^\t]+\t")
+ ;; (setq-local paragraph-separate paragraph-start)
+ ;; (setq-local page-delimiter "--- [^\t]+\t")
;; compile support
- (set (make-local-variable 'next-error-function) #'diff-next-error)
+ (setq-local next-error-function #'diff-next-error)
- (set (make-local-variable 'beginning-of-defun-function)
- #'diff-beginning-of-file-and-junk)
- (set (make-local-variable 'end-of-defun-function)
- #'diff-end-of-file)
+ (setq-local beginning-of-defun-function #'diff-beginning-of-file-and-junk)
+ (setq-local end-of-defun-function #'diff-end-of-file)
(diff-setup-whitespace)
@@ -1516,10 +1515,9 @@ a diff with \\[diff-reverse-direction].
(delq ro-bind minor-mode-overriding-map-alist)))
nil t))
;; add-log support
- (set (make-local-variable 'add-log-current-defun-function)
- #'diff-current-defun)
- (set (make-local-variable 'add-log-buffer-file-name-function)
- (lambda () (diff-find-file-name nil 'noprompt)))
+ (setq-local add-log-current-defun-function #'diff-current-defun)
+ (setq-local add-log-buffer-file-name-function
+ (lambda () (diff-find-file-name nil 'noprompt)))
(add-function :filter-return (local 'filter-buffer-substring-function)
#'diff--filter-substring)
(unless buffer-file-name
@@ -1551,7 +1549,7 @@ a diff with \\[diff-reverse-direction].
This sets `whitespace-style' and `whitespace-trailing-regexp' so
that Whitespace mode shows trailing whitespace problems on the
modified lines of the diff."
- (set (make-local-variable 'whitespace-style) '(face trailing))
+ (setq-local whitespace-style '(face trailing))
(let ((style (save-excursion
(goto-char (point-min))
;; FIXME: For buffers filled from async processes, this search
@@ -1559,10 +1557,10 @@ modified lines of the diff."
(when (re-search-forward diff-hunk-header-re nil t)
(goto-char (match-beginning 0))
(diff-hunk-style)))))
- (set (make-local-variable 'whitespace-trailing-regexp)
- (if (eq style 'context)
- "^[-+!] .*?\\([\t ]+\\)$"
- "^[-+!<>].*?\\([\t ]+\\)$"))))
+ (setq-local whitespace-trailing-regexp
+ (if (eq style 'context)
+ "^[-+!] .*?\\([\t ]+\\)$"
+ "^[-+!<>].*?\\([\t ]+\\)$"))))
(defun diff-delete-if-empty ()
;; An empty diff file means there's no more diffs to integrate, so we
@@ -1935,10 +1933,10 @@ With a prefix argument, REVERSE the hunk."
(and buffer-file-name
(backup-file-name-p buffer-file-name)
(not diff-apply-hunk-to-backup-file)
- (not (set (make-local-variable 'diff-apply-hunk-to-backup-file)
- (yes-or-no-p (format "Really apply this hunk to %s? "
- (file-name-nondirectory
- buffer-file-name)))))))
+ (not (setq-local diff-apply-hunk-to-backup-file
+ (yes-or-no-p (format "Really apply this hunk to %s? "
+ (file-name-nondirectory
+ buffer-file-name)))))))
(error "%s"
(substitute-command-keys
(format "Use %s\\[diff-apply-hunk] to apply it to the other file"
@@ -2325,7 +2323,7 @@ where DEFUN... is a list of function names found in FILE."
;; would look for non-existent files like
;; /dev/null.
(diff-find-source-location
- (not (equal "/dev/null"
+ (not (equal null-device
(car (diff-hunk-file-names t))))))
(other-buf nil)
(goto-otherbuf
@@ -2566,8 +2564,8 @@ fixed, visit it in a buffer."
(concat "diff.*\n"
"\\(?:\\(?:new file\\|deleted\\).*\n\\)?"
"\\(?:index.*\n\\)?"
- "--- \\(?:/dev/null\\|a/\\(.*\\)\\)\n"
- "\\+\\+\\+ \\(?:/dev/null\\|b/\\(.*\\)\\)\n"))))
+ "--- \\(?:" null-device "\\|a/\\(.*\\)\\)\n"
+ "\\+\\+\\+ \\(?:" null-device "\\|b/\\(.*\\)\\)\n"))))
(put-text-property (match-beginning 0)
(or (match-beginning 2) (match-beginning 1))
'display (propertize
diff --git a/lisp/vc/diff.el b/lisp/vc/diff.el
index b7f17bf3c73..7c4931b4b89 100644
--- a/lisp/vc/diff.el
+++ b/lisp/vc/diff.el
@@ -1,6 +1,6 @@
;;; diff.el --- run `diff' -*- lexical-binding: t -*-
-;; Copyright (C) 1992, 1994, 1996, 2001-2020 Free Software Foundation,
+;; Copyright (C) 1992, 1994, 1996, 2001-2021 Free Software Foundation,
;; Inc.
;; Author: Frank Bresz
@@ -190,9 +190,9 @@ returns the buffer used."
(erase-buffer))
(buffer-enable-undo (current-buffer))
(diff-mode)
- (set (make-local-variable 'revert-buffer-function)
- (lambda (_ignore-auto _noconfirm)
- (diff-no-select old new switches no-async (current-buffer))))
+ (setq-local revert-buffer-function
+ (lambda (_ignore-auto _noconfirm)
+ (diff-no-select old new switches no-async (current-buffer))))
(setq default-directory thisdir)
(setq diff-default-directory default-directory)
(let ((inhibit-read-only t))
diff --git a/lisp/vc/ediff-diff.el b/lisp/vc/ediff-diff.el
index ccf5a7807f2..e90eaa11565 100644
--- a/lisp/vc/ediff-diff.el
+++ b/lisp/vc/ediff-diff.el
@@ -1,6 +1,6 @@
;;; ediff-diff.el --- diff-related utilities -*- lexical-binding:t -*-
-;; Copyright (C) 1994-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2021 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: ediff
@@ -149,7 +149,7 @@ This variable can be set either in .emacs or toggled interactively.
Use `setq-default' if setting it in .emacs")
(ediff-defvar-local ediff-ignore-similar-regions nil
- "If t, skip over difference regions that differ only in the white space and line breaks.
+ "If t, skip difference regions that differ only in white space and line breaks.
This variable can be set either in .emacs or toggled interactively.
Use `setq-default' if setting it in .emacs")
diff --git a/lisp/vc/ediff-help.el b/lisp/vc/ediff-help.el
index 57cb0017ef5..84bf063aedf 100644
--- a/lisp/vc/ediff-help.el
+++ b/lisp/vc/ediff-help.el
@@ -1,6 +1,6 @@
;;; ediff-help.el --- Code related to the contents of Ediff help buffers -*- lexical-binding:t -*-
-;; Copyright (C) 1996-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: ediff
diff --git a/lisp/vc/ediff-hook.el b/lisp/vc/ediff-hook.el
index ed29da13878..ff48bb3845c 100644
--- a/lisp/vc/ediff-hook.el
+++ b/lisp/vc/ediff-hook.el
@@ -1,6 +1,6 @@
;;; ediff-hook.el --- setup for Ediff's menus and autoloads -*- lexical-binding:t -*-
-;; Copyright (C) 1995-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: ediff
diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el
index 04926af16ef..0865ac5ce41 100644
--- a/lisp/vc/ediff-init.el
+++ b/lisp/vc/ediff-init.el
@@ -1,6 +1,6 @@
;;; ediff-init.el --- Macros, variables, and defsubsts used by Ediff -*- lexical-binding:t -*-
-;; Copyright (C) 1994-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2021 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: ediff
@@ -432,7 +432,7 @@ Can be used to move the frame where it is desired."
:type 'hook
:group 'ediff-hook)
(defcustom ediff-startup-hook nil
- "Hooks to run in the control buffer after Ediff has been set up and is ready for the job."
+ "Hooks to run in the control buffer after Ediff has been set up and is ready."
:type 'hook
:group 'ediff-hook)
(defcustom ediff-select-hook nil
@@ -480,7 +480,7 @@ set local variables that determine how the display looks like."
:type 'hook
:group 'ediff-hook)
(defcustom ediff-cleanup-hook nil
- "Hooks to run on exiting Ediff but before killing the control and variant buffers."
+ "Hooks to run on exiting Ediff, before killing the control and variant buffers."
:type 'hook
:group 'ediff-hook)
@@ -554,19 +554,19 @@ See the documentation string of `ediff-focus-on-regexp-matches' for details.")
;; Highlighting
(defcustom ediff-before-flag-bol "->>"
- "Flag placed before a highlighted block of differences, if block starts at beginning of a line."
+ "Flag placed before highlighted block of differences at beginning of a line."
:type 'string
:tag "Region before-flag at beginning of line"
:group 'ediff)
(defcustom ediff-after-flag-eol "<<-"
- "Flag placed after a highlighted block of differences, if block ends at end of a line."
+ "Flag placed after highlighted block of differences that ends at end of line."
:type 'string
:tag "Region after-flag at end of line"
:group 'ediff)
(defcustom ediff-before-flag-mol "->>"
- "Flag placed before a highlighted block of differences, if block starts in mid-line."
+ "Flag placed before highlighted block of differences that starts mid-line."
:type 'string
:tag "Region before-flag in the middle of line"
:group 'ediff)
@@ -1268,7 +1268,7 @@ Instead, C-h would jump to previous difference."
;; Metacharacters that have to be protected from the shell when executing
;; a diff/diff3 command.
(defcustom ediff-metachars "[ \t\n!\"#$&'()*;<=>?[\\^`{|~]"
- "Regexp that matches characters that must be quoted with `\\' in shell command line.
+ "Regexp matching characters that must be quoted with `\\' in shell command line.
This default should work without changes."
:type 'regexp
:group 'ediff)
diff --git a/lisp/vc/ediff-merg.el b/lisp/vc/ediff-merg.el
index 22656761d91..826cad9cc1b 100644
--- a/lisp/vc/ediff-merg.el
+++ b/lisp/vc/ediff-merg.el
@@ -1,6 +1,6 @@
;;; ediff-merg.el --- merging utilities -*- lexical-binding:t -*-
-;; Copyright (C) 1994-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2021 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: ediff
@@ -70,7 +70,7 @@ STRING4
:group 'ediff-merge)
(defcustom ediff-show-clashes-only nil
- "If t, show only those diff regions where both buffers disagree with the ancestor.
+ "If t, show only diff regions where both buffers disagree with the ancestor.
This means that regions that have status prefer-A or prefer-B will be
skipped over. A value of nil means show all regions."
:type 'boolean
diff --git a/lisp/vc/ediff-mult.el b/lisp/vc/ediff-mult.el
index c977291a524..d32c18be8fd 100644
--- a/lisp/vc/ediff-mult.el
+++ b/lisp/vc/ediff-mult.el
@@ -1,6 +1,6 @@
;;; ediff-mult.el --- support for multi-file/multi-buffer processing in Ediff -*- lexical-binding:t -*-
-;; Copyright (C) 1995-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: ediff
@@ -181,7 +181,7 @@ directories.")
(defvar ediff-filtering-regexp-history nil "")
(defcustom ediff-default-filtering-regexp nil
- "The default regular expression used as a filename filter in multifile comparisons.
+ "Default regular expression used as a filename filter in multifile comparisons.
Should be a sexp. For instance (car ediff-filtering-regexp-history) or nil."
:type 'sexp ; yuck - why not just a regexp?
:risky t)
@@ -2317,7 +2317,7 @@ If this is a session registry buffer then just bury it."
(meta-patchbuf ediff-meta-patchbufer)
session-buf beg-marker end-marker)
- (if (or (file-directory-p file) (string-match "/dev/null" file))
+ (if (or (file-directory-p file) (string-match null-device file))
(user-error "`%s' is not an ordinary file" (file-name-as-directory file)))
(setq session-buf (ediff-get-session-buffer info)
beg-marker (ediff-get-session-objB-name info)
diff --git a/lisp/vc/ediff-ptch.el b/lisp/vc/ediff-ptch.el
index f6af5a45550..d52910efceb 100644
--- a/lisp/vc/ediff-ptch.el
+++ b/lisp/vc/ediff-ptch.el
@@ -1,6 +1,6 @@
;;; ediff-ptch.el --- Ediff's patch support -*- lexical-binding:t -*-
-;; Copyright (C) 1996-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: ediff
@@ -193,7 +193,7 @@ program."
(let ((count 0)
(mark1 (point-min-marker))
(mark1-end (point-min))
- (possible-file-names '("/dev/null" . "/dev/null"))
+ (possible-file-names `(,null-device . ,null-device))
mark2-end mark2 filenames
beg1 beg2 end1 end2
patch-map opoint)
@@ -217,10 +217,10 @@ program."
(setq possible-file-names
(cons (if (and beg1 end1)
(buffer-substring beg1 end1)
- "/dev/null")
+ null-device)
(if (and beg2 end2)
(buffer-substring beg2 end2)
- "/dev/null")))
+ null-device)))
;; Remove file junk (Bug#26084).
(while (re-search-backward
(concat "^\\(?:" diff-file-junk-re "\\)") mark1-end t)
@@ -309,12 +309,12 @@ program."
(file-exists-p (cdr m2)))
(setq base-dir1 (car m1)
base-dir2 (car m2))))))))
- (or (string= (car proposed-file-names) "/dev/null")
+ (or (string= (car proposed-file-names) null-device)
(setcar proposed-file-names
(ediff-file-name-sans-prefix
(car proposed-file-names) base-dir1)))
(or (string=
- (cdr proposed-file-names) "/dev/null")
+ (cdr proposed-file-names) null-device)
(setcdr proposed-file-names
(ediff-file-name-sans-prefix
(cdr proposed-file-names) base-dir2)))
@@ -323,7 +323,7 @@ program."
;; take the given file name into account
(or (file-directory-p filename)
- (string= "/dev/null" filename)
+ (string= null-device filename)
(setcar (ediff-get-session-objA (car ediff-patch-map))
(cons (file-name-nondirectory filename)
(file-name-nondirectory filename))))
@@ -465,6 +465,9 @@ are two possible targets for this %spatch. However, these files do not exist."
file1 file2 (if multi-patch-p "multi-" ""))))
(princ "
\nPlease enter an alternative patch target ...\n"))
+ (when (and (string= file1 file2)
+ (y-or-n-p (format "Create %s?" file1)))
+ (write-region (point-min) (point-min) file1))
(let ((directory t)
target)
(while directory
@@ -582,7 +585,7 @@ optional argument, then use it."
patch-buf
(if (and ediff-patch-map
(not (string-match-p
- "^/dev/null"
+ (concat "^" null-device)
;; this is the file to patch
(ediff-get-session-objA-name (car ediff-patch-map))))
(> (length
diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el
index e28d8574b1c..f955ba8283a 100644
--- a/lisp/vc/ediff-util.el
+++ b/lisp/vc/ediff-util.el
@@ -1,6 +1,6 @@
;;; ediff-util.el --- the core commands and utilities of ediff -*- lexical-binding:t -*-
-;; Copyright (C) 1994-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2021 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: ediff
@@ -275,8 +275,7 @@ to invocation.")
(make-local-variable 'ediff-window-setup-function)
(make-local-variable 'ediff-keep-variants)
- (make-local-variable 'window-min-height)
- (setq window-min-height 2)
+ (setq-local window-min-height 2)
;; unwrap set up parameters passed as argument
(while setup-parameters
@@ -3444,8 +3443,8 @@ Without an argument, it saves customized diff argument, if available
(defun ediff-inferior-compare-regions ()
"Compare regions in an active Ediff session.
-Like `ediff-regions-linewise' but is called from under an active Ediff session on
-the files that belong to that session.
+Like `ediff-regions-linewise' but is called from under an active Ediff session
+on the files that belong to that session.
After quitting the session invoked via this function, type C-l to the parent
Ediff Control Panel to restore highlighting."
diff --git a/lisp/vc/ediff-vers.el b/lisp/vc/ediff-vers.el
index 4ee7ee5c1f5..13a653b270b 100644
--- a/lisp/vc/ediff-vers.el
+++ b/lisp/vc/ediff-vers.el
@@ -1,6 +1,6 @@
;;; ediff-vers.el --- version control interface to Ediff -*- lexical-binding:t -*-
-;; Copyright (C) 1995-1997, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995-1997, 2001-2021 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: ediff
diff --git a/lisp/vc/ediff-wind.el b/lisp/vc/ediff-wind.el
index a23d72070ab..47ef37a19ee 100644
--- a/lisp/vc/ediff-wind.el
+++ b/lisp/vc/ediff-wind.el
@@ -1,6 +1,6 @@
;;; ediff-wind.el --- window manipulation utilities -*- lexical-binding:t -*-
-;; Copyright (C) 1994-1997, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1997, 2000-2021 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: ediff
@@ -42,13 +42,6 @@
(require 'ediff-help)
;; end pacifier
-
-;; be careful with ediff-tbar
-(eval-and-compile
- (if (featurep 'xemacs)
- (require 'ediff-tbar)
- (defun ediff-compute-toolbar-width () 0)))
-
(defgroup ediff-window nil
"Ediff window manipulation."
:prefix "ediff-"
@@ -189,7 +182,7 @@ Used internally---not a user option.")
;; not used for now
(defvar ediff-mouse-pixel-threshold 30
- "If the user moves mouse more than this many pixels, Ediff won't warp mouse into control window.")
+ "If mouse moved more than this many pixels, don't warp mouse into control window.")
(defcustom ediff-grab-mouse t
"If t, Ediff will always grab the mouse and put it in the control frame.
@@ -269,11 +262,12 @@ keyboard input to go into icons."
(let (event)
(message
"Select windows by clicking. Please click on Window %d " wind-number)
- (while (not (ediff-mouse-event-p (setq event (read-event))))
+ (while (not (ediff-mouse-event-p (setq event
+ (read--potential-mouse-event))))
(if (sit-for 1) ; if sequence of events, wait till the final word
(beep 1))
(message "Please click on Window %d " wind-number))
- (read-event) ; discard event
+ (read--potential-mouse-event) ; discard event
(posn-window (event-start event))))
@@ -961,8 +955,7 @@ create a new splittable frame if none is found."
;; 1 more line for the mode line
(setq lines (1+ (count-lines (point-min) (point-max)))
fheight lines
- fwidth (max (+ (ediff-help-message-line-length) 2)
- (ediff-compute-toolbar-width))
+ fwidth (max (+ (ediff-help-message-line-length) 2) 0)
adjusted-parameters
(list
;; possibly change surrogate minibuffer
@@ -1291,6 +1284,9 @@ It assumes that it is called from within the control buffer."
(ediff-multiframe-setup-p)
ediff-wide-display-p)))))))
+(defun ediff-compute-toolbar-width ()
+ (declare (obsolete nil "28.1"))
+ 0)
(provide 'ediff-wind)
;;; ediff-wind.el ends here
diff --git a/lisp/vc/ediff.el b/lisp/vc/ediff.el
index ae2f8ad6c1c..ed375738b47 100644
--- a/lisp/vc/ediff.el
+++ b/lisp/vc/ediff.el
@@ -1,6 +1,6 @@
;;; ediff.el --- a comprehensive visual interface to diff & patch -*- lexical-binding:t -*-
-;; Copyright (C) 1994-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2021 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Created: February 2, 1994
@@ -939,7 +939,7 @@ arguments after setting up the Ediff buffers."
;; If WIND-A is nil, use selected window.
;; If WIND-B is nil, use window next to WIND-A.
(defun ediff-windows (dumb-mode wind-A wind-B startup-hooks job-name word-mode)
- (if (or dumb-mode (not (ediff-window-display-p)))
+ (if (or dumb-mode (not (display-mouse-p)))
(setq wind-A (ediff-get-next-window wind-A nil)
wind-B (ediff-get-next-window wind-B wind-A))
(setq wind-A (ediff-get-window-by-clicking wind-A nil 1)
diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el
index 1c69bdf4135..56b31662210 100644
--- a/lisp/vc/log-edit.el
+++ b/lisp/vc/log-edit.el
@@ -1,6 +1,6 @@
;;; log-edit.el --- Major mode for editing CVS commit messages -*- lexical-binding: t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: pcl-cvs cvs commit log vc
@@ -387,7 +387,8 @@ The first subexpression is the actual text of the field.")
nil lax))
("^\n"
(progn (goto-char (match-end 0)) (1+ (match-end 0))) nil
- (0 '(:height 0.1 :inverse-video t :extend t))))
+ (0 '(face (:height 0.1 :inverse-video t :extend t)
+ display-line-numbers-disable t rear-nonsticky t))))
(log-edit--match-first-line (0 'log-edit-summary))))
(defvar log-edit-font-lock-gnu-style nil
@@ -463,16 +464,16 @@ done. Otherwise, it uses the current buffer."
(if mode
(funcall mode)
(log-edit-mode))
- (set (make-local-variable 'log-edit-callback) callback)
+ (setq-local log-edit-callback callback)
(if (listp params)
(dolist (crt params)
(set (make-local-variable (car crt)) (cdr crt)))
;; For backward compatibility with log-edit up to version 22.2
;; accept non-list PARAMS to mean `log-edit-list'.
- (set (make-local-variable 'log-edit-listfun) params))
+ (setq-local log-edit-listfun params))
- (if buffer (set (make-local-variable 'log-edit-parent-buffer) parent))
- (set (make-local-variable 'log-edit-initial-files) (log-edit-files))
+ (if buffer (setq-local log-edit-parent-buffer parent))
+ (setq-local log-edit-initial-files (log-edit-files))
(when setup
(erase-buffer)
(run-hooks 'log-edit-hook))
@@ -489,8 +490,10 @@ the package from which this is used might also provide additional
commands (under C-x v for VC, for example).
\\{log-edit-mode-map}"
- (set (make-local-variable 'font-lock-defaults)
- '(log-edit-font-lock-keywords t))
+ (setq-local font-lock-defaults '(log-edit-font-lock-keywords t))
+ (make-local-variable 'font-lock-extra-managed-props)
+ (cl-pushnew 'rear-nonsticky font-lock-extra-managed-props)
+ (cl-pushnew 'display-line-numbers-disable font-lock-extra-managed-props)
(setq-local jit-lock-contextually t) ;For the "first line is summary".
(setq-local fill-paragraph-function #'log-edit-fill-entry)
(make-local-variable 'log-edit-comment-ring-index)
@@ -984,16 +987,17 @@ where LOGBUFFER is the name of the ChangeLog buffer, and each
(visiting-buffer (find-buffer-visiting file)))
;; If there is a buffer visiting FILE, and it has a local
;; value for `change-log-default-name', use that.
- (if (and visiting-buffer
+ (or (and visiting-buffer
(local-variable-p 'change-log-default-name
- visiting-buffer))
- (with-current-buffer visiting-buffer
- change-log-default-name)
- ;; `find-change-log' uses `change-log-default-name' if set
- ;; and sets it before exiting, so we need to work around
- ;; that memoizing which is undesired here.
- (setq change-log-default-name nil)
- (find-change-log)))))
+ visiting-buffer)
+ (with-current-buffer visiting-buffer
+ change-log-default-name))
+ ;; `find-change-log' uses `change-log-default-name' if set
+ ;; and sets it before exiting, so we need to work around
+ ;; that memoizing which is undesired here.
+ (progn
+ (setq change-log-default-name nil)
+ (find-change-log))))))
(when (or (find-buffer-visiting changelog-file-name)
(file-exists-p changelog-file-name)
add-log-dont-create-changelog-file)
diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el
index e1c2b976a49..e8930979b5d 100644
--- a/lisp/vc/log-view.el
+++ b/lisp/vc/log-view.el
@@ -1,6 +1,6 @@
;;; log-view.el --- Major mode for browsing revision log histories -*- lexical-binding: t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: tools, vc
@@ -208,6 +208,10 @@ If it is nil, `log-view-toggle-entry-display' does nothing.")
"Face for the message header line in `log-view-mode'."
:group 'log-view)
+(defface log-view-commit-body '((t :inherit font-lock-comment-face))
+ "Face for the commit body in `log-view-mode'."
+ :version "28.1")
+
(defvar log-view-file-re
(concat "^\\(?:Working file: \\(?1:.+\\)" ;RCS and CVS.
;; Subversion has no such thing??
@@ -261,12 +265,10 @@ The match group number 1 should match the revision number itself.")
(define-derived-mode log-view-mode special-mode "Log-View"
"Major mode for browsing CVS log output."
(setq buffer-read-only t)
- (set (make-local-variable 'font-lock-defaults) log-view-font-lock-defaults)
- (set (make-local-variable 'beginning-of-defun-function)
- 'log-view-beginning-of-defun)
- (set (make-local-variable 'end-of-defun-function)
- 'log-view-end-of-defun)
- (set (make-local-variable 'cvs-minor-wrap-function) 'log-view-minor-wrap)
+ (setq-local font-lock-defaults log-view-font-lock-defaults)
+ (setq-local beginning-of-defun-function #'log-view-beginning-of-defun)
+ (setq-local end-of-defun-function #'log-view-end-of-defun)
+ (setq-local cvs-minor-wrap-function #'log-view-minor-wrap)
(hack-dir-local-variables-non-file-buffer))
;;;;
@@ -415,7 +417,7 @@ This calls `log-view-expanded-log-entry-function' to do the work."
(insert long-entry "\n")
(add-text-properties
beg (point)
- '(font-lock-face font-lock-comment-face log-view-comment t))
+ '(font-lock-face log-view-commit-body log-view-comment t))
(goto-char opoint))))))))
(defun log-view-beginning-of-defun (&optional arg)
diff --git a/lisp/vc/pcvs-defs.el b/lisp/vc/pcvs-defs.el
index e558292f33b..2ee3da70274 100644
--- a/lisp/vc/pcvs-defs.el
+++ b/lisp/vc/pcvs-defs.el
@@ -1,6 +1,6 @@
;;; pcvs-defs.el --- variable definitions for PCL-CVS
-;; Copyright (C) 1991-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1991-2021 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: pcl-cvs
diff --git a/lisp/vc/pcvs-info.el b/lisp/vc/pcvs-info.el
index 9f8a168a0a8..e1197176af2 100644
--- a/lisp/vc/pcvs-info.el
+++ b/lisp/vc/pcvs-info.el
@@ -1,6 +1,6 @@
;;; pcvs-info.el --- internal representation of a fileinfo entry
-;; Copyright (C) 1991-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1991-2021 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: pcl-cvs
diff --git a/lisp/vc/pcvs-parse.el b/lisp/vc/pcvs-parse.el
index dd56aec94a0..43816501bda 100644
--- a/lisp/vc/pcvs-parse.el
+++ b/lisp/vc/pcvs-parse.el
@@ -1,6 +1,6 @@
;;; pcvs-parse.el --- the CVS output parser
-;; Copyright (C) 1991-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1991-2021 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: pcl-cvs
diff --git a/lisp/vc/pcvs-util.el b/lisp/vc/pcvs-util.el
index 45703983b24..57da7bf730e 100644
--- a/lisp/vc/pcvs-util.el
+++ b/lisp/vc/pcvs-util.el
@@ -1,6 +1,6 @@
;;; pcvs-util.el --- utility functions for PCL-CVS
-;; Copyright (C) 1991-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1991-2021 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: pcl-cvs
diff --git a/lisp/vc/pcvs.el b/lisp/vc/pcvs.el
index 1e4343cc6be..1a42c67cb1c 100644
--- a/lisp/vc/pcvs.el
+++ b/lisp/vc/pcvs.el
@@ -1,6 +1,6 @@
;;; pcvs.el --- a front-end to CVS -*- lexical-binding:t -*-
-;; Copyright (C) 1991-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1991-2021 Free Software Foundation, Inc.
;; Author: The PCL-CVS Trust <pcl-cvs@cyclic.com>
;; Per Cederqvist <ceder@lysator.liu.se>
@@ -356,10 +356,10 @@ from the current buffer."
((and (bufferp cvs-temp-buffer) (buffer-live-p cvs-temp-buffer))
cvs-temp-buffer)
(t
- (set (make-local-variable 'cvs-temp-buffer)
- (cvs-get-buffer-create
- (eval cvs-temp-buffer-name `((dir . ,dir)))
- 'noreuse))))))
+ (setq-local cvs-temp-buffer
+ (cvs-get-buffer-create
+ (eval cvs-temp-buffer-name `((dir . ,dir)))
+ 'noreuse))))))
;; Handle the potential pre-existing process.
(let ((proc (get-buffer-process buf)))
@@ -381,7 +381,7 @@ from the current buffer."
(unless nosetup (save-excursion (display-buffer buf)))
;; FIXME: this doesn't do the right thing if the user later on
;; does a `find-file-other-window' and `scroll-other-window'
- (set (make-local-variable 'other-window-scroll-buffer) buf))
+ (setq-local other-window-scroll-buffer buf))
(add-to-list 'cvs-temp-buffers buf)
@@ -393,13 +393,13 @@ from the current buffer."
;; a very large and unwanted undo record.
(buffer-disable-undo)
(erase-buffer))
- (set (make-local-variable 'cvs-buffer) cvs-buf)
+ (setq-local cvs-buffer cvs-buf)
;;(cvs-minor-mode 1)
(let ((lbd list-buffers-directory))
(if (fboundp mode) (funcall mode) (fundamental-mode))
(when lbd (setq list-buffers-directory lbd)))
(cvs-minor-mode 1)
- ;;(set (make-local-variable 'cvs-buffer) cvs-buf)
+ ;;(setq-local cvs-buffer cvs-buf)
(if normal
(buffer-enable-undo)
(setq buffer-read-only t)
@@ -466,10 +466,10 @@ If non-nil, NEW means to create a new buffer no matter what."
"\n")
(setq buffer-read-only t)
(cvs-mode)
- (set (make-local-variable 'list-buffers-directory) buffer-name)
- ;;(set (make-local-variable 'cvs-temp-buffer) (cvs-temp-buffer))
+ (setq-local list-buffers-directory buffer-name)
+ ;;(setq-local cvs-temp-buffer (cvs-temp-buffer))
(let ((cookies (ewoc-create 'cvs-fileinfo-pp "\n\n" "\n" t)))
- (set (make-local-variable 'cvs-cookies) cookies)
+ (setq-local cvs-cookies cookies)
(add-hook 'kill-buffer-hook
(lambda ()
(ignore-errors (kill-buffer cvs-temp-buffer)))
@@ -1103,7 +1103,7 @@ for a lock file. If so, it inserts a message cookie in the *cvs* buffer."
(let ((msg (match-string 1))
(lock (match-string 2)))
(with-current-buffer cvs-buffer
- (set (make-local-variable 'cvs-lock-file) lock)
+ (setq-local cvs-lock-file lock)
;; display the lock situation in the *cvs* buffer:
(ewoc-enter-last
cvs-cookies
@@ -1146,8 +1146,8 @@ Full documentation is in the Texinfo file."
(if buffer-file-name
(error "Use M-x cvs-quickdir to get a *cvs* buffer"))
(buffer-disable-undo)
- ;;(set (make-local-variable 'goal-column) cvs-cursor-column)
- (set (make-local-variable 'revert-buffer-function) 'cvs-mode-revert-buffer)
+ ;;(setq-local goal-column cvs-cursor-column)
+ (setq-local revert-buffer-function 'cvs-mode-revert-buffer)
(setq truncate-lines t)
(cvs-prefix-make-local 'cvs-branch-prefix)
(cvs-prefix-make-local 'cvs-secondary-branch-prefix)
@@ -1464,7 +1464,7 @@ The POSTPROC specified there (typically `log-edit') is then called,
(funcall setupfun 'cvs-do-commit setup
'((log-edit-listfun . cvs-commit-filelist)
(log-edit-diff-function . cvs-mode-diff)) buf)
- (set (make-local-variable 'cvs-minor-wrap-function) 'cvs-commit-minor-wrap)
+ (setq-local cvs-minor-wrap-function 'cvs-commit-minor-wrap)
(run-hooks 'cvs-mode-commit-hook)))
(defun cvs-commit-minor-wrap (_buf f)
@@ -1525,15 +1525,14 @@ This is best called from a `log-view-mode' buffer."
(with-current-buffer buf
;; Set the filename before, so log-edit can correctly setup its
;; log-edit-initial-files variable.
- (set (make-local-variable 'cvs-edit-log-files) (list file)))
+ (setq-local cvs-edit-log-files (list file)))
(funcall setupfun 'cvs-do-edit-log nil
'((log-edit-listfun . cvs-edit-log-filelist)
(log-edit-diff-function . cvs-mode-diff))
buf)
(when text (erase-buffer) (insert text))
- (set (make-local-variable 'cvs-edit-log-revision) rev)
- (set (make-local-variable 'cvs-minor-wrap-function)
- 'cvs-edit-log-minor-wrap)
+ (setq-local cvs-edit-log-revision rev)
+ (setq-local cvs-minor-wrap-function 'cvs-edit-log-minor-wrap)
;; (run-hooks 'cvs-mode-commit-hook)
))
@@ -2396,7 +2395,7 @@ The exact behavior is determined also by `cvs-dired-use-hook'."
(string-prefix-p default-directory dir))
(let ((subdir (substring dir (length default-directory))))
(set-buffer buffer)
- (set (make-local-variable 'cvs-buffer) cvs-buf)
+ (setq-local cvs-buffer cvs-buf)
;; `cvs -q add file' produces no useful output :-(
(when (and (equal (car flags) "add")
(goto-char (point-min))
diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el
index d0a83fd7c49..3b09dfe5d2e 100644
--- a/lisp/vc/smerge-mode.el
+++ b/lisp/vc/smerge-mode.el
@@ -1,6 +1,6 @@
;;; smerge-mode.el --- Minor mode to resolve diff3 conflicts -*- lexical-binding: t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: vc, tools, revision control, merge, diff3, cvs, conflict
@@ -827,7 +827,7 @@ An error is raised if not inside a conflict."
((re-search-backward smerge-base-re start t)
;; a 3-parts conflict
- (set (make-local-variable 'smerge-conflict-style) 'diff3-A)
+ (setq-local smerge-conflict-style 'diff3-A)
(setq base-end upper-end)
(setq upper-end (match-beginning 0))
(setq base-start (match-end 0)))
@@ -835,7 +835,7 @@ An error is raised if not inside a conflict."
((string= filename (file-name-nondirectory
(or buffer-file-name "")))
;; a 2-parts conflict
- (set (make-local-variable 'smerge-conflict-style) 'diff3-E))
+ (setq-local smerge-conflict-style 'diff3-E))
((and (not base-start)
(or (eq smerge-conflict-style 'diff3-A)
@@ -925,7 +925,7 @@ Its behavior has mainly two restrictions:
This only matters if `smerge-refine-weight-hack' is nil.")
(defvar smerge-refine-ignore-whitespace t
- "If non-nil, indicate that `smerge-refine' should try to ignore change in whitespace.")
+ "If non-nil, `smerge-refine' should try to ignore change in whitespace.")
(defvar smerge-refine-weight-hack t
"If non-nil, pass to diff as many lines as there are chars in the region.
@@ -1350,26 +1350,28 @@ buffer names."
;; Ediff is now set up, and we are in the control buffer.
;; Do a few further adjustments and take precautions for exit.
- (set (make-local-variable 'smerge-ediff-windows) config)
- (set (make-local-variable 'smerge-ediff-buf) buf)
- (set (make-local-variable 'ediff-quit-hook)
- (lambda ()
- (let ((buffer-A ediff-buffer-A)
- (buffer-B ediff-buffer-B)
- (buffer-C ediff-buffer-C)
- (buffer-Ancestor ediff-ancestor-buffer)
- (buf smerge-ediff-buf)
- (windows smerge-ediff-windows))
- (ediff-cleanup-mess)
- (with-current-buffer buf
- (erase-buffer)
- (insert-buffer-substring buffer-C)
- (kill-buffer buffer-A)
- (kill-buffer buffer-B)
- (kill-buffer buffer-C)
- (when (bufferp buffer-Ancestor) (kill-buffer buffer-Ancestor))
- (set-window-configuration windows)
- (message "Conflict resolution finished; you may save the buffer")))))
+ (setq-local smerge-ediff-windows config)
+ (setq-local smerge-ediff-buf buf)
+ (add-hook 'ediff-quit-hook
+ (lambda ()
+ (let ((buffer-A ediff-buffer-A)
+ (buffer-B ediff-buffer-B)
+ (buffer-C ediff-buffer-C)
+ (buffer-Ancestor ediff-ancestor-buffer)
+ (buf smerge-ediff-buf)
+ (windows smerge-ediff-windows))
+ (ediff-cleanup-mess)
+ (with-current-buffer buf
+ (erase-buffer)
+ (insert-buffer-substring buffer-C)
+ (kill-buffer buffer-A)
+ (kill-buffer buffer-B)
+ (kill-buffer buffer-C)
+ (when (bufferp buffer-Ancestor)
+ (kill-buffer buffer-Ancestor))
+ (set-window-configuration windows)
+ (message "Conflict resolution finished; you may save the buffer"))))
+ nil t)
(message "Please resolve conflicts now; exit ediff when done")))
(defun smerge-makeup-conflict (pt1 pt2 pt3 &optional pt4)
@@ -1420,11 +1422,11 @@ with a \\[universal-argument] prefix, makes up a 3-way conflict."
(font-lock-fontify-region (match-beginning 0) (match-end 0) nil)))))
(if (string-match (regexp-quote smerge-parsep-re) paragraph-separate)
(unless smerge-mode
- (set (make-local-variable 'paragraph-separate)
- (replace-match "" t t paragraph-separate)))
+ (setq-local paragraph-separate
+ (replace-match "" t t paragraph-separate)))
(when smerge-mode
- (set (make-local-variable 'paragraph-separate)
- (concat smerge-parsep-re paragraph-separate))))
+ (setq-local paragraph-separate
+ (concat smerge-parsep-re paragraph-separate))))
(unless smerge-mode
(smerge-remove-props (point-min) (point-max))))
diff --git a/lisp/vc/vc-annotate.el b/lisp/vc/vc-annotate.el
index 5198bccf846..b0435ab53ee 100644
--- a/lisp/vc/vc-annotate.el
+++ b/lisp/vc/vc-annotate.el
@@ -1,6 +1,6 @@
;;; vc-annotate.el --- VC Annotate Support -*- lexical-binding: t -*-
-;; Copyright (C) 1997-1998, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2000-2021 Free Software Foundation, Inc.
;; Author: Martin Lorentzson <emwson@emw.ericsson.se>
;; Maintainer: emacs-devel@gnu.org
@@ -208,9 +208,8 @@ menu items."
;; it will become a list, to avoid initial annotations being invisible.
(add-to-invisibility-spec 'foo)
(remove-from-invisibility-spec 'foo)
- (set (make-local-variable 'truncate-lines) t)
- (set (make-local-variable 'font-lock-defaults)
- '(vc-annotate-font-lock-keywords t))
+ (setq-local truncate-lines t)
+ (setq-local font-lock-defaults '(vc-annotate-font-lock-keywords t))
(hack-dir-local-variables-non-file-buffer))
(defun vc-annotate-toggle-annotation-visibility ()
@@ -449,11 +448,10 @@ should be applied to the background or to the foreground."
(with-current-buffer temp-buffer-name
(unless (equal major-mode 'vc-annotate-mode)
(vc-annotate-mode))
- (set (make-local-variable 'vc-annotate-backend) backend)
- (set (make-local-variable 'vc-annotate-parent-file) file)
- (set (make-local-variable 'vc-annotate-parent-rev) rev)
- (set (make-local-variable 'vc-annotate-parent-display-mode)
- display-mode))))
+ (setq-local vc-annotate-backend backend)
+ (setq-local vc-annotate-parent-file file)
+ (setq-local vc-annotate-parent-rev rev)
+ (setq-local vc-annotate-parent-display-mode display-mode))))
(with-current-buffer temp-buffer-name
(vc-run-delayed
@@ -702,10 +700,10 @@ or OFFSET if present."
RATIO is the expansion that should be applied to `vc-annotate-color-map'.
The annotations are relative to the current time, unless overridden by OFFSET."
(when (/= ratio 1.0)
- (set (make-local-variable 'vc-annotate-color-map)
+ (setq-local vc-annotate-color-map
(mapcar (lambda (elem) (cons (* (car elem) ratio) (cdr elem)))
vc-annotate-color-map)))
- (set (make-local-variable 'vc-annotate-offset) offset)
+ (setq-local vc-annotate-offset offset)
(font-lock-mode 1))
(defun vc-annotate-lines (limit)
diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index e2d0ca69a20..e4eff486f5e 100644
--- a/lisp/vc/vc-bzr.el
+++ b/lisp/vc/vc-bzr.el
@@ -1,6 +1,6 @@
;;; vc-bzr.el --- VC backend for the bzr revision control system -*- lexical-binding: t -*-
-;; Copyright (C) 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2021 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Riccardo Murri <riccardo.murri@gmail.com>
@@ -701,18 +701,18 @@ or a superior directory.")
(define-derived-mode vc-bzr-log-view-mode log-view-mode "Bzr-Log-View"
(remove-hook 'log-view-mode-hook 'vc-bzr-log-view-mode) ;Deactivate the hack.
(require 'add-log)
- (set (make-local-variable 'log-view-per-file-logs) nil)
- (set (make-local-variable 'log-view-file-re) regexp-unmatchable)
- (set (make-local-variable 'log-view-message-re)
+ (setq-local log-view-per-file-logs nil)
+ (setq-local log-view-file-re regexp-unmatchable)
+ (setq-local log-view-message-re
(if (eq vc-log-view-type 'short)
"^ *\\([0-9.]+\\): \\(.*?\\)[ \t]+\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\)\\( \\[merge\\]\\)?"
"^ *\\(?:revno: \\([0-9.]+\\)\\|merged: .+\\)"))
;; Allow expanding short log entries
(when (eq vc-log-view-type 'short)
(setq truncate-lines t)
- (set (make-local-variable 'log-view-expanded-log-entry-function)
- 'vc-bzr-expanded-log-entry))
- (set (make-local-variable 'log-view-font-lock-keywords)
+ (setq-local log-view-expanded-log-entry-function
+ 'vc-bzr-expanded-log-entry))
+ (setq-local log-view-font-lock-keywords
;; log-view-font-lock-keywords is careful to use the buffer-local
;; value of log-view-message-re only since Emacs-23.
(if (eq vc-log-view-type 'short)
diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el
index fdbf44e0f13..a595cc9778b 100644
--- a/lisp/vc/vc-cvs.el
+++ b/lisp/vc/vc-cvs.el
@@ -1,6 +1,6 @@
;;; vc-cvs.el --- non-resident support for CVS version-control -*- lexical-binding: t -*-
-;; Copyright (C) 1995, 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1998-2021 Free Software Foundation, Inc.
;; Author: FSF (see vc.el for full credits)
;; Package: vc
diff --git a/lisp/vc/vc-dav.el b/lisp/vc/vc-dav.el
index d453cb41cea..88f46eff059 100644
--- a/lisp/vc/vc-dav.el
+++ b/lisp/vc/vc-dav.el
@@ -1,6 +1,6 @@
;;; vc-dav.el --- vc.el support for WebDAV
-;; Copyright (C) 2001, 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2004-2021 Free Software Foundation, Inc.
;; Author: Bill Perry <wmperry@gnu.org>
;; Keywords: url, vc
diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el
index cdf8ab984e8..bbb73240be2 100644
--- a/lisp/vc/vc-dir.el
+++ b/lisp/vc/vc-dir.el
@@ -1,6 +1,6 @@
;;; vc-dir.el --- Directory status display under VC -*- lexical-binding: t -*-
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Dan Nicolaescu <dann@ics.uci.edu>
;; Keywords: vc tools
@@ -1103,19 +1103,17 @@ commands act on the child files of that directory that are displayed in
the *vc-dir* buffer.
\\{vc-dir-mode-map}"
- (set (make-local-variable 'vc-dir-backend) use-vc-backend)
- (set (make-local-variable 'desktop-save-buffer)
- 'vc-dir-desktop-buffer-misc-data)
+ (setq-local vc-dir-backend use-vc-backend)
+ (setq-local desktop-save-buffer 'vc-dir-desktop-buffer-misc-data)
(setq-local bookmark-make-record-function #'vc-dir-bookmark-make-record)
(setq buffer-read-only t)
(when (boundp 'tool-bar-map)
- (set (make-local-variable 'tool-bar-map) vc-dir-tool-bar-map))
+ (setq-local tool-bar-map vc-dir-tool-bar-map))
(let ((buffer-read-only nil))
(erase-buffer)
- (set (make-local-variable 'vc-dir-process-buffer) nil)
- (set (make-local-variable 'vc-ewoc) (ewoc-create #'vc-dir-printer))
- (set (make-local-variable 'revert-buffer-function)
- 'vc-dir-revert-buffer-function)
+ (setq-local vc-dir-process-buffer nil)
+ (setq-local vc-ewoc (ewoc-create #'vc-dir-printer))
+ (setq-local revert-buffer-function 'vc-dir-revert-buffer-function)
(setq list-buffers-directory (expand-file-name "*vc-dir*" default-directory))
(add-to-list 'vc-dir-buffers (current-buffer))
;; Make sure that if the directory buffer is killed, the update
diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el
index 99bf5bf9b64..6b17f2afe74 100644
--- a/lisp/vc/vc-dispatcher.el
+++ b/lisp/vc/vc-dispatcher.el
@@ -1,6 +1,6 @@
;;; vc-dispatcher.el -- generic command-dispatcher facility. -*- lexical-binding: t -*-
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: FSF (see below for full credits)
;; Keywords: vc tools
@@ -138,7 +138,9 @@ preserve the setting."
;; Variables the user doesn't need to know about.
(defvar vc-log-operation nil)
-(defvar vc-log-after-operation-hook nil)
+(defvar vc-log-after-operation-hook nil
+ "Name of the hook run at the end of `vc-finish-logentry'.
+BEWARE: Despite its name, this variable is not itself a hook!")
(defvar vc-log-fileset)
;; In a log entry buffer, this is a local variable
@@ -177,9 +179,9 @@ Another is that undo information is not kept."
;; want any of its output to appear from now on.
(when oldproc (delete-process oldproc)))
(kill-all-local-variables)
- (set (make-local-variable 'vc-parent-buffer) camefrom)
- (set (make-local-variable 'vc-parent-buffer-name)
- (concat " from " (buffer-name camefrom)))
+ (setq-local vc-parent-buffer camefrom)
+ (setq-local vc-parent-buffer-name
+ (concat " from " (buffer-name camefrom)))
(setq default-directory olddir)
(let ((buffer-undo-list t)
(inhibit-read-only t))
@@ -409,8 +411,8 @@ Display the buffer in some window, but don't select it."
(symbol-value error-regexp-alist))))
(let ((compilation-error-regexp-alist error-regexp-alist))
(compilation-mode))
- (set (make-local-variable 'compilation-error-regexp-alist)
- error-regexp-alist)))
+ (setq-local compilation-error-regexp-alist
+ error-regexp-alist)))
(declare-function vc-dir-refresh "vc-dir" ())
@@ -676,14 +678,14 @@ BACKEND, if non-nil, specifies a VC backend for the Log Edit buffer."
(if (and comment (not initial-contents))
(set-buffer (get-buffer-create logbuf))
(pop-to-buffer (get-buffer-create logbuf)))
- (set (make-local-variable 'vc-parent-buffer) parent)
- (set (make-local-variable 'vc-parent-buffer-name)
- (concat " from " (buffer-name vc-parent-buffer)))
+ (setq-local vc-parent-buffer parent)
+ (setq-local vc-parent-buffer-name
+ (concat " from " (buffer-name vc-parent-buffer)))
(vc-log-edit files mode backend)
(make-local-variable 'vc-log-after-operation-hook)
(when after-hook
(setq vc-log-after-operation-hook after-hook))
- (set (make-local-variable 'vc-log-operation) action)
+ (setq-local vc-log-operation action)
(when comment
(erase-buffer)
(when (stringp comment) (insert comment)))
diff --git a/lisp/vc/vc-filewise.el b/lisp/vc/vc-filewise.el
index 67c696ced29..ee73aa6f938 100644
--- a/lisp/vc/vc-filewise.el
+++ b/lisp/vc/vc-filewise.el
@@ -1,6 +1,6 @@
;;; vc-filewise.el --- common functions for file-oriented back ends.
-;; Copyright (C) 1992-1996, 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1992-1996, 1998-2021 Free Software Foundation, Inc.
;; Author: FSF (see vc.el for full credits)
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 91554bb6d83..a9ee28e3aad 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -1,6 +1,6 @@
;;; vc-git.el --- VC backend for the git version control system -*- lexical-binding: t -*-
-;; Copyright (C) 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2021 Free Software Foundation, Inc.
;; Author: Alexandre Julliard <julliard@winehq.org>
;; Keywords: vc tools
@@ -72,7 +72,7 @@
;; by git, so it's probably
;; not a good idea.
;; - merge-news (file) see `merge-file'
-;; - mark-resolved (file) OK
+;; - mark-resolved (files) OK
;; - steal-lock (file &optional revision) NOT NEEDED
;; HISTORY FUNCTIONS
;; * print-log (files buffer &optional shortlog start-revision limit) OK
@@ -1242,18 +1242,18 @@ log entries."
(define-derived-mode vc-git-log-view-mode log-view-mode "Git-Log-View"
(require 'add-log) ;; We need the faces add-log.
;; Don't have file markers, so use impossible regexp.
- (set (make-local-variable 'log-view-file-re) regexp-unmatchable)
- (set (make-local-variable 'log-view-per-file-logs) nil)
- (set (make-local-variable 'log-view-message-re)
- (if (not (memq vc-log-view-type '(long log-search with-diff)))
- (cadr vc-git-root-log-format)
- "^commit +\\([0-9a-z]+\\)"))
+ (setq-local log-view-file-re regexp-unmatchable)
+ (setq-local log-view-per-file-logs nil)
+ (setq-local log-view-message-re
+ (if (not (memq vc-log-view-type '(long log-search with-diff)))
+ (cadr vc-git-root-log-format)
+ "^commit +\\([0-9a-z]+\\)"))
;; Allow expanding short log entries.
(when (memq vc-log-view-type '(short log-outgoing log-incoming mergebase))
(setq truncate-lines t)
- (set (make-local-variable 'log-view-expanded-log-entry-function)
- 'vc-git-expanded-log-entry))
- (set (make-local-variable 'log-view-font-lock-keywords)
+ (setq-local log-view-expanded-log-entry-function
+ 'vc-git-expanded-log-entry))
+ (setq-local log-view-font-lock-keywords
(if (not (memq vc-log-view-type '(long log-search with-diff)))
(list (cons (nth 1 vc-git-root-log-format)
(nth 2 vc-git-root-log-format)))
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index cb0657e70a0..c4b82ab11eb 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -1,6 +1,6 @@
;;; vc-hg.el --- VC backend for the mercurial version control system -*- lexical-binding: t -*-
-;; Copyright (C) 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2021 Free Software Foundation, Inc.
;; Author: Ivan Kanis
;; Maintainer: emacs-devel@gnu.org
@@ -222,8 +222,11 @@ If `ask', you will be prompted for a branch type."
(defun vc-hg-registered (file)
"Return non-nil if FILE is registered with hg."
(when (vc-hg-root file) ; short cut
- (let ((state (vc-hg-state file))) ; expensive
- (and state (not (memq state '(ignored unregistered)))))))
+ (let ((state (vc-state file 'Hg))) ; expensive
+ (if (memq state '(ignored unregistered nil))
+ ;; Clear the cache for proper fallback to another backend.
+ (ignore (vc-file-setprop file 'vc-state nil))
+ t))))
(defun vc-hg-state (file)
"Hg-specific version of `vc-state'."
@@ -273,13 +276,12 @@ If `ask', you will be prompted for a branch type."
((eq state ?C) 'up-to-date) ;; Older mercurial versions use this.
(t 'up-to-date))))))
-(defun vc-hg-working-revision (file)
+(defun vc-hg-working-revision (_file)
"Hg-specific version of `vc-working-revision'."
- (or (ignore-errors
- (with-output-to-string
- (vc-hg-command standard-output 0 file
- "parent" "--template" "{rev}")))
- "0"))
+ (ignore-errors
+ (with-output-to-string
+ (vc-hg-command standard-output 0 nil
+ "log" "-r" "." "--template" "{rev}"))))
(defcustom vc-hg-symbolic-revision-styles
'(builtin-active-bookmark
@@ -461,19 +463,19 @@ If LIMIT is non-nil, show no more than this many entries."
(define-derived-mode vc-hg-log-view-mode log-view-mode "Hg-Log-View"
(require 'add-log) ;; we need the add-log faces
- (set (make-local-variable 'log-view-file-re) regexp-unmatchable)
- (set (make-local-variable 'log-view-per-file-logs) nil)
- (set (make-local-variable 'log-view-message-re)
- (if (eq vc-log-view-type 'short)
- (cadr vc-hg-root-log-format)
- "^changeset:[ \t]*\\([0-9]+\\):\\(.+\\)"))
- (set (make-local-variable 'tab-width) 2)
+ (setq-local log-view-file-re regexp-unmatchable)
+ (setq-local log-view-per-file-logs nil)
+ (setq-local log-view-message-re
+ (if (eq vc-log-view-type 'short)
+ (cadr vc-hg-root-log-format)
+ "^changeset:[ \t]*\\([0-9]+\\):\\(.+\\)"))
+ (setq-local tab-width 2)
;; Allow expanding short log entries
(when (eq vc-log-view-type 'short)
(setq truncate-lines t)
- (set (make-local-variable 'log-view-expanded-log-entry-function)
- 'vc-hg-expanded-log-entry))
- (set (make-local-variable 'log-view-font-lock-keywords)
+ (setq-local log-view-expanded-log-entry-function
+ 'vc-hg-expanded-log-entry))
+ (setq-local log-view-font-lock-keywords
(if (eq vc-log-view-type 'short)
(list (cons (nth 1 vc-hg-root-log-format)
(nth 2 vc-hg-root-log-format)))
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el
index f09ceddcb37..f910f9d5496 100644
--- a/lisp/vc/vc-hooks.el
+++ b/lisp/vc/vc-hooks.el
@@ -1,6 +1,6 @@
;;; vc-hooks.el --- resident support for version-control -*- lexical-binding:t -*-
-;; Copyright (C) 1992-1996, 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1992-1996, 1998-2021 Free Software Foundation, Inc.
;; Author: FSF (see vc.el for full credits)
;; Maintainer: emacs-devel@gnu.org
@@ -814,7 +814,7 @@ In the latter case, VC mode is deactivated for this buffer."
(unless vc-make-backup-files
;; Use this variable, not make-backup-files,
;; because this is for things that depend on the file name.
- (set (make-local-variable 'backup-inhibited) t)))
+ (setq-local backup-inhibited t)))
((let* ((truename (and buffer-file-truename
(expand-file-name buffer-file-truename)))
(link-type (and truename
diff --git a/lisp/vc/vc-mtn.el b/lisp/vc/vc-mtn.el
index 3c26ffc0e58..3b610a1e4fe 100644
--- a/lisp/vc/vc-mtn.el
+++ b/lisp/vc/vc-mtn.el
@@ -1,6 +1,6 @@
;;; vc-mtn.el --- VC backend for Monotone -*- lexical-binding: t -*-
-;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: vc
@@ -239,14 +239,14 @@ If LIMIT is non-nil, show no more than this many entries."
(define-derived-mode vc-mtn-log-view-mode log-view-mode "Mtn-Log-View"
;; Don't match anything.
- (set (make-local-variable 'log-view-file-re) regexp-unmatchable)
- (set (make-local-variable 'log-view-per-file-logs) nil)
+ (setq-local log-view-file-re regexp-unmatchable)
+ (setq-local log-view-per-file-logs nil)
;; TODO: Use a more precise regexp than "[ |/]+" to avoid false positives
;; in the ChangeLog text.
- (set (make-local-variable 'log-view-message-re)
- "^[ |/]+Revision: \\([0-9a-f]+\\)")
+ (setq-local log-view-message-re
+ "^[ |/]+Revision: \\([0-9a-f]+\\)")
(require 'add-log) ;For change-log faces.
- (set (make-local-variable 'log-view-font-lock-keywords)
+ (setq-local log-view-font-lock-keywords
(append log-view-font-lock-keywords
'(("^[ |]+Author: \\(.*\\)" (1 'change-log-email))
("^[ |]+Date: \\(.*\\)" (1 'change-log-date))))))
diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el
index 23f088b0cff..8d64ee5cc57 100644
--- a/lisp/vc/vc-rcs.el
+++ b/lisp/vc/vc-rcs.el
@@ -1,6 +1,6 @@
;;; vc-rcs.el --- support for RCS version-control -*- lexical-binding:t -*-
-;; Copyright (C) 1992-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1992-2021 Free Software Foundation, Inc.
;; Author: FSF (see vc.el for full credits)
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/vc/vc-sccs.el b/lisp/vc/vc-sccs.el
index ba50c36832d..3d3f4048052 100644
--- a/lisp/vc/vc-sccs.el
+++ b/lisp/vc/vc-sccs.el
@@ -1,6 +1,6 @@
;;; vc-sccs.el --- support for SCCS version-control -*- lexical-binding:t -*-
-;; Copyright (C) 1992-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1992-2021 Free Software Foundation, Inc.
;; Author: FSF (see vc.el for full credits)
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/vc/vc-src.el b/lisp/vc/vc-src.el
index 4eb638978a9..201d69d79a1 100644
--- a/lisp/vc/vc-src.el
+++ b/lisp/vc/vc-src.el
@@ -1,6 +1,6 @@
;;; vc-src.el --- support for SRC version-control -*- lexical-binding:t -*-
-;; Copyright (C) 1992-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1992-2021 Free Software Foundation, Inc.
;; Author: FSF (see vc.el for full credits)
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el
index 06dd09490d2..da5471107d2 100644
--- a/lisp/vc/vc-svn.el
+++ b/lisp/vc/vc-svn.el
@@ -1,6 +1,6 @@
;;; vc-svn.el --- non-resident support for Subversion version-control -*- lexical-binding:t -*-
-;; Copyright (C) 2003-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
;; Author: FSF (see vc.el for full credits)
;; Maintainer: Stefan Monnier <monnier@gnu.org>
@@ -548,7 +548,7 @@ or svn+ssh://."
(define-derived-mode vc-svn-log-view-mode log-view-mode "SVN-Log-View"
(require 'add-log)
- (set (make-local-variable 'log-view-per-file-logs) nil))
+ (setq-local log-view-per-file-logs nil))
(autoload 'vc-setup-buffer "vc-dispatcher")
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 8def7da3776..bc9f11202b1 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -1,6 +1,6 @@
;;; vc.el --- drive a version-control system from within Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1992-1998, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1992-1998, 2000-2021 Free Software Foundation, Inc.
;; Author: FSF (see below for full credits)
;; Maintainer: emacs-devel@gnu.org
@@ -201,7 +201,7 @@
;;
;; STATE-CHANGING FUNCTIONS
;;
-;; * create-repo (backend)
+;; * create-repo ()
;;
;; Create an empty repository in the current directory and initialize
;; it so VC mode can add files to it. For file-oriented systems, this
@@ -275,7 +275,7 @@
;; If FILE is in the `added' state it should be returned to the
;; `unregistered' state.
;;
-;; - merge-file (file rev1 rev2)
+;; - merge-file (file &optional rev1 rev2)
;;
;; Merge the changes between REV1 and REV2 into the current working
;; file (for non-distributed VCS). It is expected that with an
@@ -333,19 +333,19 @@
;; the case). Not all backends support this. At present, this is
;; only ever used with LIMIT = 1 (by vc-annotate-show-log-revision-at-line).
;;
-;; * log-outgoing (backend remote-location)
+;; * log-outgoing (buffer remote-location)
;;
;; Insert in BUFFER the revision log for the changes that will be
;; sent when performing a push operation to REMOTE-LOCATION.
;;
-;; * log-incoming (backend remote-location)
+;; * log-incoming (buffer remote-location)
;;
;; Insert in BUFFER the revision log for the changes that will be
;; received when performing a pull operation from REMOTE-LOCATION.
;;
-;; - log-search (pattern)
+;; - log-search (buffer pattern)
;;
-;; Search for PATTERN in the revision log.
+;; Search for PATTERN in the revision log and output results into BUFFER.
;;
;; - log-view-mode ()
;;
@@ -478,7 +478,7 @@
;;
;; Return the root of the VC controlled hierarchy for file.
;;
-;; - ignore (file &optional directory)
+;; - ignore (file &optional directory remove)
;;
;; Ignore FILE under DIRECTORY (default is 'default-directory').
;; FILE is a file wildcard relative to DIRECTORY.
@@ -487,7 +487,7 @@
;; When called from Lisp code, if DIRECTORY is non-nil, the
;; repository to use will be deduced by DIRECTORY.
;;
-;; - ignore-completion-table
+;; - ignore-completion-table (directory)
;;
;; Return the completion table for files ignored by the current
;; version control system, e.g., the entries in `.gitignore' and
@@ -1045,7 +1045,7 @@ requesting the fileset doesn't intend to change the VC state,
such as when printing the log or showing the diffs.
If the current buffer is in `vc-dir' or Dired mode, FILESET is the
-list of marked files, or the current directory if no files are
+list of marked files, or the file under point if no files are
marked.
Otherwise, if the current buffer is visiting a version-controlled
file or is an indirect buffer whose base buffer visits a
@@ -1391,7 +1391,7 @@ first backend that could register the file is used."
(unless fname
(setq fname buffer-file-name))
(when (vc-call-backend backend 'registered fname)
- (error "This file is already registered"))
+ (error "This file is already registered: %s" fname))
;; Watch out for new buffers of size 0: the corresponding file
;; does not exist yet, even though buffer-modified-p is nil.
(when bname
@@ -1411,8 +1411,7 @@ first backend that could register the file is used."
;; the buffers visiting files affected by this `vc-register', not
;; in the current-buffer.
;; (unless vc-make-backup-files
- ;; (make-local-variable 'backup-inhibited)
- ;; (setq backup-inhibited t))
+ ;; (setq-local backup-inhibited t))
(vc-resynch-buffer file t t))
files)
@@ -1774,16 +1773,16 @@ Return t if the buffer had changes, nil otherwise."
;; Diff it against /dev/null.
(apply #'vc-do-command buffer
(if async 'async 1) "diff" file
- (append (vc-switches nil 'diff) '("/dev/null"))))))
+ (append (vc-switches nil 'diff) `(,(null-device)))))))
(setq files (nreverse filtered))))
(vc-call-backend (car vc-fileset) 'diff files rev1 rev2 buffer async)
(set-buffer buffer)
(diff-mode)
- (set (make-local-variable 'diff-vc-backend) (car vc-fileset))
- (set (make-local-variable 'diff-vc-revisions) (list rev1 rev2))
- (set (make-local-variable 'revert-buffer-function)
- (lambda (_ignore-auto _noconfirm)
- (vc-diff-internal async vc-fileset rev1 rev2 verbose)))
+ (setq-local diff-vc-backend (car vc-fileset))
+ (setq-local diff-vc-revisions (list rev1 rev2))
+ (setq-local revert-buffer-function
+ (lambda (_ignore-auto _noconfirm)
+ (vc-diff-internal async vc-fileset rev1 rev2 verbose)))
;; Make the *vc-diff* buffer read only, the diff-mode key
;; bindings are nicer for read only buffers. pcl-cvs does the
;; same thing.
@@ -2118,7 +2117,7 @@ Saves the buffer to the file."
(with-current-buffer result-buf
;; Set the parent buffer so that things like
;; C-x v g, C-x v l, ... etc work.
- (set (make-local-variable 'vc-parent-buffer) filebuf))
+ (setq-local vc-parent-buffer filebuf))
result-buf)))
(defun vc-find-revision-no-save (file revision &optional backend buffer)
@@ -2165,7 +2164,7 @@ Unlike `vc-find-revision-save', doesn't save the buffer to the file."
(get-file-buffer filename)
(find-file-noselect filename))))
(with-current-buffer result-buf
- (set (make-local-variable 'vc-parent-buffer) filebuf))
+ (setq-local vc-parent-buffer filebuf))
result-buf)))
;; Header-insertion code
@@ -2326,7 +2325,8 @@ checked out in that new branch."
;; to ask for a directory, branches are created at repository level.
default-directory
(read-directory-name "Directory: " default-directory default-directory t))
- (read-string (if current-prefix-arg "New branch name: " "New tag name: "))
+ (read-string (if current-prefix-arg "New branch name: " "New tag name: ")
+ nil 'vc-revision-history)
current-prefix-arg)))
(message "Making %s... " (if branchp "branch" "tag"))
(when (file-directory-p dir) (setq dir (file-name-as-directory dir)))
@@ -2386,11 +2386,13 @@ This function runs the hook `vc-retrieve-tag-hook' when finished."
;; for the root directory.
(defvar vc-log-short-style '(directory)
"Whether or not to show a short log.
-If it contains `directory' then if the fileset contains a directory show a short log.
-If it contains `file' then show short logs for files.
+If it contains `directory', show a short log if the fileset
+contains a directory.
+If it contains `file', show short logs for files.
Not all VC backends support short logs!")
(defvar log-view-vc-fileset)
+(defvar log-view-message-re)
(defun vc-print-log-setup-buttons (working-revision is-start-revision limit pl-return)
"Insert at the end of the current buffer buttons to show more log entries.
@@ -2400,21 +2402,32 @@ Does nothing if IS-START-REVISION is non-nil, or if LIMIT is nil,
or if PL-RETURN is `limit-unsupported'."
(when (and limit (not (eq 'limit-unsupported pl-return))
(not is-start-revision))
- (goto-char (point-max))
- (insert "\n")
- (insert-text-button "Show 2X entries"
- 'action (lambda (&rest _ignore)
- (vc-print-log-internal
- log-view-vc-backend log-view-vc-fileset
- working-revision nil (* 2 limit)))
- 'help-echo "Show the log again, and double the number of log entries shown")
- (insert " ")
- (insert-text-button "Show unlimited entries"
- 'action (lambda (&rest _ignore)
- (vc-print-log-internal
- log-view-vc-backend log-view-vc-fileset
- working-revision nil nil))
- 'help-echo "Show the log again, including all entries")))
+ (let ((entries 0))
+ (goto-char (point-min))
+ (while (re-search-forward log-view-message-re nil t)
+ (cl-incf entries))
+ ;; If we got fewer entries than we asked for, then displaying
+ ;; the "more" buttons isn't useful.
+ (when (>= entries limit)
+ (goto-char (point-max))
+ (insert "\n")
+ (insert-text-button
+ "Show 2X entries"
+ 'action (lambda (&rest _ignore)
+ (vc-print-log-internal
+ log-view-vc-backend log-view-vc-fileset
+ working-revision nil (* 2 limit)))
+ 'help-echo
+ "Show the log again, and double the number of log entries shown")
+ (insert " ")
+ (insert-text-button
+ "Show unlimited entries"
+ 'action (lambda (&rest _ignore)
+ (vc-print-log-internal
+ log-view-vc-backend log-view-vc-fileset
+ working-revision nil nil))
+ 'help-echo "Show the log again, including all entries")
+ (insert "\n")))))
(defun vc-print-log-internal (backend files working-revision
&optional is-start-revision limit type)
@@ -2466,7 +2479,7 @@ earlier revisions. Show up to LIMIT entries (non-nil means unlimited)."
rev-buff-func)
(let (retval (buffer (get-buffer-create buffer-name)))
(with-current-buffer buffer
- (set (make-local-variable 'vc-log-view-type) type))
+ (setq-local vc-log-view-type type))
(setq retval (funcall backend-func backend buffer-name type files))
(with-current-buffer buffer
(let ((inhibit-read-only t))
@@ -2478,10 +2491,9 @@ earlier revisions. Show up to LIMIT entries (non-nil means unlimited)."
backend 'region-history-mode))
'region-history-mode
'log-view-mode))
- (set (make-local-variable 'log-view-vc-backend) backend)
- (set (make-local-variable 'log-view-vc-fileset) files)
- (set (make-local-variable 'revert-buffer-function)
- rev-buff-func)))
+ (setq-local log-view-vc-backend backend)
+ (setq-local log-view-vc-fileset files)
+ (setq-local revert-buffer-function rev-buff-func)))
;; Display after setting up major-mode, so display-buffer-alist can know
;; the major-mode.
(pop-to-buffer buffer)
@@ -2679,13 +2691,13 @@ mark."
(vc-call region-history file buf lfrom lto)
(with-current-buffer buf
(vc-call-backend backend 'region-history-mode)
- (set (make-local-variable 'log-view-vc-backend) backend)
- (set (make-local-variable 'log-view-vc-fileset) (list file))
- (set (make-local-variable 'revert-buffer-function)
- (lambda (_ignore-auto _noconfirm)
- (with-current-buffer buf
- (let ((inhibit-read-only t)) (erase-buffer)))
- (vc-call region-history file buf lfrom lto))))
+ (setq-local log-view-vc-backend backend)
+ (setq-local log-view-vc-fileset (list file))
+ (setq-local revert-buffer-function
+ (lambda (_ignore-auto _noconfirm)
+ (with-current-buffer buf
+ (let ((inhibit-read-only t)) (erase-buffer)))
+ (vc-call region-history file buf lfrom lto))))
(display-buffer buf)))
;;;###autoload
diff --git a/lisp/vcursor.el b/lisp/vcursor.el
index 3601abcd6e4..e699df4842d 100644
--- a/lisp/vcursor.el
+++ b/lisp/vcursor.el
@@ -1,6 +1,6 @@
;;; vcursor.el --- manipulate an alternative ("virtual") cursor
-;; Copyright (C) 1994, 1996, 1998, 2001-2020 Free Software Foundation,
+;; Copyright (C) 1994, 1996, 1998, 2001-2021 Free Software Foundation,
;; Inc.
;; Author: Peter Stephenson <pws@ibmth.df.unipi.it>
@@ -602,15 +602,14 @@ Set `vcursor-window' to the returned value as a side effect."
(pos-visible-in-window-p (point) vcursor-window))
(progn
(walk-windows
- (function
- (lambda (win)
- (and (not winok)
- (eq (current-buffer) (window-buffer win))
- (not (and not-this (eq thiswin win)))
- (cond
- ((pos-visible-in-window-p (point) win) (setq winok win))
- ((eq thiswin win))
- ((not winbuf) (setq winbuf win))))))
+ (lambda (win)
+ (and (not winok)
+ (eq (current-buffer) (window-buffer win))
+ (not (and not-this (eq thiswin win)))
+ (cond
+ ((pos-visible-in-window-p (point) win) (setq winok win))
+ ((eq thiswin win))
+ ((not winbuf) (setq winbuf win)))))
nil (not this-frame))
(setq vcursor-window
(cond
diff --git a/lisp/version.el b/lisp/version.el
index b247232dcfd..3a3093fdd4a 100644
--- a/lisp/version.el
+++ b/lisp/version.el
@@ -1,6 +1,6 @@
;;; version.el --- record version number of Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1985, 1992, 1994-1995, 1999-2020 Free Software
+;; Copyright (C) 1985, 1992, 1994-1995, 1999-2021 Free Software
;; Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
@@ -29,14 +29,12 @@
(defconst emacs-major-version
(progn (string-match "^[0-9]+" emacs-version)
(string-to-number (match-string 0 emacs-version)))
- "Major version number of this version of Emacs.
-This variable first existed in version 19.23.")
+ "Major version number of this version of Emacs.")
(defconst emacs-minor-version
(progn (string-match "^[0-9]+\\.\\([0-9]+\\)" emacs-version)
(string-to-number (match-string 1 emacs-version)))
- "Minor version number of this version of Emacs.
-This variable first existed in version 19.23.")
+ "Minor version number of this version of Emacs.")
(defconst emacs-build-system (system-name)
"Name of the system on which Emacs was built, or nil if not available.")
diff --git a/lisp/view.el b/lisp/view.el
index 204e28c2a24..5a2f2fadfc3 100644
--- a/lisp/view.el
+++ b/lisp/view.el
@@ -1,6 +1,6 @@
;;; view.el --- peruse file or buffer without editing
-;; Copyright (C) 1985, 1989, 1994-1995, 1997, 2000-2020 Free Software
+;; Copyright (C) 1985, 1989, 1994-1995, 1997, 2000-2021 Free Software
;; Foundation, Inc.
;; Author: K. Shane Hartman
@@ -88,7 +88,9 @@ the selected window is considered for restoring."
:group 'view)
(defcustom view-inhibit-help-message nil
- "Non-nil inhibits the help message shown upon entering View mode."
+ "Non-nil inhibits the help message shown upon entering View mode.
+This setting takes effect only when View mode is entered via an
+interactive command; otherwise the help message is not shown."
:type 'boolean
:group 'view
:version "22.1")
@@ -139,7 +141,8 @@ See RETURN-TO-ALIST argument of function `view-mode-exit' for the format of
(put 'view-return-to-alist 'permanent-local t)
(defvar view-exit-action nil
- "If non-nil, a function with one argument (a buffer) called when finished viewing.
+ "If non-nil, a function called when finished viewing.
+The function should take one argument (a buffer).
Commands like \\[view-file] and \\[view-file-other-window] may
set this to bury or kill the viewed buffer.
Observe that the buffer viewed might not appear in any window at
@@ -559,7 +562,10 @@ This function runs the normal hook `view-mode-hook'."
(unless view-mode
(view-mode 1)
- (unless view-inhibit-help-message
+ (when (and (not view-inhibit-help-message)
+ ;; Avoid spamming the echo area if `view-mode' is entered
+ ;; non-interactively, e.g., in a temporary buffer (bug#44629).
+ this-command)
(message "%s"
(substitute-command-keys "\
View mode: type \\[help-command] for help, \\[describe-mode] for commands, \\[View-quit] to quit.")))))
diff --git a/lisp/vt-control.el b/lisp/vt-control.el
index d4c14197bdc..0bd5132f7c3 100644
--- a/lisp/vt-control.el
+++ b/lisp/vt-control.el
@@ -1,6 +1,6 @@
;;; vt-control.el --- Common VTxxx control functions -*- lexical-binding:t -*-
-;; Copyright (C) 1993-1994, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2001-2021 Free Software Foundation, Inc.
;; Author: Rob Riepel <riepel@networking.stanford.edu>
;; Keywords: terminals
diff --git a/lisp/vt100-led.el b/lisp/vt100-led.el
index 1e81dd241f1..117bef70653 100644
--- a/lisp/vt100-led.el
+++ b/lisp/vt100-led.el
@@ -1,6 +1,6 @@
;;; vt100-led.el --- functions for LED control on VT-100 terminals & clones -*- lexical-binding:t -*-
-;; Copyright (C) 1988, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 2001-2021 Free Software Foundation, Inc.
;; Author: Howard Gayle
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el
index e159d1888e5..9ef2da737a4 100644
--- a/lisp/w32-fns.el
+++ b/lisp/w32-fns.el
@@ -1,6 +1,6 @@
-;;; w32-fns.el --- Lisp routines for 32-bit Windows
+;;; w32-fns.el --- Lisp routines for 32-bit Windows -*- lexical-binding: t; -*-
-;; Copyright (C) 1994, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 2001-2021 Free Software Foundation, Inc.
;; Author: Geoff Voelker <voelker@cs.washington.edu>
;; Keywords: internal
@@ -55,7 +55,7 @@
w32-system-shells)))
(defun w32-shell-dos-semantics ()
- "Return non-nil if the interactive shell being used expects MS-DOS shell semantics."
+ "Return non-nil if current interactive shell expects MS-DOS shell semantics."
(or (w32-system-shell-p (w32-shell-name))
(and (member (downcase (file-name-nondirectory (w32-shell-name)))
'("cmdproxy" "cmdproxy.exe"))
@@ -383,10 +383,10 @@ for any permissions.
This is required because the Windows build environment is not required
to include Sed, which is used by leim/Makefile.in to do the job."
- (find-file orig)
- (goto-char (point-max))
- (insert-file-contents extra)
- (delete-matching-lines "^$\\|^;")
- (save-buffers-kill-emacs t))
+ (with-current-buffer (find-file-noselect orig)
+ (goto-char (point-max))
+ (insert-file-contents extra)
+ (delete-matching-lines "^$\\|^;")
+ (save-buffers-kill-emacs t)))
;;; w32-fns.el ends here
diff --git a/lisp/w32-vars.el b/lisp/w32-vars.el
index 642a48446ef..f00e474e1e4 100644
--- a/lisp/w32-vars.el
+++ b/lisp/w32-vars.el
@@ -1,6 +1,6 @@
;;; w32-vars.el --- MS-Windows specific user options -*- lexical-binding:t -*-
-;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Author: Jason Rumney <jasonr@gnu.org>
;; Keywords: internal
diff --git a/lisp/wdired.el b/lisp/wdired.el
index bb32da3e3a2..f4a0b6d9a93 100644
--- a/lisp/wdired.el
+++ b/lisp/wdired.el
@@ -1,6 +1,6 @@
;;; wdired.el --- Rename files editing their names in dired buffers -*- coding: utf-8; -*-
-;; Copyright (C) 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;; Filename: wdired.el
;; Author: Juan León Lahoz García <juanleon1@gmail.com>
@@ -242,12 +242,12 @@ See `wdired-mode'."
(interactive)
(unless (derived-mode-p 'dired-mode)
(error "Not a Dired buffer"))
- (set (make-local-variable 'wdired-old-content)
- (buffer-substring (point-min) (point-max)))
- (set (make-local-variable 'wdired-old-marks)
- (dired-remember-marks (point-min) (point-max)))
- (set (make-local-variable 'wdired-old-point) (point))
- (set (make-local-variable 'query-replace-skip-read-only) t)
+ (setq-local wdired-old-content
+ (buffer-substring (point-min) (point-max)))
+ (setq-local wdired-old-marks
+ (dired-remember-marks (point-min) (point-max)))
+ (setq-local wdired-old-point (point))
+ (setq-local query-replace-skip-read-only t)
(add-function :after-while (local 'isearch-filter-predicate)
#'wdired-isearch-filter-read-only)
(use-local-map wdired-mode-map)
@@ -355,7 +355,10 @@ non-nil means return old filename."
dired-permission-flags-regexp nil t)
(goto-char (match-beginning 0))
(looking-at "l")
- (search-forward " -> " (line-end-position) t)))
+ (if (and used-F
+ dired-ls-F-marks-symlinks)
+ (re-search-forward "@? -> " (line-end-position) t)
+ (search-forward " -> " (line-end-position) t))))
(goto-char (match-beginning 0))
(setq end (point)))
(when (and used-F
@@ -390,7 +393,7 @@ non-nil means return old filename."
(dired-advertise)
(remove-hook 'kill-buffer-hook 'wdired-check-kill-buffer t)
(remove-hook 'after-change-functions 'wdired--restore-properties t)
- (set (make-local-variable 'revert-buffer-function) 'dired-revert))
+ (setq-local revert-buffer-function 'dired-revert))
(defun wdired-abort-changes ()
@@ -763,7 +766,7 @@ If OLD, return the old target. If MOVE, move point before it."
(unless (equal link-to-new link-to-ori)
(setq changes t)
(if (equal link-to-new "") ;empty filename!
- (setq link-to-new "/dev/null"))
+ (setq link-to-new (null-device)))
(condition-case err
(progn
(delete-file link-from)
@@ -834,7 +837,7 @@ Like original function but it skips read-only words."
;; original name and permissions as a property
(defun wdired-preprocess-perms ()
(let ((inhibit-read-only t))
- (set (make-local-variable 'wdired-col-perm) nil)
+ (setq-local wdired-col-perm nil)
(save-excursion
(goto-char (point-min))
(while (not (eobp))
diff --git a/lisp/whitespace.el b/lisp/whitespace.el
index 94ed6dc47fe..7b8e5b7cc11 100644
--- a/lisp/whitespace.el
+++ b/lisp/whitespace.el
@@ -1,6 +1,6 @@
;;; whitespace.el --- minor mode to visualize TAB, (HARD) SPACE, NEWLINE -*- lexical-binding: t -*-
-;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Keywords: data, wp
@@ -86,19 +86,6 @@
;; * if global whitespace is turned off, whitespace continues on only
;; in the buffers in which local whitespace is on.
;;
-;; To use whitespace, insert in your ~/.emacs:
-;;
-;; (require 'whitespace)
-;;
-;; Or autoload at least one of the commands`whitespace-mode',
-;; `whitespace-toggle-options', `global-whitespace-mode' or
-;; `global-whitespace-toggle-options'. For example:
-;;
-;; (autoload 'whitespace-mode "whitespace"
-;; "Toggle whitespace visualization." t)
-;; (autoload 'whitespace-toggle-options "whitespace"
-;; "Toggle local `whitespace-mode' options." t)
-;;
;; whitespace was inspired by:
;;
;; whitespace.el Rajesh Vaidheeswarran <rv@gnu.org>
@@ -1999,13 +1986,13 @@ resultant list will be returned."
;; prepare local hooks
(add-hook 'write-file-functions 'whitespace-write-file-hook nil t)
;; create whitespace local buffer environment
- (set (make-local-variable 'whitespace-font-lock-keywords) nil)
- (set (make-local-variable 'whitespace-display-table) nil)
- (set (make-local-variable 'whitespace-display-table-was-local) nil)
- (set (make-local-variable 'whitespace-active-style)
- (if (listp whitespace-style)
- whitespace-style
- (list whitespace-style)))
+ (setq-local whitespace-font-lock-keywords nil)
+ (setq-local whitespace-display-table nil)
+ (setq-local whitespace-display-table-was-local nil)
+ (setq-local whitespace-active-style
+ (if (listp whitespace-style)
+ whitespace-style
+ (list whitespace-style)))
;; turn on whitespace
(when whitespace-active-style
(whitespace-color-on)
@@ -2047,19 +2034,14 @@ resultant list will be returned."
"Turn on color visualization."
(when (whitespace-style-face-p)
;; save current point and refontify when necessary
- (set (make-local-variable 'whitespace-point)
- (point))
+ (setq-local whitespace-point (point))
(setq whitespace-point--used
(let ((ol (make-overlay (point) (point) nil nil t)))
(delete-overlay ol) ol))
- (set (make-local-variable 'whitespace-font-lock-refontify)
- 0)
- (set (make-local-variable 'whitespace-bob-marker)
- (point-min-marker))
- (set (make-local-variable 'whitespace-eob-marker)
- (point-max-marker))
- (set (make-local-variable 'whitespace-buffer-changed)
- nil)
+ (setq-local whitespace-font-lock-refontify 0)
+ (setq-local whitespace-bob-marker (point-min-marker))
+ (setq-local whitespace-eob-marker (point-max-marker))
+ (setq-local whitespace-buffer-changed nil)
(add-hook 'post-command-hook #'whitespace-post-command-hook nil t)
(add-hook 'before-change-functions #'whitespace-buffer-changed nil t)
;; Add whitespace-mode color into font lock.
diff --git a/lisp/wid-browse.el b/lisp/wid-browse.el
index 53f918cff9c..0864e1b313e 100644
--- a/lisp/wid-browse.el
+++ b/lisp/wid-browse.el
@@ -1,6 +1,6 @@
;;; wid-browse.el --- functions for browsing widgets
;;
-;; Copyright (C) 1997, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: extensions
@@ -28,7 +28,6 @@
;;; Code:
(require 'easymenu)
-(require 'custom)
(require 'wid-edit)
(defgroup widget-browse nil
@@ -77,8 +76,6 @@ if that value is non-nil."
(setq major-mode 'widget-browse-mode
mode-name "Widget")
(use-local-map widget-browse-mode-map)
- (easy-menu-add widget-browse-mode-customize-menu)
- (easy-menu-add widget-browse-mode-menu)
(run-mode-hooks 'widget-browse-mode-hook))
(put 'widget-browse-mode 'mode-class 'special)
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 4e2cf7416d4..68a0d3d2356 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -1,6 +1,6 @@
;;; wid-edit.el --- Functions for creating and using widgets -*- lexical-binding:t -*-
;;
-;; Copyright (C) 1996-1997, 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1997, 1999-2021 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Maintainer: emacs-devel@gnu.org
@@ -338,7 +338,7 @@ in the key vector, as in the argument of `define-key'."
'(display-buffer-in-direction
(direction . bottom)
(window-height . fit-window-to-buffer)))
- (setq value (read-char-from-minibuffer
+ (setq value (read-char-choice
(format "%s: " title)
(mapcar #'car alist)))))
(cdr (assoc value alist))))))
@@ -591,9 +591,25 @@ Otherwise, just return the value."
(widget-put widget :args args)))
(widget-apply widget :default-get)))))
+(defun widget-inline-p (widget &optional bubblep)
+ "Non-nil if the widget WIDGET is inline.
+
+With BUBBLEP non-nil, check also if WIDGET has a member that bubbles its inline
+property (if any), up to WIDGET, so that WIDGET can act as an inline widget."
+ (or (widget-get widget :inline)
+ (and bubblep
+ (widget-get widget :inline-bubbles-p)
+ (widget-apply widget :inline-bubbles-p))))
+
(defun widget-match-inline (widget vals)
- "In WIDGET, match the start of VALS."
- (cond ((widget-get widget :inline)
+ "In WIDGET, match the start of VALS.
+
+For an inline widget or for a widget that acts like one (see `widget-inline-p'),
+try to match elements in VALS as far as possible. Otherwise, match the first
+element of the list VALS.
+
+Return a list whose car contains all members of VALS that matched WIDGET."
+ (cond ((widget-inline-p widget t)
(widget-apply widget :match-inline vals))
((and (listp vals)
(widget-apply widget :match (car vals)))
@@ -1088,7 +1104,7 @@ If nothing was called, return non-nil."
(unless (widget-apply button :mouse-down-action event)
(let ((track-mouse t))
(while (not (widget-button-release-event-p event))
- (setq event (read-event))
+ (setq event (read--potential-mouse-event))
(when (and mouse-1 (mouse-movement-p event))
(push event unread-command-events)
(setq event oevent)
@@ -1153,7 +1169,7 @@ If nothing was called, return non-nil."
(when up
;; Don't execute up events twice.
(while (not (widget-button-release-event-p event))
- (setq event (read-event))))
+ (setq event (read--potential-mouse-event))))
(when command
(call-interactively command)))))
(message "You clicked somewhere weird.")))
@@ -1188,7 +1204,6 @@ This is much faster.")
ARG may be negative to move backward.
When the second optional argument is non-nil,
nothing is shown in the echo area."
- (or (bobp) (> arg 0) (backward-char))
(let ((wrapped 0)
(number arg)
(old (widget-tabable-at)))
@@ -2198,7 +2213,7 @@ But if NO-TRUNCATE is non-nil, include them."
(let ((value (widget-get widget :value))
(args (widget-get widget :args))
(explicit (widget-get widget :explicit-choice))
- current)
+ current val inline-p fun)
(if explicit
(progn
;; If the user specified the choice for this value,
@@ -2207,15 +2222,24 @@ But if NO-TRUNCATE is non-nil, include them."
widget explicit value)))
(widget-put widget :choice explicit)
(widget-put widget :explicit-choice nil))
+ (setq inline-p (widget-inline-p widget t))
(while args
(setq current (car args)
args (cdr args))
- (when (widget-apply current :match value)
- (widget-put widget :children (list (widget-create-child-value
- widget current value)))
- (widget-put widget :choice current)
- (setq args nil
- current nil)))
+ (if inline-p
+ (if (widget-get current :inline)
+ (setq val value
+ fun :match-inline)
+ (setq val (car value)
+ fun :match))
+ (setq val value
+ fun :match))
+ (when (widget-apply current fun val)
+ (widget-put widget :children (list (widget-create-child-value
+ widget current val)))
+ (widget-put widget :choice current)
+ (setq args nil
+ current nil)))
(when current
(let ((void (widget-get widget :void)))
(widget-put widget :children (list (widget-create-child-and-convert
@@ -2438,7 +2462,7 @@ If the item is checked, CHOSEN is a cons whose cdr is the value."
(let ((child (widget-create-child widget type)))
(widget-apply child :deactivate)
child))
- ((widget-get type :inline)
+ ((widget-inline-p type t)
(widget-create-child-value
widget type (cdr chosen)))
(t
@@ -2795,7 +2819,7 @@ Return an alist of (TYPE MATCH)."
(if answer
(setq children (cons (widget-editable-list-entry-create
widget
- (if (widget-get type :inline)
+ (if (widget-inline-p type t)
(car answer)
(car (car answer)))
t)
@@ -2979,7 +3003,7 @@ Save CHILD into the :last-deleted list, so it can be inserted later."
(insert-char ?\s (widget-get widget :indent)))
(push (cond ((null answer)
(widget-create-child widget arg))
- ((widget-get arg :inline)
+ ((widget-inline-p arg t)
(widget-create-child-value widget arg (car answer)))
(t
(widget-create-child-value widget arg (car (car answer)))))
@@ -3462,14 +3486,16 @@ It reads a directory name from an editable text field."
:help-echo "C-q: insert KEY, EVENT, or CODE; RET: enter value"
:tag "Key sequence")
+;; FIXME: Consider combining this with help--read-key-sequence which
+;; can also read double and triple mouse events.
(defun widget-key-sequence-read-event (ev)
(interactive (list
(let ((inhibit-quit t) quit-flag)
- (read-event "Insert KEY, EVENT, or CODE: "))))
+ (read-key "Insert KEY, EVENT, or CODE: " t))))
(let ((ev2 (and (memq 'down (event-modifiers ev))
- (read-event)))
- (tr (and (keymapp function-key-map)
- (lookup-key function-key-map (vector ev)))))
+ (read-key nil t)))
+ (tr (and (keymapp local-function-key-map)
+ (lookup-key local-function-key-map (vector ev)))))
(when (and (integerp ev)
(or (and (<= ?0 ev) (< ev (+ ?0 (min 10 read-quoted-char-radix))))
(and (<= ?a (downcase ev))
@@ -3900,12 +3926,17 @@ example:
`(cons :format "Key: %v" ,key-type ,value-type)))
(define-widget 'choice 'menu-choice
- "A union of several sexp types."
+ "A union of several sexp types.
+
+If one of the choices of a choice widget has an :inline t property,
+then the choice widget can act as an inline widget on its own if the
+current choice is inline."
:tag "Choice"
:format "%{%t%}: %[Value Menu%] %v"
:button-prefix 'widget-push-button-prefix
:button-suffix 'widget-push-button-suffix
- :prompt-value 'widget-choice-prompt-value)
+ :prompt-value 'widget-choice-prompt-value
+ :inline-bubbles-p #'widget-choice-inline-bubbles-p)
(defun widget-choice-prompt-value (widget prompt value _unbound)
"Make a choice."
@@ -3948,6 +3979,20 @@ example:
(if current
(widget-prompt-value current prompt nil t)
value)))
+
+(defun widget-choice-inline-bubbles-p (widget)
+ "Non-nil if the choice WIDGET has at least one choice that is inline.
+This is used when matching values, because a choice widget needs to
+match a value inline rather than just match it if at least one of its choices
+is inline."
+ (let ((args (widget-get widget :args))
+ cur found)
+ (while (and args (not found))
+ (setq cur (car args)
+ args (cdr args)
+ found (widget-get cur :inline)))
+ found))
+
(define-widget 'radio 'radio-button-choice
"A union of several sexp types."
@@ -3981,17 +4026,19 @@ example:
;;; The `color' Widget.
-;; Fixme: match
(define-widget 'color 'editable-field
"Choose a color name (with sample)."
:format "%{%t%}: %v (%{sample%})\n"
:value-create 'widget-color-value-create
- :size 10
+ :size (1+ (apply #'max 13 ; Longest RGB hex string.
+ (mapcar #'length (defined-colors))))
:tag "Color"
:value "black"
:completions (or facemenu-color-alist (defined-colors))
:sample-face-get 'widget-color-sample-face-get
:notify 'widget-color-notify
+ :match #'widget-color-match
+ :validate #'widget-color-validate
:action 'widget-color-action)
(defun widget-color-value-create (widget)
@@ -4040,6 +4087,19 @@ example:
(overlay-put (widget-get widget :sample-overlay)
'face (widget-apply widget :sample-face-get))
(widget-default-notify widget child event))
+
+(defun widget-color-match (_widget value)
+ "Non-nil if VALUE is a defined color or a RGB hex string."
+ (and (stringp value)
+ (or (color-defined-p value)
+ (string-match-p "^#\\(?:[[:xdigit:]]\\{3\\}\\)\\{1,4\\}$" value))))
+
+(defun widget-color-validate (widget)
+ "Check that WIDGET's value is a valid color."
+ (let ((value (widget-value widget)))
+ (unless (widget-color-match widget value)
+ (widget-put widget :error (format "Invalid color: %S" value))
+ widget)))
;;; The Help Echo
diff --git a/lisp/widget.el b/lisp/widget.el
index 8f1e0901610..401b4cf298f 100644
--- a/lisp/widget.el
+++ b/lisp/widget.el
@@ -1,6 +1,6 @@
-;;; widget.el --- a library of user interface components
+;;; widget.el --- a library of user interface components -*- lexical-binding: t; -*-
;;
-;; Copyright (C) 1996-1997, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1997, 2001-2021 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: help, extensions, faces, hypermedia
diff --git a/lisp/windmove.el b/lisp/windmove.el
index 65579600640..e4ea8e0f693 100644
--- a/lisp/windmove.el
+++ b/lisp/windmove.el
@@ -1,6 +1,6 @@
;;; windmove.el --- directional window-selection routines -*- lexical-binding:t -*-
;;
-;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;;
;; Author: Hovav Shacham (hovav@cs.stanford.edu)
;; Created: 17 October 1998
@@ -485,7 +485,7 @@ When `switch-to-buffer-obey-display-actions' is non-nil,
(t (window-in-direction
dir nil nil
(and arg (prefix-numeric-value arg))
- windmove-wrap-around)))))
+ windmove-wrap-around 'nomini)))))
(unless window
(setq window (split-window nil nil dir) type 'window))
(cons window type)))
@@ -569,7 +569,7 @@ select the window at direction DIR.
When `windmove-wrap-around' is non-nil, takes the window
from the opposite side of the frame."
(let ((other-window (window-in-direction dir nil nil arg
- windmove-wrap-around t)))
+ windmove-wrap-around 'nomini)))
(cond ((null other-window)
(user-error "No window %s from selected window" dir))
(t
@@ -637,7 +637,7 @@ a single modifier. Default value of PREFIX is `C-x' and MODIFIERS is `shift'."
When `windmove-wrap-around' is non-nil, takes the window
from the opposite side of the frame."
(let ((other-window (window-in-direction dir nil nil nil
- windmove-wrap-around t)))
+ windmove-wrap-around 'nomini)))
(cond ((or (null other-window) (window-minibuffer-p other-window))
(user-error "No window %s from selected window" dir))
(t
diff --git a/lisp/window.el b/lisp/window.el
index 865f6fdd5cc..0a37d16273f 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -1,6 +1,6 @@
;;; window.el --- GNU Emacs window commands aside from those written in C -*- lexical-binding:t -*-
-;; Copyright (C) 1985, 1989, 1992-1994, 2000-2020 Free Software
+;; Copyright (C) 1985, 1989, 1992-1994, 2000-2021 Free Software
;; Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
@@ -1736,9 +1736,11 @@ interpret DELTA as pixels."
(setq window (window-normalize-window window))
(cond
((< delta 0)
- (max (- (window-min-size window horizontal ignore pixelwise)
- (window-size window horizontal pixelwise))
- delta))
+ (let ((min-size (window-min-size window horizontal ignore pixelwise))
+ (size (window-size window horizontal pixelwise)))
+ (if (<= size min-size)
+ 0
+ (max (- min-size size) delta))))
((> delta 0)
(if (window-size-fixed-p window horizontal ignore)
0
@@ -2309,7 +2311,7 @@ SIDE can be any of the symbols `left', `top', `right' or
;; Neither of these allow one to selectively ignore specific windows
;; (windows whose `no-other-window' parameter is non-nil) as targets of
;; the movement.
-(defun window-in-direction (direction &optional window ignore sign wrap mini)
+(defun window-in-direction (direction &optional window ignore sign wrap minibuf)
"Return window in DIRECTION as seen from WINDOW.
More precisely, return the nearest window in direction DIRECTION
as seen from the position of `window-point' in window WINDOW.
@@ -2332,10 +2334,11 @@ frame borders. This means to return for WINDOW at the top of the
frame and DIRECTION `above' the minibuffer window if the frame
has one, and a window at the bottom of the frame otherwise.
-Optional argument MINI nil means to return the minibuffer window
-if and only if it is currently active. MINI non-nil means to
-return the minibuffer window even when it's not active. However,
-if WRAP is non-nil, always act as if MINI were nil.
+Optional argument MINIBUF t means to return the minibuffer
+window even if it isn't active. MINIBUF nil or omitted means
+to return the minibuffer window if and only if it is currently active.
+MINIBUF neither nil nor t means never return the minibuffer window.
+However, if WRAP is non-nil, always act as if MINIBUF were nil.
Return nil if no suitable window can be found."
(setq window (window-normalize-window window t))
@@ -2451,7 +2454,7 @@ Return nil if no suitable window can be found."
(setq best-edge-2 w-top)
(setq best-diff-2 best-diff-2-new)
(setq best-2 w)))))
- frame nil (and mini t))
+ frame nil minibuf)
(or best best-2)))
(defun get-window-with-predicate (predicate &optional minibuf all-frames default)
@@ -4115,7 +4118,10 @@ frame can be safely deleted."
frame))
(throw 'other t))))
(let ((minibuf (active-minibuffer-window)))
- (and minibuf (eq frame (window-frame minibuf)))))
+ (and minibuf (eq frame (window-frame minibuf))
+ (not (eq (default-toplevel-value
+ minibuffer-follows-selected-frame)
+ t)))))
'frame))
((window-minibuffer-p window)
;; If WINDOW is the minibuffer window of a non-minibuffer-only
@@ -5488,7 +5494,13 @@ frame. The selected window is not changed by this function."
(set-window-parameter (window-parent new) 'window-atom t))
(set-window-parameter new 'window-atom t)))
- ;; Sanitize sizes unless SIZE was specified.
+ ;; Make the new window inherit the `min-margins' parameter of
+ ;; WINDOW (Bug#44483).
+ (let ((min-margins (window-parameter window 'min-margins)))
+ (when min-margins
+ (set-window-parameter new 'min-margins min-margins)))
+
+ ;; Sanitize sizes unless SIZE was specified.
(unless size
(window--sanitize-window-sizes horizontal))
@@ -7236,6 +7248,7 @@ The actual non-nil value of this variable will be copied to the
(const display-buffer-below-selected)
(const display-buffer-at-bottom)
(const display-buffer-in-previous-window)
+ (const display-buffer-use-least-recent-window)
(const display-buffer-use-some-window)
(const display-buffer-use-some-frame)
(function :tag "Other function"))
@@ -7371,6 +7384,37 @@ fails, call `display-buffer-pop-up-frame'.")
(defun display-buffer (buffer-or-name &optional action frame)
"Display BUFFER-OR-NAME in some window, without selecting it.
+To change which window is used, set `display-buffer-alist'
+to an expression containing one of these \"action\" functions:
+
+ `display-buffer-same-window' -- Use the selected window.
+ `display-buffer-reuse-window' -- Use a window already showing
+ the buffer.
+ `display-buffer-in-previous-window' -- Use a window that did
+ show the buffer before.
+ `display-buffer-use-some-window' -- Use some existing window.
+ `display-buffer-use-least-recent-window' -- Try to avoid re-using
+ windows that have recently been switched to.
+ `display-buffer-pop-up-window' -- Pop up a new window.
+ `display-buffer-below-selected' -- Use or pop up a window below
+ the selected one.
+ `display-buffer-at-bottom' -- Use or pop up a window at the
+ bottom of the selected frame.
+ `display-buffer-pop-up-frame' -- Show the buffer on a new frame.
+ `display-buffer-in-child-frame' -- Show the buffer in a
+ child frame.
+ `display-buffer-no-window' -- Do not display the buffer and
+ have `display-buffer' return nil immediately.
+
+For instance:
+
+ (setq display-buffer-alist '((\".*\" display-buffer-at-bottom)))
+
+Buffer display can be further customized to a very high degree;
+the rest of this docstring explains some of the many
+possibilities, and also see `(emacs)Window Choice' for more
+information.
+
BUFFER-OR-NAME must be a buffer or a string naming a live buffer.
Return the window chosen for displaying that buffer, or nil if no
such window is found.
@@ -7396,23 +7440,8 @@ function in the combined function list in turn, passing the
buffer as the first argument and the combined action alist as the
second argument, until one of the functions returns non-nil.
-Action functions and the action they try to perform are:
- `display-buffer-same-window' -- Use the selected window.
- `display-buffer-reuse-window' -- Use a window already showing
- the buffer.
- `display-buffer-in-previous-window' -- Use a window that did
- show the buffer before.
- `display-buffer-use-some-window' -- Use some existing window.
- `display-buffer-pop-up-window' -- Pop up a new window.
- `display-buffer-below-selected' -- Use or pop up a window below
- the selected one.
- `display-buffer-at-bottom' -- Use or pop up a window at the
- bottom of the selected frame.
- `display-buffer-pop-up-frame' -- Show the buffer on a new frame.
- `display-buffer-in-child-frame' -- Show the buffer in a
- child frame.
- `display-buffer-no-window' -- Do not display the buffer and
- have `display-buffer' return nil immediately.
+See above for the action functions and the action they try to
+perform.
Action alist entries are:
`inhibit-same-window' -- A non-nil value prevents the same
@@ -8235,6 +8264,16 @@ indirectly called by the latter."
(when (setq window (or best-window second-best-window))
(window--display-buffer buffer window 'reuse alist))))
+(defun display-buffer-use-least-recent-window (buffer alist)
+ "Display BUFFER in an existing window, but that hasn't been used lately.
+This `display-buffer' action function is like
+`display-buffer-use-some-window', but will cycle through windows
+when displaying buffers repeatedly, and if there's only a single
+window, it will split the window."
+ (when-let ((window (display-buffer-use-some-window
+ buffer (cons (cons 'inhibit-same-window t) alist))))
+ (window-bump-use-time window)))
+
(defun display-buffer-use-some-window (buffer alist)
"Display BUFFER in an existing window.
Search for a usable window, set that window to the buffer, and
@@ -8383,9 +8422,9 @@ from the list of completions and default values."
;; here manually.
(if (and (boundp 'icomplete-with-completion-tables)
(listp icomplete-with-completion-tables))
- (set (make-local-variable 'icomplete-with-completion-tables)
- (cons rbts-completion-table
- icomplete-with-completion-tables))))
+ (setq-local icomplete-with-completion-tables
+ (cons rbts-completion-table
+ icomplete-with-completion-tables))))
(read-buffer prompt (other-buffer (current-buffer))
(confirm-nonexistent-file-or-buffer)))))
@@ -8559,13 +8598,13 @@ Return the buffer switched to."
(when set-window-start-and-point
(let* ((entry (assq buffer (window-prev-buffers)))
- (displayed (and (eq switch-to-buffer-preserve-window-point
- 'already-displayed)
+ (preserve-win-point
+ (buffer-local-value 'switch-to-buffer-preserve-window-point
+ buffer))
+ (displayed (and (eq preserve-win-point 'already-displayed)
(get-buffer-window buffer 0))))
(set-window-buffer nil buffer)
- (when (and entry
- (or (eq switch-to-buffer-preserve-window-point t)
- displayed))
+ (when (and entry (or (eq preserve-win-point t) displayed))
;; Try to restore start and point of buffer in the selected
;; window (Bug#4041).
(set-window-start (selected-window) (nth 1 entry) t)
diff --git a/lisp/winner.el b/lisp/winner.el
index 4313e767196..9506ac53bb2 100644
--- a/lisp/winner.el
+++ b/lisp/winner.el
@@ -1,6 +1,6 @@
;;; winner.el --- Restore old window configurations
-;; Copyright (C) 1997-1998, 2001-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2001-2021 Free Software Foundation, Inc.
;; Author: Ivar Rummelhoff <ivarru@math.uio.no>
;; Created: 27 Feb 1997
diff --git a/lisp/woman.el b/lisp/woman.el
index 96ae7fe5794..0e4c1c10fca 100644
--- a/lisp/woman.el
+++ b/lisp/woman.el
@@ -1,6 +1,6 @@
;;; woman.el --- browse UN*X manual pages `wo (without) man'
-;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;; Author: Francis J. Wright <F.J.Wright@qmul.ac.uk>
;; Maintainer: emacs-devel@gnu.org
@@ -404,7 +404,6 @@
(make-obsolete-variable 'woman-version nil "28.1")
(require 'man)
-(require 'button)
(define-button-type 'WoMan-xref-man-page
:supertype 'Man-abstract-xref-man-page
'func (lambda (arg)
diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el
index 1d49f462531..23e8001c013 100644
--- a/lisp/x-dnd.el
+++ b/lisp/x-dnd.el
@@ -1,6 +1,6 @@
;;; x-dnd.el --- drag and drop support for X -*- lexical-binding: t; -*-
-;; Copyright (C) 2004-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;; Author: Jan Djärv <jan.h.d@swipnet.se>
;; Maintainer: emacs-devel@gnu.org
@@ -411,8 +411,10 @@ Coordinates are required to be absolute.
FRAME is the frame and W is the window where the drop happened.
If W is a window, return its absolute coordinates,
otherwise return the frame coordinates."
- (let* ((frame-left (frame-parameter frame 'left))
- (frame-top (frame-parameter frame 'top)))
+ (let* ((frame-left (or (car-safe (cdr-safe (frame-parameter frame 'left)))
+ (frame-parameter frame 'left)))
+ (frame-top (or (car-safe (cdr-safe (frame-parameter frame 'top)))
+ (frame-parameter frame 'top))))
(if (windowp w)
(let ((edges (window-inside-pixel-edges w)))
(cons
diff --git a/lisp/xdg.el b/lisp/xdg.el
index ae4a3f05684..0f0df53d27e 100644
--- a/lisp/xdg.el
+++ b/lisp/xdg.el
@@ -1,6 +1,6 @@
;;; xdg.el --- XDG specification and standard support -*- lexical-binding: t -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; Author: Mark Oteiza <mvoteiza@udel.edu>
;; Created: 27 January 2017
diff --git a/lisp/xml.el b/lisp/xml.el
index c96ff80446a..4e2dd13ecbd 100644
--- a/lisp/xml.el
+++ b/lisp/xml.el
@@ -1,6 +1,6 @@
;;; xml.el --- XML parser -*- lexical-binding: t -*-
-;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;; Author: Emmanuel Briot <briot@gnat.com>
;; Maintainer: Mark A. Hershberger <mah@everybody.org>
diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el
index f9c08f9a174..72faff81015 100644
--- a/lisp/xt-mouse.el
+++ b/lisp/xt-mouse.el
@@ -1,6 +1,6 @@
;;; xt-mouse.el --- support the mouse when emacs run in an xterm -*- lexical-binding: t -*-
-;; Copyright (C) 1994, 2000-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 2000-2021 Free Software Foundation, Inc.
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: mouse, terminals
@@ -77,6 +77,7 @@ https://invisible-island.net/xterm/ctlseqs/ctlseqs.html)."
(copy-sequence event))
vec)
(is-move
+ (xterm-mouse--handle-mouse-movement)
(if track-mouse vec
;; Mouse movement events are currently supposed to be
;; suppressed. Return no event.
@@ -106,8 +107,14 @@ https://invisible-island.net/xterm/ctlseqs/ctlseqs.html)."
(if (null track-mouse)
(vector drag)
(push drag unread-command-events)
+ (xterm-mouse--handle-mouse-movement)
(vector (list 'mouse-movement ev-data))))))))))))
+(defun xterm-mouse--handle-mouse-movement ()
+ "Handle mouse motion that was just generated for XTerm mouse."
+ (display--update-for-mouse-movement (terminal-parameter nil 'xterm-mouse-x)
+ (terminal-parameter nil 'xterm-mouse-y)))
+
;; These two variables have been converted to terminal parameters.
;;
;;(defvar xterm-mouse-x 0
diff --git a/lisp/xwidget.el b/lisp/xwidget.el
index caf57ae43fe..b8df55090a2 100644
--- a/lisp/xwidget.el
+++ b/lisp/xwidget.el
@@ -1,6 +1,6 @@
;;; xwidget.el --- api functions for xwidgets -*- lexical-binding: t -*-
;;
-;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
;;
;; Author: Joakim Verona (joakim@verona.se)
;;
@@ -451,7 +451,7 @@ function findactiveelement(doc){
XW is the xwidget identifier, TEXT is retrieved from the webkit."
(switch-to-buffer
(generate-new-buffer "textarea"))
- (set (make-local-variable 'xwidget-xwbl) xw)
+ (setq-local xwidget-xwbl xw)
(insert text))
(defun xwidget-webkit-end-edit-textarea ()
diff --git a/lwlib/ChangeLog.1 b/lwlib/ChangeLog.1
index 52ec945a06f..bf839cf7091 100644
--- a/lwlib/ChangeLog.1
+++ b/lwlib/ChangeLog.1
@@ -1964,7 +1964,7 @@
;; coding: utf-8
;; End:
- Copyright (C) 1995-1999, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1995-1999, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lwlib/Makefile.in b/lwlib/Makefile.in
index 1077324b513..28c16acbabc 100644
--- a/lwlib/Makefile.in
+++ b/lwlib/Makefile.in
@@ -1,7 +1,7 @@
### @configure_input@
# Copyright (C) 1992, 1993 Lucid, Inc.
-# Copyright (C) 1994, 2001-2020 Free Software Foundation, Inc.
+# Copyright (C) 1994, 2001-2021 Free Software Foundation, Inc.
#
# This file is part of the Lucid Widget Library.
#
diff --git a/lwlib/deps.mk b/lwlib/deps.mk
index 105ea1b170d..66c464f8f92 100644
--- a/lwlib/deps.mk
+++ b/lwlib/deps.mk
@@ -1,7 +1,7 @@
### deps.mk --- lwlib/Makefile fragment for GNU Emacs
# Copyright (C) 1992, 1993 Lucid, Inc.
-# Copyright (C) 1994, 2001-2020 Free Software Foundation, Inc.
+# Copyright (C) 1994, 2001-2021 Free Software Foundation, Inc.
#
# This file is part of the Lucid Widget Library.
#
diff --git a/lwlib/lwlib-Xaw.c b/lwlib/lwlib-Xaw.c
index 71ac98aabd7..8806d3f700a 100644
--- a/lwlib/lwlib-Xaw.c
+++ b/lwlib/lwlib-Xaw.c
@@ -1,7 +1,7 @@
/* The lwlib interface to Athena widgets.
Copyright (C) 1993 Chuck Thompson <cthomp@cs.uiuc.edu>
-Copyright (C) 1994, 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 1994, 2001-2021 Free Software Foundation, Inc.
This file is part of the Lucid Widget Library.
diff --git a/lwlib/lwlib-Xlw.c b/lwlib/lwlib-Xlw.c
index 862bc8f5d9d..54dc06f52ac 100644
--- a/lwlib/lwlib-Xlw.c
+++ b/lwlib/lwlib-Xlw.c
@@ -1,7 +1,7 @@
/* The lwlib interface to "xlwmenu" menus.
Copyright (C) 1992 Lucid, Inc.
-Copyright (C) 1994, 2000-2020 Free Software Foundation, Inc.
+Copyright (C) 1994, 2000-2021 Free Software Foundation, Inc.
This file is part of the Lucid Widget Library.
diff --git a/lwlib/lwlib-Xm.c b/lwlib/lwlib-Xm.c
index c4ba4113fd1..525465fa998 100644
--- a/lwlib/lwlib-Xm.c
+++ b/lwlib/lwlib-Xm.c
@@ -1,6 +1,6 @@
/* The lwlib interface to Motif widgets.
-Copyright (C) 1994-1997, 1999-2020 Free Software Foundation, Inc.
+Copyright (C) 1994-1997, 1999-2021 Free Software Foundation, Inc.
Copyright (C) 1992 Lucid, Inc.
This file is part of the Lucid Widget Library.
diff --git a/lwlib/lwlib-int.h b/lwlib/lwlib-int.h
index 885d951919c..ef76d67bfc5 100644
--- a/lwlib/lwlib-int.h
+++ b/lwlib/lwlib-int.h
@@ -1,6 +1,6 @@
/*
Copyright (C) 1992 Lucid, Inc.
-Copyright (C) 2000-2020 Free Software Foundation, Inc.
+Copyright (C) 2000-2021 Free Software Foundation, Inc.
This file is part of the Lucid Widget Library.
diff --git a/lwlib/lwlib-utils.c b/lwlib/lwlib-utils.c
index f15cb603a80..3c700e0c5fc 100644
--- a/lwlib/lwlib-utils.c
+++ b/lwlib/lwlib-utils.c
@@ -1,7 +1,7 @@
/* Defines some widget utility functions.
Copyright (C) 1992 Lucid, Inc.
-Copyright (C) 1994, 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 1994, 2001-2021 Free Software Foundation, Inc.
This file is part of the Lucid Widget Library.
@@ -148,6 +148,7 @@ XftFont *
crxft_font_open_name (Display *dpy, int screen, const char *name)
{
XftFont *pub = NULL;
+ FcPattern *match = NULL;
FcPattern *pattern = FcNameParse ((FcChar8 *) name);
if (pattern)
{
@@ -162,12 +163,18 @@ crxft_font_open_name (Display *dpy, int screen, const char *name)
FcPatternAddDouble (pattern, FC_DPI, dpi);
}
FcDefaultSubstitute (pattern);
+ FcResult result;
+ match = FcFontMatch (NULL, pattern, &result);
+ FcPatternDestroy (pattern);
+ }
+ if (match)
+ {
cairo_font_face_t *font_face
- = cairo_ft_font_face_create_for_pattern (pattern);
+ = cairo_ft_font_face_create_for_pattern (match);
if (font_face)
{
double pixel_size;
- if ((FcPatternGetDouble (pattern, FC_PIXEL_SIZE, 0, &pixel_size)
+ if ((FcPatternGetDouble (match, FC_PIXEL_SIZE, 0, &pixel_size)
!= FcResultMatch)
|| pixel_size < 1)
pixel_size = 10;
@@ -177,7 +184,7 @@ crxft_font_open_name (Display *dpy, int screen, const char *name)
cairo_matrix_init_scale (&font_matrix, pixel_size, pixel_size);
cairo_matrix_init_identity (&ctm);
cairo_font_options_t *options = cairo_font_options_create ();
- cairo_ft_font_options_substitute (options, pattern);
+ cairo_ft_font_options_substitute (options, match);
pub->scaled_font = cairo_scaled_font_create (font_face, &font_matrix,
&ctm, options);
cairo_font_face_destroy (font_face);
@@ -190,7 +197,7 @@ crxft_font_open_name (Display *dpy, int screen, const char *name)
pub->height = lround (extents.height);
pub->max_advance_width = lround (extents.max_x_advance);
}
- FcPatternDestroy (pattern);
+ FcPatternDestroy (match);
}
if (pub && pub->height <= 0)
{
diff --git a/lwlib/lwlib-widget.h b/lwlib/lwlib-widget.h
index f1323378d04..2fd84c043f2 100644
--- a/lwlib/lwlib-widget.h
+++ b/lwlib/lwlib-widget.h
@@ -1,6 +1,6 @@
/*
Copyright (C) 1992, 1993 Lucid, Inc.
-Copyright (C) 1994, 1999-2020 Free Software Foundation, Inc.
+Copyright (C) 1994, 1999-2021 Free Software Foundation, Inc.
This file is part of the Lucid Widget Library.
diff --git a/lwlib/lwlib.c b/lwlib/lwlib.c
index 33c6ab1a60d..820538f738b 100644
--- a/lwlib/lwlib.c
+++ b/lwlib/lwlib.c
@@ -1,7 +1,7 @@
/* A general interface to the widgets of different toolkits.
Copyright (C) 1992, 1993 Lucid, Inc.
-Copyright (C) 1994-1996, 1999-2020 Free Software Foundation, Inc.
+Copyright (C) 1994-1996, 1999-2021 Free Software Foundation, Inc.
This file is part of the Lucid Widget Library.
diff --git a/lwlib/lwlib.h b/lwlib/lwlib.h
index cd269749411..ab48d85890a 100644
--- a/lwlib/lwlib.h
+++ b/lwlib/lwlib.h
@@ -1,6 +1,6 @@
/*
Copyright (C) 1992, 1993 Lucid, Inc.
-Copyright (C) 1994, 1999-2020 Free Software Foundation, Inc.
+Copyright (C) 1994, 1999-2021 Free Software Foundation, Inc.
This file is part of the Lucid Widget Library.
diff --git a/lwlib/xlwmenu.c b/lwlib/xlwmenu.c
index dcef17218fb..cc73d9aa498 100644
--- a/lwlib/xlwmenu.c
+++ b/lwlib/xlwmenu.c
@@ -1,7 +1,7 @@
/* Implements a lightweight menubar widget.
Copyright (C) 1992 Lucid, Inc.
-Copyright (C) 1994-1995, 1997, 1999-2020 Free Software Foundation, Inc.
+Copyright (C) 1994-1995, 1997, 1999-2021 Free Software Foundation, Inc.
This file is part of the Lucid Widget Library.
diff --git a/lwlib/xlwmenu.h b/lwlib/xlwmenu.h
index 5215127edb3..9143edba9a2 100644
--- a/lwlib/xlwmenu.h
+++ b/lwlib/xlwmenu.h
@@ -1,6 +1,6 @@
/* Interface of a lightweight menubar widget.
-Copyright (C) 2002-2020 Free Software Foundation, Inc.
+Copyright (C) 2002-2021 Free Software Foundation, Inc.
Copyright (C) 1992 Lucid, Inc.
This file is part of the Lucid Widget Library.
diff --git a/lwlib/xlwmenuP.h b/lwlib/xlwmenuP.h
index 614a4db534a..fc77ec4bfd1 100644
--- a/lwlib/xlwmenuP.h
+++ b/lwlib/xlwmenuP.h
@@ -1,6 +1,6 @@
/* Internals of a lightweight menubar widget.
-Copyright (C) 2002-2020 Free Software Foundation, Inc.
+Copyright (C) 2002-2021 Free Software Foundation, Inc.
Copyright (C) 1992 Lucid, Inc.
This file is part of the Lucid Widget Library.
diff --git a/m4/00gnulib.m4 b/m4/00gnulib.m4
index 14628c363b7..9ba1743e652 100644
--- a/m4/00gnulib.m4
+++ b/m4/00gnulib.m4
@@ -1,5 +1,5 @@
# 00gnulib.m4 serial 8
-dnl Copyright (C) 2009-2020 Free Software Foundation, Inc.
+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.
diff --git a/m4/__inline.m4 b/m4/__inline.m4
index 520c8c4b208..b28cc6abc51 100644
--- a/m4/__inline.m4
+++ b/m4/__inline.m4
@@ -1,5 +1,5 @@
# Test for __inline keyword
-dnl Copyright 2017-2020 Free Software Foundation, Inc.
+dnl Copyright 2017-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.
diff --git a/m4/absolute-header.m4 b/m4/absolute-header.m4
index c043233de36..52d80d0428e 100644
--- a/m4/absolute-header.m4
+++ b/m4/absolute-header.m4
@@ -1,5 +1,5 @@
# absolute-header.m4 serial 17
-dnl Copyright (C) 2006-2020 Free Software Foundation, Inc.
+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,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/acl.m4 b/m4/acl.m4
index a3dcf9357b9..aaf231aee9a 100644
--- a/m4/acl.m4
+++ b/m4/acl.m4
@@ -1,7 +1,7 @@
# acl.m4 - check for access control list (ACL) primitives
# serial 24
-# Copyright (C) 2002, 2004-2020 Free Software Foundation, Inc.
+# Copyright (C) 2002, 2004-2021 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
diff --git a/m4/alloca.m4 b/m4/alloca.m4
index d8414896308..ba2f679d8e0 100644
--- a/m4/alloca.m4
+++ b/m4/alloca.m4
@@ -1,5 +1,5 @@
-# alloca.m4 serial 18
-dnl Copyright (C) 2002-2004, 2006-2007, 2009-2020 Free Software Foundation,
+# alloca.m4 serial 20
+dnl Copyright (C) 2002-2004, 2006-2007, 2009-2021 Free Software Foundation,
dnl Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -104,5 +104,5 @@ AH_VERBATIM([STACK_DIRECTION],
STACK_DIRECTION = 0 => direction of growth unknown */
#undef STACK_DIRECTION])dnl
AC_DEFINE_UNQUOTED(STACK_DIRECTION, $ac_cv_c_stack_direction)
-])
+])# _AC_LIBOBJ_ALLOCA
])
diff --git a/m4/builtin-expect.m4 b/m4/builtin-expect.m4
index a6e889503dc..c58411643ca 100644
--- a/m4/builtin-expect.m4
+++ b/m4/builtin-expect.m4
@@ -1,6 +1,6 @@
dnl Check for __builtin_expect.
-dnl Copyright 2016-2020 Free Software Foundation, Inc.
+dnl Copyright 2016-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.
diff --git a/m4/byteswap.m4 b/m4/byteswap.m4
index 0f43994eb7d..1083b4c9e24 100644
--- a/m4/byteswap.m4
+++ b/m4/byteswap.m4
@@ -1,5 +1,5 @@
# byteswap.m4 serial 4
-dnl Copyright (C) 2005, 2007, 2009-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2005, 2007, 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.
diff --git a/m4/canonicalize.m4 b/m4/canonicalize.m4
index 14ea3e12fa0..475fa15d6bd 100644
--- a/m4/canonicalize.m4
+++ b/m4/canonicalize.m4
@@ -1,6 +1,6 @@
-# canonicalize.m4 serial 33
+# canonicalize.m4 serial 35
-dnl Copyright (C) 2003-2007, 2009-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2003-2007, 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,
@@ -11,7 +11,8 @@ dnl with or without modifications, as long as this notice is preserved.
AC_DEFUN([gl_FUNC_CANONICALIZE_FILENAME_MODE],
[
AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS])
- AC_CHECK_FUNCS_ONCE([canonicalize_file_name])
+ AC_REQUIRE([gl_FUNC_LSTAT_FOLLOWS_SLASHED_SYMLINK])
+ AC_CHECK_FUNCS_ONCE([canonicalize_file_name faccessat])
AC_REQUIRE([gl_DOUBLE_SLASH_ROOT])
AC_REQUIRE([gl_FUNC_REALPATH_WORKS])
if test $ac_cv_func_canonicalize_file_name = no; then
@@ -56,7 +57,8 @@ AC_DEFUN([gl_CANONICALIZE_LGPL],
AC_DEFUN([gl_CANONICALIZE_LGPL_SEPARATE],
[
AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS])
- AC_CHECK_FUNCS_ONCE([canonicalize_file_name readlink])
+ AC_REQUIRE([gl_FUNC_LSTAT_FOLLOWS_SLASHED_SYMLINK])
+ AC_CHECK_FUNCS_ONCE([canonicalize_file_name faccessat])
dnl On native Windows, we use _getcwd(), regardless whether getcwd() is
dnl available through the linker option '-loldnames'.
diff --git a/m4/clock_time.m4 b/m4/clock_time.m4
index f4f51fa0eac..c3b9e7ea408 100644
--- a/m4/clock_time.m4
+++ b/m4/clock_time.m4
@@ -1,5 +1,5 @@
# clock_time.m4 serial 10
-dnl Copyright (C) 2002-2006, 2009-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2002-2006, 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.
diff --git a/m4/close-stream.m4 b/m4/close-stream.m4
index f3cc7aa9466..feeb4eae5d3 100644
--- a/m4/close-stream.m4
+++ b/m4/close-stream.m4
@@ -1,5 +1,5 @@
#serial 4
-dnl Copyright (C) 2006-2007, 2009-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2006-2007, 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.
diff --git a/m4/copy-file-range.m4 b/m4/copy-file-range.m4
index 5c5a274d9cc..82904e9fce4 100644
--- a/m4/copy-file-range.m4
+++ b/m4/copy-file-range.m4
@@ -1,5 +1,5 @@
# copy-file-range.m4
-dnl Copyright 2019-2020 Free Software Foundation, Inc.
+dnl Copyright 2019-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.
diff --git a/m4/d-type.m4 b/m4/d-type.m4
index d40220a1b59..534a59e3e5b 100644
--- a/m4/d-type.m4
+++ b/m4/d-type.m4
@@ -5,7 +5,7 @@ dnl
dnl Check whether struct dirent has a member named d_type.
dnl
-# Copyright (C) 1997, 1999-2004, 2006, 2009-2020 Free Software Foundation, Inc.
+# Copyright (C) 1997, 1999-2004, 2006, 2009-2021 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
diff --git a/m4/dirent_h.m4 b/m4/dirent_h.m4
index 8bef6a0ce61..6d861425855 100644
--- a/m4/dirent_h.m4
+++ b/m4/dirent_h.m4
@@ -1,5 +1,5 @@
# dirent_h.m4 serial 16
-dnl Copyright (C) 2008-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2008-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.
diff --git a/m4/dirfd.m4 b/m4/dirfd.m4
index d92445e6d80..3c9ce5dc65f 100644
--- a/m4/dirfd.m4
+++ b/m4/dirfd.m4
@@ -2,7 +2,7 @@
dnl Find out how to get the file descriptor associated with an open DIR*.
-# Copyright (C) 2001-2006, 2008-2020 Free Software Foundation, Inc.
+# Copyright (C) 2001-2006, 2008-2021 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
diff --git a/m4/double-slash-root.m4 b/m4/double-slash-root.m4
index c463ac41aca..c9bbcef6781 100644
--- a/m4/double-slash-root.m4
+++ b/m4/double-slash-root.m4
@@ -1,5 +1,5 @@
# double-slash-root.m4 serial 4 -*- Autoconf -*-
-dnl Copyright (C) 2006, 2008-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2006, 2008-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.
diff --git a/m4/dup2.m4 b/m4/dup2.m4
index a82798d6bba..0753a32491e 100644
--- a/m4/dup2.m4
+++ b/m4/dup2.m4
@@ -1,5 +1,5 @@
#serial 27
-dnl Copyright (C) 2002, 2005, 2007, 2009-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2002, 2005, 2007, 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.
diff --git a/m4/eealloc.m4 b/m4/eealloc.m4
index 236f373c564..002f0c86713 100644
--- a/m4/eealloc.m4
+++ b/m4/eealloc.m4
@@ -1,5 +1,5 @@
# eealloc.m4 serial 3
-dnl Copyright (C) 2003, 2009-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2003, 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.
diff --git a/m4/environ.m4 b/m4/environ.m4
index bab85f13404..d971770860c 100644
--- a/m4/environ.m4
+++ b/m4/environ.m4
@@ -1,5 +1,5 @@
# environ.m4 serial 7
-dnl Copyright (C) 2001-2004, 2006-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2001-2004, 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,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/errno_h.m4 b/m4/errno_h.m4
index dd4994f3d5d..51dfe92938d 100644
--- a/m4/errno_h.m4
+++ b/m4/errno_h.m4
@@ -1,5 +1,5 @@
# errno_h.m4 serial 13
-dnl Copyright (C) 2004, 2006, 2008-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2004, 2006, 2008-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.
diff --git a/m4/euidaccess.m4 b/m4/euidaccess.m4
index 39f28b39b0b..4aeb90a7e04 100644
--- a/m4/euidaccess.m4
+++ b/m4/euidaccess.m4
@@ -1,5 +1,5 @@
# euidaccess.m4 serial 15
-dnl Copyright (C) 2002-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2002-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.
diff --git a/m4/execinfo.m4 b/m4/execinfo.m4
index 37ee8de5927..75ab44beeea 100644
--- a/m4/execinfo.m4
+++ b/m4/execinfo.m4
@@ -1,6 +1,6 @@
# Check for GNU-style execinfo.h.
-dnl Copyright 2012-2020 Free Software Foundation, Inc.
+dnl Copyright 2012-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.
diff --git a/m4/explicit_bzero.m4 b/m4/explicit_bzero.m4
index a415e7b4f5e..d77ec5a3a5e 100644
--- a/m4/explicit_bzero.m4
+++ b/m4/explicit_bzero.m4
@@ -1,4 +1,4 @@
-dnl Copyright 2017-2020 Free Software Foundation, Inc.
+dnl Copyright 2017-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.
diff --git a/m4/extensions.m4 b/m4/extensions.m4
index d7c95effdac..f7333acbd4f 100644
--- a/m4/extensions.m4
+++ b/m4/extensions.m4
@@ -1,14 +1,19 @@
-# serial 18 -*- Autoconf -*-
+# serial 21 -*- Autoconf -*-
# Enable extensions on systems that normally disable them.
-# Copyright (C) 2003, 2006-2020 Free Software Foundation, Inc.
+# Copyright (C) 2003, 2006-2021 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
+dnl Define to empty for the benefit of Autoconf 2.69 and earlier, so that
+dnl AC_USE_SYSTEM_EXTENSIONS (below) can be used unchanged from Autoconf 2.70+.
+m4_ifndef([AC_CHECK_INCLUDES_DEFAULT],
+ [AC_DEFUN([AC_CHECK_INCLUDES_DEFAULT], [])])
+
# This definition of AC_USE_SYSTEM_EXTENSIONS is stolen from git
# Autoconf. Perhaps we can remove this once we can assume Autoconf
-# 2.70 or later everywhere, but since Autoconf mutates rapidly
+# is recent-enough everywhere, but since Autoconf mutates rapidly
# enough in this area it's likely we'll need to redefine
# AC_USE_SYSTEM_EXTENSIONS for quite some time.
@@ -26,36 +31,27 @@
# its dependencies. This will ensure that the gl_USE_SYSTEM_EXTENSIONS
# invocation occurs in gl_EARLY, not in gl_INIT.
+m4_version_prereq([2.70.1], [], [
+
# AC_USE_SYSTEM_EXTENSIONS
# ------------------------
# Enable extensions on systems that normally disable them,
# typically due to standards-conformance issues.
-#
-# Remember that #undef in AH_VERBATIM gets replaced with #define by
-# AC_DEFINE. The goal here is to define all known feature-enabling
-# macros, then, if reports of conflicts are made, disable macros that
-# cause problems on some platforms (such as __EXTENSIONS__).
+# We unconditionally define as many of the known feature-enabling
+# as possible, reserving conditional behavior for macros that are
+# known to cause problems on some platforms (such as __EXTENSIONS__).
AC_DEFUN_ONCE([AC_USE_SYSTEM_EXTENSIONS],
-[AC_BEFORE([$0], [AC_COMPILE_IFELSE])dnl
+[AC_BEFORE([$0], [AC_PREPROC_IFELSE])dnl
+AC_BEFORE([$0], [AC_COMPILE_IFELSE])dnl
+AC_BEFORE([$0], [AC_LINK_IFELSE])dnl
AC_BEFORE([$0], [AC_RUN_IFELSE])dnl
-
- AC_CHECK_HEADER([minix/config.h], [MINIX=yes], [MINIX=])
- if test "$MINIX" = yes; then
- AC_DEFINE([_POSIX_SOURCE], [1],
- [Define to 1 if you need to in order for 'stat' and other
- things to work.])
- AC_DEFINE([_POSIX_1_SOURCE], [2],
- [Define to 2 if the system does not provide POSIX.1 features
- except with this defined.])
- AC_DEFINE([_MINIX], [1],
- [Define to 1 if on MINIX.])
- AC_DEFINE([_NETBSD_SOURCE], [1],
- [Define to 1 to make NetBSD features available. MINIX 3 needs this.])
- fi
-
+AC_BEFORE([$0], [AC_CHECK_INCLUDES_DEFAULT])dnl
+dnl #undef in AH_VERBATIM gets replaced with #define by AC_DEFINE.
dnl Use a different key than __EXTENSIONS__, as that name broke existing
dnl configure.ac when using autoheader 2.62.
- AH_VERBATIM([USE_SYSTEM_EXTENSIONS],
+dnl The macros below are in alphabetical order ignoring leading _ or __
+dnl prefixes.
+AH_VERBATIM([USE_SYSTEM_EXTENSIONS],
[/* Enable extensions on AIX 3, Interix. */
#ifndef _ALL_SOURCE
# undef _ALL_SOURCE
@@ -64,19 +60,44 @@ dnl configure.ac when using autoheader 2.62.
#ifndef _DARWIN_C_SOURCE
# undef _DARWIN_C_SOURCE
#endif
+/* Enable general extensions on Solaris. */
+#ifndef __EXTENSIONS__
+# undef __EXTENSIONS__
+#endif
/* Enable GNU extensions on systems that have them. */
#ifndef _GNU_SOURCE
# undef _GNU_SOURCE
#endif
-/* Enable NetBSD extensions on NetBSD. */
+/* Enable X/Open compliant socket functions that do not require linking
+ with -lxnet on HP-UX 11.11. */
+#ifndef _HPUX_ALT_XOPEN_SOCKET_API
+# undef _HPUX_ALT_XOPEN_SOCKET_API
+#endif
+/* Identify the host operating system as Minix.
+ This macro does not affect the system headers' behavior.
+ A future release of Autoconf may stop defining this macro. */
+#ifndef _MINIX
+# undef _MINIX
+#endif
+/* Enable general extensions on NetBSD.
+ Enable NetBSD compatibility extensions on Minix. */
#ifndef _NETBSD_SOURCE
# undef _NETBSD_SOURCE
#endif
-/* Enable OpenBSD extensions on NetBSD. */
+/* Enable OpenBSD compatibility extensions on NetBSD.
+ Oddly enough, this does nothing on OpenBSD. */
#ifndef _OPENBSD_SOURCE
# undef _OPENBSD_SOURCE
#endif
-/* Enable threading extensions on Solaris. */
+/* Define to 1 if needed for POSIX-compatible behavior. */
+#ifndef _POSIX_SOURCE
+# undef _POSIX_SOURCE
+#endif
+/* Define to 2 if needed for POSIX-compatible behavior. */
+#ifndef _POSIX_1_SOURCE
+# undef _POSIX_1_SOURCE
+#endif
+/* Enable POSIX-compatible threading on Solaris. */
#ifndef _POSIX_PTHREAD_SEMANTICS
# undef _POSIX_PTHREAD_SEMANTICS
#endif
@@ -112,22 +133,19 @@ dnl configure.ac when using autoheader 2.62.
#ifndef _TANDEM_SOURCE
# undef _TANDEM_SOURCE
#endif
-/* Enable X/Open extensions if necessary. HP-UX 11.11 defines
- mbstate_t only if _XOPEN_SOURCE is defined to 500, regardless of
- whether compiling with -Ae or -D_HPUX_SOURCE=1. */
+/* Enable X/Open extensions. Define to 500 only if necessary
+ to make mbstate_t available. */
#ifndef _XOPEN_SOURCE
# undef _XOPEN_SOURCE
#endif
-/* Enable X/Open compliant socket functions that do not require linking
- with -lxnet on HP-UX 11.11. */
-#ifndef _HPUX_ALT_XOPEN_SOCKET_API
-# undef _HPUX_ALT_XOPEN_SOCKET_API
-#endif
-/* Enable general extensions on Solaris. */
-#ifndef __EXTENSIONS__
-# undef __EXTENSIONS__
-#endif
-])
+])dnl
+
+ AC_REQUIRE([AC_CHECK_INCLUDES_DEFAULT])dnl
+ _AC_CHECK_HEADER_ONCE([wchar.h])
+ _AC_CHECK_HEADER_ONCE([minix/config.h])
+
+dnl Defining __EXTENSIONS__ may break the system headers on some systems.
+dnl (FIXME: Which ones?)
AC_CACHE_CHECK([whether it is safe to define __EXTENSIONS__],
[ac_cv_safe_to_define___extensions__],
[AC_COMPILE_IFELSE(
@@ -136,11 +154,33 @@ dnl configure.ac when using autoheader 2.62.
]AC_INCLUDES_DEFAULT])],
[ac_cv_safe_to_define___extensions__=yes],
[ac_cv_safe_to_define___extensions__=no])])
- test $ac_cv_safe_to_define___extensions__ = yes &&
- AC_DEFINE([__EXTENSIONS__])
+
+dnl HP-UX 11.11 defines mbstate_t only if _XOPEN_SOURCE is defined to
+dnl 500, regardless of whether compiling with -Ae or -D_HPUX_SOURCE=1.
+dnl But defining _XOPEN_SOURCE may turn *off* extensions on platforms
+dnl not covered by turn-on-extensions macros (notably Dragonfly, Free,
+dnl and OpenBSD, which don't have any equivalent of _NETBSD_SOURCE) so
+dnl it should only be defined when necessary.
+ AC_CACHE_CHECK([whether _XOPEN_SOURCE should be defined],
+ [ac_cv_should_define__xopen_source],
+ [ac_cv_should_define__xopen_source=no
+ AS_IF([test $ac_cv_header_wchar_h = yes],
+ [AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM([[
+ #include <wchar.h>
+ mbstate_t x;]])],
+ [],
+ [AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM([[
+ #define _XOPEN_SOURCE 500
+ #include <wchar.h>
+ mbstate_t x;]])],
+ [ac_cv_should_define__xopen_source=yes])])])])
+
AC_DEFINE([_ALL_SOURCE])
AC_DEFINE([_DARWIN_C_SOURCE])
AC_DEFINE([_GNU_SOURCE])
+ AC_DEFINE([_HPUX_ALT_XOPEN_SOCKET_API])
AC_DEFINE([_NETBSD_SOURCE])
AC_DEFINE([_OPENBSD_SOURCE])
AC_DEFINE([_POSIX_PTHREAD_SEMANTICS])
@@ -152,24 +192,18 @@ dnl configure.ac when using autoheader 2.62.
AC_DEFINE([__STDC_WANT_LIB_EXT2__])
AC_DEFINE([__STDC_WANT_MATH_SPEC_FUNCS__])
AC_DEFINE([_TANDEM_SOURCE])
- AC_CACHE_CHECK([whether _XOPEN_SOURCE should be defined],
- [ac_cv_should_define__xopen_source],
- [ac_cv_should_define__xopen_source=no
- AC_COMPILE_IFELSE(
- [AC_LANG_PROGRAM([[
- #include <wchar.h>
- mbstate_t x;]])],
- [],
- [AC_COMPILE_IFELSE(
- [AC_LANG_PROGRAM([[
- #define _XOPEN_SOURCE 500
- #include <wchar.h>
- mbstate_t x;]])],
- [ac_cv_should_define__xopen_source=yes])])])
- test $ac_cv_should_define__xopen_source = yes &&
- AC_DEFINE([_XOPEN_SOURCE], [500])
- AC_DEFINE([_HPUX_ALT_XOPEN_SOCKET_API])
+ AS_IF([test $ac_cv_header_minix_config_h = yes],
+ [MINIX=yes
+ AC_DEFINE([_MINIX])
+ AC_DEFINE([_POSIX_SOURCE])
+ AC_DEFINE([_POSIX_1_SOURCE], [2])],
+ [MINIX=])
+ AS_IF([test $ac_cv_safe_to_define___extensions__ = yes],
+ [AC_DEFINE([__EXTENSIONS__])])
+ AS_IF([test $ac_cv_should_define__xopen_source = yes],
+ [AC_DEFINE([_XOPEN_SOURCE], [500])])
])# AC_USE_SYSTEM_EXTENSIONS
+])
# gl_USE_SYSTEM_EXTENSIONS
# ------------------------
@@ -177,13 +211,5 @@ dnl configure.ac when using autoheader 2.62.
# typically due to standards-conformance issues.
AC_DEFUN_ONCE([gl_USE_SYSTEM_EXTENSIONS],
[
- dnl Require this macro before AC_USE_SYSTEM_EXTENSIONS.
- dnl gnulib does not need it. But if it gets required by third-party macros
- dnl after AC_USE_SYSTEM_EXTENSIONS is required, autoconf 2.62..2.63 emit a
- dnl warning: "AC_COMPILE_IFELSE was called before AC_USE_SYSTEM_EXTENSIONS".
- dnl Note: We can do this only for one of the macros AC_AIX, AC_GNU_SOURCE,
- dnl AC_MINIX. If people still use AC_AIX or AC_MINIX, they are out of luck.
- AC_REQUIRE([AC_GNU_SOURCE])
-
AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS])
])
diff --git a/m4/extern-inline.m4 b/m4/extern-inline.m4
index 75c50087bd0..a2acf126c87 100644
--- a/m4/extern-inline.m4
+++ b/m4/extern-inline.m4
@@ -1,6 +1,6 @@
dnl 'extern inline' a la ISO C99.
-dnl Copyright 2012-2020 Free Software Foundation, Inc.
+dnl Copyright 2012-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.
diff --git a/m4/faccessat.m4 b/m4/faccessat.m4
index 7a8b979f8db..9d6b3635117 100644
--- a/m4/faccessat.m4
+++ b/m4/faccessat.m4
@@ -1,7 +1,7 @@
-# serial 8
+# serial 10
# See if we need to provide faccessat replacement.
-dnl Copyright (C) 2009-2020 Free Software Foundation, Inc.
+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.
@@ -20,7 +20,7 @@ AC_DEFUN([gl_FUNC_FACCESSAT],
if test $ac_cv_func_faccessat = no; then
HAVE_FACCESSAT=0
else
- case "$gl_cv_func_lstat_dereferences_slashed_symlink" in
+ case $gl_cv_func_lstat_dereferences_slashed_symlink in
*yes) ;;
*) REPLACE_FACCESSAT=1 ;;
esac
diff --git a/m4/fchmodat.m4 b/m4/fchmodat.m4
index cf5c87999c5..09380327799 100644
--- a/m4/fchmodat.m4
+++ b/m4/fchmodat.m4
@@ -1,5 +1,5 @@
# fchmodat.m4 serial 5
-dnl Copyright (C) 2004-2020 Free Software Foundation, Inc.
+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,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/fcntl.m4 b/m4/fcntl.m4
index ea24f3d64ef..f6264345c1b 100644
--- a/m4/fcntl.m4
+++ b/m4/fcntl.m4
@@ -1,5 +1,5 @@
-# fcntl.m4 serial 10
-dnl Copyright (C) 2009-2020 Free Software Foundation, Inc.
+# fcntl.m4 serial 11
+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.
@@ -81,15 +81,29 @@ AC_DEFUN([gl_FUNC_FCNTL],
behavior does not match POSIX]) ;;
esac
- dnl Many systems lack F_DUPFD_CLOEXEC
+ dnl Many systems lack F_DUPFD_CLOEXEC.
+ dnl NetBSD 9.0 declares F_DUPFD_CLOEXEC but it works only like F_DUPFD.
AC_CACHE_CHECK([whether fcntl understands F_DUPFD_CLOEXEC],
[gl_cv_func_fcntl_f_dupfd_cloexec],
- [AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
-#include <fcntl.h>
-#ifndef F_DUPFD_CLOEXEC
-choke me
-#endif
- ]])],
+ [AC_RUN_IFELSE(
+ [AC_LANG_SOURCE(
+ [[#include <fcntl.h>
+ #include <unistd.h>
+ int main (int argc, char *argv[])
+ {
+ if (argc == 1)
+ /* parent process */
+ {
+ if (fcntl (1, F_DUPFD_CLOEXEC, 10) < 0)
+ return 1;
+ return execl ("./conftest", "./conftest", "child", NULL);
+ }
+ else
+ /* child process */
+ return (fcntl (10, F_GETFL) < 0 ? 0 : 42);
+ }
+ ]])
+ ],
[AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
#ifdef __linux__
/* The Linux kernel only added F_DUPFD_CLOEXEC in 2.6.24, so we always replace
@@ -98,12 +112,22 @@ choke me
#endif
]])],
[gl_cv_func_fcntl_f_dupfd_cloexec=yes],
- [gl_cv_func_fcntl_f_dupfd_cloexec="needs runtime check"])],
- [gl_cv_func_fcntl_f_dupfd_cloexec=no])])
- if test "$gl_cv_func_fcntl_f_dupfd_cloexec" != yes; then
- gl_REPLACE_FCNTL
- dnl No witness macro needed for this bug.
- fi
+ [gl_cv_func_fcntl_f_dupfd_cloexec="needs runtime check"])
+ ],
+ [gl_cv_func_fcntl_f_dupfd_cloexec=no],
+ [case "$host_os" in
+ # Guess no on NetBSD.
+ netbsd*) gl_cv_func_fcntl_f_dupfd_cloexec="guessing no" ;;
+ *) gl_cv_func_fcntl_f_dupfd_cloexec="$gl_cross_guess_normal" ;;
+ esac
+ ])
+ ])
+ case "$gl_cv_func_fcntl_f_dupfd_cloexec" in
+ *yes) ;;
+ *) gl_REPLACE_FCNTL
+ dnl No witness macro needed for this bug.
+ ;;
+ esac
fi
dnl Replace fcntl() for supporting the gnulib-defined fchdir() function,
dnl to keep fchdir's bookkeeping up-to-date.
diff --git a/m4/fcntl_h.m4 b/m4/fcntl_h.m4
index 6b253937fd1..e63a82f10a2 100644
--- a/m4/fcntl_h.m4
+++ b/m4/fcntl_h.m4
@@ -1,6 +1,6 @@
-# serial 16
+# serial 17
# Configure fcntl.h.
-dnl Copyright (C) 2006-2007, 2009-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2006-2007, 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.
@@ -42,6 +42,9 @@ AC_DEFUN([gl_FCNTL_H_DEFAULTS],
GNULIB_NONBLOCKING=0; AC_SUBST([GNULIB_NONBLOCKING])
GNULIB_OPEN=0; AC_SUBST([GNULIB_OPEN])
GNULIB_OPENAT=0; AC_SUBST([GNULIB_OPENAT])
+ dnl Support Microsoft deprecated alias function names by default.
+ GNULIB_MDA_CREAT=1; AC_SUBST([GNULIB_MDA_CREAT])
+ GNULIB_MDA_OPEN=1; AC_SUBST([GNULIB_MDA_OPEN])
dnl Assume proper GNU behavior unless another module says otherwise.
HAVE_FCNTL=1; AC_SUBST([HAVE_FCNTL])
HAVE_OPENAT=1; AC_SUBST([HAVE_OPENAT])
diff --git a/m4/fdopendir.m4 b/m4/fdopendir.m4
index 9937a74ea8d..d42838087b5 100644
--- a/m4/fdopendir.m4
+++ b/m4/fdopendir.m4
@@ -1,7 +1,7 @@
# serial 14
# See if we need to provide fdopendir.
-dnl Copyright (C) 2009-2020 Free Software Foundation, Inc.
+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.
diff --git a/m4/filemode.m4 b/m4/filemode.m4
index 5aaaa1a167d..4dc24efbd3c 100644
--- a/m4/filemode.m4
+++ b/m4/filemode.m4
@@ -1,11 +1,10 @@
-# filemode.m4 serial 8
-dnl Copyright (C) 2002, 2005-2006, 2009-2020 Free Software Foundation, Inc.
+# filemode.m4 serial 9
+dnl Copyright (C) 2002, 2005-2006, 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.
AC_DEFUN([gl_FILEMODE],
[
- AC_REQUIRE([AC_STRUCT_ST_DM_MODE])
AC_CHECK_DECLS_ONCE([strmode])
])
diff --git a/m4/flexmember.m4 b/m4/flexmember.m4
index 90f3dddc660..49b1c752dae 100644
--- a/m4/flexmember.m4
+++ b/m4/flexmember.m4
@@ -1,7 +1,7 @@
# serial 5
# Check for flexible array member support.
-# Copyright (C) 2006, 2009-2020 Free Software Foundation, Inc.
+# Copyright (C) 2006, 2009-2021 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
diff --git a/m4/fpending.m4 b/m4/fpending.m4
index edabcec5f0b..131356ad46a 100644
--- a/m4/fpending.m4
+++ b/m4/fpending.m4
@@ -1,6 +1,6 @@
# serial 23
-# Copyright (C) 2000-2001, 2004-2020 Free Software Foundation, Inc.
+# Copyright (C) 2000-2001, 2004-2021 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
diff --git a/m4/fpieee.m4 b/m4/fpieee.m4
index d5c9aefa813..3f16957fbd2 100644
--- a/m4/fpieee.m4
+++ b/m4/fpieee.m4
@@ -1,5 +1,5 @@
# fpieee.m4 serial 2 -*- coding: utf-8 -*-
-dnl Copyright (C) 2007, 2009-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2007, 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.
diff --git a/m4/free.m4 b/m4/free.m4
new file mode 100644
index 00000000000..d671376b0bb
--- /dev/null
+++ b/m4/free.m4
@@ -0,0 +1,49 @@
+# free.m4 serial 5
+# Copyright (C) 2003-2005, 2009-2021 Free Software Foundation, Inc.
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+# Written by Paul Eggert and Bruno Haible.
+
+AC_DEFUN([gl_FUNC_FREE],
+[
+ AC_REQUIRE([gl_STDLIB_H_DEFAULTS])
+
+ dnl In the next release of POSIX, free must preserve errno.
+ dnl https://www.austingroupbugs.net/view.php?id=385
+ dnl https://sourceware.org/bugzilla/show_bug.cgi?id=17924
+ dnl So far, we know of three platforms that do this:
+ dnl * glibc >= 2.33, thanks to the fix for this bug:
+ dnl <https://sourceware.org/bugzilla/show_bug.cgi?id=17924>
+ dnl * OpenBSD >= 4.5, thanks to this commit:
+ dnl <https://cvsweb.openbsd.org/cgi-bin/cvsweb/src/lib/libc/stdlib/malloc.c.diff?r1=1.100&r2=1.101&f=h>
+ dnl * Solaris, because its malloc() implementation is based on brk(),
+ dnl not mmap(); hence its free() implementation makes no system calls.
+ dnl For other platforms, you can only be sure if they state it in their
+ dnl documentation, or by code inspection of the free() implementation in libc.
+ AC_CACHE_CHECK([whether free is known to preserve errno],
+ [gl_cv_func_free_preserves_errno],
+ [AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#include <stdlib.h>
+ ]],
+ [[#if 2 < __GLIBC__ + (33 <= __GLIBC_MINOR__)
+ #elif defined __OpenBSD__
+ #elif defined __sun
+ #else
+ #error "'free' is not known to preserve errno"
+ #endif
+ ]])],
+ [gl_cv_func_free_preserves_errno=yes],
+ [gl_cv_func_free_preserves_errno=no])
+ ])
+
+ case $gl_cv_func_free_preserves_errno in
+ *yes) ;;
+ *) REPLACE_FREE=1 ;;
+ esac
+])
+
+# Prerequisites of lib/free.c.
+AC_DEFUN([gl_PREREQ_FREE], [:])
diff --git a/m4/fstatat.m4 b/m4/fstatat.m4
index 19583ed1e40..d730e46d303 100644
--- a/m4/fstatat.m4
+++ b/m4/fstatat.m4
@@ -1,5 +1,5 @@
# fstatat.m4 serial 4
-dnl Copyright (C) 2004-2020 Free Software Foundation, Inc.
+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,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/fsusage.m4 b/m4/fsusage.m4
index 0bc62066aab..d005579f9e0 100644
--- a/m4/fsusage.m4
+++ b/m4/fsusage.m4
@@ -1,7 +1,7 @@
-# serial 34
+# serial 35
# Obtaining file system usage information.
-# Copyright (C) 1997-1998, 2000-2001, 2003-2020 Free Software Foundation, Inc.
+# Copyright (C) 1997-1998, 2000-2001, 2003-2021 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
@@ -36,7 +36,6 @@ AC_DEFUN([gl_FILE_SYSTEM_USAGE],
dnl Mac OS X >= 10.5 (32-bit mode).
AC_REQUIRE([AC_SYS_LARGEFILE])
- AC_MSG_CHECKING([how to get file system space usage])
ac_fsusage_space=no
# Perform only the link test since it seems there are no variants of the
diff --git a/m4/fsync.m4 b/m4/fsync.m4
index c86c0e6a53d..6dc8cd1c0fa 100644
--- a/m4/fsync.m4
+++ b/m4/fsync.m4
@@ -1,5 +1,5 @@
# fsync.m4 serial 2
-dnl Copyright (C) 2008-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2008-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.
diff --git a/m4/futimens.m4 b/m4/futimens.m4
index 145b8ff0d51..2e9f53e5a81 100644
--- a/m4/futimens.m4
+++ b/m4/futimens.m4
@@ -1,7 +1,7 @@
# serial 9
# See if we need to provide futimens replacement.
-dnl Copyright (C) 2009-2020 Free Software Foundation, Inc.
+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.
diff --git a/m4/getdtablesize.m4 b/m4/getdtablesize.m4
index af328644adb..8fbc941898f 100644
--- a/m4/getdtablesize.m4
+++ b/m4/getdtablesize.m4
@@ -1,5 +1,5 @@
# getdtablesize.m4 serial 8
-dnl Copyright (C) 2008-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2008-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.
diff --git a/m4/getgroups.m4 b/m4/getgroups.m4
index e3441621b25..bd746cdf88f 100644
--- a/m4/getgroups.m4
+++ b/m4/getgroups.m4
@@ -3,7 +3,7 @@
dnl From Jim Meyering.
dnl A wrapper around AC_FUNC_GETGROUPS.
-# Copyright (C) 1996-1997, 1999-2004, 2008-2020 Free Software Foundation, Inc.
+# Copyright (C) 1996-1997, 1999-2004, 2008-2021 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
diff --git a/m4/getloadavg.m4 b/m4/getloadavg.m4
index 9fe328efc02..bba22169497 100644
--- a/m4/getloadavg.m4
+++ b/m4/getloadavg.m4
@@ -1,6 +1,6 @@
# Check for getloadavg.
-# Copyright (C) 1992-1996, 1999-2000, 2002-2003, 2006, 2008-2020 Free Software
+# Copyright (C) 1992-1996, 1999-2000, 2002-2003, 2006, 2008-2021 Free Software
# Foundation, Inc.
# This file is free software; the Free Software Foundation
diff --git a/m4/getopt.m4 b/m4/getopt.m4
index 595483d58cb..bb95c5ea28e 100644
--- a/m4/getopt.m4
+++ b/m4/getopt.m4
@@ -1,5 +1,5 @@
# getopt.m4 serial 47
-dnl Copyright (C) 2002-2006, 2008-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2002-2006, 2008-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.
diff --git a/m4/getrandom.m4 b/m4/getrandom.m4
index d6da71a2c83..5f174dc7eb3 100644
--- a/m4/getrandom.m4
+++ b/m4/getrandom.m4
@@ -1,5 +1,5 @@
# getrandom.m4 serial 8
-dnl Copyright 2020 Free Software Foundation, Inc.
+dnl Copyright 2020-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.
diff --git a/m4/gettime.m4 b/m4/gettime.m4
index e65455a2ff9..de7c33046c2 100644
--- a/m4/gettime.m4
+++ b/m4/gettime.m4
@@ -1,5 +1,5 @@
# gettime.m4 serial 9
-dnl Copyright (C) 2002, 2004-2006, 2009-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2002, 2004-2006, 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.
diff --git a/m4/gettimeofday.m4 b/m4/gettimeofday.m4
index 578ed49b077..3c200815740 100644
--- a/m4/gettimeofday.m4
+++ b/m4/gettimeofday.m4
@@ -1,6 +1,6 @@
# serial 28
-# Copyright (C) 2001-2003, 2005, 2007, 2009-2020 Free Software Foundation, Inc.
+# Copyright (C) 2001-2003, 2005, 2007, 2009-2021 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
diff --git a/m4/glibc21.m4 b/m4/glibc21.m4
index ece484b5ae9..74a781aa1c9 100644
--- a/m4/glibc21.m4
+++ b/m4/glibc21.m4
@@ -1,6 +1,6 @@
# glibc21.m4 serial 5
-dnl Copyright (C) 2000-2002, 2004, 2008, 2010-2020 Free Software Foundation,
-dnl Inc.
+dnl Copyright (C) 2000-2002, 2004, 2008, 2010-2021 Free Software
+dnl 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.
diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4
index 33e56faa98e..535359b2cf6 100644
--- a/m4/gnulib-common.m4
+++ b/m4/gnulib-common.m4
@@ -1,5 +1,5 @@
-# gnulib-common.m4 serial 57
-dnl Copyright (C) 2007-2020 Free Software Foundation, Inc.
+# gnulib-common.m4 serial 63
+dnl Copyright (C) 2007-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.
@@ -483,23 +483,17 @@ AC_DEFUN([gl_FEATURES_H],
# gl_PROG_CC_C99
# Modifies the value of the shell variable CC in an attempt to make $CC
# understand ISO C99 source code.
-# This is like AC_PROG_CC_C99, except that
-# - AC_PROG_CC_C99 does not mix well with AC_PROG_CC_STDC
-# <https://lists.gnu.org/r/bug-gnulib/2011-09/msg00367.html>,
-# but many more packages use AC_PROG_CC_STDC than AC_PROG_CC_C99
-# <https://lists.gnu.org/r/bug-gnulib/2011-09/msg00441.html>.
-# Remaining problems:
-# - When AC_PROG_CC_STDC is invoked twice, it adds the C99 enabling options
-# to CC twice
-# <https://lists.gnu.org/r/bug-gnulib/2011-09/msg00431.html>.
-# - AC_PROG_CC_STDC is likely to change now that C11 is an ISO standard.
AC_DEFUN([gl_PROG_CC_C99],
[
- dnl Change that version number to the minimum Autoconf version that supports
- dnl mixing AC_PROG_CC_C99 calls with AC_PROG_CC_STDC calls.
- m4_version_prereq([9.0],
- [AC_REQUIRE([AC_PROG_CC_C99])],
- [AC_REQUIRE([AC_PROG_CC_STDC])])
+ dnl Just use AC_PROG_CC_C99.
+ dnl When AC_PROG_CC_C99 and AC_PROG_CC_STDC are used together, the substituted
+ dnl value of CC will contain the C99 enabling options twice. But this is only
+ dnl a cosmetic problem.
+ dnl With Autoconf >= 2.70, use AC_PROG_CC since it implies AC_PROG_CC_C99;
+ dnl this avoids a "warning: The macro `AC_PROG_CC_C99' is obsolete."
+ m4_version_prereq([2.70],
+ [AC_REQUIRE([AC_PROG_CC])],
+ [AC_REQUIRE([AC_PROG_CC_C99])])
])
# gl_PROG_AR_RANLIB
@@ -573,16 +567,16 @@ Amsterdam
])
# AC_C_RESTRICT
-# This definition is copied from post-2.69 Autoconf and overrides the
-# AC_C_RESTRICT macro from autoconf 2.60..2.69. It can be removed
-# once autoconf >= 2.70 can be assumed. It's painful to check version
-# numbers, and in practice this macro is more up-to-date than Autoconf
-# is, so override Autoconf unconditionally.
+# This definition is copied from post-2.70 Autoconf and overrides the
+# AC_C_RESTRICT macro from autoconf 2.60..2.70.
+m4_version_prereq([2.70.1], [], [
AC_DEFUN([AC_C_RESTRICT],
[AC_CACHE_CHECK([for C/C++ restrict keyword], [ac_cv_c_restrict],
[ac_cv_c_restrict=no
- # The order here caters to the fact that C++ does not require restrict.
- for ac_kw in __restrict __restrict__ _Restrict restrict; do
+ # Put '__restrict__' first, to avoid problems with glibc and non-GCC; see:
+ # https://lists.gnu.org/archive/html/bug-autoconf/2016-02/msg00006.html
+ # Put 'restrict' last, because C++ lacks it.
+ for ac_kw in __restrict__ __restrict _Restrict restrict; do
AC_COMPILE_IFELSE(
[AC_LANG_PROGRAM(
[[typedef int *int_ptr;
@@ -602,7 +596,7 @@ AC_DEFUN([AC_C_RESTRICT],
AH_VERBATIM([restrict],
[/* Define to the equivalent of the C99 'restrict' keyword, or to
nothing if this is not supported. Do not define if restrict is
- supported directly. */
+ supported only directly. */
#undef restrict
/* Work around a bug in older versions of Sun C++, which did not
#define __restrict__ or support _Restrict or __restrict__
@@ -620,6 +614,7 @@ AC_DEFUN([AC_C_RESTRICT],
*) AC_DEFINE_UNQUOTED([restrict], [$ac_cv_c_restrict]) ;;
esac
])# AC_C_RESTRICT
+])
# gl_BIGENDIAN
# is like AC_C_BIGENDIAN, except that it can be AC_REQUIREd.
@@ -630,13 +625,20 @@ AC_DEFUN([gl_BIGENDIAN],
AC_C_BIGENDIAN
])
+# A temporary file descriptor.
+# Must be less than 10, because dash 0.5.8 does not support redirections
+# with multi-digit file descriptors.
+m4_define([GL_TMP_FD], 9)
+
# gl_SILENT(command)
# executes command, but without the normal configure output.
+# This is useful when you want to invoke AC_CACHE_CHECK (or AC_CHECK_FUNC etc.)
+# inside another AC_CACHE_CHECK.
AC_DEFUN([gl_SILENT],
[
- {
- $1
- } AS_MESSAGE_FD>/dev/null
+ exec GL_TMP_FD>&AS_MESSAGE_FD AS_MESSAGE_FD>/dev/null
+ $1
+ exec AS_MESSAGE_FD>&GL_TMP_FD GL_TMP_FD>&-
])
# gl_CACHE_VAL_SILENT(cache-id, command-to-set-it)
@@ -646,10 +648,9 @@ AC_DEFUN([gl_SILENT],
# by an AC_MSG_CHECKING/AC_MSG_RESULT pair.
AC_DEFUN([gl_CACHE_VAL_SILENT],
[
- saved_as_echo_n="$as_echo_n"
- as_echo_n=':'
- AC_CACHE_VAL([$1], [$2])
- as_echo_n="$saved_as_echo_n"
+ gl_SILENT([
+ AC_CACHE_VAL([$1], [$2])
+ ])
])
dnl Expands to some code for use in .c programs that, on native Windows, defines
diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4
index d2fdbd82e73..ad109520dd1 100644
--- a/m4/gnulib-comp.m4
+++ b/m4/gnulib-comp.m4
@@ -1,5 +1,5 @@
# DO NOT EDIT! GENERATED AUTOMATICALLY!
-# Copyright (C) 2002-2020 Free Software Foundation, Inc.
+# Copyright (C) 2002-2021 Free Software Foundation, Inc.
#
# 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
@@ -75,6 +75,7 @@ AC_DEFUN([gl_EARLY],
# Code from module dtoastr:
# Code from module dtotimespec:
# Code from module dup2:
+ # Code from module eloop-threshold:
# Code from module environ:
# Code from module errno:
# Code from module euidaccess:
@@ -94,6 +95,7 @@ AC_DEFUN([gl_EARLY],
# Code from module fpending:
# Code from module fpieee:
AC_REQUIRE([gl_FP_IEEE])
+ # Code from module free-posix:
# Code from module fstatat:
# Code from module fsusage:
# Code from module fsync:
@@ -109,6 +111,7 @@ AC_DEFUN([gl_EARLY],
# Code from module gettimeofday:
# Code from module gitlog-to-changelog:
# Code from module group-member:
+ # Code from module idx:
# Code from module ieee754-h:
# Code from module ignore-value:
# Code from module include_next:
@@ -121,7 +124,6 @@ AC_DEFUN([gl_EARLY],
# Code from module libgmp:
# Code from module limits-h:
# Code from module lstat:
- # Code from module malloca:
# Code from module manywarnings:
# Code from module memmem-simple:
# Code from module mempcpy:
@@ -140,10 +142,12 @@ AC_DEFUN([gl_EARLY],
# Code from module pselect:
# Code from module pthread_sigmask:
# Code from module qcopy-acl:
+ # Code from module rawmemchr:
# Code from module readlink:
# Code from module readlinkat:
# Code from module regex:
# Code from module root-uid:
+ # Code from module scratch_buffer:
# Code from module sig2str:
# Code from module sigdescr_np:
# Code from module signal-h:
@@ -288,6 +292,12 @@ AC_DEFUN([gl_INIT],
if test $gl_cv_func___fpending = no; then
AC_LIBOBJ([fpending])
fi
+ gl_FUNC_FREE
+ if test $REPLACE_FREE = 1; then
+ AC_LIBOBJ([free])
+ gl_PREREQ_FREE
+ fi
+ gl_STDLIB_MODULE_INDICATOR([free-posix])
gl_FUNC_FSTATAT
if test $HAVE_FSTATAT = 0 || test $REPLACE_FSTATAT = 1; then
AC_LIBOBJ([fstatat])
@@ -507,17 +517,20 @@ AC_DEFUN([gl_INIT],
gl_gnulib_enabled_260941c0e5dc67ec9e87d1fb321c300b=false
gl_gnulib_enabled_cloexec=false
gl_gnulib_enabled_dirfd=false
+ gl_gnulib_enabled_925677f0343de64b89a9f0c790b4104c=false
gl_gnulib_enabled_euidaccess=false
gl_gnulib_enabled_getdtablesize=false
gl_gnulib_enabled_getgroups=false
gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36=false
gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1=false
+ gl_gnulib_enabled_idx=false
gl_gnulib_enabled_lchmod=false
- gl_gnulib_enabled_malloca=false
gl_gnulib_enabled_5264294aa0a5557541b53c8c741f7f31=false
gl_gnulib_enabled_open=false
gl_gnulib_enabled_03e0aaad4cb89ca757653bd367a6ccb7=false
+ gl_gnulib_enabled_rawmemchr=false
gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c=false
+ gl_gnulib_enabled_scratch_buffer=false
gl_gnulib_enabled_strtoll=false
gl_gnulib_enabled_utimens=false
gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec=false
@@ -551,6 +564,12 @@ AC_DEFUN([gl_INIT],
gl_gnulib_enabled_dirfd=true
fi
}
+ func_gl_gnulib_m4code_925677f0343de64b89a9f0c790b4104c ()
+ {
+ if ! $gl_gnulib_enabled_925677f0343de64b89a9f0c790b4104c; then
+ gl_gnulib_enabled_925677f0343de64b89a9f0c790b4104c=true
+ fi
+ }
func_gl_gnulib_m4code_euidaccess ()
{
if ! $gl_gnulib_enabled_euidaccess; then
@@ -616,6 +635,12 @@ AC_DEFUN([gl_INIT],
fi
fi
}
+ func_gl_gnulib_m4code_idx ()
+ {
+ if ! $gl_gnulib_enabled_idx; then
+ gl_gnulib_enabled_idx=true
+ fi
+ }
func_gl_gnulib_m4code_lchmod ()
{
if ! $gl_gnulib_enabled_lchmod; then
@@ -628,14 +653,6 @@ AC_DEFUN([gl_INIT],
gl_gnulib_enabled_lchmod=true
fi
}
- func_gl_gnulib_m4code_malloca ()
- {
- if ! $gl_gnulib_enabled_malloca; then
- gl_MALLOCA
- gl_gnulib_enabled_malloca=true
- func_gl_gnulib_m4code_682e609604ccaac6be382e4ee3a4eaec
- fi
- }
func_gl_gnulib_m4code_5264294aa0a5557541b53c8c741f7f31 ()
{
if ! $gl_gnulib_enabled_5264294aa0a5557541b53c8c741f7f31; then
@@ -668,12 +685,30 @@ AC_DEFUN([gl_INIT],
gl_gnulib_enabled_03e0aaad4cb89ca757653bd367a6ccb7=true
fi
}
+ func_gl_gnulib_m4code_rawmemchr ()
+ {
+ if ! $gl_gnulib_enabled_rawmemchr; then
+ gl_FUNC_RAWMEMCHR
+ if test $HAVE_RAWMEMCHR = 0; then
+ AC_LIBOBJ([rawmemchr])
+ gl_PREREQ_RAWMEMCHR
+ fi
+ gl_STRING_MODULE_INDICATOR([rawmemchr])
+ gl_gnulib_enabled_rawmemchr=true
+ fi
+ }
func_gl_gnulib_m4code_6099e9737f757db36c47fa9d9f02e88c ()
{
if ! $gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c; then
gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c=true
fi
}
+ func_gl_gnulib_m4code_scratch_buffer ()
+ {
+ if ! $gl_gnulib_enabled_scratch_buffer; then
+ gl_gnulib_enabled_scratch_buffer=true
+ fi
+ }
func_gl_gnulib_m4code_strtoll ()
{
if ! $gl_gnulib_enabled_strtoll; then
@@ -700,7 +735,16 @@ AC_DEFUN([gl_INIT],
fi
}
if test $HAVE_CANONICALIZE_FILE_NAME = 0 || test $REPLACE_CANONICALIZE_FILE_NAME = 1; then
- func_gl_gnulib_m4code_malloca
+ func_gl_gnulib_m4code_925677f0343de64b89a9f0c790b4104c
+ fi
+ if test $HAVE_CANONICALIZE_FILE_NAME = 0 || test $REPLACE_CANONICALIZE_FILE_NAME = 1; then
+ func_gl_gnulib_m4code_idx
+ fi
+ if test $HAVE_CANONICALIZE_FILE_NAME = 0 || test $REPLACE_CANONICALIZE_FILE_NAME = 1; then
+ func_gl_gnulib_m4code_rawmemchr
+ fi
+ if test $HAVE_CANONICALIZE_FILE_NAME = 0 || test $REPLACE_CANONICALIZE_FILE_NAME = 1; then
+ func_gl_gnulib_m4code_scratch_buffer
fi
if test $HAVE_FACCESSAT = 0 || test $REPLACE_FACCESSAT = 1; then
func_gl_gnulib_m4code_260941c0e5dc67ec9e87d1fb321c300b
@@ -747,15 +791,18 @@ AC_DEFUN([gl_INIT],
if case $host_os in mingw*) false;; *) test $HAVE_GETRANDOM = 0 || test $REPLACE_GETRANDOM = 1;; esac; then
func_gl_gnulib_m4code_open
fi
- if test $HAVE_READLINKAT = 0; then
+ if test $HAVE_READLINKAT = 0 || test $REPLACE_READLINKAT = 1; then
func_gl_gnulib_m4code_260941c0e5dc67ec9e87d1fb321c300b
fi
- if test $HAVE_READLINKAT = 0; then
+ if test $HAVE_READLINKAT = 0 || test $REPLACE_READLINKAT = 1; then
func_gl_gnulib_m4code_03e0aaad4cb89ca757653bd367a6ccb7
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
+ if test $HAVE_TIMEZONE_T = 0; then
+ func_gl_gnulib_m4code_idx
+ fi
if test $HAVE_TIMEGM = 0 || test $REPLACE_TIMEGM = 1; then
func_gl_gnulib_m4code_5264294aa0a5557541b53c8c741f7f31
fi
@@ -772,17 +819,20 @@ 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_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])
AM_CONDITIONAL([gl_GNULIB_ENABLED_getgroups], [$gl_gnulib_enabled_getgroups])
AM_CONDITIONAL([gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36], [$gl_gnulib_enabled_be453cec5eecf5731a274f2de7f2db36])
AM_CONDITIONAL([gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1], [$gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1])
+ AM_CONDITIONAL([gl_GNULIB_ENABLED_idx], [$gl_gnulib_enabled_idx])
AM_CONDITIONAL([gl_GNULIB_ENABLED_lchmod], [$gl_gnulib_enabled_lchmod])
- AM_CONDITIONAL([gl_GNULIB_ENABLED_malloca], [$gl_gnulib_enabled_malloca])
AM_CONDITIONAL([gl_GNULIB_ENABLED_5264294aa0a5557541b53c8c741f7f31], [$gl_gnulib_enabled_5264294aa0a5557541b53c8c741f7f31])
AM_CONDITIONAL([gl_GNULIB_ENABLED_open], [$gl_gnulib_enabled_open])
AM_CONDITIONAL([gl_GNULIB_ENABLED_03e0aaad4cb89ca757653bd367a6ccb7], [$gl_gnulib_enabled_03e0aaad4cb89ca757653bd367a6ccb7])
+ AM_CONDITIONAL([gl_GNULIB_ENABLED_rawmemchr], [$gl_gnulib_enabled_rawmemchr])
AM_CONDITIONAL([gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c], [$gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c])
+ AM_CONDITIONAL([gl_GNULIB_ENABLED_scratch_buffer], [$gl_gnulib_enabled_scratch_buffer])
AM_CONDITIONAL([gl_GNULIB_ENABLED_strtoll], [$gl_gnulib_enabled_strtoll])
AM_CONDITIONAL([gl_GNULIB_ENABLED_utimens], [$gl_gnulib_enabled_utimens])
AM_CONDITIONAL([gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec], [$gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec])
@@ -971,6 +1021,7 @@ AC_DEFUN([gl_FILE_LIST], [
lib/dtoastr.c
lib/dtotimespec.c
lib/dup2.c
+ lib/eloop-threshold.h
lib/errno.in.h
lib/euidaccess.c
lib/execinfo.c
@@ -989,6 +1040,7 @@ AC_DEFUN([gl_FILE_LIST], [
lib/flexmember.h
lib/fpending.c
lib/fpending.h
+ lib/free.c
lib/fstatat.c
lib/fsusage.c
lib/fsusage.h
@@ -1015,6 +1067,7 @@ AC_DEFUN([gl_FILE_LIST], [
lib/gettimeofday.c
lib/gl_openssl.h
lib/group-member.c
+ lib/idx.h
lib/ieee754.in.h
lib/ignore-value.h
lib/intprops.h
@@ -1023,8 +1076,11 @@ AC_DEFUN([gl_FILE_LIST], [
lib/libc-config.h
lib/limits.in.h
lib/lstat.c
- lib/malloca.c
- lib/malloca.h
+ lib/malloc/scratch_buffer.h
+ lib/malloc/scratch_buffer_dupfree.c
+ lib/malloc/scratch_buffer_grow.c
+ lib/malloc/scratch_buffer_grow_preserve.c
+ lib/malloc/scratch_buffer_set_array_size.c
lib/md5.c
lib/md5.h
lib/memmem.c
@@ -1047,6 +1103,8 @@ AC_DEFUN([gl_FILE_LIST], [
lib/pselect.c
lib/pthread_sigmask.c
lib/qcopy-acl.c
+ lib/rawmemchr.c
+ lib/rawmemchr.valgrind
lib/readlink.c
lib/readlinkat.c
lib/regcomp.c
@@ -1056,6 +1114,7 @@ AC_DEFUN([gl_FILE_LIST], [
lib/regex_internal.h
lib/regexec.c
lib/root-uid.h
+ lib/scratch_buffer.h
lib/set-permissions.c
lib/sha1.c
lib/sha1.h
@@ -1145,6 +1204,7 @@ AC_DEFUN([gl_FILE_LIST], [
m4/flexmember.m4
m4/fpending.m4
m4/fpieee.m4
+ m4/free.m4
m4/fstatat.m4
m4/fsusage.m4
m4/fsync.m4
@@ -1157,7 +1217,6 @@ AC_DEFUN([gl_FILE_LIST], [
m4/gettime.m4
m4/gettimeofday.m4
m4/gl-openssl.m4
- m4/glibc21.m4
m4/gnulib-common.m4
m4/group-member.m4
m4/ieee754-h.m4
@@ -1168,7 +1227,6 @@ AC_DEFUN([gl_FILE_LIST], [
m4/libgmp.m4
m4/limits-h.m4
m4/lstat.m4
- m4/malloca.m4
m4/manywarnings-c++.m4
m4/manywarnings.m4
m4/mbstate_t.m4
@@ -1192,6 +1250,7 @@ AC_DEFUN([gl_FILE_LIST], [
m4/pipe2.m4
m4/pselect.m4
m4/pthread_sigmask.m4
+ m4/rawmemchr.m4
m4/readlink.m4
m4/readlinkat.m4
m4/regex.m4
@@ -1203,7 +1262,6 @@ AC_DEFUN([gl_FILE_LIST], [
m4/signal_h.m4
m4/socklen.m4
m4/ssize_t.m4
- m4/st_dm_mode.m4
m4/stat-time.m4
m4/std-gnu11.m4
m4/stdalign.m4
diff --git a/m4/group-member.m4 b/m4/group-member.m4
index ad7368ceecb..7a7bb40afcb 100644
--- a/m4/group-member.m4
+++ b/m4/group-member.m4
@@ -1,6 +1,6 @@
# serial 14
-# Copyright (C) 1999-2001, 2003-2007, 2009-2020 Free Software Foundation, Inc.
+# Copyright (C) 1999-2001, 2003-2007, 2009-2021 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
diff --git a/m4/ieee754-h.m4 b/m4/ieee754-h.m4
index 8ec4583348e..68af3bd7ebe 100644
--- a/m4/ieee754-h.m4
+++ b/m4/ieee754-h.m4
@@ -1,6 +1,6 @@
# Configure ieee754-h module
-dnl Copyright 2018-2020 Free Software Foundation, Inc.
+dnl Copyright 2018-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.
diff --git a/m4/include_next.m4 b/m4/include_next.m4
index 9221d9f7d5f..bdd542bc64d 100644
--- a/m4/include_next.m4
+++ b/m4/include_next.m4
@@ -1,5 +1,5 @@
# include_next.m4 serial 26
-dnl Copyright (C) 2006-2020 Free Software Foundation, Inc.
+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,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/inttypes.m4 b/m4/inttypes.m4
index 84b1654ea26..f56e94a8881 100644
--- a/m4/inttypes.m4
+++ b/m4/inttypes.m4
@@ -1,5 +1,5 @@
# inttypes.m4 serial 32
-dnl Copyright (C) 2006-2020 Free Software Foundation, Inc.
+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,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/largefile.m4 b/m4/largefile.m4
index f4c5d3a5cea..cadb16dc972 100644
--- a/m4/largefile.m4
+++ b/m4/largefile.m4
@@ -1,7 +1,7 @@
# Enable large files on systems where this is not the default.
# Enable support for files on Linux file systems with 64-bit inode numbers.
-# Copyright 1992-1996, 1998-2020 Free Software Foundation, Inc.
+# Copyright 1992-1996, 1998-2021 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
@@ -25,7 +25,7 @@ AC_DEFUN([gl_SET_LARGEFILE_SOURCE],
# The following implementation works around a problem in autoconf <= 2.69;
# AC_SYS_LARGEFILE does not configure for large inodes on Mac OS X 10.5,
# or configures them incorrectly in some cases.
-m4_version_prereq([2.70], [] ,[
+m4_version_prereq([2.70], [], [
# _AC_SYS_LARGEFILE_TEST_INCLUDES
# -------------------------------
diff --git a/m4/lchmod.m4 b/m4/lchmod.m4
index a86a304f5f1..3d181be051e 100644
--- a/m4/lchmod.m4
+++ b/m4/lchmod.m4
@@ -1,6 +1,6 @@
#serial 8
-dnl Copyright (C) 2005-2006, 2008-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2005-2006, 2008-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.
diff --git a/m4/libgmp.m4 b/m4/libgmp.m4
index 1025f06a775..c630a19e640 100644
--- a/m4/libgmp.m4
+++ b/m4/libgmp.m4
@@ -1,6 +1,6 @@
# libgmp.m4 serial 5
# Configure the GMP library or a replacement.
-dnl Copyright 2020 Free Software Foundation, Inc.
+dnl Copyright 2020-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.
diff --git a/m4/limits-h.m4 b/m4/limits-h.m4
index 0b4f092a432..70dbb7dcfa0 100644
--- a/m4/limits-h.m4
+++ b/m4/limits-h.m4
@@ -1,6 +1,6 @@
dnl Check whether limits.h has needed features.
-dnl Copyright 2016-2020 Free Software Foundation, Inc.
+dnl Copyright 2016-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.
diff --git a/m4/lstat.m4 b/m4/lstat.m4
index 3c2b214b857..62e9db29a73 100644
--- a/m4/lstat.m4
+++ b/m4/lstat.m4
@@ -1,6 +1,6 @@
# serial 33
-# Copyright (C) 1997-2001, 2003-2020 Free Software Foundation, Inc.
+# Copyright (C) 1997-2001, 2003-2021 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
diff --git a/m4/malloca.m4 b/m4/malloca.m4
index 930199da14a..7ee33773d25 100644
--- a/m4/malloca.m4
+++ b/m4/malloca.m4
@@ -1,6 +1,6 @@
# malloca.m4 serial 2
-dnl Copyright (C) 2003-2004, 2006-2007, 2009-2020 Free Software Foundation,
-dnl Inc.
+dnl Copyright (C) 2003-2004, 2006-2007, 2009-2021 Free Software
+dnl 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.
diff --git a/m4/manywarnings.m4 b/m4/manywarnings.m4
index a37cd15b69a..53ab1534036 100644
--- a/m4/manywarnings.m4
+++ b/m4/manywarnings.m4
@@ -1,5 +1,5 @@
# manywarnings.m4 serial 21
-dnl Copyright (C) 2008-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2008-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.
diff --git a/m4/mbstate_t.m4 b/m4/mbstate_t.m4
index 057ce12ebe6..e7fe3580dbc 100644
--- a/m4/mbstate_t.m4
+++ b/m4/mbstate_t.m4
@@ -1,5 +1,5 @@
-# mbstate_t.m4 serial 13
-dnl Copyright (C) 2000-2002, 2008-2020 Free Software Foundation, Inc.
+# mbstate_t.m4 serial 14
+dnl Copyright (C) 2000-2002, 2008-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.
@@ -20,14 +20,7 @@ AC_DEFUN([AC_TYPE_MBSTATE_T],
[AC_COMPILE_IFELSE(
[AC_LANG_PROGRAM(
[AC_INCLUDES_DEFAULT[
-/* Tru64 with Desktop Toolkit C has a bug: <stdio.h> must be included before
- <wchar.h>.
- BSD/OS 4.0.1 has a bug: <stddef.h>, <stdio.h> and <time.h> must be
- included before <wchar.h>. */
-#include <stddef.h>
-#include <stdio.h>
-#include <time.h>
-#include <wchar.h>]],
+ #include <wchar.h>]],
[[mbstate_t x; return sizeof x;]])],
[ac_cv_type_mbstate_t=yes],
[ac_cv_type_mbstate_t=no])])
diff --git a/m4/md5.m4 b/m4/md5.m4
index ca213ed055f..021b352aac0 100644
--- a/m4/md5.m4
+++ b/m4/md5.m4
@@ -1,5 +1,5 @@
# md5.m4 serial 14
-dnl Copyright (C) 2002-2006, 2008-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2002-2006, 2008-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.
diff --git a/m4/memmem.m4 b/m4/memmem.m4
index 35a5bb19d1a..e2a785f48d4 100644
--- a/m4/memmem.m4
+++ b/m4/memmem.m4
@@ -1,5 +1,5 @@
# memmem.m4 serial 27
-dnl Copyright (C) 2002-2004, 2007-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2002-2004, 2007-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.
diff --git a/m4/mempcpy.m4 b/m4/mempcpy.m4
index 899f12a880a..c5ee2af8ccd 100644
--- a/m4/mempcpy.m4
+++ b/m4/mempcpy.m4
@@ -1,5 +1,5 @@
# mempcpy.m4 serial 11
-dnl Copyright (C) 2003-2004, 2006-2007, 2009-2020 Free Software Foundation,
+dnl Copyright (C) 2003-2004, 2006-2007, 2009-2021 Free Software Foundation,
dnl Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
diff --git a/m4/memrchr.m4 b/m4/memrchr.m4
index 95990ed6b76..d0c05896e54 100644
--- a/m4/memrchr.m4
+++ b/m4/memrchr.m4
@@ -1,5 +1,5 @@
# memrchr.m4 serial 10
-dnl Copyright (C) 2002-2003, 2005-2007, 2009-2020 Free Software Foundation,
+dnl Copyright (C) 2002-2003, 2005-2007, 2009-2021 Free Software Foundation,
dnl Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
diff --git a/m4/minmax.m4 b/m4/minmax.m4
index e5b28b0b8b4..e21a6879a09 100644
--- a/m4/minmax.m4
+++ b/m4/minmax.m4
@@ -1,5 +1,5 @@
# minmax.m4 serial 4
-dnl Copyright (C) 2005, 2009-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2005, 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.
diff --git a/m4/mkostemp.m4 b/m4/mkostemp.m4
index 3e5b5555582..46534d48ef5 100644
--- a/m4/mkostemp.m4
+++ b/m4/mkostemp.m4
@@ -1,5 +1,5 @@
# mkostemp.m4 serial 2
-dnl Copyright (C) 2009-2020 Free Software Foundation, Inc.
+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.
diff --git a/m4/mktime.m4 b/m4/mktime.m4
index 4e7e423fa54..245649e774a 100644
--- a/m4/mktime.m4
+++ b/m4/mktime.m4
@@ -1,5 +1,5 @@
# serial 35
-dnl Copyright (C) 2002-2003, 2005-2007, 2009-2020 Free Software Foundation,
+dnl Copyright (C) 2002-2003, 2005-2007, 2009-2021 Free Software Foundation,
dnl Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
diff --git a/m4/mode_t.m4 b/m4/mode_t.m4
index f1909517c2d..3bd4b89fee2 100644
--- a/m4/mode_t.m4
+++ b/m4/mode_t.m4
@@ -1,5 +1,5 @@
# mode_t.m4 serial 2
-dnl Copyright (C) 2009-2020 Free Software Foundation, Inc.
+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.
diff --git a/m4/multiarch.m4 b/m4/multiarch.m4
index 2c61afbd76e..f1678d9f6ee 100644
--- a/m4/multiarch.m4
+++ b/m4/multiarch.m4
@@ -1,5 +1,5 @@
# multiarch.m4 serial 9
-dnl Copyright (C) 2008-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2008-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.
diff --git a/m4/nocrash.m4 b/m4/nocrash.m4
index 637a0ea45be..27412cd2e8c 100644
--- a/m4/nocrash.m4
+++ b/m4/nocrash.m4
@@ -1,5 +1,5 @@
# nocrash.m4 serial 5
-dnl Copyright (C) 2005, 2009-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2005, 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.
diff --git a/m4/nstrftime.m4 b/m4/nstrftime.m4
index e4eb87de0b9..4674442810b 100644
--- a/m4/nstrftime.m4
+++ b/m4/nstrftime.m4
@@ -1,6 +1,6 @@
# serial 36
-# Copyright (C) 1996-1997, 1999-2007, 2009-2020 Free Software Foundation, Inc.
+# Copyright (C) 1996-1997, 1999-2007, 2009-2021 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
diff --git a/m4/off_t.m4 b/m4/off_t.m4
index 6e19af881ed..bdec43c804e 100644
--- a/m4/off_t.m4
+++ b/m4/off_t.m4
@@ -1,5 +1,5 @@
# off_t.m4 serial 1
-dnl Copyright (C) 2012-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2012-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.
diff --git a/m4/open-cloexec.m4 b/m4/open-cloexec.m4
index 11652d5f81c..542a90f42a7 100644
--- a/m4/open-cloexec.m4
+++ b/m4/open-cloexec.m4
@@ -1,6 +1,6 @@
# Test whether O_CLOEXEC is defined.
-dnl Copyright 2017-2020 Free Software Foundation, Inc.
+dnl Copyright 2017-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.
diff --git a/m4/open-slash.m4 b/m4/open-slash.m4
index 5d84f2b548a..e619039e873 100644
--- a/m4/open-slash.m4
+++ b/m4/open-slash.m4
@@ -1,5 +1,5 @@
# open-slash.m4 serial 2
-dnl Copyright (C) 2007-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2007-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.
diff --git a/m4/open.m4 b/m4/open.m4
index 552eedf8c53..c63438650df 100644
--- a/m4/open.m4
+++ b/m4/open.m4
@@ -1,5 +1,5 @@
# open.m4 serial 15
-dnl Copyright (C) 2007-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2007-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.
diff --git a/m4/pathmax.m4 b/m4/pathmax.m4
index bb4fdeba750..e67c656659b 100644
--- a/m4/pathmax.m4
+++ b/m4/pathmax.m4
@@ -1,5 +1,5 @@
# pathmax.m4 serial 11
-dnl Copyright (C) 2002-2003, 2005-2006, 2009-2020 Free Software Foundation,
+dnl Copyright (C) 2002-2003, 2005-2006, 2009-2021 Free Software Foundation,
dnl Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
diff --git a/m4/pid_t.m4 b/m4/pid_t.m4
new file mode 100644
index 00000000000..b7650a10f13
--- /dev/null
+++ b/m4/pid_t.m4
@@ -0,0 +1,38 @@
+# pid_t.m4 serial 4
+dnl Copyright (C) 2020-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.
+
+# The following implementation works around a problem in autoconf <= 2.69.
+m4_version_prereq([2.70], [], [
+
+dnl Define pid_t if the headers don't define it.
+AC_DEFUN([AC_TYPE_PID_T],
+[
+ AC_CHECK_TYPE([pid_t],
+ [],
+ [dnl On 64-bit native Windows, define it to the equivalent of 'intptr_t'
+ dnl (= 'long long' = '__int64'), because that is the return type
+ dnl of the _spawnv* functions
+ dnl <https://docs.microsoft.com/en-us/cpp/c-runtime-library/reference/spawnvp-wspawnvp>
+ dnl and the argument type of the _cwait function
+ dnl <https://docs.microsoft.com/en-us/cpp/c-runtime-library/reference/cwait>.
+ dnl Otherwise (on 32-bit Windows and on old Unix platforms), define it
+ dnl to 'int'.
+ AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM([[
+ #if defined _WIN64 && !defined __CYGWIN__
+ LLP64
+ #endif
+ ]])
+ ],
+ [gl_pid_type='int'],
+ [gl_pid_type='__int64'])
+ AC_DEFINE_UNQUOTED([pid_t], [$gl_pid_type],
+ [Define as a signed integer type capable of holding a process identifier.])
+ ],
+ [AC_INCLUDES_DEFAULT])
+])
+
+])# m4_version_prereq 2.70
diff --git a/m4/pipe2.m4 b/m4/pipe2.m4
index d36821ed1aa..43d547cb401 100644
--- a/m4/pipe2.m4
+++ b/m4/pipe2.m4
@@ -1,5 +1,5 @@
# pipe2.m4 serial 2
-dnl Copyright (C) 2009-2020 Free Software Foundation, Inc.
+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.
diff --git a/m4/pselect.m4 b/m4/pselect.m4
index 08a5823c6f9..538fe7dc122 100644
--- a/m4/pselect.m4
+++ b/m4/pselect.m4
@@ -1,5 +1,5 @@
# pselect.m4 serial 9
-dnl Copyright (C) 2011-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2011-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.
diff --git a/m4/pthread_sigmask.m4 b/m4/pthread_sigmask.m4
index 030862de015..eb4c7849655 100644
--- a/m4/pthread_sigmask.m4
+++ b/m4/pthread_sigmask.m4
@@ -1,5 +1,5 @@
# pthread_sigmask.m4 serial 19
-dnl Copyright (C) 2011-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2011-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.
diff --git a/m4/rawmemchr.m4 b/m4/rawmemchr.m4
new file mode 100644
index 00000000000..f92846543cc
--- /dev/null
+++ b/m4/rawmemchr.m4
@@ -0,0 +1,20 @@
+# rawmemchr.m4 serial 2
+dnl Copyright (C) 2003, 2007-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.
+
+AC_DEFUN([gl_FUNC_RAWMEMCHR],
+[
+ dnl Persuade glibc <string.h> to declare rawmemchr().
+ AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS])
+
+ AC_REQUIRE([gl_HEADER_STRING_H_DEFAULTS])
+ AC_CHECK_FUNCS([rawmemchr])
+ if test $ac_cv_func_rawmemchr = no; then
+ HAVE_RAWMEMCHR=0
+ fi
+])
+
+# Prerequisites of lib/strchrnul.c.
+AC_DEFUN([gl_PREREQ_RAWMEMCHR], [:])
diff --git a/m4/readlink.m4 b/m4/readlink.m4
index 9aa9e46da8c..352788c65d0 100644
--- a/m4/readlink.m4
+++ b/m4/readlink.m4
@@ -1,5 +1,5 @@
-# readlink.m4 serial 15
-dnl Copyright (C) 2003, 2007, 2009-2020 Free Software Foundation, Inc.
+# readlink.m4 serial 16
+dnl Copyright (C) 2003, 2007, 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.
@@ -23,7 +23,7 @@ AC_DEFUN([gl_FUNC_READLINK],
dnl Solaris 9 ignores trailing slash.
dnl FreeBSD 7.2 dereferences only one level of links with trailing slash.
AC_CACHE_CHECK([whether readlink handles trailing slash correctly],
- [gl_cv_func_readlink_works],
+ [gl_cv_func_readlink_trailing_slash],
[# We have readlink, so assume ln -s works.
ln -s conftest.no-such conftest.link
ln -s conftest.link conftest.lnk2
@@ -32,18 +32,22 @@ AC_DEFUN([gl_FUNC_READLINK],
[[#include <unistd.h>
]], [[char buf[20];
return readlink ("conftest.lnk2/", buf, sizeof buf) != -1;]])],
- [gl_cv_func_readlink_works=yes], [gl_cv_func_readlink_works=no],
+ [gl_cv_func_readlink_trailing_slash=yes],
+ [gl_cv_func_readlink_trailing_slash=no],
[case "$host_os" in
- # Guess yes on Linux systems.
- linux-* | linux) gl_cv_func_readlink_works="guessing yes" ;;
- # Guess yes on glibc systems.
- *-gnu* | gnu*) gl_cv_func_readlink_works="guessing yes" ;;
- # If we don't know, obey --enable-cross-guesses.
- *) gl_cv_func_readlink_works="$gl_cross_guess_normal" ;;
+ # Guess yes on Linux or glibc systems.
+ linux-* | linux | *-gnu* | gnu*)
+ gl_cv_func_readlink_trailing_slash="guessing yes" ;;
+ # Guess no on AIX or HP-UX.
+ aix* | hpux*)
+ gl_cv_func_readlink_trailing_slash="guessing no" ;;
+ # If we don't know, obey --enable-cross-guesses.
+ *)
+ gl_cv_func_readlink_trailing_slash="$gl_cross_guess_normal" ;;
esac
])
rm -f conftest.link conftest.lnk2])
- case "$gl_cv_func_readlink_works" in
+ case "$gl_cv_func_readlink_trailing_slash" in
*yes)
if test "$gl_cv_decl_readlink_works" != yes; then
REPLACE_READLINK=1
@@ -55,6 +59,43 @@ AC_DEFUN([gl_FUNC_READLINK],
REPLACE_READLINK=1
;;
esac
+
+ AC_CACHE_CHECK([whether readlink truncates results correctly],
+ [gl_cv_func_readlink_truncate],
+ [# We have readlink, so assume ln -s works.
+ ln -s ab conftest.link
+ AC_RUN_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#include <unistd.h>
+]], [[char c;
+ return readlink ("conftest.link", &c, 1) != 1;]])],
+ [gl_cv_func_readlink_truncate=yes],
+ [gl_cv_func_readlink_truncate=no],
+ [case "$host_os" in
+ # Guess yes on Linux or glibc systems.
+ linux-* | linux | *-gnu* | gnu*)
+ gl_cv_func_readlink_truncate="guessing yes" ;;
+ # Guess no on AIX or HP-UX.
+ aix* | hpux*)
+ gl_cv_func_readlink_truncate="guessing no" ;;
+ # If we don't know, obey --enable-cross-guesses.
+ *)
+ gl_cv_func_readlink_truncate="$gl_cross_guess_normal" ;;
+ esac
+ ])
+ rm -f conftest.link conftest.lnk2])
+ case $gl_cv_func_readlink_truncate in
+ *yes)
+ if test "$gl_cv_decl_readlink_works" != yes; then
+ REPLACE_READLINK=1
+ fi
+ ;;
+ *)
+ AC_DEFINE([READLINK_TRUNCATE_BUG], [1], [Define to 1 if readlink
+ sets errno instead of truncating a too-long link.])
+ REPLACE_READLINK=1
+ ;;
+ esac
fi
])
diff --git a/m4/readlinkat.m4 b/m4/readlinkat.m4
index 6ef1f590c06..1ced6721856 100644
--- a/m4/readlinkat.m4
+++ b/m4/readlinkat.m4
@@ -1,7 +1,7 @@
-# serial 5
+# serial 6
# See if we need to provide readlinkat replacement.
-dnl Copyright (C) 2009-2020 Free Software Foundation, Inc.
+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.
@@ -26,13 +26,10 @@ AC_DEFUN([gl_FUNC_READLINKAT],
ssize_t readlinkat (int, char const *, char *, size_t);]])],
[gl_cv_decl_readlinkat_works=yes],
[gl_cv_decl_readlinkat_works=no])])
- # Assume readinkat has the same trailing slash bug as readlink,
- # as is the case on Mac Os X 10.10
- case "$gl_cv_func_readlink_works" in
- *yes)
- if test "$gl_cv_decl_readlinkat_works" != yes; then
- REPLACE_READLINKAT=1
- fi
+ # Assume readlinkat has the same bugs as readlink,
+ # as is the case on OS X 10.10 with trailing slashes.
+ case $gl_cv_decl_readlinkat_works,$gl_cv_func_readlink_trailing_slash,$gl_cv_func_readlink_truncate in
+ *yes,*yes,*yes)
;;
*)
REPLACE_READLINKAT=1
diff --git a/m4/regex.m4 b/m4/regex.m4
index e723f591216..850c572228a 100644
--- a/m4/regex.m4
+++ b/m4/regex.m4
@@ -1,6 +1,6 @@
-# serial 70
+# serial 71
-# Copyright (C) 1996-2001, 2003-2020 Free Software Foundation, Inc.
+# Copyright (C) 1996-2001, 2003-2021 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
@@ -354,7 +354,6 @@ AC_DEFUN([gl_PREREQ_REGEX],
AC_REQUIRE([AC_C_RESTRICT])
AC_REQUIRE([AC_TYPE_MBSTATE_T])
AC_REQUIRE([gl_EEMALLOC])
- AC_REQUIRE([gl_GLIBC21])
AC_CHECK_HEADERS([libintl.h])
AC_CHECK_FUNCS_ONCE([isblank iswctype])
AC_CHECK_DECLS([isblank], [], [], [[#include <ctype.h>]])
diff --git a/m4/sha1.m4 b/m4/sha1.m4
index 35e3f7580ef..fdba7a6f7b1 100644
--- a/m4/sha1.m4
+++ b/m4/sha1.m4
@@ -1,5 +1,5 @@
# sha1.m4 serial 12
-dnl Copyright (C) 2002-2006, 2008-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2002-2006, 2008-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.
diff --git a/m4/sha256.m4 b/m4/sha256.m4
index 85ff1d5ba8a..f49899c84cc 100644
--- a/m4/sha256.m4
+++ b/m4/sha256.m4
@@ -1,5 +1,5 @@
# sha256.m4 serial 8
-dnl Copyright (C) 2005, 2008-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2005, 2008-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.
diff --git a/m4/sha512.m4 b/m4/sha512.m4
index fe1592a2600..b45fdf50f61 100644
--- a/m4/sha512.m4
+++ b/m4/sha512.m4
@@ -1,5 +1,5 @@
# sha512.m4 serial 9
-dnl Copyright (C) 2005-2006, 2008-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2005-2006, 2008-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.
diff --git a/m4/sig2str.m4 b/m4/sig2str.m4
index 415290c4dee..8951bbd7f0c 100644
--- a/m4/sig2str.m4
+++ b/m4/sig2str.m4
@@ -1,5 +1,5 @@
# serial 7
-dnl Copyright (C) 2002, 2005-2006, 2009-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2002, 2005-2006, 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.
diff --git a/m4/sigdescr_np.m4 b/m4/sigdescr_np.m4
index f0f3f979e83..f6fa63140c4 100644
--- a/m4/sigdescr_np.m4
+++ b/m4/sigdescr_np.m4
@@ -1,5 +1,5 @@
# sigdescr_np.m4 serial 1
-dnl Copyright (C) 2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2020-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.
diff --git a/m4/signal_h.m4 b/m4/signal_h.m4
index b2629809f18..ff9f0251fd9 100644
--- a/m4/signal_h.m4
+++ b/m4/signal_h.m4
@@ -1,5 +1,5 @@
# signal_h.m4 serial 19
-dnl Copyright (C) 2007-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2007-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.
diff --git a/m4/socklen.m4 b/m4/socklen.m4
index 251960b0ac0..eca1d1b9462 100644
--- a/m4/socklen.m4
+++ b/m4/socklen.m4
@@ -1,5 +1,5 @@
# socklen.m4 serial 11
-dnl Copyright (C) 2005-2007, 2009-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2005-2007, 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.
diff --git a/m4/ssize_t.m4 b/m4/ssize_t.m4
index 6c0a588873c..f0ed509fcc5 100644
--- a/m4/ssize_t.m4
+++ b/m4/ssize_t.m4
@@ -1,5 +1,5 @@
# ssize_t.m4 serial 5 (gettext-0.18.2)
-dnl Copyright (C) 2001-2003, 2006, 2010-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2001-2003, 2006, 2010-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.
diff --git a/m4/st_dm_mode.m4 b/m4/st_dm_mode.m4
index 5dad161c3b2..b39c3ee9976 100644
--- a/m4/st_dm_mode.m4
+++ b/m4/st_dm_mode.m4
@@ -1,6 +1,7 @@
# serial 6
-# Copyright (C) 1998-1999, 2001, 2009-2020 Free Software Foundation, Inc.
+# Copyright (C) 1998-1999, 2001, 2009-2021 Free Software Foundation,
+# Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
diff --git a/m4/stat-time.m4 b/m4/stat-time.m4
index 0ac3f7272e3..df1c2a7453a 100644
--- a/m4/stat-time.m4
+++ b/m4/stat-time.m4
@@ -1,6 +1,6 @@
# Checks for stat-related time functions.
-# Copyright (C) 1998-1999, 2001, 2003, 2005-2007, 2009-2020 Free Software
+# Copyright (C) 1998-1999, 2001, 2003, 2005-2007, 2009-2021 Free Software
# Foundation, Inc.
# This file is free software; the Free Software Foundation
diff --git a/m4/std-gnu11.m4 b/m4/std-gnu11.m4
index db833d820f3..7b1a042af1b 100644
--- a/m4/std-gnu11.m4
+++ b/m4/std-gnu11.m4
@@ -6,8 +6,10 @@
# This implementation will be obsolete once we can assume Autoconf 2.70
# or later is installed everywhere a Gnulib program might be developed.
+m4_version_prereq([2.70], [], [
-# Copyright (C) 2001-2020 Free Software Foundation, Inc.
+
+# Copyright (C) 2001-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
@@ -822,3 +824,6 @@ dnl Tru64 N/A (no support)
dnl with extended modes being tried first.
[[-std=gnu++11 -std=c++11 -std=gnu++0x -std=c++0x -qlanglvl=extended0x -AA]], [$1], [$2])[]dnl
])# _AC_PROG_CXX_CXX11
+
+
+])# m4_version_prereq
diff --git a/m4/stdalign.m4 b/m4/stdalign.m4
index dcf778e6456..8dcb634d55b 100644
--- a/m4/stdalign.m4
+++ b/m4/stdalign.m4
@@ -1,6 +1,6 @@
# Check for stdalign.h that conforms to C11.
-dnl Copyright 2011-2020 Free Software Foundation, Inc.
+dnl Copyright 2011-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.
diff --git a/m4/stddef_h.m4 b/m4/stddef_h.m4
index d8bc8ff64e4..18e872f483e 100644
--- a/m4/stddef_h.m4
+++ b/m4/stddef_h.m4
@@ -1,6 +1,6 @@
dnl A placeholder for <stddef.h>, for platforms that have issues.
# stddef_h.m4 serial 7
-dnl Copyright (C) 2009-2020 Free Software Foundation, Inc.
+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.
diff --git a/m4/stdint.m4 b/m4/stdint.m4
index d5f5d6133a9..a785b44ed17 100644
--- a/m4/stdint.m4
+++ b/m4/stdint.m4
@@ -1,5 +1,5 @@
-# stdint.m4 serial 56
-dnl Copyright (C) 2001-2020 Free Software Foundation, Inc.
+# stdint.m4 serial 58
+dnl Copyright (C) 2001-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.
@@ -34,7 +34,7 @@ AC_DEFUN_ONCE([gl_STDINT_H],
AC_SUBST([HAVE_WCHAR_H])
dnl Check for <inttypes.h>.
- dnl AC_INCLUDES_DEFAULT defines $ac_cv_header_inttypes_h.
+ AC_CHECK_HEADERS_ONCE([inttypes.h])
if test $ac_cv_header_inttypes_h = yes; then
HAVE_INTTYPES_H=1
else
@@ -43,7 +43,7 @@ AC_DEFUN_ONCE([gl_STDINT_H],
AC_SUBST([HAVE_INTTYPES_H])
dnl Check for <sys/types.h>.
- dnl AC_INCLUDES_DEFAULT defines $ac_cv_header_sys_types_h.
+ AC_CHECK_HEADERS_ONCE([sys/types.h])
if test $ac_cv_header_sys_types_h = yes; then
HAVE_SYS_TYPES_H=1
else
@@ -493,13 +493,9 @@ AC_DEFUN([gl_INTEGER_TYPE_SUFFIX],
dnl gl_STDINT_INCLUDES
AC_DEFUN([gl_STDINT_INCLUDES],
[[
- /* BSD/OS 4.0.1 has a bug: <stddef.h>, <stdio.h> and <time.h> must be
- included before <wchar.h>. */
#include <stddef.h>
#include <signal.h>
#if HAVE_WCHAR_H
- # include <stdio.h>
- # include <time.h>
# include <wchar.h>
#endif
]])
diff --git a/m4/stdio_h.m4 b/m4/stdio_h.m4
index 5f968bc26a5..4c3f24accaa 100644
--- a/m4/stdio_h.m4
+++ b/m4/stdio_h.m4
@@ -1,5 +1,5 @@
-# stdio_h.m4 serial 50
-dnl Copyright (C) 2007-2020 Free Software Foundation, Inc.
+# stdio_h.m4 serial 52
+dnl Copyright (C) 2007-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.
@@ -109,6 +109,11 @@ AC_DEFUN([gl_STDIO_H],
renameat snprintf tmpfile vdprintf vsnprintf])
AC_REQUIRE([AC_C_RESTRICT])
+
+ AC_CHECK_DECLS_ONCE([fcloseall])
+ if test $ac_cv_have_decl_fcloseall = no; then
+ HAVE_DECL_FCLOSEALL=0
+ fi
])
AC_DEFUN([gl_STDIO_MODULE_INDICATOR],
@@ -175,7 +180,15 @@ AC_DEFUN([gl_STDIO_H_DEFAULTS],
GNULIB_VPRINTF_POSIX=0; AC_SUBST([GNULIB_VPRINTF_POSIX])
GNULIB_VSNPRINTF=0; AC_SUBST([GNULIB_VSNPRINTF])
GNULIB_VSPRINTF_POSIX=0; AC_SUBST([GNULIB_VSPRINTF_POSIX])
+ dnl Support Microsoft deprecated alias function names by default.
+ GNULIB_MDA_FCLOSEALL=1; AC_SUBST([GNULIB_MDA_FCLOSEALL])
+ GNULIB_MDA_FDOPEN=1; AC_SUBST([GNULIB_MDA_FDOPEN])
+ GNULIB_MDA_FILENO=1; AC_SUBST([GNULIB_MDA_FILENO])
+ GNULIB_MDA_GETW=1; AC_SUBST([GNULIB_MDA_GETW])
+ GNULIB_MDA_PUTW=1; AC_SUBST([GNULIB_MDA_PUTW])
+ GNULIB_MDA_TEMPNAM=1; AC_SUBST([GNULIB_MDA_TEMPNAM])
dnl Assume proper GNU behavior unless another module says otherwise.
+ HAVE_DECL_FCLOSEALL=1; AC_SUBST([HAVE_DECL_FCLOSEALL])
HAVE_DECL_FPURGE=1; AC_SUBST([HAVE_DECL_FPURGE])
HAVE_DECL_FSEEKO=1; AC_SUBST([HAVE_DECL_FSEEKO])
HAVE_DECL_FTELLO=1; AC_SUBST([HAVE_DECL_FTELLO])
diff --git a/m4/stdlib_h.m4 b/m4/stdlib_h.m4
index 743066a6336..5a02972e05d 100644
--- a/m4/stdlib_h.m4
+++ b/m4/stdlib_h.m4
@@ -1,5 +1,5 @@
-# stdlib_h.m4 serial 49
-dnl Copyright (C) 2007-2020 Free Software Foundation, Inc.
+# stdlib_h.m4 serial 55
+dnl Copyright (C) 2007-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.
@@ -22,13 +22,28 @@ AC_DEFUN([gl_STDLIB_H],
#if HAVE_RANDOM_H
# include <random.h>
#endif
- ]], [_Exit atoll canonicalize_file_name getloadavg getsubopt grantpt
+ ]], [_Exit aligned_alloc atoll canonicalize_file_name free
+ getloadavg getsubopt grantpt
initstate initstate_r mbtowc mkdtemp mkostemp mkostemps mkstemp mkstemps
- posix_openpt ptsname ptsname_r qsort_r random random_r reallocarray
- realpath rpmatch secure_getenv setenv setstate setstate_r srandom
- srandom_r strtod strtold strtoll strtoull unlockpt unsetenv])
+ posix_memalign posix_openpt ptsname ptsname_r qsort_r
+ random random_r reallocarray realpath rpmatch secure_getenv setenv
+ setstate setstate_r srandom srandom_r
+ strtod strtold strtoll strtoull unlockpt unsetenv])
AC_REQUIRE([AC_C_RESTRICT])
+
+ AC_CHECK_DECLS_ONCE([ecvt])
+ if test $ac_cv_have_decl_ecvt = no; then
+ HAVE_DECL_ECVT=0
+ fi
+ AC_CHECK_DECLS_ONCE([fcvt])
+ if test $ac_cv_have_decl_fcvt = no; then
+ HAVE_DECL_FCVT=0
+ fi
+ AC_CHECK_DECLS_ONCE([gcvt])
+ if test $ac_cv_have_decl_gcvt = no; then
+ HAVE_DECL_GCVT=0
+ fi
])
AC_DEFUN([gl_STDLIB_MODULE_INDICATOR],
@@ -43,9 +58,11 @@ AC_DEFUN([gl_STDLIB_MODULE_INDICATOR],
AC_DEFUN([gl_STDLIB_H_DEFAULTS],
[
GNULIB__EXIT=0; AC_SUBST([GNULIB__EXIT])
+ GNULIB_ALIGNED_ALLOC=0; AC_SUBST([GNULIB_ALIGNED_ALLOC])
GNULIB_ATOLL=0; AC_SUBST([GNULIB_ATOLL])
GNULIB_CALLOC_POSIX=0; AC_SUBST([GNULIB_CALLOC_POSIX])
GNULIB_CANONICALIZE_FILE_NAME=0; AC_SUBST([GNULIB_CANONICALIZE_FILE_NAME])
+ GNULIB_FREE_POSIX=0; AC_SUBST([GNULIB_FREE_POSIX])
GNULIB_GETLOADAVG=0; AC_SUBST([GNULIB_GETLOADAVG])
GNULIB_GETSUBOPT=0; AC_SUBST([GNULIB_GETSUBOPT])
GNULIB_GRANTPT=0; AC_SUBST([GNULIB_GRANTPT])
@@ -56,6 +73,7 @@ AC_DEFUN([gl_STDLIB_H_DEFAULTS],
GNULIB_MKOSTEMPS=0; AC_SUBST([GNULIB_MKOSTEMPS])
GNULIB_MKSTEMP=0; AC_SUBST([GNULIB_MKSTEMP])
GNULIB_MKSTEMPS=0; AC_SUBST([GNULIB_MKSTEMPS])
+ GNULIB_POSIX_MEMALIGN=0;AC_SUBST([GNULIB_POSIX_MEMALIGN])
GNULIB_POSIX_OPENPT=0; AC_SUBST([GNULIB_POSIX_OPENPT])
GNULIB_PTSNAME=0; AC_SUBST([GNULIB_PTSNAME])
GNULIB_PTSNAME_R=0; AC_SUBST([GNULIB_PTSNAME_R])
@@ -77,10 +95,20 @@ AC_DEFUN([gl_STDLIB_H_DEFAULTS],
GNULIB_UNLOCKPT=0; AC_SUBST([GNULIB_UNLOCKPT])
GNULIB_UNSETENV=0; AC_SUBST([GNULIB_UNSETENV])
GNULIB_WCTOMB=0; AC_SUBST([GNULIB_WCTOMB])
+ dnl Support Microsoft deprecated alias function names by default.
+ GNULIB_MDA_ECVT=1; AC_SUBST([GNULIB_MDA_ECVT])
+ GNULIB_MDA_FCVT=1; AC_SUBST([GNULIB_MDA_FCVT])
+ GNULIB_MDA_GCVT=1; AC_SUBST([GNULIB_MDA_GCVT])
+ GNULIB_MDA_MKTEMP=1; AC_SUBST([GNULIB_MDA_MKTEMP])
+ GNULIB_MDA_PUTENV=1; AC_SUBST([GNULIB_MDA_PUTENV])
dnl Assume proper GNU behavior unless another module says otherwise.
HAVE__EXIT=1; AC_SUBST([HAVE__EXIT])
+ HAVE_ALIGNED_ALLOC=1; AC_SUBST([HAVE_ALIGNED_ALLOC])
HAVE_ATOLL=1; AC_SUBST([HAVE_ATOLL])
HAVE_CANONICALIZE_FILE_NAME=1; AC_SUBST([HAVE_CANONICALIZE_FILE_NAME])
+ HAVE_DECL_ECVT=1; AC_SUBST([HAVE_DECL_ECVT])
+ HAVE_DECL_FCVT=1; AC_SUBST([HAVE_DECL_FCVT])
+ HAVE_DECL_GCVT=1; AC_SUBST([HAVE_DECL_GCVT])
HAVE_DECL_GETLOADAVG=1; AC_SUBST([HAVE_DECL_GETLOADAVG])
HAVE_GETSUBOPT=1; AC_SUBST([HAVE_GETSUBOPT])
HAVE_GRANTPT=1; AC_SUBST([HAVE_GRANTPT])
@@ -92,6 +120,7 @@ AC_DEFUN([gl_STDLIB_H_DEFAULTS],
HAVE_MKOSTEMPS=1; AC_SUBST([HAVE_MKOSTEMPS])
HAVE_MKSTEMP=1; AC_SUBST([HAVE_MKSTEMP])
HAVE_MKSTEMPS=1; AC_SUBST([HAVE_MKSTEMPS])
+ HAVE_POSIX_MEMALIGN=1; AC_SUBST([HAVE_POSIX_MEMALIGN])
HAVE_POSIX_OPENPT=1; AC_SUBST([HAVE_POSIX_OPENPT])
HAVE_PTSNAME=1; AC_SUBST([HAVE_PTSNAME])
HAVE_PTSNAME_R=1; AC_SUBST([HAVE_PTSNAME_R])
@@ -115,12 +144,15 @@ AC_DEFUN([gl_STDLIB_H_DEFAULTS],
HAVE_SYS_LOADAVG_H=0; AC_SUBST([HAVE_SYS_LOADAVG_H])
HAVE_UNLOCKPT=1; AC_SUBST([HAVE_UNLOCKPT])
HAVE_DECL_UNSETENV=1; AC_SUBST([HAVE_DECL_UNSETENV])
+ REPLACE_ALIGNED_ALLOC=0; AC_SUBST([REPLACE_ALIGNED_ALLOC])
REPLACE_CALLOC=0; AC_SUBST([REPLACE_CALLOC])
REPLACE_CANONICALIZE_FILE_NAME=0; AC_SUBST([REPLACE_CANONICALIZE_FILE_NAME])
+ REPLACE_FREE=0; AC_SUBST([REPLACE_FREE])
REPLACE_INITSTATE=0; AC_SUBST([REPLACE_INITSTATE])
REPLACE_MALLOC=0; AC_SUBST([REPLACE_MALLOC])
REPLACE_MBTOWC=0; AC_SUBST([REPLACE_MBTOWC])
REPLACE_MKSTEMP=0; AC_SUBST([REPLACE_MKSTEMP])
+ REPLACE_POSIX_MEMALIGN=0; AC_SUBST([REPLACE_POSIX_MEMALIGN])
REPLACE_PTSNAME=0; AC_SUBST([REPLACE_PTSNAME])
REPLACE_PTSNAME_R=0; AC_SUBST([REPLACE_PTSNAME_R])
REPLACE_PUTENV=0; AC_SUBST([REPLACE_PUTENV])
diff --git a/m4/stpcpy.m4 b/m4/stpcpy.m4
index 0f0fa9eaaed..28db4f45dfe 100644
--- a/m4/stpcpy.m4
+++ b/m4/stpcpy.m4
@@ -1,5 +1,5 @@
# stpcpy.m4 serial 8
-dnl Copyright (C) 2002, 2007, 2009-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2002, 2007, 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.
diff --git a/m4/string_h.m4 b/m4/string_h.m4
index 29796b8629f..3e65355735c 100644
--- a/m4/string_h.m4
+++ b/m4/string_h.m4
@@ -1,11 +1,11 @@
# Configure a GNU-like replacement for <string.h>.
-# Copyright (C) 2007-2020 Free Software Foundation, Inc.
+# Copyright (C) 2007-2021 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
-# serial 27
+# serial 28
# Written by Paul Eggert.
@@ -86,6 +86,9 @@ AC_DEFUN([gl_HEADER_STRING_H_DEFAULTS],
GNULIB_STRSIGNAL=0; AC_SUBST([GNULIB_STRSIGNAL])
GNULIB_STRVERSCMP=0; AC_SUBST([GNULIB_STRVERSCMP])
HAVE_MBSLEN=0; AC_SUBST([HAVE_MBSLEN])
+ dnl Support Microsoft deprecated alias function names by default.
+ GNULIB_MDA_MEMCCPY=1; AC_SUBST([GNULIB_MDA_MEMCCPY])
+ GNULIB_MDA_STRDUP=1; AC_SUBST([GNULIB_MDA_STRDUP])
dnl Assume proper GNU behavior unless another module says otherwise.
HAVE_EXPLICIT_BZERO=1; AC_SUBST([HAVE_EXPLICIT_BZERO])
HAVE_FFSL=1; AC_SUBST([HAVE_FFSL])
diff --git a/m4/strnlen.m4 b/m4/strnlen.m4
index 71b8e1baffe..bb9a680fdc4 100644
--- a/m4/strnlen.m4
+++ b/m4/strnlen.m4
@@ -1,5 +1,5 @@
# strnlen.m4 serial 13
-dnl Copyright (C) 2002-2003, 2005-2007, 2009-2020 Free Software Foundation,
+dnl Copyright (C) 2002-2003, 2005-2007, 2009-2021 Free Software Foundation,
dnl Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
diff --git a/m4/strtoimax.m4 b/m4/strtoimax.m4
index 4958e3dcd50..d767d574510 100644
--- a/m4/strtoimax.m4
+++ b/m4/strtoimax.m4
@@ -1,5 +1,5 @@
# strtoimax.m4 serial 16
-dnl Copyright (C) 2002-2004, 2006, 2009-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2002-2004, 2006, 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.
diff --git a/m4/strtoll.m4 b/m4/strtoll.m4
index edcde3b5582..d2c9e5310d1 100644
--- a/m4/strtoll.m4
+++ b/m4/strtoll.m4
@@ -1,5 +1,5 @@
# strtoll.m4 serial 8
-dnl Copyright (C) 2002, 2004, 2006, 2008-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2002, 2004, 2006, 2008-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.
diff --git a/m4/symlink.m4 b/m4/symlink.m4
index 9cfdf93943c..209decee4c4 100644
--- a/m4/symlink.m4
+++ b/m4/symlink.m4
@@ -1,7 +1,7 @@
# serial 9
# See if we need to provide symlink replacement.
-dnl Copyright (C) 2009-2020 Free Software Foundation, Inc.
+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.
diff --git a/m4/sys_random_h.m4 b/m4/sys_random_h.m4
index 8c5d53703be..45e0469ba05 100644
--- a/m4/sys_random_h.m4
+++ b/m4/sys_random_h.m4
@@ -1,5 +1,5 @@
# sys_random_h.m4 serial 5
-dnl Copyright (C) 2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2020-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.
diff --git a/m4/sys_select_h.m4 b/m4/sys_select_h.m4
index fa19bb65f6e..4b33d312e55 100644
--- a/m4/sys_select_h.m4
+++ b/m4/sys_select_h.m4
@@ -1,5 +1,5 @@
# sys_select_h.m4 serial 20
-dnl Copyright (C) 2006-2020 Free Software Foundation, Inc.
+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,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/sys_socket_h.m4 b/m4/sys_socket_h.m4
index bf902f08108..503cb9668b7 100644
--- a/m4/sys_socket_h.m4
+++ b/m4/sys_socket_h.m4
@@ -1,5 +1,5 @@
# sys_socket_h.m4 serial 25
-dnl Copyright (C) 2005-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2005-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.
diff --git a/m4/sys_stat_h.m4 b/m4/sys_stat_h.m4
index 929144d155b..e8eac71b466 100644
--- a/m4/sys_stat_h.m4
+++ b/m4/sys_stat_h.m4
@@ -1,5 +1,5 @@
-# sys_stat_h.m4 serial 34 -*- Autoconf -*-
-dnl Copyright (C) 2006-2020 Free Software Foundation, Inc.
+# sys_stat_h.m4 serial 36 -*- 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,
dnl with or without modifications, as long as this notice is preserved.
@@ -71,6 +71,7 @@ AC_DEFUN([gl_SYS_STAT_H_DEFAULTS],
GNULIB_GETUMASK=0; AC_SUBST([GNULIB_GETUMASK])
GNULIB_LCHMOD=0; AC_SUBST([GNULIB_LCHMOD])
GNULIB_LSTAT=0; AC_SUBST([GNULIB_LSTAT])
+ GNULIB_MKDIR=0; AC_SUBST([GNULIB_MKDIR])
GNULIB_MKDIRAT=0; AC_SUBST([GNULIB_MKDIRAT])
GNULIB_MKFIFO=0; AC_SUBST([GNULIB_MKFIFO])
GNULIB_MKFIFOAT=0; AC_SUBST([GNULIB_MKFIFOAT])
@@ -79,6 +80,10 @@ AC_DEFUN([gl_SYS_STAT_H_DEFAULTS],
GNULIB_STAT=0; AC_SUBST([GNULIB_STAT])
GNULIB_UTIMENSAT=0; AC_SUBST([GNULIB_UTIMENSAT])
GNULIB_OVERRIDES_STRUCT_STAT=0; AC_SUBST([GNULIB_OVERRIDES_STRUCT_STAT])
+ dnl Support Microsoft deprecated alias function names by default.
+ GNULIB_MDA_CHMOD=1; AC_SUBST([GNULIB_MDA_CHMOD])
+ GNULIB_MDA_MKDIR=1; AC_SUBST([GNULIB_MDA_MKDIR])
+ GNULIB_MDA_UMASK=1; AC_SUBST([GNULIB_MDA_UMASK])
dnl Assume proper GNU behavior unless another module says otherwise.
HAVE_FCHMODAT=1; AC_SUBST([HAVE_FCHMODAT])
HAVE_FSTATAT=1; AC_SUBST([HAVE_FSTATAT])
diff --git a/m4/sys_time_h.m4 b/m4/sys_time_h.m4
index 8fc8599242d..64f133d5133 100644
--- a/m4/sys_time_h.m4
+++ b/m4/sys_time_h.m4
@@ -1,7 +1,7 @@
# Configure a replacement for <sys/time.h>.
# serial 9
-# Copyright (C) 2007, 2009-2020 Free Software Foundation, Inc.
+# Copyright (C) 2007, 2009-2021 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
diff --git a/m4/sys_types_h.m4 b/m4/sys_types_h.m4
index be918dc0d8b..2172c836d95 100644
--- a/m4/sys_types_h.m4
+++ b/m4/sys_types_h.m4
@@ -1,5 +1,5 @@
-# sys_types_h.m4 serial 9
-dnl Copyright (C) 2011-2020 Free Software Foundation, Inc.
+# sys_types_h.m4 serial 11
+dnl Copyright (C) 2011-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.
@@ -36,25 +36,23 @@ AC_DEFUN([gl_SYS_TYPES_H_DEFAULTS],
# This works around a buggy version in autoconf <= 2.69.
# See <https://lists.gnu.org/r/autoconf/2016-08/msg00014.html>
+# The 2.70 version isn't quoted properly, so override it too.
-m4_version_prereq([2.70], [], [
-
-# This is taken from the following Autoconf patch:
-# https://git.savannah.gnu.org/cgit/autoconf.git/commit/?id=e17a30e987d7ee695fb4294a82d987ec3dc9b974
+m4_version_prereq([2.70.1], [], [
m4_undefine([AC_HEADER_MAJOR])
AC_DEFUN([AC_HEADER_MAJOR],
[AC_CHECK_HEADERS_ONCE([sys/types.h])
AC_CHECK_HEADER([sys/mkdev.h],
- [AC_DEFINE([MAJOR_IN_MKDEV], [1],
- [Define to 1 if `major', `minor', and `makedev' are declared in
- <mkdev.h>.])])
+ [AC_DEFINE([MAJOR_IN_MKDEV], [1],
+ [Define to 1 if `major', `minor', and `makedev' are
+ declared in <mkdev.h>.])])
if test $ac_cv_header_sys_mkdev_h = no; then
AC_CHECK_HEADER([sys/sysmacros.h],
- [AC_DEFINE([MAJOR_IN_SYSMACROS], [1],
- [Define to 1 if `major', `minor', and `makedev' are declared in
- <sysmacros.h>.])])
+ [AC_DEFINE([MAJOR_IN_SYSMACROS], [1],
+ [Define to 1 if `major', `minor', and `makedev'
+ are declared in <sysmacros.h>.])])
fi
-])
+])# AC_HEADER_MAJOR
])
diff --git a/m4/tempname.m4 b/m4/tempname.m4
index da439f07b58..14c796d3eb3 100644
--- a/m4/tempname.m4
+++ b/m4/tempname.m4
@@ -1,6 +1,6 @@
#serial 5
-# Copyright (C) 2006-2007, 2009-2020 Free Software Foundation, Inc.
+# Copyright (C) 2006-2007, 2009-2021 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
diff --git a/m4/time_h.m4 b/m4/time_h.m4
index a15c09dc07b..07e6967e45b 100644
--- a/m4/time_h.m4
+++ b/m4/time_h.m4
@@ -1,8 +1,8 @@
# Configure a more-standard replacement for <time.h>.
-# Copyright (C) 2000-2001, 2003-2007, 2009-2020 Free Software Foundation, Inc.
+# Copyright (C) 2000-2001, 2003-2007, 2009-2021 Free Software Foundation, Inc.
-# serial 12
+# serial 13
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
@@ -116,6 +116,8 @@ AC_DEFUN([gl_HEADER_TIME_H_DEFAULTS],
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])
+ dnl Support Microsoft deprecated alias function names by default.
+ GNULIB_MDA_TZSET=1; AC_SUBST([GNULIB_MDA_TZSET])
dnl Assume proper GNU behavior unless another module says otherwise.
HAVE_DECL_LOCALTIME_R=1; AC_SUBST([HAVE_DECL_LOCALTIME_R])
HAVE_NANOSLEEP=1; AC_SUBST([HAVE_NANOSLEEP])
diff --git a/m4/time_r.m4 b/m4/time_r.m4
index 0e86d4496c5..713e93ac263 100644
--- a/m4/time_r.m4
+++ b/m4/time_r.m4
@@ -1,6 +1,6 @@
dnl Reentrant time functions: localtime_r, gmtime_r.
-dnl Copyright (C) 2003, 2006-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2003, 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,
dnl with or without modifications, as long as this notice is preserved.
diff --git a/m4/time_rz.m4 b/m4/time_rz.m4
index 30161c01e63..34ef0bab4b9 100644
--- a/m4/time_rz.m4
+++ b/m4/time_rz.m4
@@ -1,6 +1,6 @@
dnl Time zone functions: tzalloc, localtime_rz, etc.
-dnl Copyright (C) 2015-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2015-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.
diff --git a/m4/timegm.m4 b/m4/timegm.m4
index 67c0c3b5f1b..098c857e7f2 100644
--- a/m4/timegm.m4
+++ b/m4/timegm.m4
@@ -1,5 +1,5 @@
# timegm.m4 serial 12
-dnl Copyright (C) 2003, 2007, 2009-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2003, 2007, 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.
diff --git a/m4/timer_time.m4 b/m4/timer_time.m4
index fdb288df24b..f0e5785e9aa 100644
--- a/m4/timer_time.m4
+++ b/m4/timer_time.m4
@@ -1,5 +1,5 @@
# timer_time.m4 serial 4
-dnl Copyright (C) 2011-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2011-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.
diff --git a/m4/timespec.m4 b/m4/timespec.m4
index e71628dc318..40307d4f607 100644
--- a/m4/timespec.m4
+++ b/m4/timespec.m4
@@ -1,6 +1,6 @@
#serial 15
-# Copyright (C) 2000-2001, 2003-2007, 2009-2020 Free Software Foundation, Inc.
+# Copyright (C) 2000-2001, 2003-2007, 2009-2021 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
diff --git a/m4/tm_gmtoff.m4 b/m4/tm_gmtoff.m4
index 41517d8abfb..2743999fbc1 100644
--- a/m4/tm_gmtoff.m4
+++ b/m4/tm_gmtoff.m4
@@ -1,5 +1,5 @@
# tm_gmtoff.m4 serial 3
-dnl Copyright (C) 2002, 2009-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2002, 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.
diff --git a/m4/unistd_h.m4 b/m4/unistd_h.m4
index b4734daf603..0f26fb908d3 100644
--- a/m4/unistd_h.m4
+++ b/m4/unistd_h.m4
@@ -1,5 +1,5 @@
-# unistd_h.m4 serial 81
-dnl Copyright (C) 2006-2020 Free Software Foundation, Inc.
+# unistd_h.m4 serial 85
+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,
dnl with or without modifications, as long as this notice is preserved.
@@ -41,7 +41,9 @@ AC_DEFUN([gl_UNISTD_H],
# include <io.h>
# endif
#endif
- ]], [access chdir chown dup dup2 dup3 environ euidaccess faccessat fchdir
+ ]], [access chdir chown copy_file_range dup dup2 dup3 environ euidaccess
+ execl execle execlp execv execve execvp execvpe
+ faccessat fchdir
fchownat fdatasync fsync ftruncate getcwd getdomainname getdtablesize
getentropy getgroups gethostname getlogin getlogin_r getpagesize getpass
getusershell setusershell endusershell
@@ -50,6 +52,11 @@ AC_DEFUN([gl_UNISTD_H],
truncate ttyname_r unlink unlinkat usleep])
AC_REQUIRE([AC_C_RESTRICT])
+
+ AC_CHECK_DECLS_ONCE([execvpe])
+ if test $ac_cv_have_decl_execvpe = no; then
+ HAVE_DECL_EXECVPE=0
+ fi
])
AC_DEFUN([gl_UNISTD_MODULE_INDICATOR],
@@ -73,6 +80,13 @@ AC_DEFUN([gl_UNISTD_H_DEFAULTS],
GNULIB_DUP3=0; AC_SUBST([GNULIB_DUP3])
GNULIB_ENVIRON=0; AC_SUBST([GNULIB_ENVIRON])
GNULIB_EUIDACCESS=0; AC_SUBST([GNULIB_EUIDACCESS])
+ GNULIB_EXECL=0; AC_SUBST([GNULIB_EXECL])
+ GNULIB_EXECLE=0; AC_SUBST([GNULIB_EXECLE])
+ GNULIB_EXECLP=0; AC_SUBST([GNULIB_EXECLP])
+ GNULIB_EXECV=0; AC_SUBST([GNULIB_EXECV])
+ GNULIB_EXECVE=0; AC_SUBST([GNULIB_EXECVE])
+ GNULIB_EXECVP=0; AC_SUBST([GNULIB_EXECVP])
+ GNULIB_EXECVPE=0; AC_SUBST([GNULIB_EXECVPE])
GNULIB_FACCESSAT=0; AC_SUBST([GNULIB_FACCESSAT])
GNULIB_FCHDIR=0; AC_SUBST([GNULIB_FCHDIR])
GNULIB_FCHOWNAT=0; AC_SUBST([GNULIB_FCHOWNAT])
@@ -117,11 +131,34 @@ AC_DEFUN([gl_UNISTD_H_DEFAULTS],
GNULIB_UNLINKAT=0; AC_SUBST([GNULIB_UNLINKAT])
GNULIB_USLEEP=0; AC_SUBST([GNULIB_USLEEP])
GNULIB_WRITE=0; AC_SUBST([GNULIB_WRITE])
+ dnl Support Microsoft deprecated alias function names by default.
+ GNULIB_MDA_ACCESS=1; AC_SUBST([GNULIB_MDA_ACCESS])
+ GNULIB_MDA_CHDIR=1; AC_SUBST([GNULIB_MDA_CHDIR])
+ GNULIB_MDA_CLOSE=1; AC_SUBST([GNULIB_MDA_CLOSE])
+ GNULIB_MDA_DUP=1; AC_SUBST([GNULIB_MDA_DUP])
+ GNULIB_MDA_DUP2=1; AC_SUBST([GNULIB_MDA_DUP2])
+ GNULIB_MDA_EXECL=1; AC_SUBST([GNULIB_MDA_EXECL])
+ GNULIB_MDA_EXECLE=1; AC_SUBST([GNULIB_MDA_EXECLE])
+ GNULIB_MDA_EXECLP=1; AC_SUBST([GNULIB_MDA_EXECLP])
+ GNULIB_MDA_EXECV=1; AC_SUBST([GNULIB_MDA_EXECV])
+ GNULIB_MDA_EXECVE=1; AC_SUBST([GNULIB_MDA_EXECVE])
+ GNULIB_MDA_EXECVP=1; AC_SUBST([GNULIB_MDA_EXECVP])
+ GNULIB_MDA_EXECVPE=1; AC_SUBST([GNULIB_MDA_EXECVPE])
+ GNULIB_MDA_GETCWD=1; AC_SUBST([GNULIB_MDA_GETCWD])
+ GNULIB_MDA_GETPID=1; AC_SUBST([GNULIB_MDA_GETPID])
+ GNULIB_MDA_ISATTY=1; AC_SUBST([GNULIB_MDA_ISATTY])
+ GNULIB_MDA_LSEEK=1; AC_SUBST([GNULIB_MDA_LSEEK])
+ GNULIB_MDA_READ=1; AC_SUBST([GNULIB_MDA_READ])
+ GNULIB_MDA_RMDIR=1; AC_SUBST([GNULIB_MDA_RMDIR])
+ GNULIB_MDA_SWAB=1; AC_SUBST([GNULIB_MDA_SWAB])
+ GNULIB_MDA_UNLINK=1; AC_SUBST([GNULIB_MDA_UNLINK])
+ GNULIB_MDA_WRITE=1; AC_SUBST([GNULIB_MDA_WRITE])
dnl Assume proper GNU behavior unless another module says otherwise.
HAVE_CHOWN=1; AC_SUBST([HAVE_CHOWN])
HAVE_COPY_FILE_RANGE=1; AC_SUBST([HAVE_COPY_FILE_RANGE])
HAVE_DUP3=1; AC_SUBST([HAVE_DUP3])
HAVE_EUIDACCESS=1; AC_SUBST([HAVE_EUIDACCESS])
+ HAVE_EXECVPE=1; AC_SUBST([HAVE_EXECVPE])
HAVE_FACCESSAT=1; AC_SUBST([HAVE_FACCESSAT])
HAVE_FCHDIR=1; AC_SUBST([HAVE_FCHDIR])
HAVE_FCHOWNAT=1; AC_SUBST([HAVE_FCHOWNAT])
@@ -152,6 +189,7 @@ AC_DEFUN([gl_UNISTD_H_DEFAULTS],
HAVE_UNLINKAT=1; AC_SUBST([HAVE_UNLINKAT])
HAVE_USLEEP=1; AC_SUBST([HAVE_USLEEP])
HAVE_DECL_ENVIRON=1; AC_SUBST([HAVE_DECL_ENVIRON])
+ HAVE_DECL_EXECVPE=1; AC_SUBST([HAVE_DECL_EXECVPE])
HAVE_DECL_FCHDIR=1; AC_SUBST([HAVE_DECL_FCHDIR])
HAVE_DECL_FDATASYNC=1; AC_SUBST([HAVE_DECL_FDATASYNC])
HAVE_DECL_GETDOMAINNAME=1; AC_SUBST([HAVE_DECL_GETDOMAINNAME])
@@ -169,6 +207,13 @@ AC_DEFUN([gl_UNISTD_H_DEFAULTS],
REPLACE_CLOSE=0; AC_SUBST([REPLACE_CLOSE])
REPLACE_DUP=0; AC_SUBST([REPLACE_DUP])
REPLACE_DUP2=0; AC_SUBST([REPLACE_DUP2])
+ REPLACE_EXECL=0; AC_SUBST([REPLACE_EXECL])
+ REPLACE_EXECLE=0; AC_SUBST([REPLACE_EXECLE])
+ REPLACE_EXECLP=0; AC_SUBST([REPLACE_EXECLP])
+ REPLACE_EXECV=0; AC_SUBST([REPLACE_EXECV])
+ REPLACE_EXECVE=0; AC_SUBST([REPLACE_EXECVE])
+ REPLACE_EXECVP=0; AC_SUBST([REPLACE_EXECVP])
+ REPLACE_EXECVPE=0; AC_SUBST([REPLACE_EXECVPE])
REPLACE_FACCESSAT=0; AC_SUBST([REPLACE_FACCESSAT])
REPLACE_FCHOWNAT=0; AC_SUBST([REPLACE_FCHOWNAT])
REPLACE_FTRUNCATE=0; AC_SUBST([REPLACE_FTRUNCATE])
diff --git a/m4/unlocked-io.m4 b/m4/unlocked-io.m4
index 38658e63ac4..a2dc8a144af 100644
--- a/m4/unlocked-io.m4
+++ b/m4/unlocked-io.m4
@@ -1,6 +1,6 @@
# unlocked-io.m4 serial 15
-# Copyright (C) 1998-2006, 2009-2020 Free Software Foundation, Inc.
+# Copyright (C) 1998-2006, 2009-2021 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
diff --git a/m4/utimens.m4 b/m4/utimens.m4
index 3d31085fc6d..2ee4ef9ec95 100644
--- a/m4/utimens.m4
+++ b/m4/utimens.m4
@@ -1,4 +1,4 @@
-dnl Copyright (C) 2003-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2003-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.
diff --git a/m4/utimensat.m4 b/m4/utimensat.m4
index e9e4f26b1c1..bdabe24c568 100644
--- a/m4/utimensat.m4
+++ b/m4/utimensat.m4
@@ -1,7 +1,7 @@
# serial 7
# See if we need to provide utimensat replacement.
-dnl Copyright (C) 2009-2020 Free Software Foundation, Inc.
+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.
diff --git a/m4/utimes.m4 b/m4/utimes.m4
index 877bfd2a735..0440e78532f 100644
--- a/m4/utimes.m4
+++ b/m4/utimes.m4
@@ -1,7 +1,7 @@
# Detect some bugs in glibc's implementation of utimes.
# serial 8
-dnl Copyright (C) 2003-2005, 2009-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2003-2005, 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.
diff --git a/m4/vararrays.m4 b/m4/vararrays.m4
index 49ded2efe0d..36946acc239 100644
--- a/m4/vararrays.m4
+++ b/m4/vararrays.m4
@@ -1,17 +1,19 @@
# Check for variable-length arrays.
-# serial 5
+# serial 6
# From Paul Eggert
-# Copyright (C) 2001, 2009-2020 Free Software Foundation, Inc.
+# Copyright (C) 2001, 2009-2021 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
-# This is a copy of AC_C_VARARRAYS from a recent development version
-# of Autoconf. It replaces Autoconf's version, or for pre-2.61 autoconf
-# it defines the macro that Autoconf lacks.
+m4_version_prereq([2.70], [], [
+
+# AC_C_VARARRAYS
+# --------------
+# Check whether the C compiler supports variable-length arrays.
AC_DEFUN([AC_C_VARARRAYS],
[
AC_CACHE_CHECK([for variable-length arrays],
@@ -27,7 +29,7 @@ AC_DEFUN([AC_C_VARARRAYS],
[[/* Test for VLA support. This test is partly inspired
from examples in the C standard. Use at least two VLA
functions to detect the GCC 3.4.3 bug described in:
- https://lists.gnu.org/r/bug-gnulib/2014-08/msg00014.html
+ https://lists.gnu.org/archive/html/bug-gnulib/2014-08/msg00014.html
*/
#ifdef __STDC_NO_VLA__
syntax error;
@@ -66,3 +68,5 @@ AC_DEFUN([AC_C_VARARRAYS],
if the compiler does not already define this.])
fi
])
+
+])
diff --git a/m4/warnings.m4 b/m4/warnings.m4
index d4e4b073453..9e24d898e8f 100644
--- a/m4/warnings.m4
+++ b/m4/warnings.m4
@@ -1,5 +1,5 @@
# warnings.m4 serial 16
-dnl Copyright (C) 2008-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2008-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.
diff --git a/m4/wchar_t.m4 b/m4/wchar_t.m4
index e48d4649322..34db10e5cc0 100644
--- a/m4/wchar_t.m4
+++ b/m4/wchar_t.m4
@@ -1,5 +1,5 @@
# wchar_t.m4 serial 4 (gettext-0.18.2)
-dnl Copyright (C) 2002-2003, 2008-2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2002-2003, 2008-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.
diff --git a/m4/zzgnulib.m4 b/m4/zzgnulib.m4
index 98fa68f51a6..b9533847cb7 100644
--- a/m4/zzgnulib.m4
+++ b/m4/zzgnulib.m4
@@ -1,5 +1,5 @@
# zzgnulib.m4 serial 1
-dnl Copyright (C) 2020 Free Software Foundation, Inc.
+dnl Copyright (C) 2020-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.
diff --git a/make-dist b/make-dist
index de4f343ddd4..606fdd9e3a0 100755
--- a/make-dist
+++ b/make-dist
@@ -1,7 +1,7 @@
#!/bin/sh
### make-dist: create an Emacs distribution tar file from current srcdir
-## Copyright (C) 1995, 1997-1998, 2000-2020 Free Software Foundation,
+## Copyright (C) 1995, 1997-1998, 2000-2021 Free Software Foundation,
## Inc.
## This file is part of GNU Emacs.
@@ -190,7 +190,7 @@ if [ ! "${version}" ]; then
exit 1
fi
-echo Version number is $version
+echo Version number is "$version"
if [ $update = yes ]; then
if ! grep -q "tree holds version *${version}" README; then
@@ -257,8 +257,8 @@ if [ $check = yes ]; then
bogosities=
while read elc; do
el=`echo $elc | sed 's/c$//'`
- [ -r $el ] || continue
- [ $elc -nt $el ] || bogosities="$bogosities $elc"
+ [ -r "$el" ] || continue
+ [ "$elc" -nt "$el" ] || bogosities="$bogosities $elc"
done < $temp_elc
if [ x"${bogosities}" != x"" ]; then
@@ -271,7 +271,7 @@ if [ $check = yes ]; then
bogosities=
for file in $losers; do
- grep -q "^;.*no-byte-compile: t" $file && continue
+ grep -q "^;.*no-byte-compile: t" "$file" && continue
case $file in
site-init.el | site-load.el | site-start.el | default.el) continue ;;
esac
@@ -295,8 +295,8 @@ if [ $check = yes ]; then
info=`sed -n 's/^@setfilename //p' $texi | sed 's|.*info/||'`
[ x"${info}" != x"" ] || continue
info=info/$info
- [ -r $info ] || continue
- [ $info -nt $texi ] || bogosities="$bogosities $info"
+ [ -r "$info" ] || continue
+ [ "$info" -nt "$texi" ] || bogosities="$bogosities $info"
done < $temp_el
rm -f $temp_el
@@ -424,7 +424,7 @@ if [ $verbose = yes ] && (mkdir --verbose ${tempdir}) >/dev/null 2>&1; then
mkdir_verbose='mkdir --verbose'
else
mkdir $tempdir || exit
- mkdir_verbose=mkdir
+ mkdir_verbose="mkdir"
fi
# file_to_skip is normally empty to link every file,
@@ -467,7 +467,7 @@ while read file; do
case $file in
MANIFEST) ln $manifest $tempdir/MANIFEST || exit ;;
$file_to_skip) continue ;;
- *) ln $file $tempdir/$file || exit ;;
+ *) ln "$file" $tempdir/"$file" || exit ;;
esac
done <$manifest
@@ -476,7 +476,7 @@ if [ "${newer}" ]; then
## We remove .elc files unconditionally, on the theory that anyone picking
## up an incremental distribution already has a running Emacs to byte-compile
## them with.
- find ${tempdir} \( -name '*.elc' -o ! -newer ${newer} \) \
+ find ${tempdir} \( -name '*.elc' -o ! -newer "${newer}" \) \
-exec rm -f {} \; || exit
fi
@@ -487,12 +487,12 @@ if [ "${make_tar}" = yes ]; then
sed -e 's/^:/.:/' -e 's/::/:.:/g' -e 's/:$/:./' -e 's/:/ /g'
`
for dir in ${temppath}; do
- [ -x ${dir}/$default_gzip ] || continue
+ [ -x "${dir}"/$default_gzip ] || continue
found=1; break
done
if [ "$found" = "0" ]; then
echo "WARNING: '$default_gzip' not found, will not compress" >&2
- default_gzip=cat
+ default_gzip="cat"
fi
case "${default_gzip}" in
bzip2) gzip_extension=.bz2 ;;
@@ -518,7 +518,7 @@ if [ "${make_tar}" = yes ]; then
$default_gzip <$emacsname.tar
fi;;
esac
- ) >$emacsname.tar$gzip_extension || exit
+ ) >$emacsname.tar"$gzip_extension" || exit
fi
## Why are we deleting the staging directory if clean_up is no?
diff --git a/modules/modhelp.py b/modules/modhelp.py
index 13fd3b07652..07dfdf3f736 100755
--- a/modules/modhelp.py
+++ b/modules/modhelp.py
@@ -2,7 +2,7 @@
# Module helper script.
-# Copyright 2015-2020 Free Software Foundation, Inc.
+# Copyright 2015-2021 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
diff --git a/msdos/ChangeLog.1 b/msdos/ChangeLog.1
index 210cecd2173..ce94d415ea2 100644
--- a/msdos/ChangeLog.1
+++ b/msdos/ChangeLog.1
@@ -1550,7 +1550,7 @@
;; coding: utf-8
;; End:
- Copyright (C) 1994-1999, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1994-1999, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/msdos/INSTALL b/msdos/INSTALL
index a67c4d59754..6bb71434d46 100644
--- a/msdos/INSTALL
+++ b/msdos/INSTALL
@@ -1,6 +1,6 @@
GNU Emacs Installation Guide for the DJGPP (a.k.a. MS-DOS) port
-Copyright (C) 1992, 1994, 1996-1997, 2000-2020 Free Software Foundation,
+Copyright (C) 1992, 1994, 1996-1997, 2000-2021 Free Software Foundation,
Inc.
See the end of the file for license conditions.
diff --git a/msdos/README b/msdos/README
index d1073741c67..9feaed89459 100644
--- a/msdos/README
+++ b/msdos/README
@@ -1,4 +1,4 @@
-Copyright (C) 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 2001-2021 Free Software Foundation, Inc.
See the end of the file for license conditions.
@@ -10,7 +10,7 @@ The files emacs.ico and emacs.pif are for using the DJGPP version on
Windows 3.X. Since these are binary files, their copyright notice is
reproduced here:
-# Copyright (C) 1993, 2002-2020 Free Software Foundation, Inc.
+# Copyright (C) 1993, 2002-2021 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
#
diff --git a/msdos/autogen/Makefile.in b/msdos/autogen/Makefile.in
index 42a4656f9d5..0bdc4087522 100644
--- a/msdos/autogen/Makefile.in
+++ b/msdos/autogen/Makefile.in
@@ -1,7 +1,7 @@
# Makefile.in generated by automake 1.11.1 from Makefile.am.
# @configure_input@
-# Copyright (C) 1994-2009, 2013-2020 Free Software Foundation, Inc.
+# Copyright (C) 1994-2009, 2013-2021 Free Software Foundation, Inc.
# This Makefile.in is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
@@ -13,7 +13,7 @@
@SET_MAKE@
-# Copyright (C) 2002-2020 Free Software Foundation, Inc.
+# Copyright (C) 2002-2021 Free Software Foundation, Inc.
#
# 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
@@ -36,7 +36,7 @@
# Generated by gnulib-tool.
# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=close --avoid=dup --avoid=fchdir --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=open --avoid=openat-die --avoid=opendir --avoid=raise --avoid=save-cwd --avoid=select --avoid=sigprocmask --avoid=sys_types --avoid=threadlib --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt byteswap c-ctype c-strcase careadlinkat close-stream count-one-bits count-trailing-zeros crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr dtotimespec dup2 environ execinfo faccessat fcntl fcntl-h fdatasync fdopendir filemode fstatat fsync getloadavg getopt-gnu gettime gettimeofday intprops largefile lstat manywarnings memrchr mkostemp mktime pipe2 pselect pthread_sigmask putenv qacl readlink readlinkat sig2str socklen stat-time stdalign stdarg stdbool stdio strftime strtoimax strtoumax symlink sys_stat sys_time time timer-time timespec-add timespec-sub unsetenv utimens warnings
-# Copyright (C) 2002-2020 Free Software Foundation, Inc.
+# Copyright (C) 2002-2021 Free Software Foundation, Inc.
#
# 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
diff --git a/msdos/autogen/config.in b/msdos/autogen/config.in
index 6475d99d6f1..263cba15a28 100644
--- a/msdos/autogen/config.in
+++ b/msdos/autogen/config.in
@@ -2,7 +2,7 @@
/* GNU Emacs site configuration template file.
-Copyright (C) 1988, 1993-1994, 1999-2002, 2004-2020 Free Software
+Copyright (C) 1988, 1993-1994, 1999-2002, 2004-2021 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/msdos/depfiles.bat b/msdos/depfiles.bat
index f3c4b33d186..131f2fc04d4 100644
--- a/msdos/depfiles.bat
+++ b/msdos/depfiles.bat
@@ -1,7 +1,7 @@
@echo off
rem ----------------------------------------------------------------------
rem Auxiliary script for MSDOS, run by ../config.bat
-rem Copyright (C) 2011-2020 Free Software Foundation, Inc.
+rem Copyright (C) 2011-2021 Free Software Foundation, Inc.
rem This file is part of GNU Emacs.
diff --git a/msdos/inttypes.h b/msdos/inttypes.h
index 88ffae70a85..28633ca9ffe 100644
--- a/msdos/inttypes.h
+++ b/msdos/inttypes.h
@@ -1,6 +1,6 @@
/* Replacement inttypes.h file for building GNU Emacs on MS-DOS with DJGPP.
-Copyright (C) 2011-2020 Free Software Foundation, Inc.
+Copyright (C) 2011-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/msdos/mainmake.v2 b/msdos/mainmake.v2
index 57c44795437..f22ebea5907 100644
--- a/msdos/mainmake.v2
+++ b/msdos/mainmake.v2
@@ -1,6 +1,6 @@
# Top-level Makefile for Emacs under MS-DOS/DJGPP v2.0 or higher. -*-makefile-*-
-# Copyright (C) 1996-2020 Free Software Foundation, Inc.
+# Copyright (C) 1996-2021 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
diff --git a/msdos/sed1v2.inp b/msdos/sed1v2.inp
index 8e181224357..5d82af66d95 100644
--- a/msdos/sed1v2.inp
+++ b/msdos/sed1v2.inp
@@ -2,7 +2,7 @@
# Configuration script for src/Makefile under DJGPP v2.x
# ----------------------------------------------------------------------
#
-# Copyright (C) 1996-1997, 1999-2020 Free Software Foundation, Inc.
+# Copyright (C) 1996-1997, 1999-2021 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
#
diff --git a/msdos/sed1x.inp b/msdos/sed1x.inp
index 8d10375c90d..30c242dcb95 100644
--- a/msdos/sed1x.inp
+++ b/msdos/sed1x.inp
@@ -2,7 +2,7 @@
# Extra configuration script for src/makefile for DesqView/X
# ----------------------------------------------------------------------
#
-# Copyright (C) 1994-1997, 1999-2020 Free Software Foundation, Inc.
+# Copyright (C) 1994-1997, 1999-2021 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
#
diff --git a/msdos/sed2v2.inp b/msdos/sed2v2.inp
index e79dc4600c1..ce45a7c80e9 100644
--- a/msdos/sed2v2.inp
+++ b/msdos/sed2v2.inp
@@ -2,7 +2,7 @@
# Configuration script for src/config.h under DJGPP v2.x
# ----------------------------------------------------------------------
#
-# Copyright (C) 1993-1997, 1999-2000, 2002-2020 Free Software
+# Copyright (C) 1993-1997, 1999-2000, 2002-2021 Free Software
# Foundation, Inc.
#
# This file is part of GNU Emacs.
@@ -27,7 +27,7 @@
#ifndef MSDOS\
#define MSDOS\
#endif
-/^#undef COPYRIGHT *$/s/^.*$/#define COPYRIGHT "Copyright (C) 2020 Free Software Foundation, Inc."/
+/^#undef COPYRIGHT *$/s/^.*$/#define COPYRIGHT "Copyright (C) 2021 Free Software Foundation, Inc."/
/^#undef DIRECTORY_SEP *$/s!^.*$!#define DIRECTORY_SEP '/'!
/^#undef DOS_NT *$/s/^.*$/#define DOS_NT/
/^#undef FLOAT_CHECK_DOMAIN *$/s/^.*$/#define FLOAT_CHECK_DOMAIN/
diff --git a/msdos/sed2x.inp b/msdos/sed2x.inp
index 054cd91cd6c..00b5f07d1b5 100644
--- a/msdos/sed2x.inp
+++ b/msdos/sed2x.inp
@@ -2,7 +2,7 @@
# Extra configuration script for src/config.h for DesqView/X
# ----------------------------------------------------------------------
#
-# Copyright (C) 1994, 2001-2020 Free Software Foundation, Inc.
+# Copyright (C) 1994, 2001-2021 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
#
diff --git a/msdos/sed3v2.inp b/msdos/sed3v2.inp
index 37ad23ab755..8b9bb0679bd 100644
--- a/msdos/sed3v2.inp
+++ b/msdos/sed3v2.inp
@@ -2,7 +2,7 @@
# Configuration script for lib-src/makefile under DJGPP v2
# ----------------------------------------------------------------------
#
-# Copyright (C) 1996, 1998, 2000-2020 Free Software Foundation, Inc.
+# Copyright (C) 1996, 1998, 2000-2021 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
#
diff --git a/msdos/sed4.inp b/msdos/sed4.inp
index 6997a574966..09d3523d86a 100644
--- a/msdos/sed4.inp
+++ b/msdos/sed4.inp
@@ -2,7 +2,7 @@
# Configuration script for src/paths.h
# ----------------------------------------------------------------------
#
-# Copyright (C) 1994, 2001-2020 Free Software Foundation, Inc.
+# Copyright (C) 1994, 2001-2021 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
#
diff --git a/msdos/sed5x.inp b/msdos/sed5x.inp
index 3f593f1aa19..3639a07c3c9 100644
--- a/msdos/sed5x.inp
+++ b/msdos/sed5x.inp
@@ -2,7 +2,7 @@
# Configuration script for oldxmenu/makefile for DesqView/X
# ----------------------------------------------------------------------
#
-# Copyright (C) 1994, 2001-2020 Free Software Foundation, Inc.
+# Copyright (C) 1994, 2001-2021 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
#
diff --git a/msdos/sed6.inp b/msdos/sed6.inp
index cb2a30391bd..a0ab94599d3 100644
--- a/msdos/sed6.inp
+++ b/msdos/sed6.inp
@@ -3,7 +3,7 @@
# doc/lispintro/Makefile, and doc/misc/Makefile under DJGPP v2.x
# ---------------------------------------------------------------------------
#
-# Copyright (C) 1997, 2000-2020 Free Software Foundation, Inc.
+# Copyright (C) 1997, 2000-2021 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
#
diff --git a/msdos/sedadmin.inp b/msdos/sedadmin.inp
index ac9f38fce54..9f6dacad5dc 100644
--- a/msdos/sedadmin.inp
+++ b/msdos/sedadmin.inp
@@ -2,7 +2,7 @@
# Configuration script for admin/unidata/Makefile under DJGPP v2.x
# ----------------------------------------------------------------------
#
-# Copyright (C) 2014-2020 Free Software Foundation, Inc.
+# Copyright (C) 2014-2021 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
#
diff --git a/msdos/sedalloc.inp b/msdos/sedalloc.inp
index e2d6a56ee5d..90377dd5d8d 100644
--- a/msdos/sedalloc.inp
+++ b/msdos/sedalloc.inp
@@ -2,7 +2,7 @@
# Configuration script for SYSTEM_MALLOC/REL_ALLOC in src/config.h
# ----------------------------------------------------------------------
#
-# Copyright (C) 2008-2020 Free Software Foundation, Inc.
+# Copyright (C) 2008-2021 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
#
diff --git a/msdos/sedleim.inp b/msdos/sedleim.inp
index c4e6e7501b6..1d5ee7a6872 100644
--- a/msdos/sedleim.inp
+++ b/msdos/sedleim.inp
@@ -2,7 +2,7 @@
# Configuration script for leim/Makefile under DJGPP v2.x
# ----------------------------------------------------------------------
#
-# Copyright (C) 1999-2020 Free Software Foundation, Inc.
+# Copyright (C) 1999-2021 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
#
diff --git a/msdos/sedlibcf.inp b/msdos/sedlibcf.inp
index a071e163783..38c54e678eb 100644
--- a/msdos/sedlibcf.inp
+++ b/msdos/sedlibcf.inp
@@ -5,7 +5,7 @@
# files whose names are invalid on DOS 8+3 filesystems.
# ----------------------------------------------------------------------
#
-# Copyright (C) 2011-2020 Free Software Foundation, Inc.
+# Copyright (C) 2011-2021 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
#
diff --git a/msdos/sedlibmk.inp b/msdos/sedlibmk.inp
index 519d5baeb8c..825be849680 100644
--- a/msdos/sedlibmk.inp
+++ b/msdos/sedlibmk.inp
@@ -2,7 +2,7 @@
# Configuration script for lib/Makefile under DJGPP v2.x
# ----------------------------------------------------------------------
#
-# Copyright (C) 2011-2020 Free Software Foundation, Inc.
+# Copyright (C) 2011-2021 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
#
diff --git a/msdos/sedlisp.inp b/msdos/sedlisp.inp
index d62c0f9211e..5b3dc26ec5c 100644
--- a/msdos/sedlisp.inp
+++ b/msdos/sedlisp.inp
@@ -2,7 +2,7 @@
# Configuration script for lisp/Makefile under DJGPP v2.x
# ----------------------------------------------------------------------
#
-# Copyright (C) 2000-2020 Free Software Foundation, Inc.
+# Copyright (C) 2000-2021 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
#
diff --git a/nextstep/ChangeLog.1 b/nextstep/ChangeLog.1
index 5d866e6e274..8e7e2783ad1 100644
--- a/nextstep/ChangeLog.1
+++ b/nextstep/ChangeLog.1
@@ -312,7 +312,7 @@
;; coding: utf-8
;; End:
- Copyright (C) 2008-2020 Free Software Foundation, Inc.
+ Copyright (C) 2008-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/nextstep/INSTALL b/nextstep/INSTALL
index ac344196c8f..148be2d05c4 100644
--- a/nextstep/INSTALL
+++ b/nextstep/INSTALL
@@ -1,4 +1,4 @@
-Copyright (C) 2008-2020 Free Software Foundation, Inc.
+Copyright (C) 2008-2021 Free Software Foundation, Inc.
See the end of the file for license conditions.
diff --git a/nextstep/Makefile.in b/nextstep/Makefile.in
index 15e8bd9187b..3168fee76c0 100644
--- a/nextstep/Makefile.in
+++ b/nextstep/Makefile.in
@@ -1,6 +1,6 @@
### @configure_input@
-## Copyright (C) 2012-2020 Free Software Foundation, Inc.
+## Copyright (C) 2012-2021 Free Software Foundation, Inc.
## This file is part of GNU Emacs.
diff --git a/nextstep/README b/nextstep/README
index 3ad226bfbe5..141a5b21fe7 100644
--- a/nextstep/README
+++ b/nextstep/README
@@ -105,7 +105,7 @@ future development.
----------------------------------------------------------------------
-Copyright 2008-2020 Free Software Foundation, Inc.
+Copyright 2008-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/nextstep/templates/Info.plist.in b/nextstep/templates/Info.plist.in
index 1f074b04578..66cde9f4eeb 100644
--- a/nextstep/templates/Info.plist.in
+++ b/nextstep/templates/Info.plist.in
@@ -1,6 +1,6 @@
<?xml version="1.0" encoding="UTF-8"?>
<!--
-Copyright (C) 2008-2020 Free Software Foundation, Inc.
+Copyright (C) 2008-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/nt/ChangeLog.1 b/nt/ChangeLog.1
index 187a59c7184..247f10a7335 100644
--- a/nt/ChangeLog.1
+++ b/nt/ChangeLog.1
@@ -3548,7 +3548,7 @@
;; add-log-time-zone-rule: t
;; End:
- Copyright (C) 1995-1999, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1995-1999, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/nt/INSTALL b/nt/INSTALL
index 2fe2c8c2673..9f543151a94 100644
--- a/nt/INSTALL
+++ b/nt/INSTALL
@@ -1,7 +1,7 @@
Building and Installing Emacs on MS-Windows
using the MSYS and MinGW tools
- Copyright (C) 2013-2020 Free Software Foundation, Inc.
+ Copyright (C) 2013-2021 Free Software Foundation, Inc.
See the end of the file for license conditions.
The MSYS/MinGW build described here is supported on versions of
@@ -502,11 +502,21 @@ build will run on Windows 9X and newer systems).
Does Emacs use -lgnutls? yes
Does Emacs use -lxml2? yes
Does Emacs use -lfreetype? no
+ Does Emacs use HarfBuzz? yes
Does Emacs use -lm17n-flt? no
Does Emacs use -lotf? no
Does Emacs use -lxft? no
+ Does Emacs use -lsystemd? no
+ Does Emacs use -ljansson? yes
+ Does Emacs use the GMP library? yes
Does Emacs directly use zlib? yes
+ Does Emacs have dynamic modules support? yes
Does Emacs use toolkit scroll bars? yes
+ Does Emacs support Xwidgets? no
+ Does Emacs have threading support in lisp? yes
+ Does Emacs support the portable dumper? yes
+ Does Emacs support the legacy unexec dumping? no
+ Which dumping strategy does Emacs use? pdumper
You are almost there, hang on.
@@ -815,6 +825,14 @@ build will run on Windows 9X and newer systems).
the libjansson DLL (for 32-bit builds of Emacs) are available from
the ezwinports site and from the MSYS2 project.
+* Optional support for HarfBuzzz shaping library
+
+ Emacs supports display of complex scripts and Arabic shaping. The
+ preferred library for that is HarfBuzz; prebuilt binaries are
+ available from the ezwinports site (for 32-bit builds of Emacs) and
+ from the MSYS2 project. If HarfBuzz is not available, Emacs will
+ use the Uniscribe shaping engine that is part of MS-Windows.
+
This file is part of GNU Emacs.
diff --git a/nt/INSTALL.W64 b/nt/INSTALL.W64
index 0a0e0330a24..8f0d0c9528f 100644
--- a/nt/INSTALL.W64
+++ b/nt/INSTALL.W64
@@ -1,7 +1,7 @@
Building and Installing Emacs on 64-bit MS-Windows
using MSYS2 and MinGW-w64
- Copyright (c) 2015-2020 Free Software Foundation, Inc.
+ Copyright (c) 2015-2021 Free Software Foundation, Inc.
See the end of the file for license conditions.
This document describes how to compile a 64-bit GNU Emacs using MSYS2
@@ -55,14 +55,16 @@ packages (you can copy and paste it into the shell with Shift + Insert):
mingw-w64-x86_64-jansson \
mingw-w64-x86_64-libxml2 \
mingw-w64-x86_64-gnutls \
- mingw-w64-x86_64-zlib
+ mingw-w64-x86_64-zlib \
+ mingw-w64-x86_64-harfbuzz
The packages include the base developer tools (autoconf, grep, make, etc.),
the compiler toolchain (gcc, gdb, etc.), several image libraries, an XML
-library, the GnuTLS (transport layer security) library, and zlib for
-decompressing text. Only the first three packages are required (base-devel,
-toolchain, xpm-nox); the rest are optional. You can select only part of the
-libraries if you don't need them all.
+library, the GnuTLS (transport layer security) library, zlib for
+decompressing text, and HarfBuzz for use as the shaping engine. Only the
+first three packages are required (base-devel, toolchain, xpm-nox); the
+rest are optional. You can select only part of the libraries if you don't
+need them all.
You now have a complete build environment for Emacs.
diff --git a/nt/Makefile.in b/nt/Makefile.in
index 6bdf824ba9f..aa3a76280ef 100644
--- a/nt/Makefile.in
+++ b/nt/Makefile.in
@@ -1,6 +1,6 @@
### @configure_input@
-# Copyright (C) 2013-2020 Free Software Foundation, Inc.
+# Copyright (C) 2013-2021 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
diff --git a/nt/README b/nt/README
index bc028c8a24f..3da31d018b9 100644
--- a/nt/README
+++ b/nt/README
@@ -1,6 +1,6 @@
Emacs for Windows NT/2000 and Windows 95/98/ME
- Copyright (C) 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 2001-2021 Free Software Foundation, Inc.
See the end of the file for license conditions.
This directory contains support for compiling and running GNU Emacs on
diff --git a/nt/README.W32 b/nt/README.W32
index 9c8d20472a9..ed5673334ad 100644
--- a/nt/README.W32
+++ b/nt/README.W32
@@ -1,4 +1,4 @@
-Copyright (C) 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 2001-2021 Free Software Foundation, Inc.
See the end of the file for license conditions.
Emacs version 28.0.50 for MS-Windows
diff --git a/nt/addpm.c b/nt/addpm.c
index 19a40220203..f54a6ea9f7c 100644
--- a/nt/addpm.c
+++ b/nt/addpm.c
@@ -1,5 +1,5 @@
/* Add entries to the GNU Emacs Program Manager folder.
- Copyright (C) 1995, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1995, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/nt/cmdproxy.c b/nt/cmdproxy.c
index 51390012be7..224f68b1e85 100644
--- a/nt/cmdproxy.c
+++ b/nt/cmdproxy.c
@@ -1,5 +1,5 @@
/* Proxy shell designed for use with Emacs on Windows 95 and NT.
- Copyright (C) 1997, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
Accepts subset of Unix sh(1) command-line options, for compatibility
with elisp code written for Unix. When possible, executes external
diff --git a/nt/configure.bat b/nt/configure.bat
index 8d436690e4f..0cb1a632e2b 100755
--- a/nt/configure.bat
+++ b/nt/configure.bat
@@ -1,7 +1,7 @@
@echo off
rem ----------------------------------------------------------------------
rem This was the old configuration script for MS Windows operating systems
-rem Copyright (C) 1999-2020 Free Software Foundation, Inc.
+rem Copyright (C) 1999-2021 Free Software Foundation, Inc.
rem This file is part of GNU Emacs.
diff --git a/nt/ddeclient.c b/nt/ddeclient.c
index a1a1999f701..c577bfcfa93 100644
--- a/nt/ddeclient.c
+++ b/nt/ddeclient.c
@@ -1,5 +1,5 @@
/* Simple client interface to DDE servers.
- Copyright (C) 1998, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1998, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/nt/emacs.rc.in b/nt/emacs.rc.in
index b551e588cad..ed217887c5d 100644
--- a/nt/emacs.rc.in
+++ b/nt/emacs.rc.in
@@ -31,7 +31,7 @@ BEGIN
VALUE "FileDescription", "GNU Emacs: The extensible self-documenting text editor\0"
VALUE "FileVersion", "@comma_space_version@\0"
VALUE "InternalName", "Emacs\0"
- VALUE "LegalCopyright", "Copyright (C) 2001-2020\0"
+ VALUE "LegalCopyright", "Copyright (C) 2001-2021\0"
VALUE "OriginalFilename", "emacs.exe"
VALUE "ProductName", "Emacs\0"
VALUE "ProductVersion", "@comma_space_version@\0"
diff --git a/nt/emacsclient.rc.in b/nt/emacsclient.rc.in
index ebb117f0e6b..c061f06528e 100644
--- a/nt/emacsclient.rc.in
+++ b/nt/emacsclient.rc.in
@@ -25,7 +25,7 @@ BEGIN
VALUE "FileDescription", "GNU EmacsClient: Client for the extensible self-documenting text editor\0"
VALUE "FileVersion", "@comma_space_version@\0"
VALUE "InternalName", "EmacsClient\0"
- VALUE "LegalCopyright", "Copyright (C) 2001-2020\0"
+ VALUE "LegalCopyright", "Copyright (C) 2001-2021\0"
VALUE "OriginalFilename", "emacsclientw.exe"
VALUE "ProductName", "EmacsClient\0"
VALUE "ProductVersion", "@comma_space_version@\0"
diff --git a/nt/epaths.nt b/nt/epaths.nt
index 62e77490634..ad60f6c6fa0 100644
--- a/nt/epaths.nt
+++ b/nt/epaths.nt
@@ -12,7 +12,7 @@
the host system (e.g., i686-pc-mingw32), and @SRC@ by the root of
the Emacs source tree used to build Emacs. */
/*
-Copyright (C) 1993, 1995, 1997, 1999, 2001-2020 Free Software
+Copyright (C) 1993, 1995, 1997, 1999, 2001-2021 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/nt/gnulib-cfg.mk b/nt/gnulib-cfg.mk
index b84626d903d..5cdbde6bb5b 100644
--- a/nt/gnulib-cfg.mk
+++ b/nt/gnulib-cfg.mk
@@ -1,6 +1,6 @@
# Configurations for ../lib/gnulib.mk.
#
-# Copyright 2017-2020 Free Software Foundation, Inc.
+# Copyright 2017-2021 Free Software Foundation, Inc.
#
# 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
diff --git a/nt/icons/README b/nt/icons/README
index 9502e17437f..a8849b2eeec 100644
--- a/nt/icons/README
+++ b/nt/icons/README
@@ -2,13 +2,13 @@ COPYRIGHT AND LICENSE INFORMATION FOR IMAGE FILES
File: emacs.ico
Author: Kentaro Ohkouchi <nanasess@fsm.ne.jp>
-Copyright (C) 2008-2020 Free Software Foundation, Inc.
+Copyright (C) 2008-2021 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later
File: emacs22.ico
Author: Andrew Zhilin
-Copyright (C) 2005-2020 Free Software Foundation, Inc.
+Copyright (C) 2005-2021 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later (see COPYING)
@@ -17,7 +17,7 @@ Files: gnu2a32.ico gnu2a32t.ico gnu2b48.ico gnu2b48t.ico
gnu5w32.ico gnu5w32t.ico gnu6w48.ico gnu6w48t.ico
gnu7.ico gnu8.ico gnu9.ico
Author: Rob Davenport <rgd at bigfoot.com>
-Copyright (C) 1999, 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 1999, 2001-2021 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later (see COPYING)
<http://users.adelphia.net/~rob.davenport/gnuicons.html>
diff --git a/nt/inc/grp.h b/nt/inc/grp.h
index 342dfba7098..41511477dbf 100644
--- a/nt/inc/grp.h
+++ b/nt/inc/grp.h
@@ -1,6 +1,6 @@
/* Replacement grp.h file for building GNU Emacs on Windows.
-Copyright (C) 2003-2020 Free Software Foundation, Inc.
+Copyright (C) 2003-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/nt/inc/inttypes.h b/nt/inc/inttypes.h
index 3ac73a780e0..89c000238f8 100644
--- a/nt/inc/inttypes.h
+++ b/nt/inc/inttypes.h
@@ -1,6 +1,6 @@
/* Replacement inttypes.h file for building GNU Emacs on Windows with MSVC.
-Copyright (C) 2011-2020 Free Software Foundation, Inc.
+Copyright (C) 2011-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/nt/inc/langinfo.h b/nt/inc/langinfo.h
index 243a6a52ab7..86f4ce5bd9a 100644
--- a/nt/inc/langinfo.h
+++ b/nt/inc/langinfo.h
@@ -1,6 +1,6 @@
/* Replacement langinfo.h file for building GNU Emacs on Windows.
-Copyright (C) 2006-2020 Free Software Foundation, Inc.
+Copyright (C) 2006-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/nt/inc/ms-w32.h b/nt/inc/ms-w32.h
index 2c754f93e8f..aad51b59cfe 100644
--- a/nt/inc/ms-w32.h
+++ b/nt/inc/ms-w32.h
@@ -1,6 +1,6 @@
/* System description file for Windows NT.
-Copyright (C) 1993-1995, 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 1993-1995, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/nt/inc/nl_types.h b/nt/inc/nl_types.h
index 28ec639d075..8926f75f79d 100644
--- a/nt/inc/nl_types.h
+++ b/nt/inc/nl_types.h
@@ -1,6 +1,6 @@
/* Replacement nl_types.h file for building GNU Emacs on Windows.
-Copyright (C) 2006-2020 Free Software Foundation, Inc.
+Copyright (C) 2006-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/nt/inc/stdint.h b/nt/inc/stdint.h
index c06c97e7132..0ee3d4a9ffc 100644
--- a/nt/inc/stdint.h
+++ b/nt/inc/stdint.h
@@ -1,6 +1,6 @@
/* Replacement stdint.h file for building GNU Emacs on Windows.
-Copyright (C) 2011-2020 Free Software Foundation, Inc.
+Copyright (C) 2011-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/nt/inc/sys/resource.h b/nt/inc/sys/resource.h
index e03c2243e27..d35f89b8cdf 100644
--- a/nt/inc/sys/resource.h
+++ b/nt/inc/sys/resource.h
@@ -1,6 +1,6 @@
/* A limited emulation of sys/resource.h.
-Copyright (C) 2016-2020 Free Software Foundation, Inc.
+Copyright (C) 2016-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/nt/inc/sys/socket.h b/nt/inc/sys/socket.h
index 94ed2aa35d2..48b24628f88 100644
--- a/nt/inc/sys/socket.h
+++ b/nt/inc/sys/socket.h
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995, 2001-2020 Free Software Foundation, Inc.
+/* Copyright (C) 1995, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/nt/inc/sys/stat.h b/nt/inc/sys/stat.h
index f58d5ab6573..aa93bd4af44 100644
--- a/nt/inc/sys/stat.h
+++ b/nt/inc/sys/stat.h
@@ -1,7 +1,7 @@
/* sys/stat.h supplied with MSVCRT uses too narrow data types for
inode and user/group id, so we replace them with our own.
-Copyright (C) 2008-2020 Free Software Foundation, Inc.
+Copyright (C) 2008-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/nt/inc/sys/wait.h b/nt/inc/sys/wait.h
index 0dff5203f4e..481ad9c38b5 100644
--- a/nt/inc/sys/wait.h
+++ b/nt/inc/sys/wait.h
@@ -1,6 +1,6 @@
/* A limited emulation of sys/wait.h on Posix systems.
-Copyright (C) 2012-2020 Free Software Foundation, Inc.
+Copyright (C) 2012-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/nt/mingw-cfg.site b/nt/mingw-cfg.site
index 4a77cc20b4e..96300774871 100644
--- a/nt/mingw-cfg.site
+++ b/nt/mingw-cfg.site
@@ -83,6 +83,8 @@ ac_cv_func_readlink=yes
ac_cv_func_symlink=yes
# Avoid run-time tests of readlink and symlink, which will fail
gl_cv_func_readlink_works=yes
+gl_cv_func_readlink_trailing_slash=yes
+gl_cv_func_readlink_truncate=yes
gl_cv_func_symlink_works=yes
ac_cv_func_readlinkat=yes
ac_cv_func_faccessat=yes
@@ -156,3 +158,7 @@ gl_cv_func_copy_file_range=yes
# We don't want to build Emacs so it depends on bcrypt.dll, since then
# it will refuse to start on systems where that DLL is absent.
gl_cv_lib_assume_bcrypt=no
+# Don't build the Gnulib free.c: it is not needed, since the w32
+# implementation of 'free' doesn't touch errno, and it emits a
+# compilation warning.
+gl_cv_func_free_preserves_errno=yes
diff --git a/nt/preprep.c b/nt/preprep.c
index 21eda0ee5e7..78ed1c32381 100644
--- a/nt/preprep.c
+++ b/nt/preprep.c
@@ -1,5 +1,5 @@
/* Pre-process emacs.exe for profiling by MSVC.
- Copyright (C) 1999, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1999, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/nt/runemacs.c b/nt/runemacs.c
index 32fdc2b3074..308e856be2a 100644
--- a/nt/runemacs.c
+++ b/nt/runemacs.c
@@ -1,6 +1,6 @@
/* runemacs --- Simple program to start Emacs with its console window hidden.
-Copyright (C) 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/oldXMenu/Activate.c b/oldXMenu/Activate.c
index c919d65ee7d..91439eacc2f 100644
--- a/oldXMenu/Activate.c
+++ b/oldXMenu/Activate.c
@@ -3,7 +3,7 @@
#include "copyright.h"
/*
-Copyright (C) 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 2001-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
diff --git a/oldXMenu/ChangeLog.1 b/oldXMenu/ChangeLog.1
index bae205ae623..c237774a3f2 100644
--- a/oldXMenu/ChangeLog.1
+++ b/oldXMenu/ChangeLog.1
@@ -712,7 +712,7 @@
;; coding: utf-8
;; End:
- Copyright (C) 1993-1999, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1993-1999, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/oldXMenu/Create.c b/oldXMenu/Create.c
index 3d1a3bfc0e4..7eb17c508d5 100644
--- a/oldXMenu/Create.c
+++ b/oldXMenu/Create.c
@@ -3,7 +3,7 @@
#include "copyright.h"
/*
-Copyright (C) 1993-1994, 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 1993-1994, 2001-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
diff --git a/oldXMenu/FindSel.c b/oldXMenu/FindSel.c
index 58c27c5881a..e2a5dbbdcd4 100644
--- a/oldXMenu/FindSel.c
+++ b/oldXMenu/FindSel.c
@@ -3,7 +3,7 @@
#include "copyright.h"
/*
-Copyright (C) 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 2001-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
diff --git a/oldXMenu/Internal.c b/oldXMenu/Internal.c
index c81db9838f9..f489e27beab 100644
--- a/oldXMenu/Internal.c
+++ b/oldXMenu/Internal.c
@@ -3,7 +3,7 @@
#include "copyright.h"
/*
-Copyright (C) 1993, 1996, 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 1993, 1996, 2001-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
diff --git a/oldXMenu/Makefile.in b/oldXMenu/Makefile.in
index 9c814fd2219..7ae355b568d 100644
--- a/oldXMenu/Makefile.in
+++ b/oldXMenu/Makefile.in
@@ -15,7 +15,7 @@
## without express or implied warranty.
-## Copyright (C) 2001-2020 Free Software Foundation, Inc.
+## Copyright (C) 2001-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
diff --git a/oldXMenu/deps.mk b/oldXMenu/deps.mk
index 9744c4818f1..f1876bf7695 100644
--- a/oldXMenu/deps.mk
+++ b/oldXMenu/deps.mk
@@ -15,7 +15,7 @@
## without express or implied warranty.
-## Copyright (C) 2001-2020 Free Software Foundation, Inc.
+## Copyright (C) 2001-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
diff --git a/oldXMenu/insque.c b/oldXMenu/insque.c
index 72a0cc8c0c5..c09d1292aa6 100644
--- a/oldXMenu/insque.c
+++ b/oldXMenu/insque.c
@@ -1,5 +1,5 @@
/*
-Copyright (C) 1993-1998, 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 1993-1998, 2001-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
diff --git a/src/.gdbinit b/src/.gdbinit
index 78536fc01fb..f74e295f7ea 100644
--- a/src/.gdbinit
+++ b/src/.gdbinit
@@ -1,4 +1,4 @@
-# Copyright (C) 1992-1998, 2000-2020 Free Software Foundation, Inc.
+# Copyright (C) 1992-1998, 2000-2021 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
#
diff --git a/src/ChangeLog.1 b/src/ChangeLog.1
index 4ca7f90e7f7..3429aa4947b 100644
--- a/src/ChangeLog.1
+++ b/src/ChangeLog.1
@@ -3521,7 +3521,7 @@
* minibuf.c: Don't allow entry to minibuffer
while minibuffer is selected.
- Copyright (C) 1985-1986, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1985-1986, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/ChangeLog.10 b/src/ChangeLog.10
index fbbd3608909..bba161d3428 100644
--- a/src/ChangeLog.10
+++ b/src/ChangeLog.10
@@ -27912,7 +27912,7 @@ See ChangeLog.9 for earlier changes.
;; add-log-time-zone-rule: t
;; End:
- Copyright (C) 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/ChangeLog.11 b/src/ChangeLog.11
index cf9e87a6a80..41c35babda0 100644
--- a/src/ChangeLog.11
+++ b/src/ChangeLog.11
@@ -31385,7 +31385,7 @@ See ChangeLog.10 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 2007-2020 Free Software Foundation, Inc.
+ Copyright (C) 2007-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/ChangeLog.12 b/src/ChangeLog.12
index 04983fe03e6..77540ee5b11 100644
--- a/src/ChangeLog.12
+++ b/src/ChangeLog.12
@@ -22936,7 +22936,7 @@ See ChangeLog.11 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 2011-2020 Free Software Foundation, Inc.
+ Copyright (C) 2011-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/ChangeLog.13 b/src/ChangeLog.13
index 87055d70315..3fb23ceff3d 100644
--- a/src/ChangeLog.13
+++ b/src/ChangeLog.13
@@ -17905,7 +17905,7 @@ See ChangeLog.12 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 2011-2020 Free Software Foundation, Inc.
+ Copyright (C) 2011-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/ChangeLog.2 b/src/ChangeLog.2
index a499350253e..44c575c564e 100644
--- a/src/ChangeLog.2
+++ b/src/ChangeLog.2
@@ -4771,7 +4771,7 @@
See ChangeLog.1 for earlier changes.
- Copyright (C) 1986-1988, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1986-1988, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/ChangeLog.3 b/src/ChangeLog.3
index 4e403058837..1cae9bfc655 100644
--- a/src/ChangeLog.3
+++ b/src/ChangeLog.3
@@ -16503,7 +16503,7 @@ See ChangeLog.2 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 1993, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1993, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/ChangeLog.4 b/src/ChangeLog.4
index cc8d22ceeb1..f34e4cb0f5e 100644
--- a/src/ChangeLog.4
+++ b/src/ChangeLog.4
@@ -6906,7 +6906,7 @@ See ChangeLog.3 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 1993-1994, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1993-1994, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/ChangeLog.5 b/src/ChangeLog.5
index 56bfb9f9eff..af0f6b9c388 100644
--- a/src/ChangeLog.5
+++ b/src/ChangeLog.5
@@ -7148,7 +7148,7 @@ See ChangeLog.4 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 1994-1995, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1994-1995, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/ChangeLog.6 b/src/ChangeLog.6
index 391d5fb8a52..709148569ed 100644
--- a/src/ChangeLog.6
+++ b/src/ChangeLog.6
@@ -5358,7 +5358,7 @@ See ChangeLog.5 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 1995-1996, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1995-1996, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/ChangeLog.7 b/src/ChangeLog.7
index bb3e1997ec7..7e9a085e505 100644
--- a/src/ChangeLog.7
+++ b/src/ChangeLog.7
@@ -11091,7 +11091,7 @@ See ChangeLog.6 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 1997-1998, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1997-1998, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/ChangeLog.8 b/src/ChangeLog.8
index c7b99a443d5..8587a14f2ce 100644
--- a/src/ChangeLog.8
+++ b/src/ChangeLog.8
@@ -13979,7 +13979,7 @@
See ChangeLog.7 for earlier changes.
- Copyright (C) 1999, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1999, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/ChangeLog.9 b/src/ChangeLog.9
index 0c1f72a6787..25a17e74fe7 100644
--- a/src/ChangeLog.9
+++ b/src/ChangeLog.9
@@ -13294,7 +13294,7 @@ See ChangeLog.8 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/Makefile.in b/src/Makefile.in
index c5fb2ea3ab2..4100edf4712 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -1,6 +1,6 @@
### @configure_input@
-# Copyright (C) 1985, 1987-1988, 1993-1995, 1999-2020 Free Software
+# Copyright (C) 1985, 1987-1988, 1993-1995, 1999-2021 Free Software
# Foundation, Inc.
# This file is part of GNU Emacs.
@@ -336,6 +336,10 @@ DUMPING=@DUMPING@
CHECK_STRUCTS = @CHECK_STRUCTS@
HAVE_PDUMPER = @HAVE_PDUMPER@
+## ARM Macs require that all code have a valid signature. Since pump
+## invalidates the signature, we must re-sign to fix it.
+DO_CODESIGN=$(patsubst aarch64-apple-darwin%,yes,@configuration@)
+
# 'make' verbosity.
AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
@@ -653,6 +657,9 @@ temacs$(EXEEXT): $(LIBXMENU) $(ALLOBJS) $(LIBEGNU_ARCHIVE) $(EMACSRES) \
$(ALLOBJS) $(LIBEGNU_ARCHIVE) $(W32_RES_LINK) $(LIBES)
ifeq ($(HAVE_PDUMPER),yes)
$(AM_V_at)$(MAKE_PDUMPER_FINGERPRINT) $@.tmp
+ifeq ($(DO_CODESIGN),yes)
+ codesign -s - -f $@.tmp
+endif
endif
$(AM_V_at)mv $@.tmp $@
$(MKDIR_P) $(etc)
diff --git a/src/README b/src/README
index fbebf6b95f5..1f42449eddc 100644
--- a/src/README
+++ b/src/README
@@ -1,4 +1,4 @@
-Copyright (C) 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 2001-2021 Free Software Foundation, Inc.
See the end of the file for license conditions.
diff --git a/src/alloc.c b/src/alloc.c
index f90d09265d0..c0a55e61b97 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -1,6 +1,6 @@
/* Storage allocation and gc for GNU Emacs Lisp interpreter.
-Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2020 Free Software
+Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2021 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
@@ -664,7 +664,7 @@ display_malloc_warning (void)
call3 (intern ("display-warning"),
intern ("alloc"),
build_string (pending_malloc_warning),
- intern ("emergency"));
+ intern (":emergency"));
pending_malloc_warning = 0;
}
@@ -732,7 +732,11 @@ static void
malloc_unblock_input (void)
{
if (block_input_in_memory_allocators)
- unblock_input ();
+ {
+ int err = errno;
+ unblock_input ();
+ errno = err;
+ }
}
# define MALLOC_BLOCK_INPUT malloc_block_input ()
# define MALLOC_UNBLOCK_INPUT malloc_unblock_input ()
@@ -6061,10 +6065,6 @@ garbage_collect (void)
mark_fringe_data ();
#endif
-#ifdef HAVE_MODULES
- mark_modules ();
-#endif
-
/* Everything is now marked, except for the data in font caches,
undo lists, and finalizers. The first two are compacted by
removing an items which aren't reachable otherwise. */
@@ -6158,10 +6158,17 @@ where each entry has the form (NAME SIZE USED FREE), where:
- FREE is the number of those objects that are not live but that Emacs
keeps around for future allocations (maybe because it does not know how
to return them to the OS).
+
However, if there was overflow in pure space, and Emacs was dumped
using the 'unexec' method, `garbage-collect' returns nil, because
real GC can't be done.
-See Info node `(elisp)Garbage Collection'. */)
+
+Note that calling this function does not guarantee that absolutely all
+unreachable objects will be garbage-collected. Emacs uses a
+mark-and-sweep garbage collector, but is conservative when it comes to
+collecting objects in some circumstances.
+
+For further details, see Info node `(elisp)Garbage Collection'. */)
(void)
{
if (garbage_collection_inhibited)
@@ -6206,6 +6213,30 @@ See Info node `(elisp)Garbage Collection'. */)
return CALLMANY (Flist, total);
}
+DEFUN ("garbage-collect-maybe", Fgarbage_collect_maybe,
+Sgarbage_collect_maybe, 1, 1, "",
+ doc: /* Call `garbage-collect' if enough allocation happened.
+FACTOR determines what "enough" means here:
+If FACTOR is a positive number N, it means to run GC if more than
+1/Nth of the allocations needed to trigger automatic allocation took
+place.
+Therefore, as N gets higher, this is more likely to perform a GC.
+Returns non-nil if GC happened, and nil otherwise. */)
+ (Lisp_Object factor)
+{
+ CHECK_FIXNAT (factor);
+ EMACS_INT fact = XFIXNAT (factor);
+
+ EMACS_INT since_gc = gc_threshold - consing_until_gc;
+ if (fact >= 1 && since_gc > gc_threshold / fact)
+ {
+ garbage_collect ();
+ return Qt;
+ }
+ else
+ return Qnil;
+}
+
/* Mark Lisp objects in glyph matrix MATRIX. Currently the
only interesting objects referenced from glyphs are strings. */
@@ -7194,6 +7225,20 @@ Frames, windows, buffers, and subprocesses count as vectors
make_int (strings_consed));
}
+#ifdef GNU_LINUX
+DEFUN ("malloc-info", Fmalloc_info, Smalloc_info, 0, 0, "",
+ doc: /* Report malloc information to stderr.
+This function outputs to stderr an XML-formatted
+description of the current state of the memory-allocation
+arenas. */)
+ (void)
+{
+ if (malloc_info (0, stderr))
+ error ("malloc_info failed: %s", emacs_strerror (errno));
+ return Qnil;
+}
+#endif
+
static bool
symbol_uses_obj (Lisp_Object symbol, Lisp_Object obj)
{
@@ -7536,8 +7581,12 @@ N should be nonnegative. */);
defsubr (&Smake_finalizer);
defsubr (&Spurecopy);
defsubr (&Sgarbage_collect);
+ defsubr (&Sgarbage_collect_maybe);
defsubr (&Smemory_info);
defsubr (&Smemory_use_counts);
+#ifdef GNU_LINUX
+ defsubr (&Smalloc_info);
+#endif
defsubr (&Ssuspicious_object);
Lisp_Object watcher;
diff --git a/src/atimer.c b/src/atimer.c
index a7daf9dcf5b..9b198675ab4 100644
--- a/src/atimer.c
+++ b/src/atimer.c
@@ -1,5 +1,5 @@
/* Asynchronous timers.
- Copyright (C) 2000-2020 Free Software Foundation, Inc.
+ Copyright (C) 2000-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/atimer.h b/src/atimer.h
index 660d77c9392..e3e283a75c0 100644
--- a/src/atimer.h
+++ b/src/atimer.h
@@ -1,5 +1,5 @@
/* Asynchronous timers.
- Copyright (C) 2000-2020 Free Software Foundation, Inc.
+ Copyright (C) 2000-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/bidi.c b/src/bidi.c
index 225b27b18cd..1413ba6b888 100644
--- a/src/bidi.c
+++ b/src/bidi.c
@@ -1,6 +1,6 @@
/* Low-level bidirectional buffer/string-scanning functions for GNU Emacs.
-Copyright (C) 2000-2001, 2004-2005, 2009-2020 Free Software Foundation,
+Copyright (C) 2000-2001, 2004-2005, 2009-2021 Free Software Foundation,
Inc.
Author: Eli Zaretskii <eliz@gnu.org>
@@ -1460,6 +1460,11 @@ bidi_at_paragraph_end (ptrdiff_t charpos, ptrdiff_t bytepos)
else
start_re = paragraph_start_re;
+ /* Prevent quitting inside re_match_2, as redisplay_window could
+ have temporarily moved point. */
+ ptrdiff_t count = SPECPDL_INDEX ();
+ specbind (Qinhibit_quit, Qt);
+
val = fast_looking_at (sep_re, charpos, bytepos, ZV, ZV_BYTE, Qnil);
if (val < 0)
{
@@ -1469,6 +1474,7 @@ bidi_at_paragraph_end (ptrdiff_t charpos, ptrdiff_t bytepos)
val = -2;
}
+ unbind_to (count, Qnil);
return val;
}
@@ -1544,6 +1550,11 @@ bidi_find_paragraph_start (ptrdiff_t pos, ptrdiff_t pos_byte)
if (cache_buffer->base_buffer)
cache_buffer = cache_buffer->base_buffer;
+ /* Prevent quitting inside re_match_2, as redisplay_window could
+ have temporarily moved point. */
+ ptrdiff_t count = SPECPDL_INDEX ();
+ specbind (Qinhibit_quit, Qt);
+
while (pos_byte > BEGV_BYTE
&& n++ < MAX_PARAGRAPH_SEARCH
&& fast_looking_at (re, pos, pos_byte, limit, limit_byte, Qnil) < 0)
@@ -1561,6 +1572,7 @@ bidi_find_paragraph_start (ptrdiff_t pos, ptrdiff_t pos_byte)
else
pos = find_newline_no_quit (pos, pos_byte, -1, &pos_byte);
}
+ unbind_to (count, Qnil);
if (n >= MAX_PARAGRAPH_SEARCH)
pos = BEGV, pos_byte = BEGV_BYTE;
if (bpc)
diff --git a/src/bignum.c b/src/bignum.c
index dce5908a1e4..1ac75c19e24 100644
--- a/src/bignum.c
+++ b/src/bignum.c
@@ -1,6 +1,6 @@
/* Big numbers for Emacs.
-Copyright 2018-2020 Free Software Foundation, Inc.
+Copyright 2018-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/bignum.h b/src/bignum.h
index 251a19e338a..33a540e9093 100644
--- a/src/bignum.h
+++ b/src/bignum.h
@@ -1,6 +1,6 @@
/* Big numbers for Emacs.
-Copyright 2018-2020 Free Software Foundation, Inc.
+Copyright 2018-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/blockinput.h b/src/blockinput.h
index f94e62dd461..8e4657b27c7 100644
--- a/src/blockinput.h
+++ b/src/blockinput.h
@@ -1,5 +1,5 @@
/* blockinput.h - interface to blocking complicated interrupt-driven input.
- Copyright (C) 1989, 1993, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1989, 1993, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/buffer.c b/src/buffer.c
index 241f2d43a93..80c799e719b 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -1,6 +1,6 @@
/* Buffer manipulation primitives for GNU Emacs.
-Copyright (C) 1985-1989, 1993-1995, 1997-2020 Free Software Foundation,
+Copyright (C) 1985-1989, 1993-1995, 1997-2021 Free Software Foundation,
Inc.
This file is part of GNU Emacs.
@@ -37,7 +37,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "window.h"
#include "commands.h"
#include "character.h"
-#include "coding.h"
#include "buffer.h"
#include "region-cache.h"
#include "indent.h"
@@ -62,8 +61,9 @@ struct buffer buffer_defaults;
/* This structure marks which slots in a buffer have corresponding
default values in buffer_defaults.
- Each such slot has a nonzero value in this structure.
- The value has only one nonzero bit.
+ Each such slot has a value in this structure.
+ The value is a positive Lisp integer that must be smaller than
+ MAX_PER_BUFFER_VARS.
When a buffer has its own local value for a slot,
the entry for that slot (found in the same slot in this structure)
@@ -297,11 +297,6 @@ bset_mark (struct buffer *b, Lisp_Object val)
b->mark_ = val;
}
static void
-bset_minor_modes (struct buffer *b, Lisp_Object val)
-{
- b->minor_modes_ = val;
-}
-static void
bset_mode_line_format (struct buffer *b, Lisp_Object val)
{
b->mode_line_format_ = val;
@@ -518,16 +513,33 @@ get_truename_buffer (register Lisp_Object filename)
return Qnil;
}
-DEFUN ("get-buffer-create", Fget_buffer_create, Sget_buffer_create, 1, 1, 0,
+/* Run buffer-list-update-hook if Vrun_hooks is non-nil, and BUF is NULL
+ or does not have buffer hooks inhibited. BUF is NULL when called by
+ make-indirect-buffer, since it does not inhibit buffer hooks. */
+
+static void
+run_buffer_list_update_hook (struct buffer *buf)
+{
+ if (! (NILP (Vrun_hooks) || (buf && buf->inhibit_buffer_hooks)))
+ call1 (Vrun_hooks, Qbuffer_list_update_hook);
+}
+
+DEFUN ("get-buffer-create", Fget_buffer_create, Sget_buffer_create, 1, 2, 0,
doc: /* Return the buffer specified by BUFFER-OR-NAME, creating a new one if needed.
If BUFFER-OR-NAME is a string and a live buffer with that name exists,
return that buffer. If no such buffer exists, create a new buffer with
-that name and return it. If BUFFER-OR-NAME starts with a space, the new
-buffer does not keep undo information.
+that name and return it.
+
+If BUFFER-OR-NAME starts with a space, the new buffer does not keep undo
+information. If optional argument INHIBIT-BUFFER-HOOKS is non-nil, the
+new buffer does not run the hooks `kill-buffer-hook',
+`kill-buffer-query-functions', and `buffer-list-update-hook'. This
+avoids slowing down internal or temporary buffers that are never
+presented to users or passed on to other applications.
If BUFFER-OR-NAME is a buffer instead of a string, return it as given,
even if it is dead. The return value is never nil. */)
- (register Lisp_Object buffer_or_name)
+ (register Lisp_Object buffer_or_name, Lisp_Object inhibit_buffer_hooks)
{
register Lisp_Object buffer, name;
register struct buffer *b;
@@ -602,11 +614,7 @@ even if it is dead. The return value is never nil. */)
set_string_intervals (name, NULL);
bset_name (b, name);
- b->inhibit_buffer_hooks
- = (STRINGP (Vcode_conversion_workbuf_name)
- && strncmp (SSDATA (name), SSDATA (Vcode_conversion_workbuf_name),
- SBYTES (Vcode_conversion_workbuf_name)) == 0);
-
+ b->inhibit_buffer_hooks = !NILP (inhibit_buffer_hooks);
bset_undo_list (b, SREF (name, 0) != ' ' ? Qnil : Qt);
reset_buffer (b);
@@ -618,9 +626,8 @@ even if it is dead. The return value is never nil. */)
/* Put this in the alist of all live buffers. */
XSETBUFFER (buffer, b);
Vbuffer_alist = nconc2 (Vbuffer_alist, list1 (Fcons (name, buffer)));
- /* And run buffer-list-update-hook. */
- if (!NILP (Vrun_hooks) && !b->inhibit_buffer_hooks)
- call1 (Vrun_hooks, Qbuffer_list_update_hook);
+
+ run_buffer_list_update_hook (b);
return buffer;
}
@@ -894,9 +901,7 @@ CLONE nil means the indirect buffer's state is reset to default values. */)
set_buffer_internal_1 (old_b);
}
- /* Run buffer-list-update-hook. */
- if (!NILP (Vrun_hooks))
- call1 (Vrun_hooks, Qbuffer_list_update_hook);
+ run_buffer_list_update_hook (NULL);
return buf;
}
@@ -1004,7 +1009,6 @@ reset_buffer_local_variables (struct buffer *b, bool permanent_too)
bset_major_mode (b, Qfundamental_mode);
bset_keymap (b, Qnil);
bset_mode_name (b, QSFundamental);
- bset_minor_modes (b, Qnil);
/* If the standard case table has been altered and invalidated,
fix up its insides first. */
@@ -1541,9 +1545,7 @@ This does not change the name of the visited file (if any). */)
&& !NILP (BVAR (current_buffer, auto_save_file_name)))
call0 (intern ("rename-auto-save-file"));
- /* Run buffer-list-update-hook. */
- if (!NILP (Vrun_hooks) && !current_buffer->inhibit_buffer_hooks)
- call1 (Vrun_hooks, Qbuffer_list_update_hook);
+ run_buffer_list_update_hook (current_buffer);
/* Refetch since that last call may have done GC. */
return BVAR (current_buffer, name);
@@ -1617,7 +1619,7 @@ exists, return the buffer `*scratch*' (creating it if necessary). */)
buf = Fget_buffer (scratch);
if (NILP (buf))
{
- buf = Fget_buffer_create (scratch);
+ buf = Fget_buffer_create (scratch, Qnil);
Fset_buffer_major_mode (buf);
}
return buf;
@@ -1641,7 +1643,7 @@ other_buffer_safely (Lisp_Object buffer)
buf = Fget_buffer (scratch);
if (NILP (buf))
{
- buf = Fget_buffer_create (scratch);
+ buf = Fget_buffer_create (scratch, Qnil);
Fset_buffer_major_mode (buf);
}
@@ -1718,7 +1720,9 @@ buffer to be killed as the current buffer. If any of them returns nil,
the buffer is not killed. The hook `kill-buffer-hook' is run before the
buffer is actually killed. The buffer being killed will be current
while the hook is running. Functions called by any of these hooks are
-supposed to not change the current buffer.
+supposed to not change the current buffer. Neither hook is run for
+internal or temporary buffers created by `get-buffer-create' or
+`generate-new-buffer' with argument INHIBIT-BUFFER-HOOKS non-nil.
Any processes that have this buffer as the `process-buffer' are killed
with SIGHUP. This function calls `replace-buffer-in-windows' for
@@ -1978,9 +1982,7 @@ cleaning up all windows currently displaying the buffer to be killed. */)
bset_width_table (b, Qnil);
unblock_input ();
- /* Run buffer-list-update-hook. */
- if (!NILP (Vrun_hooks) && !b->inhibit_buffer_hooks)
- call1 (Vrun_hooks, Qbuffer_list_update_hook);
+ run_buffer_list_update_hook (b);
return Qt;
}
@@ -2020,9 +2022,7 @@ record_buffer (Lisp_Object buffer)
fset_buffer_list (f, Fcons (buffer, Fdelq (buffer, f->buffer_list)));
fset_buried_buffer_list (f, Fdelq (buffer, f->buried_buffer_list));
- /* Run buffer-list-update-hook. */
- if (!NILP (Vrun_hooks) && !XBUFFER (buffer)->inhibit_buffer_hooks)
- call1 (Vrun_hooks, Qbuffer_list_update_hook);
+ run_buffer_list_update_hook (XBUFFER (buffer));
}
@@ -2059,9 +2059,7 @@ DEFUN ("bury-buffer-internal", Fbury_buffer_internal, Sbury_buffer_internal,
fset_buried_buffer_list
(f, Fcons (buffer, Fdelq (buffer, f->buried_buffer_list)));
- /* Run buffer-list-update-hook. */
- if (!NILP (Vrun_hooks) && !XBUFFER (buffer)->inhibit_buffer_hooks)
- call1 (Vrun_hooks, Qbuffer_list_update_hook);
+ run_buffer_list_update_hook (XBUFFER (buffer));
return Qnil;
}
@@ -2604,8 +2602,6 @@ current buffer is cleared. */)
p += bytes, pos += bytes;
}
}
- if (narrowed)
- Fnarrow_to_region (make_fixnum (begv), make_fixnum (zv));
}
else
{
@@ -2684,9 +2680,6 @@ current buffer is cleared. */)
if (pt != PT)
TEMP_SET_PT (pt);
- if (narrowed)
- Fnarrow_to_region (make_fixnum (begv), make_fixnum (zv));
-
/* Do this first, so that chars_in_text asks the right question.
set_intervals_multibyte needs it too. */
bset_enable_multibyte_characters (current_buffer, Qt);
@@ -2819,7 +2812,7 @@ the normal hook `change-major-mode-hook'. */)
/* Force mode-line redisplay. Useful here because all major mode
commands call this function. */
- update_mode_lines = 12;
+ bset_update_mode_line (current_buffer);
return Qnil;
}
@@ -4792,7 +4785,7 @@ mmap_init (void)
if (mmap_fd <= 0)
{
/* No anonymous mmap -- we need the file descriptor. */
- mmap_fd = emacs_open ("/dev/zero", O_RDONLY, 0);
+ mmap_fd = emacs_open_noquit ("/dev/zero", O_RDONLY, 0);
if (mmap_fd == -1)
fatal ("Cannot open /dev/zero: %s", emacs_strerror (errno));
}
@@ -5180,7 +5173,6 @@ init_buffer_once (void)
bset_upcase_table (&buffer_local_flags, make_fixnum (0));
bset_case_canon_table (&buffer_local_flags, make_fixnum (0));
bset_case_eqv_table (&buffer_local_flags, make_fixnum (0));
- bset_minor_modes (&buffer_local_flags, make_fixnum (0));
bset_width_table (&buffer_local_flags, make_fixnum (0));
bset_pt_marker (&buffer_local_flags, make_fixnum (0));
bset_begv_marker (&buffer_local_flags, make_fixnum (0));
@@ -5355,10 +5347,11 @@ init_buffer_once (void)
Fput (Qkill_buffer_hook, Qpermanent_local, Qt);
/* Super-magic invisible buffer. */
- Vprin1_to_string_buffer = Fget_buffer_create (build_pure_c_string (" prin1"));
+ Vprin1_to_string_buffer =
+ Fget_buffer_create (build_pure_c_string (" prin1"), Qt);
Vbuffer_alist = Qnil;
- Fset_buffer (Fget_buffer_create (build_pure_c_string ("*scratch*")));
+ Fset_buffer (Fget_buffer_create (build_pure_c_string ("*scratch*"), Qnil));
inhibit_modification_hooks = 0;
}
@@ -5403,7 +5396,7 @@ init_buffer (void)
#endif /* USE_MMAP_FOR_BUFFERS */
AUTO_STRING (scratch, "*scratch*");
- Fset_buffer (Fget_buffer_create (scratch));
+ Fset_buffer (Fget_buffer_create (scratch, Qnil));
if (NILP (BVAR (&buffer_defaults, enable_multibyte_characters)))
Fset_buffer_multibyte (Qnil);
@@ -5645,6 +5638,9 @@ Use the command `abbrev-mode' to change this variable. */);
DEFVAR_PER_BUFFER ("fill-column", &BVAR (current_buffer, fill_column),
Qintegerp,
doc: /* Column beyond which automatic line-wrapping should happen.
+It is used by filling commands, such as `fill-region' and `fill-paragraph',
+and by `auto-fill-mode', which see.
+See also `current-fill-column'.
Interactively, you can set the buffer local value using \\[set-fill-column]. */);
DEFVAR_PER_BUFFER ("left-margin", &BVAR (current_buffer, left_margin),
@@ -6303,9 +6299,14 @@ Use Custom to set this variable and update the display. */);
DEFVAR_LISP ("kill-buffer-query-functions", Vkill_buffer_query_functions,
doc: /* List of functions called with no args to query before killing a buffer.
The buffer being killed will be current while the functions are running.
+See `kill-buffer'.
If any of them returns nil, the buffer is not killed. Functions run by
-this hook are supposed to not change the current buffer. */);
+this hook are supposed to not change the current buffer.
+
+This hook is not run for internal or temporary buffers created by
+`get-buffer-create' or `generate-new-buffer' with argument
+INHIBIT-BUFFER-HOOKS non-nil. */);
Vkill_buffer_query_functions = Qnil;
DEFVAR_LISP ("change-major-mode-hook", Vchange_major_mode_hook,
@@ -6318,9 +6319,12 @@ The function `kill-all-local-variables' runs this before doing anything else. *
doc: /* Hook run when the buffer list changes.
Functions (implicitly) running this hook are `get-buffer-create',
`make-indirect-buffer', `rename-buffer', `kill-buffer', `bury-buffer'
-and `select-window'. Functions run by this hook should avoid calling
-`select-window' with a nil NORECORD argument or `with-temp-buffer'
-since either may lead to infinite recursion. */);
+and `select-window'. This hook is not run for internal or temporary
+buffers created by `get-buffer-create' or `generate-new-buffer' with
+argument INHIBIT-BUFFER-HOOKS non-nil.
+
+Functions run by this hook should avoid calling `select-window' with a
+nil NORECORD argument since it may lead to infinite recursion. */);
Vbuffer_list_update_hook = Qnil;
DEFSYM (Qbuffer_list_update_hook, "buffer-list-update-hook");
@@ -6376,10 +6380,3 @@ since either may lead to infinite recursion. */);
Fput (intern_c_string ("erase-buffer"), Qdisabled, Qt);
}
-
-void
-keys_of_buffer (void)
-{
- initial_define_key (control_x_map, 'b', "switch-to-buffer");
- initial_define_key (control_x_map, 'k', "kill-buffer");
-}
diff --git a/src/buffer.h b/src/buffer.h
index 3da49414bb8..790291f1185 100644
--- a/src/buffer.h
+++ b/src/buffer.h
@@ -1,6 +1,6 @@
/* Header file for the buffer manipulation primitives.
-Copyright (C) 1985-1986, 1993-1995, 1997-2020 Free Software Foundation,
+Copyright (C) 1985-1986, 1993-1995, 1997-2021 Free Software Foundation,
Inc.
This file is part of GNU Emacs.
@@ -419,9 +419,6 @@ struct buffer
/* Non-nil means show ... at end of line followed by invisible lines. */
Lisp_Object selective_display_ellipses_;
- /* Alist of (FUNCTION . STRING) for each minor mode enabled in buffer. */
- Lisp_Object minor_modes_;
-
/* t if "self-insertion" should overwrite; `binary' if it should also
overwrite newlines and tabs - for editing executables and the like. */
Lisp_Object overwrite_mode_;
@@ -666,11 +663,11 @@ struct buffer
/* Non-zero whenever the narrowing is changed in this buffer. */
bool_bf clip_changed : 1;
- /* Non-zero for internally used temporary buffers that don't need to
- run hooks kill-buffer-hook, buffer-list-update-hook, and
- kill-buffer-query-functions. This is used in coding.c to avoid
- slowing down en/decoding when there are a lot of these hooks
- defined. */
+ /* Non-zero for internal or temporary buffers that don't need to
+ run hooks kill-buffer-hook, kill-buffer-query-functions, and
+ buffer-list-update-hook. This is used in coding.c to avoid
+ slowing down en/decoding when a lot of these hooks are
+ defined, as well as by with-temp-buffer, for example. */
bool_bf inhibit_buffer_hooks : 1;
/* List of overlays that end at or before the current center,
diff --git a/src/bytecode.c b/src/bytecode.c
index 1c3b6eac0d1..4fd41acab85 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -1,5 +1,5 @@
/* Execution of byte code produced by bytecomp.el.
- Copyright (C) 1985-1988, 1993, 2000-2020 Free Software Foundation,
+ Copyright (C) 1985-1988, 1993, 2000-2021 Free Software Foundation,
Inc.
This file is part of GNU Emacs.
diff --git a/src/callint.c b/src/callint.c
index f80436f3d91..d3f49bc35d1 100644
--- a/src/callint.c
+++ b/src/callint.c
@@ -1,5 +1,5 @@
/* Call a Lisp function interactively.
- Copyright (C) 1985-1986, 1993-1995, 1997, 2000-2020 Free Software
+ Copyright (C) 1985-1986, 1993-1995, 1997, 2000-2021 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
@@ -283,6 +283,11 @@ invoke it (via an `interactive' spec that contains, for instance, an
Lisp_Object save_real_this_command = Vreal_this_command;
Lisp_Object save_last_command = KVAR (current_kboard, Vlast_command);
+ /* Bound recursively so that code can check the current command from
+ code running from minibuffer hooks (and the like), without being
+ overwritten by subsequent minibuffer calls. */
+ specbind (Qcurrent_minibuffer_command, Vthis_command);
+
if (NILP (keys))
keys = this_command_keys, key_count = this_command_key_count;
else
diff --git a/src/callproc.c b/src/callproc.c
index e3346e2eabb..cb72b070b7b 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -1,6 +1,6 @@
/* Synchronous subprocess invocation for GNU Emacs.
-Copyright (C) 1985-1988, 1993-1995, 1999-2020 Free Software Foundation,
+Copyright (C) 1985-1988, 1993-1995, 1999-2021 Free Software Foundation,
Inc.
This file is part of GNU Emacs.
@@ -30,6 +30,11 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "lisp.h"
+#ifdef SETUP_SLAVE_PTY
+# include <sys/stream.h>
+# include <sys/stropts.h>
+#endif
+
#ifdef WINDOWSNT
#include <sys/socket.h> /* for fcntl */
#include <windows.h>
@@ -100,6 +105,15 @@ enum
};
static Lisp_Object call_process (ptrdiff_t, Lisp_Object *, int, ptrdiff_t);
+
+#ifdef DOS_NT
+# define CHILD_SETUP_TYPE int
+#else
+# define CHILD_SETUP_TYPE _Noreturn void
+#endif
+
+static CHILD_SETUP_TYPE child_setup (int, int, int, char **, char **,
+ const char *);
/* Return the current buffer's working directory, or the home
directory if it's unreachable, as a string suitable for a system call.
@@ -301,7 +315,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
char *tempfile = NULL;
#else
sigset_t oldset;
- pid_t pid;
+ pid_t pid = -1;
#endif
int child_errno;
int fd_output, fd_error;
@@ -405,9 +419,8 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
if (! (NILP (buffer) || EQ (buffer, Qt) || FIXNUMP (buffer)))
{
- Lisp_Object spec_buffer;
- spec_buffer = buffer;
- buffer = Fget_buffer_create (buffer);
+ Lisp_Object spec_buffer = buffer;
+ buffer = Fget_buffer_create (buffer, Qnil);
/* Mention the buffer name for a better error message. */
if (NILP (buffer))
CHECK_BUFFER (spec_buffer);
@@ -542,8 +555,11 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
callproc_fd[CALLPROC_STDERR] = fd_error;
}
+ char **env = make_environment_block (current_dir);
+
#ifdef MSDOS /* MW, July 1993 */
- status = child_setup (filefd, fd_output, fd_error, new_argv, 0, current_dir);
+ status = child_setup (filefd, fd_output, fd_error, new_argv, env,
+ SSDATA (current_dir));
if (status < 0)
{
@@ -589,70 +605,10 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
block_input ();
block_child_signal (&oldset);
-#ifdef WINDOWSNT
- pid = child_setup (filefd, fd_output, fd_error, new_argv, 0, current_dir);
-#else /* not WINDOWSNT */
-
- /* vfork, and prevent local vars from being clobbered by the vfork. */
- {
- Lisp_Object volatile buffer_volatile = buffer;
- Lisp_Object volatile coding_systems_volatile = coding_systems;
- Lisp_Object volatile current_dir_volatile = current_dir;
- bool volatile display_p_volatile = display_p;
- int volatile fd_error_volatile = fd_error;
- int volatile filefd_volatile = filefd;
- ptrdiff_t volatile count_volatile = count;
- ptrdiff_t volatile sa_avail_volatile = sa_avail;
- ptrdiff_t volatile sa_count_volatile = sa_count;
- char **volatile new_argv_volatile = new_argv;
- int volatile callproc_fd_volatile[CALLPROC_FDS];
- for (i = 0; i < CALLPROC_FDS; i++)
- callproc_fd_volatile[i] = callproc_fd[i];
-
- pid = vfork ();
-
- buffer = buffer_volatile;
- coding_systems = coding_systems_volatile;
- current_dir = current_dir_volatile;
- display_p = display_p_volatile;
- fd_error = fd_error_volatile;
- filefd = filefd_volatile;
- count = count_volatile;
- sa_avail = sa_avail_volatile;
- sa_count = sa_count_volatile;
- new_argv = new_argv_volatile;
-
- for (i = 0; i < CALLPROC_FDS; i++)
- callproc_fd[i] = callproc_fd_volatile[i];
- fd_output = callproc_fd[CALLPROC_STDOUT];
- }
-
- if (pid == 0)
- {
-#ifdef DARWIN_OS
- /* Work around a macOS bug, where SIGCHLD is apparently
- delivered to a vforked child instead of to its parent. See:
- https://lists.gnu.org/r/emacs-devel/2017-05/msg00342.html
- */
- signal (SIGCHLD, SIG_DFL);
-#endif
-
- unblock_child_signal (&oldset);
- dissociate_controlling_tty ();
-
- /* Emacs ignores SIGPIPE, but the child should not. */
- signal (SIGPIPE, SIG_DFL);
- /* Likewise for SIGPROF. */
-#ifdef SIGPROF
- signal (SIGPROF, SIG_DFL);
-#endif
-
- child_setup (filefd, fd_output, fd_error, new_argv, 0, current_dir);
- }
-
-#endif /* not WINDOWSNT */
-
- child_errno = errno;
+ child_errno
+ = emacs_spawn (&pid, filefd, fd_output, fd_error, new_argv, env,
+ SSDATA (current_dir), NULL, &oldset);
+ eassert ((child_errno == 0) == (0 < pid));
if (pid > 0)
{
@@ -1188,16 +1144,6 @@ exec_failed (char const *name, int err)
_exit (err == ENOENT ? EXIT_ENOENT : EXIT_CANNOT_INVOKE);
}
-#else
-
-/* Do nothing. There is no need to fail, as DOS_NT platforms do not
- fork and exec, and handle alloca exhaustion in a different way. */
-
-static void
-exec_failed (char const *name, int err)
-{
-}
-
#endif
/* This is the last thing run in a newly forked inferior
@@ -1206,8 +1152,6 @@ exec_failed (char const *name, int err)
Initialize inferior's priority, pgrp, connected dir and environment.
then exec another program based on new_argv.
- If SET_PGRP, put the subprocess into a separate process group.
-
CURRENT_DIR is an elisp string giving the path of the current
directory the subprocess should have. Since we can't really signal
a decent error from within the child, this should be verified as an
@@ -1217,12 +1161,10 @@ exec_failed (char const *name, int err)
On MS-Windows, either return a pid or return -1 and set errno.
On MS-DOS, either return an exit status or signal an error. */
-CHILD_SETUP_TYPE
-child_setup (int in, int out, int err, char **new_argv, bool set_pgrp,
- Lisp_Object current_dir)
+static CHILD_SETUP_TYPE
+child_setup (int in, int out, int err, char **new_argv, char **env,
+ const char *current_dir)
{
- char **env;
- char *pwd_var;
#ifdef WINDOWSNT
int cpid;
HANDLE handles[3];
@@ -1236,24 +1178,6 @@ child_setup (int in, int out, int err, char **new_argv, bool set_pgrp,
src/alloca.c) it is safe because that changes the superior's
static variables as if the superior had done alloca and will be
cleaned up in the usual way. */
- {
- char *temp;
- ptrdiff_t i;
-
- i = SBYTES (current_dir);
-#ifdef MSDOS
- /* MSDOS must have all environment variables malloc'ed, because
- low-level libc functions that launch subsidiary processes rely
- on that. */
- pwd_var = xmalloc (i + 5);
-#else
- if (MAX_ALLOCA - 5 < i)
- exec_failed (new_argv[0], ENOMEM);
- pwd_var = alloca (i + 5);
-#endif
- temp = pwd_var + 4;
- memcpy (pwd_var, "PWD=", 4);
- lispstpcpy (temp, current_dir);
#ifndef DOS_NT
/* We can't signal an Elisp error here; we're in a vfork. Since
@@ -1261,101 +1185,13 @@ child_setup (int in, int out, int err, char **new_argv, bool set_pgrp,
should only return an error if the directory's permissions
are changed between the check and this chdir, but we should
at least check. */
- if (chdir (temp) < 0)
+ if (chdir (current_dir) < 0)
_exit (EXIT_CANCELED);
-#else /* DOS_NT */
- /* Get past the drive letter, so that d:/ is left alone. */
- if (i > 2 && IS_DEVICE_SEP (temp[1]) && IS_DIRECTORY_SEP (temp[2]))
- {
- temp += 2;
- i -= 2;
- }
-#endif /* DOS_NT */
-
- /* Strip trailing slashes for PWD, but leave "/" and "//" alone. */
- while (i > 2 && IS_DIRECTORY_SEP (temp[i - 1]))
- temp[--i] = 0;
- }
-
- /* Set `env' to a vector of the strings in the environment. */
- {
- register Lisp_Object tem;
- register char **new_env;
- char **p, **q;
- register int new_length;
- Lisp_Object display = Qnil;
-
- new_length = 0;
-
- for (tem = Vprocess_environment;
- CONSP (tem) && STRINGP (XCAR (tem));
- tem = XCDR (tem))
- {
- if (strncmp (SSDATA (XCAR (tem)), "DISPLAY", 7) == 0
- && (SDATA (XCAR (tem)) [7] == '\0'
- || SDATA (XCAR (tem)) [7] == '='))
- /* DISPLAY is specified in process-environment. */
- display = Qt;
- new_length++;
- }
-
- /* If not provided yet, use the frame's DISPLAY. */
- if (NILP (display))
- {
- Lisp_Object tmp = Fframe_parameter (selected_frame, Qdisplay);
- if (!STRINGP (tmp) && CONSP (Vinitial_environment))
- /* If still not found, Look for DISPLAY in Vinitial_environment. */
- tmp = Fgetenv_internal (build_string ("DISPLAY"),
- Vinitial_environment);
- if (STRINGP (tmp))
- {
- display = tmp;
- new_length++;
- }
- }
-
- /* new_length + 2 to include PWD and terminating 0. */
- if (MAX_ALLOCA / sizeof *env - 2 < new_length)
- exec_failed (new_argv[0], ENOMEM);
- env = new_env = alloca ((new_length + 2) * sizeof *env);
- /* If we have a PWD envvar, pass one down,
- but with corrected value. */
- if (egetenv ("PWD"))
- *new_env++ = pwd_var;
-
- if (STRINGP (display))
- {
- if (MAX_ALLOCA - sizeof "DISPLAY=" < SBYTES (display))
- exec_failed (new_argv[0], ENOMEM);
- char *vdata = alloca (sizeof "DISPLAY=" + SBYTES (display));
- lispstpcpy (stpcpy (vdata, "DISPLAY="), display);
- new_env = add_env (env, new_env, vdata);
- }
-
- /* Overrides. */
- for (tem = Vprocess_environment;
- CONSP (tem) && STRINGP (XCAR (tem));
- tem = XCDR (tem))
- new_env = add_env (env, new_env, SSDATA (XCAR (tem)));
-
- *new_env = 0;
-
- /* Remove variable names without values. */
- p = q = env;
- while (*p != 0)
- {
- while (*q != 0 && strchr (*q, '=') == NULL)
- q++;
- *p = *q++;
- if (*p != 0)
- p++;
- }
- }
-
+#endif
#ifdef WINDOWSNT
prepare_standard_handles (in, out, err, handles);
- set_process_dir (SSDATA (current_dir));
+ set_process_dir (current_dir);
/* Spawn the child. (See w32proc.c:sys_spawnve). */
cpid = spawnve (_P_NOWAIT, new_argv[0], new_argv, env);
reset_standard_handles (in, out, err, handles);
@@ -1391,6 +1227,185 @@ child_setup (int in, int out, int err, char **new_argv, bool set_pgrp,
#endif /* not WINDOWSNT */
}
+/* Start a new asynchronous subprocess. If successful, return zero
+ and store the process identifier of the new process in *NEWPID.
+ Use STDIN, STDOUT, and STDERR as standard streams for the new
+ process. Use ARGV as argument vector for the new process; use
+ process image file ARGV[0]. Use ENVP for the environment block for
+ the new process. Use CWD as working directory for the new process.
+ If PTY is not NULL, it must be a pseudoterminal device. If PTY is
+ NULL, don't perform any terminal setup. OLDSET must be a pointer
+ to a signal set initialized by `block_child_signal'. Before
+ calling this function, call `block_input' and `block_child_signal';
+ afterwards, call `unblock_input' and `unblock_child_signal'. Be
+ sure to call `unblock_child_signal' only after registering NEWPID
+ in a list where `handle_child_signal' can find it! */
+
+int
+emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err,
+ char **argv, char **envp, const char *cwd,
+ const char *pty, const sigset_t *oldset)
+{
+ int pid;
+
+ eassert (input_blocked_p ());
+
+#ifndef WINDOWSNT
+ /* vfork, and prevent local vars from being clobbered by the vfork. */
+ pid_t *volatile newpid_volatile = newpid;
+ const char *volatile cwd_volatile = cwd;
+ const char *volatile pty_volatile = pty;
+ char **volatile argv_volatile = argv;
+ int volatile stdin_volatile = std_in;
+ int volatile stdout_volatile = std_out;
+ int volatile stderr_volatile = std_err;
+ char **volatile envp_volatile = envp;
+ const sigset_t *volatile oldset_volatile = oldset;
+
+#ifdef DARWIN_OS
+ /* Darwin doesn't let us run setsid after a vfork, so use fork when
+ necessary. Below, we reset SIGCHLD handling after a vfork, as
+ apparently macOS can mistakenly deliver SIGCHLD to the child. */
+ if (pty != NULL)
+ pid = fork ();
+ else
+ pid = vfork ();
+#else
+ pid = vfork ();
+#endif
+
+ newpid = newpid_volatile;
+ cwd = cwd_volatile;
+ pty = pty_volatile;
+ argv = argv_volatile;
+ std_in = stdin_volatile;
+ std_out = stdout_volatile;
+ std_err = stderr_volatile;
+ envp = envp_volatile;
+ oldset = oldset_volatile;
+
+ if (pid == 0)
+#endif /* not WINDOWSNT */
+ {
+ bool pty_flag = pty != NULL;
+ /* Make the pty be the controlling terminal of the process. */
+#ifdef HAVE_PTYS
+ dissociate_controlling_tty ();
+
+ /* Make the pty's terminal the controlling terminal. */
+ if (pty_flag && std_in >= 0)
+ {
+#ifdef TIOCSCTTY
+ /* We ignore the return value
+ because faith@cs.unc.edu says that is necessary on Linux. */
+ ioctl (std_in, TIOCSCTTY, 0);
+#endif
+ }
+#if defined (LDISC1)
+ if (pty_flag && std_in >= 0)
+ {
+ struct termios t;
+ tcgetattr (std_in, &t);
+ t.c_lflag = LDISC1;
+ if (tcsetattr (std_in, TCSANOW, &t) < 0)
+ emacs_perror ("create_process/tcsetattr LDISC1");
+ }
+#else
+#if defined (NTTYDISC) && defined (TIOCSETD)
+ if (pty_flag && std_in >= 0)
+ {
+ /* Use new line discipline. */
+ int ldisc = NTTYDISC;
+ ioctl (std_in, TIOCSETD, &ldisc);
+ }
+#endif
+#endif
+
+#if !defined (DONT_REOPEN_PTY)
+/*** There is a suggestion that this ought to be a
+ conditional on TIOCSPGRP, or !defined TIOCSCTTY.
+ Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
+ that system does seem to need this code, even though
+ both TIOCSCTTY is defined. */
+ /* Now close the pty (if we had it open) and reopen it.
+ This makes the pty the controlling terminal of the subprocess. */
+ if (pty_flag)
+ {
+
+ /* I wonder if emacs_close (emacs_open (pty, ...))
+ would work? */
+ if (std_in >= 0)
+ emacs_close (std_in);
+ std_out = std_in = emacs_open_noquit (pty, O_RDWR, 0);
+
+ if (std_in < 0)
+ {
+ emacs_perror (pty);
+ _exit (EXIT_CANCELED);
+ }
+
+ }
+#endif /* not DONT_REOPEN_PTY */
+
+#ifdef SETUP_SLAVE_PTY
+ if (pty_flag)
+ {
+ SETUP_SLAVE_PTY;
+ }
+#endif /* SETUP_SLAVE_PTY */
+#endif /* HAVE_PTYS */
+
+#ifdef DARWIN_OS
+ /* Work around a macOS bug, where SIGCHLD is apparently
+ delivered to a vforked child instead of to its parent. See:
+ https://lists.gnu.org/r/emacs-devel/2017-05/msg00342.html
+ */
+ signal (SIGCHLD, SIG_DFL);
+#endif
+
+ signal (SIGINT, SIG_DFL);
+ signal (SIGQUIT, SIG_DFL);
+#ifdef SIGPROF
+ signal (SIGPROF, SIG_DFL);
+#endif
+
+ /* Emacs ignores SIGPIPE, but the child should not. */
+ signal (SIGPIPE, SIG_DFL);
+ /* Likewise for SIGPROF. */
+#ifdef SIGPROF
+ signal (SIGPROF, SIG_DFL);
+#endif
+
+ /* Stop blocking SIGCHLD in the child. */
+ unblock_child_signal (oldset);
+
+ if (pty_flag)
+ child_setup_tty (std_out);
+
+ if (std_err < 0)
+ std_err = std_out;
+#ifdef WINDOWSNT
+ pid = child_setup (std_in, std_out, std_err, argv, envp, cwd);
+#else /* not WINDOWSNT */
+ child_setup (std_in, std_out, std_err, argv, envp, cwd);
+#endif /* not WINDOWSNT */
+ }
+
+ /* Back in the parent process. */
+
+ int vfork_error = pid < 0 ? errno : 0;
+
+ if (pid < 0)
+ {
+ eassert (0 < vfork_error);
+ return vfork_error;
+ }
+
+ eassert (0 < pid);
+ *newpid = pid;
+ return 0;
+}
+
static bool
getenv_internal_1 (const char *var, ptrdiff_t varlen, char **value,
ptrdiff_t *valuelen, Lisp_Object env)
@@ -1514,6 +1529,119 @@ egetenv_internal (const char *var, ptrdiff_t len)
return 0;
}
+/* Create a new environment block. You can pass the returned pointer
+ to `execve'. Add unwind protections for all newly-allocated
+ objects. Don't call any Lisp code or the garbage collector while
+ the block is active. */
+
+char **
+make_environment_block (Lisp_Object current_dir)
+{
+ char **env;
+ char *pwd_var;
+
+ {
+ char *temp;
+ ptrdiff_t i;
+
+ i = SBYTES (current_dir);
+ pwd_var = xmalloc (i + 5);
+ record_unwind_protect_ptr (xfree, pwd_var);
+ temp = pwd_var + 4;
+ memcpy (pwd_var, "PWD=", 4);
+ lispstpcpy (temp, current_dir);
+
+#ifdef DOS_NT
+ /* Get past the drive letter, so that d:/ is left alone. */
+ if (i > 2 && IS_DEVICE_SEP (temp[1]) && IS_DIRECTORY_SEP (temp[2]))
+ {
+ temp += 2;
+ i -= 2;
+ }
+#endif /* DOS_NT */
+
+ /* Strip trailing slashes for PWD, but leave "/" and "//" alone. */
+ while (i > 2 && IS_DIRECTORY_SEP (temp[i - 1]))
+ temp[--i] = 0;
+ }
+
+ /* Set `env' to a vector of the strings in the environment. */
+
+ {
+ register Lisp_Object tem;
+ register char **new_env;
+ char **p, **q;
+ register int new_length;
+ Lisp_Object display = Qnil;
+
+ new_length = 0;
+
+ for (tem = Vprocess_environment;
+ CONSP (tem) && STRINGP (XCAR (tem));
+ tem = XCDR (tem))
+ {
+ if (strncmp (SSDATA (XCAR (tem)), "DISPLAY", 7) == 0
+ && (SDATA (XCAR (tem)) [7] == '\0'
+ || SDATA (XCAR (tem)) [7] == '='))
+ /* DISPLAY is specified in process-environment. */
+ display = Qt;
+ new_length++;
+ }
+
+ /* If not provided yet, use the frame's DISPLAY. */
+ if (NILP (display))
+ {
+ Lisp_Object tmp = Fframe_parameter (selected_frame, Qdisplay);
+ if (!STRINGP (tmp) && CONSP (Vinitial_environment))
+ /* If still not found, Look for DISPLAY in Vinitial_environment. */
+ tmp = Fgetenv_internal (build_string ("DISPLAY"),
+ Vinitial_environment);
+ if (STRINGP (tmp))
+ {
+ display = tmp;
+ new_length++;
+ }
+ }
+
+ /* new_length + 2 to include PWD and terminating 0. */
+ env = new_env = xnmalloc (new_length + 2, sizeof *env);
+ record_unwind_protect_ptr (xfree, env);
+ /* If we have a PWD envvar, pass one down,
+ but with corrected value. */
+ if (egetenv ("PWD"))
+ *new_env++ = pwd_var;
+
+ if (STRINGP (display))
+ {
+ char *vdata = xmalloc (sizeof "DISPLAY=" + SBYTES (display));
+ record_unwind_protect_ptr (xfree, vdata);
+ lispstpcpy (stpcpy (vdata, "DISPLAY="), display);
+ new_env = add_env (env, new_env, vdata);
+ }
+
+ /* Overrides. */
+ for (tem = Vprocess_environment;
+ CONSP (tem) && STRINGP (XCAR (tem));
+ tem = XCDR (tem))
+ new_env = add_env (env, new_env, SSDATA (XCAR (tem)));
+
+ *new_env = 0;
+
+ /* Remove variable names without values. */
+ p = q = env;
+ while (*p != 0)
+ {
+ while (*q != 0 && strchr (*q, '=') == NULL)
+ q++;
+ *p = *q++;
+ if (*p != 0)
+ p++;
+ }
+ }
+
+ return env;
+}
+
/* This is run before init_cmdargs. */
diff --git a/src/casefiddle.c b/src/casefiddle.c
index debd2412238..a7a25414909 100644
--- a/src/casefiddle.c
+++ b/src/casefiddle.c
@@ -1,7 +1,7 @@
/* -*- coding: utf-8 -*- */
/* GNU Emacs case conversion functions.
-Copyright (C) 1985, 1994, 1997-1999, 2001-2020 Free Software Foundation,
+Copyright (C) 1985, 1994, 1997-1999, 2001-2021 Free Software Foundation,
Inc.
This file is part of GNU Emacs.
@@ -682,16 +682,3 @@ Called with one argument METHOD which can be:
defsubr (&Sdowncase_word);
defsubr (&Scapitalize_word);
}
-
-void
-keys_of_casefiddle (void)
-{
- initial_define_key (control_x_map, Ctl ('U'), "upcase-region");
- Fput (intern ("upcase-region"), Qdisabled, Qt);
- initial_define_key (control_x_map, Ctl ('L'), "downcase-region");
- Fput (intern ("downcase-region"), Qdisabled, Qt);
-
- initial_define_key (meta_map, 'u', "upcase-word");
- initial_define_key (meta_map, 'l', "downcase-word");
- initial_define_key (meta_map, 'c', "capitalize-word");
-}
diff --git a/src/casetab.c b/src/casetab.c
index 07cda36d95d..4699857cb8a 100644
--- a/src/casetab.c
+++ b/src/casetab.c
@@ -1,5 +1,5 @@
/* GNU Emacs routines to deal with case tables.
- Copyright (C) 1993-1994, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1993-1994, 2001-2021 Free Software Foundation, Inc.
Author: Howard Gayle
diff --git a/src/category.c b/src/category.c
index c80571ecd4f..ec8f61f7f00 100644
--- a/src/category.c
+++ b/src/category.c
@@ -1,6 +1,6 @@
/* GNU Emacs routines to deal with category tables.
-Copyright (C) 1998, 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 1998, 2001-2021 Free Software Foundation, Inc.
Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
2005, 2006, 2007, 2008, 2009, 2010, 2011
National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/src/ccl.c b/src/ccl.c
index 796698eb1ce..7c033afc882 100644
--- a/src/ccl.c
+++ b/src/ccl.c
@@ -1,5 +1,5 @@
/* CCL (Code Conversion Language) interpreter.
- Copyright (C) 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 2001-2021 Free Software Foundation, Inc.
Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
2005, 2006, 2007, 2008, 2009, 2010, 2011
National Institute of Advanced Industrial Science and Technology (AIST)
@@ -1151,7 +1151,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
if (!INT_DIVIDE_OVERFLOW (reg[rrr], i))
reg[rrr] /= i;
break;
- case CCL_MOD: reg[rrr] %= i; break;
+ case CCL_MOD:
if (!i)
CCL_INVALID_CMD;
reg[rrr] = i == -1 ? 0 : reg[rrr] % i;
diff --git a/src/character.c b/src/character.c
index 5860f6a0c8c..a599a0355f4 100644
--- a/src/character.c
+++ b/src/character.c
@@ -1,6 +1,6 @@
/* Basic character support.
-Copyright (C) 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 2001-2021 Free Software Foundation, Inc.
Copyright (C) 1995, 1997, 1998, 2001 Electrotechnical Laboratory, JAPAN.
Licensed to the Free Software Foundation.
Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
@@ -982,6 +982,27 @@ printablep (int c)
|| gen_cat == UNICODE_CATEGORY_Cn)); /* unassigned */
}
+/* Return true if C is graphic character that can be printed independently. */
+bool
+graphic_base_p (int c)
+{
+ Lisp_Object category = CHAR_TABLE_REF (Vunicode_category_table, c);
+ if (! FIXNUMP (category))
+ return false;
+ EMACS_INT gen_cat = XFIXNUM (category);
+
+ return (!(gen_cat == UNICODE_CATEGORY_Mn /* mark, nonspacing */
+ || gen_cat == UNICODE_CATEGORY_Mc /* mark, combining */
+ || gen_cat == UNICODE_CATEGORY_Me /* mark, enclosing */
+ || gen_cat == UNICODE_CATEGORY_Zs /* separator, space */
+ || gen_cat == UNICODE_CATEGORY_Zl /* separator, line */
+ || gen_cat == UNICODE_CATEGORY_Zp /* separator, paragraph */
+ || gen_cat == UNICODE_CATEGORY_Cc /* other, control */
+ || gen_cat == UNICODE_CATEGORY_Cs /* other, surrogate */
+ || gen_cat == UNICODE_CATEGORY_Cf /* other, format */
+ || gen_cat == UNICODE_CATEGORY_Cn)); /* other, unassigned */
+}
+
/* Return true if C is a horizontal whitespace character, as defined
by https://www.unicode.org/reports/tr18/tr18-19.html#blank. */
bool
diff --git a/src/character.h b/src/character.h
index af5023f77cc..cbf43097ae2 100644
--- a/src/character.h
+++ b/src/character.h
@@ -583,6 +583,7 @@ extern bool alphanumericp (int);
extern bool graphicp (int);
extern bool printablep (int);
extern bool blankp (int);
+extern bool graphic_base_p (int);
/* Look up the element in char table OBJ at index CH, and return it as
an integer. If the element is not a character, return CH itself. */
diff --git a/src/charset.c b/src/charset.c
index 520dd3a9605..eb388d1868b 100644
--- a/src/charset.c
+++ b/src/charset.c
@@ -1,6 +1,6 @@
/* Basic character set support.
-Copyright (C) 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 2001-2021 Free Software Foundation, Inc.
Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
2005, 2006, 2007, 2008, 2009, 2010, 2011
@@ -800,7 +800,9 @@ RANGE is a cons (FROM . TO), where FROM and TO indicate a range of
characters contained in CHARSET.
The optional 4th and 5th arguments FROM-CODE and TO-CODE specify the
-range of code points (in CHARSET) of target characters. */)
+range of code points (in CHARSET) of target characters. Note that
+these are not character codes, but code points in CHARSET; for the
+difference see `decode-char' and `list-charset-chars'. */)
(Lisp_Object function, Lisp_Object charset, Lisp_Object arg, Lisp_Object from_code, Lisp_Object to_code)
{
struct charset *cs;
diff --git a/src/charset.h b/src/charset.h
index 62b28e6c8f0..97122d82a65 100644
--- a/src/charset.h
+++ b/src/charset.h
@@ -1,5 +1,5 @@
/* Header for charset handler.
- Copyright (C) 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 2001-2021 Free Software Foundation, Inc.
Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
2005, 2006, 2007, 2008, 2009, 2010, 2011
National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/src/chartab.c b/src/chartab.c
index cb2ced568d9..331e8595ebe 100644
--- a/src/chartab.c
+++ b/src/chartab.c
@@ -1000,10 +1000,10 @@ map_sub_char_table_for_charset (void (*c_function) (Lisp_Object, Lisp_Object),
"mapping table" or a "deunifier table" of a certain charset.
If CHARSET is not NULL (this is the case that `map-charset-chars'
- is called with non-nil FROM-CODE and TO-CODE), it is a charset who
- owns TABLE, and the function is called only on a character in the
+ is called with non-nil FROM-CODE and TO-CODE), it is a charset that
+ owns TABLE, and the function is called only for characters in the
range FROM and TO. FROM and TO are not character codes, but code
- points of a character in CHARSET.
+ points of characters in CHARSET (see 'decode-char').
This function is called in these two cases:
diff --git a/src/cm.c b/src/cm.c
index dc5a5a34eb7..fe81ca869e0 100644
--- a/src/cm.c
+++ b/src/cm.c
@@ -1,5 +1,5 @@
/* Cursor motion subroutines for GNU Emacs.
- Copyright (C) 1985, 1995, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1985, 1995, 2001-2021 Free Software Foundation, Inc.
based primarily on public domain code written by Chris Torek
This file is part of GNU Emacs.
diff --git a/src/cm.h b/src/cm.h
index 11d0b2b4b33..9bea33299ce 100644
--- a/src/cm.h
+++ b/src/cm.h
@@ -1,5 +1,5 @@
/* Cursor motion calculation definitions for GNU Emacs
- Copyright (C) 1985, 1989, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1985, 1989, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/cmds.c b/src/cmds.c
index c29cf00dad1..1547db80e88 100644
--- a/src/cmds.c
+++ b/src/cmds.c
@@ -1,6 +1,6 @@
/* Simple built-in editing commands.
-Copyright (C) 1985, 1993-1998, 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 1985, 1993-1998, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -529,24 +529,3 @@ This is run after inserting the character. */);
defsubr (&Sdelete_char);
defsubr (&Sself_insert_command);
}
-
-void
-keys_of_cmds (void)
-{
- int n;
-
- initial_define_key (global_map, Ctl ('I'), "self-insert-command");
- for (n = 040; n < 0177; n++)
- initial_define_key (global_map, n, "self-insert-command");
-#ifdef MSDOS
- for (n = 0200; n < 0240; n++)
- initial_define_key (global_map, n, "self-insert-command");
-#endif
- for (n = 0240; n < 0400; n++)
- initial_define_key (global_map, n, "self-insert-command");
-
- initial_define_key (global_map, Ctl ('A'), "beginning-of-line");
- initial_define_key (global_map, Ctl ('B'), "backward-char");
- initial_define_key (global_map, Ctl ('E'), "end-of-line");
- initial_define_key (global_map, Ctl ('F'), "forward-char");
-}
diff --git a/src/coding.c b/src/coding.c
index 2142e7fa518..739dd6adcb5 100644
--- a/src/coding.c
+++ b/src/coding.c
@@ -1,5 +1,5 @@
/* Coding system handler (conversion, detection, etc).
- Copyright (C) 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 2001-2021 Free Software Foundation, Inc.
Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
2005, 2006, 2007, 2008, 2009, 2010, 2011
National Institute of Advanced Industrial Science and Technology (AIST)
@@ -7821,7 +7821,7 @@ encode_coding (struct coding_system *coding)
/* A string that serves as name of the reusable work buffer, and as base
name of temporary work buffers used for code-conversion operations. */
-Lisp_Object Vcode_conversion_workbuf_name;
+static Lisp_Object Vcode_conversion_workbuf_name;
/* The reusable working buffer, created once and never killed. */
static Lisp_Object Vcode_conversion_reused_workbuf;
@@ -7839,7 +7839,7 @@ code_conversion_restore (Lisp_Object arg)
if (! NILP (workbuf))
{
if (EQ (workbuf, Vcode_conversion_reused_workbuf))
- reused_workbuf_in_use = 0;
+ reused_workbuf_in_use = false;
else
Fkill_buffer (workbuf);
}
@@ -7857,13 +7857,13 @@ code_conversion_save (bool with_work_buf, bool multibyte)
{
Lisp_Object name
= Fgenerate_new_buffer_name (Vcode_conversion_workbuf_name, Qnil);
- workbuf = Fget_buffer_create (name);
+ workbuf = Fget_buffer_create (name, Qt);
}
else
{
if (NILP (Fbuffer_live_p (Vcode_conversion_reused_workbuf)))
Vcode_conversion_reused_workbuf
- = Fget_buffer_create (Vcode_conversion_workbuf_name);
+ = Fget_buffer_create (Vcode_conversion_workbuf_name, Qt);
workbuf = Vcode_conversion_reused_workbuf;
}
}
@@ -7881,7 +7881,7 @@ code_conversion_save (bool with_work_buf, bool multibyte)
bset_undo_list (current_buffer, Qt);
bset_enable_multibyte_characters (current_buffer, multibyte ? Qt : Qnil);
if (EQ (workbuf, Vcode_conversion_reused_workbuf))
- reused_workbuf_in_use = 1;
+ reused_workbuf_in_use = true;
set_buffer_internal (current);
}
@@ -10354,8 +10354,8 @@ decode_file_name (Lisp_Object fname)
#endif
}
-Lisp_Object
-encode_file_name (Lisp_Object fname)
+static Lisp_Object
+encode_file_name_1 (Lisp_Object fname)
{
/* This is especially important during bootstrap and dumping, when
file-name encoding is not yet known, and therefore any non-ASCII
@@ -10380,6 +10380,19 @@ encode_file_name (Lisp_Object fname)
#endif
}
+Lisp_Object
+encode_file_name (Lisp_Object fname)
+{
+ Lisp_Object encoded = encode_file_name_1 (fname);
+ /* No system accepts NUL bytes in filenames. Allowing them can
+ cause subtle bugs because the system would silently use a
+ different filename than expected. Perform this check after
+ encoding to not miss NUL bytes introduced through encoding. */
+ CHECK_TYPE (memchr (SSDATA (encoded), '\0', SBYTES (encoded)) == NULL,
+ Qfilenamep, fname);
+ return encoded;
+}
+
DEFUN ("decode-coding-string", Fdecode_coding_string, Sdecode_coding_string,
2, 4, 0,
doc: /* Decode STRING which is encoded in CODING-SYSTEM, and return the result.
@@ -11639,7 +11652,7 @@ syms_of_coding (void)
staticpro (&Vcode_conversion_workbuf_name);
Vcode_conversion_workbuf_name = build_pure_c_string (" *code-conversion-work*");
- reused_workbuf_in_use = 0;
+ reused_workbuf_in_use = false;
PDUMPER_REMEMBER_SCALAR (reused_workbuf_in_use);
DEFSYM (Qcharset, "charset");
@@ -11780,6 +11793,7 @@ syms_of_coding (void)
DEFSYM (Qignored, "ignored");
DEFSYM (Qutf_8_string_p, "utf-8-string-p");
+ DEFSYM (Qfilenamep, "filenamep");
defsubr (&Scoding_system_p);
defsubr (&Sread_coding_system);
diff --git a/src/coding.h b/src/coding.h
index 4973cf89eb1..d06bed3f5d9 100644
--- a/src/coding.h
+++ b/src/coding.h
@@ -1,5 +1,5 @@
/* Header for coding system handler.
- Copyright (C) 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 2001-2021 Free Software Foundation, Inc.
Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
2005, 2006, 2007, 2008, 2009, 2010, 2011
National Institute of Advanced Industrial Science and Technology (AIST)
@@ -97,9 +97,6 @@ enum define_coding_undecided_arg_index
extern Lisp_Object Vcoding_system_hash_table;
-/* Name (or base name) of work buffer for code conversion. */
-extern Lisp_Object Vcode_conversion_workbuf_name;
-
/* Enumeration of index to an attribute vector of a coding system. */
enum coding_attr_index
diff --git a/src/commands.h b/src/commands.h
index 81e9b7e4da9..2205ebf7d39 100644
--- a/src/commands.h
+++ b/src/commands.h
@@ -1,5 +1,5 @@
/* Definitions needed by most editing commands.
- Copyright (C) 1985, 1994, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1985, 1994, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -23,14 +23,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#define Ctl(c) ((c)&037)
-/* Define the names of keymaps, just so people can refer to them in
- calls to initial_define_key. These should *not* be used after
- initialization; use-global-map doesn't affect these; it sets
- current_global_map instead. */
-extern Lisp_Object global_map;
-extern Lisp_Object meta_map;
-extern Lisp_Object control_x_map;
-
/* If not Qnil, this is a switch-frame event which we decided to put
off until the end of a key sequence. This should be read as the
next command input, after any Vunread_command_events.
diff --git a/src/composite.c b/src/composite.c
index 66c1e86aae1..f1c011223b2 100644
--- a/src/composite.c
+++ b/src/composite.c
@@ -1,5 +1,5 @@
/* Composite sequence support.
- Copyright (C) 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 2001-2021 Free Software Foundation, Inc.
Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H14PRO021
diff --git a/src/composite.h b/src/composite.h
index bdf63fed10e..c5d3c0faabb 100644
--- a/src/composite.h
+++ b/src/composite.h
@@ -1,5 +1,5 @@
/* Header for composite sequence handler.
- Copyright (C) 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 2001-2021 Free Software Foundation, Inc.
Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H14PRO021
diff --git a/src/conf_post.h b/src/conf_post.h
index 1ef4ff33428..bd56f29e287 100644
--- a/src/conf_post.h
+++ b/src/conf_post.h
@@ -1,6 +1,6 @@
/* conf_post.h --- configure.ac includes this via AH_BOTTOM
-Copyright (C) 1988, 1993-1994, 1999-2002, 2004-2020 Free Software
+Copyright (C) 1988, 1993-1994, 1999-2002, 2004-2021 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/cygw32.c b/src/cygw32.c
index d402669ec14..b11d94d3a62 100644
--- a/src/cygw32.c
+++ b/src/cygw32.c
@@ -1,5 +1,5 @@
/* Cygwin support routines.
- Copyright (C) 2011-2020 Free Software Foundation, Inc.
+ Copyright (C) 2011-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/cygw32.h b/src/cygw32.h
index 647211b3209..19cb77539bb 100644
--- a/src/cygw32.h
+++ b/src/cygw32.h
@@ -1,5 +1,5 @@
/* Header for Cygwin support routines.
- Copyright (C) 2011-2020 Free Software Foundation, Inc.
+ Copyright (C) 2011-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/data.c b/src/data.c
index 65589856687..35a6890b9bd 100644
--- a/src/data.c
+++ b/src/data.c
@@ -1,5 +1,5 @@
/* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter.
- Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2020 Free Software
+ Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2021 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
@@ -1440,10 +1440,14 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
{
int offset = XBUFFER_OBJFWD (innercontents)->offset;
int idx = PER_BUFFER_IDX (offset);
- if (idx > 0
- && bindflag == SET_INTERNAL_SET
- && !let_shadows_buffer_binding_p (sym))
- SET_PER_BUFFER_VALUE_P (buf, idx, 1);
+ if (idx > 0 && bindflag == SET_INTERNAL_SET
+ && !PER_BUFFER_VALUE_P (buf, idx))
+ {
+ if (let_shadows_buffer_binding_p (sym))
+ set_default_internal (symbol, newval, bindflag);
+ else
+ SET_PER_BUFFER_VALUE_P (buf, idx, 1);
+ }
}
if (voide)
@@ -1635,8 +1639,9 @@ default_value (Lisp_Object symbol)
DEFUN ("default-boundp", Fdefault_boundp, Sdefault_boundp, 1, 1, 0,
doc: /* Return t if SYMBOL has a non-void default value.
-This is the value that is seen in buffers that do not have their own values
-for this variable. */)
+A variable may have a buffer-local or a `let'-bound local value. This
+function says whether the variable has a non-void value outside of the
+current context. Also see `default-value'. */)
(Lisp_Object symbol)
{
register Lisp_Object value;
@@ -3755,6 +3760,7 @@ syms_of_data (void)
DEFSYM (Qbuffer_read_only, "buffer-read-only");
DEFSYM (Qtext_read_only, "text-read-only");
DEFSYM (Qmark_inactive, "mark-inactive");
+ DEFSYM (Qinhibited_interaction, "inhibited-interaction");
DEFSYM (Qlistp, "listp");
DEFSYM (Qconsp, "consp");
@@ -3839,6 +3845,8 @@ syms_of_data (void)
PUT_ERROR (Qbuffer_read_only, error_tail, "Buffer is read-only");
PUT_ERROR (Qtext_read_only, pure_cons (Qbuffer_read_only, error_tail),
"Text is read-only");
+ PUT_ERROR (Qinhibited_interaction, error_tail,
+ "User interaction while inhibited");
DEFSYM (Qrange_error, "range-error");
DEFSYM (Qdomain_error, "domain-error");
diff --git a/src/dbusbind.c b/src/dbusbind.c
index dc4db5c8513..c005474d440 100644
--- a/src/dbusbind.c
+++ b/src/dbusbind.c
@@ -1,5 +1,5 @@
/* Elisp bindings for D-Bus.
- Copyright (C) 2007-2020 Free Software Foundation, Inc.
+ Copyright (C) 2007-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -132,23 +132,36 @@ static bool xd_in_read_queued_messages = 0;
#define XD_BASIC_DBUS_TYPE(type) \
(dbus_type_is_valid (type) && dbus_type_is_basic (type))
#else
-#define XD_BASIC_DBUS_TYPE(type) \
- ((type == DBUS_TYPE_BYTE) \
- || (type == DBUS_TYPE_BOOLEAN) \
- || (type == DBUS_TYPE_INT16) \
- || (type == DBUS_TYPE_UINT16) \
- || (type == DBUS_TYPE_INT32) \
- || (type == DBUS_TYPE_UINT32) \
- || (type == DBUS_TYPE_INT64) \
- || (type == DBUS_TYPE_UINT64) \
- || (type == DBUS_TYPE_DOUBLE) \
- || (type == DBUS_TYPE_STRING) \
- || (type == DBUS_TYPE_OBJECT_PATH) \
- || (type == DBUS_TYPE_SIGNATURE) \
#ifdef DBUS_TYPE_UNIX_FD
- || (type == DBUS_TYPE_UNIX_FD) \
+#define XD_BASIC_DBUS_TYPE(type) \
+ ((type == DBUS_TYPE_BYTE) \
+ || (type == DBUS_TYPE_BOOLEAN) \
+ || (type == DBUS_TYPE_INT16) \
+ || (type == DBUS_TYPE_UINT16) \
+ || (type == DBUS_TYPE_INT32) \
+ || (type == DBUS_TYPE_UINT32) \
+ || (type == DBUS_TYPE_INT64) \
+ || (type == DBUS_TYPE_UINT64) \
+ || (type == DBUS_TYPE_DOUBLE) \
+ || (type == DBUS_TYPE_STRING) \
+ || (type == DBUS_TYPE_OBJECT_PATH) \
+ || (type == DBUS_TYPE_SIGNATURE) \
+ || (type == DBUS_TYPE_UNIX_FD))
+#else
+#define XD_BASIC_DBUS_TYPE(type) \
+ ((type == DBUS_TYPE_BYTE) \
+ || (type == DBUS_TYPE_BOOLEAN) \
+ || (type == DBUS_TYPE_INT16) \
+ || (type == DBUS_TYPE_UINT16) \
+ || (type == DBUS_TYPE_INT32) \
+ || (type == DBUS_TYPE_UINT32) \
+ || (type == DBUS_TYPE_INT64) \
+ || (type == DBUS_TYPE_UINT64) \
+ || (type == DBUS_TYPE_DOUBLE) \
+ || (type == DBUS_TYPE_STRING) \
+ || (type == DBUS_TYPE_OBJECT_PATH) \
+ || (type == DBUS_TYPE_SIGNATURE))
#endif
- )
#endif
/* This was a macro. On Solaris 2.11 it was said to compile for
diff --git a/src/decompress.c b/src/decompress.c
index 8e8f2443111..48392499eaf 100644
--- a/src/decompress.c
+++ b/src/decompress.c
@@ -1,5 +1,5 @@
/* Interface to zlib.
- Copyright (C) 2013-2020 Free Software Foundation, Inc.
+ Copyright (C) 2013-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/deps.mk b/src/deps.mk
index 4d162eeb0f2..eda2ed63382 100644
--- a/src/deps.mk
+++ b/src/deps.mk
@@ -1,6 +1,6 @@
### deps.mk --- src/Makefile fragment for GNU Emacs
-## Copyright (C) 1985, 1987-1988, 1993-1995, 1999-2020 Free Software
+## Copyright (C) 1985, 1987-1988, 1993-1995, 1999-2021 Free Software
## Foundation, Inc.
## This file is part of GNU Emacs.
diff --git a/src/dired.c b/src/dired.c
index 8256f2626dc..ebcf77bc263 100644
--- a/src/dired.c
+++ b/src/dired.c
@@ -1,5 +1,5 @@
/* Lisp functions for making directory listings.
- Copyright (C) 1985-1986, 1993-1994, 1999-2020 Free Software
+ Copyright (C) 1985-1986, 1993-1994, 1999-2021 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
@@ -165,8 +165,16 @@ read_dirent (DIR *dir, Lisp_Object dirname)
Lisp_Object
directory_files_internal (Lisp_Object directory, Lisp_Object full,
Lisp_Object match, Lisp_Object nosort, bool attrs,
- Lisp_Object id_format)
+ Lisp_Object id_format, Lisp_Object return_count)
{
+ EMACS_INT ind = 0, last = MOST_POSITIVE_FIXNUM;
+
+ if (!NILP (return_count))
+ {
+ CHECK_FIXNAT (return_count);
+ last = XFIXNAT (return_count);
+ }
+
if (!NILP (match))
CHECK_STRING (match);
@@ -267,6 +275,10 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full,
else
finalname = name;
+ if (ind == last)
+ break;
+ ind ++;
+
list = Fcons (attrs ? Fcons (finalname, fileattrs) : finalname, list);
}
@@ -288,18 +300,20 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full,
}
-DEFUN ("directory-files", Fdirectory_files, Sdirectory_files, 1, 4, 0,
+DEFUN ("directory-files", Fdirectory_files, Sdirectory_files, 1, 5, 0,
doc: /* Return a list of names of files in DIRECTORY.
-There are three optional arguments:
+There are four optional arguments:
If FULL is non-nil, return absolute file names. Otherwise return names
that are relative to the specified directory.
If MATCH is non-nil, mention only file names whose non-directory part
matches the regexp MATCH.
If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
Otherwise, the list returned is sorted with `string-lessp'.
- NOSORT is useful if you plan to sort the result yourself. */)
+ NOSORT is useful if you plan to sort the result yourself.
+If COUNT is non-nil and a natural number, the function will return
+ COUNT number of file names (if so many are present). */)
(Lisp_Object directory, Lisp_Object full, Lisp_Object match,
- Lisp_Object nosort)
+ Lisp_Object nosort, Lisp_Object count)
{
directory = Fexpand_file_name (directory, Qnil);
@@ -307,14 +321,15 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
call the corresponding file name handler. */
Lisp_Object handler = Ffind_file_name_handler (directory, Qdirectory_files);
if (!NILP (handler))
- return call5 (handler, Qdirectory_files, directory,
- full, match, nosort);
+ return call6 (handler, Qdirectory_files, directory,
+ full, match, nosort, count);
- return directory_files_internal (directory, full, match, nosort, false, Qnil);
+ return directory_files_internal (directory, full, match, nosort,
+ false, Qnil, count);
}
DEFUN ("directory-files-and-attributes", Fdirectory_files_and_attributes,
- Sdirectory_files_and_attributes, 1, 5, 0,
+ Sdirectory_files_and_attributes, 1, 6, 0,
doc: /* Return a list of names of files and their attributes in DIRECTORY.
Value is a list of the form:
@@ -323,7 +338,7 @@ Value is a list of the form:
where each FILEn-ATTRS is the attributes of FILEn as returned
by `file-attributes'.
-This function accepts four optional arguments:
+This function accepts five optional arguments:
If FULL is non-nil, return absolute file names. Otherwise return names
that are relative to the specified directory.
If MATCH is non-nil, mention only file names whose non-directory part
@@ -332,10 +347,12 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
NOSORT is useful if you plan to sort the result yourself.
ID-FORMAT specifies the preferred format of attributes uid and gid, see
`file-attributes' for further documentation.
+If COUNT is non-nil and a natural number, the function will return
+ COUNT number of file names (if so many are present).
On MS-Windows, performance depends on `w32-get-true-file-attributes',
which see. */)
(Lisp_Object directory, Lisp_Object full, Lisp_Object match,
- Lisp_Object nosort, Lisp_Object id_format)
+ Lisp_Object nosort, Lisp_Object id_format, Lisp_Object count)
{
directory = Fexpand_file_name (directory, Qnil);
@@ -344,11 +361,11 @@ which see. */)
Lisp_Object handler
= Ffind_file_name_handler (directory, Qdirectory_files_and_attributes);
if (!NILP (handler))
- return call6 (handler, Qdirectory_files_and_attributes,
- directory, full, match, nosort, id_format);
+ return call7 (handler, Qdirectory_files_and_attributes,
+ directory, full, match, nosort, id_format, count);
return directory_files_internal (directory, full, match, nosort,
- true, id_format);
+ true, id_format, count);
}
diff --git a/src/dispextern.h b/src/dispextern.h
index 848d3bcd20e..3ad98b8344e 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -1,6 +1,6 @@
/* Interface definitions for display code.
-Copyright (C) 1985, 1993-1994, 1997-2020 Free Software Foundation, Inc.
+Copyright (C) 1985, 1993-1994, 1997-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -3040,6 +3040,10 @@ struct image
# if !defined USE_CAIRO && defined HAVE_XRENDER
/* Picture versions of pixmap and mask for compositing. */
Picture picture, mask_picture;
+
+ /* We need to store the original image dimensions in case we have to
+ call XGetImage. */
+ int original_width, original_height;
# endif
#endif /* HAVE_X_WINDOWS */
#ifdef HAVE_NTGUI
@@ -3606,6 +3610,7 @@ extern Lisp_Object marginal_area_string (struct window *, enum window_part,
extern void redraw_frame (struct frame *);
extern bool update_frame (struct frame *, bool, bool);
extern void update_frame_with_menu (struct frame *, int, int);
+extern int update_mouse_position (struct frame *, int, int);
extern void bitch_at_user (void);
extern void adjust_frame_glyphs (struct frame *);
void free_glyphs (struct frame *);
diff --git a/src/dispnew.c b/src/dispnew.c
index 3f2ae3e6ad1..e603c671363 100644
--- a/src/dispnew.c
+++ b/src/dispnew.c
@@ -1,6 +1,6 @@
/* Updating of data structures for redisplay.
-Copyright (C) 1985-1988, 1993-1995, 1997-2020 Free Software Foundation,
+Copyright (C) 1985-1988, 1993-1995, 1997-2021 Free Software Foundation,
Inc.
This file is part of GNU Emacs.
@@ -2558,11 +2558,15 @@ build_frame_matrix_from_leaf_window (struct glyph_matrix *frame_matrix, struct w
the corresponding frame row to be updated. */
frame_row->enabled_p = true;
- /* Maybe insert a vertical border between horizontally adjacent
+ /* Maybe insert a vertical border between horizontally adjacent
windows. */
- if (GLYPH_CHAR (right_border_glyph) != 0)
+ if (GLYPH_CHAR (right_border_glyph) != 0)
{
- struct glyph *border = window_row->glyphs[LAST_AREA] - 1;
+ struct glyph *border = window_row->glyphs[LAST_AREA] - 1;
+ /* It's a subtle bug if we are overwriting some non-char
+ glyph with the vertical border glyph. */
+ eassert (border->type == CHAR_GLYPH);
+ border->type = CHAR_GLYPH;
SET_CHAR_GLYPH_FROM_GLYPH (*border, right_border_glyph);
}
@@ -3323,6 +3327,53 @@ update_frame_with_menu (struct frame *f, int row, int col)
display_completed = !paused_p;
}
+/* Update the mouse position for a frame F. This handles both
+ updating the display for mouse-face propreties and updating the
+ help echo text.
+
+ Returns the number of events generated. */
+int
+update_mouse_position (struct frame *f, int x, int y)
+{
+ previous_help_echo_string = help_echo_string;
+ help_echo_string = Qnil;
+
+ note_mouse_highlight (f, x, y);
+
+ /* If the contents of the global variable help_echo_string
+ has changed, generate a HELP_EVENT. */
+ if (!NILP (help_echo_string)
+ || !NILP (previous_help_echo_string))
+ {
+ Lisp_Object frame;
+ XSETFRAME (frame, f);
+
+ gen_help_event (help_echo_string, frame, help_echo_window,
+ help_echo_object, help_echo_pos);
+ return 1;
+ }
+
+ return 0;
+}
+
+DEFUN ("display--update-for-mouse-movement", Fdisplay__update_for_mouse_movement,
+ Sdisplay__update_for_mouse_movement, 2, 2, 0,
+ doc: /* Handle mouse movement detected by Lisp code.
+
+This function should be called when Lisp code detects the mouse has
+moved, even if `track-mouse' is nil. This handles updates that do not
+rely on input events such as updating display for mouse-face
+properties or updating the help echo text. */)
+ (Lisp_Object mouse_x, Lisp_Object mouse_y)
+{
+ CHECK_FIXNUM (mouse_x);
+ CHECK_FIXNUM (mouse_y);
+
+ update_mouse_position (SELECTED_FRAME (), XFIXNUM (mouse_x),
+ XFIXNUM (mouse_y));
+ return Qnil;
+}
+
/************************************************************************
Window-based updates
@@ -5904,8 +5955,12 @@ when TERMINAL is nil. */)
}
out = tty->output;
}
+ /* STRING might be very long, in which case fwrite could be
+ interrupted by SIGIO. So we temporarily block SIGIO. */
+ unrequest_sigio ();
fwrite (SDATA (string), 1, SBYTES (string), out);
fflush (out);
+ request_sigio ();
unblock_input ();
return Qnil;
}
@@ -5994,7 +6049,14 @@ additional wait period, in milliseconds; this is for backwards compatibility.
READING is true if reading input.
If DISPLAY_OPTION is >0 display process output while waiting.
If DISPLAY_OPTION is >1 perform an initial redisplay before waiting.
-*/
+
+ Returns a boolean Qt if we waited the full time and returns Qnil if the
+ wait was interrupted by incoming process output or keyboard events.
+
+ FIXME: When `wait_reading_process_output` returns early because of
+ process output, instead of returning nil we should loop and wait some
+ more (i.e. until either there's pending input events or the timeout
+ expired). */
Lisp_Object
sit_for (Lisp_Object timeout, bool reading, int display_option)
@@ -6002,6 +6064,8 @@ sit_for (Lisp_Object timeout, bool reading, int display_option)
intmax_t sec;
int nsec;
bool do_display = display_option > 0;
+ bool curbuf_eq_winbuf
+ = (current_buffer == XBUFFER (XWINDOW (selected_window)->contents));
swallow_events (do_display);
@@ -6053,10 +6117,18 @@ sit_for (Lisp_Object timeout, bool reading, int display_option)
gobble_input ();
#endif
- wait_reading_process_output (sec, nsec, reading ? -1 : 1, do_display,
- Qnil, NULL, 0);
+ int nbytes
+ = wait_reading_process_output (sec, nsec, reading ? -1 : 1, do_display,
+ Qnil, NULL, 0);
+
+ if (reading && curbuf_eq_winbuf)
+ /* Timers and process filters/sentinels may have changed the selected
+ window (e.g. in response to a connection from emacsclient), in which
+ case we should follow it (unless we weren't in the selected-window's
+ buffer to start with). */
+ set_buffer_internal (XBUFFER (XWINDOW (selected_window)->contents));
- return detect_input_pending () ? Qnil : Qt;
+ return (nbytes > 0 || detect_input_pending ()) ? Qnil : Qt;
}
@@ -6490,6 +6562,7 @@ syms_of_display (void)
{
defsubr (&Sredraw_frame);
defsubr (&Sredraw_display);
+ defsubr (&Sdisplay__update_for_mouse_movement);
defsubr (&Sframe_or_buffer_changed_p);
defsubr (&Sopen_termscript);
defsubr (&Sding);
diff --git a/src/disptab.h b/src/disptab.h
index d5453474d95..adf411b805d 100644
--- a/src/disptab.h
+++ b/src/disptab.h
@@ -1,5 +1,5 @@
/* Things for GLYPHS and glyph tables.
- Copyright (C) 1993, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1993, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/dmpstruct.awk b/src/dmpstruct.awk
index a25bcf6f404..c7b93da3bcb 100644
--- a/src/dmpstruct.awk
+++ b/src/dmpstruct.awk
@@ -1,4 +1,4 @@
-# Copyright (C) 2018-2020 Free Software Foundation, Inc.
+# Copyright (C) 2018-2021 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
#
diff --git a/src/doc.c b/src/doc.c
index f1ce266d39f..1307aa5ee92 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -1,6 +1,6 @@
/* Record indices of function doc strings stored in a file. -*- coding: utf-8 -*-
-Copyright (C) 1985-1986, 1993-1995, 1997-2020 Free Software Foundation,
+Copyright (C) 1985-1986, 1993-1995, 1997-2021 Free Software Foundation,
Inc.
This file is part of GNU Emacs.
@@ -82,10 +82,7 @@ Lisp_Object
get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
{
char *from, *to, *name, *p, *p1;
- int fd;
- int offset;
- EMACS_INT position;
- Lisp_Object file, tem, pos;
+ Lisp_Object file, pos;
ptrdiff_t count = SPECPDL_INDEX ();
USE_SAFE_ALLOCA;
@@ -102,7 +99,7 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
else
return Qnil;
- position = eabs (XFIXNUM (pos));
+ EMACS_INT position = eabs (XFIXNUM (pos));
if (!STRINGP (Vdoc_directory))
return Qnil;
@@ -113,7 +110,7 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
/* Put the file name in NAME as a C string.
If it is relative, combine it with Vdoc_directory. */
- tem = Ffile_name_absolute_p (file);
+ Lisp_Object tem = Ffile_name_absolute_p (file);
file = ENCODE_FILE (file);
Lisp_Object docdir
= NILP (tem) ? ENCODE_FILE (Vdoc_directory) : empty_unibyte_string;
@@ -123,7 +120,7 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
name = SAFE_ALLOCA (docdir_sizemax + SBYTES (file));
lispstpcpy (lispstpcpy (name, docdir), file);
- fd = emacs_open (name, O_RDONLY, 0);
+ int fd = emacs_open (name, O_RDONLY, 0);
if (fd < 0)
{
if (will_dump_p ())
@@ -150,7 +147,7 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
/* Seek only to beginning of disk block. */
/* Make sure we read at least 1024 bytes before `position'
so we can check the leading text for consistency. */
- offset = min (position, max (1024, position % (8 * 1024)));
+ int offset = min (position, max (1024, position % (8 * 1024)));
if (TYPE_MAXIMUM (off_t) < position
|| lseek (fd, position - offset, 0) < 0)
error ("Position %"pI"d out of range in doc string file \"%s\"",
@@ -164,7 +161,6 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
{
ptrdiff_t space_left = (get_doc_string_buffer_size - 1
- (p - get_doc_string_buffer));
- int nread;
/* Allocate or grow the buffer if we need to. */
if (space_left <= 0)
@@ -182,7 +178,7 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
If we read the same block last time, maybe skip this? */
if (space_left > 1024 * 8)
space_left = 1024 * 8;
- nread = emacs_read_quit (fd, p, space_left);
+ int nread = emacs_read_quit (fd, p, space_left);
if (nread < 0)
report_file_error ("Read error on documentation file", file);
p[nread] = 0;
@@ -240,10 +236,8 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
{
if (*from == 1)
{
- int c;
-
from++;
- c = *from++;
+ int c = *from++;
if (c == 1)
*to++ = c;
else if (c == '0')
@@ -313,10 +307,8 @@ Unless a non-nil second argument RAW is given, the
string is passed through `substitute-command-keys'. */)
(Lisp_Object function, Lisp_Object raw)
{
- Lisp_Object fun;
- Lisp_Object funcar;
Lisp_Object doc;
- bool try_reload = 1;
+ bool try_reload = true;
documentation:
@@ -330,7 +322,7 @@ string is passed through `substitute-command-keys'. */)
raw);
}
- fun = Findirect_function (function, Qnil);
+ Lisp_Object fun = Findirect_function (function, Qnil);
if (NILP (fun))
xsignal1 (Qvoid_function, function);
if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
@@ -362,7 +354,7 @@ string is passed through `substitute-command-keys'. */)
}
else if (CONSP (fun))
{
- funcar = XCAR (fun);
+ Lisp_Object funcar = XCAR (fun);
if (!SYMBOLP (funcar))
xsignal1 (Qinvalid_function, fun);
else if (EQ (funcar, Qkeymap))
@@ -406,7 +398,7 @@ string is passed through `substitute-command-keys'. */)
try_reload = reread_doc_file (Fcar_safe (doc));
if (try_reload)
{
- try_reload = 0;
+ try_reload = false;
goto documentation;
}
}
@@ -430,7 +422,7 @@ This differs from `get' in that it can refer to strings stored in the
aren't strings. */)
(Lisp_Object symbol, Lisp_Object prop, Lisp_Object raw)
{
- bool try_reload = 1;
+ bool try_reload = true;
Lisp_Object tem;
documentation_property:
@@ -462,7 +454,7 @@ aren't strings. */)
try_reload = reread_doc_file (Fcar_safe (doc));
if (try_reload)
{
- try_reload = 0;
+ try_reload = false;
goto documentation_property;
}
}
@@ -492,9 +484,7 @@ store_function_docstring (Lisp_Object obj, EMACS_INT offset)
fun = XCDR (fun);
if (CONSP (fun))
{
- Lisp_Object tem;
-
- tem = XCAR (fun);
+ Lisp_Object tem = XCAR (fun);
if (EQ (tem, Qlambda) || EQ (tem, Qautoload)
|| (EQ (tem, Qclosure) && (fun = XCDR (fun), 1)))
{
@@ -682,37 +672,25 @@ default_to_grave_quoting_style (void)
&& EQ (AREF (dv, 0), make_fixnum ('`')));
}
-/* Return the current effective text quoting style. */
-enum text_quoting_style
-text_quoting_style (void)
+DEFUN ("text-quoting-style", Ftext_quoting_style,
+ Stext_quoting_style, 0, 0, 0,
+ doc: /* Return the current effective text quoting style.
+See variable `text-quoting-style'. */)
+ (void)
{
+ /* Use grave accent and apostrophe `like this'. */
if (NILP (Vtext_quoting_style)
? default_to_grave_quoting_style ()
: EQ (Vtext_quoting_style, Qgrave))
- return GRAVE_QUOTING_STYLE;
+ return Qgrave;
+
+ /* Use apostrophes 'like this'. */
else if (EQ (Vtext_quoting_style, Qstraight))
- return STRAIGHT_QUOTING_STYLE;
- else
- return CURVE_QUOTING_STYLE;
-}
+ return Qstraight;
-/* This is just a Lisp wrapper for text_quoting_style above. */
-DEFUN ("get-quoting-style", Fget_quoting_style,
- Sget_quoting_style, 0, 0, 0,
- doc: /* Return the current effective text quoting style.
-See variable `text-quoting-style'. */)
- (void)
-{
- switch (text_quoting_style ())
- {
- case STRAIGHT_QUOTING_STYLE:
- return Qstraight;
- case CURVE_QUOTING_STYLE:
- return Qcurve;
- case GRAVE_QUOTING_STYLE:
- default:
- return Qgrave;
- }
+ /* Use curved single quotes ‘like this’. */
+ else
+ return Qcurve;
}
@@ -755,5 +733,5 @@ otherwise. */);
defsubr (&Sdocumentation);
defsubr (&Sdocumentation_property);
defsubr (&Ssnarf_documentation);
- defsubr (&Sget_quoting_style);
+ defsubr (&Stext_quoting_style);
}
diff --git a/src/doprnt.c b/src/doprnt.c
index ce259d07cfe..b6b5978c891 100644
--- a/src/doprnt.c
+++ b/src/doprnt.c
@@ -1,7 +1,7 @@
/* Output like sprintf to a buffer of specified size. -*- coding: utf-8 -*-
Also takes args differently: pass one pointer to the end
of the format string in addition to the format string itself.
- Copyright (C) 1985, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1985, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -77,8 +77,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
where flags is [+ -0], width is [0-9]+, precision is .[0-9]+, and length
is empty or l or the value of the pD or pI or PRIdMAX (sans "d") macros.
A % that does not introduce a valid %-sequence causes undefined behavior.
- ASCII bytes in FORMAT other than % are copied through as-is;
- non-ASCII bytes should not appear in FORMAT.
+ Bytes in FORMAT other than % are copied through as-is.
The + flag character inserts a + before any positive number, while a space
inserts a space before any positive number; these flags only affect %d, %o,
@@ -175,7 +174,13 @@ doprnt_non_null_end (char *buffer, ptrdiff_t bufsize, char const *format,
Returns the number of bytes stored into BUFFER, excluding
the terminating null byte. Output is always null-terminated.
String arguments are passed as C strings.
- Integers are passed as C integers. */
+ Integers are passed as C integers.
+
+ FIXME: If FORMAT_END is not at a character boundary
+ doprnt_non_null_end will cut the string in the middle of the
+ character and the returned string will have an incomplete character
+ sequence at the end. We may prefer to cut at a character
+ boundary. */
ptrdiff_t
doprnt (char *buffer, ptrdiff_t bufsize, const char *format,
@@ -199,7 +204,7 @@ doprnt (char *buffer, ptrdiff_t bufsize, const char *format,
/* Buffer we have got with malloc. */
char *big_buffer = NULL;
- enum text_quoting_style quoting_style = text_quoting_style ();
+ Lisp_Object quoting_style = Ftext_quoting_style ();
bufsize--;
@@ -482,18 +487,29 @@ doprnt (char *buffer, ptrdiff_t bufsize, const char *format,
char const *src;
ptrdiff_t srclen;
- if (quoting_style == CURVE_QUOTING_STYLE && fmtchar == '`')
+ if (EQ (quoting_style, Qcurve) && fmtchar == '`')
src = uLSQM, srclen = sizeof uLSQM - 1;
- else if (quoting_style == CURVE_QUOTING_STYLE && fmtchar == '\'')
+ else if (EQ (quoting_style, Qcurve) && fmtchar == '\'')
src = uRSQM, srclen = sizeof uRSQM - 1;
- else
+ else if (! LEADING_CODE_P (fmtchar))
{
- if (quoting_style == STRAIGHT_QUOTING_STYLE && fmtchar == '`')
+ if (EQ (quoting_style, Qstraight) && fmtchar == '`')
fmtchar = '\'';
- eassert (ASCII_CHAR_P (fmtchar));
+
*bufptr++ = fmtchar;
continue;
}
+ else
+ {
+ int charlen = BYTES_BY_CHAR_HEAD (fmtchar);
+ src = fmt0;
+
+ /* If the format string ends in the middle of a multibyte
+ character we don't want to skip over the NUL byte. */
+ for (srclen = 1 ; *(src + srclen) != 0 && srclen < charlen ; srclen++);
+
+ fmt = src + srclen;
+ }
if (bufsize < srclen)
{
diff --git a/src/dosfns.c b/src/dosfns.c
index 7a6605dece6..10023c8c7f1 100644
--- a/src/dosfns.c
+++ b/src/dosfns.c
@@ -1,6 +1,6 @@
/* MS-DOS specific Lisp utilities. Coded by Manabu Higashida, 1991.
Major changes May-July 1993 Morten Welinder (only 10% original code left)
- Copyright (C) 1991, 1993, 1996-1998, 2001-2020 Free Software
+ Copyright (C) 1991, 1993, 1996-1998, 2001-2021 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/dosfns.h b/src/dosfns.h
index bae199b6f6c..6ad2a034707 100644
--- a/src/dosfns.h
+++ b/src/dosfns.h
@@ -2,7 +2,7 @@
Coded by Manabu Higashida, 1991.
Modified by Morten Welinder, 1993-1994.
-Copyright (C) 1991, 1994-1995, 1997, 1999, 2001-2020 Free Software
+Copyright (C) 1991, 1994-1995, 1997, 1999, 2001-2021 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/dynlib.c b/src/dynlib.c
index 4919d5cc726..86f8b7e2063 100644
--- a/src/dynlib.c
+++ b/src/dynlib.c
@@ -1,6 +1,6 @@
/* Portable API for dynamic loading.
-Copyright 2015-2020 Free Software Foundation, Inc.
+Copyright 2015-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/dynlib.h b/src/dynlib.h
index cb3454b5563..e20d8891a23 100644
--- a/src/dynlib.h
+++ b/src/dynlib.h
@@ -1,6 +1,6 @@
/* Portable API for dynamic loading.
-Copyright 2015-2020 Free Software Foundation, Inc.
+Copyright 2015-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/editfns.c b/src/editfns.c
index ca6b8981ebf..6f04c998915 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -1,6 +1,6 @@
/* Lisp functions pertaining to editing. -*- coding: utf-8 -*-
-Copyright (C) 1985-1987, 1989, 1993-2020 Free Software Foundation, Inc.
+Copyright (C) 1985-1987, 1989, 1993-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -188,11 +188,16 @@ DEFUN ("point-marker", Fpoint_marker, Spoint_marker, 0, 0, 0,
return build_marker (current_buffer, PT, PT_BYTE);
}
-DEFUN ("goto-char", Fgoto_char, Sgoto_char, 1, 1, "NGoto char: ",
+DEFUN ("goto-char", Fgoto_char, Sgoto_char, 1, 1,
+ "(goto-char--read-natnum-interactive \"Go to char: \")",
doc: /* Set point to POSITION, a number or marker.
Beginning of buffer is position (point-min), end is (point-max).
-The return value is POSITION. */)
+The return value is POSITION.
+
+If called interactively, a numeric prefix argument specifies
+POSITION; without a numeric prefix argument, read POSITION from the
+minibuffer. The default value is the number at point (if any). */)
(register Lisp_Object position)
{
if (MARKERP (position))
@@ -2117,6 +2122,13 @@ nil. */)
{
signal_after_change (BEGV, size_a, ZV - BEGV);
update_compositions (BEGV, ZV, CHECK_INSIDE);
+ /* We've locked the buffer's file above in
+ prepare_to_modify_buffer; if the buffer is unchanged at this
+ point, i.e. no insertions or deletions have been made, unlock
+ the file now. */
+ if (SAVE_MODIFF == MODIFF
+ && STRINGP (BVAR (a, file_truename)))
+ unlock_file (BVAR (a, file_truename));
}
return Qt;
@@ -3147,7 +3159,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
if (STRINGP (args[i]) && STRING_MULTIBYTE (args[i]))
multibyte = true;
- int quoting_style = message ? text_quoting_style () : -1;
+ Lisp_Object quoting_style = message ? Ftext_quoting_style () : Qnil;
ptrdiff_t ispec;
ptrdiff_t nspec = 0;
@@ -3767,7 +3779,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
unsigned char str[MAX_MULTIBYTE_LENGTH];
if ((format_char == '`' || format_char == '\'')
- && quoting_style == CURVE_QUOTING_STYLE)
+ && EQ (quoting_style, Qcurve))
{
if (! multibyte)
{
@@ -3778,7 +3790,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
convbytes = 3;
new_result = true;
}
- else if (format_char == '`' && quoting_style == STRAIGHT_QUOTING_STYLE)
+ else if (format_char == '`' && EQ (quoting_style, Qstraight))
{
convsrc = "'";
new_result = true;
diff --git a/src/emacs-icon.h b/src/emacs-icon.h
index c3fd7f3ce28..87790bbc29e 100644
--- a/src/emacs-icon.h
+++ b/src/emacs-icon.h
@@ -1,7 +1,7 @@
/* XPM */
/* Emacs icon
-Copyright (C) 2008-2020 Free Software Foundation, Inc.
+Copyright (C) 2008-2021 Free Software Foundation, Inc.
Author: Kentaro Ohkouchi <nanasess@fsm.ne.jp>
Nicolas Petton <nicolas@petton.fr>
diff --git a/src/emacs-module.c b/src/emacs-module.c
index 23b8e8620c9..894dffcf21e 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -1,6 +1,6 @@
/* emacs-module.c - Module loading and runtime implementation
-Copyright (C) 2015-2020 Free Software Foundation, Inc.
+Copyright (C) 2015-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -200,8 +200,6 @@ static AVOID module_abort (const char *, ...) ATTRIBUTE_FORMAT_PRINTF (1, 2);
static emacs_env *initialize_environment (emacs_env *,
struct emacs_env_private *);
static void finalize_environment (emacs_env *);
-static void finalize_environment_unwind (void *);
-static void finalize_runtime_unwind (void *);
static void module_handle_nonlocal_exit (emacs_env *, enum nonlocal_exit,
Lisp_Object);
static void module_non_local_exit_signal_1 (emacs_env *,
@@ -786,7 +784,8 @@ module_make_string (emacs_env *env, const char *str, ptrdiff_t len)
MODULE_FUNCTION_BEGIN (NULL);
if (! (0 <= len && len <= STRING_BYTES_BOUND))
overflow_error ();
- Lisp_Object lstr = module_decode_utf_8 (str, len);
+ Lisp_Object lstr
+ = len == 0 ? empty_multibyte_string : module_decode_utf_8 (str, len);
return lisp_to_value (env, lstr);
}
@@ -796,9 +795,8 @@ module_make_unibyte_string (emacs_env *env, const char *str, ptrdiff_t length)
MODULE_FUNCTION_BEGIN (NULL);
if (! (0 <= length && length <= STRING_BYTES_BOUND))
overflow_error ();
- Lisp_Object lstr = make_uninit_string (length);
- memcpy (SDATA (lstr), str, length);
- SDATA (lstr)[length] = 0;
+ Lisp_Object lstr
+ = length == 0 ? empty_unibyte_string : make_unibyte_string (str, length);
return lisp_to_value (env, lstr);
}
@@ -1089,10 +1087,6 @@ module_signal_or_throw (struct emacs_env_private *env)
}
}
-/* Live runtime and environment objects, for assertions. */
-static Lisp_Object Vmodule_runtimes;
-static Lisp_Object Vmodule_environments;
-
DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0,
doc: /* Load module FILE. */)
(Lisp_Object file)
@@ -1137,9 +1131,9 @@ DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0,
rt->private_members = &rt_priv;
rt->get_environment = module_get_environment;
- Vmodule_runtimes = Fcons (make_mint_ptr (rt), Vmodule_runtimes);
ptrdiff_t count = SPECPDL_INDEX ();
- record_unwind_protect_ptr (finalize_runtime_unwind, rt);
+ record_unwind_protect_module (SPECPDL_MODULE_RUNTIME, rt);
+ record_unwind_protect_module (SPECPDL_MODULE_ENVIRONMENT, rt_priv.env);
int r = module_init (rt);
@@ -1167,7 +1161,7 @@ funcall_module (Lisp_Object function, ptrdiff_t nargs, Lisp_Object *arglist)
struct emacs_env_private priv;
emacs_env *env = initialize_environment (&pub, &priv);
ptrdiff_t count = SPECPDL_INDEX ();
- record_unwind_protect_ptr (finalize_environment_unwind, env);
+ record_unwind_protect_module (SPECPDL_MODULE_ENVIRONMENT, env);
USE_SAFE_ALLOCA;
emacs_value *args = nargs > 0 ? SAFE_ALLOCA (nargs * sizeof *args) : NULL;
@@ -1243,12 +1237,13 @@ module_assert_runtime (struct emacs_runtime *runtime)
if (! module_assertions)
return;
ptrdiff_t count = 0;
- for (Lisp_Object tail = Vmodule_runtimes; CONSP (tail); tail = XCDR (tail))
- {
- if (xmint_pointer (XCAR (tail)) == runtime)
- return;
- ++count;
- }
+ for (const union specbinding *pdl = specpdl; pdl != specpdl_ptr; ++pdl)
+ if (pdl->kind == SPECPDL_MODULE_RUNTIME)
+ {
+ if (pdl->unwind_ptr.arg == runtime)
+ return;
+ ++count;
+ }
module_abort ("Runtime pointer not found in list of %"pD"d runtimes",
count);
}
@@ -1259,13 +1254,13 @@ module_assert_env (emacs_env *env)
if (! module_assertions)
return;
ptrdiff_t count = 0;
- for (Lisp_Object tail = Vmodule_environments; CONSP (tail);
- tail = XCDR (tail))
- {
- if (xmint_pointer (XCAR (tail)) == env)
- return;
- ++count;
- }
+ for (const union specbinding *pdl = specpdl; pdl != specpdl_ptr; ++pdl)
+ if (pdl->kind == SPECPDL_MODULE_ENVIRONMENT)
+ {
+ if (pdl->unwind_ptr.arg == env)
+ return;
+ ++count;
+ }
module_abort ("Environment pointer not found in list of %"pD"d environments",
count);
}
@@ -1323,22 +1318,22 @@ value_to_lisp (emacs_value v)
environments. */
ptrdiff_t num_environments = 0;
ptrdiff_t num_values = 0;
- for (Lisp_Object environments = Vmodule_environments;
- CONSP (environments); environments = XCDR (environments))
- {
- emacs_env *env = xmint_pointer (XCAR (environments));
- struct emacs_env_private *priv = env->private_members;
- /* The value might be one of the nonlocal exit values. Note
- that we don't check whether a nonlocal exit is currently
- pending, because the module might have cleared the flag
- in the meantime. */
- if (&priv->non_local_exit_symbol == v
- || &priv->non_local_exit_data == v)
- goto ok;
- if (value_storage_contains_p (&priv->storage, v, &num_values))
- goto ok;
- ++num_environments;
- }
+ for (const union specbinding *pdl = specpdl; pdl != specpdl_ptr; ++pdl)
+ if (pdl->kind == SPECPDL_MODULE_ENVIRONMENT)
+ {
+ const emacs_env *env = pdl->unwind_ptr.arg;
+ struct emacs_env_private *priv = env->private_members;
+ /* The value might be one of the nonlocal exit values. Note
+ that we don't check whether a nonlocal exit is currently
+ pending, because the module might have cleared the flag
+ in the meantime. */
+ if (&priv->non_local_exit_symbol == v
+ || &priv->non_local_exit_data == v)
+ goto ok;
+ if (value_storage_contains_p (&priv->storage, v, &num_values))
+ goto ok;
+ ++num_environments;
+ }
/* Also check global values. */
if (module_global_reference_p (v, &num_values))
goto ok;
@@ -1421,18 +1416,14 @@ allocate_emacs_value (emacs_env *env, Lisp_Object obj)
/* Mark all objects allocated from local environments so that they
don't get garbage-collected. */
void
-mark_modules (void)
+mark_module_environment (void *ptr)
{
- for (Lisp_Object tem = Vmodule_environments; CONSP (tem); tem = XCDR (tem))
- {
- emacs_env *env = xmint_pointer (XCAR (tem));
- struct emacs_env_private *priv = env->private_members;
- for (struct emacs_value_frame *frame = &priv->storage.initial;
- frame != NULL;
- frame = frame->next)
- for (int i = 0; i < frame->offset; ++i)
- mark_object (frame->objects[i].v);
- }
+ emacs_env *env = ptr;
+ struct emacs_env_private *priv = env->private_members;
+ for (struct emacs_value_frame *frame = &priv->storage.initial; frame != NULL;
+ frame = frame->next)
+ for (int i = 0; i < frame->offset; ++i)
+ mark_object (frame->objects[i].v);
}
@@ -1495,7 +1486,6 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv)
env->set_function_finalizer = module_set_function_finalizer;
env->open_channel = module_open_channel;
env->make_interactive = module_make_interactive;
- Vmodule_environments = Fcons (make_mint_ptr (env), Vmodule_environments);
return env;
}
@@ -1505,23 +1495,19 @@ static void
finalize_environment (emacs_env *env)
{
finalize_storage (&env->private_members->storage);
- eassert (xmint_pointer (XCAR (Vmodule_environments)) == env);
- Vmodule_environments = XCDR (Vmodule_environments);
}
-static void
+void
finalize_environment_unwind (void *env)
{
finalize_environment (env);
}
-static void
+void
finalize_runtime_unwind (void *raw_ert)
{
- struct emacs_runtime *ert = raw_ert;
- eassert (xmint_pointer (XCAR (Vmodule_runtimes)) == ert);
- Vmodule_runtimes = XCDR (Vmodule_runtimes);
- finalize_environment (ert->private_members->env);
+ /* No further cleanup is required, as the initial environment is
+ unwound separately. See the logic in Fmodule_load. */
}
@@ -1610,12 +1596,6 @@ syms_of_module (void)
DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD,
Qnil, false);
- staticpro (&Vmodule_runtimes);
- Vmodule_runtimes = Qnil;
-
- staticpro (&Vmodule_environments);
- Vmodule_environments = Qnil;
-
DEFSYM (Qmodule_load_failed, "module-load-failed");
Fput (Qmodule_load_failed, Qerror_conditions,
pure_list (Qmodule_load_failed, Qerror));
diff --git a/src/emacs-module.h.in b/src/emacs-module.h.in
index 6a39d507c84..2989b439109 100644
--- a/src/emacs-module.h.in
+++ b/src/emacs-module.h.in
@@ -1,6 +1,6 @@
/* emacs-module.h - GNU Emacs module API.
-Copyright (C) 2015-2020 Free Software Foundation, Inc.
+Copyright (C) 2015-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/emacs.c b/src/emacs.c
index e9e9661c398..77114271b27 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -1,6 +1,6 @@
/* Fully extensible Emacs, running on Unix, intended for GNU.
-Copyright (C) 1985-1987, 1993-1995, 1997-1999, 2001-2020 Free Software
+Copyright (C) 1985-1987, 1993-1995, 1997-1999, 2001-2021 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
@@ -170,7 +170,7 @@ static uintmax_t heap_bss_diff;
We mark being in the exec'd process by a daemon name argument of
form "--daemon=\nFD0,FD1\nNAME" where FD are the pipe file descriptors,
NAME is the original daemon name, if any. */
-#if defined NS_IMPL_COCOA || (defined HAVE_NTGUI && defined CYGWIN)
+#if defined NS_IMPL_COCOA || defined CYGWIN
# define DAEMON_MUST_EXEC
#endif
@@ -386,7 +386,14 @@ terminate_due_to_signal (int sig, int backtrace_limit)
totally_unblock_input ();
if (sig == SIGTERM || sig == SIGHUP || sig == SIGINT)
- Fkill_emacs (make_fixnum (sig));
+ {
+ /* Avoid abort in shut_down_emacs if we were interrupted
+ by SIGINT in noninteractive usage, as in that case we
+ don't care about the message stack. */
+ if (sig == SIGINT && noninteractive)
+ clear_message_stack ();
+ Fkill_emacs (make_fixnum (sig));
+ }
shut_down_emacs (sig, Qnil);
emacs_backtrace (backtrace_limit);
@@ -1268,7 +1275,7 @@ main (int argc, char **argv)
{
emacs_close (STDIN_FILENO);
emacs_close (STDOUT_FILENO);
- int result = emacs_open (term, O_RDWR, 0);
+ int result = emacs_open_noquit (term, O_RDWR, 0);
if (result != STDIN_FILENO
|| (fcntl (STDIN_FILENO, F_DUPFD_CLOEXEC, STDOUT_FILENO)
!= STDOUT_FILENO))
@@ -1949,12 +1956,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
syms_of_json ();
#endif
- keys_of_casefiddle ();
- keys_of_cmds ();
- keys_of_buffer ();
keys_of_keyboard ();
- keys_of_keymap ();
- keys_of_window ();
}
else
{
@@ -2358,10 +2360,13 @@ all of which are called before Emacs is actually killed. */
/* Fsignal calls emacs_abort () if it sees that waiting_for_input is
set. */
waiting_for_input = 0;
- if (noninteractive)
- safe_run_hooks (Qkill_emacs_hook);
- else
- run_hook (Qkill_emacs_hook);
+ if (!NILP (find_symbol_value (Qkill_emacs_hook)))
+ {
+ if (noninteractive)
+ safe_run_hooks (Qkill_emacs_hook);
+ else
+ call1 (Qrun_hook_query_error_with_timeout, Qkill_emacs_hook);
+ }
#ifdef HAVE_X_WINDOWS
/* Transfer any clipboards we own to the clipboard manager. */
@@ -2842,7 +2847,7 @@ from the parent process and its tty file descriptors. */)
int nfd;
/* Get rid of stdin, stdout and stderr. */
- nfd = emacs_open ("/dev/null", O_RDWR, 0);
+ nfd = emacs_open_noquit ("/dev/null", O_RDWR, 0);
err |= nfd < 0;
err |= dup2 (nfd, STDIN_FILENO) < 0;
err |= dup2 (nfd, STDOUT_FILENO) < 0;
@@ -2883,6 +2888,8 @@ syms_of_emacs (void)
DEFSYM (Qrisky_local_variable, "risky-local-variable");
DEFSYM (Qkill_emacs, "kill-emacs");
DEFSYM (Qkill_emacs_hook, "kill-emacs-hook");
+ DEFSYM (Qrun_hook_query_error_with_timeout,
+ "run-hook-query-error-with-timeout");
#ifdef HAVE_UNEXEC
defsubr (&Sdump_emacs);
diff --git a/src/emacsgtkfixed.c b/src/emacsgtkfixed.c
index ea9465d5536..996ded2acaa 100644
--- a/src/emacsgtkfixed.c
+++ b/src/emacsgtkfixed.c
@@ -1,7 +1,7 @@
/* A Gtk Widget that inherits GtkFixed, but can be shrunk.
This file is only use when compiling with Gtk+ 3.
-Copyright (C) 2011-2020 Free Software Foundation, Inc.
+Copyright (C) 2011-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/emacsgtkfixed.h b/src/emacsgtkfixed.h
index b230a4d4d8a..78879764d86 100644
--- a/src/emacsgtkfixed.h
+++ b/src/emacsgtkfixed.h
@@ -1,7 +1,7 @@
/* A Gtk Widget that inherits GtkFixed, but can be shrunk.
This file is only use when compiling with Gtk+ 3.
-Copyright (C) 2011-2020 Free Software Foundation, Inc.
+Copyright (C) 2011-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/epaths.in b/src/epaths.in
index 3cadd160ecf..1de1e05f253 100644
--- a/src/epaths.in
+++ b/src/epaths.in
@@ -1,6 +1,6 @@
/* Hey Emacs, this is -*- C -*- code! */
/*
-Copyright (C) 1993, 1995, 1997, 1999, 2001-2020 Free Software
+Copyright (C) 1993, 1995, 1997, 1999, 2001-2021 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/eval.c b/src/eval.c
index 76708e6e7e2..5bf3faebc85 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1,6 +1,6 @@
/* Evaluator for GNU Emacs Lisp interpreter.
-Copyright (C) 1985-1987, 1993-1995, 1999-2020 Free Software Foundation,
+Copyright (C) 1985-1987, 1993-1995, 1999-2021 Free Software Foundation,
Inc.
This file is part of GNU Emacs.
@@ -681,6 +681,10 @@ default_toplevel_binding (Lisp_Object symbol)
case SPECPDL_UNWIND_EXCURSION:
case SPECPDL_UNWIND_VOID:
case SPECPDL_BACKTRACE:
+#ifdef HAVE_MODULES
+ case SPECPDL_MODULE_RUNTIME:
+ case SPECPDL_MODULE_ENVIRONMENT:
+#endif
case SPECPDL_LET_LOCAL:
break;
@@ -691,6 +695,49 @@ default_toplevel_binding (Lisp_Object symbol)
return binding;
}
+/* Look for a lexical-binding of SYMBOL somewhere up the stack.
+ This will only find bindings created with interpreted code, since once
+ compiled names of lexical variables are basically gone anyway. */
+static bool
+lexbound_p (Lisp_Object symbol)
+{
+ union specbinding *pdl = specpdl_ptr;
+ while (pdl > specpdl)
+ {
+ switch ((--pdl)->kind)
+ {
+ case SPECPDL_LET_DEFAULT:
+ case SPECPDL_LET:
+ if (EQ (specpdl_symbol (pdl), Qinternal_interpreter_environment))
+ {
+ Lisp_Object env = specpdl_old_value (pdl);
+ if (CONSP (env) && !NILP (Fassq (symbol, env)))
+ return true;
+ }
+ break;
+
+ case SPECPDL_UNWIND:
+ case SPECPDL_UNWIND_ARRAY:
+ case SPECPDL_UNWIND_PTR:
+ case SPECPDL_UNWIND_INT:
+ case SPECPDL_UNWIND_INTMAX:
+ case SPECPDL_UNWIND_EXCURSION:
+ case SPECPDL_UNWIND_VOID:
+ case SPECPDL_BACKTRACE:
+#ifdef HAVE_MODULES
+ case SPECPDL_MODULE_RUNTIME:
+ case SPECPDL_MODULE_ENVIRONMENT:
+#endif
+ case SPECPDL_LET_LOCAL:
+ break;
+
+ default:
+ emacs_abort ();
+ }
+ }
+ return false;
+}
+
DEFUN ("default-toplevel-value", Fdefault_toplevel_value, Sdefault_toplevel_value, 1, 1, 0,
doc: /* Return SYMBOL's toplevel default value.
"Toplevel" means outside of any let binding. */)
@@ -726,6 +773,15 @@ This is like `defvar' and `defconst' but without affecting the variable's
value. */)
(Lisp_Object symbol, Lisp_Object doc)
{
+ if (!XSYMBOL (symbol)->u.s.declared_special
+ && lexbound_p (symbol))
+ /* This test tries to catch the situation where we do
+ (let ((<foo-var> ...)) ...(<foo-function> ...)....)
+ and where the `foo` package only gets loaded when <foo-function>
+ is called, so the outer `let` incorrectly made the binding lexical
+ because the <foo-var> wasn't yet declared as dynamic at that point. */
+ error ("Defining as dynamic an already lexical var");
+
XSYMBOL (symbol)->u.s.declared_special = true;
if (!NILP (doc))
{
@@ -1111,9 +1167,18 @@ Lisp_Object
internal_catch (Lisp_Object tag,
Lisp_Object (*func) (Lisp_Object), Lisp_Object arg)
{
+ /* MINIBUFFER_QUIT_LEVEL is to handle quitting from nested minibuffers by
+ throwing t to tag `exit'.
+ Value -1 means there is no (throw 'exit t) in progress;
+ 0 means the `throw' wasn't done from an active minibuffer;
+ N > 0 means the `throw' was done from the minibuffer at level N. */
+ static EMACS_INT minibuffer_quit_level = -1;
/* This structure is made part of the chain `catchlist'. */
struct handler *c = push_handler (tag, CATCHER);
+ if (EQ (tag, Qexit))
+ minibuffer_quit_level = -1;
+
/* Call FUNC. */
if (! sys_setjmp (c->jmp))
{
@@ -1127,6 +1192,23 @@ internal_catch (Lisp_Object tag,
Lisp_Object val = handlerlist->val;
clobbered_eassert (handlerlist == c);
handlerlist = handlerlist->next;
+ if (EQ (tag, Qexit) && EQ (val, Qt))
+ /* If we've thrown t to tag `exit' from within a minibuffer, we
+ exit all minibuffers more deeply nested than the current
+ one. */
+ {
+ EMACS_INT mini_depth = this_minibuffer_depth (Qnil);
+ if (mini_depth && mini_depth != minibuffer_quit_level)
+ {
+ if (minibuffer_quit_level == -1)
+ minibuffer_quit_level = mini_depth;
+ if (minibuffer_quit_level
+ && (minibuf_level > minibuffer_quit_level))
+ Fthrow (Qexit, Qt);
+ }
+ else
+ minibuffer_quit_level = -1;
+ }
return val;
}
}
@@ -1653,6 +1735,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit)
break;
}
+ bool debugger_called = false;
if (/* Don't run the debugger for a memory-full error.
(There is no room in memory to do that!) */
!NILP (error_symbol)
@@ -1666,7 +1749,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit)
if requested". */
|| EQ (h->tag_or_ch, Qerror)))
{
- bool debugger_called
+ debugger_called
= maybe_call_debugger (conditions, error_symbol, data);
/* We can't return values to code which signaled an error, but we
can continue code which has signaled a quit. */
@@ -1674,6 +1757,23 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit)
return Qnil;
}
+ /* If we're in batch mode, print a backtrace unconditionally to help
+ with debugging. Make sure to use `debug' unconditionally to not
+ interfere with ERT or other packages that install custom
+ debuggers. Don't try to call the debugger while dumping or
+ bootstrapping, it wouldn't work anyway. */
+ if (!debugger_called && !NILP (error_symbol)
+ && (NILP (clause) || EQ (h->tag_or_ch, Qerror))
+ && noninteractive && backtrace_on_error_noninteractive
+ && !will_dump_p () && !will_bootstrap_p ()
+ && NILP (Vinhibit_debugger))
+ {
+ ptrdiff_t count = SPECPDL_INDEX ();
+ specbind (Vdebugger, Qdebug);
+ call_debugger (list2 (Qerror, Fcons (error_symbol, data)));
+ unbind_to (count, Qnil);
+ }
+
if (!NILP (clause))
{
Lisp_Object unwind_data
@@ -3432,6 +3532,15 @@ record_unwind_protect_void (void (*function) (void))
}
void
+record_unwind_protect_module (enum specbind_tag kind, void *ptr)
+{
+ specpdl_ptr->kind = kind;
+ specpdl_ptr->unwind_ptr.func = NULL;
+ specpdl_ptr->unwind_ptr.arg = ptr;
+ grow_specpdl ();
+}
+
+void
rebind_for_thread_switch (void)
{
union specbinding *bind;
@@ -3481,6 +3590,14 @@ do_one_unbind (union specbinding *this_binding, bool unwinding,
break;
case SPECPDL_BACKTRACE:
break;
+#ifdef HAVE_MODULES
+ case SPECPDL_MODULE_RUNTIME:
+ finalize_runtime_unwind (this_binding->unwind_ptr.arg);
+ break;
+ case SPECPDL_MODULE_ENVIRONMENT:
+ finalize_environment_unwind (this_binding->unwind_ptr.arg);
+ break;
+#endif
case SPECPDL_LET:
{ /* If variable has a trivial value (no forwarding), and isn't
trapped, we can just set it. */
@@ -3811,6 +3928,10 @@ backtrace_eval_unrewind (int distance)
case SPECPDL_UNWIND_INTMAX:
case SPECPDL_UNWIND_VOID:
case SPECPDL_BACKTRACE:
+#ifdef HAVE_MODULES
+ case SPECPDL_MODULE_RUNTIME:
+ case SPECPDL_MODULE_ENVIRONMENT:
+#endif
break;
case SPECPDL_LET:
{ /* If variable has a trivial value (no forwarding), we can
@@ -3946,6 +4067,10 @@ NFRAMES and BASE specify the activation frame to use, as in `backtrace-frame'.
case SPECPDL_UNWIND_EXCURSION:
case SPECPDL_UNWIND_VOID:
case SPECPDL_BACKTRACE:
+#ifdef HAVE_MODULES
+ case SPECPDL_MODULE_RUNTIME:
+ case SPECPDL_MODULE_ENVIRONMENT:
+#endif
break;
default:
@@ -3992,6 +4117,14 @@ mark_specpdl (union specbinding *first, union specbinding *ptr)
}
break;
+#ifdef HAVE_MODULES
+ case SPECPDL_MODULE_RUNTIME:
+ break;
+ case SPECPDL_MODULE_ENVIRONMENT:
+ mark_module_environment (pdl->unwind_ptr.arg);
+ break;
+#endif
+
case SPECPDL_LET_DEFAULT:
case SPECPDL_LET_LOCAL:
mark_object (specpdl_where (pdl));
@@ -4162,6 +4295,14 @@ Note that `debug-on-error', `debug-on-quit' and friends
still determine whether to handle the particular condition. */);
Vdebug_on_signal = Qnil;
+ DEFVAR_BOOL ("backtrace-on-error-noninteractive",
+ backtrace_on_error_noninteractive,
+ doc: /* Non-nil means print backtrace on error in batch mode.
+If this is nil, errors in batch mode will just print the error
+message upon encountering an unhandled error, without showing
+the Lisp backtrace. */);
+ backtrace_on_error_noninteractive = true;
+
/* The value of num_nonmacro_input_events as of the last time we
started to enter the debugger. If we decide to enter the debugger
again when this is still equal to num_nonmacro_input_events, then we
diff --git a/src/fileio.c b/src/fileio.c
index 283813ff89e..741e297d29c 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -1,6 +1,6 @@
/* File IO for GNU Emacs.
-Copyright (C) 1985-1988, 1993-2020 Free Software Foundation, Inc.
+Copyright (C) 1985-1988, 1993-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -3050,7 +3050,6 @@ file_accessible_directory_p (Lisp_Object file)
ptrdiff_t len = SBYTES (file);
char const *dir;
bool ok;
- int saved_errno;
USE_SAFE_ALLOCA;
/* Normally a file "FOO" is an accessible directory if "FOO/." exists.
@@ -3075,9 +3074,7 @@ file_accessible_directory_p (Lisp_Object file)
}
ok = file_access_p (dir, F_OK);
- saved_errno = errno;
SAFE_FREE ();
- errno = saved_errno;
return ok;
#endif /* !DOS_NT */
}
@@ -3757,9 +3754,10 @@ characters in the buffer. If VISIT is non-nil, BEG and END must be nil.
If optional fifth argument REPLACE is non-nil, replace the current
buffer contents (in the accessible portion) with the file contents.
This is better than simply deleting and inserting the whole thing
-because (1) it preserves some marker positions and (2) it puts less data
-in the undo list. When REPLACE is non-nil, the second return value is
-the number of characters that replace previous buffer contents.
+because (1) it preserves some marker positions (in unchanged portions
+at the start and end of the buffer) and (2) it puts less data in the
+undo list. When REPLACE is non-nil, the second return value is the
+number of characters that replace previous buffer contents.
This function does code conversion according to the value of
`coding-system-for-read' or `file-coding-system-alist', and sets the
@@ -4003,7 +4001,7 @@ by calling `format-decode', which see. */)
record_unwind_current_buffer ();
- workbuf = Fget_buffer_create (name);
+ workbuf = Fget_buffer_create (name, Qt);
buf = XBUFFER (workbuf);
delete_all_overlays (buf);
@@ -5751,7 +5749,7 @@ auto_save_error (Lisp_Object error_val)
Lisp_Object msg = CALLN (Fformat, format, BVAR (current_buffer, name),
Ferror_message_string (error_val));
call3 (intern ("display-warning"),
- intern ("auto-save"), msg, intern ("error"));
+ intern ("auto-save"), msg, intern (":error"));
return Qnil;
}
@@ -6258,6 +6256,7 @@ syms_of_fileio (void)
DEFSYM (Qfile_date_error, "file-date-error");
DEFSYM (Qfile_missing, "file-missing");
DEFSYM (Qfile_notify_error, "file-notify-error");
+ DEFSYM (Qremote_file_error, "remote-file-error");
DEFSYM (Qexcl, "excl");
DEFVAR_LISP ("file-name-coding-system", Vfile_name_coding_system,
@@ -6319,6 +6318,11 @@ behaves as if file names were encoded in `utf-8'. */);
Fput (Qfile_notify_error, Qerror_message,
build_pure_c_string ("File notification error"));
+ Fput (Qremote_file_error, Qerror_conditions,
+ Fpurecopy (list3 (Qremote_file_error, Qfile_error, Qerror)));
+ Fput (Qremote_file_error, Qerror_message,
+ build_pure_c_string ("Remote file error"));
+
DEFVAR_LISP ("file-name-handler-alist", Vfile_name_handler_alist,
doc: /* Alist of elements (REGEXP . HANDLER) for file names handled specially.
If a file name matches REGEXP, all I/O on that file is done by calling
diff --git a/src/filelock.c b/src/filelock.c
index 39febd366d8..35baa0c6668 100644
--- a/src/filelock.c
+++ b/src/filelock.c
@@ -1,6 +1,6 @@
/* Lock files for editing.
-Copyright (C) 1985-1987, 1993-1994, 1996, 1998-2020 Free Software
+Copyright (C) 1985-1987, 1993-1994, 1996, 1998-2021 Free Software
Foundation, Inc.
Author: Richard King
diff --git a/src/firstfile.c b/src/firstfile.c
index 9dc70df9d3c..2733e1b5d64 100644
--- a/src/firstfile.c
+++ b/src/firstfile.c
@@ -1,5 +1,5 @@
/* Mark beginning of data space to dump as pure, for GNU Emacs.
- Copyright (C) 1997, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/floatfns.c b/src/floatfns.c
index 235e3b4cdfe..aadae4fd9d6 100644
--- a/src/floatfns.c
+++ b/src/floatfns.c
@@ -1,6 +1,6 @@
/* Primitive operations on floating point for GNU Emacs Lisp interpreter.
-Copyright (C) 1988, 1993-1994, 1999, 2001-2020 Free Software Foundation,
+Copyright (C) 1988, 1993-1994, 1999, 2001-2021 Free Software Foundation,
Inc.
Author: Wolfgang Rupprecht (according to ack.texi)
diff --git a/src/fns.c b/src/fns.c
index f50bf8ecb77..7ab2e8f1a03 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -1,6 +1,6 @@
/* Random utility Lisp functions.
-Copyright (C) 1985-1987, 1993-1995, 1997-2020 Free Software Foundation,
+Copyright (C) 1985-1987, 1993-1995, 1997-2021 Free Software Foundation,
Inc.
This file is part of GNU Emacs.
@@ -105,9 +105,14 @@ list_length (Lisp_Object list)
DEFUN ("length", Flength, Slength, 1, 1, 0,
doc: /* Return the length of vector, list or string SEQUENCE.
A byte-code function object is also allowed.
+
If the string contains multibyte characters, this is not necessarily
the number of bytes in the string; it is the number of characters.
-To get the number of bytes, use `string-bytes'. */)
+To get the number of bytes, use `string-bytes'.
+
+If the length of a list is being computed to compare to a (small)
+number, the `length<', `length>' and `length=' functions may be more
+efficient. */)
(Lisp_Object sequence)
{
EMACS_INT val;
@@ -145,6 +150,75 @@ least the number of distinct elements. */)
return make_fixnum (len);
}
+static inline
+EMACS_INT length_internal (Lisp_Object sequence, int len)
+{
+ /* If LENGTH is short (arbitrarily chosen cut-off point), use a
+ fast loop that doesn't care about whether SEQUENCE is
+ circular or not. */
+ if (len < 0xffff)
+ while (CONSP (sequence))
+ {
+ if (--len <= 0)
+ return -1;
+ sequence = XCDR (sequence);
+ }
+ /* Signal an error on circular lists. */
+ else
+ FOR_EACH_TAIL (sequence)
+ if (--len <= 0)
+ return -1;
+ return len;
+}
+
+DEFUN ("length<", Flength_less, Slength_less, 2, 2, 0,
+ doc: /* Return non-nil if SEQUENCE is shorter than LENGTH.
+See `length' for allowed values of SEQUENCE and how elements are
+counted. */)
+ (Lisp_Object sequence, Lisp_Object length)
+{
+ CHECK_FIXNUM (length);
+ EMACS_INT len = XFIXNUM (length);
+
+ if (CONSP (sequence))
+ return length_internal (sequence, len) == -1? Qnil: Qt;
+ else
+ return XFIXNUM (Flength (sequence)) < len? Qt: Qnil;
+}
+
+DEFUN ("length>", Flength_greater, Slength_greater, 2, 2, 0,
+ doc: /* Return non-nil if SEQUENCE is longer than LENGTH.
+See `length' for allowed values of SEQUENCE and how elements are
+counted. */)
+ (Lisp_Object sequence, Lisp_Object length)
+{
+ CHECK_FIXNUM (length);
+ EMACS_INT len = XFIXNUM (length);
+
+ if (CONSP (sequence))
+ return length_internal (sequence, len + 1) == -1? Qt: Qnil;
+ else
+ return XFIXNUM (Flength (sequence)) > len? Qt: Qnil;
+}
+
+DEFUN ("length=", Flength_equal, Slength_equal, 2, 2, 0,
+ doc: /* Return non-nil if SEQUENCE has length equal to LENGTH.
+See `length' for allowed values of SEQUENCE and how elements are
+counted. */)
+ (Lisp_Object sequence, Lisp_Object length)
+{
+ CHECK_FIXNUM (length);
+ EMACS_INT len = XFIXNUM (length);
+
+ if (len < 0)
+ return Qnil;
+
+ if (CONSP (sequence))
+ return length_internal (sequence, len + 1) == 1? Qt: Qnil;
+ else
+ return XFIXNUM (Flength (sequence)) == len? Qt: Qnil;
+}
+
DEFUN ("proper-list-p", Fproper_list_p, Sproper_list_p, 1, 1, 0,
doc: /* Return OBJECT's length if it is a proper list, nil otherwise.
A proper list is neither circular nor dotted (i.e., its last cdr is nil). */
@@ -4525,16 +4599,34 @@ sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p)
EMACS_UINT
hash_string (char const *ptr, ptrdiff_t len)
{
- char const *p = ptr;
- char const *end = p + len;
- unsigned char c;
- EMACS_UINT hash = 0;
+ EMACS_UINT const *p = (EMACS_UINT const *) ptr;
+ EMACS_UINT const *end = (EMACS_UINT const *) (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);
- while (p != end)
+ /* Beware: `end` might be unaligned, so `p < end` is not always the same
+ * as `p <= end - 1`. */
+ while (p <= end - 1)
{
- c = *p++;
+ EMACS_UINT c = *p;
+ 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);
+ }
return hash;
}
@@ -5418,7 +5510,8 @@ disregarding any coding systems. If nil, use the current buffer.
This function is useful for comparing two buffers running in the same
Emacs, but is not guaranteed to return the same hash between different
-Emacs versions.
+Emacs versions. It should be somewhat more efficient on larger
+buffers than `secure-hash' is, and should not allocate more memory.
It should not be used for anything security-related. See
`secure-hash' for these applications. */ )
@@ -5455,6 +5548,90 @@ It should not be used for anything security-related. See
return make_digest_string (digest, SHA1_DIGEST_SIZE);
}
+DEFUN ("buffer-line-statistics", Fbuffer_line_statistics,
+ Sbuffer_line_statistics, 0, 1, 0,
+ doc: /* Return data about lines in BUFFER.
+The data is returned as a list, and the first element is the number of
+lines in the buffer, the second is the length of the longest line, and
+the third is the mean line length. The lengths returned are in bytes, not
+characters. */ )
+ (Lisp_Object buffer_or_name)
+{
+ Lisp_Object buffer;
+ ptrdiff_t lines = 0, longest = 0;
+ double mean = 0;
+ struct buffer *b;
+
+ if (NILP (buffer_or_name))
+ buffer = Fcurrent_buffer ();
+ else
+ buffer = Fget_buffer (buffer_or_name);
+ if (NILP (buffer))
+ nsberror (buffer_or_name);
+
+ b = XBUFFER (buffer);
+
+ unsigned char *start = BUF_BEG_ADDR (b);
+ ptrdiff_t area = BUF_GPT_BYTE (b) - BUF_BEG_BYTE (b), pre_gap = 0;
+
+ /* Process the first part of the buffer. */
+ while (area > 0)
+ {
+ unsigned char *n = memchr (start, '\n', area);
+
+ if (n)
+ {
+ ptrdiff_t this_line = n - start;
+ if (this_line > longest)
+ longest = this_line;
+ lines++;
+ /* Blame Knuth. */
+ mean = mean + (this_line - mean) / lines;
+ area = area - this_line - 1;
+ start += this_line + 1;
+ }
+ else
+ {
+ /* Didn't have a newline here, so save the rest for the
+ post-gap calculation. */
+ pre_gap = area;
+ area = 0;
+ }
+ }
+
+ /* If the gap is before the end of the buffer, process the last half
+ of the buffer. */
+ if (BUF_GPT_BYTE (b) < BUF_Z_BYTE (b))
+ {
+ start = BUF_GAP_END_ADDR (b);
+ area = BUF_Z_ADDR (b) - BUF_GAP_END_ADDR (b);
+
+ while (area > 0)
+ {
+ unsigned char *n = memchr (start, '\n', area);
+ ptrdiff_t this_line = n? n - start + pre_gap: area + pre_gap;
+
+ if (this_line > longest)
+ longest = this_line;
+ lines++;
+ /* Blame Knuth again. */
+ mean = mean + (this_line - mean) / lines;
+ area = area - this_line - 1;
+ start += this_line + 1;
+ pre_gap = 0;
+ }
+ }
+ else if (pre_gap > 0)
+ {
+ if (pre_gap > longest)
+ longest = pre_gap;
+ lines++;
+ mean = mean + (pre_gap - mean) / lines;
+ }
+
+ return list3 (make_int (lines), make_int (longest), make_float (mean));
+}
+
static bool
string_ascii_p (Lisp_Object string)
{
@@ -5502,25 +5679,32 @@ Case is always significant and text properties are ignored. */)
haybytes = SBYTES (haystack) - start_byte;
/* We can do a direct byte-string search if both strings have the
- same multibyteness, or if at least one of them consists of ASCII
- characters only. */
+ same multibyteness, or if the needle consists of ASCII characters only. */
if (STRING_MULTIBYTE (haystack)
? (STRING_MULTIBYTE (needle)
|| SCHARS (haystack) == SBYTES (haystack) || string_ascii_p (needle))
: (!STRING_MULTIBYTE (needle)
- || SCHARS (needle) == SBYTES (needle) || string_ascii_p (haystack)))
- res = memmem (haystart, haybytes,
- SSDATA (needle), SBYTES (needle));
- else if (STRING_MULTIBYTE (haystack)) /* unibyte needle */
+ || SCHARS (needle) == SBYTES (needle)))
+ {
+ if (STRING_MULTIBYTE (haystack) && STRING_MULTIBYTE (needle)
+ && SCHARS (haystack) == SBYTES (haystack)
+ && SCHARS (needle) != SBYTES (needle))
+ /* Multibyte non-ASCII needle, multibyte ASCII haystack: impossible. */
+ return Qnil;
+ else
+ res = memmem (haystart, haybytes,
+ SSDATA (needle), SBYTES (needle));
+ }
+ else if (STRING_MULTIBYTE (haystack)) /* unibyte non-ASCII needle */
{
Lisp_Object multi_needle = string_to_multibyte (needle);
res = memmem (haystart, haybytes,
SSDATA (multi_needle), SBYTES (multi_needle));
}
- else /* unibyte haystack, multibyte needle */
+ else /* unibyte haystack, multibyte non-ASCII needle */
{
/* The only possible way we can find the multibyte needle in the
- unibyte stack (since we know that neither are pure-ASCII) is
+ unibyte stack (since we know that the needle is non-ASCII) is
if they contain "raw bytes" (and no other non-ASCII chars.) */
ptrdiff_t nbytes = SBYTES (needle);
for (ptrdiff_t i = 0; i < nbytes; i++)
@@ -5544,6 +5728,40 @@ Case is always significant and text properties are ignored. */)
return make_int (string_byte_to_char (haystack, res - SSDATA (haystack)));
}
+
+static void
+collect_interval (INTERVAL interval, Lisp_Object collector)
+{
+ nconc2 (collector,
+ list1(list3 (make_fixnum (interval->position),
+ make_fixnum (interval->position + LENGTH (interval)),
+ interval->plist)));
+}
+
+DEFUN ("object-intervals", Fobject_intervals, Sobject_intervals, 1, 1, 0,
+ doc: /* Return a copy of the text properties of OBJECT.
+OBJECT must be a buffer or a string.
+
+Altering this copy does not change the layout of the text properties
+in OBJECT. */)
+ (register Lisp_Object object)
+{
+ Lisp_Object collector = Fcons (Qnil, Qnil);
+ INTERVAL intervals;
+
+ if (STRINGP (object))
+ intervals = string_intervals (object);
+ else if (BUFFERP (object))
+ intervals = buffer_intervals (XBUFFER (object));
+ else
+ wrong_type_argument (Qbuffer_or_string_p, object);
+
+ if (! intervals)
+ return Qnil;
+
+ traverse_intervals (intervals, 0, collect_interval, collector);
+ return CDR (collector);
+}
void
@@ -5585,6 +5803,7 @@ syms_of_fns (void)
defsubr (&Smaphash);
defsubr (&Sdefine_hash_table_test);
defsubr (&Sstring_search);
+ defsubr (&Sobject_intervals);
/* Crypto and hashing stuff. */
DEFSYM (Qiv_auto, "iv-auto");
@@ -5660,6 +5879,9 @@ this variable. */);
defsubr (&Srandom);
defsubr (&Slength);
defsubr (&Ssafe_length);
+ defsubr (&Slength_less);
+ defsubr (&Slength_greater);
+ defsubr (&Slength_equal);
defsubr (&Sproper_list_p);
defsubr (&Sstring_bytes);
defsubr (&Sstring_distance);
@@ -5733,4 +5955,5 @@ this variable. */);
defsubr (&Ssecure_hash);
defsubr (&Sbuffer_hash);
defsubr (&Slocale_info);
+ defsubr (&Sbuffer_line_statistics);
}
diff --git a/src/font.c b/src/font.c
index 8dbf8cb8999..a59ebe216b8 100644
--- a/src/font.c
+++ b/src/font.c
@@ -1,6 +1,6 @@
/* font.c -- "Font" primitives.
-Copyright (C) 2006-2020 Free Software Foundation, Inc.
+Copyright (C) 2006-2021 Free Software Foundation, Inc.
Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H13PRO009
@@ -3945,6 +3945,23 @@ VALUE must be a non-negative integer or a floating point number
specifying the font size. It specifies the font size in pixels (if
VALUE is an integer), or in points (if VALUE is a float).
+`:dpi'
+
+VALUE must be a non-negative number that specifies the resolution
+(dot per inch) for which the font is designed.
+
+`:spacing'
+
+VALUE specifies the spacing of the font: mono, proportional, charcell,
+or dual. It can be either a number (0 for proportional, 90 for dual,
+100 for mono, 110 for charcell) or a 1-letter symbol: `P', `D', `M',
+or `C' (lower-case variants are also accepted).
+
+`:avgwidth'
+
+VALUE must be a non-negative integer specifying the average width of
+the font in 1/10 pixel units.
+
`:name'
VALUE must be a string of XLFD-style or fontconfig-style font name.
diff --git a/src/font.h b/src/font.h
index 8614e7fa10a..d3e15306427 100644
--- a/src/font.h
+++ b/src/font.h
@@ -1,5 +1,5 @@
/* font.h -- Interface definition for font handling.
- Copyright (C) 2006-2020 Free Software Foundation, Inc.
+ Copyright (C) 2006-2021 Free Software Foundation, Inc.
Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H13PRO009
diff --git a/src/fontset.c b/src/fontset.c
index 8c86075c07e..332be6c39d1 100644
--- a/src/fontset.c
+++ b/src/fontset.c
@@ -1,6 +1,6 @@
/* Fontset handler.
-Copyright (C) 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 2001-2021 Free Software Foundation, Inc.
Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
2005, 2006, 2007, 2008, 2009, 2010, 2011
National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/src/fontset.h b/src/fontset.h
index f8a6b1d62d2..42cca50d381 100644
--- a/src/fontset.h
+++ b/src/fontset.h
@@ -1,5 +1,5 @@
/* Header for fontset handler.
- Copyright (C) 1998, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1998, 2001-2021 Free Software Foundation, Inc.
Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
2005, 2006, 2007, 2008, 2009, 2010, 2011
National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/src/frame.c b/src/frame.c
index 7c377da4456..599c4075f88 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -1,6 +1,6 @@
/* Generic frame functions.
-Copyright (C) 1993-1995, 1997, 1999-2020 Free Software Foundation, Inc.
+Copyright (C) 1993-1995, 1997, 1999-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -1426,11 +1426,15 @@ do_switch_frame (Lisp_Object frame, int track, int for_deletion, Lisp_Object nor
if (FRAMEP (gfocus))
{
focus = FRAME_FOCUS_FRAME (XFRAME (gfocus));
- if ((FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ())
+ if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ())
/* Redirect frame focus also when FRAME has its minibuffer
- window on the selected frame (see Bug#24500). */
+ window on the selected frame (see Bug#24500).
+
+ Don't do that: It causes redirection problem with a
+ separate minibuffer frame (Bug#24803) and problems
+ when updating the cursor on such frames.
|| (NILP (focus)
- && EQ (FRAME_MINIBUF_WINDOW (f), sf->selected_window)))
+ && EQ (FRAME_MINIBUF_WINDOW (f), sf->selected_window))) */
Fredirect_frame_focus (gfocus, frame);
}
}
@@ -1482,6 +1486,7 @@ do_switch_frame (Lisp_Object frame, int track, int for_deletion, Lisp_Object nor
#endif
internal_last_event_frame = Qnil;
+ move_minibuffer_onto_frame ();
return frame;
}
@@ -2567,23 +2572,30 @@ before calling this function on it, like this.
int yval = check_integer_range (y, INT_MIN, INT_MAX);
/* I think this should be done with a hook. */
-#ifdef HAVE_WINDOW_SYSTEM
if (FRAME_WINDOW_P (XFRAME (frame)))
- /* Warping the mouse will cause enternotify and focus events. */
- frame_set_mouse_position (XFRAME (frame), xval, yval);
-#elif defined MSDOS
- if (FRAME_MSDOS_P (XFRAME (frame)))
+ {
+#ifdef HAVE_WINDOW_SYSTEM
+ /* Warping the mouse will cause enternotify and focus events. */
+ frame_set_mouse_position (XFRAME (frame), xval, yval);
+#endif /* HAVE_WINDOW_SYSTEM */
+ }
+#ifdef MSDOS
+ else if (FRAME_MSDOS_P (XFRAME (frame)))
{
Fselect_frame (frame, Qnil);
mouse_moveto (xval, yval);
}
-#elif defined HAVE_GPM
- Fselect_frame (frame, Qnil);
- term_mouse_moveto (xval, yval);
+#endif /* MSDOS */
+ else
+ {
+ Fselect_frame (frame, Qnil);
+#ifdef HAVE_GPM
+ term_mouse_moveto (xval, yval);
#else
- (void) xval;
- (void) yval;
-#endif
+ (void) xval;
+ (void) yval;
+#endif /* HAVE_GPM */
+ }
return Qnil;
}
@@ -2605,23 +2617,31 @@ before calling this function on it, like this.
int yval = check_integer_range (y, INT_MIN, INT_MAX);
/* I think this should be done with a hook. */
-#ifdef HAVE_WINDOW_SYSTEM
if (FRAME_WINDOW_P (XFRAME (frame)))
- /* Warping the mouse will cause enternotify and focus events. */
- frame_set_mouse_pixel_position (XFRAME (frame), xval, yval);
-#elif defined MSDOS
- if (FRAME_MSDOS_P (XFRAME (frame)))
+ {
+ /* Warping the mouse will cause enternotify and focus events. */
+#ifdef HAVE_WINDOW_SYSTEM
+ frame_set_mouse_pixel_position (XFRAME (frame), xval, yval);
+#endif /* HAVE_WINDOW_SYSTEM */
+ }
+#ifdef MSDOS
+ else if (FRAME_MSDOS_P (XFRAME (frame)))
{
Fselect_frame (frame, Qnil);
mouse_moveto (xval, yval);
}
-#elif defined HAVE_GPM
- Fselect_frame (frame, Qnil);
- term_mouse_moveto (xval, yval);
+#endif /* MSDOS */
+ else
+ {
+ Fselect_frame (frame, Qnil);
+#ifdef HAVE_GPM
+ term_mouse_moveto (xval, yval);
#else
- (void) xval;
- (void) yval;
-#endif
+ (void) xval;
+ (void) yval;
+#endif /* HAVE_GPM */
+
+ }
return Qnil;
}
@@ -3572,7 +3592,9 @@ window managers may refuse to honor a HEIGHT that is not an integer
multiple of the default frame font height.
When called interactively, HEIGHT is the numeric prefix and the
-currently selected frame will be set to this height. */)
+currently selected frame will be set to this height.
+
+If FRAME is nil, it defaults to the selected frame. */)
(Lisp_Object frame, Lisp_Object height, Lisp_Object pretend, Lisp_Object pixelwise)
{
struct frame *f = decode_live_frame (frame);
@@ -3595,7 +3617,9 @@ window managers may refuse to honor a WIDTH that is not an integer
multiple of the default frame font width.
When called interactively, WIDTH is the numeric prefix and the
-currently selected frame will be set to this width. */)
+currently selected frame will be set to this width.
+
+If FRAME is nil, it defaults to the selected frame. */)
(Lisp_Object frame, Lisp_Object width, Lisp_Object pretend, Lisp_Object pixelwise)
{
struct frame *f = decode_live_frame (frame);
@@ -3611,7 +3635,9 @@ Optional argument PIXELWISE non-nil means to measure in pixels. Note:
When `frame-resize-pixelwise' is nil, some window managers may refuse to
honor a WIDTH that is not an integer multiple of the default frame font
width or a HEIGHT that is not an integer multiple of the default frame
-font height. */)
+font height.
+
+If FRAME is nil, it defaults to the selected frame. */)
(Lisp_Object frame, Lisp_Object width, Lisp_Object height, Lisp_Object pixelwise)
{
struct frame *f = decode_live_frame (frame);
@@ -3629,7 +3655,11 @@ DEFUN ("frame-position", Fframe_position,
FRAME must be a live frame and defaults to the selected one. The return
value is a cons (x, y) of the coordinates of the top left corner of
FRAME's outer frame, in pixels relative to an origin (0, 0) of FRAME's
-display. */)
+display.
+
+Note that the values returned are not guaranteed to be accurate: The
+values depend on the underlying window system, and some systems add a
+constant offset to the values. */)
(Lisp_Object frame)
{
register struct frame *f = decode_live_frame (frame);
diff --git a/src/frame.h b/src/frame.h
index 16ecfd311c3..8cf41dc0046 100644
--- a/src/frame.h
+++ b/src/frame.h
@@ -1,5 +1,5 @@
/* Define frame-object for GNU Emacs.
- Copyright (C) 1993-1994, 1999-2020 Free Software Foundation, Inc.
+ Copyright (C) 1993-1994, 1999-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/fringe.c b/src/fringe.c
index 75496692d53..65c9a84ac99 100644
--- a/src/fringe.c
+++ b/src/fringe.c
@@ -1,5 +1,5 @@
/* Fringe handling (split from xdisp.c).
- Copyright (C) 1985-1988, 1993-1995, 1997-2020 Free Software
+ Copyright (C) 1985-1988, 1993-1995, 1997-2021 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/ftcrfont.c b/src/ftcrfont.c
index a10308c62ee..db417b3e77d 100644
--- a/src/ftcrfont.c
+++ b/src/ftcrfont.c
@@ -1,5 +1,5 @@
/* ftcrfont.c -- FreeType font driver on cairo.
- Copyright (C) 2015-2020 Free Software Foundation, Inc.
+ Copyright (C) 2015-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -84,7 +84,12 @@ ftcrfont_glyph_extents (struct font *font,
cache->lbearing = floor (extents.x_bearing);
cache->rbearing = ceil (extents.width + extents.x_bearing);
cache->width = lround (extents.x_advance);
- cache->ascent = ceil (- extents.y_bearing);
+ /* The subtraction of a small number is to avoid rounding up due
+ to floating-point inaccuracies with some fonts, which then
+ could cause unpleasant effects while scrolling (see bug
+ #44284), since we then think that a glyph row's ascent is too
+ small to accommodate a glyph with a higher phys_ascent. */
+ cache->ascent = ceil (- extents.y_bearing - 1.0 / 256);
cache->descent = ceil (extents.height + extents.y_bearing);
}
diff --git a/src/ftfont.c b/src/ftfont.c
index 6fca9c85093..0603dd9ce68 100644
--- a/src/ftfont.c
+++ b/src/ftfont.c
@@ -1,5 +1,5 @@
/* ftfont.c -- FreeType font driver.
- Copyright (C) 2006-2020 Free Software Foundation, Inc.
+ Copyright (C) 2006-2021 Free Software Foundation, Inc.
Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H13PRO009
diff --git a/src/getpagesize.h b/src/getpagesize.h
index f033d9739d1..ec497d04040 100644
--- a/src/getpagesize.h
+++ b/src/getpagesize.h
@@ -1,5 +1,5 @@
/* Emulate getpagesize on systems that lack it.
- Copyright (C) 1986, 1992, 1995, 2001-2020 Free Software Foundation,
+ Copyright (C) 1986, 1992, 1995, 2001-2021 Free Software Foundation,
Inc.
This file is part of GNU Emacs.
diff --git a/src/gfilenotify.c b/src/gfilenotify.c
index d083afc2fca..4da61569435 100644
--- a/src/gfilenotify.c
+++ b/src/gfilenotify.c
@@ -1,5 +1,5 @@
/* Filesystem notifications support with glib API.
- Copyright (C) 2013-2020 Free Software Foundation, Inc.
+ Copyright (C) 2013-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/gmalloc.c b/src/gmalloc.c
index 3560c744539..66008ea69b2 100644
--- a/src/gmalloc.c
+++ b/src/gmalloc.c
@@ -1,5 +1,5 @@
/* Declarations for `malloc' and friends.
- Copyright (C) 1990-1993, 1995-1996, 1999, 2002-2007, 2013-2020 Free
+ Copyright (C) 1990-1993, 1995-1996, 1999, 2002-2007, 2013-2021 Free
Software Foundation, Inc.
Written May 1989 by Mike Haertel.
diff --git a/src/gnutls.c b/src/gnutls.c
index 0010553a9d4..aa245ee5c39 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -1,5 +1,5 @@
/* GnuTLS glue for GNU Emacs.
- Copyright (C) 2010-2020 Free Software Foundation, Inc.
+ Copyright (C) 2010-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -2766,7 +2766,7 @@ GnuTLS MACs : the list will contain `macs'.
GnuTLS digests : the list will contain `digests'.
GnuTLS symmetric ciphers: the list will contain `ciphers'.
GnuTLS AEAD ciphers : the list will contain `AEAD-ciphers'.
-%DUMBFW : the list will contain `ClientHello\ Padding'.
+%DUMBFW : the list will contain `ClientHello\\ Padding'.
Any GnuTLS extension with ID up to 100
: the list will contain its name. */)
(void)
diff --git a/src/gnutls.h b/src/gnutls.h
index 5f4ad603476..5fa08f8b129 100644
--- a/src/gnutls.h
+++ b/src/gnutls.h
@@ -1,5 +1,5 @@
/* GnuTLS glue for GNU Emacs.
- Copyright (C) 2010-2020 Free Software Foundation, Inc.
+ Copyright (C) 2010-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/gtkutil.c b/src/gtkutil.c
index fafd94c0f71..11e59b9fae5 100644
--- a/src/gtkutil.c
+++ b/src/gtkutil.c
@@ -1,6 +1,6 @@
/* Functions for creating and updating GTK widgets.
-Copyright (C) 2003-2020 Free Software Foundation, Inc.
+Copyright (C) 2003-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -2944,14 +2944,11 @@ xg_get_menu_item_label (GtkMenuItem *witem)
static bool
xg_item_label_same_p (GtkMenuItem *witem, const char *label)
{
- bool is_same = 0;
char *utf8_label = get_utf8_string (label);
const char *old_label = witem ? xg_get_menu_item_label (witem) : 0;
- if (! old_label && ! utf8_label)
- is_same = 1;
- else if (old_label && utf8_label)
- is_same = strcmp (utf8_label, old_label) == 0;
+ bool is_same = (!old_label == !utf8_label
+ && (!old_label || strcmp (utf8_label, old_label) == 0));
if (utf8_label) g_free (utf8_label);
diff --git a/src/gtkutil.h b/src/gtkutil.h
index 5419167cd78..31a12cd5d3c 100644
--- a/src/gtkutil.h
+++ b/src/gtkutil.h
@@ -1,6 +1,6 @@
/* Definitions and headers for GTK widgets.
-Copyright (C) 2003-2020 Free Software Foundation, Inc.
+Copyright (C) 2003-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/hbfont.c b/src/hbfont.c
index 82b115e6868..e9f4085b1ae 100644
--- a/src/hbfont.c
+++ b/src/hbfont.c
@@ -1,5 +1,5 @@
/* hbfont.c -- Platform-independent support for HarfBuzz font driver.
- Copyright (C) 2019-2020 Free Software Foundation, Inc.
+ Copyright (C) 2019-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/image.c b/src/image.c
index c857b8e62a4..a124cf91ba0 100644
--- a/src/image.c
+++ b/src/image.c
@@ -1,6 +1,6 @@
/* Functions for image support on window system.
-Copyright (C) 1989, 1992-2020 Free Software Foundation, Inc.
+Copyright (C) 1989, 1992-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -1592,17 +1592,6 @@ make_image_cache (void)
return c;
}
-/* Compare two lists (one of which must be proper), comparing each
- element with `eq'. */
-static bool
-equal_lists (Lisp_Object a, Lisp_Object b)
-{
- while (CONSP (a) && CONSP (b) && EQ (XCAR (a), XCAR (b)))
- a = XCDR (a), b = XCDR (b);
-
- return EQ (a, b);
-}
-
/* Find an image matching SPEC in the cache, and return it. If no
image is found, return NULL. */
static struct image *
@@ -1630,7 +1619,7 @@ search_image_cache (struct frame *f, Lisp_Object spec, EMACS_UINT hash,
for (img = c->buckets[i]; img; img = img->next)
if (img->hash == hash
- && equal_lists (img->spec, spec)
+ && !NILP (Fequal (img->spec, spec))
&& (ignore_colors || (img->face_foreground == foreground
&& img->face_background == background)))
break;
@@ -1644,12 +1633,13 @@ static void
uncache_image (struct frame *f, Lisp_Object spec)
{
struct image *img;
+ EMACS_UINT hash = sxhash (spec);
/* Because the background colors are based on the current face, we
can have multiple copies of an image with the same spec. We want
to remove them all to ensure the user doesn't see an old version
of the image when the face changes. */
- while ((img = search_image_cache (f, spec, sxhash (spec), 0, 0, true)))
+ while ((img = search_image_cache (f, spec, hash, 0, 0, true)))
{
free_image (f, img);
/* As display glyphs may still be referring to the image ID, we
@@ -1802,6 +1792,79 @@ which is then usually a filename. */)
return Qnil;
}
+static size_t
+image_size_in_bytes (struct image *img)
+{
+ size_t size = 0;
+
+#if defined USE_CAIRO
+ Emacs_Pixmap pm = img->pixmap;
+ if (pm)
+ size += pm->height * pm->bytes_per_line;
+ Emacs_Pixmap msk = img->mask;
+ if (msk)
+ size += msk->height * msk->bytes_per_line;
+
+#elif defined HAVE_X_WINDOWS
+ /* Use a nominal depth of 24 bpp for pixmap and 1 bpp for mask,
+ to avoid having to query the server. */
+ if (img->pixmap != NO_PIXMAP)
+ size += img->width * img->height * 3;
+ if (img->mask != NO_PIXMAP)
+ size += img->width * img->height / 8;
+
+ if (img->ximg && img->ximg->data)
+ size += img->ximg->bytes_per_line * img->ximg->height;
+ if (img->mask_img && img->mask_img->data)
+ size += img->mask_img->bytes_per_line * img->mask_img->height;
+
+#elif defined HAVE_NS
+ if (img->pixmap)
+ size += ns_image_size_in_bytes (img->pixmap);
+ if (img->mask)
+ size += ns_image_size_in_bytes (img->mask);
+
+#elif defined HAVE_NTGUI
+ if (img->pixmap)
+ size += w32_image_size (img->pixmap);
+ if (img->mask)
+ size += w32_image_size (img->mask);
+
+#endif
+
+ return size;
+}
+
+static size_t
+image_frame_cache_size (struct frame *f)
+{
+ struct image_cache *c = FRAME_IMAGE_CACHE (f);
+ if (!c)
+ return 0;
+
+ size_t total = 0;
+ for (ptrdiff_t i = 0; i < c->used; ++i)
+ {
+ struct image *img = c->images[i];
+ total += img ? image_size_in_bytes (img) : 0;
+ }
+ return total;
+}
+
+DEFUN ("image-cache-size", Fimage_cache_size, Simage_cache_size, 0, 0, 0,
+ doc: /* Return the size of the image cache. */)
+ (void)
+{
+ Lisp_Object tail, frame;
+ size_t total = 0;
+
+ FOR_EACH_FRAME (tail, frame)
+ if (FRAME_WINDOW_P (XFRAME (frame)))
+ total += image_frame_cache_size (XFRAME (frame));
+
+ return make_int (total);
+}
+
DEFUN ("image-flush", Fimage_flush, Simage_flush,
1, 2, 0,
@@ -2131,6 +2194,10 @@ image_set_transform (struct frame *f, struct image *img)
# if !defined USE_CAIRO && defined HAVE_XRENDER
if (!img->picture)
return;
+
+ /* Store the original dimensions as we'll overwrite them later. */
+ img->original_width = img->width;
+ img->original_height = img->height;
# endif
/* Determine size. */
@@ -2347,7 +2414,7 @@ lookup_image (struct frame *f, Lisp_Object spec, int face_id)
/* Look up SPEC in the hash table of the image cache. */
hash = sxhash (spec);
- img = search_image_cache (f, spec, hash, foreground, background, true);
+ img = search_image_cache (f, spec, hash, foreground, background, false);
if (img && img->load_failed_p)
{
free_image (f, img);
@@ -2990,6 +3057,11 @@ image_get_x_image (struct frame *f, struct image *img, bool mask_p)
if (ximg_in_img)
return ximg_in_img;
+#ifdef HAVE_XRENDER
+ else if (img->picture)
+ return XGetImage (FRAME_X_DISPLAY (f), !mask_p ? img->pixmap : img->mask,
+ 0, 0, img->original_width, img->original_height, ~0, ZPixmap);
+#endif
else
return XGetImage (FRAME_X_DISPLAY (f), !mask_p ? img->pixmap : img->mask,
0, 0, img->width, img->height, ~0, ZPixmap);
@@ -9453,6 +9525,7 @@ enum svg_keyword_index
SVG_TYPE,
SVG_DATA,
SVG_FILE,
+ SVG_BASE_URI,
SVG_ASCENT,
SVG_MARGIN,
SVG_RELIEF,
@@ -9472,6 +9545,7 @@ static const struct image_keyword svg_format[SVG_LAST] =
{":type", IMAGE_SYMBOL_VALUE, 1},
{":data", IMAGE_STRING_VALUE, 0},
{":file", IMAGE_STRING_VALUE, 0},
+ {":base-uri", IMAGE_STRING_VALUE, 0},
{":ascent", IMAGE_ASCENT_VALUE, 0},
{":margin", IMAGE_NON_NEGATIVE_INTEGER_VALUE_OR_PAIR, 0},
{":relief", IMAGE_INTEGER_VALUE, 0},
@@ -9542,16 +9616,21 @@ DEF_DLL_FN (void, rsvg_handle_set_base_uri, (RsvgHandle *, const char *));
DEF_DLL_FN (gboolean, rsvg_handle_write,
(RsvgHandle *, const guchar *, gsize, GError **));
DEF_DLL_FN (gboolean, rsvg_handle_close, (RsvgHandle *, GError **));
-#endif
+# endif
-#if LIBRSVG_CHECK_VERSION (2, 46, 0)
+DEF_DLL_FN (void, rsvg_handle_set_dpi_x_y,
+ (RsvgHandle * handle, double dpi_x, double dpi_y));
+
+# if LIBRSVG_CHECK_VERSION (2, 46, 0)
+DEF_DLL_FN (void, rsvg_handle_get_intrinsic_dimensions,
+ (RsvgHandle *, gboolean *, RsvgLength *, gboolean *,
+ RsvgLength *, gboolean *, RsvgRectangle *));
DEF_DLL_FN (gboolean, rsvg_handle_get_geometry_for_layer,
(RsvgHandle *, const char *, const RsvgRectangle *,
RsvgRectangle *, RsvgRectangle *, GError **));
-#else
+# endif
DEF_DLL_FN (void, rsvg_handle_get_dimensions,
(RsvgHandle *, RsvgDimensionData *));
-#endif
DEF_DLL_FN (GdkPixbuf *, rsvg_handle_get_pixbuf, (RsvgHandle *));
DEF_DLL_FN (int, gdk_pixbuf_get_width, (const GdkPixbuf *));
DEF_DLL_FN (int, gdk_pixbuf_get_height, (const GdkPixbuf *));
@@ -9598,11 +9677,12 @@ init_svg_functions (void)
LOAD_DLL_FN (library, rsvg_handle_write);
LOAD_DLL_FN (library, rsvg_handle_close);
#endif
+ LOAD_DLL_FN (library, rsvg_handle_set_dpi_x_y);
#if LIBRSVG_CHECK_VERSION (2, 46, 0)
+ LOAD_DLL_FN (library, rsvg_handle_get_intrinsic_dimensions);
LOAD_DLL_FN (library, rsvg_handle_get_geometry_for_layer);
-#else
- LOAD_DLL_FN (library, rsvg_handle_get_dimensions);
#endif
+ LOAD_DLL_FN (library, rsvg_handle_get_dimensions);
LOAD_DLL_FN (library, rsvg_handle_get_pixbuf);
LOAD_DLL_FN (gdklib, gdk_pixbuf_get_width);
@@ -9638,10 +9718,10 @@ init_svg_functions (void)
# undef g_object_unref
# undef g_type_init
# if LIBRSVG_CHECK_VERSION (2, 46, 0)
+# undef rsvg_handle_get_intrinsic_dimensions
# undef rsvg_handle_get_geometry_for_layer
-# else
-# undef rsvg_handle_get_dimensions
# endif
+# undef rsvg_handle_get_dimensions
# undef rsvg_handle_get_pixbuf
# if LIBRSVG_CHECK_VERSION (2, 32, 0)
# undef g_file_new_for_path
@@ -9653,6 +9733,7 @@ init_svg_functions (void)
# undef rsvg_handle_set_base_uri
# undef rsvg_handle_write
# endif
+# undef rsvg_handle_set_dpi_x_y
# define gdk_pixbuf_get_bits_per_sample fn_gdk_pixbuf_get_bits_per_sample
# define gdk_pixbuf_get_colorspace fn_gdk_pixbuf_get_colorspace
@@ -9668,10 +9749,12 @@ init_svg_functions (void)
# define g_type_init fn_g_type_init
# endif
# if LIBRSVG_CHECK_VERSION (2, 46, 0)
-# define rsvg_handle_get_geometry_for_layer fn_rsvg_handle_get_geometry_for_layer
-# else
-# define rsvg_handle_get_dimensions fn_rsvg_handle_get_dimensions
+# define rsvg_handle_get_intrinsic_dimensions \
+ fn_rsvg_handle_get_intrinsic_dimensions
+# define rsvg_handle_get_geometry_for_layer \
+ fn_rsvg_handle_get_geometry_for_layer
# endif
+# define rsvg_handle_get_dimensions fn_rsvg_handle_get_dimensions
# define rsvg_handle_get_pixbuf fn_rsvg_handle_get_pixbuf
# if LIBRSVG_CHECK_VERSION (2, 32, 0)
# define g_file_new_for_path fn_g_file_new_for_path
@@ -9684,6 +9767,7 @@ init_svg_functions (void)
# define rsvg_handle_set_base_uri fn_rsvg_handle_set_base_uri
# define rsvg_handle_write fn_rsvg_handle_write
# endif
+# define rsvg_handle_set_dpi_x_y fn_rsvg_handle_set_dpi_x_y
# endif /* !WINDOWSNT */
@@ -9694,10 +9778,11 @@ static bool
svg_load (struct frame *f, struct image *img)
{
bool success_p = 0;
- Lisp_Object file_name;
+ Lisp_Object file_name, base_uri;
/* If IMG->spec specifies a file name, create a non-file spec from it. */
file_name = image_spec_value (img->spec, QCfile, NULL);
+ base_uri = image_spec_value (img->spec, QCbase_uri, NULL);
if (STRINGP (file_name))
{
int fd;
@@ -9717,15 +9802,17 @@ svg_load (struct frame *f, struct image *img)
return 0;
}
/* If the file was slurped into memory properly, parse it. */
+ if (!STRINGP (base_uri))
+ base_uri = file;
success_p = svg_load_image (f, img, contents, size,
- SSDATA (ENCODE_FILE (file)));
+ SSDATA (ENCODE_FILE (base_uri)));
xfree (contents);
}
/* Else it's not a file, it's a Lisp object. Load the image from a
Lisp object rather than a file. */
else
{
- Lisp_Object data, original_filename;
+ Lisp_Object data;
data = image_spec_value (img->spec, QCdata, NULL);
if (!STRINGP (data))
@@ -9733,15 +9820,56 @@ svg_load (struct frame *f, struct image *img)
image_error ("Invalid image data `%s'", data);
return 0;
}
- original_filename = BVAR (current_buffer, filename);
+ if (!STRINGP (base_uri))
+ base_uri = BVAR (current_buffer, filename);
success_p = svg_load_image (f, img, SSDATA (data), SBYTES (data),
- (NILP (original_filename) ? NULL
- : SSDATA (original_filename)));
+ (STRINGP (base_uri) ?
+ SSDATA (ENCODE_FILE (base_uri)) : NULL));
}
return success_p;
}
+#if LIBRSVG_CHECK_VERSION (2, 46, 0)
+static double
+svg_css_length_to_pixels (RsvgLength length, double dpi)
+{
+ double value = length.length;
+
+ switch (length.unit)
+ {
+ case RSVG_UNIT_PX:
+ /* Already a pixel value. */
+ break;
+ case RSVG_UNIT_CM:
+ /* 2.54 cm in an inch. */
+ value = dpi * value / 2.54;
+ break;
+ case RSVG_UNIT_MM:
+ /* 25.4 mm in an inch. */
+ value = dpi * value / 25.4;
+ break;
+ case RSVG_UNIT_PT:
+ /* 72 points in an inch. */
+ value = dpi * value / 72;
+ break;
+ case RSVG_UNIT_PC:
+ /* 6 picas in an inch. */
+ value = dpi * value / 6;
+ break;
+ case RSVG_UNIT_IN:
+ value *= dpi;
+ break;
+ default:
+ /* Probably one of em, ex, or %. We can't know what the pixel
+ value is without more information. */
+ value = 0;
+ }
+
+ return value;
+}
+#endif
+
/* Load frame F and image IMG. CONTENTS contains the SVG XML data to
be parsed, SIZE is its size, and FILENAME is the name of the SVG
file being loaded.
@@ -9779,18 +9907,26 @@ svg_load_image (struct frame *f, struct image *img, char *contents,
rsvg_handle = rsvg_handle_new_from_stream_sync (input_stream, base_file,
RSVG_HANDLE_FLAGS_NONE,
NULL, &err);
+
if (base_file)
g_object_unref (base_file);
g_object_unref (input_stream);
/* Check rsvg_handle too, to avoid librsvg 2.40.13 bug (Bug#36773#26). */
if (!rsvg_handle || err) goto rsvg_error;
+
+ rsvg_handle_set_dpi_x_y (rsvg_handle, FRAME_DISPLAY_INFO (f)->resx,
+ FRAME_DISPLAY_INFO (f)->resy);
#else
/* Make a handle to a new rsvg object. */
rsvg_handle = rsvg_handle_new ();
eassume (rsvg_handle);
+ rsvg_handle_set_dpi_x_y (rsvg_handle, FRAME_DISPLAY_INFO (f)->resx,
+ FRAME_DISPLAY_INFO (f)->resy);
+
/* Set base_uri for properly handling referenced images (via 'href').
+ Can be explicitly specified using `:base_uri' image property.
See rsvg bug 596114 - "image refs are relative to curdir, not .svg file"
<https://gitlab.gnome.org/GNOME/librsvg/issues/33>. */
if (filename)
@@ -9810,23 +9946,65 @@ svg_load_image (struct frame *f, struct image *img, char *contents,
#if LIBRSVG_CHECK_VERSION (2, 46, 0)
RsvgRectangle zero_rect, viewbox, out_logical_rect;
- rsvg_handle_get_geometry_for_layer (rsvg_handle, NULL,
- &zero_rect, &viewbox,
- &out_logical_rect, NULL);
- viewbox_width = viewbox.x + viewbox.width;
- viewbox_height = viewbox.y + viewbox.height;
-#else
- /* The function used above to get the geometry of the visible area
- of the SVG are only available in librsvg 2.46 and above, so in
- certain circumstances this code path can result in some parts of
- the SVG being cropped. */
- RsvgDimensionData dimension_data;
+ /* Try the instrinsic dimensions first. */
+ gboolean has_width, has_height, has_viewbox;
+ RsvgLength iwidth, iheight;
+ double dpi = FRAME_DISPLAY_INFO (f)->resx;
+
+ rsvg_handle_get_intrinsic_dimensions (rsvg_handle,
+ &has_width, &iwidth,
+ &has_height, &iheight,
+ &has_viewbox, &viewbox);
- rsvg_handle_get_dimensions (rsvg_handle, &dimension_data);
+ if (has_width && has_height)
+ {
+ /* Success! We can use these values directly. */
+ viewbox_width = svg_css_length_to_pixels (iwidth, dpi);
+ viewbox_height = svg_css_length_to_pixels (iheight, dpi);
+ }
+ else if (has_width && has_viewbox)
+ {
+ viewbox_width = svg_css_length_to_pixels (iwidth, dpi);
+ viewbox_height = svg_css_length_to_pixels (iwidth, dpi)
+ * viewbox.width / viewbox.height;
+ }
+ else if (has_height && has_viewbox)
+ {
+ viewbox_height = svg_css_length_to_pixels (iheight, dpi);
+ viewbox_width = svg_css_length_to_pixels (iheight, dpi)
+ * viewbox.height / viewbox.width;
+ }
+ else if (has_viewbox)
+ {
+ viewbox_width = viewbox.width;
+ viewbox_height = viewbox.height;
+ }
+ else
+ {
+ /* We haven't found a useable set of sizes, so try working out
+ the visible area. */
+ rsvg_handle_get_geometry_for_layer (rsvg_handle, NULL,
+ &zero_rect, &viewbox,
+ &out_logical_rect, NULL);
+ viewbox_width = viewbox.x + viewbox.width;
+ viewbox_height = viewbox.y + viewbox.height;
+ }
- viewbox_width = dimension_data.width;
- viewbox_height = dimension_data.height;
+ if (viewbox_width == 0 || viewbox_height == 0)
#endif
+ {
+ /* The functions used above to get the geometry of the visible
+ area of the SVG are only available in librsvg 2.46 and above,
+ so in certain circumstances this code path can result in some
+ parts of the SVG being cropped. */
+ RsvgDimensionData dimension_data;
+
+ rsvg_handle_get_dimensions (rsvg_handle, &dimension_data);
+
+ viewbox_width = dimension_data.width;
+ viewbox_height = dimension_data.height;
+ }
+
compute_image_size (viewbox_width, viewbox_height, img->spec,
&width, &height);
@@ -9902,18 +10080,26 @@ svg_load_image (struct frame *f, struct image *img, char *contents,
rsvg_handle = rsvg_handle_new_from_stream_sync (input_stream, base_file,
RSVG_HANDLE_FLAGS_NONE,
NULL, &err);
+
if (base_file)
g_object_unref (base_file);
g_object_unref (input_stream);
/* Check rsvg_handle too, to avoid librsvg 2.40.13 bug (Bug#36773#26). */
if (!rsvg_handle || err) goto rsvg_error;
+
+ rsvg_handle_set_dpi_x_y (rsvg_handle, FRAME_DISPLAY_INFO (f)->resx,
+ FRAME_DISPLAY_INFO (f)->resy);
#else
/* Make a handle to a new rsvg object. */
rsvg_handle = rsvg_handle_new ();
eassume (rsvg_handle);
+ rsvg_handle_set_dpi_x_y (rsvg_handle, FRAME_DISPLAY_INFO (f)->resx,
+ FRAME_DISPLAY_INFO (f)->resy);
+
/* Set base_uri for properly handling referenced images (via 'href').
+ Can be explicitly specified using `:base_uri' image property.
See rsvg bug 596114 - "image refs are relative to curdir, not .svg file"
<https://gitlab.gnome.org/GNOME/librsvg/issues/33>. */
if (filename)
@@ -10596,6 +10782,7 @@ non-numeric, there is no explicit limit on the size of images. */);
#if defined (HAVE_RSVG)
DEFSYM (Qsvg, "svg");
+ DEFSYM (QCbase_uri, ":base-uri");
add_image_type (Qsvg);
#ifdef HAVE_NTGUI
/* Other libraries used directly by svg code. */
@@ -10625,6 +10812,7 @@ non-numeric, there is no explicit limit on the size of images. */);
defsubr (&Simage_size);
defsubr (&Simage_mask_p);
defsubr (&Simage_metadata);
+ defsubr (&Simage_cache_size);
#ifdef GLYPH_DEBUG
defsubr (&Simagep);
diff --git a/src/indent.c b/src/indent.c
index 4ecf02b6b96..0a6b460f753 100644
--- a/src/indent.c
+++ b/src/indent.c
@@ -1,5 +1,5 @@
/* Indentation functions.
- Copyright (C) 1985-1988, 1993-1995, 1998, 2000-2020 Free Software
+ Copyright (C) 1985-1988, 1993-1995, 1998, 2000-2021 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/indent.h b/src/indent.h
index 6058429ede5..776fe7ba4b9 100644
--- a/src/indent.h
+++ b/src/indent.h
@@ -1,5 +1,5 @@
/* Definitions for interface to indent.c
- Copyright (C) 1985-1986, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1985-1986, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/inotify.c b/src/inotify.c
index 549a82b4013..df6145d7025 100644
--- a/src/inotify.c
+++ b/src/inotify.c
@@ -1,6 +1,6 @@
/* Inotify support for Emacs
-Copyright (C) 2012-2020 Free Software Foundation, Inc.
+Copyright (C) 2012-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/insdel.c b/src/insdel.c
index 6e245971085..e38b091f542 100644
--- a/src/insdel.c
+++ b/src/insdel.c
@@ -1,5 +1,5 @@
/* Buffer insertion/deletion and gap motion for GNU Emacs. -*- coding: utf-8 -*-
- Copyright (C) 1985-1986, 1993-1995, 1997-2020 Free Software
+ Copyright (C) 1985-1986, 1993-1995, 1997-2021 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/intervals.c b/src/intervals.c
index 0257591a142..f88a41f2549 100644
--- a/src/intervals.c
+++ b/src/intervals.c
@@ -1,5 +1,5 @@
/* Code for doing intervals.
- Copyright (C) 1993-1995, 1997-1998, 2001-2020 Free Software
+ Copyright (C) 1993-1995, 1997-1998, 2001-2021 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/intervals.h b/src/intervals.h
index 9a7ba910a10..c1b19345d2e 100644
--- a/src/intervals.h
+++ b/src/intervals.h
@@ -1,5 +1,5 @@
/* Definitions and global variables for intervals.
- Copyright (C) 1993-1994, 2000-2020 Free Software Foundation, Inc.
+ Copyright (C) 1993-1994, 2000-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/json.c b/src/json.c
index 744c40a1bef..2901a20811a 100644
--- a/src/json.c
+++ b/src/json.c
@@ -1,6 +1,6 @@
/* JSON parsing and serialization.
-Copyright (C) 2017-2020 Free Software Foundation, Inc.
+Copyright (C) 2017-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/keyboard.c b/src/keyboard.c
index 2e0143379a0..9ee4c4f6d68 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -1,6 +1,6 @@
/* Keyboard and mouse input; editor command loop.
-Copyright (C) 1985-1989, 1993-1997, 1999-2020 Free Software Foundation,
+Copyright (C) 1985-1989, 1993-1997, 1999-2021 Free Software Foundation,
Inc.
This file is part of GNU Emacs.
@@ -285,7 +285,7 @@ bool input_pending;
with the input rate, but if it can keep up just enough that there's no
input_pending when we begin the command, then redisplay is not skipped
which results in better feedback to the user. */
-static bool input_was_pending;
+bool input_was_pending;
/* Circular buffer for pre-read keyboard input. */
@@ -384,11 +384,13 @@ next_kbd_event (union buffered_input_event *ptr)
return ptr == kbd_buffer + KBD_BUFFER_SIZE - 1 ? kbd_buffer : ptr + 1;
}
+#ifdef HAVE_X11
static union buffered_input_event *
prev_kbd_event (union buffered_input_event *ptr)
{
return ptr == kbd_buffer ? kbd_buffer + KBD_BUFFER_SIZE - 1 : ptr - 1;
}
+#endif
/* Like EVENT_START, but assume EVENT is an event.
This pacifies gcc -Wnull-dereference, which might otherwise
@@ -741,9 +743,6 @@ void
force_auto_save_soon (void)
{
last_auto_save = - auto_save_interval - 1;
- /* FIXME: What's the relationship between forcing auto-save and adding
- a buffer-switch event? */
- record_asynch_buffer_change ();
}
#endif
@@ -2122,7 +2121,7 @@ read_char_help_form_unwind (void)
Lisp_Object window_config = XCAR (help_form_saved_window_configs);
help_form_saved_window_configs = XCDR (help_form_saved_window_configs);
if (!NILP (window_config))
- Fset_window_configuration (window_config);
+ Fset_window_configuration (window_config, Qnil);
}
#define STOP_POLLING \
@@ -3431,8 +3430,7 @@ readable_events (int flags)
&& event->ie.part == scroll_bar_handle
&& event->ie.modifiers == 0)
#endif
- && !((flags & READABLE_EVENTS_FILTER_EVENTS)
- && event->kind == BUFFER_SWITCH_EVENT))
+ )
return 1;
event = next_kbd_event (event);
}
@@ -3583,12 +3581,6 @@ kbd_buffer_store_buffered_event (union buffered_input_event *event,
return;
}
}
- /* Don't insert two BUFFER_SWITCH_EVENT's in a row.
- Just ignore the second one. */
- else if (event->kind == BUFFER_SWITCH_EVENT
- && kbd_fetch_ptr != kbd_store_ptr
- && prev_kbd_event (kbd_store_ptr)->kind == BUFFER_SWITCH_EVENT)
- return;
/* Don't let the very last slot in the buffer become full,
since that would make the two pointers equal,
@@ -3622,7 +3614,6 @@ kbd_buffer_store_buffered_event (union buffered_input_event *event,
case ICONIFY_EVENT: ignore_event = Qiconify_frame; break;
case DEICONIFY_EVENT: ignore_event = Qmake_frame_visible; break;
case SELECTION_REQUEST_EVENT: ignore_event = Qselection_request; break;
- case BUFFER_SWITCH_EVENT: ignore_event = Qbuffer_switch; break;
default: ignore_event = Qnil; break;
}
@@ -3656,7 +3647,8 @@ kbd_buffer_unget_event (struct selection_input_event *event)
#define INPUT_EVENT_POS_MAX \
((ptrdiff_t) min (PTRDIFF_MAX, min (TYPE_MAXIMUM (Time) / 2, \
MOST_POSITIVE_FIXNUM)))
-#define INPUT_EVENT_POS_MIN (-1 - INPUT_EVENT_POS_MAX)
+#define INPUT_EVENT_POS_MIN (PTRDIFF_MIN < -INPUT_EVENT_POS_MAX \
+ ? -1 - INPUT_EVENT_POS_MAX : PTRDIFF_MIN)
/* Return a Time that encodes position POS. POS must be in range. */
@@ -3736,9 +3728,6 @@ discard_mouse_events (void)
if (sp->kind == MOUSE_CLICK_EVENT
|| sp->kind == WHEEL_EVENT
|| sp->kind == HORIZ_WHEEL_EVENT
-#ifdef HAVE_GPM
- || sp->kind == GPM_CLICK_EVENT
-#endif
|| sp->kind == SCROLL_BAR_CLICK_EVENT
|| sp->kind == HORIZONTAL_SCROLL_BAR_CLICK_EVENT)
{
@@ -3964,7 +3953,6 @@ kbd_buffer_get_event (KBOARD **kbp,
#ifdef HAVE_XWIDGETS
case XWIDGET_EVENT:
#endif
- case BUFFER_SWITCH_EVENT:
case SAVE_SESSION_EVENT:
case NO_EVENT:
case HELP_EVENT:
@@ -5344,14 +5332,6 @@ make_lispy_event (struct input_event *event)
return list2 (Qmove_frame, list1 (event->frame_or_window));
#endif
- case BUFFER_SWITCH_EVENT:
- {
- /* The value doesn't matter here; only the type is tested. */
- Lisp_Object obj;
- XSETBUFFER (obj, current_buffer);
- return obj;
- }
-
/* Just discard these, by returning nil.
With MULTI_KBOARD, these events are used as placeholders
when we need to randomly delete events from the queue.
@@ -5542,9 +5522,6 @@ make_lispy_event (struct input_event *event)
/* A mouse click. Figure out where it is, decide whether it's
a press, click or drag, and build the appropriate structure. */
case MOUSE_CLICK_EVENT:
-#ifdef HAVE_GPM
- case GPM_CLICK_EVENT:
-#endif
#ifndef USE_TOOLKIT_SCROLL_BARS
case SCROLL_BAR_CLICK_EVENT:
case HORIZONTAL_SCROLL_BAR_CLICK_EVENT:
@@ -5559,11 +5536,7 @@ make_lispy_event (struct input_event *event)
position = Qnil;
/* Build the position as appropriate for this mouse click. */
- if (event->kind == MOUSE_CLICK_EVENT
-#ifdef HAVE_GPM
- || event->kind == GPM_CLICK_EVENT
-#endif
- )
+ if (event->kind == MOUSE_CLICK_EVENT)
{
struct frame *f = XFRAME (event->frame_or_window);
int row, column;
@@ -6815,41 +6788,6 @@ get_input_pending (int flags)
return input_pending;
}
-/* Put a BUFFER_SWITCH_EVENT in the buffer
- so that read_key_sequence will notice the new current buffer. */
-
-void
-record_asynch_buffer_change (void)
-{
- /* We don't need a buffer-switch event unless Emacs is waiting for input.
- The purpose of the event is to make read_key_sequence look up the
- keymaps again. If we aren't in read_key_sequence, we don't need one,
- and the event could cause trouble by messing up (input-pending-p).
- Note: Fwaiting_for_user_input_p always returns nil when async
- subprocesses aren't supported. */
- if (!NILP (Fwaiting_for_user_input_p ()))
- {
- struct input_event event;
-
- EVENT_INIT (event);
- event.kind = BUFFER_SWITCH_EVENT;
- event.frame_or_window = Qnil;
- event.arg = Qnil;
-
- /* Make sure no interrupt happens while storing the event. */
-#ifdef USABLE_SIGIO
- if (interrupt_input)
- kbd_buffer_store_event (&event);
- else
-#endif
- {
- stop_polling ();
- kbd_buffer_store_event (&event);
- start_polling ();
- }
- }
-}
-
/* Read any terminal input already buffered up by the system
into the kbd_buffer, but do not wait.
@@ -7005,12 +6943,8 @@ tty_read_avail_input (struct terminal *terminal,
if (gpm_tty == tty)
{
Gpm_Event event;
- struct input_event gpm_hold_quit;
int gpm, fd = gpm_fd;
- EVENT_INIT (gpm_hold_quit);
- gpm_hold_quit.kind = NO_EVENT;
-
/* gpm==1 if event received.
gpm==0 if the GPM daemon has closed the connection, in which case
Gpm_GetEvent closes gpm_fd and clears it to -1, which is why
@@ -7018,13 +6952,11 @@ tty_read_avail_input (struct terminal *terminal,
select masks.
gpm==-1 if a protocol error or EWOULDBLOCK; the latter is normal. */
while (gpm = Gpm_GetEvent (&event), gpm == 1) {
- nread += handle_one_term_event (tty, &event, &gpm_hold_quit);
+ nread += handle_one_term_event (tty, &event);
}
if (gpm == 0)
/* Presumably the GPM daemon has closed the connection. */
close_gpm (fd);
- if (gpm_hold_quit.kind != NO_EVENT)
- kbd_buffer_store_event (&gpm_hold_quit);
if (nread)
return nread;
}
@@ -11589,8 +11521,6 @@ syms_of_keyboard (void)
/* Menu and tool bar item parts. */
DEFSYM (Qmenu_enable, "menu-enable");
- DEFSYM (Qbuffer_switch, "buffer-switch");
-
#ifdef HAVE_NTGUI
DEFSYM (Qlanguage_change, "language-change");
DEFSYM (Qend_session, "end-session");
@@ -11901,6 +11831,13 @@ will be in `last-command' during the following command. */);
doc: /* This is like `this-command', except that commands should never modify it. */);
Vreal_this_command = Qnil;
+ DEFSYM (Qcurrent_minibuffer_command, "current-minibuffer-command");
+ DEFVAR_LISP ("current-minibuffer-command", Vcurrent_minibuffer_command,
+ doc: /* This is like `this-command', but bound recursively.
+Code running from (for instance) a minibuffer hook can check this variable
+to see what command invoked the current minibuffer. */);
+ Vcurrent_minibuffer_command = Qnil;
+
DEFVAR_LISP ("this-command-keys-shift-translated",
Vthis_command_keys_shift_translated,
doc: /* Non-nil if the key sequence activating this command was shift-translated.
@@ -12451,12 +12388,6 @@ syms_of_keyboard_for_pdumper (void)
void
keys_of_keyboard (void)
{
- initial_define_key (global_map, Ctl ('Z'), "suspend-emacs");
- initial_define_key (control_x_map, Ctl ('Z'), "suspend-emacs");
- initial_define_key (meta_map, Ctl ('C'), "exit-recursive-edit");
- initial_define_key (global_map, Ctl (']'), "abort-recursive-edit");
- initial_define_key (meta_map, 'x', "execute-extended-command");
-
initial_define_lispy_key (Vspecial_event_map, "delete-frame",
"handle-delete-frame");
#ifdef HAVE_NTGUI
diff --git a/src/keyboard.h b/src/keyboard.h
index 41da3a6bf44..8bdffaa2bff 100644
--- a/src/keyboard.h
+++ b/src/keyboard.h
@@ -1,5 +1,5 @@
/* Declarations useful when processing input.
- Copyright (C) 1985-1987, 1993, 2001-2020 Free Software Foundation,
+ Copyright (C) 1985-1987, 1993, 2001-2021 Free Software Foundation,
Inc.
This file is part of GNU Emacs.
@@ -432,7 +432,7 @@ extern int parse_solitary_modifier (Lisp_Object symbol);
extern Lisp_Object real_this_command;
extern int quit_char;
-
+extern bool input_was_pending;
extern unsigned int timers_run;
extern bool menu_separator_name_p (const char *);
@@ -446,7 +446,6 @@ extern void push_kboard (struct kboard *);
extern void push_frame_kboard (struct frame *);
extern void pop_kboard (void);
extern void temporarily_switch_to_single_kboard (struct frame *);
-extern void record_asynch_buffer_change (void);
extern void input_poll_signal (int);
extern void start_polling (void);
extern void stop_polling (void);
diff --git a/src/keymap.c b/src/keymap.c
index e5b4781076f..de9b2b58c5e 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -1,5 +1,5 @@
/* Manipulation of keymaps
- Copyright (C) 1985-1988, 1993-1995, 1998-2020 Free Software
+ Copyright (C) 1985-1988, 1993-1995, 1998-2021 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
@@ -59,22 +59,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
Lisp_Object current_global_map; /* Current global keymap. */
-Lisp_Object global_map; /* Default global key bindings. */
-
-Lisp_Object meta_map; /* The keymap used for globally bound
- ESC-prefixed default commands. */
-
-Lisp_Object control_x_map; /* The keymap used for globally bound
- C-x-prefixed default commands. */
-
- /* The keymap used by the minibuf for local
- bindings when spaces are allowed in the
- minibuf. */
-
- /* The keymap used by the minibuf for local
- bindings when spaces are not encouraged
- in the minibuf. */
-
/* Alist of elements like (DEL . "\d"). */
static Lisp_Object exclude_keys;
@@ -140,19 +124,6 @@ in case you use it as a menu with `x-popup-menu'. */)
return list1 (Qkeymap);
}
-/* This function is used for installing the standard key bindings
- at initialization time.
-
- For example:
-
- initial_define_key (control_x_map, Ctl('X'), "exchange-point-and-mark"); */
-
-void
-initial_define_key (Lisp_Object keymap, int key, const char *defname)
-{
- store_in_keymap (keymap, make_fixnum (key), intern_c_string (defname));
-}
-
void
initial_define_lispy_key (Lisp_Object keymap, const char *keyname, const char *defname)
{
@@ -218,15 +189,13 @@ when reading a key-sequence to be looked-up in this keymap. */)
Lisp_Object
get_keymap (Lisp_Object object, bool error_if_not_keymap, bool autoload)
{
- Lisp_Object tem;
-
autoload_retry:
if (NILP (object))
goto end;
if (CONSP (object) && EQ (XCAR (object), Qkeymap))
return object;
- tem = indirect_function (object);
+ Lisp_Object tem = indirect_function (object);
if (CONSP (tem))
{
if (EQ (XCAR (tem), Qkeymap))
@@ -265,12 +234,10 @@ get_keymap (Lisp_Object object, bool error_if_not_keymap, bool autoload)
static Lisp_Object
keymap_parent (Lisp_Object keymap, bool autoload)
{
- Lisp_Object list;
-
keymap = get_keymap (keymap, 1, autoload);
/* Skip past the initial element `keymap'. */
- list = XCDR (keymap);
+ Lisp_Object list = XCDR (keymap);
for (; CONSP (list); list = XCDR (list))
{
/* See if there is another `keymap'. */
@@ -306,8 +273,6 @@ DEFUN ("set-keymap-parent", Fset_keymap_parent, Sset_keymap_parent, 2, 2, 0,
Return PARENT. PARENT should be nil or another keymap. */)
(Lisp_Object keymap, Lisp_Object parent)
{
- Lisp_Object list, prev;
-
/* Flush any reverse-map cache. */
where_is_cache = Qnil; where_is_cache_keymaps = Qt;
@@ -323,10 +288,10 @@ Return PARENT. PARENT should be nil or another keymap. */)
}
/* Skip past the initial element `keymap'. */
- prev = keymap;
+ Lisp_Object prev = keymap;
while (1)
{
- list = XCDR (prev);
+ Lisp_Object list = XCDR (prev);
/* If there is a parent keymap here, replace it.
If we came to the end, add the parent in PREV. */
if (!CONSP (list) || KEYMAPP (list))
@@ -805,14 +770,10 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def)
towards the front of the alist and character lookups in dense
keymaps will remain fast. Otherwise, this just points at the
front of the keymap. */
- Lisp_Object insertion_point;
-
- insertion_point = keymap;
+ Lisp_Object insertion_point = keymap;
for (tail = XCDR (keymap); CONSP (tail); tail = XCDR (tail))
{
- Lisp_Object elt;
-
- elt = XCAR (tail);
+ Lisp_Object elt = XCAR (tail);
if (VECTORP (elt))
{
if (FIXNATP (idx) && XFIXNAT (idx) < ASIZE (elt))
@@ -1018,9 +979,8 @@ copy_keymap_1 (Lisp_Object keymap, int depth)
}
else if (VECTORP (elt))
{
- int i;
elt = Fcopy_sequence (elt);
- for (i = 0; i < ASIZE (elt); i++)
+ for (int i = 0; i < ASIZE (elt); i++)
ASET (elt, i, copy_keymap_item (AREF (elt, i), depth + 1));
}
else if (CONSP (elt))
@@ -1097,24 +1057,19 @@ binding is altered. If there is no binding for KEY, the new pair
binding KEY to DEF is added at the front of KEYMAP. */)
(Lisp_Object keymap, Lisp_Object key, Lisp_Object def)
{
- ptrdiff_t idx;
- Lisp_Object c;
- Lisp_Object cmd;
- bool metized = 0;
- int meta_bit;
- ptrdiff_t length;
+ bool metized = false;
keymap = get_keymap (keymap, 1, 1);
- length = CHECK_VECTOR_OR_STRING (key);
+ ptrdiff_t length = CHECK_VECTOR_OR_STRING (key);
if (length == 0)
return Qnil;
if (SYMBOLP (def) && !EQ (Vdefine_key_rebound_commands, Qt))
Vdefine_key_rebound_commands = Fcons (def, Vdefine_key_rebound_commands);
- meta_bit = (VECTORP (key) || (STRINGP (key) && STRING_MULTIBYTE (key))
- ? meta_modifier : 0x80);
+ int meta_bit = (VECTORP (key) || (STRINGP (key) && STRING_MULTIBYTE (key))
+ ? meta_modifier : 0x80);
if (VECTORP (def) && ASIZE (def) > 0 && CONSP (AREF (def, 0)))
{ /* DEF is apparently an XEmacs-style keyboard macro. */
@@ -1130,10 +1085,10 @@ binding KEY to DEF is added at the front of KEYMAP. */)
def = tmp;
}
- idx = 0;
+ ptrdiff_t idx = 0;
while (1)
{
- c = Faref (key, make_fixnum (idx));
+ Lisp_Object c = Faref (key, make_fixnum (idx));
if (CONSP (c))
{
@@ -1153,14 +1108,14 @@ binding KEY to DEF is added at the front of KEYMAP. */)
&& !metized)
{
c = meta_prefix_char;
- metized = 1;
+ metized = true;
}
else
{
if (FIXNUMP (c))
XSETINT (c, XFIXNUM (c) & ~meta_bit);
- metized = 0;
+ metized = false;
idx++;
}
@@ -1173,7 +1128,7 @@ binding KEY to DEF is added at the front of KEYMAP. */)
if (idx == length)
return store_in_keymap (keymap, c, def);
- cmd = access_keymap (keymap, c, 0, 1, 1);
+ Lisp_Object cmd = access_keymap (keymap, c, 0, 1, 1);
/* If this key is undefined, make it a prefix. */
if (NILP (cmd))
@@ -1250,23 +1205,19 @@ third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will
recognize the default bindings, just as `read-key-sequence' does. */)
(Lisp_Object keymap, Lisp_Object key, Lisp_Object accept_default)
{
- ptrdiff_t idx;
- Lisp_Object cmd;
- Lisp_Object c;
- ptrdiff_t length;
bool t_ok = !NILP (accept_default);
if (!CONSP (keymap) && !NILP (keymap))
keymap = get_keymap (keymap, true, true);
- length = CHECK_VECTOR_OR_STRING (key);
+ ptrdiff_t length = CHECK_VECTOR_OR_STRING (key);
if (length == 0)
return keymap;
- idx = 0;
+ ptrdiff_t idx = 0;
while (1)
{
- c = Faref (key, make_fixnum (idx++));
+ Lisp_Object c = Faref (key, make_fixnum (idx++));
if (CONSP (c) && lucid_event_type_list_p (c))
c = Fevent_convert_list (c);
@@ -1280,7 +1231,7 @@ recognize the default bindings, just as `read-key-sequence' does. */)
if (!FIXNUMP (c) && !SYMBOLP (c) && !CONSP (c) && !STRINGP (c))
message_with_string ("Key sequence contains invalid event %s", c, 1);
- cmd = access_keymap (keymap, c, t_ok, 0, 1);
+ Lisp_Object cmd = access_keymap (keymap, c, t_ok, 0, 1);
if (idx == length)
return cmd;
@@ -1299,9 +1250,7 @@ recognize the default bindings, just as `read-key-sequence' does. */)
static Lisp_Object
define_as_prefix (Lisp_Object keymap, Lisp_Object c)
{
- Lisp_Object cmd;
-
- cmd = Fmake_sparse_keymap (Qnil);
+ Lisp_Object cmd = Fmake_sparse_keymap (Qnil);
store_in_keymap (keymap, c, cmd);
return cmd;
@@ -1322,15 +1271,12 @@ append_key (Lisp_Object key_sequence, Lisp_Object key)
static void
silly_event_symbol_error (Lisp_Object c)
{
- Lisp_Object parsed, base, name, assoc;
- int modifiers;
-
- parsed = parse_modifiers (c);
- modifiers = XFIXNAT (XCAR (XCDR (parsed)));
- base = XCAR (parsed);
- name = Fsymbol_name (base);
+ Lisp_Object parsed = parse_modifiers (c);
+ int modifiers = XFIXNAT (XCAR (XCDR (parsed)));
+ Lisp_Object base = XCAR (parsed);
+ Lisp_Object name = Fsymbol_name (base);
/* This alist includes elements such as ("RET" . "\\r"). */
- assoc = Fassoc (name, exclude_keys, Qnil);
+ Lisp_Object assoc = Fassoc (name, exclude_keys, Qnil);
if (! NILP (assoc))
{
@@ -1391,16 +1337,14 @@ ptrdiff_t
current_minor_maps (Lisp_Object **modeptr, Lisp_Object **mapptr)
{
ptrdiff_t i = 0;
- int list_number = 0;
Lisp_Object alist, assoc, var, val;
- Lisp_Object emulation_alists;
+ Lisp_Object emulation_alists = Vemulation_mode_map_alists;
Lisp_Object lists[2];
- emulation_alists = Vemulation_mode_map_alists;
lists[0] = Vminor_mode_overriding_map_alist;
lists[1] = Vminor_mode_map_alist;
- for (list_number = 0; list_number < 2; list_number++)
+ for (int list_number = 0; list_number < 2; list_number++)
{
if (CONSP (emulation_alists))
{
@@ -1526,9 +1470,7 @@ like in the respective argument of `key-binding'. */)
if (CONSP (position))
{
- Lisp_Object window;
-
- window = POSN_WINDOW (position);
+ Lisp_Object window = POSN_WINDOW (position);
if (WINDOWP (window)
&& BUFFERP (XWINDOW (window)->contents)
@@ -1557,7 +1499,7 @@ like in the respective argument of `key-binding'. */)
if (NILP (XCDR (keymaps)))
{
Lisp_Object *maps;
- int nmaps, i;
+ int nmaps;
ptrdiff_t pt = click_position (position);
/* This usually returns the buffer's local map,
but that can be overridden by a `local-map' property. */
@@ -1575,9 +1517,7 @@ like in the respective argument of `key-binding'. */)
if (POSN_INBUFFER_P (position))
{
- Lisp_Object pos;
-
- pos = POSN_BUFFER_POSN (position);
+ Lisp_Object pos = POSN_BUFFER_POSN (position);
if (FIXNUMP (pos)
&& XFIXNUM (pos) >= BEG && XFIXNUM (pos) <= Z)
{
@@ -1597,15 +1537,13 @@ like in the respective argument of `key-binding'. */)
if (CONSP (string) && STRINGP (XCAR (string)))
{
- Lisp_Object pos, map;
-
- pos = XCDR (string);
+ Lisp_Object pos = XCDR (string);
string = XCAR (string);
if (FIXNUMP (pos)
&& XFIXNUM (pos) >= 0
&& XFIXNUM (pos) < SCHARS (string))
{
- map = Fget_text_property (pos, Qlocal_map, string);
+ Lisp_Object map = Fget_text_property (pos, Qlocal_map, string);
if (!NILP (map))
local_map = map;
@@ -1623,7 +1561,7 @@ like in the respective argument of `key-binding'. */)
/* Now put all the minor mode keymaps on the list. */
nmaps = current_minor_maps (0, &maps);
- for (i = --nmaps; i >= 0; i--)
+ for (int i = --nmaps; i >= 0; i--)
if (!NILP (maps[i]))
keymaps = Fcons (maps[i], keymaps);
@@ -1667,18 +1605,15 @@ specified buffer position instead of point are used.
*/)
(Lisp_Object key, Lisp_Object accept_default, Lisp_Object no_remap, Lisp_Object position)
{
- Lisp_Object value;
-
if (NILP (position) && VECTORP (key))
{
- Lisp_Object event;
-
if (ASIZE (key) == 0)
return Qnil;
/* mouse events may have a symbolic prefix indicating the
scrollbar or mode line */
- event = AREF (key, SYMBOLP (AREF (key, 0)) && ASIZE (key) > 1 ? 1 : 0);
+ Lisp_Object event
+ = AREF (key, SYMBOLP (AREF (key, 0)) && ASIZE (key) > 1 ? 1 : 0);
/* We are not interested in locations without event data */
@@ -1690,8 +1625,8 @@ specified buffer position instead of point are used.
}
}
- value = Flookup_key (Fcurrent_active_maps (Qt, position),
- key, accept_default);
+ Lisp_Object value = Flookup_key (Fcurrent_active_maps (Qt, position),
+ key, accept_default);
if (NILP (value) || FIXNUMP (value))
return Qnil;
@@ -1711,40 +1646,6 @@ specified buffer position instead of point are used.
/* GC is possible in this function if it autoloads a keymap. */
-DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 2, 0,
- doc: /* Return the binding for command KEYS in current local keymap only.
-KEYS is a string or vector, a sequence of keystrokes.
-The binding is probably a symbol with a function definition.
-
-If optional argument ACCEPT-DEFAULT is non-nil, recognize default
-bindings; see the description of `lookup-key' for more details about this. */)
- (Lisp_Object keys, Lisp_Object accept_default)
-{
- register Lisp_Object map;
- map = BVAR (current_buffer, keymap);
- if (NILP (map))
- return Qnil;
- return Flookup_key (map, keys, accept_default);
-}
-
-/* GC is possible in this function if it autoloads a keymap. */
-
-DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 2, 0,
- doc: /* Return the binding for command KEYS in current global keymap only.
-KEYS is a string or vector, a sequence of keystrokes.
-The binding is probably a symbol with a function definition.
-This function's return values are the same as those of `lookup-key'
-\(which see).
-
-If optional argument ACCEPT-DEFAULT is non-nil, recognize default
-bindings; see the description of `lookup-key' for more details about this. */)
- (Lisp_Object keys, Lisp_Object accept_default)
-{
- return Flookup_key (current_global_map, keys, accept_default);
-}
-
-/* GC is possible in this function if it autoloads a keymap. */
-
DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding, Sminor_mode_key_binding, 1, 2, 0,
doc: /* Find the visible minor mode bindings of KEY.
Return an alist of pairs (MODENAME . BINDING), where MODENAME is
@@ -1760,15 +1661,11 @@ bindings; see the description of `lookup-key' for more details about this. */)
(Lisp_Object key, Lisp_Object accept_default)
{
Lisp_Object *modes, *maps;
- int nmaps;
- Lisp_Object binding;
- int i, j;
-
- nmaps = current_minor_maps (&modes, &maps);
+ int nmaps = current_minor_maps (&modes, &maps);
+ Lisp_Object binding = Qnil;
- binding = Qnil;
-
- for (i = j = 0; i < nmaps; i++)
+ int j;
+ for (int i = j = 0; i < nmaps; i++)
if (!NILP (maps[i])
&& !NILP (binding = Flookup_key (maps[i], key, accept_default))
&& !FIXNUMP (binding))
@@ -1782,29 +1679,6 @@ bindings; see the description of `lookup-key' for more details about this. */)
return Flist (j, maps);
}
-DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 3, 0,
- doc: /* Define COMMAND as a prefix command. COMMAND should be a symbol.
-A new sparse keymap is stored as COMMAND's function definition and its
-value.
-This prepares COMMAND for use as a prefix key's binding.
-If a second optional argument MAPVAR is given, it should be a symbol.
-The map is then stored as MAPVAR's value instead of as COMMAND's
-value; but COMMAND is still defined as a function.
-The third optional argument NAME, if given, supplies a menu name
-string for the map. This is required to use the keymap as a menu.
-This function returns COMMAND. */)
- (Lisp_Object command, Lisp_Object mapvar, Lisp_Object name)
-{
- Lisp_Object map;
- map = Fmake_sparse_keymap (name);
- Ffset (command, map);
- if (!NILP (mapvar))
- Fset (mapvar, map);
- else
- Fset (command, map);
- return command;
-}
-
DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0,
doc: /* Select KEYMAP as the global keymap. */)
(Lisp_Object keymap)
@@ -1942,8 +1816,7 @@ then the value includes only maps for prefixes that start with PREFIX. */)
{
/* If a prefix was specified, start with the keymap (if any) for
that prefix, so we don't waste time considering other prefixes. */
- Lisp_Object tem;
- tem = Flookup_key (keymap, prefix, Qt);
+ Lisp_Object tem = Flookup_key (keymap, prefix, Qt);
/* Flookup_key may give us nil, or a number,
if the prefix is not defined in this particular map.
It might even give us a list that isn't a keymap. */
@@ -2011,7 +1884,7 @@ then the value includes only maps for prefixes that start with PREFIX. */)
DEFUN ("key-description", Fkey_description, Skey_description, 1, 2, 0,
doc: /* Return a pretty description of key-sequence KEYS.
Optional arg PREFIX is the sequence of keys leading up to KEYS.
-For example, [?\C-x ?l] is converted into the string \"C-x l\".
+For example, [?\\C-x ?l] is converted into the string \"C-x l\".
For an approximate inverse of this, see `kbd'. */)
(Lisp_Object keys, Lisp_Object prefix)
@@ -2260,11 +2133,21 @@ See `text-char-description' for describing character codes. */)
{
if (NILP (no_angles))
{
- Lisp_Object result;
- char *buffer = SAFE_ALLOCA (sizeof "<>"
- + SBYTES (SYMBOL_NAME (key)));
- esprintf (buffer, "<%s>", SDATA (SYMBOL_NAME (key)));
- result = build_string (buffer);
+ Lisp_Object namestr = SYMBOL_NAME (key);
+ const char *sym = SSDATA (namestr);
+ ptrdiff_t len = SBYTES (namestr);
+ /* Find the extent of the modifier prefix, like "C-M-". */
+ int i = 0;
+ while (i < len - 3 && sym[i + 1] == '-' && strchr ("CMSsHA", sym[i]))
+ i += 2;
+ /* First I bytes of SYM are modifiers; put <> around the rest. */
+ char *buffer = SAFE_ALLOCA (len + 3);
+ memcpy (buffer, sym, i);
+ buffer[i] = '<';
+ memcpy (buffer + i + 1, sym + i, len - i);
+ buffer [len + 1] = '>';
+ buffer [len + 2] = '\0';
+ Lisp_Object result = build_string (buffer);
SAFE_FREE ();
return result;
}
@@ -2406,7 +2289,6 @@ where_is_internal (Lisp_Object definition, Lisp_Object keymaps,
bool noindirect, bool nomenus)
{
Lisp_Object maps = Qnil;
- Lisp_Object found;
struct where_is_internal_data data;
/* Only important use of caching is for the menubar
@@ -2432,7 +2314,7 @@ where_is_internal (Lisp_Object definition, Lisp_Object keymaps,
we're filling it up. */
where_is_cache = Qnil;
- found = keymaps;
+ Lisp_Object found = keymaps;
while (CONSP (found))
{
maps =
@@ -2541,8 +2423,7 @@ The optional 5th arg NO-REMAP alters how command remapping is handled:
/* Whether or not we're handling remapped sequences. This is needed
because remapping is not done recursively by Fcommand_remapping: you
can't remap a remapped command. */
- bool remapped = 0;
- Lisp_Object tem = Qnil;
+ bool remapped = false;
/* Refresh the C version of the modifier preference. */
where_is_preferred_modifier
@@ -2556,7 +2437,7 @@ The optional 5th arg NO-REMAP alters how command remapping is handled:
else
keymaps = Fcurrent_active_maps (Qnil, Qnil);
- tem = Fcommand_remapping (definition, Qnil, keymaps);
+ Lisp_Object tem = Fcommand_remapping (definition, Qnil, keymaps);
/* If `definition' is remapped to `tem', then OT1H no key will run
that command (since they will run `tem' instead), so we should
return nil; but OTOH all keys bound to `definition' (or to `tem')
@@ -2598,7 +2479,7 @@ The optional 5th arg NO-REMAP alters how command remapping is handled:
considered remapped sequences yet, copy them over and
process them. */
|| (!remapped && (sequences = remapped_sequences,
- remapped = 1,
+ remapped = true,
CONSP (sequences))))
{
Lisp_Object sequence, function;
@@ -2744,9 +2625,7 @@ The optional argument MENUS, if non-nil, says to mention menu bindings.
\(Ordinarily these are omitted from the output.) */)
(Lisp_Object buffer, Lisp_Object prefix, Lisp_Object menus)
{
- Lisp_Object outbuf, shadow;
Lisp_Object nomenu = NILP (menus) ? Qt : Qnil;
- Lisp_Object start1;
const char *alternate_heading
= "\
@@ -2756,17 +2635,16 @@ You type Translation\n\
CHECK_BUFFER (buffer);
- shadow = Qnil;
- outbuf = Fcurrent_buffer ();
+ Lisp_Object shadow = Qnil;
+ Lisp_Object outbuf = Fcurrent_buffer ();
/* Report on alternates for keys. */
if (STRINGP (KVAR (current_kboard, Vkeyboard_translate_table)) && !NILP (prefix))
{
- int c;
const unsigned char *translate = SDATA (KVAR (current_kboard, Vkeyboard_translate_table));
int translate_len = SCHARS (KVAR (current_kboard, Vkeyboard_translate_table));
- for (c = 0; c < translate_len; c++)
+ for (int c = 0; c < translate_len; c++)
if (translate[c] != c)
{
char buf[KEY_DESCRIPTION_SIZE];
@@ -2803,7 +2681,7 @@ You type Translation\n\
}
/* Print the (major mode) local map. */
- start1 = Qnil;
+ Lisp_Object start1 = Qnil;
if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map)))
start1 = KVAR (current_kboard, Voverriding_terminal_local_map);
@@ -2832,14 +2710,13 @@ You type Translation\n\
else
{
/* Print the minor mode and major mode keymaps. */
- int i, nmaps;
Lisp_Object *modes, *maps;
/* Temporarily switch to `buffer', so that we can get that buffer's
minor modes correctly. */
Fset_buffer (buffer);
- nmaps = current_minor_maps (&modes, &maps);
+ int nmaps = current_minor_maps (&modes, &maps);
Fset_buffer (outbuf);
start1 = get_local_map (BUF_PT (XBUFFER (buffer)),
@@ -2855,7 +2732,7 @@ You type Translation\n\
}
/* Print the minor mode maps. */
- for (i = 0; i < nmaps; i++)
+ for (int i = 0; i < nmaps; i++)
{
/* The title for a minor mode keymap
is constructed at run time.
@@ -2926,7 +2803,7 @@ You type Translation\n\
CALLN (Ffuncall,
Qdescribe_map_tree,
KVAR (current_kboard, Vlocal_function_key_map), Qnil, Qnil, prefix,
- msg, nomenu, Qt, Qt, Qt);
+ msg, nomenu, Qt, Qnil, Qnil);
}
/* Print the input-decode-map translations under this prefix. */
@@ -3042,21 +2919,11 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
bool partial, Lisp_Object shadow, Lisp_Object entire_map,
bool keymap_p, bool mention_shadow)
{
- Lisp_Object definition;
- Lisp_Object tem2;
Lisp_Object elt_prefix = Qnil;
- int i;
- Lisp_Object suppress;
- Lisp_Object kludge;
- bool first = 1;
+ Lisp_Object suppress = Qnil;
+ bool first = true;
/* Range of elements to be handled. */
int from, to, stop;
- Lisp_Object character;
- int starting_i;
-
- suppress = Qnil;
-
- definition = Qnil;
if (!keymap_p)
{
@@ -3071,7 +2938,7 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
/* This vector gets used to present single keys to Flookup_key. Since
that is done once per vector element, we don't want to cons up a
fresh vector every time. */
- kludge = make_nil_vector (1);
+ Lisp_Object kludge = make_nil_vector (1);
if (partial)
suppress = intern ("suppress-keymap");
@@ -3082,11 +2949,12 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
else
stop = to = ASIZE (vector);
- for (i = from; ; i++)
+ for (int i = from; ; i++)
{
- bool this_shadowed = 0;
+ bool this_shadowed = false;
+ Lisp_Object shadowed_by = Qnil;
int range_beg, range_end;
- Lisp_Object val;
+ Lisp_Object val, tem2;
maybe_quit ();
@@ -3097,7 +2965,7 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
stop = to;
}
- starting_i = i;
+ int starting_i = i;
if (CHAR_TABLE_P (vector))
{
@@ -3107,34 +2975,30 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
}
else
val = AREF (vector, i);
- definition = get_keyelt (val, 0);
+ Lisp_Object definition = get_keyelt (val, 0);
if (NILP (definition)) continue;
/* Don't mention suppressed commands. */
if (SYMBOLP (definition) && partial)
{
- Lisp_Object tem;
-
- tem = Fget (definition, suppress);
+ Lisp_Object tem = Fget (definition, suppress);
if (!NILP (tem)) continue;
}
- character = make_fixnum (starting_i);
+ Lisp_Object character = make_fixnum (starting_i);
ASET (kludge, 0, character);
/* If this binding is shadowed by some other map, ignore it. */
if (!NILP (shadow))
{
- Lisp_Object tem;
+ shadowed_by = shadow_lookup (shadow, kludge, Qt, 0);
- tem = shadow_lookup (shadow, kludge, Qt, 0);
-
- if (!NILP (tem))
+ if (!NILP (shadowed_by) && !EQ (shadowed_by, definition))
{
if (mention_shadow)
- this_shadowed = 1;
+ this_shadowed = true;
else
continue;
}
@@ -3144,9 +3008,7 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
one in the same keymap. */
if (!NILP (entire_map))
{
- Lisp_Object tem;
-
- tem = Flookup_key (entire_map, kludge, Qt);
+ Lisp_Object tem = Flookup_key (entire_map, kludge, Qt);
if (!EQ (tem, definition))
continue;
@@ -3155,7 +3017,7 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
if (first)
{
insert ("\n", 1);
- first = 0;
+ first = false;
}
/* Output the prefix that applies to every entry in this map. */
@@ -3165,9 +3027,9 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
insert1 (Fkey_description (kludge, prefix));
/* Find all consecutive characters or rows that have the same
- definition. But, VECTOR is a char-table, we had better put a
- boundary between normal characters (-#x3FFF7F) and 8-bit
- characters (#x3FFF80-). */
+ definition. But, if VECTOR is a char-table, we had better
+ put a boundary between normal characters (-#x3FFF7F) and
+ 8-bit characters (#x3FFF80-). */
if (CHAR_TABLE_P (vector))
{
while (i + 1 < stop
@@ -3186,6 +3048,20 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
&& !NILP (Fequal (tem2, definition)))
i++;
+ /* Make sure found consecutive keys are either not shadowed or,
+ if they are, that they are shadowed by the same command. */
+ if (CHAR_TABLE_P (vector) && i != starting_i)
+ {
+ Lisp_Object key = make_nil_vector (1);
+ for (int j = starting_i + 1; j <= i; j++)
+ {
+ ASET (key, 0, make_fixnum (j));
+ Lisp_Object tem = shadow_lookup (shadow, key, Qt, 0);
+ if (NILP (Fequal (tem, shadowed_by)))
+ i = j - 1;
+ }
+ }
+
/* If we have a range of more than one character,
print where the range reaches to. */
@@ -3209,7 +3085,13 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
if (this_shadowed)
{
SET_PT (PT - 1);
- insert_string (" (binding currently shadowed)");
+ static char const fmt[] = " (currently shadowed by `%s')";
+ USE_SAFE_ALLOCA;
+ char *buffer = SAFE_ALLOCA (sizeof fmt +
+ SBYTES (SYMBOL_NAME (shadowed_by)));
+ esprintf (buffer, fmt, SDATA (SYMBOL_NAME (shadowed_by)));
+ insert_string (buffer);
+ SAFE_FREE();
SET_PT (PT + 1);
}
}
@@ -3223,49 +3105,11 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
}
}
-/* Apropos - finding all symbols whose names match a regexp. */
-static Lisp_Object apropos_predicate;
-static Lisp_Object apropos_accumulate;
-
-static void
-apropos_accum (Lisp_Object symbol, Lisp_Object string)
-{
- register Lisp_Object tem;
-
- tem = Fstring_match (string, Fsymbol_name (symbol), Qnil);
- if (!NILP (tem) && !NILP (apropos_predicate))
- tem = call1 (apropos_predicate, symbol);
- if (!NILP (tem))
- apropos_accumulate = Fcons (symbol, apropos_accumulate);
-}
-
-DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0,
- doc: /* Show all symbols whose names contain match for REGEXP.
-If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done
-for each symbol and a symbol is mentioned only if that returns non-nil.
-Return list of symbols found. */)
- (Lisp_Object regexp, Lisp_Object predicate)
-{
- Lisp_Object tem;
- CHECK_STRING (regexp);
- apropos_predicate = predicate;
- apropos_accumulate = Qnil;
- map_obarray (Vobarray, apropos_accum, regexp);
- tem = Fsort (apropos_accumulate, Qstring_lessp);
- apropos_accumulate = Qnil;
- apropos_predicate = Qnil;
- return tem;
-}
-
void
syms_of_keymap (void)
{
DEFSYM (Qkeymap, "keymap");
DEFSYM (Qdescribe_map_tree, "describe-map-tree");
- staticpro (&apropos_predicate);
- staticpro (&apropos_accumulate);
- apropos_predicate = Qnil;
- apropos_accumulate = Qnil;
DEFSYM (Qkeymap_canonicalize, "keymap-canonicalize");
@@ -3277,21 +3121,9 @@ syms_of_keymap (void)
Each one is the value of a Lisp variable, and is also
pointed to by a C variable */
- global_map = Fmake_keymap (Qnil);
- Fset (intern_c_string ("global-map"), global_map);
-
- current_global_map = global_map;
- staticpro (&global_map);
+ current_global_map = Qnil;
staticpro (&current_global_map);
- meta_map = Fmake_keymap (Qnil);
- Fset (intern_c_string ("esc-map"), meta_map);
- Ffset (intern_c_string ("ESC-prefix"), meta_map);
-
- control_x_map = Fmake_keymap (Qnil);
- Fset (intern_c_string ("ctl-x-map"), control_x_map);
- Ffset (intern_c_string ("Control-X-prefix"), control_x_map);
-
exclude_keys = pure_list
(pure_cons (build_pure_c_string ("DEL"), build_pure_c_string ("\\d")),
pure_cons (build_pure_c_string ("TAB"), build_pure_c_string ("\\t")),
@@ -3388,12 +3220,9 @@ be preferred. */);
defsubr (&Scopy_keymap);
defsubr (&Scommand_remapping);
defsubr (&Skey_binding);
- defsubr (&Slocal_key_binding);
- defsubr (&Sglobal_key_binding);
defsubr (&Sminor_mode_key_binding);
defsubr (&Sdefine_key);
defsubr (&Slookup_key);
- defsubr (&Sdefine_prefix_command);
defsubr (&Suse_global_map);
defsubr (&Suse_local_map);
defsubr (&Scurrent_local_map);
@@ -3409,12 +3238,4 @@ be preferred. */);
defsubr (&Stext_char_description);
defsubr (&Swhere_is_internal);
defsubr (&Sdescribe_buffer_bindings);
- defsubr (&Sapropos_internal);
-}
-
-void
-keys_of_keymap (void)
-{
- initial_define_key (global_map, 033, "ESC-prefix");
- initial_define_key (global_map, Ctl ('X'), "Control-X-prefix");
}
diff --git a/src/keymap.h b/src/keymap.h
index 2f7df2bd955..f417301c8f2 100644
--- a/src/keymap.h
+++ b/src/keymap.h
@@ -1,5 +1,5 @@
/* Functions to manipulate keymaps.
- Copyright (C) 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -37,10 +37,8 @@ extern char *push_key_description (EMACS_INT, char *);
extern Lisp_Object access_keymap (Lisp_Object, Lisp_Object, bool, bool, bool);
extern Lisp_Object get_keymap (Lisp_Object, bool, bool);
extern ptrdiff_t current_minor_maps (Lisp_Object **, Lisp_Object **);
-extern void initial_define_key (Lisp_Object, int, const char *);
extern void initial_define_lispy_key (Lisp_Object, const char *, const char *);
extern void syms_of_keymap (void);
-extern void keys_of_keymap (void);
typedef void (*map_keymap_function_t)
(Lisp_Object key, Lisp_Object val, Lisp_Object args, void *data);
diff --git a/src/kqueue.c b/src/kqueue.c
index adbb8d92c0b..0a0650d2081 100644
--- a/src/kqueue.c
+++ b/src/kqueue.c
@@ -1,6 +1,6 @@
/* Filesystem notifications support with kqueue API.
-Copyright (C) 2015-2020 Free Software Foundation, Inc.
+Copyright (C) 2015-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -128,7 +128,7 @@ kqueue_compare_dir_list (Lisp_Object watch_object)
return;
}
new_directory_files =
- directory_files_internal (dir, Qnil, Qnil, Qnil, true, Qnil);
+ directory_files_internal (dir, Qnil, Qnil, Qnil, true, Qnil, Qnil);
new_dl = kqueue_directory_listing (new_directory_files);
/* Parse through the old list. */
@@ -452,7 +452,8 @@ only when the upper directory of the renamed file is watched. */)
if (NILP (Ffile_directory_p (file)))
watch_object = list4 (watch_descriptor, file, flags, callback);
else {
- dir_list = directory_files_internal (file, Qnil, Qnil, Qnil, true, Qnil);
+ dir_list = directory_files_internal (file, Qnil, Qnil, Qnil, true, Qnil,
+ Qnil);
watch_object = list5 (watch_descriptor, file, flags, callback, dir_list);
}
watch_list = Fcons (watch_object, watch_list);
diff --git a/src/lastfile.c b/src/lastfile.c
index 7ddfe23d3dd..7df6cf10b12 100644
--- a/src/lastfile.c
+++ b/src/lastfile.c
@@ -1,5 +1,5 @@
/* Mark end of data space to dump as pure, for GNU Emacs.
- Copyright (C) 1985, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1985, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/lcms.c b/src/lcms.c
index 924bdd299dc..b998c8c4eb2 100644
--- a/src/lcms.c
+++ b/src/lcms.c
@@ -1,5 +1,5 @@
/* Interface to Little CMS
- Copyright (C) 2017-2020 Free Software Foundation, Inc.
+ Copyright (C) 2017-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/lisp.h b/src/lisp.h
index 45353fbef3d..f6588685443 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -1,6 +1,6 @@
/* Fundamental definitions for GNU Emacs Lisp interpreter. -*- coding: utf-8 -*-
-Copyright (C) 1985-1987, 1993-1995, 1997-2020 Free Software Foundation,
+Copyright (C) 1985-1987, 1993-1995, 1997-2021 Free Software Foundation,
Inc.
This file is part of GNU Emacs.
@@ -1478,8 +1478,8 @@ struct Lisp_String
{
struct
{
- ptrdiff_t size;
- ptrdiff_t size_byte;
+ ptrdiff_t size; /* MSB is used as the markbit. */
+ ptrdiff_t size_byte; /* Set to -1 for unibyte strings. */
INTERVAL intervals; /* Text properties in this string. */
unsigned char *data;
} s;
@@ -1897,16 +1897,17 @@ ASCII_CHAR_P (intmax_t c)
return 0 <= c && c < 0x80;
}
-/* A char-table is a kind of vectorlike, with contents are like a
- vector but with a few other slots. For some purposes, it makes
- sense to handle a char-table with type struct Lisp_Vector. An
- element of a char table can be any Lisp objects, but if it is a sub
- char-table, we treat it a table that contains information of a
- specific range of characters. A sub char-table is like a vector but
- with two integer fields between the header and Lisp data, which means
+/* A char-table is a kind of vectorlike, with contents like a vector,
+ but with a few additional slots. For some purposes, it makes sense
+ to handle a char-table as type 'struct Lisp_Vector'. An element of
+ a char-table can be any Lisp object, but if it is a sub-char-table,
+ we treat it as a table that contains information of a specific
+ range of characters. A sub-char-table is like a vector, but with
+ two integer fields between the header and Lisp data, which means
that it has to be marked with some precautions (see mark_char_table
- in alloc.c). A sub char-table appears only in an element of a char-table,
- and there's no way to access it directly from Emacs Lisp program. */
+ in alloc.c). A sub-char-table appears only in an element of a
+ char-table, and there's no way to access it directly from a Lisp
+ program. */
enum CHARTAB_SIZE_BITS
{
@@ -1926,11 +1927,11 @@ struct Lisp_Char_Table
contents, and extras slots. */
union vectorlike_header header;
- /* This holds a default value,
- which is used whenever the value for a specific character is nil. */
+ /* This holds the default value, which is used whenever the value
+ for a specific character is nil. */
Lisp_Object defalt;
- /* This points to another char table, which we inherit from when the
+ /* This points to another char table, from which we inherit when the
value for a specific character is nil. The `defalt' slot takes
precedence over this. */
Lisp_Object parent;
@@ -1939,8 +1940,8 @@ struct Lisp_Char_Table
meant for. */
Lisp_Object purpose;
- /* The bottom sub char-table for characters of the range 0..127. It
- is nil if none of ASCII character has a specific value. */
+ /* The bottom sub char-table for characters in the range 0..127. It
+ is nil if no ASCII character has a specific value. */
Lisp_Object ascii;
Lisp_Object contents[(1 << CHARTAB_SIZE_BITS_0)];
@@ -2015,7 +2016,7 @@ CHAR_TABLE_REF_ASCII (Lisp_Object ct, ptrdiff_t idx)
}
/* Almost equivalent to Faref (CT, IDX) with optimization for ASCII
- characters. Do not check validity of CT. */
+ characters. Does not check validity of CT. */
INLINE Lisp_Object
CHAR_TABLE_REF (Lisp_Object ct, int idx)
{
@@ -2025,7 +2026,7 @@ CHAR_TABLE_REF (Lisp_Object ct, int idx)
}
/* Equivalent to Faset (CT, IDX, VAL) with optimization for ASCII and
- 8-bit European characters. Do not check validity of CT. */
+ 8-bit European characters. Does not check validity of CT. */
INLINE void
CHAR_TABLE_SET (Lisp_Object ct, int idx, Lisp_Object val)
{
@@ -3124,9 +3125,13 @@ enum specbind_tag {
SPECPDL_UNWIND_PTR, /* Likewise, on void *. */
SPECPDL_UNWIND_INT, /* Likewise, on int. */
SPECPDL_UNWIND_INTMAX, /* Likewise, on intmax_t. */
- SPECPDL_UNWIND_EXCURSION, /* Likewise, on an execursion. */
+ SPECPDL_UNWIND_EXCURSION, /* Likewise, on an excursion. */
SPECPDL_UNWIND_VOID, /* Likewise, with no arg. */
SPECPDL_BACKTRACE, /* An element of the backtrace. */
+#ifdef HAVE_MODULES
+ SPECPDL_MODULE_RUNTIME, /* A live module runtime. */
+ SPECPDL_MODULE_ENVIRONMENT, /* A live module environment. */
+#endif
SPECPDL_LET, /* A plain and simple dynamic let-binding. */
/* Tags greater than SPECPDL_LET must be "subkinds" of LET. */
SPECPDL_LET_LOCAL, /* A buffer-local let-binding. */
@@ -3556,7 +3561,6 @@ extern void swap_in_global_binding (struct Lisp_Symbol *);
/* Defined in cmds.c */
extern void syms_of_cmds (void);
-extern void keys_of_cmds (void);
/* Defined in coding.c. */
extern Lisp_Object detect_coding_system (const unsigned char *, ptrdiff_t,
@@ -3711,6 +3715,7 @@ extern Lisp_Object echo_area_buffer[2];
extern void add_to_log (char const *, ...);
extern void vadd_to_log (char const *, va_list);
extern void check_message_stack (void);
+extern void clear_message_stack (void);
extern void setup_echo_area_for_printing (bool);
extern bool push_message (void);
extern void pop_message_unwind (void);
@@ -3793,6 +3798,7 @@ flush_stack_call_func (void (*func) (void *arg), void *arg)
extern void garbage_collect (void);
extern void maybe_garbage_collect (void);
+extern bool maybe_garbage_collect_eagerly (EMACS_INT factor);
extern const char *pending_malloc_warning;
extern Lisp_Object zero_vector;
extern EMACS_INT consing_until_gc;
@@ -4146,6 +4152,7 @@ extern void record_unwind_protect_intmax (void (*) (intmax_t), intmax_t);
extern void record_unwind_protect_void (void (*) (void));
extern void record_unwind_protect_excursion (void);
extern void record_unwind_protect_nothing (void);
+extern void record_unwind_protect_module (enum specbind_tag, void *);
extern void clear_unwind_protect (ptrdiff_t);
extern void set_unwind_protect (ptrdiff_t, void (*) (Lisp_Object), Lisp_Object);
extern void set_unwind_protect_ptr (ptrdiff_t, void (*) (void *), void *);
@@ -4216,7 +4223,9 @@ extern module_funcptr module_function_address
(struct Lisp_Module_Function const *);
extern void *module_function_data (const struct Lisp_Module_Function *);
extern void module_finalize_function (const struct Lisp_Module_Function *);
-extern void mark_modules (void);
+extern void mark_module_environment (void *);
+extern void finalize_runtime_unwind (void *);
+extern void finalize_environment_unwind (void *);
extern void init_module_assertions (bool);
extern void syms_of_module (void);
#endif
@@ -4252,7 +4261,6 @@ extern Lisp_Object get_truename_buffer (Lisp_Object);
extern void init_buffer_once (void);
extern void init_buffer (void);
extern void syms_of_buffer (void);
-extern void keys_of_buffer (void);
/* Defined in marker.c. */
@@ -4336,9 +4344,14 @@ extern void clear_regexp_cache (void);
extern Lisp_Object Vminibuffer_list;
extern Lisp_Object last_minibuf_string;
+extern void move_minibuffer_onto_frame (void);
+extern bool is_minibuffer (EMACS_INT, Lisp_Object);
+extern EMACS_INT this_minibuffer_depth (Lisp_Object);
+extern EMACS_INT minibuf_level;
extern Lisp_Object get_minibuffer (EMACS_INT);
extern void init_minibuf_once (void);
extern void syms_of_minibuf (void);
+extern void barf_if_interaction_inhibited (void);
/* Defined in callint.c. */
@@ -4347,7 +4360,6 @@ extern void syms_of_callint (void);
/* Defined in casefiddle.c. */
extern void syms_of_casefiddle (void);
-extern void keys_of_casefiddle (void);
/* Defined in casetab.c. */
@@ -4481,32 +4493,20 @@ extern void setup_process_coding_systems (Lisp_Object);
/* Defined in callproc.c. */
#ifdef DOS_NT
-# define CHILD_SETUP_TYPE int
# define CHILD_SETUP_ERROR_DESC "Spawning child process"
#else
-# define CHILD_SETUP_TYPE _Noreturn void
# define CHILD_SETUP_ERROR_DESC "Doing vfork"
#endif
-extern CHILD_SETUP_TYPE child_setup (int, int, int, char **, bool, Lisp_Object);
+extern int emacs_spawn (pid_t *, int, int, int, char **, char **,
+ const char *, const char *, const sigset_t *);
+extern char **make_environment_block (Lisp_Object);
extern void init_callproc_1 (void);
extern void init_callproc (void);
extern void set_initial_environment (void);
extern void syms_of_callproc (void);
/* Defined in doc.c. */
-enum text_quoting_style
- {
- /* Use curved single quotes ‘like this’. */
- CURVE_QUOTING_STYLE,
-
- /* Use grave accent and apostrophe `like this'. */
- GRAVE_QUOTING_STYLE,
-
- /* Use apostrophes 'like this'. */
- STRAIGHT_QUOTING_STYLE
- };
-extern enum text_quoting_style text_quoting_style (void);
extern Lisp_Object read_doc_string (Lisp_Object);
extern Lisp_Object get_doc_string (Lisp_Object, bool, bool);
extern void syms_of_doc (void);
@@ -4578,6 +4578,7 @@ extern AVOID emacs_abort (void) NO_INLINE;
extern int emacs_fstatat (int, char const *, void *, int);
extern int emacs_openat (int, char const *, int, int);
extern int emacs_open (const char *, int, int);
+extern int emacs_open_noquit (const char *, int, int);
extern int emacs_pipe (int[2]);
extern int emacs_close (int);
extern ptrdiff_t emacs_read (int, void *, ptrdiff_t);
@@ -4612,7 +4613,7 @@ extern void syms_of_ccl (void);
extern void syms_of_dired (void);
extern Lisp_Object directory_files_internal (Lisp_Object, Lisp_Object,
Lisp_Object, Lisp_Object,
- bool, Lisp_Object);
+ bool, Lisp_Object, Lisp_Object);
/* Defined in term.c. */
extern int *char_ins_del_vector;
diff --git a/src/lread.c b/src/lread.c
index a3d5fd7bb81..72b68df6631 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -1,6 +1,6 @@
/* Lisp parsing and input streams.
-Copyright (C) 1985-1989, 1993-1995, 1997-2020 Free Software Foundation,
+Copyright (C) 1985-1989, 1993-1995, 1997-2021 Free Software Foundation,
Inc.
This file is part of GNU Emacs.
@@ -767,11 +767,16 @@ is used for reading a character.
If the optional argument SECONDS is non-nil, it should be a number
specifying the maximum number of seconds to wait for input. If no
input arrives in that time, return nil. SECONDS may be a
-floating-point value. */)
+floating-point value.
+
+If `inhibit-interaction' is non-nil, this function will signal an
+`inhibited-interaction' error. */)
(Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
{
Lisp_Object val;
+ barf_if_interaction_inhibited ();
+
if (! NILP (prompt))
message_with_string ("%s", prompt, 0);
val = read_filtered_event (1, 1, 1, ! NILP (inherit_input_method), seconds);
@@ -782,6 +787,12 @@ floating-point value. */)
DEFUN ("read-event", Fread_event, Sread_event, 0, 3, 0,
doc: /* Read an event object from the input stream.
+
+If you want to read non-character events, consider calling `read-key'
+instead. `read-key' will decode events via `input-decode-map' that
+`read-event' will not. On a terminal this includes function keys such
+as <F7> and <RIGHT>, or mouse events generated by `xterm-mouse-mode'.
+
If the optional argument PROMPT is non-nil, display that as a prompt.
If PROMPT is nil or the string \"\", the key sequence/events that led
to the current command is used as the prompt.
@@ -793,9 +804,14 @@ is used for reading a character.
If the optional argument SECONDS is non-nil, it should be a number
specifying the maximum number of seconds to wait for input. If no
input arrives in that time, return nil. SECONDS may be a
-floating-point value. */)
+floating-point value.
+
+If `inhibit-interaction' is non-nil, this function will signal an
+`inhibited-interaction' error. */)
(Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
{
+ barf_if_interaction_inhibited ();
+
if (! NILP (prompt))
message_with_string ("%s", prompt, 0);
return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method), seconds);
@@ -822,11 +838,16 @@ is used for reading a character.
If the optional argument SECONDS is non-nil, it should be a number
specifying the maximum number of seconds to wait for input. If no
input arrives in that time, return nil. SECONDS may be a
-floating-point value. */)
- (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
+floating-point value.
+
+If `inhibit-interaction' is non-nil, this function will signal an
+`inhibited-interaction' error. */)
+(Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
{
Lisp_Object val;
+ barf_if_interaction_inhibited ();
+
if (! NILP (prompt))
message_with_string ("%s", prompt, 0);
@@ -3438,7 +3459,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
/* Any modifiers remaining are invalid. */
if (modifiers)
- error ("Invalid modifier in string");
+ invalid_syntax ("Invalid modifier in string");
p += CHAR_STRING (ch, (unsigned char *) p);
}
else
diff --git a/src/macfont.h b/src/macfont.h
index 1341030f353..0ec11f513c0 100644
--- a/src/macfont.h
+++ b/src/macfont.h
@@ -1,5 +1,5 @@
/* Interface definition for macOS Core text font backend.
- Copyright (C) 2009-2020 Free Software Foundation, Inc.
+ Copyright (C) 2009-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/macfont.m b/src/macfont.m
index 904814647f9..d86f09f4850 100644
--- a/src/macfont.m
+++ b/src/macfont.m
@@ -1,5 +1,5 @@
/* Font driver on macOS Core text.
- Copyright (C) 2009-2020 Free Software Foundation, Inc.
+ Copyright (C) 2009-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/macros.c b/src/macros.c
index 6006c863729..c8ce94e63b1 100644
--- a/src/macros.c
+++ b/src/macros.c
@@ -1,6 +1,6 @@
/* Keyboard macros.
-Copyright (C) 1985-1986, 1993, 2000-2020 Free Software Foundation, Inc.
+Copyright (C) 1985-1986, 1993, 2000-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/macros.h b/src/macros.h
index d1d516bd837..23167a0763d 100644
--- a/src/macros.h
+++ b/src/macros.h
@@ -1,5 +1,5 @@
/* Definitions for keyboard macro interpretation in GNU Emacs.
- Copyright (C) 1985, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1985, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/marker.c b/src/marker.c
index 64f210db88b..59791513170 100644
--- a/src/marker.c
+++ b/src/marker.c
@@ -1,5 +1,5 @@
/* Markers: examining, setting and deleting.
- Copyright (C) 1985, 1997-1998, 2001-2020 Free Software Foundation,
+ Copyright (C) 1985, 1997-1998, 2001-2021 Free Software Foundation,
Inc.
This file is part of GNU Emacs.
diff --git a/src/menu.c b/src/menu.c
index e4fda572cd8..3b1d7402571 100644
--- a/src/menu.c
+++ b/src/menu.c
@@ -1,6 +1,6 @@
/* Platform-independent code for terminal communications.
-Copyright (C) 1986, 1988, 1993-1994, 1996, 1999-2020 Free Software
+Copyright (C) 1986, 1988, 1993-1994, 1996, 1999-2021 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/menu.h b/src/menu.h
index 44749ade75a..6c67ab20bb0 100644
--- a/src/menu.h
+++ b/src/menu.h
@@ -1,5 +1,5 @@
/* Functions to manipulate menus.
- Copyright (C) 2008-2020 Free Software Foundation, Inc.
+ Copyright (C) 2008-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/minibuf.c b/src/minibuf.c
index f957b2ae173..5df10453739 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -1,6 +1,6 @@
/* Minibuffer input and completion.
-Copyright (C) 1985-1986, 1993-2020 Free Software Foundation, Inc.
+Copyright (C) 1985-1986, 1993-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -63,7 +63,34 @@ static Lisp_Object minibuf_prompt;
static ptrdiff_t minibuf_prompt_width;
+static Lisp_Object nth_minibuffer (EMACS_INT depth);
+
+/* Return TRUE when a frame switch causes a minibuffer on the old
+ frame to move onto the new one. */
+static bool
+minibuf_follows_frame (void)
+{
+ return EQ (Fdefault_toplevel_value (Qminibuffer_follows_selected_frame),
+ Qt);
+}
+
+/* Return TRUE when a minibuffer always remains on the frame where it
+ was first invoked. */
+static bool
+minibuf_stays_put (void)
+{
+ return NILP (Fdefault_toplevel_value (Qminibuffer_follows_selected_frame));
+}
+
+/* Return TRUE when opening a (recursive) minibuffer causes
+ minibuffers on other frames to move to the selected frame. */
+static bool
+minibuf_moves_frame_when_opened (void)
+{
+ return !NILP (Fdefault_toplevel_value (Qminibuffer_follows_selected_frame));
+}
+
/* Put minibuf on currently selected frame's minibuffer.
We do this whenever the user starts a new minibuffer
or when a minibuffer exits. */
@@ -76,39 +103,88 @@ choose_minibuf_frame (void)
&& !EQ (minibuf_window, XFRAME (selected_frame)->minibuffer_window))
{
struct frame *sf = XFRAME (selected_frame);
- Lisp_Object buffer;
-
/* I don't think that any frames may validly have a null minibuffer
window anymore. */
if (NILP (sf->minibuffer_window))
emacs_abort ();
- /* Under X, we come here with minibuf_window being the
- minibuffer window of the unused termcap window created in
- init_window_once. That window doesn't have a buffer. */
- buffer = XWINDOW (minibuf_window)->contents;
- if (BUFFERP (buffer))
- /* Use set_window_buffer instead of Fset_window_buffer (see
- discussion of bug#11984, bug#12025, bug#12026). */
- set_window_buffer (sf->minibuffer_window, buffer, 0, 0);
minibuf_window = sf->minibuffer_window;
+ /* If we've still got another minibuffer open, use its mini-window
+ instead. */
+ if (minibuf_level > 1 && minibuf_stays_put ())
+ {
+ Lisp_Object buffer = get_minibuffer (minibuf_level);
+ Lisp_Object tail, frame;
+
+ FOR_EACH_FRAME (tail, frame)
+ if (EQ (XWINDOW (XFRAME (frame)->minibuffer_window)->contents,
+ buffer))
+ {
+ minibuf_window = XFRAME (frame)->minibuffer_window;
+ break;
+ }
+ }
}
- /* Make sure no other frame has a minibuffer as its selected window,
- because the text would not be displayed in it, and that would be
- confusing. Only allow the selected frame to do this,
- and that only if the minibuffer is active. */
+ if (minibuf_moves_frame_when_opened ()
+ && FRAMEP (selected_frame)
+ && FRAME_LIVE_P (XFRAME (selected_frame)))
+ /* Make sure no other frame has a minibuffer as its selected window,
+ because the text would not be displayed in it, and that would be
+ confusing. Only allow the selected frame to do this,
+ and that only if the minibuffer is active. */
{
Lisp_Object tail, frame;
+ struct frame *of;
FOR_EACH_FRAME (tail, frame)
- if (MINI_WINDOW_P (XWINDOW (FRAME_SELECTED_WINDOW (XFRAME (frame))))
- && !(EQ (frame, selected_frame)
- && minibuf_level > 0))
- Fset_frame_selected_window (frame, Fframe_first_window (frame), Qnil);
+ if (!EQ (frame, selected_frame)
+ && minibuf_level > 1
+ /* The frame's minibuffer can be on a different frame. */
+ && ! EQ (XWINDOW ((of = XFRAME (frame))->minibuffer_window)->frame,
+ selected_frame))
+ {
+ if (MINI_WINDOW_P (XWINDOW (FRAME_SELECTED_WINDOW (of))))
+ Fset_frame_selected_window (frame, Fframe_first_window (frame),
+ Qnil);
+
+ if (!EQ (XWINDOW (of->minibuffer_window)->contents,
+ nth_minibuffer (0)))
+ set_window_buffer (of->minibuffer_window,
+ nth_minibuffer (0), 0, 0);
+ }
}
}
+/* If `minibuffer_follows_selected_frame' is t and we have a
+ minibuffer, move it from its current frame to the selected frame.
+ This function is intended to be called from `do_switch_frame' in
+ frame.c. */
+void move_minibuffer_onto_frame (void)
+{
+ if (!minibuf_level)
+ return;
+ if (!minibuf_follows_frame ())
+ return;
+ if (FRAMEP (selected_frame)
+ && FRAME_LIVE_P (XFRAME (selected_frame))
+ && !EQ (minibuf_window, XFRAME (selected_frame)->minibuffer_window))
+ {
+ EMACS_INT i;
+ struct frame *sf = XFRAME (selected_frame);
+ Lisp_Object old_frame = XWINDOW (minibuf_window)->frame;
+ struct frame *of = XFRAME (old_frame);
+
+ /* Stack up all the (recursively) open minibuffers on the selected
+ mini_window. */
+ for (i = 1; i <= minibuf_level; i++)
+ set_window_buffer (sf->minibuffer_window, nth_minibuffer (i), 0, 0);
+ minibuf_window = sf->minibuffer_window;
+ if (of != sf)
+ set_window_buffer (of->minibuffer_window, get_minibuffer (0), 0, 0);
+ }
+}
+
DEFUN ("active-minibuffer-window", Factive_minibuffer_window,
Sactive_minibuffer_window, 0, 0, 0,
doc: /* Return the currently active minibuffer window, or nil if none. */)
@@ -261,15 +337,31 @@ read_minibuf_noninteractive (Lisp_Object prompt, bool expflag,
return val;
}
+/* Return true when BUFFER is an active minibuffer. */
+static bool
+live_minibuffer_p (Lisp_Object buffer)
+{
+ Lisp_Object tem;
+ EMACS_INT i;
+
+ if (EQ (buffer, Fcar (Vminibuffer_list)))
+ /* *Minibuf-0* is never active. */
+ return false;
+ tem = Fcdr (Vminibuffer_list);
+ for (i = 1; i <= minibuf_level; i++, tem = Fcdr (tem))
+ if (EQ (Fcar (tem), buffer))
+ return true;
+ return false;
+}
+
DEFUN ("minibufferp", Fminibufferp,
- Sminibufferp, 0, 1, 0,
+ Sminibufferp, 0, 2, 0,
doc: /* Return t if BUFFER is a minibuffer.
No argument or nil as argument means use current buffer as BUFFER.
-BUFFER can be a buffer or a buffer name. */)
- (Lisp_Object buffer)
+BUFFER can be a buffer or a buffer name. If LIVE is non-nil, then
+return t only if BUFFER is an active minibuffer. */)
+ (Lisp_Object buffer, Lisp_Object live)
{
- Lisp_Object tem;
-
if (NILP (buffer))
buffer = Fcurrent_buffer ();
else if (STRINGP (buffer))
@@ -277,8 +369,67 @@ BUFFER can be a buffer or a buffer name. */)
else
CHECK_BUFFER (buffer);
- tem = Fmemq (buffer, Vminibuffer_list);
- return ! NILP (tem) ? Qt : Qnil;
+ return (NILP (live)
+ ? !NILP (Fmemq (buffer, Vminibuffer_list))
+ : live_minibuffer_p (buffer))
+ ? Qt : Qnil;
+}
+
+DEFUN ("innermost-minibuffer-p", Finnermost_minibuffer_p,
+ Sinnermost_minibuffer_p, 0, 1, 0,
+ doc: /* Return t if BUFFER is the most nested active minibuffer.
+No argument or nil as argument means use the current buffer as BUFFER. */)
+ (Lisp_Object buffer)
+{
+ if (NILP (buffer))
+ buffer = Fcurrent_buffer ();
+ return EQ (buffer, (Fcar (Fnthcdr (make_fixnum (minibuf_level),
+ Vminibuffer_list))))
+ ? Qt
+ : Qnil;
+}
+
+/* Return the nesting depth of the active minibuffer BUFFER, or 0 if
+ BUFFER isn't such a thing. If BUFFER is nil, this means use the current
+ buffer. */
+EMACS_INT
+this_minibuffer_depth (Lisp_Object buffer)
+{
+ EMACS_INT i;
+ Lisp_Object bufs;
+
+ if (NILP (buffer))
+ buffer = Fcurrent_buffer ();
+ for (i = 1, bufs = Fcdr (Vminibuffer_list);
+ i <= minibuf_level;
+ i++, bufs = Fcdr (bufs))
+ if (EQ (Fcar (bufs), buffer))
+ return i;
+ return 0;
+}
+
+DEFUN ("abort-minibuffers", Fabort_minibuffers, Sabort_minibuffers, 0, 0, "",
+ doc: /* Abort the current minibuffer.
+If we are not currently in the innermost minibuffer, prompt the user to
+confirm the aborting of the current minibuffer and all contained ones. */)
+ (void)
+{
+ EMACS_INT minibuf_depth = this_minibuffer_depth (Qnil);
+ Lisp_Object array[2];
+ AUTO_STRING (fmt, "Abort %s minibuffer levels? ");
+
+ if (!minibuf_depth)
+ error ("Not in a minibuffer");
+ if (minibuf_depth < minibuf_level)
+ {
+ array[0] = fmt;
+ array[1] = make_fixnum (minibuf_level - minibuf_depth + 1);
+ if (!NILP (Fyes_or_no_p (Fformat (2, array))))
+ Fthrow (Qexit, Qt);
+ }
+ else
+ Fthrow (Qexit, Qt);
+ return Qnil;
}
DEFUN ("minibuffer-prompt-end", Fminibuffer_prompt_end,
@@ -356,6 +507,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
Lisp_Object val;
ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object mini_frame, ambient_dir, minibuffer, input_method;
+ Lisp_Object calling_frame = selected_frame;
Lisp_Object enable_multibyte;
EMACS_INT pos = 0;
/* String to add to the history. */
@@ -433,6 +585,8 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
return unbind_to (count, val);
}
+ minibuf_level++; /* Before calling choose_minibuf_frame. */
+
/* Choose the minibuffer window and frame, and take action on them. */
/* Prepare for restoring the current buffer since choose_minibuf_frame
@@ -444,14 +598,18 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
record_unwind_protect_void (choose_minibuf_frame);
record_unwind_protect (restore_window_configuration,
- Fcurrent_window_configuration (Qnil));
+ Fcons (Qt, Fcurrent_window_configuration (Qnil)));
/* 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,
- Fcurrent_window_configuration (mini_frame));
+ Fcons (/* Arrange for the frame later to be
+ switched back to the calling
+ frame. */
+ Qnil,
+ Fcurrent_window_configuration (mini_frame)));
/* If the minibuffer is on an iconified or invisible frame,
make it visible now. */
@@ -484,7 +642,6 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
= Fcons (Fthis_command_keys_vector (), minibuf_save_list);
record_unwind_protect_void (read_minibuf_unwind);
- minibuf_level++;
/* We are exiting the minibuffer one way or the other, so run the hook.
It should be run before unwinding the minibuf settings. Do it
separately from read_minibuf_unwind because we need to make sure that
@@ -566,8 +723,8 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
if (minibuf_level == 1 || !EQ (minibuf_window, selected_window))
minibuf_selected_window = selected_window;
- /* Empty out the minibuffers of all frames other than the one
- where we are going to display one now.
+ /* Empty out the minibuffers of all frames, except those frames
+ where there is an active minibuffer.
Set them to point to ` *Minibuf-0*', which is always empty. */
empty_minibuf = get_minibuffer (0);
@@ -575,14 +732,30 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
{
Lisp_Object root_window = Fframe_root_window (frame);
Lisp_Object mini_window = XWINDOW (root_window)->next;
+ Lisp_Object buffer;
- if (! NILP (mini_window) && ! EQ (mini_window, minibuf_window)
- && !NILP (Fwindow_minibuffer_p (mini_window)))
- /* Use set_window_buffer instead of Fset_window_buffer (see
- discussion of bug#11984, bug#12025, bug#12026). */
- set_window_buffer (mini_window, empty_minibuf, 0, 0);
+ if (!NILP (mini_window) && !EQ (mini_window, minibuf_window)
+ && !NILP (Fwindow_minibuffer_p (mini_window)))
+ {
+ buffer = XWINDOW (mini_window)->contents;
+ if (!live_minibuffer_p (buffer))
+ /* Use set_window_buffer instead of Fset_window_buffer (see
+ discussion of bug#11984, bug#12025, bug#12026). */
+ set_window_buffer (mini_window, empty_minibuf, 0, 0);
+ }
}
+ 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). */
@@ -664,10 +837,25 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
recursive_edit_1 ();
+ /* We've exited the recursive edit without an error, so switch the
+ current window away from the expired minibuffer window. */
+ {
+ Lisp_Object prev = Fprevious_window (minibuf_window, Qnil, Qnil);
+ /* PREV can be on a different frame when we have a minibuffer only
+ frame, the other frame's minibuffer window is MINIBUF_WINDOW,
+ and its "focus window" is also MINIBUF_WINDOW. */
+ while (!EQ (prev, minibuf_window)
+ && !EQ (selected_frame, WINDOW_FRAME (XWINDOW (prev))))
+ prev = Fprevious_window (prev, Qnil, Qnil);
+ if (!EQ (prev, minibuf_window))
+ Fset_frame_selected_window (selected_frame, prev, Qnil);
+ }
+
/* If cursor is on the minibuffer line,
show the user we have exited by putting it in column 0. */
if (XWINDOW (minibuf_window)->cursor.vpos >= 0
- && !noninteractive)
+ && !noninteractive
+ && !FRAME_INITIAL_P (SELECTED_FRAME ()))
{
XWINDOW (minibuf_window)->cursor.hpos = 0;
XWINDOW (minibuf_window)->cursor.x = 0;
@@ -701,6 +889,12 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
in set-window-configuration. */
unbind_to (count, Qnil);
+ /* Switch the frame back to the calling frame. */
+ if (!EQ (selected_frame, calling_frame)
+ && FRAMEP (calling_frame)
+ && FRAME_LIVE_P (XFRAME (calling_frame)))
+ call2 (intern ("select-frame-set-input-focus"), calling_frame, Qnil);
+
/* Add the value to the appropriate history list, if any. This is
done after the previous buffer has been made current again, in
case the history variable is buffer-local. */
@@ -714,6 +908,24 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
return val;
}
+/* Return true if BUF is a particular existing minibuffer. */
+bool
+is_minibuffer (EMACS_INT depth, Lisp_Object buf)
+{
+ Lisp_Object tail = Fnthcdr (make_fixnum (depth), Vminibuffer_list);
+ return
+ !NILP (tail)
+ && EQ (Fcar (tail), buf);
+}
+
+/* Return the DEPTHth minibuffer, or nil if such does not yet exist. */
+static Lisp_Object
+nth_minibuffer (EMACS_INT depth)
+{
+ Lisp_Object tail = Fnthcdr (make_fixnum (depth), Vminibuffer_list);
+ return XCAR (tail);
+}
+
/* 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. */
@@ -733,7 +945,7 @@ get_minibuffer (EMACS_INT depth)
static char const name_fmt[] = " *Minibuf-%"pI"d*";
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);
+ buf = Fget_buffer_create (lname, Qnil);
/* Although the buffer's name starts with a space, undo should be
enabled in it. */
@@ -775,6 +987,7 @@ read_minibuf_unwind (void)
{
Lisp_Object old_deactivate_mark;
Lisp_Object window;
+ Lisp_Object future_mini_window;
/* If this was a recursive minibuffer,
tie the minibuffer window back to the outer level minibuffer buffer. */
@@ -809,6 +1022,7 @@ read_minibuf_unwind (void)
if (FRAME_LIVE_P (XFRAME (WINDOW_FRAME (XWINDOW (temp)))))
minibuf_window = temp;
#endif
+ future_mini_window = Fcar (minibuf_save_list);
minibuf_save_list = Fcdr (minibuf_save_list);
/* Erase the minibuffer we were using at this level. */
@@ -825,7 +1039,8 @@ read_minibuf_unwind (void)
/* When we get to the outmost level, make sure we resize the
mini-window back to its normal size. */
- if (minibuf_level == 0)
+ if (minibuf_level == 0
+ || !EQ (selected_frame, WINDOW_FRAME (XWINDOW (future_mini_window))))
resize_mini_window (XWINDOW (window), 0);
/* Deal with frames that should be removed when exiting the
@@ -860,6 +1075,13 @@ read_minibuf_unwind (void)
}
+void
+barf_if_interaction_inhibited (void)
+{
+ if (inhibit_interaction)
+ xsignal0 (Qinhibited_interaction);
+}
+
DEFUN ("read-from-minibuffer", Fread_from_minibuffer,
Sread_from_minibuffer, 1, 7, 0,
doc: /* Read a string from the minibuffer, prompting with string PROMPT.
@@ -904,6 +1126,9 @@ If the variable `minibuffer-allow-text-properties' is non-nil,
then the string which is returned includes whatever text properties
were present in the minibuffer. Otherwise the value has no text properties.
+If `inhibit-interaction' is non-nil, this function will signal an
+ `inhibited-interaction' error.
+
The remainder of this documentation string describes the
INITIAL-CONTENTS argument in more detail. It is only relevant when
studying existing code, or when HIST is a cons. If non-nil,
@@ -919,6 +1144,8 @@ and some related functions, which use zero-indexing for POSITION. */)
{
Lisp_Object histvar, histpos, val;
+ barf_if_interaction_inhibited ();
+
CHECK_STRING (prompt);
if (NILP (keymap))
keymap = Vminibuffer_local_map;
@@ -992,11 +1219,17 @@ point positioned at the end, so that SPACE will accept the input.
\(Actually, INITIAL can also be a cons of a string and an integer.
Such values are treated as in `read-from-minibuffer', but are normally
not useful in this function.)
+
Third arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer inherits
-the current input method and the setting of`enable-multibyte-characters'. */)
+the current input method and the setting of`enable-multibyte-characters'.
+
+If `inhibit-interaction' is non-nil, this function will signal an
+`inhibited-interaction' error. */)
(Lisp_Object prompt, Lisp_Object initial, Lisp_Object inherit_input_method)
{
CHECK_STRING (prompt);
+ barf_if_interaction_inhibited ();
+
return read_minibuf (Vminibuffer_local_ns_map, initial, prompt,
0, Qminibuffer_history, make_fixnum (0), Qnil, 0,
!NILP (inherit_input_method));
@@ -1911,6 +2144,8 @@ syms_of_minibuf (void)
staticpro (&minibuf_prompt);
staticpro (&minibuf_save_list);
+ DEFSYM (Qminibuffer_follows_selected_frame,
+ "minibuffer-follows-selected-frame");
DEFSYM (Qcompletion_ignore_case, "completion-ignore-case");
DEFSYM (Qminibuffer_default, "minibuffer-default");
Fset (Qminibuffer_default, Qnil);
@@ -1932,9 +2167,6 @@ syms_of_minibuf (void)
DEFSYM (Qminibuffer_setup_hook, "minibuffer-setup-hook");
DEFSYM (Qminibuffer_exit_hook, "minibuffer-exit-hook");
- /* The maximum length of a minibuffer history. */
- DEFSYM (Qhistory_length, "history-length");
-
DEFSYM (Qcurrent_input_method, "current-input-method");
DEFSYM (Qactivate_input_method, "activate-input-method");
DEFSYM (Qcase_fold_search, "case-fold-search");
@@ -1954,6 +2186,16 @@ For example, `eval-expression' uses this. */);
The function is called with the arguments passed to `read-buffer'. */);
Vread_buffer_function = Qnil;
+ DEFVAR_LISP ("minibuffer-follows-selected-frame", minibuffer_follows_selected_frame,
+ doc: /* t means the active minibuffer always displays on the selected frame.
+Nil means that a minibuffer will appear only in the frame which created it.
+Any other value means the minibuffer will move onto another frame, but
+only when the user starts using a minibuffer there.
+
+Any buffer local or dynamic binding of this variable is ignored. Only the
+default top level value is used. */);
+ minibuffer_follows_selected_frame = Qt;
+
DEFVAR_BOOL ("read-buffer-completion-ignore-case",
read_buffer_completion_ignore_case,
doc: /* Non-nil means completion ignores case when reading a buffer name. */);
@@ -2097,6 +2339,15 @@ This variable also overrides the default character that `read-passwd'
uses to hide passwords. */);
Vread_hide_char = Qnil;
+ DEFVAR_BOOL ("inhibit-interaction",
+ inhibit_interaction,
+ doc: /* Non-nil means any user interaction will signal an error.
+This variable can be bound when user interaction can't be performed,
+for instance when running a headless Emacs server. Functions like
+`read-from-minibuffer' (and the like) will signal `inhibited-interaction'
+instead. */);
+ inhibit_interaction = 0;
+
defsubr (&Sactive_minibuffer_window);
defsubr (&Sset_minibuffer_window);
defsubr (&Sread_from_minibuffer);
@@ -2110,6 +2361,8 @@ uses to hide passwords. */);
defsubr (&Sminibuffer_prompt);
defsubr (&Sminibufferp);
+ defsubr (&Sinnermost_minibuffer_p);
+ defsubr (&Sabort_minibuffers);
defsubr (&Sminibuffer_prompt_end);
defsubr (&Sminibuffer_contents);
defsubr (&Sminibuffer_contents_no_properties);
diff --git a/src/msdos.c b/src/msdos.c
index b5f06c99c3d..5da01c9e7ca 100644
--- a/src/msdos.c
+++ b/src/msdos.c
@@ -1,6 +1,6 @@
/* MS-DOS specific C utilities. -*- coding: cp850 -*-
-Copyright (C) 1993-1997, 1999-2020 Free Software Foundation, Inc.
+Copyright (C) 1993-1997, 1999-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/msdos.h b/src/msdos.h
index e08195ca6ad..f7d3b0d7029 100644
--- a/src/msdos.h
+++ b/src/msdos.h
@@ -1,5 +1,5 @@
/* MS-DOS specific C utilities, interface.
- Copyright (C) 1993, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1993, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/nsfns.m b/src/nsfns.m
index c7956497c4c..ae114f83e4d 100644
--- a/src/nsfns.m
+++ b/src/nsfns.m
@@ -1,6 +1,6 @@
/* Functions for the NeXT/Open/GNUstep and macOS window system.
-Copyright (C) 1989, 1992-1994, 2005-2006, 2008-2020 Free Software
+Copyright (C) 1989, 1992-1994, 2005-2006, 2008-2021 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
@@ -456,7 +456,7 @@ ns_set_name (struct frame *f, Lisp_Object name, int explicit)
static void
ns_set_represented_filename (struct frame *f)
{
- Lisp_Object filename, encoded_filename;
+ Lisp_Object filename;
Lisp_Object buf = XWINDOW (f->selected_window)->contents;
NSAutoreleasePool *pool;
NSString *fstr;
@@ -473,9 +473,7 @@ ns_set_represented_filename (struct frame *f)
if (! NILP (filename))
{
- encoded_filename = ENCODE_UTF_8 (filename);
-
- fstr = [NSString stringWithLispString:encoded_filename];
+ fstr = [NSString stringWithLispString:filename];
if (fstr == nil) fstr = @"";
}
else
@@ -1487,14 +1485,14 @@ Some window managers may refuse to restack windows. */)
if (FRAME_NS_VIEW (f1) && FRAME_NS_VIEW (f2))
{
- NSWindow *window = [FRAME_NS_VIEW (f1) window];
- NSInteger window2 = [[FRAME_NS_VIEW (f2) window] windowNumber];
- NSWindowOrderingMode flag = NILP (above) ? NSWindowBelow : NSWindowAbove;
-
- [window orderWindow: flag
- relativeTo: window2];
+ EmacsWindow *window = (EmacsWindow *)[FRAME_NS_VIEW (f1) window];
+ NSWindow *window2 = [FRAME_NS_VIEW (f2) window];
+ BOOL flag = !NILP (above);
- return Qt;
+ if ([window restackWindow:window2 above:!NILP (above)])
+ return Qt;
+ else
+ return Qnil;
}
else
{
@@ -3012,7 +3010,7 @@ DEFUN ("ns-show-character-palette",
#endif
-/* Whether N bytes at STR are in the [0,127] range. */
+/* Whether N bytes at STR are in the [1,127] range. */
static bool
all_nonzero_ascii (unsigned char *str, ptrdiff_t n)
{
diff --git a/src/nsfont.m b/src/nsfont.m
index 378a6408401..f4f0d281674 100644
--- a/src/nsfont.m
+++ b/src/nsfont.m
@@ -1,6 +1,6 @@
/* Font back-end driver for the NeXT/Open/GNUstep and macOS window system.
See font.h
- Copyright (C) 2006-2020 Free Software Foundation, Inc.
+ Copyright (C) 2006-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -329,7 +329,7 @@ static NSString
{
Lisp_Object script = assq_no_quit (XCAR (otf), Votf_script_alist);
return CONSP (script)
- ? [NSString stringWithUTF8String: SSDATA (SYMBOL_NAME (XCDR ((script))))]
+ ? [NSString stringWithLispString: SYMBOL_NAME (XCDR ((script)))]
: @"";
}
@@ -345,7 +345,7 @@ static NSString
if (!strncmp (SSDATA (r), reg, SBYTES (r)))
{
script = XCDR (XCAR (rts));
- return [NSString stringWithUTF8String: SSDATA (SYMBOL_NAME (script))];
+ return [NSString stringWithLispString: SYMBOL_NAME (script)];
}
rts = XCDR (rts);
}
@@ -370,8 +370,7 @@ static NSString
{
Lisp_Object key = XCAR (tmp), val = XCDR (tmp);
if (EQ (key, QCscript) && SYMBOLP (val))
- return [NSString stringWithUTF8String:
- SSDATA (SYMBOL_NAME (val))];
+ return [NSString stringWithLispString: SYMBOL_NAME (val)];
if (EQ (key, QClang) && SYMBOLP (val))
return ns_lang_to_script (val);
if (EQ (key, QCotf) && CONSP (val) && SYMBOLP (XCAR (val)))
diff --git a/src/nsgui.h b/src/nsgui.h
index 0536ef0c0a9..e4038d32267 100644
--- a/src/nsgui.h
+++ b/src/nsgui.h
@@ -1,5 +1,5 @@
/* Definitions and headers for communication on the NeXT/Open/GNUstep API.
- Copyright (C) 1995, 2005, 2008-2020 Free Software Foundation, Inc.
+ Copyright (C) 1995, 2005, 2008-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/nsimage.m b/src/nsimage.m
index da6f01cf6a3..fa81a41a519 100644
--- a/src/nsimage.m
+++ b/src/nsimage.m
@@ -1,5 +1,5 @@
/* Image support for the NeXT/Open/GNUstep and macOS window system.
- Copyright (C) 1989, 1992-1994, 2005-2006, 2008-2020 Free Software
+ Copyright (C) 1989, 1992-1994, 2005-2006, 2008-2021 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
@@ -235,6 +235,11 @@ ns_set_alpha (void *img, int x, int y, unsigned char a)
[(EmacsImage *)img setAlphaAtX: x Y: y to: a];
}
+size_t
+ns_image_size_in_bytes (void *img)
+{
+ return [(EmacsImage *)img sizeInBytes];
+}
/* ==========================================================================
@@ -257,7 +262,7 @@ ns_set_alpha (void *img, int x, int y, unsigned char a)
found = ENCODE_FILE (found);
image = [[EmacsImage alloc] initByReferencingFile:
- [NSString stringWithUTF8String: SSDATA (found)]];
+ [NSString stringWithLispString: found]];
image->bmRep = nil;
#ifdef NS_IMPL_COCOA
@@ -273,7 +278,7 @@ ns_set_alpha (void *img, int x, int y, unsigned char a)
[image setSize: NSMakeSize([imgRep pixelsWide], [imgRep pixelsHigh])];
- [image setName: [NSString stringWithUTF8String: SSDATA (file)]];
+ [image setName: [NSString stringWithLispString: file]];
return image;
}
@@ -288,6 +293,18 @@ ns_set_alpha (void *img, int x, int y, unsigned char a)
}
+- (id)copyWithZone:(NSZone *)zone
+{
+ EmacsImage *copy = [super copyWithZone:zone];
+
+ copy->stippleMask = [stippleMask copyWithZone:zone];
+ copy->bmRep = [bmRep copyWithZone:zone];
+ copy->transform = [transform copyWithZone:zone];
+
+ return copy;
+}
+
+
/* Create image from monochrome bitmap. If both FG and BG are 0
(black), set the background to white and make it transparent. */
- (instancetype)initFromXBM: (unsigned char *)bits width: (int)w height: (int)h
@@ -610,5 +627,22 @@ ns_set_alpha (void *img, int x, int y, unsigned char a)
smoothing = s;
}
+/* Approximate allocated size of image in bytes. */
+- (size_t) sizeInBytes
+{
+ size_t bytes = 0;
+ NSImageRep *rep;
+ NSEnumerator *reps = [[self representations] objectEnumerator];
+ while ((rep = (NSImageRep *) [reps nextObject]))
+ {
+ if ([rep respondsToSelector: @selector (bytesPerRow)])
+ {
+ NSBitmapImageRep *bmr = (NSBitmapImageRep *) rep;
+ bytes += [bmr bytesPerRow] * [bmr numberOfPlanes] * [bmr pixelsHigh];
+ }
+ }
+ return bytes;
+}
+
@end
diff --git a/src/nsmenu.m b/src/nsmenu.m
index a286a80da17..8086f56854e 100644
--- a/src/nsmenu.m
+++ b/src/nsmenu.m
@@ -1,5 +1,5 @@
/* NeXT/Open/GNUstep and macOS Cocoa menu and toolbar module.
- Copyright (C) 2007-2020 Free Software Foundation, Inc.
+ Copyright (C) 2007-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -47,21 +47,11 @@ Carbon version by Yamamoto Mitsuharu. */
#endif
-#if 0
-/* Include lisp -> C common menu parsing code. */
-#define ENCODE_MENU_STRING(str) ENCODE_UTF_8 (str)
-#include "nsmenu_common.c"
-#endif
-
extern long context_menu_value;
EmacsMenu *svcsMenu;
/* Nonzero means a menu is currently active. */
static int popup_activated_flag;
-/* Nonzero means we are tracking and updating menus. */
-static int trackingMenu;
-
-
/* NOTE: toolbar implementation is at end,
following complete menu implementation. */
@@ -75,11 +65,22 @@ static int trackingMenu;
/* Supposed to discard menubar and free storage. Since we share the
menubar among frames and update its context for the focused window,
- there is nothing to do here. */
+ we do not discard the menu. We do, however, want to remove any
+ existing menu items. */
void
free_frame_menubar (struct frame *f)
{
- return;
+ id menu = [NSApp mainMenu];
+ for (int i = [menu numberOfItems] - 1 ; i >= 0; i--)
+ {
+ NSMenuItem *item = [menu itemAtIndex:i];
+ NSString *title = [item title];
+
+ if ([ns_app_name isEqualToString:title])
+ continue;
+
+ [menu removeItemAtIndex:i];
+ }
}
@@ -98,16 +99,19 @@ popup_activated (void)
3) deep_p, submenu = non-nil: Update contents of a single submenu.
-------------------------------------------------------------------------- */
static void
-ns_update_menubar (struct frame *f, bool deep_p, EmacsMenu *submenu)
+ns_update_menubar (struct frame *f, bool deep_p)
{
NSAutoreleasePool *pool;
- id menu = [NSApp mainMenu];
- static EmacsMenu *last_submenu = nil;
BOOL needsSet = NO;
+ id menu = [NSApp mainMenu];
bool owfi;
+
Lisp_Object items;
widget_value *wv, *first_wv, *prev_wv = 0;
int i;
+ int *submenu_start, *submenu_end;
+ bool *submenu_top_level_items;
+ int *submenu_n_panes;
#if NSMENUPROFILE
struct timeb tb;
@@ -116,7 +120,7 @@ ns_update_menubar (struct frame *f, bool deep_p, EmacsMenu *submenu)
NSTRACE ("ns_update_menubar");
- if (f != SELECTED_FRAME ())
+ if (f != SELECTED_FRAME () || FRAME_EXTERNAL_MENU_BAR (f) == 0)
return;
XSETFRAME (Vmenu_updating_frame, f);
/*fprintf (stderr, "ns_update_menubar: frame: %p\tdeep: %d\tsub: %p\n", f, deep_p, submenu); */
@@ -142,114 +146,105 @@ ns_update_menubar (struct frame *f, bool deep_p, EmacsMenu *submenu)
#endif
#ifdef NS_IMPL_GNUSTEP
- deep_p = 1; /* until GNUstep NSMenu implements the Panther delegation model */
+ deep_p = 1; /* See comment in menuNeedsUpdate. */
#endif
if (deep_p)
{
- /* Fully parse one or more of the submenus. */
- int n = 0;
- int *submenu_start, *submenu_end;
- bool *submenu_top_level_items;
- int *submenu_n_panes;
+ /* Make a widget-value tree representing the entire menu trees. */
+
struct buffer *prev = current_buffer;
Lisp_Object buffer;
ptrdiff_t specpdl_count = SPECPDL_INDEX ();
int previous_menu_items_used = f->menu_bar_items_used;
Lisp_Object *previous_items
= alloca (previous_menu_items_used * sizeof *previous_items);
+ int subitems;
- /* lisp preliminaries */
buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->contents;
specbind (Qinhibit_quit, Qt);
+ /* Don't let the debugger step into this code
+ because it is not reentrant. */
specbind (Qdebug_on_next_call, Qnil);
+
record_unwind_save_match_data ();
if (NILP (Voverriding_local_map_menu_flag))
{
specbind (Qoverriding_terminal_local_map, Qnil);
specbind (Qoverriding_local_map, Qnil);
}
+
set_buffer_internal_1 (XBUFFER (buffer));
- /* TODO: for some reason this is not needed in other terms,
- but some menu updates call Info-extract-pointer which causes
- abort-on-error if waiting-for-input. Needs further investigation. */
+ /* TODO: for some reason this is not needed in other terms, but
+ some menu updates call Info-extract-pointer which causes
+ abort-on-error if waiting-for-input. Needs further
+ investigation. */
owfi = waiting_for_input;
waiting_for_input = 0;
- /* lucid hook and possible reset */
+ /* Run the Lucid hook. */
safe_run_hooks (Qactivate_menubar_hook);
+
+ /* If it has changed current-menubar from previous value,
+ really recompute the menubar from the value. */
if (! NILP (Vlucid_menu_bar_dirty_flag))
call0 (Qrecompute_lucid_menubar);
safe_run_hooks (Qmenu_bar_update_hook);
fset_menu_bar_items (f, menu_bar_items (FRAME_MENU_BAR_ITEMS (f)));
- /* Now ready to go */
items = FRAME_MENU_BAR_ITEMS (f);
- /* Save the frame's previous menu bar contents data */
+ /* Save the frame's previous menu bar contents data. */
if (previous_menu_items_used)
- memcpy (previous_items, aref_addr (f->menu_bar_vector, 0),
- previous_menu_items_used * sizeof (Lisp_Object));
+ memcpy (previous_items, xvector_contents (f->menu_bar_vector),
+ previous_menu_items_used * word_size);
- /* parse stage 1: extract from lisp */
+ /* Fill in menu_items with the current menu bar contents.
+ This can evaluate Lisp code. */
save_menu_items ();
menu_items = f->menu_bar_vector;
menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0;
- submenu_start = alloca (ASIZE (items) * sizeof *submenu_start);
- submenu_end = alloca (ASIZE (items) * sizeof *submenu_end);
- submenu_n_panes = alloca (ASIZE (items) * sizeof *submenu_n_panes);
- submenu_top_level_items = alloca (ASIZE (items)
+ subitems = ASIZE (items) / 4;
+ submenu_start = alloca ((subitems + 1) * sizeof *submenu_start);
+ submenu_end = alloca (subitems * sizeof *submenu_end);
+ submenu_n_panes = alloca (subitems * sizeof *submenu_n_panes);
+ submenu_top_level_items = alloca (subitems
* sizeof *submenu_top_level_items);
init_menu_items ();
- for (i = 0; i < ASIZE (items); i += 4)
+ for (i = 0; i < subitems; i++)
{
Lisp_Object key, string, maps;
- key = AREF (items, i);
- string = AREF (items, i + 1);
- maps = AREF (items, i + 2);
+ key = AREF (items, 4 * i);
+ string = AREF (items, 4 * i + 1);
+ maps = AREF (items, 4 * i + 2);
if (NILP (string))
break;
- /* FIXME: we'd like to only parse the needed submenu, but this
- was causing crashes in the _common parsing code: need to make
- sure proper initialization done. */
- /* if (submenu && strcmp ([[submenu title] UTF8String], SSDATA (string)))
- continue; */
-
submenu_start[i] = menu_items_used;
menu_items_n_panes = 0;
- submenu_top_level_items[i] = parse_single_submenu (key, string, maps);
+ submenu_top_level_items[i]
+ = parse_single_submenu (key, string, maps);
submenu_n_panes[i] = menu_items_n_panes;
+
submenu_end[i] = menu_items_used;
- n++;
}
+ submenu_start[i] = -1;
finish_menu_items ();
waiting_for_input = owfi;
+ /* Convert menu_items into widget_value trees
+ to display the menu. This cannot evaluate Lisp code. */
- if (submenu && n == 0)
- {
- /* should have found a menu for this one but didn't */
- fprintf (stderr, "ERROR: did not find lisp menu for submenu '%s'.\n",
- [[submenu title] UTF8String]);
- discard_menu_items ();
- unbind_to (specpdl_count, Qnil);
- unblock_input ();
- return;
- }
-
- /* parse stage 2: insert into lucid 'widget_value' structures
- [comments in other terms say not to evaluate lisp code here] */
wv = make_widget_value ("menubar", NULL, true, Qnil);
wv->button_type = BUTTON_TYPE_NONE;
first_wv = wv;
- for (i = 0; i < 4*n; i += 4)
+ for (i = 0; submenu_start[i] >= 0; i++)
{
menu_items_n_panes = submenu_n_panes[i];
wv = digest_single_submenu (submenu_start[i], submenu_end[i],
@@ -259,169 +254,79 @@ ns_update_menubar (struct frame *f, bool deep_p, EmacsMenu *submenu)
else
first_wv->contents = wv;
/* Don't set wv->name here; GC during the loop might relocate it. */
- wv->enabled = 1;
+ wv->enabled = true;
wv->button_type = BUTTON_TYPE_NONE;
prev_wv = wv;
}
set_buffer_internal_1 (prev);
- /* Compare the new menu items with previous, and leave off if no change. */
- /* FIXME: following other terms here, but seems like this should be
- done before parse stage 2 above, since its results aren't used. */
- if (previous_menu_items_used
- && (!submenu || (submenu && submenu == last_submenu))
- && menu_items_used == previous_menu_items_used)
- {
- for (i = 0; i < previous_menu_items_used; i++)
- /* FIXME: this ALWAYS fails on Buffers menu items.. something
- about their strings causes them to change every time, so we
- double-check failures. */
- if (!EQ (previous_items[i], AREF (menu_items, i)))
- if (!(STRINGP (previous_items[i])
- && STRINGP (AREF (menu_items, i))
- && !strcmp (SSDATA (previous_items[i]),
- SSDATA (AREF (menu_items, i)))))
- break;
- if (i == previous_menu_items_used)
- {
- /* No change. */
+ /* If there has been no change in the Lisp-level contents
+ of the menu bar, skip redisplaying it. Just exit. */
-#if NSMENUPROFILE
- ftime (&tb);
- t += 1000*tb.time+tb.millitm;
- fprintf (stderr, "NO CHANGE! CUTTING OUT after %ld msec.\n", t);
-#endif
+ /* Compare the new menu items with the ones computed last time. */
+ for (i = 0; i < previous_menu_items_used; i++)
+ if (menu_items_used == i
+ || (!EQ (previous_items[i], AREF (menu_items, i))))
+ break;
+ if (i == menu_items_used && i == previous_menu_items_used && i != 0)
+ {
+ /* The menu items have not changed. Don't bother updating
+ the menus in any form, since it would be a no-op. */
+ free_menubar_widget_value_tree (first_wv);
+ discard_menu_items ();
+ unbind_to (specpdl_count, Qnil);
+ return;
+ }
- free_menubar_widget_value_tree (first_wv);
- discard_menu_items ();
- unbind_to (specpdl_count, Qnil);
- unblock_input ();
- return;
- }
- }
/* The menu items are different, so store them in the frame. */
- /* FIXME: this is not correct for single-submenu case. */
fset_menu_bar_vector (f, menu_items);
f->menu_bar_items_used = menu_items_used;
- /* Calls restore_menu_items, etc., as they were outside. */
+ /* This undoes save_menu_items. */
unbind_to (specpdl_count, Qnil);
- /* Parse stage 2a: now GC cannot happen during the lifetime of the
- widget_value, so it's safe to store data from a Lisp_String. */
+ /* Now GC cannot happen during the lifetime of the widget_value,
+ so it's safe to store data from a Lisp_String. */
wv = first_wv->contents;
for (i = 0; i < ASIZE (items); i += 4)
{
Lisp_Object string;
string = AREF (items, i + 1);
if (NILP (string))
- break;
-
- wv->name = SSDATA (string);
+ break;
+ wv->name = SSDATA (string);
update_submenu_strings (wv->contents);
- wv = wv->next;
+ wv = wv->next;
}
- /* Now, update the NS menu; if we have a submenu, use that, otherwise
- create a new menu for each sub and fill it. */
- if (submenu)
- {
- const char *submenuTitle = [[submenu title] UTF8String];
- for (wv = first_wv->contents; wv; wv = wv->next)
- {
- if (!strcmp (submenuTitle, wv->name))
- {
- [submenu fillWithWidgetValue: wv->contents];
- last_submenu = submenu;
- break;
- }
- }
- }
- else
- {
- [menu fillWithWidgetValue: first_wv->contents frame: f];
- }
-
}
else
{
- static int n_previous_strings = 0;
- static char previous_strings[100][10];
- static struct frame *last_f = NULL;
- int n;
- Lisp_Object string;
+ /* Make a widget-value tree containing
+ just the top level menu bar strings. */
wv = make_widget_value ("menubar", NULL, true, Qnil);
wv->button_type = BUTTON_TYPE_NONE;
first_wv = wv;
- /* Make widget-value tree with just the top level menu bar strings. */
items = FRAME_MENU_BAR_ITEMS (f);
- if (NILP (items))
- {
- free_menubar_widget_value_tree (first_wv);
- unblock_input ();
- return;
- }
-
-
- /* Check if no change: this mechanism is a bit rough, but ready. */
- n = ASIZE (items) / 4;
- if (f == last_f && n_previous_strings == n)
- {
- for (i = 0; i<n; i++)
- {
- string = AREF (items, 4*i+1);
-
- if (EQ (string, make_fixnum (0))) // FIXME: Why??? --Stef
- continue;
- if (NILP (string))
- {
- if (previous_strings[i][0])
- break;
- else
- continue;
- }
- else if (memcmp (previous_strings[i], SDATA (string),
- min (10, SBYTES (string) + 1)))
- break;
- }
-
- if (i == n)
- {
- free_menubar_widget_value_tree (first_wv);
- unblock_input ();
- return;
- }
- }
-
- [menu clear];
for (i = 0; i < ASIZE (items); i += 4)
{
+ Lisp_Object string;
+
string = AREF (items, i + 1);
if (NILP (string))
break;
- if (n < 100)
- memcpy (previous_strings[i/4], SDATA (string),
- min (10, SBYTES (string) + 1));
-
wv = make_widget_value (SSDATA (string), NULL, true, Qnil);
wv->button_type = BUTTON_TYPE_NONE;
+ /* This prevents lwlib from assuming this
+ menu item is really supposed to be empty. */
+ /* The intptr_t cast avoids a warning.
+ This value just has to be different from small integers. */
wv->call_data = (void *) (intptr_t) (-1);
-#ifdef NS_IMPL_COCOA
- /* We'll update the real copy under app menu when time comes. */
- if (!strcmp ("Services", wv->name))
- {
- /* But we need to make sure it will update on demand. */
- [svcsMenu setFrame: f];
- }
- else
-#endif
- [menu addSubmenuWithTitle: wv->name forFrame: f];
-
if (prev_wv)
prev_wv->next = wv;
else
@@ -429,16 +334,59 @@ ns_update_menubar (struct frame *f, bool deep_p, EmacsMenu *submenu)
prev_wv = wv;
}
- last_f = f;
- if (n < 100)
- n_previous_strings = n;
+ /* Forget what we thought we knew about what is in the
+ detailed contents of the menu bar menus.
+ Changing the top level always destroys the contents. */
+ f->menu_bar_items_used = 0;
+ }
+
+ /* Now, update the NS menu. */
+ i = 0;
+
+ /* Make sure we skip the "application" menu, which is always the
+ first entry in our top-level menu. */
+ if (i < [menu numberOfItems])
+ {
+ NSString *title = [[menu itemAtIndex:i] title];
+ if ([ns_app_name isEqualToString:title])
+ i += 1;
+ }
+
+ for (wv = first_wv->contents; wv; wv = wv->next)
+ {
+ EmacsMenu *submenu;
+
+ if (i < [menu numberOfItems])
+ {
+ NSString *titleStr = [NSString stringWithUTF8String: wv->name];
+ NSMenuItem *item = [menu itemAtIndex:i];
+ submenu = (EmacsMenu*)[item submenu];
+
+ [item setTitle:titleStr];
+ [submenu setTitle:titleStr];
+ [submenu removeAllItems];
+ }
else
- n_previous_strings = 0;
+ submenu = [menu addSubmenuWithTitle: wv->name];
+
+ if ([[submenu title] isEqualToString:@"Help"])
+ [NSApp setHelpMenu:submenu];
+ if (deep_p)
+ [submenu fillWithWidgetValue: wv->contents];
+
+ i += 1;
+ }
+
+ while (i < [menu numberOfItems])
+ {
+ /* Remove any extra items. */
+ [menu removeItemAtIndex:i];
}
- free_menubar_widget_value_tree (first_wv);
+ free_menubar_widget_value_tree (first_wv);
+
#if NSMENUPROFILE
ftime (&tb);
t += 1000*tb.time+tb.millitm;
@@ -460,21 +408,10 @@ ns_update_menubar (struct frame *f, bool deep_p, EmacsMenu *submenu)
void
set_frame_menubar (struct frame *f, bool first_time, bool deep_p)
{
- ns_update_menubar (f, deep_p, nil);
-}
-
-void
-ns_activate_menubar (struct frame *f)
-{
-#ifdef NS_IMPL_COCOA
- ns_update_menubar (f, true, nil);
- ns_check_pending_open_menu ();
-#endif
+ ns_update_menubar (f, deep_p);
}
-
-
/* ==========================================================================
Menu: class implementation
@@ -490,96 +427,31 @@ ns_activate_menubar (struct frame *f)
/* override designated initializer */
- (instancetype)initWithTitle: (NSString *)title
{
- frame = 0;
if ((self = [super initWithTitle: title]))
[self setAutoenablesItems: NO];
- return self;
-}
-
-
-/* used for top-level */
-- (instancetype)initWithTitle: (NSString *)title frame: (struct frame *)f
-{
- [self initWithTitle: title];
- frame = f;
-#ifdef NS_IMPL_COCOA
[self setDelegate: self];
-#endif
- return self;
-}
+ needsUpdate = YES;
-- (void)setFrame: (struct frame *)f
-{
- frame = f;
-}
-
-#ifdef NS_IMPL_COCOA
--(void)trackingNotification:(NSNotification *)notification
-{
- /* Update menu in menuNeedsUpdate only while tracking menus. */
- trackingMenu = ([notification name] == NSMenuDidBeginTrackingNotification
- ? 1 : 0);
- if (! trackingMenu) ns_check_menu_open (nil);
-}
-
-- (void)menuWillOpen:(NSMenu *)menu
-{
- ++trackingMenu;
-
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070
- // On 10.6 we get repeated calls, only the one for NSSystemDefined is "real".
- if (
-#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
- NSAppKitVersionNumber < NSAppKitVersionNumber10_7 &&
-#endif
- [[NSApp currentEvent] type] != NSEventTypeSystemDefined)
- return;
-#endif
-
- /* When dragging from one menu to another, we get willOpen followed by didClose,
- i.e. trackingMenu == 3 in willOpen and then 2 after didClose.
- We have updated all menus, so avoid doing it when trackingMenu == 3. */
- if (trackingMenu == 2)
- ns_check_menu_open (menu);
-}
-
-- (void)menuDidClose:(NSMenu *)menu
-{
- --trackingMenu;
+ return self;
}
-#endif /* NS_IMPL_COCOA */
-/* Delegate method called when a submenu is being opened: run a 'deep' call
- to set_frame_menubar. */
+/* Delegate method called when a submenu is being opened: run a 'deep'
+ call to ns_update_menubar. */
- (void)menuNeedsUpdate: (NSMenu *)menu
{
- if (!FRAME_LIVE_P (frame))
+ if (!FRAME_LIVE_P (SELECTED_FRAME ()))
return;
- /* Cocoa/Carbon will request update on every keystroke
- via IsMenuKeyEvent -> CheckMenusForKeyEvent. These are not needed
- since key equivalents are handled through emacs.
- On Leopard, even keystroke events generate SystemDefined event.
- Third-party applications that enhance mouse / trackpad
- interaction, or also VNC/Remote Desktop will send events
- of type AppDefined rather than SysDefined.
- Menus will fail to show up if they haven't been initialized.
- AppDefined events may lack timing data.
-
- Thus, we rely on the didBeginTrackingNotification notification
- as above to indicate the need for updates.
- From 10.6 on, we could also use -[NSMenu propertiesToUpdate]: In the
- key press case, NSMenuPropertyItemImage (e.g.) won't be set.
- */
- if (trackingMenu == 0)
- return;
-/*fprintf (stderr, "Updating menu '%s'\n", [[self title] UTF8String]); NSLog (@"%@\n", event); */
-#ifdef NS_IMPL_GNUSTEP
- /* Don't know how to do this for anything other than Mac OS X 10.5 and later.
- This is wrong, as it might run Lisp code in the event loop. */
- ns_update_menubar (frame, true, self);
+#ifdef NS_IMPL_COCOA
+/* TODO: GNUstep calls this method when the menu is still being built
+ which results in a recursive stack overflow. One possible solution
+ is to use menuWillOpen instead, but the Apple docs explicitly warn
+ against changing the contents of the menu in it. I don't know what
+ the right thing to do for GNUstep is. */
+ if (needsUpdate)
+ ns_update_menubar (SELECTED_FRAME (), true);
#endif
}
@@ -593,33 +465,8 @@ ns_activate_menubar (struct frame *f)
}
-/* Parse a widget_value's key rep (examples: 's-p', 's-S', '(C-x C-s)', '<f13>')
- into an accelerator string. We are only able to display a single character
- for an accelerator, together with an optional modifier combination. (Under
- Carbon more control was possible, but in Cocoa multi-char strings passed to
- NSMenuItem get ignored. For now we try to display a super-single letter
- combo, and return the others as strings to be appended to the item title.
- (This is signaled by setting keyEquivModMask to 0 for now.) */
--(NSString *)parseKeyEquiv: (const char *)key
-{
- const char *tpos = key;
- keyEquivModMask = NSEventModifierFlagCommand;
-
- if (!key || !*key)
- return @"";
-
- while (*tpos == ' ' || *tpos == '(')
- tpos++;
- if ((*tpos == 's') && (*(tpos+1) == '-'))
- {
- return [NSString stringWithFormat: @"%c", tpos[2]];
- }
- keyEquivModMask = 0; /* signal */
- return [NSString stringWithUTF8String: tpos];
-}
-
-
- (NSMenuItem *)addItemWithWidgetValue: (void *)wvptr
+ attributes: (NSDictionary *)attributes
{
NSMenuItem *item;
widget_value *wv = (widget_value *)wvptr;
@@ -627,36 +474,33 @@ ns_activate_menubar (struct frame *f)
if (menu_separator_name_p (wv->name))
{
item = [NSMenuItem separatorItem];
- [self addItem: item];
}
else
{
- NSString *title, *keyEq;
- title = [NSString stringWithUTF8String: wv->name];
+ NSString *title = [NSString stringWithUTF8String: wv->name];
if (title == nil)
title = @"< ? >"; /* (get out in the open so we know about it) */
- keyEq = [self parseKeyEquiv: wv->key];
-#ifdef NS_IMPL_COCOA
- /* macOS mangles modifier strings longer than one character. */
- if (keyEquivModMask == 0)
- {
- title = [title stringByAppendingFormat: @" (%@)", keyEq];
- item = [self addItemWithTitle: (NSString *)title
- action: @selector (menuDown:)
- keyEquivalent: @""];
- }
- else
+ item = [[[NSMenuItem alloc] init] autorelease];
+ if (wv->key)
{
-#endif
- item = [self addItemWithTitle: (NSString *)title
- action: @selector (menuDown:)
- keyEquivalent: keyEq];
+ NSString *key = [NSString stringWithUTF8String: wv->key];
#ifdef NS_IMPL_COCOA
- }
+ /* Cocoa only permits a single key (with modifiers) as
+ keyEquivalent, so we put them in the title string
+ in a tab-separated column. */
+ title = [title stringByAppendingFormat: @"\t%@", key];
+#else
+ [item setKeyEquivalent: key];
#endif
- [item setKeyEquivalentModifierMask: keyEquivModMask];
+ }
+ NSAttributedString *atitle = [[[NSAttributedString alloc]
+ initWithString: title
+ attributes: attributes]
+ autorelease];
+ [item setAction: @selector (menuDown:)];
+ [item setAttributedTitle: atitle];
[item setEnabled: wv->enabled];
/* Draw radio buttons and tickboxes. */
@@ -669,52 +513,145 @@ ns_activate_menubar (struct frame *f)
[item setTag: (NSInteger)wv->call_data];
}
+ [self addItem: item];
return item;
}
/* convenience */
--(void)clear
+-(void)removeAllItems
{
+#ifdef NS_IMPL_COCOA
+ [super removeAllItems];
+#else
+ /* GNUstep doesn't have removeAllItems yet, so do it
+ manually. */
int n;
for (n = [self numberOfItems]-1; n >= 0; n--)
- {
- NSMenuItem *item = [self itemAtIndex: n];
- NSString *title = [item title];
- if ([ns_app_name isEqualToString: title]
- && ![item isSeparatorItem])
- continue;
- [self removeItemAtIndex: n];
- }
+ [self removeItemAtIndex: n];
+#endif
+
+ needsUpdate = YES;
}
-- (void)fillWithWidgetValue: (void *)wvptr
+typedef struct {
+ const char *from, *to;
+} subst_t;
+
+/* Standard keyboard symbols used in menus. */
+static const subst_t key_symbols[] = {
+ {"<backspace>", "⌫"},
+ {"DEL", "⌫"},
+ {"<deletechar>", "⌦"},
+ {"<return>", "↩"},
+ {"RET", "↩"},
+ {"<left>", "←"},
+ {"<right>", "→"},
+ {"<up>", "↑"},
+ {"<down>", "↓"},
+ {"<prior>", "⇞"},
+ {"<next>", "⇟"},
+ {"<home>", "↖"},
+ {"<end>", "↘"},
+ {"<tab>", "⇥"},
+ {"TAB", "⇥"},
+ {"<backtab>", "⇤"},
+};
+
+/* Transform the key sequence KEY into something prettier by
+ substituting keyboard symbols. */
+static char *
+prettify_key (const char *key)
{
- [self fillWithWidgetValue: wvptr frame: (struct frame *)nil];
+ while (*key == ' ') key++;
+
+ int len = strlen (key);
+ char *buf = xmalloc (len + 1);
+ memcpy (buf, key, len + 1);
+ for (int i = 0; i < ARRAYELTS (key_symbols); i++)
+ {
+ ptrdiff_t fromlen = strlen (key_symbols[i].from);
+ char *p = buf;
+ while (p < buf + len)
+ {
+ char *match = memmem (buf, len, key_symbols[i].from, fromlen);
+ if (!match)
+ break;
+ ptrdiff_t tolen = strlen (key_symbols[i].to);
+ eassert (tolen <= fromlen);
+ memcpy (match, key_symbols[i].to, tolen);
+ memmove (match + tolen, match + fromlen,
+ len - (match + fromlen - buf) + 1);
+ len -= fromlen - tolen;
+ p = match + tolen;
+ }
+ }
+ Lisp_Object result = build_string (buf);
+ xfree (buf);
+ return SSDATA (result);
}
-- (void)fillWithWidgetValue: (void *)wvptr frame: (struct frame *)f
+- (void)fillWithWidgetValue: (void *)wvptr
{
- widget_value *wv = (widget_value *)wvptr;
+ widget_value *first_wv = (widget_value *)wvptr;
+ NSFont *menuFont = [NSFont menuFontOfSize:0];
+ NSDictionary *attributes = nil;
+
+#ifdef NS_IMPL_COCOA
+ /* Cocoa doesn't allow multi-key sequences in its menu display, so
+ work around it by using tabs to split the title into two
+ columns. */
+ NSDictionary *font_attribs = @{NSFontAttributeName: menuFont};
+ CGFloat maxNameWidth = 0;
+ CGFloat maxKeyWidth = 0;
+
+ /* Determine the maximum width of all menu items. */
+ for (widget_value *wv = first_wv; wv != NULL; wv = wv->next)
+ if (!menu_separator_name_p (wv->name))
+ {
+ NSString *name = [NSString stringWithUTF8String: wv->name];
+ NSSize nameSize = [name sizeWithAttributes: font_attribs];
+ maxNameWidth = MAX(maxNameWidth, nameSize.width);
+ if (wv->key)
+ {
+ wv->key = prettify_key (wv->key);
+ NSString *key = [NSString stringWithUTF8String: wv->key];
+ NSSize keySize = [key sizeWithAttributes: font_attribs];
+ maxKeyWidth = MAX(maxKeyWidth, keySize.width);
+ }
+ }
+
+ /* Put some space between the names and keys. */
+ CGFloat maxWidth = maxNameWidth + maxKeyWidth + 40;
+
+ /* Set a right-aligned tab stop at the maximum width, so that the
+ key will appear immediately to the left of it. */
+ NSTextTab *tab =
+ [[[NSTextTab alloc] initWithTextAlignment: NSTextAlignmentRight
+ location: maxWidth
+ options: @{}] autorelease];
+ NSMutableParagraphStyle *pstyle = [[[NSMutableParagraphStyle alloc] init]
+ autorelease];
+ [pstyle setTabStops: @[tab]];
+ attributes = @{NSParagraphStyleAttributeName: pstyle};
+#endif
/* clear existing contents */
- [self clear];
+ [self removeAllItems];
/* add new contents */
- for (; wv != NULL; wv = wv->next)
+ for (widget_value *wv = first_wv; wv != NULL; wv = wv->next)
{
- NSMenuItem *item = [self addItemWithWidgetValue: wv];
+ NSMenuItem *item = [self addItemWithWidgetValue: wv
+ attributes: attributes];
if (wv->contents)
{
EmacsMenu *submenu;
- if (f)
- submenu = [[EmacsMenu alloc] initWithTitle: [item title] frame:f];
- else
- submenu = [[EmacsMenu alloc] initWithTitle: [item title]];
+ submenu = [[EmacsMenu alloc] initWithTitle: [item title]];
[self setSubmenu: submenu forItem: item];
[submenu fillWithWidgetValue: wv->contents];
@@ -723,6 +660,8 @@ ns_activate_menubar (struct frame *f)
}
}
+ needsUpdate = NO;
+
#ifdef NS_IMPL_GNUSTEP
if ([[self window] isVisible])
[self sizeToFit];
@@ -731,13 +670,13 @@ ns_activate_menubar (struct frame *f)
/* Adds an empty submenu and returns it. */
-- (EmacsMenu *)addSubmenuWithTitle: (const char *)title forFrame: (struct frame *)f
+- (EmacsMenu *)addSubmenuWithTitle: (const char *)title
{
NSString *titleStr = [NSString stringWithUTF8String: title];
NSMenuItem *item = [self addItemWithTitle: titleStr
action: (SEL)nil /*@selector (menuDown:) */
keyEquivalent: @""];
- EmacsMenu *submenu = [[EmacsMenu alloc] initWithTitle: titleStr frame: f];
+ EmacsMenu *submenu = [[EmacsMenu alloc] initWithTitle: titleStr];
[self setSubmenu: submenu forItem: item];
[submenu release];
return submenu;
@@ -970,7 +909,7 @@ ns_menu_show (struct frame *f, int x, int y, int menuflags,
}
pmenu = [[EmacsMenu alloc] initWithTitle:
- [NSString stringWithUTF8String: SSDATA (title)]];
+ [NSString stringWithLispString: title]];
[pmenu fillWithWidgetValue: first_wv->contents];
free_menubar_widget_value_tree (first_wv);
unbind_to (specpdl_count, Qnil);
@@ -1022,15 +961,12 @@ update_frame_tool_bar (struct frame *f)
int i, k = 0;
EmacsView *view = FRAME_NS_VIEW (f);
EmacsToolbar *toolbar = [view toolbar];
- int oldh;
NSTRACE ("update_frame_tool_bar");
if (view == nil || toolbar == nil) return;
block_input ();
- oldh = FRAME_TOOLBAR_HEIGHT (f);
-
#ifdef NS_IMPL_COCOA
[toolbar clearActive];
#else
@@ -1881,12 +1817,6 @@ DEFUN ("menu-or-popup-active-p", Fmenu_or_popup_active_p, Smenu_or_popup_active_
void
syms_of_nsmenu (void)
{
-#ifndef NS_IMPL_COCOA
- /* Don't know how to keep track of this in Next/Open/GNUstep. Always
- update menus there. */
- trackingMenu = 1;
- PDUMPER_REMEMBER_SCALAR (trackingMenu);
-#endif
defsubr (&Sns_reset_menu);
defsubr (&Smenu_or_popup_active_p);
diff --git a/src/nsselect.m b/src/nsselect.m
index 7b1937f5d99..5ab3ef77fec 100644
--- a/src/nsselect.m
+++ b/src/nsselect.m
@@ -1,5 +1,5 @@
/* NeXT/Open/GNUstep / macOS Cocoa selection processing for emacs.
- Copyright (C) 1993-1994, 2005-2006, 2008-2020 Free Software
+ Copyright (C) 1993-1994, 2005-2006, 2008-2021 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
@@ -58,7 +58,7 @@ symbol_to_nsstring (Lisp_Object sym)
if (EQ (sym, QPRIMARY)) return NXPrimaryPboard;
if (EQ (sym, QSECONDARY)) return NXSecondaryPboard;
if (EQ (sym, QTEXT)) return NSPasteboardTypeString;
- return [NSString stringWithUTF8String: SSDATA (SYMBOL_NAME (sym))];
+ return [NSString stringWithLispString: SYMBOL_NAME (sym)];
}
static NSPasteboard *
@@ -78,7 +78,13 @@ ns_string_to_symbol (NSString *t)
return QSECONDARY;
if ([t isEqualToString: NSPasteboardTypeString])
return QTEXT;
- if ([t isEqualToString: NSFilenamesPboardType])
+ if ([t isEqualToString:
+#if NS_USE_NSPasteboardTypeFileURL != 0
+ NSPasteboardTypeFileURL
+#else
+ NSFilenamesPboardType
+#endif
+ ])
return QFILE_NAME;
if ([t isEqualToString: NSPasteboardTypeTabularText])
return QTEXT;
@@ -170,17 +176,12 @@ ns_string_to_pasteboard_internal (id pb, Lisp_Object str, NSString *gtype)
}
else
{
- char *utfStr;
NSString *type, *nsStr;
NSEnumerator *tenum;
CHECK_STRING (str);
- utfStr = SSDATA (str);
- nsStr = [[NSString alloc] initWithBytesNoCopy: utfStr
- length: SBYTES (str)
- encoding: NSUTF8StringEncoding
- freeWhenDone: NO];
+ nsStr = [NSString stringWithLispString: str];
// FIXME: Why those 2 different code paths?
if (gtype == nil)
{
@@ -196,7 +197,6 @@ ns_string_to_pasteboard_internal (id pb, Lisp_Object str, NSString *gtype)
eassert (gtype == NSPasteboardTypeString);
[pb setString: nsStr forType: gtype];
}
- [nsStr release];
ns_store_pb_change_count (pb);
}
}
@@ -473,7 +473,12 @@ nxatoms_of_nsselect (void)
[NSNumber numberWithLong:0], NXPrimaryPboard,
[NSNumber numberWithLong:0], NXSecondaryPboard,
[NSNumber numberWithLong:0], NSPasteboardTypeString,
- [NSNumber numberWithLong:0], NSFilenamesPboardType,
+ [NSNumber numberWithLong:0],
+#if NS_USE_NSPasteboardTypeFileURL != 0
+ NSPasteboardTypeFileURL,
+#else
+ NSFilenamesPboardType,
+#endif
[NSNumber numberWithLong:0], NSPasteboardTypeTabularText,
nil] retain];
}
diff --git a/src/nsterm.h b/src/nsterm.h
index f292993d8f7..eae1d0725ea 100644
--- a/src/nsterm.h
+++ b/src/nsterm.h
@@ -1,5 +1,5 @@
/* Definitions and headers for communication with NeXT/Open/GNUstep API.
- Copyright (C) 1989, 1993, 2005, 2008-2020 Free Software Foundation,
+ Copyright (C) 1989, 1993, 2005, 2008-2021 Free Software Foundation,
Inc.
This file is part of GNU Emacs.
@@ -39,6 +39,15 @@ typedef CGFloat EmacsCGFloat;
typedef float EmacsCGFloat;
#endif
+/* NSFilenamesPboardType is deprecated in macOS 10.14, but
+ NSPasteboardTypeFileURL is only available in 10.13 (and GNUstep
+ probably lacks it too). */
+#if defined NS_IMPL_COCOA && MAC_OS_X_VERSION_MIN_REQUIRED >= 101300
+#define NS_USE_NSPasteboardTypeFileURL 1
+#else
+#define NS_USE_NSPasteboardTypeFileURL 0
+#endif
+
/* ==========================================================================
Trace support
@@ -414,6 +423,7 @@ typedef id instancetype;
========================================================================== */
@class EmacsToolbar;
+@class EmacsSurface;
#ifdef NS_IMPL_COCOA
@interface EmacsView : NSView <NSTextInput, NSWindowDelegate>
@@ -435,7 +445,7 @@ typedef id instancetype;
BOOL fs_is_native;
BOOL in_fullscreen_transition;
#ifdef NS_DRAW_TO_BUFFER
- CGContextRef drawingBuffer;
+ EmacsSurface *surface;
#endif
@public
struct frame *emacsframe;
@@ -478,7 +488,7 @@ typedef id instancetype;
#ifdef NS_DRAW_TO_BUFFER
- (void)focusOnDrawingBuffer;
-- (void)createDrawingBuffer;
+- (void)unfocusDrawingBuffer;
#endif
- (void)copyRect:(NSRect)srcRect to:(NSRect)dstRect;
@@ -497,6 +507,7 @@ typedef id instancetype;
NSPoint grabOffset;
}
+- (BOOL)restackWindow:(NSWindow *)win above:(BOOL)above;
- (void)setAppearance;
@end
@@ -513,25 +524,17 @@ typedef id instancetype;
========================================================================== */
-#ifdef NS_IMPL_COCOA
@interface EmacsMenu : NSMenu <NSMenuDelegate>
-#else
-@interface EmacsMenu : NSMenu
-#endif
{
- struct frame *frame;
- unsigned long keyEquivModMask;
+ BOOL needsUpdate;
}
-- (instancetype)initWithTitle: (NSString *)title frame: (struct frame *)f;
-- (void)setFrame: (struct frame *)f;
- (void)menuNeedsUpdate: (NSMenu *)menu; /* (delegate method) */
-- (NSString *)parseKeyEquiv: (const char *)key;
-- (NSMenuItem *)addItemWithWidgetValue: (void *)wvptr;
+- (NSMenuItem *)addItemWithWidgetValue: (void *)wvptr
+ attributes: (NSDictionary *)attributes;
- (void)fillWithWidgetValue: (void *)wvptr;
-- (void)fillWithWidgetValue: (void *)wvptr frame: (struct frame *)f;
-- (EmacsMenu *)addSubmenuWithTitle: (const char *)title forFrame: (struct frame *)f;
-- (void) clear;
+- (EmacsMenu *)addSubmenuWithTitle: (const char *)title;
+- (void) removeAllItems;
- (Lisp_Object)runMenuAt: (NSPoint)p forFrame: (struct frame *)f
keymaps: (bool)keymaps;
@end
@@ -666,6 +669,7 @@ typedef id instancetype;
- (BOOL)setFrame: (unsigned int) index;
- (void)setTransform: (double[3][3]) m;
- (void)setSmoothing: (BOOL)s;
+- (size_t)sizeInBytes;
@end
@@ -711,6 +715,25 @@ typedef id instancetype;
+ (CGFloat)scrollerWidth;
@end
+#ifdef NS_DRAW_TO_BUFFER
+@interface EmacsSurface : NSObject
+{
+ NSMutableArray *cache;
+ NSSize size;
+ CGColorSpaceRef colorSpace;
+ IOSurfaceRef currentSurface;
+ IOSurfaceRef lastSurface;
+ CGContextRef context;
+}
+- (id) initWithSize: (NSSize)s ColorSpace: (CGColorSpaceRef)cs;
+- (void) dealloc;
+- (NSSize) getSize;
+- (CGContextRef) getContext;
+- (void) releaseContext;
+- (IOSurfaceRef) getSurface;
+@end
+#endif
+
/* ==========================================================================
@@ -1129,8 +1152,6 @@ extern int ns_lisp_to_color (Lisp_Object color, NSColor **col);
extern NSColor *ns_lookup_indexed_color (unsigned long idx, struct frame *f);
extern unsigned long ns_index_color (NSColor *color, struct frame *f);
extern const char *ns_get_pending_menu_title (void);
-extern void ns_check_menu_open (NSMenu *menu);
-extern void ns_check_pending_open_menu (void);
#endif
/* Implemented in nsfns, published in nsterm. */
@@ -1195,6 +1216,7 @@ extern void ns_set_alpha (void *img, int x, int y, unsigned char a);
extern int ns_display_pixel_height (struct ns_display_info *);
extern int ns_display_pixel_width (struct ns_display_info *);
+extern size_t ns_image_size_in_bytes (void *img);
/* This in nsterm.m */
extern float ns_antialias_threshold;
diff --git a/src/nsterm.m b/src/nsterm.m
index fa38350a2f6..c5815ce8d10 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -1,6 +1,6 @@
/* NeXT/Open/GNUstep / macOS communication module. -*- coding: utf-8 -*-
-Copyright (C) 1989, 1993-1994, 2005-2006, 2008-2020 Free Software
+Copyright (C) 1989, 1993-1994, 2005-2006, 2008-2021 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
@@ -72,6 +72,10 @@ GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu)
#include <Carbon/Carbon.h>
#endif
+#ifdef NS_DRAW_TO_BUFFER
+#include <IOSurface/IOSurface.h>
+#endif
+
static EmacsMenu *dockMenu;
#ifdef NS_IMPL_COCOA
static EmacsMenu *mainMenu;
@@ -310,24 +314,6 @@ static struct {
NULL, 0, 0
};
-#ifdef NS_IMPL_COCOA
-/*
- * State for pending menu activation:
- * MENU_NONE Normal state
- * MENU_PENDING A menu has been clicked on, but has been canceled so we can
- * run lisp to update the menu.
- * MENU_OPENING Menu is up to date, and the click event is redone so the menu
- * will open.
- */
-#define MENU_NONE 0
-#define MENU_PENDING 1
-#define MENU_OPENING 2
-static int menu_will_open_state = MENU_NONE;
-
-/* Saved position for menu click. */
-static CGPoint menu_mouse_point;
-#endif
-
/* Convert modifiers in a NeXTstep event to emacs style modifiers. */
#define NS_FUNCTION_KEY_MASK 0x800000
#define NSLeftControlKeyMask (0x000001 | NSEventModifierFlagControl)
@@ -1165,8 +1151,7 @@ ns_update_end (struct frame *f)
if ([FRAME_NS_VIEW (f) wantsUpdateLayer])
{
#endif
- [NSGraphicsContext setCurrentContext:nil];
- [view setNeedsDisplay:YES];
+ [FRAME_NS_VIEW (f) unfocusDrawingBuffer];
#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
}
else
@@ -1274,6 +1259,8 @@ ns_unfocus (struct frame *f)
if ([FRAME_NS_VIEW (f) wantsUpdateLayer])
{
#endif
+ if (! ns_updating_frame)
+ [FRAME_NS_VIEW (f) unfocusDrawingBuffer];
[FRAME_NS_VIEW (f) setNeedsDisplay:YES];
#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
}
@@ -1782,6 +1769,8 @@ ns_destroy_window (struct frame *f)
{
NSTRACE ("ns_destroy_window");
+ check_window_system (f);
+
/* If this frame has a parent window, detach it as not doing so can
cause a crash in GNUStep. */
if (FRAME_PARENT_FRAME (f) != NULL)
@@ -1792,7 +1781,7 @@ ns_destroy_window (struct frame *f)
[parent removeChildWindow: child];
}
- check_window_system (f);
+ [[FRAME_NS_VIEW (f) window] close];
ns_free_frame_resources (f);
ns_window_num--;
}
@@ -3054,7 +3043,7 @@ ns_clear_under_internal_border (struct frame *f)
if (!face)
return;
- ns_focus (f, &frame_rect, 1);
+ ns_focus (f, NULL, 1);
[ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), f) set];
for (int i = 0; i < 4 ; i++)
{
@@ -3403,6 +3392,8 @@ ns_draw_window_cursor (struct window *w, struct glyph_row *glyph_row,
/* Prevent the cursor from being drawn outside the text area. */
r = NSIntersectionRect (r, ns_row_rect (w, glyph_row, TEXT_AREA));
+ ns_focus (f, &r, 1);
+
face = FACE_FROM_ID_OR_NULL (f, phys_cursor_glyph->face_id);
if (face && NS_FACE_BACKGROUND (face)
== ns_index_color (FRAME_CURSOR_COLOR (f), f))
@@ -3413,8 +3404,6 @@ ns_draw_window_cursor (struct window *w, struct glyph_row *glyph_row,
else
[FRAME_CURSOR_COLOR (f) set];
- ns_focus (f, &r, 1);
-
switch (cursor_type)
{
case DEFAULT_CURSOR:
@@ -4606,79 +4595,6 @@ check_native_fs ()
}
#endif
-/* GNUstep does not have cancelTracking. */
-#ifdef NS_IMPL_COCOA
-/* Check if menu open should be canceled or continued as normal. */
-void
-ns_check_menu_open (NSMenu *menu)
-{
- /* Click in menu bar? */
- NSArray *a = [[NSApp mainMenu] itemArray];
- int i;
- BOOL found = NO;
-
- if (menu == nil) // Menu tracking ended.
- {
- if (menu_will_open_state == MENU_OPENING)
- menu_will_open_state = MENU_NONE;
- return;
- }
-
- for (i = 0; ! found && i < [a count]; i++)
- found = menu == [[a objectAtIndex:i] submenu];
- if (found)
- {
- if (menu_will_open_state == MENU_NONE && emacs_event)
- {
- NSEvent *theEvent = [NSApp currentEvent];
- struct frame *emacsframe = SELECTED_FRAME ();
-
- /* On macOS, the following can cause an event loop when the
- Spotlight for Help search field is populated. Avoid this by
- not postponing mouse drag and non-user-generated mouse down
- events (Bug#31371). */
- if (([theEvent type] == NSEventTypeLeftMouseDown)
- && [theEvent eventNumber])
- {
- [menu cancelTracking];
- menu_will_open_state = MENU_PENDING;
- emacs_event->kind = MENU_BAR_ACTIVATE_EVENT;
- EV_TRAILER (theEvent);
-
- CGEventRef ourEvent = CGEventCreate (NULL);
- menu_mouse_point = CGEventGetLocation (ourEvent);
- CFRelease (ourEvent);
- }
- }
- else if (menu_will_open_state == MENU_OPENING)
- {
- menu_will_open_state = MENU_NONE;
- }
- }
-}
-
-/* Redo saved menu click if state is MENU_PENDING. */
-void
-ns_check_pending_open_menu ()
-{
- if (menu_will_open_state == MENU_PENDING)
- {
- CGEventSourceRef source
- = CGEventSourceCreate (kCGEventSourceStateHIDSystemState);
-
- CGEventRef event = CGEventCreateMouseEvent (source,
- kCGEventLeftMouseDown,
- menu_mouse_point,
- kCGMouseButtonLeft);
- CGEventSetType (event, kCGEventLeftMouseDown);
- CGEventPost (kCGHIDEventTap, event);
- CFRelease (event);
- CFRelease (source);
-
- menu_will_open_state = MENU_OPENING;
- }
-}
-#endif /* NS_IMPL_COCOA */
static int
ns_read_socket (struct terminal *terminal, struct input_event *hold_quit)
@@ -4787,7 +4703,8 @@ ns_select (int nfds, fd_set *readfds, fd_set *writefds,
return -1;
}
- for (k = 0; k < nfds+1; k++)
+ eassert (nfds <= FD_SETSIZE);
+ for (k = 0; k < nfds; k++)
{
if (readfds && FD_ISSET(k, readfds)) ++nr;
if (writefds && FD_ISSET(k, writefds)) ++nr;
@@ -4804,8 +4721,22 @@ ns_select (int nfds, fd_set *readfds, fd_set *writefds,
thread_select(pselect, 0, NULL, NULL, NULL, &t, sigmask);
}
- [outerpool release];
- outerpool = [[NSAutoreleasePool alloc] init];
+ /* FIXME: This draining of outerpool causes a crash when a buffer
+ running over tramp is displayed and the user tries to use the
+ menus. I believe some other autorelease pool's lifetime
+ straddles this call causing a violation of autorelease pool
+ nesting. There's no good reason to keep these here since the
+ pool will be drained some other time anyway, but removing them
+ leaves the menus sometimes not opening until the user moves their
+ mouse pointer, but that's better than a crash.
+
+ There must be something about running external processes like
+ tramp that interferes with the modal menu code.
+
+ See bugs 24472, 37557, 37922. */
+
+ // [outerpool release];
+ // outerpool = [[NSAutoreleasePool alloc] init];
send_appdefined = YES;
@@ -4985,8 +4916,8 @@ ns_set_vertical_scroll_bar (struct window *window,
[bar removeFromSuperview];
wset_vertical_scroll_bar (window, Qnil);
[bar release];
+ ns_clear_frame_area (f, left, top, width, height);
}
- ns_clear_frame_area (f, left, top, width, height);
unblock_input ();
return;
}
@@ -5008,7 +4939,7 @@ ns_set_vertical_scroll_bar (struct window *window,
r.size.width = oldRect.size.width;
if (FRAME_LIVE_P (f) && !NSEqualRects (oldRect, r))
{
- if (oldRect.origin.x != r.origin.x)
+ if (! NSEqualRects (oldRect, r))
ns_clear_frame_area (f, left, top, width, height);
[bar setFrame: r];
}
@@ -5086,8 +5017,7 @@ ns_set_horizontal_scroll_bar (struct window *window,
oldRect = [bar frame];
if (FRAME_LIVE_P (f) && !NSEqualRects (oldRect, r))
{
- if (oldRect.origin.y != r.origin.y)
- ns_clear_frame_area (f, left, top, width, height);
+ ns_clear_frame_area (f, left, top, width, height);
[bar setFrame: r];
update_p = YES;
}
@@ -5164,15 +5094,13 @@ ns_judge_scroll_bars (struct frame *f)
id view;
EmacsView *eview = FRAME_NS_VIEW (f);
NSArray *subviews = [[eview superview] subviews];
- BOOL removed = NO;
NSTRACE ("ns_judge_scroll_bars");
for (i = [subviews count]-1; i >= 0; --i)
{
view = [subviews objectAtIndex: i];
if (![view isKindOfClass: [EmacsScroller class]]) continue;
- if ([view judge])
- removed = YES;
+ [view judge];
}
}
@@ -5416,7 +5344,6 @@ ns_create_terminal (struct ns_display_info *dpyinfo)
terminal->set_new_font_hook = ns_new_font;
terminal->implicit_set_name_hook = ns_implicitly_set_name;
terminal->menu_show_hook = ns_menu_show;
- terminal->activate_menubar_hook = ns_activate_menubar;
terminal->popup_dialog_hook = ns_popup_dialog;
terminal->set_vertical_scroll_bar_hook = ns_set_vertical_scroll_bar;
terminal->set_horizontal_scroll_bar_hook = ns_set_horizontal_scroll_bar;
@@ -5541,9 +5468,8 @@ ns_term_init (Lisp_Object display_name)
/* There are 752 colors defined in rgb.txt. */
if ( cl == nil || [[cl allKeys] count] < 752)
{
- Lisp_Object color_file, color_map, color;
+ Lisp_Object color_file, color_map, color, name;
unsigned long c;
- char *name;
color_file = Fexpand_file_name (build_string ("rgb.txt"),
Fsymbol_value (intern ("data-directory")));
@@ -5556,14 +5482,14 @@ ns_term_init (Lisp_Object display_name)
for ( ; CONSP (color_map); color_map = XCDR (color_map))
{
color = XCAR (color_map);
- name = SSDATA (XCAR (color));
+ name = XCAR (color);
c = XFIXNUM (XCDR (color));
[cl setColor:
[NSColor colorForEmacsRed: RED_FROM_ULONG (c) / 255.0
green: GREEN_FROM_ULONG (c) / 255.0
blue: BLUE_FROM_ULONG (c) / 255.0
alpha: 1.0]
- forKey: [NSString stringWithUTF8String: name]];
+ forKey: [NSString stringWithLispString: name]];
}
/* FIXME: Report any errors writing the color file below. */
@@ -5662,15 +5588,6 @@ ns_term_init (Lisp_Object display_name)
[NSApp setServicesMenu: svcsMenu];
/* Needed at least on Cocoa, to get dock menu to show windows */
[NSApp setWindowsMenu: [[NSMenu alloc] init]];
-
- [[NSNotificationCenter defaultCenter]
- addObserver: mainMenu
- selector: @selector (trackingNotification:)
- name: NSMenuDidBeginTrackingNotification object: mainMenu];
- [[NSNotificationCenter defaultCenter]
- addObserver: mainMenu
- selector: @selector (trackingNotification:)
- name: NSMenuDidEndTrackingNotification object: mainMenu];
}
#endif /* macOS menu setup */
@@ -5685,7 +5602,11 @@ ns_term_init (Lisp_Object display_name)
ns_drag_types = [[NSArray arrayWithObjects:
NSPasteboardTypeString,
NSPasteboardTypeTabularText,
+#if NS_USE_NSPasteboardTypeFileURL != 0
+ NSPasteboardTypeFileURL,
+#else
NSFilenamesPboardType,
+#endif
NSPasteboardTypeURL, nil] retain];
/* If fullscreen is in init/default-frame-alist, focus isn't set
@@ -6368,7 +6289,7 @@ not_in_argv (NSString *arg)
object:nil];
#ifdef NS_DRAW_TO_BUFFER
- CGContextRelease (drawingBuffer);
+ [surface release];
#endif
[toolbar release];
@@ -6529,6 +6450,14 @@ not_in_argv (NSString *arg)
code = 0xFF08; /* backspace */
else
code = fnKeysym;
+
+ /* Function keys (such as the F-keys, arrow keys, etc.) set
+ modifiers as though the fn key has been pressed when it
+ hasn't. Also some combinations of fn and a function key
+ return a different key than was pressed (e.g. fn-<left>
+ gives <home>). We need to unset the fn key flag in these
+ cases. */
+ flags &= ~NS_FUNCTION_KEY_MASK;
}
/* The ⌘ and ⌥ modifiers can be either shift-like (for alternate
@@ -6550,17 +6479,6 @@ not_in_argv (NSString *arg)
Lisp_Object kind = fnKeysym ? QCfunction : QCordinary;
emacs_event->modifiers = EV_MODIFIERS2 (flags, kind);
- /* Function keys (such as the F-keys, arrow keys, etc.) set
- modifiers as though the fn key has been pressed when it
- hasn't. Also some combinations of fn and a function key
- return a different key than was pressed (e.g. fn-<left> gives
- <home>). We need to unset the fn modifier in these cases.
- FIXME: Can we avoid setting it in the first place? */
- if (fnKeysym && (flags & NS_FUNCTION_KEY_MASK))
- emacs_event->modifiers
- ^= parse_solitary_modifier (mod_of_kind (ns_function_modifier,
- QCfunction));
-
if (NS_KEYLOG)
fprintf (stderr, "keyDown: code =%x\tfnKey =%x\tflags = %x\tmods = %x\n",
code, fnKeysym, flags, emacs_event->modifiers);
@@ -7283,7 +7201,7 @@ not_in_argv (NSString *arg)
old_title = t;
}
size_title = xmalloc (strlen (old_title) + 40);
- esprintf (size_title, "%s — (%d x %d)", old_title, cols, rows);
+ esprintf (size_title, "%s — (%d × %d)", old_title, cols, rows);
[window setTitle: [NSString stringWithUTF8String: size_title]];
[window display];
xfree (size_title);
@@ -7394,8 +7312,9 @@ not_in_argv (NSString *arg)
if ([self wantsUpdateLayer])
{
CGFloat scale = [[self window] backingScaleFactor];
- int oldw = (CGFloat)CGBitmapContextGetWidth (drawingBuffer) / scale;
- int oldh = (CGFloat)CGBitmapContextGetHeight (drawingBuffer) / scale;
+ NSSize size = [surface getSize];
+ int oldw = size.width / scale;
+ int oldh = size.height / scale;
NSTRACE_SIZE ("Original size", NSMakeSize (oldw, oldh));
@@ -7405,6 +7324,9 @@ not_in_argv (NSString *arg)
NSTRACE_MSG ("No change");
return;
}
+
+ [surface release];
+ surface = nil;
}
#endif
@@ -7417,9 +7339,6 @@ not_in_argv (NSString *arg)
FRAME_PIXEL_TO_TEXT_HEIGHT (emacsframe, newh),
0, YES, 0, 1);
-#ifdef NS_DRAW_TO_BUFFER
- [self createDrawingBuffer];
-#endif
SET_FRAME_GARBAGED (emacsframe);
cancel_mouse_face (emacsframe);
}
@@ -7622,8 +7541,7 @@ not_in_argv (NSString *arg)
[self registerForDraggedTypes: ns_drag_types];
tem = f->name;
- name = [NSString stringWithUTF8String:
- NILP (tem) ? "Emacs" : SSDATA (tem)];
+ name = NILP (tem) ? @"Emacs" : [NSString stringWithLispString:tem];
[win setTitle: name];
/* toolbar support */
@@ -7691,10 +7609,6 @@ not_in_argv (NSString *arg)
[NSApp registerServicesMenuSendTypes: ns_send_types
returnTypes: [NSArray array]];
-#ifdef NS_DRAW_TO_BUFFER
- [self createDrawingBuffer];
-#endif
-
/* Set up view resize notifications. */
[self setPostsFrameChangedNotifications:YES];
[[NSNotificationCenter defaultCenter]
@@ -8414,45 +8328,41 @@ not_in_argv (NSString *arg)
#ifdef NS_DRAW_TO_BUFFER
-- (void)createDrawingBuffer
- /* Create and store a new CGGraphicsContext for Emacs to draw into.
-
- We can't do this in GNUstep as there's no equivalent, so under
- GNUstep we retain the old method of drawing direct to the
- EmacsView. */
+- (void)focusOnDrawingBuffer
{
- NSTRACE ("EmacsView createDrawingBuffer]");
+ CGFloat scale = [[self window] backingScaleFactor];
- if (! [self wantsUpdateLayer])
- return;
+ NSTRACE ("[EmacsView focusOnDrawingBuffer]");
- NSGraphicsContext *screen;
- CGColorSpaceRef colorSpace = [[[self window] colorSpace] CGColorSpace];
- CGFloat scale = [[self window] backingScaleFactor];
- NSRect frame = [self frame];
+ if (! surface)
+ {
+ NSRect frame = [self frame];
+ NSSize s = NSMakeSize (NSWidth (frame) * scale, NSHeight (frame) * scale);
- if (drawingBuffer != nil)
- CGContextRelease (drawingBuffer);
+ surface = [[EmacsSurface alloc] initWithSize:s
+ ColorSpace:[[[self window] colorSpace]
+ CGColorSpace]];
+ }
+
+ CGContextRef context = [surface getContext];
- drawingBuffer = CGBitmapContextCreate (nil, NSWidth (frame) * scale, NSHeight (frame) * scale,
- 8, 0, colorSpace,
- kCGImageAlphaPremultipliedFirst | kCGBitmapByteOrder32Host);
+ CGContextTranslateCTM(context, 0, [surface getSize].height);
+ CGContextScaleCTM(context, scale, -scale);
- /* This fixes the scale to match the backing scale factor, and flips the image. */
- CGContextTranslateCTM(drawingBuffer, 0, NSHeight (frame) * scale);
- CGContextScaleCTM(drawingBuffer, scale, -scale);
+ [NSGraphicsContext
+ setCurrentContext:[NSGraphicsContext
+ graphicsContextWithCGContext:context
+ flipped:YES]];
}
-- (void)focusOnDrawingBuffer
+- (void)unfocusDrawingBuffer
{
- NSTRACE ("EmacsView focusOnDrawingBuffer]");
+ NSTRACE ("[EmacsView unfocusDrawingBuffer]");
- NSGraphicsContext *buf =
- [NSGraphicsContext
- graphicsContextWithCGContext:drawingBuffer flipped:YES];
-
- [NSGraphicsContext setCurrentContext:buf];
+ [NSGraphicsContext setCurrentContext:nil];
+ [surface releaseContext];
+ [self setNeedsDisplay:YES];
}
@@ -8461,11 +8371,11 @@ not_in_argv (NSString *arg)
{
NSTRACE ("EmacsView windowDidChangeBackingProperties:]");
- if (! [self wantsUpdateLayer])
- return;
-
NSRect frame = [self frame];
- [self createDrawingBuffer];
+
+ [surface release];
+ surface = nil;
+
ns_clear_frame (emacsframe);
expose_frame (emacsframe, 0, 0, NSWidth (frame), NSHeight (frame));
}
@@ -8483,33 +8393,28 @@ not_in_argv (NSString *arg)
if ([self wantsUpdateLayer])
{
#endif
- CGImageRef copy;
- NSRect frame = [self frame];
- NSAffineTransform *setOrigin = [NSAffineTransform transform];
-
- [[NSGraphicsContext currentContext] saveGraphicsState];
-
- /* Set the clipping before messing with the buffer's
- orientation. */
- NSRectClip (dstRect);
-
- /* Unflip the buffer as the copied image will be unflipped, and
- offset the top left so when we draw back into the buffer the
- correct part of the image is drawn. */
- CGContextScaleCTM(drawingBuffer, 1, -1);
- CGContextTranslateCTM(drawingBuffer,
- NSMinX (dstRect) - NSMinX (srcRect),
- -NSHeight (frame) - (NSMinY (dstRect) - NSMinY (srcRect)));
-
- /* Take a copy of the buffer and then draw it back to the buffer,
- limited by the clipping rectangle. */
- copy = CGBitmapContextCreateImage (drawingBuffer);
- CGContextDrawImage (drawingBuffer, frame, copy);
-
- CGImageRelease (copy);
-
- [[NSGraphicsContext currentContext] restoreGraphicsState];
- [self setNeedsDisplayInRect:dstRect];
+ double scale = [[self window] backingScaleFactor];
+ CGContextRef context = [[NSGraphicsContext currentContext] CGContext];
+ int bpp = CGBitmapContextGetBitsPerPixel (context) / 8;
+ 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);
+
+ 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,
+ srcRowSize);
+ else
+ for (int y = 0 ; y < NSHeight (srcRect) * scale ; y++)
+ memmove (dstPixels + y * rowSize,
+ srcPixels + y * rowSize,
+ srcRowSize);
#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
}
@@ -8550,9 +8455,12 @@ not_in_argv (NSString *arg)
{
NSTRACE ("[EmacsView updateLayer]");
- CGImageRef contentsImage = CGBitmapContextCreateImage(drawingBuffer);
- [[self layer] setContents:(id)contentsImage];
- CGImageRelease(contentsImage);
+ /* This can fail to update the screen if the same surface is
+ provided twice in a row, even if its contents have changed.
+ There's a private method, -[CALayer setContentsChanged], that we
+ could use to force it, but we shouldn't often get the same
+ surface twice in a row. */
+ [[self layer] setContents:(id)[surface getSurface]];
}
#endif
@@ -8629,9 +8537,19 @@ not_in_argv (NSString *arg)
{
return NO;
}
- /* FIXME: NSFilenamesPboardType is deprecated in 10.14, but the
- NSURL method can only handle one file at a time. Stick with the
- existing code at the moment. */
+#if NS_USE_NSPasteboardTypeFileURL != 0
+ else if ([type isEqualToString: NSPasteboardTypeFileURL])
+ {
+ type_sym = Qfile;
+
+ NSArray *urls = [pb readObjectsForClasses: @[[NSURL self]]
+ options: nil];
+ NSEnumerator *uenum = [urls objectEnumerator];
+ NSURL *url;
+ while ((url = [uenum nextObject]))
+ strings = Fcons ([[url path] lispString], strings);
+ }
+#else // !NS_USE_NSPasteboardTypeFileURL
else if ([type isEqualToString: NSFilenamesPboardType])
{
NSArray *files;
@@ -8647,6 +8565,7 @@ not_in_argv (NSString *arg)
while ( (file = [fenum nextObject]) )
strings = Fcons ([file lispString], strings);
}
+#endif // !NS_USE_NSPasteboardTypeFileURL
else if ([type isEqualToString: NSPasteboardTypeURL])
{
NSURL *url = [NSURL URLFromPasteboard: pb];
@@ -8789,6 +8708,112 @@ not_in_argv (NSString *arg)
@implementation EmacsWindow
+/* It seems the only way to reorder child frames is by removing them
+ from the parent and then reattaching them in the correct order. */
+
+- (void)orderFront:(id)sender
+{
+ NSTRACE ("[EmacsWindow orderFront:]");
+
+ NSWindow *parent = [self parentWindow];
+ if (parent)
+ {
+ [parent removeChildWindow:self];
+ [parent addChildWindow:self ordered:NSWindowAbove];
+ }
+ else
+ [super orderFront:sender];
+}
+
+- (void)makeKeyAndOrderFront:(id)sender
+{
+ NSTRACE ("[EmacsWindow makeKeyAndOrderFront:]");
+
+ if ([self parentWindow])
+ {
+ [self orderFront:sender];
+ [self makeKeyWindow];
+ }
+ else
+ [super makeKeyAndOrderFront:sender];
+}
+
+
+/* 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)
+{
+ NSInteger i1 = [w1 orderedIndex];
+ NSInteger i2 = [w2 orderedIndex];
+
+ if (i1 > i2)
+ return NSOrderedAscending;
+ if (i1 < i2)
+ return NSOrderedDescending;
+
+ return NSOrderedSame;
+}
+
+- (void)orderBack:(id)sender
+{
+ NSTRACE ("[EmacsWindow orderBack:]");
+
+ NSWindow *parent = [self parentWindow];
+ if (parent)
+ {
+ NSArray *children = [[parent childWindows]
+ sortedArrayUsingFunction:nswindow_orderedIndex_sort
+ context:nil];
+ [parent removeChildWindow:self];
+ [parent addChildWindow:self ordered:NSWindowAbove];
+
+ for (NSWindow *win in children)
+ {
+ if (win != self)
+ {
+ [parent removeChildWindow:win];
+ [parent addChildWindow:win ordered:NSWindowAbove];
+ }
+ }
+ }
+ else
+ [super orderBack:sender];
+}
+
+- (BOOL)restackWindow:(NSWindow *)win above:(BOOL)above
+{
+ NSTRACE ("[EmacsWindow restackWindow:above:]");
+
+ /* If parent windows don't match we can't restack these frames
+ without changing the parents. */
+ if ([self parentWindow] != [win parentWindow])
+ return NO;
+ else if (![self parentWindow])
+ [self orderWindow:(above ? NSWindowAbove : NSWindowBelow)
+ relativeTo:[win windowNumber]];
+ else
+ {
+ NSInteger index;
+ NSWindow *parent = [self parentWindow];
+ NSMutableArray *children = [[[parent childWindows]
+ sortedArrayUsingFunction:nswindow_orderedIndex_sort
+ context:nil]
+ mutableCopy];
+ [children removeObject:self];
+ index = [children indexOfObject:win];
+ [children insertObject:self atIndex:(above ? index+1 : index)];
+
+ for (NSWindow *w in children)
+ {
+ [parent removeChildWindow:w];
+ [parent addChildWindow:w ordered:NSWindowAbove];
+ }
+ }
+
+ return YES;
+}
+
#ifdef NS_IMPL_COCOA
- (id)accessibilityAttributeValue:(NSString *)attribute
{
@@ -9595,6 +9620,210 @@ not_in_argv (NSString *arg)
@end /* EmacsScroller */
+#ifdef NS_DRAW_TO_BUFFER
+
+/* ==========================================================================
+
+ A class to handle the screen buffer.
+
+ ========================================================================== */
+
+@implementation EmacsSurface
+
+
+/* An IOSurface is a pixel buffer that is efficiently copied to VRAM
+ for display. In order to use an IOSurface we must first lock it,
+ write to it, then unlock it. At this point it is transferred to
+ VRAM and if we modify it during this transfer we may see corruption
+ of the output. To avoid this problem we can check if the surface
+ is "in use", and if it is then avoid using it. Unfortunately to
+ avoid writing to a surface that's in use, but still maintain the
+ ability to draw to the screen at any time, we need to keep a cache
+ of multiple surfaces that we can use at will.
+
+ The EmacsSurface class maintains this cache of surfaces, and
+ handles the conversion to a CGGraphicsContext that AppKit can use
+ to draw on.
+
+ The cache is simple: if a free surface is found it is removed from
+ the cache and set as the "current" surface. Once Emacs is done
+ with drawing to the current surface, the previous surface that was
+ drawn to is added to the cache for reuse, and the current one is
+ set as the last surface. If no free surfaces are found in the
+ cache then a new one is created.
+
+ When AppKit wants to update the screen, we provide it with the last
+ surface, as that has the most recent data.
+
+ FIXME: It is possible for the cache to grow if Emacs draws faster
+ than the surfaces can be drawn to the screen, so there should
+ probably be some sort of pruning job that removes excess
+ surfaces. */
+
+
+- (id) initWithSize: (NSSize)s
+ ColorSpace: (CGColorSpaceRef)cs
+{
+ NSTRACE ("[EmacsSurface initWithSize:ColorSpace:]");
+
+ [super init];
+
+ cache = [[NSMutableArray arrayWithCapacity:3] retain];
+ size = s;
+ colorSpace = cs;
+
+ return self;
+}
+
+
+- (void) dealloc
+{
+ if (context)
+ CGContextRelease (context);
+
+ if (currentSurface)
+ CFRelease (currentSurface);
+ if (lastSurface)
+ CFRelease (lastSurface);
+
+ for (id object in cache)
+ CFRelease ((IOSurfaceRef)object);
+
+ [cache removeAllObjects];
+
+ [super dealloc];
+}
+
+
+/* Return the size values our cached data is using. */
+- (NSSize) getSize
+{
+ return size;
+}
+
+
+/* Return a CGContextRef that can be used for drawing to the screen.
+ This must ALWAYS be paired with a call to releaseContext, and the
+ calls cannot be nested. */
+- (CGContextRef) getContext
+{
+ IOSurfaceRef surface = NULL;
+
+ NSTRACE ("[EmacsSurface getContextWithSize:]");
+ NSTRACE_MSG (@"IOSurface count: %lu", [cache count] + (lastSurface ? 1 : 0));
+
+ for (id object in cache)
+ {
+ if (!IOSurfaceIsInUse ((IOSurfaceRef)object))
+ {
+ surface = (IOSurfaceRef)object;
+ [cache removeObject:object];
+ break;
+ }
+ }
+
+ if (!surface)
+ {
+ int bytesPerRow = IOSurfaceAlignProperty (kIOSurfaceBytesPerRow,
+ size.width * 4);
+
+ surface = IOSurfaceCreate
+ ((CFDictionaryRef)@{(id)kIOSurfaceWidth:[NSNumber numberWithInt:size.width],
+ (id)kIOSurfaceHeight:[NSNumber numberWithInt:size.height],
+ (id)kIOSurfaceBytesPerRow:[NSNumber numberWithInt:bytesPerRow],
+ (id)kIOSurfaceBytesPerElement:[NSNumber numberWithInt:4],
+ (id)kIOSurfacePixelFormat:[NSNumber numberWithUnsignedInt:'BGRA']});
+ }
+
+ IOReturn lockStatus = IOSurfaceLock (surface, 0, nil);
+ if (lockStatus != kIOReturnSuccess)
+ NSLog (@"Failed to lock surface: %x", lockStatus);
+
+ [self copyContentsTo:surface];
+
+ currentSurface = surface;
+
+ context = CGBitmapContextCreate (IOSurfaceGetBaseAddress (currentSurface),
+ IOSurfaceGetWidth (currentSurface),
+ IOSurfaceGetHeight (currentSurface),
+ 8,
+ IOSurfaceGetBytesPerRow (currentSurface),
+ colorSpace,
+ (kCGImageAlphaPremultipliedFirst
+ | kCGBitmapByteOrder32Host));
+ return context;
+}
+
+
+/* Releases the CGGraphicsContext and unlocks the associated
+ IOSurface, so it will be sent to VRAM. */
+- (void) releaseContext
+{
+ NSTRACE ("[EmacsSurface releaseContextAndGetSurface]");
+
+ CGContextRelease (context);
+ context = NULL;
+
+ IOReturn lockStatus = IOSurfaceUnlock (currentSurface, 0, nil);
+ if (lockStatus != kIOReturnSuccess)
+ NSLog (@"Failed to unlock surface: %x", lockStatus);
+
+ /* Put lastSurface back on the end of the cache. It may not have
+ been displayed on the screen yet, but we probably want the new
+ data and not some stale data anyway. */
+ if (lastSurface)
+ [cache addObject:(id)lastSurface];
+ lastSurface = currentSurface;
+ currentSurface = NULL;
+}
+
+
+/* Get the IOSurface that we want to draw to the screen. */
+- (IOSurfaceRef) getSurface
+{
+ /* lastSurface always contains the most up-to-date and complete data. */
+ return lastSurface;
+}
+
+
+/* Copy the contents of lastSurface to DESTINATION. This is required
+ every time we want to use an IOSurface as its contents are probably
+ blanks (if it's new), or stale. */
+- (void) copyContentsTo: (IOSurfaceRef) destination
+{
+ IOReturn lockStatus;
+ void *sourceData, *destinationData;
+ int numBytes = IOSurfaceGetAllocSize (destination);
+
+ NSTRACE ("[EmacsSurface copyContentsTo:]");
+
+ if (! lastSurface)
+ return;
+
+ lockStatus = IOSurfaceLock (lastSurface, kIOSurfaceLockReadOnly, nil);
+ if (lockStatus != kIOReturnSuccess)
+ NSLog (@"Failed to lock source surface: %x", lockStatus);
+
+ sourceData = IOSurfaceGetBaseAddress (lastSurface);
+ destinationData = IOSurfaceGetBaseAddress (destination);
+
+ /* Since every IOSurface should have the exact same settings, a
+ memcpy seems like the fastest way to copy the data from one to
+ the other. */
+ memcpy (destinationData, sourceData, numBytes);
+
+ lockStatus = IOSurfaceUnlock (lastSurface, kIOSurfaceLockReadOnly, nil);
+ if (lockStatus != kIOReturnSuccess)
+ NSLog (@"Failed to unlock source surface: %x", lockStatus);
+}
+
+
+@end /* EmacsSurface */
+
+
+#endif
+
+
#ifdef NS_IMPL_GNUSTEP
/* Dummy class to get rid of startup warnings. */
@implementation EmacsDocument
diff --git a/src/nsxwidget.h b/src/nsxwidget.h
index dcdb26cb34c..9cc90b0d09a 100644
--- a/src/nsxwidget.h
+++ b/src/nsxwidget.h
@@ -1,6 +1,6 @@
/* Header for NS Cocoa part of xwidget and webkit widget.
-Copyright (C) 2019-2020 Free Software Foundation, Inc.
+Copyright (C) 2019-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/nsxwidget.m b/src/nsxwidget.m
index dbd4cb29a62..eff5f0a9ce8 100644
--- a/src/nsxwidget.m
+++ b/src/nsxwidget.m
@@ -1,6 +1,6 @@
/* NS Cocoa part implementation of xwidget and webkit widget.
-Copyright (C) 2019-2020 Free Software Foundation, Inc.
+Copyright (C) 2019-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -296,8 +296,6 @@ static NSString *xwScript;
/* Xwidget webkit commands. */
-static Lisp_Object build_string_with_nsstr (NSString *nsstr);
-
bool
nsxwidget_is_web_view (struct xwidget *xw)
{
@@ -309,14 +307,14 @@ Lisp_Object
nsxwidget_webkit_uri (struct xwidget *xw)
{
XwWebView *xwWebView = (XwWebView *) xw->xwWidget;
- return build_string_with_nsstr (xwWebView.URL.absoluteString);
+ return [xwWebView.URL.absoluteString lispString];
}
Lisp_Object
nsxwidget_webkit_title (struct xwidget *xw)
{
XwWebView *xwWebView = (XwWebView *) xw->xwWidget;
- return build_string_with_nsstr (xwWebView.title);
+ return [xwWebView.title lispString];
}
/* @Note ATS - Need application transport security in 'Info.plist' or
@@ -350,15 +348,6 @@ nsxwidget_webkit_zoom (struct xwidget *xw, double zoom_change)
/* TODO: setMagnification:centeredAtPoint. */
}
-/* Build lisp string */
-static Lisp_Object
-build_string_with_nsstr (NSString *nsstr)
-{
- const char *utfstr = [nsstr UTF8String];
- NSUInteger bytes = [nsstr lengthOfBytesUsingEncoding:NSUTF8StringEncoding];
- return make_string (utfstr, bytes);
-}
-
/* Recursively convert an objc native type JavaScript value to a Lisp
value. Mostly copied from GTK xwidget 'webkit_js_to_lisp'. */
static Lisp_Object
@@ -367,7 +356,7 @@ js_to_lisp (id value)
if (value == nil || [value isKindOfClass:NSNull.class])
return Qnil;
else if ([value isKindOfClass:NSString.class])
- return build_string_with_nsstr ((NSString *) value);
+ return [(NSString *) value lispString];
else if ([value isKindOfClass:NSNumber.class])
{
NSNumber *nsnum = (NSNumber *) value;
@@ -407,7 +396,7 @@ js_to_lisp (id value)
{
NSString *prop_key = (NSString *) [keys objectAtIndex:i];
id prop_value = [nsdict valueForKey:prop_key];
- p->contents[i] = Fcons (build_string_with_nsstr (prop_key),
+ p->contents[i] = Fcons ([prop_key lispString],
js_to_lisp (prop_value));
}
XSETVECTOR (obj, p);
diff --git a/src/pdumper.c b/src/pdumper.c
index 909900417d9..c1388ebbb37 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2018-2020 Free Software Foundation, Inc.
+/* Copyright (C) 2018-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -2058,7 +2058,7 @@ dump_interval_tree (struct dump_context *ctx,
static dump_off
dump_string (struct dump_context *ctx, const struct Lisp_String *string)
{
-#if CHECK_STRUCTS && !defined (HASH_Lisp_String_86FEA6EC7C)
+#if CHECK_STRUCTS && !defined (HASH_Lisp_String_348C2B2FDB)
# error "Lisp_String changed. See CHECK_STRUCTS comment in config.h."
#endif
/* If we have text properties, write them _after_ the string so that
@@ -2692,7 +2692,7 @@ dump_hash_table (struct dump_context *ctx,
static dump_off
dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer)
{
-#if CHECK_STRUCTS && !defined HASH_buffer_5DC36DBD42
+#if CHECK_STRUCTS && !defined HASH_buffer_99D642C1CB
# error "buffer changed. See CHECK_STRUCTS comment in config.h."
#endif
struct buffer munged_buffer = *in_buffer;
@@ -4024,7 +4024,7 @@ types. */)
ctx->header.fingerprint[i] = fingerprint[i];
const dump_off header_start = ctx->offset;
- dump_fingerprint ("dumping fingerprint", ctx->header.fingerprint);
+ dump_fingerprint ("Dumping fingerprint", ctx->header.fingerprint);
dump_write (ctx, &ctx->header, sizeof (ctx->header));
const dump_off header_end = ctx->offset;
@@ -5273,7 +5273,7 @@ pdumper_load (const char *dump_filename)
eassert (!dump_loaded_p ());
int err;
- int dump_fd = emacs_open (dump_filename, O_RDONLY, 0);
+ int dump_fd = emacs_open_noquit (dump_filename, O_RDONLY, 0);
if (dump_fd < 0)
{
err = (errno == ENOENT || errno == ENOTDIR
diff --git a/src/pdumper.h b/src/pdumper.h
index c793fb40580..ed665ac6c2f 100644
--- a/src/pdumper.h
+++ b/src/pdumper.h
@@ -1,6 +1,6 @@
/* Header file for the portable dumper.
-Copyright (C) 2016, 2018-2020 Free Software Foundation, Inc.
+Copyright (C) 2016, 2018-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/print.c b/src/print.c
index fa65a3cb268..14af9195475 100644
--- a/src/print.c
+++ b/src/print.c
@@ -1,6 +1,6 @@
/* Lisp object printing and output streams.
-Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2020 Free Software
+Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2021 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
@@ -562,7 +562,7 @@ temp_output_buffer_setup (const char *bufname)
record_unwind_current_buffer ();
- Fset_buffer (Fget_buffer_create (build_string (bufname)));
+ Fset_buffer (Fget_buffer_create (build_string (bufname), Qnil));
Fkill_all_local_variables ();
delete_all_overlays (current_buffer);
@@ -1557,7 +1557,8 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag,
/* Implement a readable output, e.g.:
#s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
/* Always print the size. */
- int len = sprintf (buf, "#s(hash-table size %"pD"d", ASIZE (h->next));
+ int len = sprintf (buf, "#s(hash-table size %"pD"d",
+ HASH_TABLE_SIZE (h));
strout (buf, len, len, printcharfun);
if (!NILP (h->test.name))
@@ -1848,6 +1849,24 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag,
return true;
}
+static char
+named_escape (int i)
+{
+ switch (i)
+ {
+ case '\b': return 'b';
+ case '\t': return 't';
+ case '\n': return 'n';
+ case '\f': return 'f';
+ case '\r': return 'r';
+ case ' ': return 's';
+ /* \a, \v, \e and \d are excluded from printing as escapes since
+ they are somewhat rare as characters and more likely to be
+ plain integers. */
+ }
+ return 0;
+}
+
static void
print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
{
@@ -1908,29 +1927,30 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
{
case_Lisp_Int:
{
- int c;
- intmax_t i;
+ EMACS_INT i = XFIXNUM (obj);
+ char escaped_name;
- if (EQ (Vinteger_output_format, Qt) && CHARACTERP (obj)
- && (c = XFIXNUM (obj)))
+ if (print_integers_as_characters && i >= 0 && i <= MAX_UNICODE_CHAR
+ && ((escaped_name = named_escape (i))
+ || graphic_base_p (i)))
{
printchar ('?', printcharfun);
- if (escapeflag
- && (c == ';' || c == '(' || c == ')' || c == '{' || c == '}'
- || c == '[' || c == ']' || c == '\"' || c == '\'' || c == '\\'))
+ if (escaped_name)
+ {
+ printchar ('\\', printcharfun);
+ i = escaped_name;
+ }
+ else if (escapeflag
+ && (i == ';' || i == '\"' || i == '\'' || i == '\\'
+ || i == '(' || i == ')'
+ || i == '{' || i == '}'
+ || i == '[' || i == ']'))
printchar ('\\', printcharfun);
- printchar (c, printcharfun);
- }
- else if (INTEGERP (Vinteger_output_format)
- && integer_to_intmax (Vinteger_output_format, &i)
- && i == 16 && !NILP (Fnatnump (obj)))
- {
- int len = sprintf (buf, "#x%"pI"x", (EMACS_UINT) XFIXNUM (obj));
- strout (buf, len, len, printcharfun);
+ printchar (i, printcharfun);
}
else
{
- int len = sprintf (buf, "%"pI"d", XFIXNUM (obj));
+ int len = sprintf (buf, "%"pI"d", i);
strout (buf, len, len, printcharfun);
}
}
@@ -2270,12 +2290,13 @@ A value of nil means to use the shortest notation
that represents the number without losing information. */);
Vfloat_output_format = Qnil;
- DEFVAR_LISP ("integer-output-format", Vinteger_output_format,
- doc: /* The format used to print integers.
-When t, print characters from integers that represent a character.
-When a number 16, print non-negative integers in the hexadecimal format.
-Otherwise, by default print integers in the decimal format. */);
- Vinteger_output_format = Qnil;
+ DEFVAR_BOOL ("print-integers-as-characters", print_integers_as_characters,
+ doc: /* Non-nil means integers are printed using characters syntax.
+Only independent graphic characters, and control characters with named
+escape sequences such as newline, are printed this way. Other
+integers, including those corresponding to raw bytes, are printed
+as numbers the usual way. */);
+ print_integers_as_characters = false;
DEFVAR_LISP ("print-length", Vprint_length,
doc: /* Maximum length of list to print before abbreviating.
diff --git a/src/process.c b/src/process.c
index 50c425077a9..57105982c15 100644
--- a/src/process.c
+++ b/src/process.c
@@ -1,6 +1,6 @@
/* Asynchronous subprocess control for GNU Emacs.
-Copyright (C) 1985-1988, 1993-1996, 1998-1999, 2001-2020 Free Software
+Copyright (C) 1985-1988, 1993-1996, 1998-1999, 2001-2021 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
@@ -80,15 +80,6 @@ static struct rlimit nofile_limit;
#endif
-#ifdef NEED_BSDTTY
-#include <bsdtty.h>
-#endif
-
-#ifdef USG5_4
-# include <sys/stream.h>
-# include <sys/stropts.h>
-#endif
-
#ifdef HAVE_UTIL_H
#include <util.h>
#endif
@@ -292,6 +283,16 @@ static int max_desc;
the file descriptor of a socket that is already bound. */
static int external_sock_fd;
+/* File descriptor that becomes readable when we receive SIGCHLD. */
+static int child_signal_read_fd = -1;
+/* The write end thereof. The SIGCHLD handler writes to this file
+ descriptor to notify `wait_reading_process_output' of process
+ status changes. */
+static int child_signal_write_fd = -1;
+static void child_signal_init (void);
+static void child_signal_read (int, void *);
+static void child_signal_notify (void);
+
/* Indexed by descriptor, gives the process (if any) for that descriptor. */
static Lisp_Object chan_process[FD_SETSIZE];
static void wait_for_socket_fds (Lisp_Object, char const *);
@@ -465,6 +466,7 @@ add_read_fd (int fd, fd_callback func, void *data)
{
add_keyboard_wait_descriptor (fd);
+ eassert (0 <= fd && fd < FD_SETSIZE);
fd_callback_info[fd].func = func;
fd_callback_info[fd].data = data;
}
@@ -485,6 +487,7 @@ static void
add_process_read_fd (int fd)
{
add_non_keyboard_read_fd (fd);
+ eassert (0 <= fd && fd < FD_SETSIZE);
fd_callback_info[fd].flags |= PROCESS_FD;
}
@@ -495,6 +498,7 @@ delete_read_fd (int fd)
{
delete_keyboard_wait_descriptor (fd);
+ eassert (0 <= fd && fd < FD_SETSIZE);
if (fd_callback_info[fd].flags == 0)
{
fd_callback_info[fd].func = 0;
@@ -534,6 +538,7 @@ recompute_max_desc (void)
{
int fd;
+ eassert (max_desc < FD_SETSIZE);
for (fd = max_desc; fd >= 0; --fd)
{
if (fd_callback_info[fd].flags != 0)
@@ -542,6 +547,7 @@ recompute_max_desc (void)
break;
}
}
+ eassert (max_desc < FD_SETSIZE);
}
/* Stop monitoring file descriptor FD for when write is possible. */
@@ -549,6 +555,7 @@ recompute_max_desc (void)
void
delete_write_fd (int fd)
{
+ eassert (0 <= fd && fd < FD_SETSIZE);
if ((fd_callback_info[fd].flags & NON_BLOCKING_CONNECT_FD) != 0)
{
if (--num_pending_connects < 0)
@@ -571,6 +578,7 @@ compute_input_wait_mask (fd_set *mask)
int fd;
FD_ZERO (mask);
+ eassert (max_desc < FD_SETSIZE);
for (fd = 0; fd <= max_desc; ++fd)
{
if (fd_callback_info[fd].thread != NULL
@@ -593,6 +601,7 @@ compute_non_process_wait_mask (fd_set *mask)
int fd;
FD_ZERO (mask);
+ eassert (max_desc < FD_SETSIZE);
for (fd = 0; fd <= max_desc; ++fd)
{
if (fd_callback_info[fd].thread != NULL
@@ -616,6 +625,7 @@ compute_non_keyboard_wait_mask (fd_set *mask)
int fd;
FD_ZERO (mask);
+ eassert (max_desc < FD_SETSIZE);
for (fd = 0; fd <= max_desc; ++fd)
{
if (fd_callback_info[fd].thread != NULL
@@ -639,6 +649,7 @@ compute_write_mask (fd_set *mask)
int fd;
FD_ZERO (mask);
+ eassert (max_desc < FD_SETSIZE);
for (fd = 0; fd <= max_desc; ++fd)
{
if (fd_callback_info[fd].thread != NULL
@@ -660,6 +671,7 @@ clear_waiting_thread_info (void)
{
int fd;
+ eassert (max_desc < FD_SETSIZE);
for (fd = 0; fd <= max_desc; ++fd)
{
if (fd_callback_info[fd].waiting_thread == current_thread)
@@ -690,8 +702,7 @@ status_convert (int w)
if (WIFSTOPPED (w))
return Fcons (Qstop, Fcons (make_fixnum (WSTOPSIG (w)), Qnil));
else if (WIFEXITED (w))
- return Fcons (Qexit, Fcons (make_fixnum (WEXITSTATUS (w)),
- WCOREDUMP (w) ? Qt : Qnil));
+ return Fcons (Qexit, Fcons (make_fixnum (WEXITSTATUS (w)), Qnil));
else if (WIFSIGNALED (w))
return Fcons (Qsignal, Fcons (make_fixnum (WTERMSIG (w)),
WCOREDUMP (w) ? Qt : Qnil));
@@ -936,8 +947,10 @@ update_processes_for_thread_death (Lisp_Object dying_thread)
struct Lisp_Process *proc = XPROCESS (process);
pset_thread (proc, Qnil);
+ eassert (proc->infd < FD_SETSIZE);
if (proc->infd >= 0)
fd_callback_info[proc->infd].thread = NULL;
+ eassert (proc->outfd < FD_SETSIZE);
if (proc->outfd >= 0)
fd_callback_info[proc->outfd].thread = NULL;
}
@@ -1378,8 +1391,10 @@ If THREAD is nil, the process is unlocked. */)
proc = XPROCESS (process);
pset_thread (proc, thread);
+ eassert (proc->infd < FD_SETSIZE);
if (proc->infd >= 0)
fd_callback_info[proc->infd].thread = tstate;
+ eassert (proc->outfd < FD_SETSIZE);
if (proc->outfd >= 0)
fd_callback_info[proc->outfd].thread = tstate;
@@ -1731,7 +1746,7 @@ usage: (make-process &rest ARGS) */)
buffer = Fplist_get (contact, QCbuffer);
if (!NILP (buffer))
- buffer = Fget_buffer_create (buffer);
+ buffer = Fget_buffer_create (buffer, Qnil);
/* Make sure that the child will be able to chdir to the current
buffer's current directory, or its unhandled equivalent. We
@@ -1768,7 +1783,7 @@ usage: (make-process &rest ARGS) */)
QCname,
concat2 (name, build_string (" stderr")),
QCbuffer,
- Fget_buffer_create (xstderr),
+ Fget_buffer_create (xstderr, Qnil),
QCnoquery,
query_on_exit ? Qnil : Qt);
}
@@ -2047,7 +2062,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
{
struct Lisp_Process *p = XPROCESS (process);
int inchannel, outchannel;
- pid_t pid;
+ pid_t pid = -1;
int vfork_errno;
int forkin, forkout, forkerr = -1;
bool pty_flag = 0;
@@ -2055,6 +2070,10 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
Lisp_Object lisp_pty_name = Qnil;
sigset_t oldset;
+ /* Ensure that the SIGCHLD handler can notify
+ `wait_reading_process_output'. */
+ child_signal_init ();
+
inchannel = outchannel = -1;
if (p->pty_flag)
@@ -2100,6 +2119,9 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
}
}
+ if (FD_SETSIZE <= inchannel || FD_SETSIZE <= outchannel)
+ report_file_errno ("Creating pipe", Qnil, EMFILE);
+
#ifndef WINDOWSNT
if (emacs_pipe (p->open_fd + READ_FROM_EXEC_MONITOR) != 0)
report_file_error ("Creating pipe", Qnil);
@@ -2109,6 +2131,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
fcntl (outchannel, F_SETFL, O_NONBLOCK);
/* Record this as an active process, with its channels. */
+ eassert (0 <= inchannel && inchannel < FD_SETSIZE);
chan_process[inchannel] = process;
p->infd = inchannel;
p->outfd = outchannel;
@@ -2124,145 +2147,25 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
if (!EQ (p->command, Qt))
add_process_read_fd (inchannel);
+ ptrdiff_t count = SPECPDL_INDEX ();
+
/* This may signal an error. */
setup_process_coding_systems (process);
+ char **env = make_environment_block (current_dir);
block_input ();
block_child_signal (&oldset);
-#ifndef WINDOWSNT
- /* vfork, and prevent local vars from being clobbered by the vfork. */
- Lisp_Object volatile current_dir_volatile = current_dir;
- Lisp_Object volatile lisp_pty_name_volatile = lisp_pty_name;
- char **volatile new_argv_volatile = new_argv;
- int volatile forkin_volatile = forkin;
- int volatile forkout_volatile = forkout;
- int volatile forkerr_volatile = forkerr;
- struct Lisp_Process *p_volatile = p;
-
-#ifdef DARWIN_OS
- /* Darwin doesn't let us run setsid after a vfork, so use fork when
- necessary. Also, reset SIGCHLD handling after a vfork, as
- apparently macOS can mistakenly deliver SIGCHLD to the child. */
- if (pty_flag)
- pid = fork ();
- else
- {
- pid = vfork ();
- if (pid == 0)
- signal (SIGCHLD, SIG_DFL);
- }
-#else
- pid = vfork ();
-#endif
-
- current_dir = current_dir_volatile;
- lisp_pty_name = lisp_pty_name_volatile;
- new_argv = new_argv_volatile;
- forkin = forkin_volatile;
- forkout = forkout_volatile;
- forkerr = forkerr_volatile;
- p = p_volatile;
-
pty_flag = p->pty_flag;
+ eassert (pty_flag == ! NILP (lisp_pty_name));
- if (pid == 0)
-#endif /* not WINDOWSNT */
- {
- /* Make the pty be the controlling terminal of the process. */
-#ifdef HAVE_PTYS
- dissociate_controlling_tty ();
+ vfork_errno
+ = emacs_spawn (&pid, forkin, forkout, forkerr, new_argv, env,
+ SSDATA (current_dir),
+ pty_flag ? SSDATA (lisp_pty_name) : NULL, &oldset);
- /* Make the pty's terminal the controlling terminal. */
- if (pty_flag && forkin >= 0)
- {
-#ifdef TIOCSCTTY
- /* We ignore the return value
- because faith@cs.unc.edu says that is necessary on Linux. */
- ioctl (forkin, TIOCSCTTY, 0);
-#endif
- }
-#if defined (LDISC1)
- if (pty_flag && forkin >= 0)
- {
- struct termios t;
- tcgetattr (forkin, &t);
- t.c_lflag = LDISC1;
- if (tcsetattr (forkin, TCSANOW, &t) < 0)
- emacs_perror ("create_process/tcsetattr LDISC1");
- }
-#else
-#if defined (NTTYDISC) && defined (TIOCSETD)
- if (pty_flag && forkin >= 0)
- {
- /* Use new line discipline. */
- int ldisc = NTTYDISC;
- ioctl (forkin, TIOCSETD, &ldisc);
- }
-#endif
-#endif
-
-#if !defined (DONT_REOPEN_PTY)
-/*** There is a suggestion that this ought to be a
- conditional on TIOCSPGRP, or !defined TIOCSCTTY.
- Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
- that system does seem to need this code, even though
- both TIOCSCTTY is defined. */
- /* Now close the pty (if we had it open) and reopen it.
- This makes the pty the controlling terminal of the subprocess. */
- if (pty_flag)
- {
-
- /* I wonder if emacs_close (emacs_open (SSDATA (lisp_pty_name), ...))
- would work? */
- if (forkin >= 0)
- emacs_close (forkin);
- forkout = forkin = emacs_open (SSDATA (lisp_pty_name), O_RDWR, 0);
-
- if (forkin < 0)
- {
- emacs_perror (SSDATA (lisp_pty_name));
- _exit (EXIT_CANCELED);
- }
-
- }
-#endif /* not DONT_REOPEN_PTY */
+ eassert ((vfork_errno == 0) == (0 < pid));
-#ifdef SETUP_SLAVE_PTY
- if (pty_flag)
- {
- SETUP_SLAVE_PTY;
- }
-#endif /* SETUP_SLAVE_PTY */
-#endif /* HAVE_PTYS */
-
- signal (SIGINT, SIG_DFL);
- signal (SIGQUIT, SIG_DFL);
-#ifdef SIGPROF
- signal (SIGPROF, SIG_DFL);
-#endif
-
- /* Emacs ignores SIGPIPE, but the child should not. */
- signal (SIGPIPE, SIG_DFL);
-
- /* Stop blocking SIGCHLD in the child. */
- unblock_child_signal (&oldset);
-
- if (pty_flag)
- child_setup_tty (forkout);
-
- if (forkerr < 0)
- forkerr = forkout;
-#ifdef WINDOWSNT
- pid = child_setup (forkin, forkout, forkerr, new_argv, 1, current_dir);
-#else /* not WINDOWSNT */
- child_setup (forkin, forkout, forkerr, new_argv, 1, current_dir);
-#endif /* not WINDOWSNT */
- }
-
- /* Back in the parent process. */
-
- vfork_errno = errno;
p->pid = pid;
if (pid >= 0)
p->alive = 1;
@@ -2271,6 +2174,9 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
unblock_child_signal (&oldset);
unblock_input ();
+ /* Environment block no longer needed. */
+ unbind_to (count, Qnil);
+
if (pid < 0)
report_file_errno (CHILD_SETUP_ERROR_DESC, Qnil, vfork_errno);
else
@@ -2319,6 +2225,8 @@ create_pty (Lisp_Object process)
if (pty_fd >= 0)
{
p->open_fd[SUBPROCESS_STDIN] = pty_fd;
+ if (FD_SETSIZE <= pty_fd)
+ report_file_errno ("Opening pty", Qnil, EMFILE);
#if ! defined (USG) || defined (USG_SUBTTY_WORKS)
/* On most USG systems it does not work to open the pty's tty here,
then close it and reopen it in the child. */
@@ -2340,6 +2248,7 @@ create_pty (Lisp_Object process)
/* Record this as an active process, with its channels.
As a result, child_setup will close Emacs's side of the pipes. */
+ eassert (0 <= pty_fd && pty_fd < FD_SETSIZE);
chan_process[pty_fd] = process;
p->infd = pty_fd;
p->outfd = pty_fd;
@@ -2425,6 +2334,9 @@ usage: (make-pipe-process &rest ARGS) */)
outchannel = p->open_fd[WRITE_TO_SUBPROCESS];
inchannel = p->open_fd[READ_FROM_SUBPROCESS];
+ if (FD_SETSIZE <= inchannel || FD_SETSIZE <= outchannel)
+ report_file_errno ("Creating pipe", Qnil, EMFILE);
+
fcntl (inchannel, F_SETFL, O_NONBLOCK);
fcntl (outchannel, F_SETFL, O_NONBLOCK);
@@ -2433,6 +2345,7 @@ usage: (make-pipe-process &rest ARGS) */)
#endif
/* Record this as an active process, with its channels. */
+ eassert (0 <= inchannel && inchannel < FD_SETSIZE);
chan_process[inchannel] = proc;
p->infd = inchannel;
p->outfd = outchannel;
@@ -2443,7 +2356,7 @@ usage: (make-pipe-process &rest ARGS) */)
buffer = Fplist_get (contact, QCbuffer);
if (NILP (buffer))
buffer = name;
- buffer = Fget_buffer_create (buffer);
+ buffer = Fget_buffer_create (buffer, Qnil);
pset_buffer (p, buffer);
pset_childp (p, contact);
@@ -2762,6 +2675,7 @@ set up yet, this function will block until socket setup has completed. */)
return Qnil;
channel = XPROCESS (process)->infd;
+ eassert (0 <= channel && channel < FD_SETSIZE);
return conv_sockaddr_to_lisp (datagram_address[channel].sa,
datagram_address[channel].len);
}
@@ -2790,6 +2704,7 @@ set up yet, this function will block until socket setup has completed. */)
channel = XPROCESS (process)->infd;
len = get_lisp_to_sockaddr_size (address, &family);
+ eassert (0 <= channel && channel < FD_SETSIZE);
if (len == 0 || datagram_address[channel].len != len)
return Qnil;
conv_lisp_to_sockaddr (family, address, datagram_address[channel].sa, len);
@@ -3164,16 +3079,19 @@ usage: (make-serial-process &rest ARGS) */)
fd = serial_open (port);
p->open_fd[SUBPROCESS_STDIN] = fd;
+ if (FD_SETSIZE <= fd)
+ report_file_errno ("Opening serial port", port, EMFILE);
p->infd = fd;
p->outfd = fd;
if (fd > max_desc)
max_desc = fd;
+ eassert (0 <= fd && fd < FD_SETSIZE);
chan_process[fd] = proc;
buffer = Fplist_get (contact, QCbuffer);
if (NILP (buffer))
buffer = name;
- buffer = Fget_buffer_create (buffer);
+ buffer = Fget_buffer_create (buffer, Qnil);
pset_buffer (p, buffer);
pset_childp (p, contact);
@@ -3338,6 +3256,7 @@ finish_after_tls_connection (Lisp_Object proc)
Fplist_get (contact, QChost),
Fplist_get (contact, QCservice));
+ eassert (p->outfd < FD_SETSIZE);
if (NILP (result))
{
pset_status (p, list2 (Qfailed,
@@ -3383,6 +3302,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
if (!NILP (use_external_socket_p))
{
socket_to_use = external_sock_fd;
+ eassert (socket_to_use < FD_SETSIZE);
/* Ensure we don't consume the external socket twice. */
external_sock_fd = -1;
@@ -3424,6 +3344,14 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
xerrno = errno;
continue;
}
+ /* Reject file descriptors that would be too large. */
+ if (FD_SETSIZE <= s)
+ {
+ emacs_close (s);
+ s = -1;
+ xerrno = EMFILE;
+ continue;
+ }
}
if (p->is_non_blocking_client && ! (SOCK_NONBLOCK && socket_to_use < 0))
@@ -3588,6 +3516,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
#ifdef DATAGRAM_SOCKETS
if (p->socktype == SOCK_DGRAM)
{
+ eassert (0 <= s && s < FD_SETSIZE);
if (datagram_address[s].sa)
emacs_abort ();
@@ -3652,6 +3581,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
inch = s;
outch = s;
+ eassert (0 <= inch && inch < FD_SETSIZE);
chan_process[inch] = proc;
fcntl (inch, F_SETFL, O_NONBLOCK);
@@ -3678,6 +3608,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
if (! (connecting_status (p->status)
&& EQ (XCDR (p->status), addrinfos)))
pset_status (p, Fcons (Qconnect, addrinfos));
+ eassert (0 <= inch && inch < FD_SETSIZE);
if ((fd_callback_info[inch].flags & NON_BLOCKING_CONNECT_FD) == 0)
add_non_blocking_write_fd (inch);
}
@@ -4188,7 +4119,7 @@ usage: (make-network-process &rest ARGS) */)
open_socket:
if (!NILP (buffer))
- buffer = Fget_buffer_create (buffer);
+ buffer = Fget_buffer_create (buffer, Qnil);
/* Unwind bind_polling_period. */
unbind_to (count, Qnil);
@@ -4637,6 +4568,12 @@ network_lookup_address_info_1 (Lisp_Object host, const char *service,
if (STRING_MULTIBYTE (host) && SBYTES (host) != SCHARS (host))
error ("Non-ASCII hostname %s detected, please use puny-encode-domain",
SSDATA (host));
+
+#ifdef WINDOWSNT
+ /* Ensure socket support is loaded if available. */
+ init_winsock (TRUE);
+#endif
+
ret = getaddrinfo (SSDATA (host), service, hints, res);
if (ret)
{
@@ -4662,12 +4599,13 @@ network_lookup_address_info_1 (Lisp_Object host, const char *service,
DEFUN ("network-lookup-address-info", Fnetwork_lookup_address_info,
Snetwork_lookup_address_info, 1, 2, 0,
- doc: /* Look up ip address info of NAME.
+ doc: /* Look up Internet Protocol (IP) address info of NAME.
Optional parameter FAMILY controls whether to look up IPv4 or IPv6
addresses. The default of nil means both, symbol `ipv4' means IPv4
only, symbol `ipv6' means IPv6 only. Returns a list of addresses, or
nil if none were found. Each address is a vector of integers, as per
-the description of ADDRESS in `make-network-process'. */)
+the description of ADDRESS in `make-network-process'. In case of
+error displays the error message. */)
(Lisp_Object name, Lisp_Object family)
{
Lisp_Object addresses = Qnil;
@@ -4739,6 +4677,7 @@ deactivate_process (Lisp_Object proc)
close_process_fd (&p->open_fd[i]);
inchannel = p->infd;
+ eassert (inchannel < FD_SETSIZE);
if (inchannel >= 0)
{
p->infd = -1;
@@ -4875,6 +4814,13 @@ server_accept_connection (Lisp_Object server, int channel)
s = accept4 (channel, &saddr.sa, &len, SOCK_CLOEXEC);
+ if (FD_SETSIZE <= s)
+ {
+ emacs_close (s);
+ s = -1;
+ errno = EMFILE;
+ }
+
if (s < 0)
{
int code = errno;
@@ -4961,7 +4907,7 @@ server_accept_connection (Lisp_Object server, int channel)
if (!NILP (buffer))
{
args[1] = buffer;
- buffer = Fget_buffer_create (Fformat (nargs, args));
+ buffer = Fget_buffer_create (Fformat (nargs, args), Qnil);
}
}
@@ -4972,6 +4918,7 @@ server_accept_connection (Lisp_Object server, int channel)
Lisp_Object name = Fformat (nargs, args);
Lisp_Object proc = make_process (name);
+ eassert (0 <= s && s < FD_SETSIZE);
chan_process[s] = proc;
fcntl (s, F_SETFL, O_NONBLOCK);
@@ -5251,6 +5198,8 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
break;
+ eassert (max_desc < FD_SETSIZE);
+
#if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
{
Lisp_Object process_list_head, aproc;
@@ -5328,19 +5277,9 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
do
{
unsigned old_timers_run = timers_run;
- struct buffer *old_buffer = current_buffer;
- Lisp_Object old_window = selected_window;
timer_delay = timer_check ();
- /* If a timer has run, this might have changed buffers
- an alike. Make read_key_sequence aware of that. */
- if (timers_run != old_timers_run
- && (old_buffer != current_buffer
- || !EQ (old_window, selected_window))
- && waiting_for_user_input_p == -1)
- record_asynch_buffer_change ();
-
if (timers_run != old_timers_run && do_display)
/* We must retry, since a timer may have requeued itself
and that could alter the time_delay. */
@@ -5384,6 +5323,15 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
compute_input_wait_mask (&Atemp);
compute_write_mask (&Ctemp);
+ /* If a process status has changed, the child signal pipe
+ will likely be readable. We want to ignore it for now,
+ because otherwise we wouldn't run into a timeout
+ below. */
+ int fd = child_signal_read_fd;
+ eassert (fd < FD_SETSIZE);
+ if (0 <= fd)
+ FD_CLR (fd, &Atemp);
+
timeout = make_timespec (0, 0);
if ((thread_select (pselect, max_desc + 1,
&Atemp,
@@ -5470,6 +5418,14 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
check_write = true;
}
+ /* We have to be informed when we receive a SIGCHLD signal for
+ an asynchronous process. Otherwise this might deadlock if we
+ receive a SIGCHLD during `pselect'. */
+ int child_fd = child_signal_read_fd;
+ eassert (child_fd < FD_SETSIZE);
+ if (0 <= child_fd)
+ FD_SET (child_fd, &Available);
+
/* If frame size has changed or the window is newly mapped,
redisplay now, before we start to wait. There is a race
condition here; if a SIGIO arrives between now and the select
@@ -5694,9 +5650,6 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
if (read_kbd != 0)
{
- unsigned old_timers_run = timers_run;
- struct buffer *old_buffer = current_buffer;
- Lisp_Object old_window = selected_window;
bool leave = false;
if (detect_input_pending_run_timers (do_display))
@@ -5706,14 +5659,6 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
leave = true;
}
- /* If a timer has run, this might have changed buffers
- an alike. Make read_key_sequence aware of that. */
- if (timers_run != old_timers_run
- && waiting_for_user_input_p == -1
- && (old_buffer != current_buffer
- || !EQ (old_window, selected_window)))
- record_asynch_buffer_change ();
-
if (leave)
break;
}
@@ -6015,6 +5960,7 @@ read_process_output (Lisp_Object proc, int channel)
{
ssize_t nbytes;
struct Lisp_Process *p = XPROCESS (proc);
+ eassert (0 <= channel && channel < FD_SETSIZE);
struct coding_system *coding = proc_decode_coding_system[channel];
int carryover = p->decoding_carryover;
ptrdiff_t readmax = clip_to_bounds (1, read_process_output_max, PTRDIFF_MAX);
@@ -6179,6 +6125,7 @@ read_and_dispose_of_process_output (struct Lisp_Process *p, char *chars,
proc_encode_coding_system[p->outfd] surely points to a
valid memory because p->outfd will be changed once EOF is
sent to the process. */
+ eassert (p->outfd < FD_SETSIZE);
if (NILP (p->encode_coding_system) && p->outfd >= 0
&& proc_encode_coding_system[p->outfd])
{
@@ -6213,18 +6160,6 @@ read_and_dispose_of_process_output (struct Lisp_Process *p, char *chars,
/* Restore waiting_for_user_input_p as it was
when we were called, in case the filter clobbered it. */
waiting_for_user_input_p = waiting;
-
-#if 0 /* Call record_asynch_buffer_change unconditionally,
- because we might have changed minor modes or other things
- that affect key bindings. */
- if (! EQ (Fcurrent_buffer (), obuffer)
- || ! EQ (current_buffer->keymap, okeymap))
-#endif
- /* But do it only if the caller is actually going to read events.
- Otherwise there's no need to make him wake up, and it could
- cause trouble (for example it would make sit_for return). */
- if (waiting_for_user_input_p == -1)
- record_asynch_buffer_change ();
}
DEFUN ("internal-default-process-filter", Finternal_default_process_filter,
@@ -6430,6 +6365,7 @@ send_process (Lisp_Object proc, const char *buf, ptrdiff_t len,
if (p->outfd < 0)
error ("Output file descriptor of %s is closed", SDATA (p->name));
+ eassert (p->outfd < FD_SETSIZE);
coding = proc_encode_coding_system[p->outfd];
Vlast_coding_system_used = CODING_ID_NAME (coding->id);
@@ -6539,6 +6475,7 @@ send_process (Lisp_Object proc, const char *buf, ptrdiff_t len,
/* Send this batch, using one or more write calls. */
ptrdiff_t written = 0;
int outfd = p->outfd;
+ eassert (0 <= outfd && outfd < FD_SETSIZE);
#ifdef DATAGRAM_SOCKETS
if (DATAGRAM_CHAN_P (outfd))
{
@@ -6989,6 +6926,7 @@ traffic. */)
struct Lisp_Process *p;
p = XPROCESS (process);
+ eassert (p->infd < FD_SETSIZE);
if (EQ (p->command, Qt)
&& p->infd >= 0
&& (!EQ (p->filter, Qt) || EQ (p->status, Qlisten)))
@@ -7116,6 +7054,7 @@ process has been transmitted to the serial port. */)
outfd = XPROCESS (proc)->outfd;
+ eassert (outfd < FD_SETSIZE);
if (outfd >= 0)
coding = proc_encode_coding_system[outfd];
@@ -7163,11 +7102,13 @@ process has been transmitted to the serial port. */)
p->open_fd[WRITE_TO_SUBPROCESS] = new_outfd;
p->outfd = new_outfd;
+ eassert (0 <= new_outfd && new_outfd < FD_SETSIZE);
if (!proc_encode_coding_system[new_outfd])
proc_encode_coding_system[new_outfd]
= xmalloc (sizeof (struct coding_system));
if (old_outfd >= 0)
{
+ eassert (old_outfd < FD_SETSIZE);
*proc_encode_coding_system[new_outfd]
= *proc_encode_coding_system[old_outfd];
memset (proc_encode_coding_system[old_outfd], 0,
@@ -7204,7 +7145,72 @@ process has been transmitted to the serial port. */)
subprocesses which the main thread should not reap. For example,
if the main thread attempted to reap an already-reaped child, it
might inadvertently reap a GTK-created process that happened to
- have the same process ID. */
+ 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. */
+
+/* Set up `child_signal_read_fd' and `child_signal_write_fd'. */
+
+static void
+child_signal_init (void)
+{
+ /* Either both are initialized, or both are uninitialized. */
+ eassert ((child_signal_read_fd < 0) == (child_signal_write_fd < 0));
+
+ if (0 <= child_signal_read_fd)
+ return; /* already done */
+
+ int fds[2];
+ if (emacs_pipe (fds) < 0)
+ report_file_error ("Creating pipe for child signal", Qnil);
+ if (FD_SETSIZE <= fds[0])
+ {
+ /* Since we need to `pselect' on the read end, it has to fit
+ into an `fd_set'. */
+ emacs_close (fds[0]);
+ emacs_close (fds[1]);
+ report_file_errno ("Creating pipe for child signal", Qnil,
+ EMFILE);
+ }
+
+ /* We leave the file descriptors open until the Emacs process
+ exits. */
+ eassert (0 <= fds[0]);
+ eassert (0 <= fds[1]);
+ if (fcntl (fds[0], 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];
+}
+
+/* Consume a process status change. */
+
+static void
+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)
+ emacs_perror ("reading from child signal FD");
+}
+
+/* Notify `wait_reading_process_output' of a process status
+ change. */
+
+static void
+child_signal_notify (void)
+{
+ 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");
+}
/* LIB_CHILD_HANDLER is a SIGCHLD handler that Emacs calls while doing
its own SIGCHLD handling. On POSIXish systems, glib needs this to
@@ -7242,6 +7248,7 @@ static void
handle_child_signal (int sig)
{
Lisp_Object tail, proc;
+ bool changed = false;
/* Find the process that signaled us, and record its status. */
@@ -7264,6 +7271,7 @@ handle_child_signal (int sig)
eassert (ok);
if (child_status_changed (deleted_pid, 0, 0))
{
+ changed = true;
if (STRINGP (XCDR (head)))
unlink (SSDATA (XCDR (head)));
XSETCAR (tail, Qnil);
@@ -7281,6 +7289,7 @@ handle_child_signal (int sig)
&& child_status_changed (p->pid, &status, WUNTRACED | WCONTINUED))
{
/* Change the status of the process that was found. */
+ changed = true;
p->tick = ++process_tick;
p->raw_status = status;
p->raw_status_new = 1;
@@ -7300,6 +7309,10 @@ handle_child_signal (int sig)
}
}
+ if (changed)
+ /* Wake up `wait_reading_process_output'. */
+ child_signal_notify ();
+
lib_child_handler (sig);
#ifdef NS_IMPL_GNUSTEP
/* NSTask in GNUstep sets its child handler each time it is called.
@@ -7390,16 +7403,6 @@ exec_sentinel (Lisp_Object proc, Lisp_Object reason)
when we were called, in case the filter clobbered it. */
waiting_for_user_input_p = waiting;
-#if 0
- if (! EQ (Fcurrent_buffer (), obuffer)
- || ! EQ (current_buffer->keymap, okeymap))
-#endif
- /* But do it only if the caller is actually going to read events.
- Otherwise there's no need to make him wake up, and it could
- cause trouble (for example it would make sit_for return). */
- if (waiting_for_user_input_p == -1)
- record_asynch_buffer_change ();
-
unbind_to (count, Qnil);
}
@@ -7626,6 +7629,7 @@ DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p,
struct Lisp_Process *p = XPROCESS (process);
if (p->infd < 0)
return Qnil;
+ eassert (p->infd < FD_SETSIZE);
struct coding_system *coding = proc_decode_coding_system[p->infd];
return (CODING_FOR_UNIBYTE (coding) ? Qnil : Qt);
}
@@ -7659,6 +7663,7 @@ keyboard_bit_set (fd_set *mask)
{
int fd;
+ eassert (max_desc < FD_SETSIZE);
for (fd = 0; fd <= max_desc; fd++)
if (FD_ISSET (fd, mask)
&& ((fd_callback_info[fd].flags & (FOR_READ | KEYBOARD_FD))
@@ -7906,6 +7911,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
void
add_timer_wait_descriptor (int fd)
{
+ eassert (0 <= fd && fd < FD_SETSIZE);
add_read_fd (fd, timerfd_callback, NULL);
fd_callback_info[fd].flags &= ~KEYBOARD_FD;
}
@@ -7968,6 +7974,7 @@ setup_process_coding_systems (Lisp_Object process)
if (inch < 0 || outch < 0)
return;
+ eassert (0 <= inch && inch < FD_SETSIZE);
if (!proc_decode_coding_system[inch])
proc_decode_coding_system[inch] = xmalloc (sizeof (struct coding_system));
coding_system = p->decode_coding_system;
@@ -7979,6 +7986,7 @@ setup_process_coding_systems (Lisp_Object process)
}
setup_coding_system (coding_system, proc_decode_coding_system[inch]);
+ eassert (0 <= outch && outch < FD_SETSIZE);
if (!proc_encode_coding_system[outch])
proc_encode_coding_system[outch] = xmalloc (sizeof (struct coding_system));
setup_coding_system (p->encode_coding_system,
@@ -8217,13 +8225,29 @@ init_process_emacs (int sockfd)
if (!will_dump_with_unexec_p ())
{
#if defined HAVE_GLIB && !defined WINDOWSNT
- /* Tickle glib's child-handling code. Ask glib to wait for Emacs itself;
- this should always fail, but is enough to initialize glib's
+ /* Tickle glib's child-handling code. Ask glib to install a
+ watch source for Emacs itself which will initialize glib's
private SIGCHLD handler, allowing catch_child_signal to copy
- it into lib_child_handler. */
- g_source_unref (g_child_watch_source_new (getpid ()));
-#endif
+ it into lib_child_handler.
+
+ Unfortunatly in glib commit 2e471acf, the behavior changed to
+ always install a signal handler when g_child_watch_source_new
+ is called and not just the first time it's called. Glib also
+ now resets signal handlers to SIG_DFL when it no longer has a
+ watcher on that signal. This is a hackey work around to get
+ glib's g_unix_signal_handler into lib_child_handler. */
+ GSource *source = g_child_watch_source_new (getpid ());
+ catch_child_signal ();
+ g_source_unref (source);
+
+ eassert (lib_child_handler != dummy_handler);
+ signal_handler_t lib_child_handler_glib = lib_child_handler;
catch_child_signal ();
+ eassert (lib_child_handler == dummy_handler);
+ lib_child_handler = lib_child_handler_glib;
+#else
+ catch_child_signal ();
+#endif
}
#ifdef HAVE_SETRLIMIT
diff --git a/src/process.h b/src/process.h
index a783a31cb86..d041ada5867 100644
--- a/src/process.h
+++ b/src/process.h
@@ -1,5 +1,5 @@
/* Definitions for asynchronous process control in GNU Emacs.
- Copyright (C) 1985, 1994, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1985, 1994, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/profiler.c b/src/profiler.c
index 9d2e828f221..21ae2447aa4 100644
--- a/src/profiler.c
+++ b/src/profiler.c
@@ -1,6 +1,6 @@
/* Profiler implementation.
-Copyright (C) 2012-2020 Free Software Foundation, Inc.
+Copyright (C) 2012-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/puresize.h b/src/puresize.h
index 7611f6e53f4..811d0b4d369 100644
--- a/src/puresize.h
+++ b/src/puresize.h
@@ -1,5 +1,5 @@
/* How much read-only Lisp storage a dumped Emacs needs.
- Copyright (C) 1993, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1993, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/ralloc.c b/src/ralloc.c
index a7cac137329..02689265f2e 100644
--- a/src/ralloc.c
+++ b/src/ralloc.c
@@ -1,5 +1,5 @@
/* Block-relocating memory allocator.
- Copyright (C) 1993, 1995, 2000-2020 Free Software Foundation, Inc.
+ Copyright (C) 1993, 1995, 2000-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/regex-emacs.c b/src/regex-emacs.c
index 971a5f63749..8350e54b54a 100644
--- a/src/regex-emacs.c
+++ b/src/regex-emacs.c
@@ -1,6 +1,6 @@
/* Emacs regular expression matching and search
- Copyright (C) 1993-2020 Free Software Foundation, Inc.
+ Copyright (C) 1993-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
@@ -3575,9 +3575,11 @@ skip_noops (re_char *p, re_char *pend)
opcode. When the function finishes, *PP will be advanced past that opcode.
C is character to test (possibly after translations) and CORIG is original
character (i.e. without any translations). UNIBYTE denotes whether c is
- unibyte or multibyte character. */
+ unibyte or multibyte character.
+ CANON_TABLE is the canonicalisation table for case folding or Qnil. */
static bool
-execute_charset (re_char **pp, int c, int corig, bool unibyte)
+execute_charset (re_char **pp, int c, int corig, bool unibyte,
+ Lisp_Object canon_table)
{
eassume (0 <= c && 0 <= corig);
re_char *p = *pp, *rtp = NULL;
@@ -3617,11 +3619,9 @@ execute_charset (re_char **pp, int c, int corig, bool unibyte)
(class_bits & BIT_BLANK && ISBLANK (c)) ||
(class_bits & BIT_WORD && ISWORD (c)) ||
((class_bits & BIT_UPPER) &&
- (ISUPPER (c) || (corig != c &&
- c == downcase (corig) && ISLOWER (c)))) ||
+ (ISUPPER (corig) || (!NILP (canon_table) && ISLOWER (corig)))) ||
((class_bits & BIT_LOWER) &&
- (ISLOWER (c) || (corig != c &&
- c == upcase (corig) && ISUPPER(c)))) ||
+ (ISLOWER (corig) || (!NILP (canon_table) && ISUPPER (corig)))) ||
(class_bits & BIT_PUNCT && ISPUNCT (c)) ||
(class_bits & BIT_GRAPH && ISGRAPH (c)) ||
(class_bits & BIT_PRINT && ISPRINT (c)))
@@ -3696,7 +3696,8 @@ mutually_exclusive_p (struct re_pattern_buffer *bufp, re_char *p1,
else if ((re_opcode_t) *p1 == charset
|| (re_opcode_t) *p1 == charset_not)
{
- if (!execute_charset (&p1, c, c, !multibyte || ASCII_CHAR_P (c)))
+ if (!execute_charset (&p1, c, c, !multibyte || ASCII_CHAR_P (c),
+ Qnil))
{
DEBUG_PRINT (" No match => fast loop.\n");
return true;
@@ -4367,7 +4368,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
}
p -= 1;
- if (!execute_charset (&p, c, corig, unibyte_char))
+ if (!execute_charset (&p, c, corig, unibyte_char, translate))
goto fail;
d += len;
diff --git a/src/regex-emacs.h b/src/regex-emacs.h
index 354408bb2a7..027ab655580 100644
--- a/src/regex-emacs.h
+++ b/src/regex-emacs.h
@@ -1,6 +1,6 @@
/* Emacs regular expression API
- Copyright (C) 1985, 1989-1993, 1995, 2000-2020 Free Software
+ Copyright (C) 1985, 1989-1993, 1995, 2000-2021 Free Software
Foundation, Inc.
This program is free software; you can redistribute it and/or modify
diff --git a/src/region-cache.c b/src/region-cache.c
index 836296764d1..b75a9691b5d 100644
--- a/src/region-cache.c
+++ b/src/region-cache.c
@@ -1,6 +1,6 @@
/* Caching facts about regions of the buffer, for optimization.
-Copyright (C) 1985-1989, 1993, 1995, 2001-2020 Free Software Foundation,
+Copyright (C) 1985-1989, 1993, 1995, 2001-2021 Free Software Foundation,
Inc.
This file is part of GNU Emacs.
diff --git a/src/region-cache.h b/src/region-cache.h
index 46e45a2fbdb..128215718d8 100644
--- a/src/region-cache.h
+++ b/src/region-cache.h
@@ -1,6 +1,6 @@
/* Header file: Caching facts about regions of the buffer, for optimization.
-Copyright (C) 1985-1986, 1993, 1995, 2001-2020 Free Software Foundation,
+Copyright (C) 1985-1986, 1993, 1995, 2001-2021 Free Software Foundation,
Inc.
This file is part of GNU Emacs.
diff --git a/src/scroll.c b/src/scroll.c
index 145c256048a..9042888d1f2 100644
--- a/src/scroll.c
+++ b/src/scroll.c
@@ -1,6 +1,6 @@
/* Calculate what line insertion or deletion to do, and do it
-Copyright (C) 1985-1986, 1990, 1993-1994, 2001-2020 Free Software
+Copyright (C) 1985-1986, 1990, 1993-1994, 2001-2021 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/search.c b/src/search.c
index e7f90949464..c757bf3d1f2 100644
--- a/src/search.c
+++ b/src/search.c
@@ -1,6 +1,6 @@
/* String search routines for GNU Emacs.
-Copyright (C) 1985-1987, 1993-1994, 1997-1999, 2001-2020 Free Software
+Copyright (C) 1985-1987, 1993-1994, 1997-1999, 2001-2021 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
@@ -3031,6 +3031,23 @@ If optional arg RESEAT is non-nil, make markers on LIST point nowhere. */)
return Qnil;
}
+DEFUN ("match-data--translate", Fmatch_data__translate, Smatch_data__translate,
+ 1, 1, 0,
+ doc: /* Add N to all positions in the match data. Internal. */)
+ (Lisp_Object n)
+{
+ CHECK_FIXNUM (n);
+ EMACS_INT delta = XFIXNUM (n);
+ if (!NILP (last_thing_searched))
+ for (ptrdiff_t i = 0; i < search_regs.num_regs; i++)
+ if (search_regs.start[i] >= 0)
+ {
+ search_regs.start[i] = max (0, search_regs.start[i] + delta);
+ search_regs.end[i] = max (0, search_regs.end[i] + delta);
+ }
+ return Qnil;
+}
+
/* Called from Flooking_at, Fstring_match, search_buffer, Fstore_match_data
if asynchronous code (filter or sentinel) is running. */
static void
@@ -3388,6 +3405,7 @@ is to bind it with `let' around a small expression. */);
defsubr (&Smatch_end);
defsubr (&Smatch_data);
defsubr (&Sset_match_data);
+ defsubr (&Smatch_data__translate);
defsubr (&Sregexp_quote);
defsubr (&Snewline_cache_check);
diff --git a/src/sheap.c b/src/sheap.c
index 7d6429c532c..5401e791b07 100644
--- a/src/sheap.c
+++ b/src/sheap.c
@@ -1,7 +1,7 @@
/* simulate `sbrk' with an array in .bss, for `unexec' support for Cygwin;
complete rewrite of xemacs Cygwin `unexec' code
- Copyright (C) 2004-2020 Free Software Foundation, Inc.
+ Copyright (C) 2004-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/sheap.h b/src/sheap.h
index 50f602a4467..f1004d6c2e5 100644
--- a/src/sheap.h
+++ b/src/sheap.h
@@ -1,6 +1,6 @@
/* Static heap allocation for GNU Emacs.
-Copyright 2016-2020 Free Software Foundation, Inc.
+Copyright 2016-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/sound.c b/src/sound.c
index f74c4769a44..e5f66f8f529 100644
--- a/src/sound.c
+++ b/src/sound.c
@@ -1,6 +1,6 @@
/* sound.c -- sound support.
-Copyright (C) 1998-1999, 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 1998-1999, 2001-2021 Free Software Foundation, Inc.
Author: Gerd Moellmann <gerd@gnu.org>
diff --git a/src/syntax.c b/src/syntax.c
index df07809aaaf..9fbf88535f3 100644
--- a/src/syntax.c
+++ b/src/syntax.c
@@ -1,5 +1,5 @@
/* GNU Emacs routines to deal with syntax tables; also word and list parsing.
- Copyright (C) 1985, 1987, 1993-1995, 1997-1999, 2001-2020 Free
+ Copyright (C) 1985, 1987, 1993-1995, 1997-1999, 2001-2021 Free
Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/syntax.h b/src/syntax.h
index a2ec3301bab..66ee139a967 100644
--- a/src/syntax.h
+++ b/src/syntax.h
@@ -1,6 +1,6 @@
/* Declarations having to do with GNU Emacs syntax tables.
-Copyright (C) 1985, 1993-1994, 1997-1998, 2001-2020 Free Software
+Copyright (C) 1985, 1993-1994, 1997-1998, 2001-2021 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/sysdep.c b/src/sysdep.c
index f6c0ddee01a..941b4e2fa24 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -1,5 +1,5 @@
/* Interfaces to system-dependent kernel and library entries.
- Copyright (C) 1985-1988, 1993-1995, 1999-2020 Free Software
+ Copyright (C) 1985-1988, 1993-1995, 1999-2021 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
@@ -53,6 +53,10 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
# include <sys/sysctl.h>
#endif
+#if defined __OpenBSD__
+# include <sys/proc.h>
+#endif
+
#ifdef DARWIN_OS
# include <libproc.h>
#endif
@@ -314,33 +318,21 @@ get_current_dir_name_or_unreachable (void)
&& emacs_fstatat (AT_FDCWD, ".", &dotstat, 0) == 0
&& dotstat.st_ino == pwdstat.st_ino
&& dotstat.st_dev == pwdstat.st_dev)
- {
- char *buf = malloc (pwdlen + 1);
- if (!buf)
- return NULL;
- return memcpy (buf, pwd, pwdlen + 1);
- }
+ return strdup (pwd);
else
{
ptrdiff_t buf_size = min (bufsize_max, 1024);
- char *buf = malloc (buf_size);
- if (!buf)
- return NULL;
for (;;)
{
+ char *buf = malloc (buf_size);
+ if (!buf)
+ return NULL;
if (getcwd (buf, buf_size) == buf)
return buf;
- int getcwd_errno = errno;
- if (getcwd_errno != ERANGE || buf_size == bufsize_max)
- {
- free (buf);
- errno = getcwd_errno;
- return NULL;
- }
+ free (buf);
+ if (errno != ERANGE || buf_size == bufsize_max)
+ return NULL;
buf_size = buf_size <= bufsize_max / 2 ? 2 * buf_size : bufsize_max;
- buf = realloc (buf, buf_size);
- if (!buf)
- return NULL;
}
}
}
@@ -1440,6 +1432,7 @@ set_window_size (int fd, int height, int width)
/* BSD-style. */
struct winsize size;
+ memset (&size, 0, sizeof (size));
size.ws_row = height;
size.ws_col = width;
@@ -1450,6 +1443,7 @@ set_window_size (int fd, int height, int width)
/* SunOS - style. */
struct ttysize size;
+ memset (&size, 0, sizeof (size));
size.ts_lines = height;
size.ts_cols = width;
@@ -2326,6 +2320,28 @@ emacs_open (char const *file, int oflags, int mode)
return emacs_openat (AT_FDCWD, file, oflags, mode);
}
+/* Same as above, but doesn't allow the user to quit. */
+
+static int
+emacs_openat_noquit (int dirfd, const char *file, int oflags,
+ int mode)
+{
+ int fd;
+ if (! (oflags & O_TEXT))
+ oflags |= O_BINARY;
+ oflags |= O_CLOEXEC;
+ do
+ fd = openat (dirfd, file, oflags, mode);
+ while (fd < 0 && errno == EINTR);
+ return fd;
+}
+
+int
+emacs_open_noquit (char const *file, int oflags, int mode)
+{
+ return emacs_openat_noquit (AT_FDCWD, file, oflags, mode);
+}
+
/* Open FILE as a stream for Emacs use, with mode MODE.
Act like emacs_open with respect to threads, signals, and quits. */
@@ -2892,7 +2908,8 @@ list_system_processes (void)
process. */
procdir = build_string ("/proc");
match = build_string ("[0-9]+");
- proclist = directory_files_internal (procdir, Qnil, match, Qt, false, Qnil);
+ proclist = directory_files_internal (procdir, Qnil, match, Qt,
+ false, Qnil, Qnil);
/* `proclist' gives process IDs as strings. Destructively convert
each string into a number. */
@@ -2981,6 +2998,14 @@ make_lisp_timeval (struct timeval t)
return make_lisp_time (timeval_to_timespec (t));
}
+#elif defined __OpenBSD__
+
+static Lisp_Object
+make_lisp_timeval (long sec, long usec)
+{
+ return make_lisp_time(make_timespec(sec, usec * 1000));
+}
+
#endif
#ifdef GNU_LINUX
@@ -3670,6 +3695,189 @@ system_process_attributes (Lisp_Object pid)
return attrs;
}
+#elif defined __OpenBSD__
+
+Lisp_Object
+system_process_attributes (Lisp_Object pid)
+{
+ int proc_id, nentries, fscale, i;
+ int pagesize = getpagesize ();
+ int mib[6];
+ size_t len;
+ double pct;
+ char *ttyname, args[ARG_MAX];
+ struct kinfo_proc proc;
+ struct passwd *pw;
+ struct group *gr;
+ struct timespec t;
+ struct uvmexp uvmexp;
+
+ Lisp_Object attrs = Qnil;
+ Lisp_Object decoded_comm;
+
+ CHECK_NUMBER (pid);
+ CONS_TO_INTEGER (pid, int, proc_id);
+
+ len = sizeof proc;
+ mib[0] = CTL_KERN;
+ mib[1] = KERN_PROC;
+ mib[2] = KERN_PROC_PID;
+ mib[3] = proc_id;
+ mib[4] = len;
+ mib[5] = 1;
+ if (sysctl (mib, 6, &proc, &len, NULL, 0) != 0)
+ return attrs;
+
+ attrs = Fcons (Fcons (Qeuid, INT_TO_INTEGER (proc.p_uid)), attrs);
+
+ block_input ();
+ pw = getpwuid (proc.p_uid);
+ unblock_input ();
+ if (pw)
+ attrs = Fcons (Fcons (Quser, build_string(pw->pw_name)), attrs);
+
+ attrs = Fcons (Fcons (Qegid, INT_TO_INTEGER(proc.p_svgid)), attrs);
+
+ block_input ();
+ gr = getgrgid (proc.p_svgid);
+ unblock_input ();
+ if (gr)
+ attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs);
+
+ AUTO_STRING (comm, proc.p_comm);
+ decoded_comm = code_convert_string_norecord (comm, Vlocale_coding_system, 0);
+ attrs = Fcons (Fcons (Qcomm, decoded_comm), attrs);
+
+ {
+ char state[2] = {'\0', '\0'};
+ switch (proc.p_stat) {
+ case SIDL:
+ state[0] = 'I';
+ break;
+ case SRUN:
+ state[0] = 'R';
+ break;
+ case SSLEEP:
+ state[0] = 'S';
+ break;
+ case SSTOP:
+ state[0] = 'T';
+ break;
+ case SZOMB:
+ state[0] = 'Z';
+ break;
+ case SDEAD:
+ state[0] = 'D';
+ break;
+ }
+ attrs = Fcons (Fcons (Qstate, build_string (state)), attrs);
+ }
+
+ attrs = Fcons (Fcons (Qppid, INT_TO_INTEGER (proc.p_ppid)), attrs);
+ attrs = Fcons (Fcons (Qpgrp, INT_TO_INTEGER (proc.p_gid)), attrs);
+ attrs = Fcons (Fcons (Qsess, INT_TO_INTEGER (proc.p_sid)), attrs);
+
+ block_input ();
+ ttyname = proc.p_tdev == NODEV ? NULL : devname (proc.p_tdev, S_IFCHR);
+ unblock_input ();
+ if (ttyname)
+ attrs = Fcons (Fcons (Qttname, build_string (ttyname)), attrs);
+
+ attrs = Fcons (Fcons (Qtpgid, INT_TO_INTEGER (proc.p_tpgid)), attrs);
+ attrs = Fcons (Fcons (Qminflt, INT_TO_INTEGER (proc.p_uru_minflt)),
+ attrs);
+ attrs = Fcons (Fcons (Qmajflt, INT_TO_INTEGER (proc.p_uru_majflt)),
+ attrs);
+
+ /* FIXME: missing cminflt, cmajflt. */
+
+ attrs = Fcons (Fcons (Qutime, make_lisp_timeval (proc.p_uutime_sec,
+ proc.p_uutime_usec)),
+ attrs);
+ attrs = Fcons (Fcons (Qstime, make_lisp_timeval (proc.p_ustime_sec,
+ proc.p_ustime_usec)),
+ attrs);
+ t = timespec_add (make_timespec (proc.p_uutime_sec,
+ proc.p_uutime_usec * 1000),
+ make_timespec (proc.p_ustime_sec,
+ proc.p_ustime_usec * 1000));
+ attrs = Fcons (Fcons (Qtime, make_lisp_time (t)), attrs);
+
+ attrs = Fcons (Fcons (Qcutime, make_lisp_timeval (proc.p_uctime_sec,
+ proc.p_uctime_usec)),
+ attrs);
+
+ /* FIXME: missing cstime and thus ctime. */
+
+ attrs = Fcons (Fcons (Qpri, make_fixnum (proc.p_priority)), attrs);
+ attrs = Fcons (Fcons (Qnice, make_fixnum (proc.p_nice)), attrs);
+
+ /* FIXME: missing thcount (thread count) */
+
+ attrs = Fcons (Fcons (Qstart, make_lisp_timeval (proc.p_ustart_sec,
+ proc.p_ustart_usec)),
+ attrs);
+
+ len = (proc.p_vm_tsize + proc.p_vm_dsize + proc.p_vm_ssize) * pagesize >> 10;
+ attrs = Fcons (Fcons (Qvsize, make_fixnum (len)), attrs);
+
+ attrs = Fcons (Fcons (Qrss, make_fixnum (proc.p_vm_rssize * pagesize >> 10)),
+ attrs);
+
+ t = make_timespec (proc.p_ustart_sec,
+ proc.p_ustart_usec * 1000);
+ t = timespec_sub (current_timespec (), t);
+ attrs = Fcons (Fcons (Qetime, make_lisp_time (t)), attrs);
+
+ len = sizeof (fscale);
+ mib[0] = CTL_KERN;
+ mib[1] = KERN_FSCALE;
+ if (sysctl (mib, 2, &fscale, &len, NULL, 0) != -1)
+ {
+ pct = (double)proc.p_pctcpu / fscale * 100.0;
+ attrs = Fcons (Fcons (Qpcpu, make_float (pct)), attrs);
+ }
+
+ len = sizeof (uvmexp);
+ mib[0] = CTL_VM;
+ mib[1] = VM_UVMEXP;
+ if (sysctl (mib, 2, &uvmexp, &len, NULL, 0) != -1)
+ {
+ pct = (100.0 * (double)proc.p_vm_rssize / uvmexp.npages);
+ attrs = Fcons (Fcons (Qpmem, make_float (pct)), attrs);
+ }
+
+ len = sizeof args;
+ mib[0] = CTL_KERN;
+ mib[1] = KERN_PROC_ARGS;
+ mib[2] = proc_id;
+ mib[3] = KERN_PROC_ARGV;
+ if (sysctl (mib, 4, &args, &len, NULL, 0) == 0 && len != 0)
+ {
+ char **argv = (char**)args;
+
+ /* concatenate argv reusing the existing storage storage.
+ sysctl(8) guarantees that "the buffer pointed to by oldp is
+ filled with an array of char pointers followed by the strings
+ themselves." */
+ for (i = 0; argv[i] != NULL; ++i)
+ {
+ if (argv[i+1] != NULL)
+ {
+ len = strlen (argv[i]);
+ argv[i][len] = ' ';
+ }
+ }
+
+ AUTO_STRING (comm, *argv);
+ decoded_comm = code_convert_string_norecord (comm,
+ Vlocale_coding_system, 0);
+ attrs = Fcons (Fcons (Qargs, decoded_comm), attrs);
+ }
+
+ return attrs;
+}
+
#elif defined DARWIN_OS
Lisp_Object
diff --git a/src/sysselect.h b/src/sysselect.h
index ecba1f329ee..017c02b77f4 100644
--- a/src/sysselect.h
+++ b/src/sysselect.h
@@ -1,5 +1,5 @@
/* sysselect.h - System-dependent definitions for the select function.
- Copyright (C) 1995, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1995, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/syssignal.h b/src/syssignal.h
index a3e462b5385..285a3c548ba 100644
--- a/src/syssignal.h
+++ b/src/syssignal.h
@@ -1,6 +1,6 @@
/* syssignal.h - System-dependent definitions for signals.
-Copyright (C) 1993, 1999, 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 1993, 1999, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/sysstdio.h b/src/sysstdio.h
index 461019273bd..d4df3d74567 100644
--- a/src/sysstdio.h
+++ b/src/sysstdio.h
@@ -1,6 +1,6 @@
/* Standard I/O for Emacs.
-Copyright 2013-2020 Free Software Foundation, Inc.
+Copyright 2013-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/systhread.c b/src/systhread.c
index ebd75526495..c68853cacac 100644
--- a/src/systhread.c
+++ b/src/systhread.c
@@ -1,5 +1,5 @@
/* System thread definitions
-Copyright (C) 2012-2020 Free Software Foundation, Inc.
+Copyright (C) 2012-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/systhread.h b/src/systhread.h
index 73c764a9401..0f47d7c1a8a 100644
--- a/src/systhread.h
+++ b/src/systhread.h
@@ -1,5 +1,5 @@
/* System thread definitions
-Copyright (C) 2012-2020 Free Software Foundation, Inc.
+Copyright (C) 2012-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/systime.h b/src/systime.h
index b59a3d1c690..08ab5bdde33 100644
--- a/src/systime.h
+++ b/src/systime.h
@@ -1,5 +1,5 @@
/* systime.h - System-dependent definitions for time manipulations.
- Copyright (C) 1993-1994, 2002-2020 Free Software Foundation, Inc.
+ Copyright (C) 1993-1994, 2002-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/systty.h b/src/systty.h
index 43fe824123f..c19b4b35f18 100644
--- a/src/systty.h
+++ b/src/systty.h
@@ -1,5 +1,5 @@
/* systty.h - System-dependent definitions for terminals.
- Copyright (C) 1993-1994, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1993-1994, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/syswait.h b/src/syswait.h
index 57b0f70eced..42e8c408549 100644
--- a/src/syswait.h
+++ b/src/syswait.h
@@ -1,5 +1,5 @@
/* Define wait system call interface for Emacs.
- Copyright (C) 1993-1995, 2000-2020 Free Software Foundation, Inc.
+ Copyright (C) 1993-1995, 2000-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/term.c b/src/term.c
index ff1aabfed23..2e2ab2bf438 100644
--- a/src/term.c
+++ b/src/term.c
@@ -1,5 +1,5 @@
/* Terminal control module for terminals described by TERMCAP
- Copyright (C) 1985-1987, 1993-1995, 1998, 2000-2020 Free Software
+ Copyright (C) 1985-1987, 1993-1995, 1998, 2000-2021 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
@@ -2382,7 +2382,6 @@ frame's terminal). */)
#ifdef HAVE_GPM
-#ifndef HAVE_WINDOW_SYSTEM
void
term_mouse_moveto (int x, int y)
{
@@ -2396,7 +2395,6 @@ term_mouse_moveto (int x, int y)
last_mouse_x = x;
last_mouse_y = y; */
}
-#endif /* HAVE_WINDOW_SYSTEM */
/* Implementation of draw_row_with_mouse_face for TTY/GPM. */
void
@@ -2430,22 +2428,6 @@ tty_draw_row_with_mouse_face (struct window *w, struct glyph_row *row,
cursor_to (f, save_y, save_x);
}
-static bool
-term_mouse_movement (struct frame *frame, Gpm_Event *event)
-{
- /* Has the mouse moved off the glyph it was on at the last sighting? */
- if (event->x != last_mouse_x || event->y != last_mouse_y)
- {
- frame->mouse_moved = 1;
- note_mouse_highlight (frame, event->x, event->y);
- /* Remember which glyph we're now on. */
- last_mouse_x = event->x;
- last_mouse_y = event->y;
- return 1;
- }
- return 0;
-}
-
/* Return the current time, as a Time value. Wrap around on overflow. */
static Time
current_Time (void)
@@ -2497,7 +2479,7 @@ term_mouse_click (struct input_event *result, Gpm_Event *event,
{
int i, j;
- result->kind = GPM_CLICK_EVENT;
+ result->kind = MOUSE_CLICK_EVENT;
for (i = 0, j = GPM_B_LEFT; i < 3; i++, j >>= 1 )
{
if (event->buttons & j) {
@@ -2550,67 +2532,55 @@ term_mouse_click (struct input_event *result, Gpm_Event *event,
}
int
-handle_one_term_event (struct tty_display_info *tty, Gpm_Event *event,
- struct input_event *hold_quit)
+handle_one_term_event (struct tty_display_info *tty, Gpm_Event *event)
{
struct frame *f = XFRAME (tty->top_frame);
struct input_event ie;
- bool do_help = 0;
int count = 0;
EVENT_INIT (ie);
ie.kind = NO_EVENT;
ie.arg = Qnil;
- if (event->type & (GPM_MOVE | GPM_DRAG)) {
- previous_help_echo_string = help_echo_string;
- help_echo_string = Qnil;
-
- Gpm_DrawPointer (event->x, event->y, fileno (tty->output));
-
- if (!term_mouse_movement (f, event))
- help_echo_string = previous_help_echo_string;
-
- /* If the contents of the global variable help_echo_string
- has changed, generate a HELP_EVENT. */
- if (!NILP (help_echo_string)
- || !NILP (previous_help_echo_string))
- do_help = 1;
-
- goto done;
- }
- else {
- f->mouse_moved = 0;
- term_mouse_click (&ie, event, f);
- if (tty_handle_tab_bar_click (f, event->x, event->y,
- (ie.modifiers & down_modifier) != 0, &ie))
- {
- /* tty_handle_tab_bar_click stores 2 events in the event
- queue, so we are done here. */
- count += 2;
- return count;
- }
- }
-
- done:
- if (ie.kind != NO_EVENT)
+ if (event->type & (GPM_MOVE | GPM_DRAG))
{
- kbd_buffer_store_event_hold (&ie, hold_quit);
- count++;
- }
+ Gpm_DrawPointer (event->x, event->y, fileno (tty->output));
- if (do_help
- && !(hold_quit && hold_quit->kind != NO_EVENT))
+ /* Has the mouse moved off the glyph it was on at the last
+ sighting? */
+ if (event->x != last_mouse_x || event->y != last_mouse_y)
+ {
+ /* FIXME: These three lines can not be moved into
+ update_mouse_position unless xterm-mouse gets updated to
+ generate mouse events via C code. See
+ https://lists.gnu.org/archive/html/emacs-devel/2020-11/msg00163.html */
+ last_mouse_x = event->x;
+ last_mouse_y = event->y;
+ f->mouse_moved = 1;
+
+ count += update_mouse_position (f, event->x, event->y);
+ }
+ }
+ else
{
- Lisp_Object frame;
-
- if (f)
- XSETFRAME (frame, f);
- else
- frame = Qnil;
-
- gen_help_event (help_echo_string, frame, help_echo_window,
- help_echo_object, help_echo_pos);
+ f->mouse_moved = 0;
+ term_mouse_click (&ie, event, f);
+ /* eassert (ie.kind == MOUSE_CLICK_EVENT); */
+ if (tty_handle_tab_bar_click (f, event->x, event->y,
+ (ie.modifiers & down_modifier) != 0, &ie))
+ {
+ /* eassert (ie.kind == MOUSE_CLICK_EVENT
+ * || ie.kind == TAB_BAR_EVENT); */
+ /* tty_handle_tab_bar_click stores 2 events in the event
+ queue, so we are done here. */
+ /* FIXME: Actually, `tty_handle_tab_bar_click` returns true
+ without storing any events, when
+ (ie.modifiers & down_modifier) != 0 */
+ count += 2;
+ return count;
+ }
+ /* eassert (ie.kind == MOUSE_CLICK_EVENT); */
+ kbd_buffer_store_event (&ie);
count++;
}
@@ -4274,8 +4244,8 @@ use the Bourne shell command 'TERM=...; export TERM' (C-shell:\n\
#ifdef HAVE_GPM
terminal->mouse_position_hook = term_mouse_position;
- tty->mouse_highlight.mouse_face_window = Qnil;
#endif
+ tty->mouse_highlight.mouse_face_window = Qnil;
terminal->kboard = allocate_kboard (Qnil);
terminal->kboard->reference_count++;
diff --git a/src/termcap.c b/src/termcap.c
index 1ace4c93103..227dbeb7d92 100644
--- a/src/termcap.c
+++ b/src/termcap.c
@@ -1,5 +1,5 @@
/* Work-alike for termcap, plus extra features.
- Copyright (C) 1985-1986, 1993-1995, 2000-2008, 2011, 2013-2020 Free
+ Copyright (C) 1985-1986, 1993-1995, 2000-2008, 2011, 2013-2021 Free
Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
diff --git a/src/termchar.h b/src/termchar.h
index c967e7d04f4..f50c1bfb6ea 100644
--- a/src/termchar.h
+++ b/src/termchar.h
@@ -1,5 +1,5 @@
/* Flags and parameters describing terminal's characteristics.
- Copyright (C) 1985-1986, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1985-1986, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/termhooks.h b/src/termhooks.h
index d18b750c3a2..3800679e803 100644
--- a/src/termhooks.h
+++ b/src/termhooks.h
@@ -1,6 +1,6 @@
/* Parameters and display hooks for terminal devices.
-Copyright (C) 1985-1986, 1993-1994, 2001-2020 Free Software Foundation,
+Copyright (C) 1985-1986, 1993-1994, 2001-2021 Free Software Foundation,
Inc.
This file is part of GNU Emacs.
@@ -159,7 +159,6 @@ enum event_kind
SELECTION_REQUEST_EVENT, /* Another X client wants a selection from us.
See `struct selection_input_event'. */
SELECTION_CLEAR_EVENT, /* Another X client cleared our selection. */
- BUFFER_SWITCH_EVENT, /* A process filter has switched buffers. */
DELETE_WINDOW_EVENT, /* An X client said "delete this window". */
#ifdef HAVE_NTGUI
END_SESSION_EVENT, /* The user is logging out or shutting down. */
@@ -220,10 +219,6 @@ enum event_kind
save yourself before shutdown. */
SAVE_SESSION_EVENT
-#ifdef HAVE_GPM
- , GPM_CLICK_EVENT
-#endif
-
#ifdef HAVE_DBUS
, DBUS_EVENT
#endif
@@ -370,10 +365,8 @@ enum {
#ifdef HAVE_GPM
#include <gpm.h>
-extern int handle_one_term_event (struct tty_display_info *, Gpm_Event *, struct input_event *);
-#ifndef HAVE_WINDOW_SYSTEM
+extern int handle_one_term_event (struct tty_display_info *, Gpm_Event *);
extern void term_mouse_moveto (int, int);
-#endif
/* The device for which we have enabled gpm support. */
extern struct tty_display_info *gpm_tty;
diff --git a/src/terminal.c b/src/terminal.c
index e3b666ba61d..b83adc596bb 100644
--- a/src/terminal.c
+++ b/src/terminal.c
@@ -1,5 +1,5 @@
/* Functions related to terminal devices.
- Copyright (C) 2005-2020 Free Software Foundation, Inc.
+ Copyright (C) 2005-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/terminfo.c b/src/terminfo.c
index 0765996401f..a9c9572bbb2 100644
--- a/src/terminfo.c
+++ b/src/terminfo.c
@@ -1,5 +1,5 @@
/* Interface from Emacs to terminfo.
- Copyright (C) 1985-1986, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1985-1986, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -23,10 +23,10 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* Define these variables that serve as global parameters to termcap,
so that we do not need to conditionalize the places in Emacs
- that set them. But don't do that for terminfo, as that could
- cause link errors when using -fno-common. */
+ that set them. But don't do that if terminfo defines them, as that
+ could cause link errors when using -fno-common. */
-#if !TERMINFO
+#ifndef TERMINFO_DEFINES_BC
char *UP, *BC, PC;
#endif
diff --git a/src/termopts.h b/src/termopts.h
index 5c5caeab52f..0a3dfa092fc 100644
--- a/src/termopts.h
+++ b/src/termopts.h
@@ -1,5 +1,5 @@
/* Flags and parameters describing user options for handling the terminal.
- Copyright (C) 1985-1986, 1990, 2001-2020 Free Software Foundation,
+ Copyright (C) 1985-1986, 1990, 2001-2021 Free Software Foundation,
Inc.
This file is part of GNU Emacs.
diff --git a/src/textprop.c b/src/textprop.c
index 0876badc873..d7d6a669232 100644
--- a/src/textprop.c
+++ b/src/textprop.c
@@ -1,5 +1,5 @@
/* Interface code for dealing with text properties.
- Copyright (C) 1993-1995, 1997, 1999-2020 Free Software Foundation,
+ Copyright (C) 1993-1995, 1997, 1999-2021 Free Software Foundation,
Inc.
This file is part of GNU Emacs.
diff --git a/src/thread.c b/src/thread.c
index 7ab1e6de1fc..f74f6111486 100644
--- a/src/thread.c
+++ b/src/thread.c
@@ -1,5 +1,5 @@
/* Threading code.
-Copyright (C) 2012-2020 Free Software Foundation, Inc.
+Copyright (C) 2012-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/thread.h b/src/thread.h
index a09929fa440..cf3ce922c46 100644
--- a/src/thread.h
+++ b/src/thread.h
@@ -1,5 +1,5 @@
/* Thread definitions
-Copyright (C) 2012-2020 Free Software Foundation, Inc.
+Copyright (C) 2012-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -140,7 +140,6 @@ struct thread_state
for user-input when that process-filter was called.
waiting_for_input cannot be used as that is by definition 0 when
lisp code is being evalled.
- This is also used in record_asynch_buffer_change.
For that purpose, this must be 0
when not inside wait_reading_process_output. */
int m_waiting_for_user_input_p;
diff --git a/src/timefns.c b/src/timefns.c
index 4a28f707a3b..f0e2e97f555 100644
--- a/src/timefns.c
+++ b/src/timefns.c
@@ -1,6 +1,6 @@
/* Timestamp functions for Emacs
-Copyright (C) 1985-1987, 1989, 1993-2020 Free Software Foundation, Inc.
+Copyright (C) 1985-1987, 1989, 1993-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/tparam.c b/src/tparam.c
index 6afef2ef849..c89a9bde9a0 100644
--- a/src/tparam.c
+++ b/src/tparam.c
@@ -1,5 +1,5 @@
/* Merge parameters into a termcap entry string.
- Copyright (C) 1985, 1987, 1993, 1995, 2000-2008, 2013-2020 Free
+ Copyright (C) 1985, 1987, 1993, 1995, 2000-2008, 2013-2021 Free
Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
diff --git a/src/tparam.h b/src/tparam.h
index 5cab1479ade..893c3cac12c 100644
--- a/src/tparam.h
+++ b/src/tparam.h
@@ -1,6 +1,6 @@
/* Interface definitions for termcap entries.
-Copyright (C) 2011-2020 Free Software Foundation, Inc.
+Copyright (C) 2011-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/undo.c b/src/undo.c
index 0fcd8af240a..2db401ebc7e 100644
--- a/src/undo.c
+++ b/src/undo.c
@@ -1,5 +1,5 @@
/* undo handling for GNU Emacs.
- Copyright (C) 1990, 1993-1994, 2000-2020 Free Software Foundation,
+ Copyright (C) 1990, 1993-1994, 2000-2021 Free Software Foundation,
Inc.
This file is part of GNU Emacs.
diff --git a/src/unexaix.c b/src/unexaix.c
index 0e57b25c51d..949750f4933 100644
--- a/src/unexaix.c
+++ b/src/unexaix.c
@@ -1,5 +1,5 @@
/* Dump an executable file.
- Copyright (C) 1985-1988, 1999, 2001-2020 Free Software Foundation,
+ Copyright (C) 1985-1988, 1999, 2001-2021 Free Software Foundation,
Inc.
This file is part of GNU Emacs.
diff --git a/src/unexcoff.c b/src/unexcoff.c
index 3daa9d149b1..c4b2f6ebea7 100644
--- a/src/unexcoff.c
+++ b/src/unexcoff.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1985-1988, 1992-1994, 2001-2020 Free Software
+/* Copyright (C) 1985-1988, 1992-1994, 2001-2021 Free Software
* Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/unexcw.c b/src/unexcw.c
index 83efbc74bb1..7a80b05963b 100644
--- a/src/unexcw.c
+++ b/src/unexcw.c
@@ -1,7 +1,7 @@
/* unexec() support for Cygwin;
complete rewrite of xemacs Cygwin unexec() code
- Copyright (C) 2004-2020 Free Software Foundation, Inc.
+ Copyright (C) 2004-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/unexelf.c b/src/unexelf.c
index 2506cc61175..b5cded5cfda 100644
--- a/src/unexelf.c
+++ b/src/unexelf.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1985-1988, 1990, 1992, 1999-2020 Free Software
+/* Copyright (C) 1985-1988, 1990, 1992, 1999-2021 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/unexmacosx.c b/src/unexmacosx.c
index 8cf68bb92e1..f226f1b6c19 100644
--- a/src/unexmacosx.c
+++ b/src/unexmacosx.c
@@ -1,5 +1,5 @@
/* Dump Emacs in Mach-O format for use on macOS.
- Copyright (C) 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/unexw32.c b/src/unexw32.c
index 3c0f33557dd..1c60e3da0ee 100644
--- a/src/unexw32.c
+++ b/src/unexw32.c
@@ -1,5 +1,5 @@
/* unexec for GNU Emacs on Windows NT.
- Copyright (C) 1994, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1994, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/vm-limit.c b/src/vm-limit.c
index 1a07ecfb323..b9058d04352 100644
--- a/src/vm-limit.c
+++ b/src/vm-limit.c
@@ -1,5 +1,5 @@
/* Functions for memory limit warnings.
- Copyright (C) 1990, 1992, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1990, 1992, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/w16select.c b/src/w16select.c
index 75933526db1..37239137cf0 100644
--- a/src/w16select.c
+++ b/src/w16select.c
@@ -1,6 +1,6 @@
/* 16-bit Windows Selection processing for emacs on MS-Windows
-Copyright (C) 1996-1997, 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 1996-1997, 2001-2021 Free Software Foundation, Inc.
Author: Dale P. Smith <dpsm@en.com>
diff --git a/src/w32.c b/src/w32.c
index 5ebae324c20..a3c247b8b0d 100644
--- a/src/w32.c
+++ b/src/w32.c
@@ -1,6 +1,6 @@
/* Utility and Unix shadow routines for GNU Emacs on the Microsoft Windows API.
-Copyright (C) 1994-1995, 2000-2020 Free Software Foundation, Inc.
+Copyright (C) 1994-1995, 2000-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -8667,6 +8667,11 @@ pipe2 (int * phandles, int pipe2_flags)
{
_close (phandles[0]);
_close (phandles[1]);
+ /* Since we close the handles, set them to -1, so as to
+ avoid an assertion violation if the caller then tries to
+ close the handle again (emacs_close will abort otherwise
+ if errno is EBADF). */
+ phandles[0] = phandles[1] = -1;
errno = EMFILE;
rc = -1;
}
diff --git a/src/w32.h b/src/w32.h
index 1afb8ad0873..3f8eb250cc1 100644
--- a/src/w32.h
+++ b/src/w32.h
@@ -2,7 +2,7 @@
#define EMACS_W32_H
/* Support routines for the NT version of Emacs.
- Copyright (C) 1994, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1994, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -216,7 +216,7 @@ extern int sys_rename_replace (char const *, char const *, BOOL);
extern int pipe2 (int *, int);
extern void register_aux_fd (int);
-extern void set_process_dir (char *);
+extern void set_process_dir (const char *);
extern int sys_spawnve (int, char *, char **, char **);
extern void register_child (pid_t, int);
diff --git a/src/w32common.h b/src/w32common.h
index eb7faa1939a..94bb457e59d 100644
--- a/src/w32common.h
+++ b/src/w32common.h
@@ -1,5 +1,5 @@
/* Common functions for Microsoft Windows builds of Emacs
- Copyright (C) 2012-2020 Free Software Foundation, Inc.
+ Copyright (C) 2012-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/w32console.c b/src/w32console.c
index 72df888b749..cb9e288e880 100644
--- a/src/w32console.c
+++ b/src/w32console.c
@@ -1,5 +1,5 @@
/* Terminal hooks for GNU Emacs on the Microsoft Windows API.
- Copyright (C) 1992, 1999, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1992, 1999, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/w32cygwinx.c b/src/w32cygwinx.c
index 2d729834600..b58febc4e04 100644
--- a/src/w32cygwinx.c
+++ b/src/w32cygwinx.c
@@ -1,6 +1,6 @@
/* Common functions for the Microsoft Windows and Cygwin builds.
-Copyright (C) 2018-2020 Free Software Foundation, Inc.
+Copyright (C) 2018-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/w32fns.c b/src/w32fns.c
index ef69f40611e..c1e18ff7fad 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -1,6 +1,6 @@
/* Graphical user interface functions for the Microsoft Windows API.
-Copyright (C) 1989, 1992-2020 Free Software Foundation, Inc.
+Copyright (C) 1989, 1992-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -4448,7 +4448,10 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
int size, i;
W32Msg wmsg;
HIMC context = get_ime_context_fn (hwnd);
- wmsg.dwModifiers = w32_get_key_modifiers (wParam, lParam);
+ wmsg.dwModifiers =
+ w32_ignore_modifiers_on_IME_input
+ ? 0
+ : w32_get_key_modifiers (wParam, lParam);
/* Get buffer size. */
size = get_composition_string_fn (context, GCS_RESULTSTR, NULL, 0);
buffer = alloca (size);
@@ -7369,7 +7372,7 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
tip_f = XFRAME (tip_frame);
window = FRAME_ROOT_WINDOW (tip_f);
- tip_buf = Fget_buffer_create (tip);
+ tip_buf = Fget_buffer_create (tip, Qnil);
/* We will mark the tip window a "pseudo-window" below, and such
windows cannot have display margins. */
bset_left_margin_cols (XBUFFER (tip_buf), make_fixnum (0));
@@ -8498,8 +8501,8 @@ DEFUN ("w32-register-hot-key", Fw32_register_hot_key,
doc: /* Register KEY as a hot-key combination.
Certain key combinations like Alt-Tab and Win-R are reserved for
system use on Windows, and therefore are normally intercepted by the
-system. These key combinations can be received by registering them
-as hot-keys, except for Win-L which always locks the computer.
+system. These key combinations can be used in Emacs by registering
+them as hot-keys, except for Win-L which always locks the computer.
On Windows 98 and ME, KEY must be a one element key definition in
vector form that would be acceptable to `define-key' (e.g. [A-tab] for
@@ -8508,16 +8511,19 @@ Alt-Tab). The meta modifier is interpreted as Alt if
modifier keys. The return value is the hotkey-id if registered,
otherwise nil.
-On Windows versions since NT, KEY can also be specified as [M-], [s-] or
-[h-] to indicate that all combinations of that key should be processed
-by Emacs instead of the operating system. The super and hyper
-modifiers are interpreted according to the current values of
-`w32-lwindow-modifier' and `w32-rwindow-modifier'. For instance,
-setting `w32-lwindow-modifier' to `super' and then calling
-`(w32-register-hot-key [s-])' grabs all combinations of the left Windows
-key to Emacs, but leaves the right Windows key free for the operating
-system keyboard shortcuts. The return value is t if the call affected
-any key combinations, otherwise nil. */)
+On Windows versions since NT, KEY can also be specified as just a
+modifier key, [M-], [s-] or [H-], to indicate that all combinations
+of the respective modifier key should be processed by Emacs instead
+of the operating system. The super and hyper modifiers are
+interpreted according to the current values of `w32-lwindow-modifier'
+and `w32-rwindow-modifier'. For instance, setting `w32-lwindow-modifier'
+to `super' and then calling `(w32-register-hot-key [s-])' grabs all
+combinations of the left Windows key to Emacs as keys with the Super
+modifier, but leaves the right Windows key free for the operating
+system keyboard shortcuts.
+
+The return value is t if the call affected any key combinations,
+otherwise nil. */)
(Lisp_Object key)
{
key = w32_parse_and_hook_hot_key (key, 1);
@@ -10611,6 +10617,15 @@ tip frame. */);
doc: /* Non-nil means don't display the abort dialog when aborting. */);
w32_disable_abort_dialog = 0;
+ DEFVAR_BOOL ("w32-ignore-modifiers-on-IME-input",
+ w32_ignore_modifiers_on_IME_input,
+ doc: /* Whether to ignore modifier keys when processing input with IME.
+Some MS-Windows input methods use modifier keys such as Ctrl or Alt to input
+characters, in which case applying the modifiers will change the input.
+The default value of this variable is therefore t, to ignore modifier
+keys when IME input is received. */);
+ w32_ignore_modifiers_on_IME_input = true;
+
#if 0 /* TODO: Port to W32 */
defsubr (&Sx_change_window_property);
defsubr (&Sx_delete_window_property);
diff --git a/src/w32font.c b/src/w32font.c
index c1d5f25d251..6b9ab0468cd 100644
--- a/src/w32font.c
+++ b/src/w32font.c
@@ -1,5 +1,5 @@
/* Font backend for the Microsoft Windows API.
- Copyright (C) 2007-2020 Free Software Foundation, Inc.
+ Copyright (C) 2007-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/w32font.h b/src/w32font.h
index a76f8c30cec..cf2bf3c2421 100644
--- a/src/w32font.h
+++ b/src/w32font.h
@@ -1,5 +1,5 @@
/* Shared GDI and Uniscribe Font backend declarations for the Windows API.
- Copyright (C) 2007-2020 Free Software Foundation, Inc.
+ Copyright (C) 2007-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/w32gui.h b/src/w32gui.h
index dfec1f08617..d2c34bd00a9 100644
--- a/src/w32gui.h
+++ b/src/w32gui.h
@@ -1,5 +1,5 @@
/* Definitions and headers for communication on the Microsoft Windows API.
- Copyright (C) 1995, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1995, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -46,6 +46,7 @@ extern int w32_load_image (struct frame *f, struct image *img,
Lisp_Object spec_file, Lisp_Object spec_data);
extern bool w32_can_use_native_image_api (Lisp_Object);
extern void w32_gdiplus_shutdown (void);
+extern size_t w32_image_size (Emacs_Pixmap);
#define FACE_DEFAULT (~0)
diff --git a/src/w32heap.c b/src/w32heap.c
index a72bed62caf..e002f72608a 100644
--- a/src/w32heap.c
+++ b/src/w32heap.c
@@ -1,5 +1,5 @@
/* Heap management routines for GNU Emacs on the Microsoft Windows API.
- Copyright (C) 1994, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1994, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/w32heap.h b/src/w32heap.h
index 5c062671494..0b34f8a356a 100644
--- a/src/w32heap.h
+++ b/src/w32heap.h
@@ -1,5 +1,5 @@
/* Heap management routines (including unexec) for GNU Emacs on Windows NT.
- Copyright (C) 1994, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1994, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/w32image.c b/src/w32image.c
index 70b2eb29b87..cc1a6eba22b 100644
--- a/src/w32image.c
+++ b/src/w32image.c
@@ -1,6 +1,6 @@
/* Implementation of MS-Windows native image API via the GDI+ library.
-Copyright (C) 2020 Free Software Foundation, Inc.
+Copyright (C) 2020-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/w32inevt.c b/src/w32inevt.c
index 7023e7144a3..1a80a001974 100644
--- a/src/w32inevt.c
+++ b/src/w32inevt.c
@@ -1,5 +1,5 @@
/* Input event support for Emacs on the Microsoft Windows API.
- Copyright (C) 1992-1993, 1995, 2001-2020 Free Software Foundation,
+ Copyright (C) 1992-1993, 1995, 2001-2021 Free Software Foundation,
Inc.
This file is part of GNU Emacs.
diff --git a/src/w32inevt.h b/src/w32inevt.h
index 3426ac6251f..f0097716f35 100644
--- a/src/w32inevt.h
+++ b/src/w32inevt.h
@@ -1,5 +1,5 @@
/* Input routines for GNU Emacs on the Microsoft Windows API.
- Copyright (C) 1995, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1995, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/w32menu.c b/src/w32menu.c
index da2db78a940..8bf0c462030 100644
--- a/src/w32menu.c
+++ b/src/w32menu.c
@@ -1,5 +1,5 @@
/* Menu support for GNU Emacs on the Microsoft Windows API.
- Copyright (C) 1986, 1988, 1993-1994, 1996, 1998-1999, 2001-2020 Free
+ Copyright (C) 1986, 1988, 1993-1994, 1996, 1998-1999, 2001-2021 Free
Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/w32notify.c b/src/w32notify.c
index 0871abb6027..b9e90633923 100644
--- a/src/w32notify.c
+++ b/src/w32notify.c
@@ -1,6 +1,6 @@
/* Filesystem notifications support for GNU Emacs on the Microsoft Windows API.
-Copyright (C) 2012-2020 Free Software Foundation, Inc.
+Copyright (C) 2012-2021 Free Software Foundation, Inc.
Author: Eli Zaretskii <eliz@gnu.org>
diff --git a/src/w32proc.c b/src/w32proc.c
index 0cf82013065..2b6cb9c1e1d 100644
--- a/src/w32proc.c
+++ b/src/w32proc.c
@@ -1,6 +1,6 @@
/* Process support for GNU Emacs on the Microsoft Windows API.
-Copyright (C) 1992, 1995, 1999-2020 Free Software Foundation, Inc.
+Copyright (C) 1992, 1995, 1999-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -3019,9 +3019,9 @@ reset_standard_handles (int in, int out, int err, HANDLE handles[3])
}
void
-set_process_dir (char * dir)
+set_process_dir (const char * dir)
{
- process_dir = dir;
+ process_dir = (char *) dir;
}
/* To avoid problems with winsock implementations that work over dial-up
diff --git a/src/w32reg.c b/src/w32reg.c
index 9ef50afce33..9794162bd09 100644
--- a/src/w32reg.c
+++ b/src/w32reg.c
@@ -1,6 +1,6 @@
/* Emulate the X Resource Manager through the registry.
-Copyright (C) 1990, 1993-1994, 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 1990, 1993-1994, 2001-2021 Free Software Foundation, Inc.
Author: Kevin Gallo
diff --git a/src/w32select.c b/src/w32select.c
index e754e1f1ed2..85f8e5556a2 100644
--- a/src/w32select.c
+++ b/src/w32select.c
@@ -1,6 +1,6 @@
/* Selection processing for Emacs on the Microsoft Windows API.
-Copyright (C) 1993-1994, 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 1993-1994, 2001-2021 Free Software Foundation, Inc.
Author: Kevin Gallo
Benjamin Riefenstahl
diff --git a/src/w32select.h b/src/w32select.h
index 2cdc51994a3..7ed8696ea98 100644
--- a/src/w32select.h
+++ b/src/w32select.h
@@ -1,6 +1,6 @@
/* Selection processing for Emacs on the Microsoft W32 API.
-Copyright (C) 1993-1994, 2001-2020 Free Software Foundation, Inc.
+Copyright (C) 1993-1994, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/w32term.c b/src/w32term.c
index e0618e4f52d..109aa58d732 100644
--- a/src/w32term.c
+++ b/src/w32term.c
@@ -1,6 +1,6 @@
/* Implementation of GUI terminal on the Microsoft Windows API.
-Copyright (C) 1989, 1993-2020 Free Software Foundation, Inc.
+Copyright (C) 1989, 1993-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -1991,6 +1991,17 @@ w32_draw_image_foreground (struct glyph_string *s)
RestoreDC (s->hdc ,-1);
}
+size_t
+w32_image_size (Emacs_Pixmap pixmap)
+{
+ BITMAP bm_info;
+ size_t rv = 0;
+
+ if (GetObject (pixmap, sizeof (BITMAP), &bm_info))
+ rv = bm_info.bmWidth * bm_info.bmHeight * bm_info.bmBitsPixel / 8;
+ return rv;
+}
+
/* Draw a relief around the image glyph string S. */
@@ -4847,10 +4858,6 @@ w32_read_socket (struct terminal *terminal,
inev.kind = DEICONIFY_EVENT;
XSETFRAME (inev.frame_or_window, f);
}
- else if (!NILP (Vframe_list) && !NILP (XCDR (Vframe_list)))
- /* Force a redisplay sooner or later to update the
- frame titles in case this is the second frame. */
- record_asynch_buffer_change ();
}
else
{
@@ -5468,12 +5475,6 @@ w32_read_socket (struct terminal *terminal,
inev.kind = DEICONIFY_EVENT;
XSETFRAME (inev.frame_or_window, f);
}
- else if (! NILP (Vframe_list)
- && ! NILP (XCDR (Vframe_list)))
- /* Force a redisplay sooner or later
- to update the frame titles
- in case this is the second frame. */
- record_asynch_buffer_change ();
/* Windows can send us a SIZE_MAXIMIZED message even
when fullscreen is fullboth. The following is a
@@ -5521,12 +5522,6 @@ w32_read_socket (struct terminal *terminal,
inev.kind = DEICONIFY_EVENT;
XSETFRAME (inev.frame_or_window, f);
}
- else if (! NILP (Vframe_list)
- && ! NILP (XCDR (Vframe_list)))
- /* Force a redisplay sooner or later
- to update the frame titles
- in case this is the second frame. */
- record_asynch_buffer_change ();
}
if (EQ (get_frame_param (f, Qfullscreen), Qmaximized))
@@ -5818,9 +5813,6 @@ w32_read_socket (struct terminal *terminal,
SET_FRAME_GARBAGED (f);
DebPrint (("obscured frame %p (%s) found to be visible\n",
f, SDATA (f->name)));
-
- /* Force a redisplay sooner or later. */
- record_asynch_buffer_change ();
}
}
}
@@ -7165,15 +7157,21 @@ w32_initialize_display_info (Lisp_Object display_name)
memset (dpyinfo, 0, sizeof (*dpyinfo));
dpyinfo->name_list_element = Fcons (display_name, Qnil);
+ static char const title[] = "GNU Emacs";
if (STRINGP (Vsystem_name))
{
- dpyinfo->w32_id_name = xmalloc (SCHARS (Vinvocation_name)
- + SCHARS (Vsystem_name) + 2);
- sprintf (dpyinfo->w32_id_name, "%s@%s",
- SDATA (Vinvocation_name), SDATA (Vsystem_name));
+ static char const at[] = " at ";
+ ptrdiff_t nbytes = sizeof (title) + sizeof (at);
+ if (INT_ADD_WRAPV (nbytes, SCHARS (Vsystem_name), &nbytes))
+ memory_full (SIZE_MAX);
+ dpyinfo->w32_id_name = xmalloc (nbytes);
+ sprintf (dpyinfo->w32_id_name, "%s%s%s", title, at, SDATA (Vsystem_name));
}
else
- dpyinfo->w32_id_name = xlispstrdup (Vinvocation_name);
+ {
+ dpyinfo->w32_id_name = xmalloc (sizeof (title));
+ strcpy (dpyinfo->w32_id_name, title);
+ }
/* Default Console mode values - overridden when running in GUI mode
with values obtained from system metrics. */
@@ -7509,7 +7507,8 @@ w32_initialize (void)
}
#ifdef CYGWIN
- if ((w32_message_fd = emacs_open ("/dev/windows", O_RDWR, 0)) == -1)
+ if ((w32_message_fd = emacs_open_noquit ("/dev/windows", O_RDWR, 0))
+ == -1)
fatal ("opening /dev/windows: %s", strerror (errno));
#endif /* CYGWIN */
diff --git a/src/w32term.h b/src/w32term.h
index 694493c6c82..7d351df871d 100644
--- a/src/w32term.h
+++ b/src/w32term.h
@@ -1,5 +1,5 @@
/* Definitions and headers for communication on the Microsoft Windows API.
- Copyright (C) 1995, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1995, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/w32uniscribe.c b/src/w32uniscribe.c
index 7a84b21f9da..0df1ff298f1 100644
--- a/src/w32uniscribe.c
+++ b/src/w32uniscribe.c
@@ -1,6 +1,6 @@
/* Font backend for the Microsoft W32 Uniscribe API.
Windows-specific parts of the HarfBuzz font backend.
- Copyright (C) 2008-2020 Free Software Foundation, Inc.
+ Copyright (C) 2008-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/w32xfns.c b/src/w32xfns.c
index 70cee559f3c..712214b591b 100644
--- a/src/w32xfns.c
+++ b/src/w32xfns.c
@@ -1,5 +1,5 @@
/* Functions taken directly from X sources for use with the Microsoft Windows API.
- Copyright (C) 1989, 1992-1995, 1999, 2001-2020 Free Software
+ Copyright (C) 1989, 1992-1995, 1999, 2001-2021 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/widget.c b/src/widget.c
index b141612b539..43f0307b4e0 100644
--- a/src/widget.c
+++ b/src/widget.c
@@ -1,5 +1,5 @@
/* The emacs frame widget.
- Copyright (C) 1992-1993, 2000-2020 Free Software Foundation, Inc.
+ Copyright (C) 1992-1993, 2000-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/widget.h b/src/widget.h
index 7ec5b63e128..105bc6646d1 100644
--- a/src/widget.h
+++ b/src/widget.h
@@ -1,5 +1,5 @@
/* The emacs frame widget public header file.
- Copyright (C) 1993, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1993, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/widgetprv.h b/src/widgetprv.h
index cf7cad7c01a..58620a05b2a 100644
--- a/src/widgetprv.h
+++ b/src/widgetprv.h
@@ -1,5 +1,5 @@
/* The emacs frame widget private header file.
- Copyright (C) 1993, 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 1993, 2001-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/window.c b/src/window.c
index e7433969d29..e025e0b0821 100644
--- a/src/window.c
+++ b/src/window.c
@@ -1,6 +1,6 @@
/* Window creation, deletion and examination for GNU Emacs.
Does not include redisplay.
- Copyright (C) 1985-1987, 1993-1998, 2000-2020 Free Software
+ Copyright (C) 1985-1987, 1993-1998, 2000-2021 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
@@ -617,11 +617,12 @@ equals the special symbol `mark-for-redisplay'.
Run `buffer-list-update-hook' unless NORECORD is non-nil. Note that
applications and internal routines often select a window temporarily for
various purposes; mostly, to simplify coding. As a rule, such
-selections should be not recorded and therefore will not pollute
+selections should not be recorded and therefore will not pollute
`buffer-list-update-hook'. Selections that "really count" are those
causing a visible change in the next redisplay of WINDOW's frame and
-should be always recorded. So if you think of running a function each
-time a window gets selected put it on `buffer-list-update-hook'.
+should always be recorded. So if you think of running a function each
+time a window gets selected, put it on `buffer-list-update-hook' or
+`window-selection-change-functions'.
Also note that the main editor command loop sets the current buffer to
the buffer of the selected window before each command. */)
@@ -2643,8 +2644,10 @@ candidate_window_p (Lisp_Object window, Lisp_Object owindow,
/* To qualify as candidate, it's not sufficient for WINDOW's frame
to just share the minibuffer window - it must be active as well
(see Bug#24500). */
- candidate_p = (EQ (XWINDOW (all_frames)->frame, w->frame)
- || EQ (XWINDOW (all_frames)->frame, FRAME_FOCUS_FRAME (f)));
+ candidate_p = ((EQ (XWINDOW (all_frames)->frame, w->frame)
+ || (EQ (f->minibuffer_window, all_frames)
+ && EQ (XWINDOW (all_frames)->frame, FRAME_FOCUS_FRAME (f))))
+ && !is_minibuffer (0, XWINDOW (all_frames)->contents));
else if (FRAMEP (all_frames))
candidate_p = EQ (all_frames, w->frame);
@@ -2660,12 +2663,15 @@ static void
decode_next_window_args (Lisp_Object *window, Lisp_Object *minibuf, Lisp_Object *all_frames)
{
struct window *w = decode_live_window (*window);
+ Lisp_Object miniwin = XFRAME (w->frame)->minibuffer_window;
XSETWINDOW (*window, w);
/* MINIBUF nil may or may not include minibuffers. Decide if it
does. */
if (NILP (*minibuf))
- *minibuf = minibuf_level ? minibuf_window : Qlambda;
+ *minibuf = this_minibuffer_depth (XWINDOW (miniwin)->contents)
+ ? miniwin
+ : Qlambda;
else if (!EQ (*minibuf, Qt))
*minibuf = Qlambda;
@@ -5667,7 +5673,7 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror)
if (whole)
{
ptrdiff_t start_pos = IT_CHARPOS (it);
- int dy = frame_line_height;
+ int flh = frame_line_height;
int ht = window_box_height (w);
int nscls = sanitize_next_screen_context_lines ();
/* In the below we divide the window box height by the frame's
@@ -5675,14 +5681,30 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror)
box is not an integral multiple of the line height. This is
important to ensure we get back to the same position when
scrolling up, then down. */
- dy = n * max (dy, (ht / dy - nscls) * dy);
+ int dy = n * max (flh, (ht / flh - nscls) * flh);
+ int goal_y;
+ void *it_data;
/* Note that move_it_vertically always moves the iterator to the
start of a line. So, if the last line doesn't have a newline,
we would end up at the start of the line ending at ZV. */
if (dy <= 0)
{
+ goal_y = it.current_y + dy;
move_it_vertically_backward (&it, -dy);
+ /* move_it_vertically_backward above always overshoots if DY
+ cannot be reached exactly, i.e. if it falls in the middle
+ of a screen line. But if that screen line is large
+ (e.g., a tall image), it might make more sense to
+ undershoot instead. */
+ if (goal_y - it.current_y > 0.5 * flh)
+ {
+ it_data = bidi_shelve_cache ();
+ struct it it1 = it;
+ if (line_bottom_y (&it1) - goal_y < goal_y - it.current_y)
+ move_it_by_lines (&it, 1);
+ bidi_unshelve_cache (it_data, true);
+ }
/* Ensure we actually do move, e.g. in case we are currently
looking at an image that is taller that the window height. */
while (start_pos == IT_CHARPOS (it)
@@ -5691,8 +5713,28 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror)
}
else if (dy > 0)
{
- move_it_to (&it, ZV, -1, it.current_y + dy, -1,
- MOVE_TO_POS | MOVE_TO_Y);
+ goal_y = it.current_y + dy;
+ move_it_to (&it, ZV, -1, goal_y, -1, MOVE_TO_POS | MOVE_TO_Y);
+ /* Extra precision for people who want us to preserve the
+ screen position of the cursor: effectively round DY to the
+ nearest screen line, instead of rounding to zero; the latter
+ causes point to move by one line after C-v followed by M-v,
+ if the buffer has lines of different height. */
+ if (!NILP (Vscroll_preserve_screen_position)
+ && goal_y - it.current_y > 0.5 * flh)
+ {
+ it_data = bidi_shelve_cache ();
+ struct it it2 = it;
+
+ move_it_by_lines (&it, 1);
+ if (it.current_y > goal_y + 0.5 * flh)
+ {
+ it = it2;
+ bidi_unshelve_cache (it_data, false);
+ }
+ else
+ bidi_unshelve_cache (it_data, true);
+ }
/* Ensure we actually do move, e.g. in case we are currently
looking at an image that is taller that the window height. */
while (start_pos == IT_CHARPOS (it)
@@ -6822,19 +6864,25 @@ DEFUN ("window-configuration-frame", Fwindow_configuration_frame, Swindow_config
}
DEFUN ("set-window-configuration", Fset_window_configuration,
- Sset_window_configuration, 1, 1, 0,
+ Sset_window_configuration, 1, 2, 0,
doc: /* Set the configuration of windows and buffers as specified by CONFIGURATION.
CONFIGURATION must be a value previously returned
by `current-window-configuration' (which see).
+
+Normally, this function selects the frame of the CONFIGURATION, but if
+DONT-SET-FRAME is non-nil, it leaves selected the frame which was
+current at the start of the function.
+
If CONFIGURATION was made from a frame that is now deleted,
only frame-independent values can be restored. In this case,
the return value is nil. Otherwise the value is t. */)
- (Lisp_Object configuration)
+ (Lisp_Object configuration, Lisp_Object dont_set_frame)
{
register struct save_window_data *data;
struct Lisp_Vector *saved_windows;
Lisp_Object new_current_buffer;
Lisp_Object frame;
+ Lisp_Object old_frame = selected_frame;
struct frame *f;
ptrdiff_t old_point = -1;
USE_SAFE_ALLOCA;
@@ -7151,7 +7199,10 @@ the return value is nil. Otherwise the value is t. */)
select_window above totally superfluous; it still sets f's
selected window. */
if (FRAME_LIVE_P (XFRAME (data->selected_frame)))
- do_switch_frame (data->selected_frame, 0, 0, Qnil);
+ do_switch_frame (NILP (dont_set_frame)
+ ? data->selected_frame
+ : old_frame
+ , 0, 0, Qnil);
}
FRAME_WINDOW_CHANGE (f) = true;
@@ -7185,11 +7236,13 @@ the return value is nil. Otherwise the value is t. */)
return FRAME_LIVE_P (f) ? Qt : Qnil;
}
-
void
restore_window_configuration (Lisp_Object configuration)
{
- Fset_window_configuration (configuration);
+ if (CONSP (configuration))
+ Fset_window_configuration (XCDR (configuration), XCAR (configuration));
+ else
+ Fset_window_configuration (configuration, Qnil);
}
@@ -7773,7 +7826,7 @@ set_window_scroll_bars (struct window *w, Lisp_Object width,
if more than a single window needs to be considered, see
redisplay_internal. */
if (changed)
- windows_or_buffers_changed = 31;
+ wset_redisplay (w);
return changed ? w : NULL;
}
@@ -8050,6 +8103,18 @@ and scrolling positions. */)
return Qt;
return Qnil;
}
+
+DEFUN ("window-bump-use-time", Fwindow_bump_use_time,
+ Swindow_bump_use_time, 1, 1, 0,
+ doc: /* Mark WINDOW as having been recently used. */)
+ (Lisp_Object window)
+{
+ struct window *w = decode_valid_window (window);
+
+ w->use_time = ++window_select_count;
+ return Qnil;
+}
+
static void init_window_once_for_pdumper (void);
@@ -8193,11 +8258,17 @@ is displayed in the `mode-line' face. */);
DEFVAR_LISP ("scroll-preserve-screen-position",
Vscroll_preserve_screen_position,
doc: /* Controls if scroll commands move point to keep its screen position unchanged.
+
A value of nil means point does not keep its screen position except
at the scroll margin or window boundary respectively.
+
A value of t means point keeps its screen position if the scroll
command moved it vertically out of the window, e.g. when scrolling
-by full screens.
+by full screens. If point is within `next-screen-context-lines' lines
+from the edges of the window, point will typically not keep its screen
+position when doing commands like `scroll-up-command'/`scroll-down-command'
+and the like.
+
Any other value means point always keeps its screen position.
Scroll commands should have the `scroll-command' property
on their symbols to be controlled by this variable. */);
@@ -8517,6 +8588,7 @@ displayed after a scrolling operation to be somewhat inaccurate. */);
defsubr (&Swindow_vscroll);
defsubr (&Sset_window_vscroll);
defsubr (&Scompare_window_configurations);
+ defsubr (&Swindow_bump_use_time);
defsubr (&Swindow_list);
defsubr (&Swindow_list_1);
defsubr (&Swindow_prev_buffers);
@@ -8527,14 +8599,3 @@ displayed after a scrolling operation to be somewhat inaccurate. */);
defsubr (&Swindow_parameter);
defsubr (&Sset_window_parameter);
}
-
-void
-keys_of_window (void)
-{
- initial_define_key (control_x_map, '<', "scroll-left");
- initial_define_key (control_x_map, '>', "scroll-right");
-
- initial_define_key (global_map, Ctl ('V'), "scroll-up-command");
- initial_define_key (meta_map, Ctl ('V'), "scroll-other-window");
- initial_define_key (meta_map, 'v', "scroll-down-command");
-}
diff --git a/src/window.h b/src/window.h
index 167d1be7abb..79eb44e7a38 100644
--- a/src/window.h
+++ b/src/window.h
@@ -1,5 +1,5 @@
/* Window definitions for GNU Emacs.
- Copyright (C) 1985-1986, 1993, 1995, 1997-2020 Free Software
+ Copyright (C) 1985-1986, 1993, 1995, 1997-2021 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
@@ -1124,10 +1124,6 @@ extern Lisp_Object echo_area_window;
extern EMACS_INT command_loop_level;
-/* Depth in minibuffer invocations. */
-
-extern EMACS_INT minibuf_level;
-
/* Non-zero if we should redraw the mode lines on the next redisplay.
Usually set to a unique small integer so we can track the main causes of
full redisplays in `redisplay--mode-lines-cause'. */
@@ -1202,7 +1198,6 @@ extern bool window_outdated (struct window *);
extern void init_window_once (void);
extern void init_window (void);
extern void syms_of_window (void);
-extern void keys_of_window (void);
/* Move cursor to row/column position VPOS/HPOS, pixel coordinates
Y/X. HPOS/VPOS are window-relative row and column numbers and X/Y
are window-relative pixel positions. This is always done during
diff --git a/src/xdisp.c b/src/xdisp.c
index cc499f33261..32e9773b54e 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -1,6 +1,6 @@
/* Display generation from window structure and buffer text.
-Copyright (C) 1985-1988, 1993-1995, 1997-2020 Free Software Foundation,
+Copyright (C) 1985-1988, 1993-1995, 1997-2021 Free Software Foundation,
Inc.
This file is part of GNU Emacs.
@@ -1114,7 +1114,8 @@ static ptrdiff_t display_count_lines (ptrdiff_t, ptrdiff_t, ptrdiff_t,
static void pint2str (register char *, register int, register ptrdiff_t);
static int display_string (const char *, Lisp_Object, Lisp_Object,
- ptrdiff_t, ptrdiff_t, struct it *, int, int, int, int);
+ ptrdiff_t, ptrdiff_t, struct it *, int, int, int,
+ int);
static void compute_line_metrics (struct it *);
static void run_redisplay_end_trigger_hook (struct it *);
static bool get_overlay_strings (struct it *, ptrdiff_t);
@@ -1796,6 +1797,7 @@ pos_visible_p (struct window *w, ptrdiff_t charpos, int *x, int *y,
from a display vector, we need to consume all of
the glyphs from that display vector. */
start_display (&it2, w, top);
+ it2.glyph_row = NULL;
move_it_to (&it2, charpos - 1, -1, -1, -1, MOVE_TO_POS);
/* If we didn't get to CHARPOS - 1, there's some
replacing display property at that position, and
@@ -1919,16 +1921,17 @@ pos_visible_p (struct window *w, ptrdiff_t charpos, int *x, int *y,
of the display line where the display string
begins. */
start_display (&it3, w, top);
+ it3.glyph_row = NULL;
move_it_to (&it3, -1, 0, top_y, -1, MOVE_TO_X | MOVE_TO_Y);
/* If it3_moved stays false after the 'while' loop
below, that means we already were at a newline
before the loop (e.g., the display string begins
- with a newline), so we don't need to (and cannot)
- inspect the glyphs of it3.glyph_row, because
- PRODUCE_GLYPHS will not produce anything for a
- newline, and thus it3.glyph_row stays at its
- stale content it got at top of the window. */
+ with a newline), so we don't need to return to
+ the last position before the display string,
+ because PRODUCE_GLYPHS will not produce anything
+ for a newline. */
bool it3_moved = false;
+ int top_x_before_string = it3.current_x;
/* Finally, advance the iterator until we hit the
first display element whose character position is
CHARPOS, or until the first newline from the
@@ -1936,6 +1939,8 @@ pos_visible_p (struct window *w, ptrdiff_t charpos, int *x, int *y,
display line. */
while (get_next_display_element (&it3))
{
+ if (!EQ (it3.object, string))
+ top_x_before_string = it3.current_x;
PRODUCE_GLYPHS (&it3);
if (IT_CHARPOS (it3) == charpos
|| ITERATOR_AT_END_OF_LINE_P (&it3))
@@ -1950,32 +1955,26 @@ pos_visible_p (struct window *w, ptrdiff_t charpos, int *x, int *y,
if (!it3.line_number_produced_p)
{
if (it3.lnum_pixel_width > 0)
- top_x += it3.lnum_pixel_width;
+ {
+ top_x += it3.lnum_pixel_width;
+ top_x_before_string += it3.lnum_pixel_width;
+ }
else if (it.line_number_produced_p)
- top_x += it.lnum_pixel_width;
+ {
+ top_x += it.lnum_pixel_width;
+ top_x_before_string += it3.lnum_pixel_width;
+ }
}
/* Normally, we would exit the above loop because we
found the display element whose character
position is CHARPOS. For the contingency that we
didn't, and stopped at the first newline from the
- display string, move back over the glyphs
- produced from the string, until we find the
- rightmost glyph not from the string. */
+ display string, reset top_x to the coordinate of
+ the rightmost glyph not from the string. */
if (it3_moved
&& newline_in_string
&& IT_CHARPOS (it3) != charpos && EQ (it3.object, string))
- {
- struct glyph *g = it3.glyph_row->glyphs[TEXT_AREA]
- + it3.glyph_row->used[TEXT_AREA];
-
- while (EQ ((g - 1)->object, string))
- {
- --g;
- top_x -= g->pixel_width;
- }
- eassert (g < it3.glyph_row->glyphs[TEXT_AREA]
- + it3.glyph_row->used[TEXT_AREA]);
- }
+ top_x = top_x_before_string;
}
}
@@ -4263,6 +4262,7 @@ handle_fontified_prop (struct it *it)
if (!STRINGP (it->string)
&& it->s == NULL
&& !NILP (Vfontification_functions)
+ && !(input_was_pending && redisplay_skip_fontification_on_input)
&& !NILP (Vrun_hooks)
&& (pos = make_fixnum (IT_CHARPOS (*it)),
prop = Fget_char_property (pos, Qfontified, Qnil),
@@ -7323,14 +7323,21 @@ static next_element_function const get_next_element[NUM_IT_METHODS] =
/* Return true iff a character at CHARPOS (and BYTEPOS) is composed
- (possibly with the following characters). */
+ (possibly with the following characters).
+
+ Note: we pass -1 as the "resolved bidi level" when the iterator
+ doesn't have the bidi_p flag set, because in that case we really
+ don't know what is the directionality of the text, so we leave it to
+ the shaping engine to figure that out. */
#define CHAR_COMPOSED_P(IT,CHARPOS,BYTEPOS,END_CHARPOS) \
((IT)->cmp_it.id >= 0 \
|| ((IT)->cmp_it.stop_pos == (CHARPOS) \
&& composition_reseat_it (&(IT)->cmp_it, CHARPOS, BYTEPOS, \
END_CHARPOS, (IT)->w, \
- (IT)->bidi_it.resolved_level, \
+ (IT)->bidi_p \
+ ? (IT)->bidi_it.resolved_level \
+ : -1, \
FACE_FROM_ID_OR_NULL ((IT)->f, \
(IT)->face_id), \
(IT)->string)))
@@ -8317,10 +8324,10 @@ next_element_from_display_vector (struct it *it)
next_face_id = it->dpvec_face_id;
else
{
- int lface_id =
- GLYPH_CODE_FACE (it->dpvec[it->current.dpvec_index + 1]);
+ Lisp_Object gc = it->dpvec[it->current.dpvec_index + 1];
+ int lface_id = GLYPH_CODE_P (gc) ? GLYPH_CODE_FACE (gc) : 0;
- if (lface_id > 0)
+ if (lface_id > 0)
next_face_id = merge_faces (it->w, Qt, lface_id,
it->saved_face_id);
}
@@ -9278,8 +9285,8 @@ move_it_in_display_line_to (struct it *it,
if (may_wrap && char_can_wrap_before (it))
{
/* We have reached a glyph that follows one or more
- whitespace characters or a character that allows
- wrapping after it. If this character allows
+ whitespace characters or characters that allow
+ wrapping after them. If this character allows
wrapping before it, save this position as a
wrapping point. */
if (atpos_it.sp >= 0)
@@ -9296,7 +9303,6 @@ move_it_in_display_line_to (struct it *it,
}
/* Otherwise, we can wrap here. */
SAVE_IT (wrap_it, *it, wrap_data);
- next_may_wrap = false;
}
/* Update may_wrap for the next iteration. */
may_wrap = next_may_wrap;
@@ -9952,7 +9958,27 @@ move_it_to (struct it *it, ptrdiff_t to_charpos, int to_x, int to_y, int to_vpos
{
skip = skip2;
if (skip == MOVE_POS_MATCH_OR_ZV)
- reached = 7;
+ {
+ reached = 7;
+ /* If the last move_it_in_display_line_to call
+ took us away from TO_CHARPOS, back up to the
+ previous position, as it is a better
+ approximation of TO_CHARPOS. (Note that we
+ could have both positions after TO_CHARPOS or
+ both positions before it, due to bidi
+ reordering.) */
+ if (IT_CHARPOS (*it) != to_charpos
+ && ((IT_CHARPOS (it_backup) > to_charpos)
+ == (IT_CHARPOS (*it) > to_charpos)))
+ {
+ int max_ascent = it->max_ascent;
+ int max_descent = it->max_descent;
+
+ RESTORE_IT (it, &it_backup, backup_data);
+ it->max_ascent = max_ascent;
+ it->max_descent = max_descent;
+ }
+ }
}
}
else
@@ -10296,11 +10322,22 @@ move_it_vertically_backward (struct it *it, int dy)
move_it_vertically (it, target_y - it->current_y);
else
{
+ struct text_pos last_pos;
+ int last_y, last_vpos;
do
{
+ last_pos = it->current.pos;
+ last_y = it->current_y;
+ last_vpos = it->vpos;
move_it_by_lines (it, 1);
}
- while (target_y >= line_bottom_y (it) && IT_CHARPOS (*it) < ZV);
+ while (target_y > it->current_y && IT_CHARPOS (*it) < ZV);
+ if (it->current_y > target_y)
+ {
+ reseat (it, last_pos, true);
+ it->current_y = last_y;
+ it->vpos = last_vpos;
+ }
}
}
}
@@ -10612,9 +10649,10 @@ include the height of both, if present, in the return value. */)
bpos = BEGV_BYTE;
while (bpos < ZV_BYTE)
{
- c = fetch_char_advance (&start, &bpos);
+ c = FETCH_BYTE (bpos);
if (!(c == ' ' || c == '\t' || c == '\n' || c == '\r'))
break;
+ inc_both (&start, &bpos);
}
while (bpos > BEGV_BYTE)
{
@@ -10643,7 +10681,10 @@ include the height of both, if present, in the return value. */)
dec_both (&end, &bpos);
c = FETCH_BYTE (bpos);
if (!(c == ' ' || c == '\t' || c == '\n' || c == '\r'))
- break;
+ {
+ inc_both (&end, &bpos);
+ break;
+ }
}
while (bpos < ZV_BYTE)
{
@@ -10844,7 +10885,7 @@ message_dolog (const char *m, ptrdiff_t nbytes, bool nlflag, bool multibyte)
/* Ensure the Messages buffer exists, and switch to it.
If we created it, set the major-mode. */
bool newbuffer = NILP (Fget_buffer (Vmessages_buffer_name));
- Fset_buffer (Fget_buffer_create (Vmessages_buffer_name));
+ Fset_buffer (Fget_buffer_create (Vmessages_buffer_name, Qnil));
if (newbuffer
&& !NILP (Ffboundp (intern ("messages-buffer-mode"))))
call0 (intern ("messages-buffer-mode"));
@@ -11330,7 +11371,7 @@ ensure_echo_area_buffers (void)
static char const name_fmt[] = " *Echo Area %d*";
char name[sizeof name_fmt + INT_STRLEN_BOUND (int)];
AUTO_STRING_WITH_LEN (lname, name, sprintf (name, name_fmt, i));
- echo_buffer[i] = Fget_buffer_create (lname);
+ echo_buffer[i] = Fget_buffer_create (lname, Qnil);
bset_truncate_lines (XBUFFER (echo_buffer[i]), Qnil);
/* to force word wrap in echo area -
it was decided to postpone this*/
@@ -11746,9 +11787,10 @@ resize_mini_window (struct window *w, bool exact_p)
return false;
/* By default, start display at the beginning. */
- set_marker_both (w->start, w->contents,
- BUF_BEGV (XBUFFER (w->contents)),
- BUF_BEGV_BYTE (XBUFFER (w->contents)));
+ if (redisplay_adhoc_scroll_in_resize_mini_windows)
+ set_marker_both (w->start, w->contents,
+ BUF_BEGV (XBUFFER (w->contents)),
+ BUF_BEGV_BYTE (XBUFFER (w->contents)));
/* Nil means don't try to resize. */
if ((NILP (Vresize_mini_windows)
@@ -11807,27 +11849,32 @@ resize_mini_window (struct window *w, bool exact_p)
if (height > max_height)
{
height = (max_height / unit) * unit;
- init_iterator (&it, w, ZV, ZV_BYTE, NULL, DEFAULT_FACE_ID);
- move_it_vertically_backward (&it, height - unit);
- /* The following move is usually a no-op when the stuff
- displayed in the mini-window comes entirely from buffer
- text, but it is needed when some of it comes from overlay
- strings, especially when there's an after-string at ZV.
- This happens with some completion packages, like
- icomplete, ido-vertical, etc. With those packages, if we
- don't force w->start to be at the beginning of a screen
- line, important parts of the stuff in the mini-window,
- such as user prompt, will be hidden from view. */
- move_it_by_lines (&it, 0);
- start = it.current.pos;
- /* Prevent redisplay_window from recentering, and thus from
- overriding the window-start point we computed here. */
- w->start_at_line_beg = false;
+ if (redisplay_adhoc_scroll_in_resize_mini_windows)
+ {
+ init_iterator (&it, w, ZV, ZV_BYTE, NULL, DEFAULT_FACE_ID);
+ move_it_vertically_backward (&it, height - unit);
+ /* The following move is usually a no-op when the stuff
+ displayed in the mini-window comes entirely from buffer
+ text, but it is needed when some of it comes from overlay
+ strings, especially when there's an after-string at ZV.
+ This happens with some completion packages, like
+ icomplete, ido-vertical, etc. With those packages, if we
+ don't force w->start to be at the beginning of a screen
+ line, important parts of the stuff in the mini-window,
+ such as user prompt, will be hidden from view. */
+ move_it_by_lines (&it, 0);
+ start = it.current.pos;
+ /* Prevent redisplay_window from recentering, and thus from
+ overriding the window-start point we computed here. */
+ w->start_at_line_beg = false;
+ SET_MARKER_FROM_TEXT_POS (w->start, start);
+ }
}
else
- SET_TEXT_POS (start, BEGV, BEGV_BYTE);
-
- SET_MARKER_FROM_TEXT_POS (w->start, start);
+ {
+ SET_TEXT_POS (start, BEGV, BEGV_BYTE);
+ SET_MARKER_FROM_TEXT_POS (w->start, start);
+ }
if (EQ (Vresize_mini_windows, Qgrow_only))
{
@@ -11920,8 +11967,8 @@ pop_message_unwind (void)
/* Check that Vmessage_stack is nil. Called from emacs.c when Emacs
- exits. If the stack is not empty, we have a missing pop_message
- somewhere. */
+ exits. If the stack is not empty, we have a missing
+ pop_message_unwind somewhere. */
void
check_message_stack (void)
@@ -11930,6 +11977,11 @@ check_message_stack (void)
emacs_abort ();
}
+void
+clear_message_stack (void)
+{
+ Vmessage_stack = Qnil;
+}
/* Truncate to NCHARS what will be displayed in the echo area the next
time we display it---but don't redisplay it now. */
@@ -18820,6 +18872,10 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
/* Try to scroll by specified few lines. */
if ((0 < scroll_conservatively
+ /* FIXME: the option is supposed to affect minibuffers, but we
+ test MINI_WINDOW_P, which can also catch uses of
+ mini-windows for displaying the echo area. Do we need to
+ distinguish these two use cases? */
|| (scroll_minibuffer_conservatively && MINI_WINDOW_P (w))
|| 0 < emacs_scroll_step
|| temp_scroll_step
@@ -20766,9 +20822,8 @@ try_window_id (struct window *w)
+ window_wants_header_line (w)
+ window_internal_height (w));
-#if defined (HAVE_GPM) || defined (MSDOS)
gui_clear_window_mouse_face (w);
-#endif
+
/* Perform the operation on the screen. */
if (dvpos > 0)
{
@@ -22261,14 +22316,15 @@ extend_face_to_end_of_line (struct it *it)
default_face->id : face->id);
/* Display fill-column indicator if needed. */
- /* We need to subtract 1 to the indicator_column here because we
- will add the indicator IN the column indicator number, not
- after it. We compare the variable it->current_x before
- producing the glyph. When FRAME_WINDOW_P we subtract
- CHAR_WIDTH calculating STRETCH_WIDTH for the same reason. */
- const int indicator_column =
- fill_column_indicator_column (it, 1) - 1;
- do
+ const int indicator_column = fill_column_indicator_column (it, 1);
+
+ /* Make sure our idea of current_x is in sync with the glyphs
+ actually in the glyph row. They might differ because
+ append_space_for_newline can insert one glyph without
+ updating current_x. */
+ it->current_x = it->glyph_row->used[TEXT_AREA];
+
+ while (it->current_x <= it->last_visible_x)
{
if (it->current_x != indicator_column)
PRODUCE_GLYPHS (it);
@@ -22286,7 +22342,6 @@ extend_face_to_end_of_line (struct it *it)
it->c = it->char_to_display = ' ';
}
}
- while (it->current_x <= it->last_visible_x);
if (WINDOW_RIGHT_MARGIN_WIDTH (it->w) > 0
&& (it->glyph_row->used[RIGHT_MARGIN_AREA]
@@ -25400,14 +25455,62 @@ display_mode_line (struct window *w, enum face_id face_id, Lisp_Object format)
format_mode_line_unwind_data (NULL, NULL,
Qnil, false));
- mode_line_target = MODE_LINE_DISPLAY;
-
/* Temporarily make frame's keyboard the current kboard so that
kboard-local variables in the mode_line_format will get the right
values. */
push_kboard (FRAME_KBOARD (it.f));
record_unwind_save_match_data ();
- display_mode_element (&it, 0, 0, 0, format, Qnil, false);
+
+ if (NILP (Vmode_line_compact))
+ {
+ mode_line_target = MODE_LINE_DISPLAY;
+ display_mode_element (&it, 0, 0, 0, format, Qnil, false);
+ }
+ else
+ {
+ Lisp_Object mode_string = Fformat_mode_line (format, Qnil, Qnil, Qnil);
+ if (EQ (Vmode_line_compact, Qlong)
+ && WINDOW_TOTAL_COLS (w) >= SCHARS (mode_string))
+ {
+ /* The window is wide enough; just display the mode line we
+ just computed. */
+ display_string (NULL, mode_string, Qnil,
+ 0, 0, &it, 0, 0, 0,
+ STRING_MULTIBYTE (mode_string));
+ }
+ else
+ {
+ /* Compress the mode line. */
+ ptrdiff_t i = 0, i_byte = 0, start = 0;
+ int prev = 0;
+
+ while (i < SCHARS (mode_string))
+ {
+ int c = fetch_string_char_advance (mode_string, &i, &i_byte);
+ if (c == ' ' && prev == ' ')
+ {
+ display_string (NULL,
+ Fsubstring (mode_string, make_fixnum (start),
+ make_fixnum (i - 1)),
+ Qnil, 0, 0, &it, 0, 0, 0,
+ STRING_MULTIBYTE (mode_string));
+ /* Skip past the rest of the space characters. */
+ while (c == ' ' && i < SCHARS (mode_string))
+ c = fetch_string_char_advance (mode_string, &i, &i_byte);
+ start = i - 1;
+ }
+ prev = c;
+ }
+
+ /* Display the final bit. */
+ if (start < i)
+ display_string (NULL,
+ Fsubstring (mode_string, make_fixnum (start),
+ make_fixnum (i)),
+ Qnil, 0, 0, &it, 0, 0, 0,
+ STRING_MULTIBYTE (mode_string));
+ }
+ }
pop_kboard ();
unbind_to (count, Qnil);
@@ -27039,6 +27142,7 @@ display_string (const char *string, Lisp_Object lisp_string, Lisp_Object face_st
with index START. */
reseat_to_string (it, NILP (lisp_string) ? string : NULL, lisp_string,
start, precision, field_width, multibyte);
+
if (string && STRINGP (lisp_string))
/* LISP_STRING is the one returned by decode_mode_spec. We should
ignore its text properties. */
@@ -27065,7 +27169,7 @@ display_string (const char *string, Lisp_Object lisp_string, Lisp_Object face_st
else
max_x = min (max_x, it->last_visible_x);
- /* Skip over display elements that are not visible. because IT->w is
+ /* Skip over display elements that are not visible because IT->w is
hscrolled. */
if (it->current_x < it->first_visible_x)
move_it_in_display_line_to (it, 100000, it->first_visible_x,
@@ -31224,7 +31328,9 @@ get_window_cursor_type (struct window *w, struct glyph *glyph, int *width,
{
*active_cursor = false;
- if (MINI_WINDOW_P (w) && minibuf_level == 0)
+ if (MINI_WINDOW_P (w) &&
+ (minibuf_level == 0
+ || is_minibuffer (0, w->contents)))
return NO_CURSOR;
non_selected = true;
@@ -34752,6 +34858,14 @@ wide as that tab on the display. */);
The face used for trailing whitespace is `trailing-whitespace'. */);
Vshow_trailing_whitespace = Qnil;
+ DEFVAR_LISP ("mode-line-compact", Vmode_line_compact,
+ doc: /* Non-nil means that mode lines should be compact.
+This means that repeating spaces will be replaced with a single space.
+If this variable is `long', only mode lines that are wider than the
+currently selected window are compressed. */);
+ Vmode_line_compact = Qnil;
+ DEFSYM (Qlong, "long");
+
DEFVAR_LISP ("nobreak-char-display", Vnobreak_char_display,
doc: /* Control highlighting of non-ASCII space and hyphen chars.
If the value is t, Emacs highlights non-ASCII chars which have the
@@ -35470,7 +35584,7 @@ message displayed by its counterpart function specified by
DEFVAR_BOOL ("display-raw-bytes-as-hex", display_raw_bytes_as_hex,
doc: /* Non-nil means display raw bytes in hexadecimal format.
-The default is to use octal format (\200) whereas hexadecimal (\x80)
+The default is to use octal format (\\200) whereas hexadecimal (\\x80)
may be more familiar to users. */);
display_raw_bytes_as_hex = false;
@@ -35486,6 +35600,27 @@ The initial frame is not displayed anywhere, so skipping it is
best except in special circumstances such as running redisplay tests
in batch mode. */);
redisplay_skip_initial_frame = true;
+
+ DEFVAR_BOOL ("redisplay-skip-fontification-on-input",
+ redisplay_skip_fontification_on_input,
+ doc: /* Skip `fontification_functions` when there is input pending.
+If non-nil and there was input pending at the beginning of the command,
+the `fontification_functions` hook is not run. This usually does not
+affect the display because redisplay is completely skipped anyway if input
+was pending, but it can make scrolling smoother by avoiding
+unnecessary fontification.
+It is similar to `fast-but-imprecise-scrolling' with similar tradeoffs,
+but with the advantage that it should only affect the behavior when Emacs
+has trouble keeping up with the incoming input rate. */);
+ redisplay_skip_fontification_on_input = false;
+
+ DEFVAR_BOOL ("redisplay-adhoc-scroll-in-resize-mini-windows",
+ redisplay_adhoc_scroll_in_resize_mini_windows,
+ doc: /* If nil always use normal scrolling in minibuffer windows.
+Otherwise, use custom-tailored code after resizing minibuffer windows to try
+and display the most important part of the minibuffer. */);
+ /* See bug#43519 for some discussion around this. */
+ redisplay_adhoc_scroll_in_resize_mini_windows = true;
}
diff --git a/src/xfaces.c b/src/xfaces.c
index 73a536b19c6..258b365eda3 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -1,6 +1,6 @@
/* xfaces.c -- "Face" primitives.
-Copyright (C) 1993-1994, 1998-2020 Free Software Foundation, Inc.
+Copyright (C) 1993-1994, 1998-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -3293,7 +3293,8 @@ FRAME 0 means change the face on all frames, and change the default
}
else if (EQ (k, QCstyle))
{
- if (!EQ (v, Qpressed_button) && !EQ (v, Qreleased_button))
+ if (!EQ (v, Qpressed_button) && !EQ (v, Qreleased_button)
+ && !EQ(v, Qflat_button))
break;
}
else
@@ -6031,6 +6032,10 @@ realize_gui_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE]
face->box = FACE_RAISED_BOX;
else if (EQ (value, Qpressed_button))
face->box = FACE_SUNKEN_BOX;
+ else if (EQ (value, Qflat_button)) {
+ face->box = FACE_SIMPLE_BOX;
+ face->box_color = face->background;
+ }
}
}
}
@@ -6919,6 +6924,7 @@ syms_of_xfaces (void)
DEFSYM (Qwave, "wave");
DEFSYM (Qreleased_button, "released-button");
DEFSYM (Qpressed_button, "pressed-button");
+ DEFSYM (Qflat_button, "flat-button");
DEFSYM (Qnormal, "normal");
DEFSYM (Qextra_light, "extra-light");
DEFSYM (Qlight, "light");
diff --git a/src/xfns.c b/src/xfns.c
index 46e4bd73a6b..9ab537ca8d9 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -1,6 +1,6 @@
/* Functions for the X Window System.
-Copyright (C) 1989, 1992-2020 Free Software Foundation, Inc.
+Copyright (C) 1989, 1992-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -2321,24 +2321,6 @@ hack_wm_protocols (struct frame *f, Widget widget)
static XFontSet xic_create_xfontset (struct frame *);
static XIMStyle best_xim_style (XIMStyles *);
-
-/* Supported XIM styles, ordered by preference. */
-
-static const XIMStyle supported_xim_styles[] =
-{
- XIMPreeditPosition | XIMStatusArea,
- XIMPreeditPosition | XIMStatusNothing,
- XIMPreeditPosition | XIMStatusNone,
- XIMPreeditNothing | XIMStatusArea,
- XIMPreeditNothing | XIMStatusNothing,
- XIMPreeditNothing | XIMStatusNone,
- XIMPreeditNone | XIMStatusArea,
- XIMPreeditNone | XIMStatusNothing,
- XIMPreeditNone | XIMStatusNone,
- 0,
-};
-
-
#if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT
/* Create an X fontset on frame F with base font name BASE_FONTNAME. */
@@ -2622,15 +2604,8 @@ xic_free_xfontset (struct frame *f)
static XIMStyle
best_xim_style (XIMStyles *xim)
{
- int i, j;
- int nr_supported = ARRAYELTS (supported_xim_styles);
-
- for (i = 0; i < nr_supported; ++i)
- for (j = 0; j < xim->count_styles; ++j)
- if (supported_xim_styles[i] == xim->supported_styles[j])
- return supported_xim_styles[i];
-
- /* Return the default style. */
+ /* Return the default style. This is what GTK3 uses and
+ should work fine with all modern input methods. */
return XIMPreeditNothing | XIMStatusNothing;
}
@@ -7041,7 +7016,7 @@ Text larger than the specified size is clipped. */)
tip_f = XFRAME (tip_frame);
window = FRAME_ROOT_WINDOW (tip_f);
- tip_buf = Fget_buffer_create (tip);
+ tip_buf = Fget_buffer_create (tip, Qnil);
/* We will mark the tip window a "pseudo-window" below, and such
windows cannot have display margins. */
bset_left_margin_cols (XBUFFER (tip_buf), make_fixnum (0));
diff --git a/src/xfont.c b/src/xfont.c
index 32f63c3f7ce..0570ee96a90 100644
--- a/src/xfont.c
+++ b/src/xfont.c
@@ -1,5 +1,5 @@
/* xfont.c -- X core font driver.
- Copyright (C) 2006-2020 Free Software Foundation, Inc.
+ Copyright (C) 2006-2021 Free Software Foundation, Inc.
Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H13PRO009
diff --git a/src/xftfont.c b/src/xftfont.c
index eb60d219a72..f7349316366 100644
--- a/src/xftfont.c
+++ b/src/xftfont.c
@@ -1,5 +1,5 @@
/* xftfont.c -- XFT font driver.
- Copyright (C) 2006-2020 Free Software Foundation, Inc.
+ Copyright (C) 2006-2021 Free Software Foundation, Inc.
Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H13PRO009
diff --git a/src/xgselect.c b/src/xgselect.c
index be70107b756..0d91d55bad6 100644
--- a/src/xgselect.c
+++ b/src/xgselect.c
@@ -1,6 +1,6 @@
/* Function for handling the GLib event loop.
-Copyright (C) 2009-2020 Free Software Foundation, Inc.
+Copyright (C) 2009-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/xgselect.h b/src/xgselect.h
index 512bf3ad85f..2142a236b23 100644
--- a/src/xgselect.h
+++ b/src/xgselect.h
@@ -1,6 +1,6 @@
/* Header for xg_select.
-Copyright (C) 2009-2020 Free Software Foundation, Inc.
+Copyright (C) 2009-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/xmenu.c b/src/xmenu.c
index dba7e88f486..ea3813a64e2 100644
--- a/src/xmenu.c
+++ b/src/xmenu.c
@@ -1,6 +1,6 @@
/* X Communication module for terminals which understand the X protocol.
-Copyright (C) 1986, 1988, 1993-1994, 1996, 1999-2020 Free Software
+Copyright (C) 1986, 1988, 1993-1994, 1996, 1999-2021 Free Software
Foundation, Inc.
Author: Jon Arnold
diff --git a/src/xml.c b/src/xml.c
index d7da86404f6..495988ab232 100644
--- a/src/xml.c
+++ b/src/xml.c
@@ -1,5 +1,5 @@
/* Interface to libxml2.
- Copyright (C) 2010-2020 Free Software Foundation, Inc.
+ Copyright (C) 2010-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/xrdb.c b/src/xrdb.c
index 3d7f715c88f..7d84762978f 100644
--- a/src/xrdb.c
+++ b/src/xrdb.c
@@ -1,5 +1,5 @@
/* Deal with the X Resource Manager.
- Copyright (C) 1990, 1993-1994, 2000-2020 Free Software Foundation,
+ Copyright (C) 1990, 1993-1994, 2000-2021 Free Software Foundation,
Inc.
Author: Joseph Arceneaux
diff --git a/src/xselect.c b/src/xselect.c
index 383aebf96c8..030f6240712 100644
--- a/src/xselect.c
+++ b/src/xselect.c
@@ -1,5 +1,5 @@
/* X Selection processing for Emacs.
- Copyright (C) 1993-1997, 2000-2020 Free Software Foundation, Inc.
+ Copyright (C) 1993-1997, 2000-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/xsettings.c b/src/xsettings.c
index 1ba1021e40b..58dfd43ad18 100644
--- a/src/xsettings.c
+++ b/src/xsettings.c
@@ -1,6 +1,6 @@
/* Functions for handling font and other changes dynamically.
-Copyright (C) 2009-2020 Free Software Foundation, Inc.
+Copyright (C) 2009-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/xsettings.h b/src/xsettings.h
index f29ce77c7f0..26717fc08cb 100644
--- a/src/xsettings.h
+++ b/src/xsettings.h
@@ -1,6 +1,6 @@
/* Functions for handle font changes dynamically.
-Copyright (C) 2009-2020 Free Software Foundation, Inc.
+Copyright (C) 2009-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/xsmfns.c b/src/xsmfns.c
index 203085e24f1..10565a4b25f 100644
--- a/src/xsmfns.c
+++ b/src/xsmfns.c
@@ -1,7 +1,7 @@
/* Session management module for systems which understand the X Session
management protocol.
-Copyright (C) 2002-2020 Free Software Foundation, Inc.
+Copyright (C) 2002-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/src/xterm.c b/src/xterm.c
index 98bb0ea8917..b8374fed8b1 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -1,6 +1,6 @@
/* X Communication module for terminals which understand the X protocol.
-Copyright (C) 1989, 1993-2020 Free Software Foundation, Inc.
+Copyright (C) 1989, 1993-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -8383,10 +8383,6 @@ handle_one_xevent (struct x_display_info *dpyinfo,
inev.ie.kind = DEICONIFY_EVENT;
XSETFRAME (inev.ie.frame_or_window, f);
}
- else if (! NILP (Vframe_list) && ! NILP (XCDR (Vframe_list)))
- /* Force a redisplay sooner or later to update the
- frame titles in case this is the second frame. */
- record_asynch_buffer_change ();
}
goto OTHER;
@@ -8951,7 +8947,9 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (!f
&& (f = any)
&& configureEvent.xconfigure.window == FRAME_X_WINDOW (f)
- && FRAME_VISIBLE_P(f))
+ && (FRAME_VISIBLE_P(f)
+ || !(configureEvent.xconfigure.width <= 1
+ && configureEvent.xconfigure.height <= 1)))
{
block_input ();
if (FRAME_X_DOUBLE_BUFFERED_P (f))
@@ -8966,7 +8964,10 @@ handle_one_xevent (struct x_display_info *dpyinfo,
f = 0;
}
#endif
- if (f && FRAME_VISIBLE_P(f))
+ if (f
+ && (FRAME_VISIBLE_P(f)
+ || !(configureEvent.xconfigure.width <= 1
+ && configureEvent.xconfigure.height <= 1)))
{
#ifdef USE_GTK
/* For GTK+ don't call x_net_wm_state for the scroll bar
@@ -9705,7 +9706,7 @@ x_draw_window_cursor (struct window *w, struct glyph_row *glyph_row, int x,
#ifdef HAVE_X_I18N
if (w == XWINDOW (f->selected_window))
- if (FRAME_XIC (f) && (FRAME_XIC_STYLE (f) & XIMPreeditPosition))
+ if (FRAME_XIC (f))
xic_set_preeditarea (w, x, y);
#endif
}
@@ -10388,11 +10389,8 @@ xim_instantiate_callback (Display *display, XPointer client_data, XPointer call_
create_frame_xic (f);
if (FRAME_XIC_STYLE (f) & XIMStatusArea)
xic_set_statusarea (f);
- if (FRAME_XIC_STYLE (f) & XIMPreeditPosition)
- {
- struct window *w = XWINDOW (f->selected_window);
- xic_set_preeditarea (w, w->cursor.x, w->cursor.y);
- }
+ struct window *w = XWINDOW (f->selected_window);
+ xic_set_preeditarea (w, w->cursor.x, w->cursor.y);
}
}
@@ -12928,20 +12926,24 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
#endif
Lisp_Object system_name = Fsystem_name ();
-
- ptrdiff_t nbytes = SBYTES (Vinvocation_name) + 1;
- if (STRINGP (system_name)
- && INT_ADD_WRAPV (nbytes, SBYTES (system_name) + 1, &nbytes))
- memory_full (SIZE_MAX);
- dpyinfo->x_id = ++x_display_id;
- dpyinfo->x_id_name = xmalloc (nbytes);
- char *nametail = lispstpcpy (dpyinfo->x_id_name, Vinvocation_name);
+ static char const title[] = "GNU Emacs";
if (STRINGP (system_name))
{
- *nametail++ = '@';
- lispstpcpy (nametail, system_name);
+ static char const at[] = " at ";
+ ptrdiff_t nbytes = sizeof (title) + sizeof (at);
+ if (INT_ADD_WRAPV (nbytes, SBYTES (system_name), &nbytes))
+ memory_full (SIZE_MAX);
+ dpyinfo->x_id_name = xmalloc (nbytes);
+ sprintf (dpyinfo->x_id_name, "%s%s%s", title, at, SDATA (system_name));
+ }
+ else
+ {
+ dpyinfo->x_id_name = xmalloc (sizeof (title));
+ strcpy (dpyinfo->x_id_name, title);
}
+ dpyinfo->x_id = ++x_display_id;
+
/* Figure out which modifier bits mean what. */
x_find_modifier_meanings (dpyinfo);
@@ -13033,13 +13035,13 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
or larger than other for other applications, even if it is the same
font name (monospace-10 for example). */
+# ifdef HAVE_XRENDER
int event_base, error_base;
- char *v;
- double d;
-
XRenderQueryExtension (dpyinfo->display, &event_base, &error_base);
+# endif
- v = XGetDefault (dpyinfo->display, "Xft", "dpi");
+ char *v = XGetDefault (dpyinfo->display, "Xft", "dpi");
+ double d;
if (v != NULL && sscanf (v, "%lf", &d) == 1)
dpyinfo->resy = dpyinfo->resx = d;
}
diff --git a/src/xterm.h b/src/xterm.h
index 0f8ba5e82b4..ebc42b7dd55 100644
--- a/src/xterm.h
+++ b/src/xterm.h
@@ -1,5 +1,5 @@
/* Definitions and headers for communication with X protocol.
- Copyright (C) 1989, 1993-1994, 1998-2020 Free Software Foundation,
+ Copyright (C) 1989, 1993-1994, 1998-2021 Free Software Foundation,
Inc.
This file is part of GNU Emacs.
diff --git a/src/xwidget.c b/src/xwidget.c
index 031975fafb9..e4b42e6e0c6 100644
--- a/src/xwidget.c
+++ b/src/xwidget.c
@@ -1,6 +1,6 @@
/* Support for embedding graphical components in a buffer.
-Copyright (C) 2011-2020 Free Software Foundation, Inc.
+Copyright (C) 2011-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -100,7 +100,8 @@ Returns the newly constructed xwidget, or nil if construction fails. */)
Lisp_Object val;
xw->type = type;
xw->title = title;
- xw->buffer = NILP (buffer) ? Fcurrent_buffer () : Fget_buffer_create (buffer);
+ xw->buffer = (NILP (buffer) ? Fcurrent_buffer ()
+ : Fget_buffer_create (buffer, Qnil));
xw->height = XFIXNAT (height);
xw->width = XFIXNAT (width);
xw->kill_without_query = false;
@@ -128,6 +129,16 @@ Returns the newly constructed xwidget, or nil if construction fails. */)
if (EQ (xw->type, Qwebkit))
{
xw->widget_osr = webkit_web_view_new ();
+
+ /* webkitgtk uses GSubprocess which sets sigaction causing
+ Emacs to not catch SIGCHLD with its usual handle setup in
+ catch_child_signal(). This resets the SIGCHLD
+ sigaction. */
+ struct sigaction old_action;
+ sigaction (SIGCHLD, NULL, &old_action);
+ webkit_web_view_load_uri(WEBKIT_WEB_VIEW (xw->widget_osr),
+ "about:blank");
+ sigaction (SIGCHLD, &old_action, NULL);
}
gtk_widget_set_size_request (GTK_WIDGET (xw->widget_osr), xw->width,
diff --git a/src/xwidget.h b/src/xwidget.h
index 40ad8ae8334..591f23489db 100644
--- a/src/xwidget.h
+++ b/src/xwidget.h
@@ -1,6 +1,6 @@
/* Support for embedding graphical components in a buffer.
-Copyright (C) 2011-2020 Free Software Foundation, Inc.
+Copyright (C) 2011-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/test/ChangeLog.1 b/test/ChangeLog.1
index 2bf014d0a95..7085b9ea10c 100644
--- a/test/ChangeLog.1
+++ b/test/ChangeLog.1
@@ -2952,7 +2952,7 @@
;; coding: utf-8
;; End:
- Copyright (C) 2008-2020 Free Software Foundation, Inc.
+ Copyright (C) 2008-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/test/Makefile.in b/test/Makefile.in
index 67d203df297..c5e86df3761 100644
--- a/test/Makefile.in
+++ b/test/Makefile.in
@@ -1,6 +1,6 @@
### @configure_input@
-# Copyright (C) 2010-2020 Free Software Foundation, Inc.
+# Copyright (C) 2010-2021 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
@@ -161,11 +161,15 @@ endif
## Save logs, and show logs for failed tests.
WRITE_LOG = > $@ 2>&1 || { STAT=$$?; cat $@; exit $$STAT; }
+## On Hydra or Emba, always show logs for certain problematic tests.
ifdef EMACS_HYDRA_CI
-## On Hydra, always show logs for certain problematic tests.
lisp/net/tramp-tests.log \
: WRITE_LOG = 2>&1 | tee $@
endif
+ifdef EMACS_EMBA_CI
+lisp/filenotify-tests.log lisp/net/tramp-tests.log \
+: WRITE_LOG = 2>&1 | tee $@
+endif
ifeq ($(TEST_LOAD_EL), yes)
testloadfile = $*.el
@@ -242,6 +246,18 @@ endef
$(foreach test,${TESTS},$(eval $(call test_template,${test})))
+## Get the tests for only a specific directory.
+SUBDIRS = $(sort $(shell find lib-src lisp src -type d ! -path "*resources*" -print))
+
+define subdir_template
+ .PHONY: check-$(subst /,-,$(1))
+ check-$(subst /,-,$(1)):
+ @${MAKE} check LOGFILES="$(patsubst %.el,%.log, \
+ $(patsubst $(srcdir)/%,%,$(wildcard $(1)/*.el)))"
+endef
+
+$(foreach subdir, $(SUBDIRS), $(eval $(call subdir_template,$(subdir))))
+
ifeq (@HAVE_MODULES@, yes)
# -fPIC is a no-op on Windows, but causes a compiler warning
ifeq ($(SO),.dll)
@@ -268,6 +284,7 @@ $(test_module): $(test_module:${SO}=.c) ../src/emacs-module.h
$(AM_V_CCLD)$(CC) -shared $(CPPFLAGS) $(MODULE_CFLAGS) $(LDFLAGS) \
-o $@ $< $(LIBGMP) \
$(and $(GMP_H),$(srcdir)/../lib/mini-gmp-gnulib.c) \
+ $(if $(OMIT_GNULIB_MODULE_free-posix),,$(srcdir)/../lib/free.c) \
$(srcdir)/../lib/timespec.c $(srcdir)/../lib/gettime.c
endif
@@ -307,10 +324,10 @@ check-doit:
ifeq ($(TEST_INTERACTIVE), yes)
HOME=$(TEST_HOME) $(emacs) \
-l ert ${ert_opts} \
- $(patsubst %,-l %,$(if $(findstring $(TEST_LOAD_EL),yes),$ELFILES,$(ELFILES:.el=))) \
+ $(patsubst %,-l %,$(if $(findstring $(TEST_LOAD_EL),yes),$ELFILES,$(ELFILES:.el=))) \
$(TEST_RUN_ERT)
else
- -@${MAKE} -k ${LOGFILES}
+ -@${MAKE} -k ${LOGFILES}
@$(emacs) --batch -l ert --eval \
"(ert-summarize-tests-batch-and-exit ${SUMMARIZE_TESTS})" ${LOGFILES}
endif
diff --git a/test/README b/test/README
index d0da89d1c2c..5f3c10adbe1 100644
--- a/test/README
+++ b/test/README
@@ -1,4 +1,4 @@
-Copyright (C) 2008-2020 Free Software Foundation, Inc.
+Copyright (C) 2008-2021 Free Software Foundation, Inc.
See the end of the file for license conditions.
This directory contains files intended to test various aspects of
@@ -39,6 +39,11 @@ The Makefile in this directory supports the following targets:
* make check-all
Like "make check", but run all tests.
+* make check-<dirname>
+ Like "make check", but run only the tests in test/<dirname>/*.el.
+ <dirname> is a relative directory path, which has replaced "/" by "-",
+ like in "check-src" or "check-lisp-net".
+
* make <filename> -or- make <filename>.log
Run all tests declared in <filename>.el. This includes expensive
tests. In the former case the output is shown on the terminal, in
@@ -55,7 +60,9 @@ https://www.gnu.org/software/emacs/manual/html_node/ert/Test-Selectors.html
You could use predefined selectors of the Makefile. "make <filename>
SELECTOR='$(SELECTOR_DEFAULT)'" runs all tests for <filename>.el
-except the tests tagged as expensive or unstable.
+except the tests tagged as expensive or unstable. Other predefined
+selectors are $(SELECTOR_EXPENSIVE) (run all tests except unstable
+ones) and $(SELECTOR_ALL) (run all tests).
If your test file contains the tests "test-foo", "test2-foo" and
"test-foo-remote", and you want to run only the former two tests, you
@@ -113,7 +120,8 @@ $EMACS_HYDRA_CI indicates the hydra environment, and $EMACS_EMBA_CI
indicates the emba environment, respectively.
-(Also, see etc/compilation.txt for compilation mode font lock tests.)
+(Also, see etc/compilation.txt for compilation mode font lock tests
+and etc/grep.txt for grep mode font lock tests.)
This file is part of GNU Emacs.
diff --git a/test/file-organization.org b/test/file-organization.org
index 64c0755b3bc..7cf5b88d6d0 100644
--- a/test/file-organization.org
+++ b/test/file-organization.org
@@ -17,13 +17,15 @@ Sub-directories are in many cases themed after packages (~gnus~, ~org~,
~calc~), related functionality (~net~, ~emacs-lisp~, ~progmodes~) or status
(~obsolete~).
-C source is stored in the ~src~ directory, which is flat.
+C source is stored in the ~src~ directory, which is flat. Source for
+utility programs is stored in the ~lib-src~ directory.
** Test Files
Automated tests should be stored in the ~test/lisp~ directory for
-tests of functionality implemented in Lisp, and in the ~test/src~
-directory for functionality implemented in C. Tests should reflect
+tests of functionality implemented in Lisp, in the ~test/src~
+directory for functionality implemented in C, and in the
+~test/lib-src~ directory for utility programs. Tests should reflect
the directory structure of the source tree; so tests for files in the
~lisp/emacs-lisp~ source directory should reside in the
~test/lisp/emacs-lisp~ directory.
@@ -36,10 +38,10 @@ files of any name which are themselves placed in a directory named
after the feature with ~-tests~ appended, such as
~/test/lisp/emacs-lisp/eieio-tests~
-Similarly, features implemented in C should reside in ~/test/src~ and
-be named after the C file with ~-tests.el~ added to the base-name of
-the tested source file. Thus, tests for ~src/fileio.c~ should be in
-~test/src/fileio-tests.el~.
+Similarly, tests of features implemented in C should reside in
+~/test/src~ or in ~test/lib-src~ and be named after the C file with
+~-tests.el~ added to the base-name of the tested source file. Thus,
+tests for ~src/fileio.c~ should be in ~test/src/fileio-tests.el~.
There are also some test materials that cannot be run automatically
(i.e. via ert). These should be placed in ~/test/manual~; they are
@@ -57,3 +59,8 @@ directory called ~test/lisp/progmodes/flymake-resources~.
No guidance is given for the organization of resource files inside the
~-resources~ directory; files can be organized at the author's
discretion.
+
+** Testing Infrastructure Files
+
+Files used to support testing infrastructure such as EMBA should be
+placed in ~infra~.
diff --git a/test/infra/Dockerfile.emba b/test/infra/Dockerfile.emba
new file mode 100644
index 00000000000..421264db9c9
--- /dev/null
+++ b/test/infra/Dockerfile.emba
@@ -0,0 +1,71 @@
+# 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/>.
+
+# GNU Emacs support for the GitLab-specific build of Docker images.
+
+# The presence of this file does not imply any FSF/GNU endorsement of
+# Docker or any other particular tool. Also, it is intended for
+# evaluation purposes, thus possibly temporary.
+
+# Maintainer: Ted Zlatanov <tzz@lifelogs.com>
+# URL: https://emba.gnu.org/emacs/emacs
+
+FROM debian:stretch as emacs-base
+
+RUN apt-get update && \
+ apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0 \
+ libc-dev gcc g++ make autoconf automake libncurses-dev gnutls-dev git \
+ && rm -rf /var/lib/apt/lists/*
+
+FROM emacs-base as emacs-inotify
+
+RUN apt-get update && \
+ apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0 inotify-tools \
+ && rm -rf /var/lib/apt/lists/*
+
+COPY . /checkout
+WORKDIR /checkout
+RUN ./autogen.sh autoconf
+RUN ./configure --without-makeinfo
+RUN make -j4 bootstrap
+RUN make -j4
+
+FROM emacs-base as emacs-filenotify-gio
+
+RUN apt-get update && \
+ apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0 libglib2.0-dev libglib2.0-bin libglib2.0-0 \
+ && rm -rf /var/lib/apt/lists/*
+
+COPY . /checkout
+WORKDIR /checkout
+RUN ./autogen.sh autoconf
+RUN ./configure --without-makeinfo --with-file-notification=gfile
+RUN make bootstrap
+RUN make -j4
+
+FROM emacs-base as emacs-gnustep
+
+RUN apt-get update && \
+ apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0 gnustep-devel \
+ && rm -rf /var/lib/apt/lists/*
+
+COPY . /checkout
+WORKDIR /checkout
+RUN ./autogen.sh autoconf
+RUN ./configure --without-makeinfo --with-ns
+RUN make bootstrap
+RUN make -j4
diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml
new file mode 100644
index 00000000000..ddabacfe010
--- /dev/null
+++ b/test/infra/gitlab-ci.yml
@@ -0,0 +1,243 @@
+# Copyright (C) 2017-2021 Free Software Foundation, Inc.
+#
+# This file is part of GNU Emacs.
+#
+# GNU Emacs is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (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/>.
+
+# GNU Emacs support for the GitLab protocol for CI
+
+# The presence of this file does not imply any FSF/GNU endorsement of
+# any particular service that uses that protocol. Also, it is intended for
+# evaluation purposes, thus possibly temporary.
+
+# Maintainer: Ted Zlatanov <tzz@lifelogs.com>
+# URL: https://emba.gnu.org/emacs/emacs
+
+# Never run merge request pipelines, they usually duplicate push pipelines
+# see https://docs.gitlab.com/ee/ci/yaml/README.html#common-if-clauses-for-rules
+
+# Rules: always run tags and branches named master*, emacs*, feature*, fix*
+# Test that it triggers by pushing a tag: `git tag mytag; git push origin mytag`
+# Test that it triggers by pushing to: feature/emba, feature1, master, master-2, fix/emba, emacs-299, fix-2
+# Test that it doesn't trigger by pushing to: scratch-2, scratch/emba, oldbranch, dev
+workflow:
+ rules:
+ - if: '$CI_PIPELINE_SOURCE == "merge_request_event"'
+ when: never
+ - if: '$CI_COMMIT_TAG'
+ when: always
+ - if: '$CI_COMMIT_BRANCH !~ /^(master|emacs|feature|fix)/'
+ when: never
+ - when: always
+
+variables:
+ GIT_STRATEGY: fetch
+ EMACS_EMBA_CI: 1
+ # # Use TLS https://docs.gitlab.com/ee/ci/docker/using_docker_build.html#tls-enabled
+ # DOCKER_HOST: tcp://docker:2376
+ # DOCKER_TLS_CERTDIR: "/certs"
+ # Put the configuration for each run in a separate directory to avoid conflicts
+ DOCKER_CONFIG: "/.docker-config-${CI_COMMIT_SHA}"
+ # We don't use ${CI_COMMIT_SHA} to be able to do one bootstrap across multiple builds
+ BUILD_TAG: ${CI_COMMIT_REF_SLUG}
+
+default:
+ image: docker:19.03.12
+ timeout: 3 hours
+ before_script:
+ - docker info
+ - echo "docker registry is ${CI_REGISTRY}"
+ - docker login -u ${CI_REGISTRY_USER} -p ${CI_REGISTRY_PASSWORD} ${CI_REGISTRY}
+
+.job-template:
+ rules:
+ - changes:
+ - "**/Makefile.in"
+ - .gitlab-ci.yml
+ - aclocal.m4
+ - autogen.sh
+ - configure.ac
+ - lib/*.{h,c}
+ - lisp/**/*.el
+ - src/*.{h,c}
+ - test/infra/*
+ - test/lisp/**/*.el
+ - test/src/*.el
+ - changes:
+ # gfilemonitor, kqueue
+ - src/gfilenotify.c
+ - src/kqueue.c
+ # MS Windows
+ - "**/w32*"
+ # GNUstep
+ - lisp/term/ns-win.el
+ - src/ns*.{h,m}
+ - src/macfont.{h,m}
+ when: never
+ # these will be cached across builds
+ cache:
+ key: ${CI_COMMIT_SHA}
+ paths: []
+ policy: pull-push
+ # these will be saved for followup builds
+ artifacts:
+ expire_in: 24 hrs
+ paths: []
+ # - "test/**/*.log"
+ # - "**/*.log"
+ # using the variables for each job
+ 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}
+
+.build-template:
+ rules:
+ - if: '$CI_PIPELINE_SOURCE == "web"'
+ when: always
+ - changes:
+ - "**/Makefile.in"
+ - .gitlab-ci.yml
+ - aclocal.m4
+ - autogen.sh
+ - configure.ac
+ - lib/*.{h,c}
+ - lisp/emacs-lisp/*.el
+ - src/*.{h,c}
+ - test/infra/*
+ - changes:
+ # gfilemonitor, kqueue
+ - src/gfilenotify.c
+ - src/kqueue.c
+ # MS Windows
+ - "**/w32*"
+ # GNUstep
+ - lisp/term/ns-win.el
+ - src/ns*.{h,m}
+ - src/macfont.{h,m}
+ when: never
+ script:
+ - docker build --pull --target ${target} -t ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} -f test/infra/Dockerfile.emba .
+ - docker push ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG}
+
+.gnustep-template:
+ rules:
+ - if: '$CI_PIPELINE_SOURCE == "web"'
+ - if: '$CI_PIPELINE_SOURCE == "schedule"'
+ changes:
+ - "**/Makefile.in"
+ - .gitlab-ci.yml
+ - configure.ac
+ - src/ns*.{h,m}
+ - src/macfont.{h,m}
+ - lisp/term/ns-win.el
+ - nextstep/**/*
+ - test/infra/*
+
+.filenotify-gio-template:
+ rules:
+ - if: '$CI_PIPELINE_SOURCE == "web"'
+ - if: '$CI_PIPELINE_SOURCE == "schedule"'
+ changes:
+ - "**/Makefile.in"
+ - .gitlab-ci.yml
+ - lisp/autorevert.el
+ - lisp/filenotify.el
+ - lisp/net/tramp-sh.el
+ - src/gfilenotify.c
+ - test/infra/*
+ - test/lisp/autorevert-tests.el
+ - test/lisp/filenotify-tests.el
+
+stages:
+ - prep-images
+ - build-images
+ - fast
+ - normal
+ - platform-images
+ - platforms
+ - slow
+
+prep-image-base:
+ stage: prep-images
+ extends: [.job-template, .build-template]
+ variables:
+ target: emacs-base
+
+build-image-inotify:
+ stage: build-images
+ extends: [.job-template, .build-template]
+ variables:
+ target: emacs-inotify
+
+test-fast-inotify:
+ stage: fast
+ extends: [.job-template]
+ variables:
+ target: emacs-inotify
+ make_params: "-C test check"
+
+build-image-filenotify-gio:
+ stage: platform-images
+ extends: [.job-template, .build-template, .filenotify-gio-template]
+ variables:
+ target: emacs-filenotify-gio
+
+build-image-gnustep:
+ stage: platform-images
+ extends: [.job-template, .build-template, .gnustep-template]
+ variables:
+ target: emacs-gnustep
+
+test-lisp-inotify:
+ stage: normal
+ extends: [.job-template]
+ variables:
+ target: emacs-inotify
+ make_params: "-C test check-lisp"
+
+test-lisp-net-inotify:
+ stage: normal
+ extends: [.job-template]
+ variables:
+ target: emacs-inotify
+ make_params: "-C test check-lisp-net"
+
+test-filenotify-gio:
+ # This tests file monitor libraries gfilemonitor and gio.
+ stage: platforms
+ extends: [.job-template, .filenotify-gio-template]
+ variables:
+ target: emacs-filenotify-gio
+ make_params: "-k -C test autorevert-tests filenotify-tests"
+
+test-gnustep:
+ # This tests the GNUstep build process
+ stage: platforms
+ extends: [.job-template, .gnustep-template]
+ variables:
+ target: emacs-gnustep
+ make_params: install
+
+test-all-inotify:
+ # This tests also file monitor libraries inotify and inotifywatch.
+ stage: slow
+ extends: [.job-template]
+ rules:
+ # note there's no "changes" section, so this always runs on a schedule
+ - if: '$CI_PIPELINE_SOURCE == "web"'
+ - if: '$CI_PIPELINE_SOURCE == "schedule"'
+ variables:
+ target: emacs-inotify
+ make_params: check-expensive
diff --git a/test/lib-src/emacsclient-tests.el b/test/lib-src/emacsclient-tests.el
index a502bb782f2..8bad9c04e00 100644
--- a/test/lib-src/emacsclient-tests.el
+++ b/test/lib-src/emacsclient-tests.el
@@ -1,6 +1,6 @@
;;; emacsclient-tests.el --- Test emacsclient -*- lexical-binding:t -*-
-;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2016-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/abbrev-tests.el b/test/lisp/abbrev-tests.el
index aaf1d4a5b5c..2a42d5636d3 100644
--- a/test/lisp/abbrev-tests.el
+++ b/test/lisp/abbrev-tests.el
@@ -1,6 +1,6 @@
;;; abbrev-tests.el --- Test suite for abbrevs -*- lexical-binding: t; -*-
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Author: Eli Zaretskii <eliz@gnu.org>
;; Keywords: abbrevs
@@ -69,8 +69,9 @@
(define-abbrev ert-test-abbrevs "sys" "system abbrev" nil :system t)
(should (equal (mapcar #'symbol-name (abbrev--table-symbols 'ert-test-abbrevs))
'("a-e-t")))
- (should (equal (mapcar #'symbol-name (abbrev--table-symbols 'ert-test-abbrevs t))
- '("a-e-t" "sys")))))
+ (let ((syms (abbrev--table-symbols 'ert-test-abbrevs t)))
+ (should (equal (sort (mapcar #'symbol-name syms) #'string<)
+ '("a-e-t" "sys"))))))
(ert-deftest abbrev-table-get-put-test ()
(let ((table (make-abbrev-table)))
diff --git a/test/lisp/align-resources/align-post.c b/test/lisp/align-resources/align-post.c
new file mode 100644
index 00000000000..157e1d6242a
--- /dev/null
+++ b/test/lisp/align-resources/align-post.c
@@ -0,0 +1,3 @@
+int
+main (int argc,
+ char *argv[]);
diff --git a/test/lisp/align-resources/align-post.java b/test/lisp/align-resources/align-post.java
new file mode 100644
index 00000000000..e0ea8e727f1
--- /dev/null
+++ b/test/lisp/align-resources/align-post.java
@@ -0,0 +1,9 @@
+class X
+{
+ String field1;
+ String[] field2;
+ int field3;
+ int[] field4;
+ X field5;
+ X[] field6;
+}
diff --git a/test/lisp/align-resources/align-pre.c b/test/lisp/align-resources/align-pre.c
new file mode 100644
index 00000000000..b1774181a40
--- /dev/null
+++ b/test/lisp/align-resources/align-pre.c
@@ -0,0 +1,3 @@
+int
+main (int argc,
+ char *argv[]);
diff --git a/test/lisp/align-resources/align-pre.java b/test/lisp/align-resources/align-pre.java
new file mode 100644
index 00000000000..fe7a87a9393
--- /dev/null
+++ b/test/lisp/align-resources/align-pre.java
@@ -0,0 +1,9 @@
+class X
+{
+ String field1;
+ String[] field2;
+ int field3;
+ int[] field4;
+ X field5;
+ X[] field6;
+}
diff --git a/test/lisp/align-tests.el b/test/lisp/align-tests.el
new file mode 100644
index 00000000000..a9c36e30e19
--- /dev/null
+++ b/test/lisp/align-tests.el
@@ -0,0 +1,47 @@
+;;; align-tests.el --- Test suite for aligns -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'ert-x)
+(require 'align)
+
+(defun test-align-compare (file function)
+ (should (equal
+ (with-temp-buffer
+ (insert-file-contents (ert-resource-file (format file "pre")))
+ (funcall function)
+ (align (point-min) (point-max))
+ (buffer-substring-no-properties (point-min) (point-max)))
+ (with-temp-buffer
+ (insert-file-contents (ert-resource-file (format file "post")))
+ (buffer-string)))))
+
+(ert-deftest align-java ()
+ (test-align-compare "align-%s.java" #'java-mode))
+
+(ert-deftest align-c ()
+ (test-align-compare "align-%s.c" #'c-mode))
+
+(provide 'align-tests)
+
+;;; align-tests.el ends here
diff --git a/test/lisp/allout-tests.el b/test/lisp/allout-tests.el
index f7cd6db9cd4..3a346fd1e2d 100644
--- a/test/lisp/allout-tests.el
+++ b/test/lisp/allout-tests.el
@@ -1,6 +1,6 @@
;;; allout-tests.el --- Tests for allout.el -*- lexical-binding: t -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -74,7 +74,7 @@
"Ensure that prior local value is resumed."
(with-temp-buffer
(allout-tests-obliterate-variable 'allout-tests-locally-true)
- (set (make-local-variable 'allout-tests-locally-true) t)
+ (setq-local allout-tests-locally-true t)
(cl-assert (not (default-boundp 'allout-tests-locally-true))
nil (concat "Test setup mistake -- variable supposed to"
" not have global binding, but it does."))
@@ -98,7 +98,7 @@
(allout-tests-obliterate-variable 'allout-tests-globally-true)
(setq allout-tests-globally-true t)
(allout-tests-obliterate-variable 'allout-tests-locally-true)
- (set (make-local-variable 'allout-tests-locally-true) t)
+ (setq-local allout-tests-locally-true t)
(allout-add-resumptions '(allout-tests-globally-unbound t)
'(allout-tests-globally-true nil)
'(allout-tests-locally-true nil))
@@ -135,7 +135,7 @@
(allout-tests-obliterate-variable 'allout-tests-globally-true)
(setq allout-tests-globally-true t)
(allout-tests-obliterate-variable 'allout-tests-locally-true)
- (set (make-local-variable 'allout-tests-locally-true) t)
+ (setq-local allout-tests-locally-true t)
(allout-add-resumptions '(allout-tests-globally-unbound t)
'(allout-tests-globally-true nil)
'(allout-tests-locally-true nil))
diff --git a/test/lisp/allout-widgets-tests.el b/test/lisp/allout-widgets-tests.el
index 2b1bcaa6de3..59ff6783697 100644
--- a/test/lisp/allout-widgets-tests.el
+++ b/test/lisp/allout-widgets-tests.el
@@ -1,6 +1,6 @@
;;; allout-widgets-tests.el --- Tests for allout-widgets.el -*- lexical-binding: t -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/ansi-color-tests.el b/test/lisp/ansi-color-tests.el
new file mode 100644
index 00000000000..107dc8e400b
--- /dev/null
+++ b/test/lisp/ansi-color-tests.el
@@ -0,0 +1,49 @@
+;;; ansi-color-tests.el --- Test suite for ansi-color -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
+
+;; Author: Pablo Barbáchano <pablob@amazon.com>
+;; Keywords: ansi
+
+;; 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 'ansi-color)
+
+(defvar test-strings '(("\e[33mHello World\e[0m" . "Hello World")
+ ("\e[1m\e[3m\e[5mbold italics blink\e[0m" . "bold italics blink")))
+
+(ert-deftest ansi-color-apply-on-region-test ()
+ (dolist (pair test-strings)
+ (with-temp-buffer
+ (insert (car pair))
+ (ansi-color-apply-on-region (point-min) (point-max))
+ (should (equal (buffer-string) (cdr pair)))
+ (should (not (equal (overlays-at (point-min)) nil))))))
+
+(ert-deftest ansi-color-apply-on-region-preserving-test ()
+ (dolist (pair test-strings)
+ (with-temp-buffer
+ (insert (car pair))
+ (ansi-color-apply-on-region (point-min) (point-max) t)
+ (should (equal (buffer-string) (car pair))))))
+
+(provide 'ansi-color-tests)
+
+;;; ansi-color-tests.el ends here
diff --git a/test/lisp/apropos-tests.el b/test/lisp/apropos-tests.el
index 4c5522d14c2..7eaa64207f1 100644
--- a/test/lisp/apropos-tests.el
+++ b/test/lisp/apropos-tests.el
@@ -1,6 +1,6 @@
;;; apropos-tests.el --- Tests for apropos.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; Author: Simen Heggestøyl <simenheg@gmail.com>
;; Keywords:
diff --git a/test/lisp/arc-mode-tests.el b/test/lisp/arc-mode-tests.el
index e92a4d28c6f..5c6af9b45cf 100644
--- a/test/lisp/arc-mode-tests.el
+++ b/test/lisp/arc-mode-tests.el
@@ -1,6 +1,6 @@
;;; arc-mode-tests.el --- Test suite for arc-mode. -*- lexical-binding: t -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el
index 677abb33cc9..bfbef53db97 100644
--- a/test/lisp/auth-source-pass-tests.el
+++ b/test/lisp/auth-source-pass-tests.el
@@ -1,6 +1,6 @@
;;; auth-source-pass-tests.el --- Tests for auth-source-pass.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2013, 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013, 2017-2021 Free Software Foundation, Inc.
;; Author: Damien Cassou <damien.cassou@gmail.com>
diff --git a/test/lisp/auth-source-tests.el b/test/lisp/auth-source-tests.el
index deb1b91aab2..4f0d9949af5 100644
--- a/test/lisp/auth-source-tests.el
+++ b/test/lisp/auth-source-tests.el
@@ -1,6 +1,6 @@
;;; auth-source-tests.el --- Tests for auth-source.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Author: Damien Cassou <damien@cassou.me>,
;; Nicolas Petton <nicolas@petton.fr>
diff --git a/test/lisp/autoinsert-tests.el b/test/lisp/autoinsert-tests.el
index eafa9c6c02c..7ec4bf63791 100644
--- a/test/lisp/autoinsert-tests.el
+++ b/test/lisp/autoinsert-tests.el
@@ -1,6 +1,6 @@
;;; autoinsert-tests.el --- Tests for autoinsert.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; Author: Simen Heggestøyl <simenheg@gmail.com>
;; Keywords:
diff --git a/test/lisp/autorevert-tests.el b/test/lisp/autorevert-tests.el
index 9ebf137f87c..6da515bb2c8 100644
--- a/test/lisp/autorevert-tests.el
+++ b/test/lisp/autorevert-tests.el
@@ -1,6 +1,6 @@
;;; auto-revert-tests.el --- Tests of auto-revert -*- lexical-binding: t -*-
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
@@ -132,7 +132,7 @@ This expects `auto-revert--messages' to be bound by
(null (string-match
(format-message
"Reverting buffer `%s'\\." (buffer-name buffer))
- auto-revert--messages)))
+ (or auto-revert--messages ""))))
(if (with-current-buffer buffer auto-revert-use-notify)
(read-event nil nil 0.05)
(sleep-for 0.05)))))
@@ -583,6 +583,89 @@ This expects `auto-revert--messages' to be bound by
(auto-revert--deftest-remote auto-revert-test06-write-file
"Test `write-file' in `auto-revert-mode' for remote buffers.")
+;; This is inspired by Bug#44638.
+(ert-deftest auto-revert-test07-auto-revert-several-buffers ()
+ "Check autorevert for several buffers visiting the same file."
+ ;; (with-auto-revert-test
+ (let ((auto-revert-use-notify t)
+ (tmpfile (make-temp-file "auto-revert-test"))
+ (times '(120 60 30 15))
+ (num-buffers 10)
+ require-final-newline buffers)
+
+ (unwind-protect
+ ;; Check indirect buffers.
+ (ert-with-message-capture auto-revert--messages
+ (auto-revert-tests--write-file "any text" tmpfile (pop times))
+ (push (find-file-noselect tmpfile) buffers)
+ (with-current-buffer (car buffers)
+ (should (string-equal (buffer-string) "any text"))
+ ;; `buffer-stale--default-function' checks for
+ ;; `verify-visited-file-modtime'. We must ensure that
+ ;; it returns nil.
+ (auto-revert-mode 1)
+ (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))
+ (dolist (buf buffers)
+ (with-current-buffer buf
+ (should (string-equal (buffer-string) "any text"))
+ (should auto-revert-mode)))
+
+ (auto-revert-tests--write-file "another text" tmpfile (pop times))
+ ;; Check, that the buffer has been reverted.
+ (auto-revert--wait-for-revert (car buffers))
+ (dolist (buf buffers)
+ (with-current-buffer buf
+ (should (string-equal (buffer-string) "another text")))))
+
+ ;; Exit.
+ (ignore-errors
+ (dolist (buf buffers)
+ (with-current-buffer buf (set-buffer-modified-p nil))
+ (kill-buffer buf)))
+ (setq buffers nil)
+ (ignore-errors (delete-file tmpfile)))
+
+ ;; Check direct buffers.
+ (unwind-protect
+ (ert-with-message-capture auto-revert--messages
+ (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))
+ (dolist (buf buffers)
+ (with-current-buffer buf
+ (insert-file-contents tmpfile 'visit)
+ (should (string-equal (buffer-string) "any text"))
+ (auto-revert-mode 1)
+ (should auto-revert-mode)))
+
+ (auto-revert-tests--write-file "another text" tmpfile (pop times))
+ ;; Check, that the buffers have been reverted.
+ (dolist (buf buffers)
+ (auto-revert--wait-for-revert buf)
+ (with-current-buffer buf
+ (should (string-equal (buffer-string) "another text")))))
+
+ ;; Exit.
+ (ignore-errors
+ (dolist (buf buffers)
+ (with-current-buffer buf (set-buffer-modified-p nil))
+ (kill-buffer buf)))
+ (ignore-errors (delete-file tmpfile)))));)
+
+(auto-revert--deftest-remote auto-revert-test07-auto-revert-several-buffers
+ "Check autorevert for several buffers visiting the same remote file.")
+
(defun auto-revert-test-all (&optional interactive)
"Run all tests for \\[auto-revert]."
(interactive "p")
diff --git a/test/lisp/battery-tests.el b/test/lisp/battery-tests.el
index 8d7cc7fccf3..e34d59102bc 100644
--- a/test/lisp/battery-tests.el
+++ b/test/lisp/battery-tests.el
@@ -1,6 +1,6 @@
;;; battery-tests.el --- tests for battery.el -*- lexical-binding: t -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/bookmark-tests.el b/test/lisp/bookmark-tests.el
index 6745e4c1d8a..9c33a27288a 100644
--- a/test/lisp/bookmark-tests.el
+++ b/test/lisp/bookmark-tests.el
@@ -1,6 +1,6 @@
;;; bookmark-tests.el --- Tests for bookmark.el -*- lexical-binding: t -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; Author: Stefan Kangas <stefankangas@gmail.com>
diff --git a/test/lisp/buff-menu-tests.el b/test/lisp/buff-menu-tests.el
index 7d7824bf9c4..18c988656d3 100644
--- a/test/lisp/buff-menu-tests.el
+++ b/test/lisp/buff-menu-tests.el
@@ -1,6 +1,6 @@
;;; buff-menu-tests.el --- Test suite for buff-menu.el -*- lexical-binding: t -*-
-;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2016-2021 Free Software Foundation, Inc.
;; Author: Tino Calancha <tino.calancha@gmail.com>
diff --git a/test/lisp/button-tests.el b/test/lisp/button-tests.el
index b463366c33b..e0944afa344 100644
--- a/test/lisp/button-tests.el
+++ b/test/lisp/button-tests.el
@@ -1,6 +1,6 @@
;;; button-tests.el --- tests for button.el -*- lexical-binding: t -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/calc/calc-tests.el b/test/lisp/calc/calc-tests.el
index b59f4dc988f..bdcf78e020a 100644
--- a/test/lisp/calc/calc-tests.el
+++ b/test/lisp/calc/calc-tests.el
@@ -1,6 +1,6 @@
;;; calc-tests.el --- tests for calc -*- lexical-binding: t; -*-
-;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2021 Free Software Foundation, Inc.
;; Author: Leo Liu <sdl.web@gmail.com>
;; Keywords: maint
diff --git a/test/lisp/calendar/cal-julian-tests.el b/test/lisp/calendar/cal-julian-tests.el
index 76118b3d7f5..db3a4909fa4 100644
--- a/test/lisp/calendar/cal-julian-tests.el
+++ b/test/lisp/calendar/cal-julian-tests.el
@@ -1,6 +1,6 @@
;;; cal-julian-tests.el --- tests for calendar/cal-julian.el -*- lexical-binding:t -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; Author: Stefan Kangas <stefankangas@gmail.com>
diff --git a/test/lisp/calendar/icalendar-tests.el b/test/lisp/calendar/icalendar-tests.el
index 8b44f639475..7993a1fd806 100644
--- a/test/lisp/calendar/icalendar-tests.el
+++ b/test/lisp/calendar/icalendar-tests.el
@@ -1,6 +1,6 @@
;; icalendar-tests.el --- Test suite for icalendar.el -*- lexical-binding:t -*-
-;; Copyright (C) 2005, 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2005, 2008-2021 Free Software Foundation, Inc.
;; Author: Ulf Jasper <ulf.jasper@web.de>
;; Created: March 2005
diff --git a/test/lisp/calendar/iso8601-tests.el b/test/lisp/calendar/iso8601-tests.el
index c835f5792b9..618e5b12386 100644
--- a/test/lisp/calendar/iso8601-tests.el
+++ b/test/lisp/calendar/iso8601-tests.el
@@ -1,6 +1,6 @@
;;; iso8601-tests.el --- tests for calendar/iso8601.el -*- lexical-binding:t -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/calendar/lunar-tests.el b/test/lisp/calendar/lunar-tests.el
index d2647aac03a..268dcfdb550 100644
--- a/test/lisp/calendar/lunar-tests.el
+++ b/test/lisp/calendar/lunar-tests.el
@@ -1,6 +1,6 @@
;;; lunar-tests.el --- tests for calendar/lunar.el -*- lexical-binding:t -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; Author: Stefan Kangas <stefankangas@gmail.com>
@@ -27,39 +27,37 @@
(defmacro with-lunar-test (&rest body)
`(let ((calendar-latitude 40.1)
(calendar-longitude -88.2)
- (calendar-location-name "Urbana, IL")
- (calendar-time-zone -360)
- (calendar-standard-time-zone-name "CST")
- (calendar-time-display-form '(12-hours ":" minutes am-pm)))
+ (calendar-location-name "Paris")
+ (calendar-time-zone 0)
+ (calendar-standard-time-zone-name "UTC")
+ ;; Make sure daylight saving is disabled to avoid interference
+ ;; from the system settings (see bug#45818).
+ (calendar-daylight-savings-starts nil)
+ (calendar-time-display-form '(24-hours ":" minutes)))
,@body))
(ert-deftest lunar-test-phase ()
(with-lunar-test
(should (equal (lunar-phase 1)
- '((1 7 1900) "11:40pm" 1 "")))))
+ '((1 8 1900) "05:40" 1 "")))))
(ert-deftest lunar-test-eclipse-check ()
(with-lunar-test
(should (equal (eclipse-check 1 1) "** Eclipse **"))))
-;; This fails in certain time zones.
-;; Eg TZ=America/Phoenix make lisp/calendar/lunar-tests
-;; Similarly with TZ=UTC.
-;; Daylight saving related?
(ert-deftest lunar-test-phase-list ()
- :tags '(:unstable)
(with-lunar-test
(should (equal (lunar-phase-list 3 1871)
- '(((3 20 1871) "11:03pm" 0 "")
- ((3 29 1871) "1:46am" 1 "** Eclipse **")
- ((4 5 1871) "9:20am" 2 "")
- ((4 12 1871) "12:57am" 3 "** Eclipse possible **")
- ((4 19 1871) "2:06pm" 0 "")
- ((4 27 1871) "6:49pm" 1 "")
- ((5 4 1871) "5:57pm" 2 "")
- ((5 11 1871) "9:29am" 3 "")
- ((5 19 1871) "5:46am" 0 "")
- ((5 27 1871) "8:02am" 1 ""))))))
+ '(((3 21 1871) "04:03" 0 "")
+ ((3 29 1871) "06:46" 1 "** Eclipse **")
+ ((4 5 1871) "14:20" 2 "")
+ ((4 12 1871) "05:57" 3 "** Eclipse possible **")
+ ((4 19 1871) "19:06" 0 "")
+ ((4 27 1871) "23:49" 1 "")
+ ((5 4 1871) "22:57" 2 "")
+ ((5 11 1871) "14:29" 3 "")
+ ((5 19 1871) "10:46" 0 "")
+ ((5 27 1871) "13:02" 1 ""))))))
(ert-deftest lunar-test-new-moon-time ()
(with-lunar-test
diff --git a/test/lisp/calendar/parse-time-tests.el b/test/lisp/calendar/parse-time-tests.el
index e1801a57307..b90fe0bd85b 100644
--- a/test/lisp/calendar/parse-time-tests.el
+++ b/test/lisp/calendar/parse-time-tests.el
@@ -1,6 +1,6 @@
;; parse-time-tests.el --- Test suite for parse-time.el -*- lexical-binding:t -*-
-;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2016-2021 Free Software Foundation, Inc.
;; Author: Lars Ingebrigtsen <larsi@gnus.org>
diff --git a/test/lisp/calendar/solar-tests.el b/test/lisp/calendar/solar-tests.el
index 441beafe71c..337deb8ce9a 100644
--- a/test/lisp/calendar/solar-tests.el
+++ b/test/lisp/calendar/solar-tests.el
@@ -1,6 +1,6 @@
;;; solar-tests.el --- tests for solar.el -*- lexical-binding: t -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -26,7 +26,9 @@
(calendar-longitude 75.8)
(calendar-time-zone +330)
(calendar-standard-time-zone-name "IST")
- (calendar-daylight-time-zone-name "IST")
+ ;; Make sure our clockwork isn't confused by daylight saving rules
+ ;; in effect for any other time zone (bug#45818).
+ (calendar-daylight-savings-starts nil)
(epsilon (/ 60.0))) ; Minute accuracy is good enough.
(let* ((sunrise-sunset (solar-sunrise-sunset '(12 30 2020)))
(sunrise (car (nth 0 sunrise-sunset)))
diff --git a/test/lisp/calendar/time-date-tests.el b/test/lisp/calendar/time-date-tests.el
index 76a5641f34d..4568947c0b3 100644
--- a/test/lisp/calendar/time-date-tests.el
+++ b/test/lisp/calendar/time-date-tests.el
@@ -1,6 +1,6 @@
;;; time-date-tests.el --- tests for calendar/time-date.el -*- lexical-binding:t -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/calendar/todo-mode-tests.el b/test/lisp/calendar/todo-mode-tests.el
index 6ed55121988..6fa2b9d7c35 100644
--- a/test/lisp/calendar/todo-mode-tests.el
+++ b/test/lisp/calendar/todo-mode-tests.el
@@ -1,6 +1,6 @@
;;; todo-mode-tests.el --- tests for todo-mode.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; Author: Stephen Berman <stephen.berman@gmx.net>
;; Keywords: calendar
diff --git a/test/lisp/cedet/semantic-utest-c.el b/test/lisp/cedet/semantic-utest-c.el
index c776a0fbaac..a7cbe116c2e 100644
--- a/test/lisp/cedet/semantic-utest-c.el
+++ b/test/lisp/cedet/semantic-utest-c.el
@@ -1,6 +1,6 @@
;;; semantic-utest-c.el --- C based parsing tests. -*- lexical-binding:t -*-
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/test/lisp/cedet/semantic-utest-fmt.el b/test/lisp/cedet/semantic-utest-fmt.el
index c2f2bb7226c..d6e5ce7a0fd 100644
--- a/test/lisp/cedet/semantic-utest-fmt.el
+++ b/test/lisp/cedet/semantic-utest-fmt.el
@@ -1,6 +1,6 @@
;;; cedet/semantic-utest-fmt.el --- Parsing / Formatting tests -*- lexical-binding:t -*-
-;;; Copyright (C) 2003-2004, 2007-2020 Free Software Foundation, Inc.
+;;; Copyright (C) 2003-2004, 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/test/lisp/cedet/semantic-utest-ia.el b/test/lisp/cedet/semantic-utest-ia.el
index c99ef97b509..7210f66b0a7 100644
--- a/test/lisp/cedet/semantic-utest-ia.el
+++ b/test/lisp/cedet/semantic-utest-ia.el
@@ -1,6 +1,6 @@
;;; semantic-utest-ia.el --- Analyzer unit tests -*- lexical-binding:t -*-
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -86,6 +86,7 @@
(should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-nsp.cpp ()
+ (skip-unless (executable-find "g++"))
(let ((tst (expand-file-name "testnsp.cpp" semantic-utest-test-directory)))
(should (file-exists-p tst))
(should-not (semantic-ia-utest tst))))
@@ -96,6 +97,7 @@
(should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-namespace.cpp ()
+ (skip-unless (executable-find "g++"))
(let ((tst (expand-file-name "testnsp.cpp" semantic-utest-test-directory)))
(should (file-exists-p tst))
(should-not (semantic-ia-utest tst))))
diff --git a/test/lisp/cedet/semantic-utest.el b/test/lisp/cedet/semantic-utest.el
index e537871528c..67de4a5b02d 100644
--- a/test/lisp/cedet/semantic-utest.el
+++ b/test/lisp/cedet/semantic-utest.el
@@ -1,6 +1,6 @@
;;; semantic-utest.el --- Tests for semantic's parsing system. -*- lexical-binding:t -*-
-;;; Copyright (C) 2003-2004, 2007-2020 Free Software Foundation, Inc.
+;;; Copyright (C) 2003-2004, 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -38,14 +38,9 @@
(defvar semantic-utest-test-directory (expand-file-name "tests" cedet-utest-directory)
"Location of test files.")
-(defvar semantic-utest-temp-directory (if (fboundp 'temp-directory)
- (temp-directory)
- temporary-file-directory)
- "Temporary directory to use when creating files.")
-
(defun semantic-utest-fname (name)
"Create a filename for NAME in /tmp."
- (expand-file-name name semantic-utest-temp-directory))
+ (expand-file-name name temporary-file-directory))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Data for C tests
@@ -582,10 +577,8 @@ INSERTME is the text to be inserted after the deletion."
(ert-deftest semantic-utest-Javascript()
- (if (fboundp 'javascript-mode)
- (semantic-utest-generic (semantic-utest-fname "javascripttest.js") semantic-utest-Javascript-buffer-contents semantic-utest-Javascript-name-contents '("fun2") "//1" "//deleted line")
- (message "Skipping JavaScript test: NO major mode."))
- )
+ (skip-unless (fboundp 'javascript-mode))
+ (semantic-utest-generic (semantic-utest-fname "javascripttest.js") semantic-utest-Javascript-buffer-contents semantic-utest-Javascript-name-contents '("fun2") "//1" "//deleted line"))
(ert-deftest semantic-utest-Java()
;; If JDE is installed, it might mess things up depending on the version
diff --git a/test/lisp/cedet/srecode-utest-getset.el b/test/lisp/cedet/srecode-utest-getset.el
index fc66ac4edf2..1c6578038c0 100644
--- a/test/lisp/cedet/srecode-utest-getset.el
+++ b/test/lisp/cedet/srecode-utest-getset.el
@@ -1,6 +1,6 @@
;;; srecode/test-getset.el --- Test the getset inserter. -*- lexical-binding:t -*-
-;; Copyright (C) 2008, 2009, 2011, 2019-2020 Free Software Foundation, Inc
+;; Copyright (C) 2008, 2009, 2011, 2019-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -128,7 +128,6 @@ private:
(srecode-utest-getset-jumptotag "miscFunction"))
(let ((pos (point)))
- (skip-chars-backward " \t\n") ; xemacs forward-comment is different.
(forward-comment -1)
(re-search-forward "miscFunction" pos))
diff --git a/test/lisp/cedet/srecode-utest-template.el b/test/lisp/cedet/srecode-utest-template.el
index 7c5bbc599a3..f97ff18320e 100644
--- a/test/lisp/cedet/srecode-utest-template.el
+++ b/test/lisp/cedet/srecode-utest-template.el
@@ -1,6 +1,6 @@
;;; srecode/test.el --- SRecode Core Template tests. -*- lexical-binding:t -*-
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -307,13 +307,9 @@ INSIDE SECTION: ARG HANDLER ONE")
(should (srecode-table major-mode))
;; Loop over the output testpoints.
-
(dolist (p srecode-utest-output-entries)
- (set-buffer testbuff) ;; XEmacs causes a buffer switch. I don't know why
- (should-not (srecode-utest-test p))
- )
+ (should-not (srecode-utest-test p)))))
- ))
(when (file-exists-p srecode-utest-testfile)
(delete-file srecode-utest-testfile)))
diff --git a/test/lisp/char-fold-tests.el b/test/lisp/char-fold-tests.el
index 599d9d614f9..063c893516f 100644
--- a/test/lisp/char-fold-tests.el
+++ b/test/lisp/char-fold-tests.el
@@ -1,6 +1,6 @@
;;; char-fold-tests.el --- Tests for char-fold.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
diff --git a/test/lisp/color-tests.el b/test/lisp/color-tests.el
index 3fb9bd5c097..2493476a66a 100644
--- a/test/lisp/color-tests.el
+++ b/test/lisp/color-tests.el
@@ -1,6 +1,6 @@
;;; color-tests.el --- Tests for color.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; Author: Simen Heggestøyl <simenheg@gmail.com>
;; Keywords:
diff --git a/test/lisp/comint-tests.el b/test/lisp/comint-tests.el
index 923f588e9e6..de1bc548e18 100644
--- a/test/lisp/comint-tests.el
+++ b/test/lisp/comint-tests.el
@@ -1,6 +1,6 @@
;;; comint-tests.el -*- lexical-binding:t -*-
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/completion-tests.el b/test/lisp/completion-tests.el
index 7473bbbb0c5..c13fb2e44b7 100644
--- a/test/lisp/completion-tests.el
+++ b/test/lisp/completion-tests.el
@@ -1,6 +1,6 @@
;;; completion-tests.el --- Tests for completion.el -*- lexical-binding: t -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/cus-edit-tests.el b/test/lisp/cus-edit-tests.el
new file mode 100644
index 00000000000..95f62e0d7ea
--- /dev/null
+++ b/test/lisp/cus-edit-tests.el
@@ -0,0 +1,80 @@
+;;; cus-edit-tests.el --- Tests for cus-edit.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'ert-x)
+(eval-when-compile (require 'cl-lib))
+(require 'cus-edit)
+
+(defmacro with-cus-edit-test (buffer &rest body)
+ (declare (indent 1))
+ `(save-window-excursion
+ (unwind-protect
+ (progn ,@body)
+ (when-let ((buf (get-buffer ,buffer)))
+ (kill-buffer buf)))))
+
+
+;;;; showing/hiding obsolete options
+
+(defgroup cus-edit-tests nil "test"
+ :group 'test-group)
+
+(defcustom cus-edit-tests--obsolete-option-tag nil
+ "This should never be removed; it is obsolete for testing purposes."
+ :type 'boolean
+ :version "917.10") ; a super high version number
+(make-obsolete-variable 'cus-edit-tests--obsolete-option-tag nil "X.X-test")
+(defconst cus-edit-tests--obsolete-option-tag
+ (custom-unlispify-tag-name 'cus-edit-tests--obsolete-option-tag))
+
+(ert-deftest cus-edit-tests-customize-apropos/hide-obsolete ()
+ (with-cus-edit-test "*Customize Apropos*"
+ (customize-apropos "cus-edit-tests")
+ (should-not (search-forward cus-edit-tests--obsolete-option-tag nil t))))
+
+(ert-deftest cus-edit-tests-customize-changed-options/hide-obsolete ()
+ (with-cus-edit-test "*Customize Changed Options*"
+ (customize-changed-options "917.2") ; some future version
+ (should-not (search-forward cus-edit-tests--obsolete-option-tag nil t))))
+
+(ert-deftest cus-edit-tests-customize-group/hide-obsolete ()
+ "Check that obsolete variables do not show up."
+ (with-cus-edit-test "*Customize Group: Cus Edit Tests*"
+ (customize-group 'cus-edit-tests)
+ (should-not (search-forward cus-edit-tests--obsolete-option-tag nil t))))
+
+(ert-deftest cus-edit-tests-customize-option/show-obsolete ()
+ (with-cus-edit-test "*Customize Option: Cus Edit Tests Obsolete Option Tag*"
+ (customize-option 'cus-edit-tests--obsolete-option-tag)
+ (goto-char (point-min))
+ (should (search-forward cus-edit-tests--obsolete-option-tag nil t))))
+
+(ert-deftest cus-edit-tests-customize-saved/show-obsolete ()
+ (with-cus-edit-test "*Customize Saved*"
+ (cl-letf (((get 'cus-edit-tests--obsolete-option-tag 'saved-value) '(t)))
+ (customize-saved)
+ (should (search-forward cus-edit-tests--obsolete-option-tag nil t)))))
+
+(provide 'cus-edit-tests)
+;;; cus-edit-tests.el ends here
diff --git a/test/lisp/custom-tests.el b/test/lisp/custom-tests.el
index a1451cf0ce6..10854c71d56 100644
--- a/test/lisp/custom-tests.el
+++ b/test/lisp/custom-tests.el
@@ -1,6 +1,6 @@
;;; custom-tests.el --- tests for custom.el -*- lexical-binding: t -*-
-;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2018-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -156,4 +156,51 @@
(load custom-test-admin-cus-test)
(should (null (cus-test-opts t))))
+(ert-deftest custom-test-enable-theme-keeps-settings ()
+ "Test that enabling a theme doesn't change its settings."
+ (let* ((custom-theme-load-path `(,(ert-resource-directory)))
+ settings)
+ (load-theme 'custom--test 'no-confirm 'no-enable)
+ (setq settings (get 'custom--test 'theme-settings))
+ (enable-theme 'custom--test)
+ (should (equal settings (get 'custom--test 'theme-settings)))))
+
+(defcustom custom--test-local-option 'initial
+ "Buffer-local user option for testing."
+ :group 'emacs
+ :type '(choice (const initial) (const changed))
+ :local t)
+
+(defcustom custom--test-permanent-option 'initial
+ "Permanently local user option for testing."
+ :group 'emacs
+ :type '(choice (const initial) (const changed))
+ :local 'permanent)
+
+(ert-deftest custom-test-local-option ()
+ "Test :local user options."
+ ;; Initial default values.
+ (should (eq custom--test-local-option 'initial))
+ (should (eq custom--test-permanent-option 'initial))
+ (should (eq (default-value 'custom--test-local-option) 'initial))
+ (should (eq (default-value 'custom--test-permanent-option) 'initial))
+ (let ((obuf (current-buffer)))
+ (with-temp-buffer
+ ;; Changed buffer-local values.
+ (setq custom--test-local-option 'changed)
+ (setq custom--test-permanent-option 'changed)
+ (should (eq custom--test-local-option 'changed))
+ (should (eq custom--test-permanent-option 'changed))
+ (should (eq (default-value 'custom--test-local-option) 'initial))
+ (should (eq (default-value 'custom--test-permanent-option) 'initial))
+ (with-current-buffer obuf
+ (should (eq custom--test-local-option 'initial))
+ (should (eq custom--test-permanent-option 'initial)))
+ ;; Permanent variable remains unchanged.
+ (kill-all-local-variables)
+ (should (eq custom--test-local-option 'initial))
+ (should (eq custom--test-permanent-option 'changed))
+ (should (eq (default-value 'custom--test-local-option) 'initial))
+ (should (eq (default-value 'custom--test-permanent-option) 'initial)))))
+
;;; custom-tests.el ends here
diff --git a/test/lisp/dabbrev-tests.el b/test/lisp/dabbrev-tests.el
index 06c5c0655a7..0b20dcf9213 100644
--- a/test/lisp/dabbrev-tests.el
+++ b/test/lisp/dabbrev-tests.el
@@ -1,6 +1,6 @@
;;; dabbrev-tests.el --- Test suite for dabbrev. -*- lexical-binding:t -*-
-;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2016-2021 Free Software Foundation, Inc.
;; Author: Alan Third <alan@idiocy.org>
;; Keywords: dabbrev
diff --git a/test/lisp/delim-col-tests.el b/test/lisp/delim-col-tests.el
index c46c0f78e9f..838fc92e826 100644
--- a/test/lisp/delim-col-tests.el
+++ b/test/lisp/delim-col-tests.el
@@ -1,6 +1,6 @@
;;; delim-col-tests.el --- Tests for delim-col.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; Author: Stefan Kangas <stefankangas@gmail.com>
diff --git a/test/lisp/descr-text-tests.el b/test/lisp/descr-text-tests.el
index b060dffb0ff..6ba455b50d4 100644
--- a/test/lisp/descr-text-tests.el
+++ b/test/lisp/descr-text-tests.el
@@ -1,6 +1,6 @@
;;; descr-text-test.el --- ERT tests for descr-text.el -*- lexical-binding: t -*-
-;; Copyright (C) 2014, 2016-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2014, 2016-2021 Free Software Foundation, Inc.
;; Author: Michal Nazarewicz <mina86@mina86.com>
diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el
index 6bb8ced1f30..7f1743f88d7 100644
--- a/test/lisp/dired-aux-tests.el
+++ b/test/lisp/dired-aux-tests.el
@@ -1,6 +1,6 @@
;;; dired-aux-tests.el --- Test suite for dired-aux. -*- lexical-binding: t -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el
index cec533ddfaa..aac78c64c69 100644
--- a/test/lisp/dired-tests.el
+++ b/test/lisp/dired-tests.el
@@ -1,6 +1,6 @@
;;; dired-tests.el --- Test suite. -*- lexical-binding: t -*-
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -293,6 +293,7 @@
(ert-deftest dired-test-bug27899 ()
"Test for https://debbugs.gnu.org/27899 ."
+ :tags '(:unstable)
(dired (list (expand-file-name "src" source-directory)
"cygw32.c" "alloc.c" "w32xfns.c" "xdisp.c"))
(let ((orig dired-hide-details-mode))
@@ -440,6 +441,81 @@
(should (= 6 (length (dired-get-marked-files)))) ; All empty dirs but zeta-empty-dir deleted.
(advice-remove 'read-answer 'dired-test-bug27940-advice))))
+(ert-deftest dired-test-directory-files ()
+ "Test for `directory-files'."
+ (let ((testdir (expand-file-name
+ "directory-files-test" (temporary-file-directory)))
+ (nod directory-files-no-dot-files-regexp))
+ (unwind-protect
+ (progn
+ (when (file-directory-p testdir)
+ (delete-directory testdir t))
+
+ (make-directory testdir)
+ (when (file-directory-p testdir)
+ ;; directory-empty-p: test non-existent dir
+ (should-not (directory-empty-p "some-imaginary-dir"))
+ (should (= 2 (length (directory-files testdir))))
+ ;; directory-empty-p: test empty dir
+ (should (directory-empty-p testdir))
+ (should-not (directory-files testdir nil nod t 1))
+ (dolist (file '(a b c d))
+ (make-empty-file (expand-file-name (symbol-name file) testdir)))
+ (should (= 6 (length (directory-files testdir))))
+ (should (equal "abcd" (mapconcat 'identity (directory-files
+ testdir nil nod) "")))
+ (should (= 2 (length (directory-files testdir nil "[bc]"))))
+ (should (= 3 (length (directory-files testdir nil nod nil 3))))
+ (dolist (file '(5 4 3 2 1))
+ (make-empty-file
+ (expand-file-name (number-to-string file) testdir)))
+ ;;(should (= 0 (length (directory-files testdir nil "[0-9]" t -1))))
+ (should (= 5 (length (directory-files testdir nil "[0-9]" t))))
+ (should (= 5 (length (directory-files testdir nil "[0-9]" t 50))))
+ (should-not (directory-empty-p testdir)))
+
+ (delete-directory testdir t)))))
+
+(ert-deftest dired-test-directory-files-and-attributes ()
+ "Test for `directory-files-and-attributes'."
+ (let ((testdir (expand-file-name
+ "directory-files-test" (temporary-file-directory)))
+ (nod directory-files-no-dot-files-regexp))
+
+ (unwind-protect
+ (progn
+ (when (file-directory-p testdir)
+ (delete-directory testdir t))
+
+ (make-directory testdir)
+ (when (file-directory-p testdir)
+ (should (= 2 (length (directory-files testdir))))
+ (should-not (directory-files-and-attributes testdir t nod t 1))
+ (dolist (file '(a b c d))
+ (make-directory (expand-file-name (symbol-name file) testdir)))
+ (should (= 6 (length (directory-files-and-attributes testdir))))
+ (dolist (dir (directory-files-and-attributes testdir t nod))
+ (should (file-directory-p (car dir)))
+ (should-not (file-regular-p (car dir))))
+ (should (= 2 (length
+ (directory-files-and-attributes testdir nil "[bc]"))))
+ (should (= 3 (length
+ (directory-files-and-attributes
+ testdir nil nod nil nil 3))))
+ (dolist (file '(5 4 3 2 1))
+ (make-empty-file
+ (expand-file-name (number-to-string file) testdir)))
+ ;; (should (= 0 (length (directory-files-and-attributes testdir nil
+ ;; "[0-9]" t
+ ;; nil -1))))
+ (should (= 5 (length
+ (directory-files-and-attributes
+ testdir nil "[0-9]" t))))
+ (should (= 5 (length
+ (directory-files-and-attributes
+ testdir nil "[0-9]" t nil 50))))))
+ (when (file-directory-p testdir)
+ (delete-directory testdir t)))))
(provide 'dired-tests)
;; dired-tests.el ends here
diff --git a/test/lisp/dired-x-tests.el b/test/lisp/dired-x-tests.el
index 245e36efb79..5b51c997e36 100644
--- a/test/lisp/dired-x-tests.el
+++ b/test/lisp/dired-x-tests.el
@@ -1,6 +1,6 @@
;;; dired-x-tests.el --- Test suite for dired-x. -*- lexical-binding: t -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/dom-tests.el b/test/lisp/dom-tests.el
index f743df78fd5..dbe3a15dac1 100644
--- a/test/lisp/dom-tests.el
+++ b/test/lisp/dom-tests.el
@@ -1,6 +1,6 @@
;;; dom-tests.el --- Tests for dom.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2016-2021 Free Software Foundation, Inc.
;; Author: Simen Heggestøyl <simenheg@gmail.com>
;; Keywords:
diff --git a/test/lisp/electric-tests.el b/test/lisp/electric-tests.el
index 5f63f6831b3..1b7beeaa366 100644
--- a/test/lisp/electric-tests.el
+++ b/test/lisp/electric-tests.el
@@ -1,6 +1,6 @@
;;; electric-tests.el --- tests for electric.el
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; Author: João Távora <joaotavora@gmail.com>
;; Keywords:
diff --git a/test/lisp/elide-head-tests.el b/test/lisp/elide-head-tests.el
index c9ef26a8181..4b9a559ac75 100644
--- a/test/lisp/elide-head-tests.el
+++ b/test/lisp/elide-head-tests.el
@@ -1,6 +1,6 @@
;;; elide-head-tests.el --- Tests for elide-head.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; Author: Simen Heggestøyl <simenheg@gmail.com>
;; Keywords:
diff --git a/test/lisp/emacs-lisp/backquote-tests.el b/test/lisp/emacs-lisp/backquote-tests.el
index d1e6494ba66..a196d0b8866 100644
--- a/test/lisp/emacs-lisp/backquote-tests.el
+++ b/test/lisp/emacs-lisp/backquote-tests.el
@@ -1,6 +1,6 @@
;;; backquote-tests.el --- Tests for backquote.el -*- lexical-binding: t -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/emacs-lisp/backtrace-tests.el b/test/lisp/emacs-lisp/backtrace-tests.el
index fbc71e0ec86..5c4e5305ecc 100644
--- a/test/lisp/emacs-lisp/backtrace-tests.el
+++ b/test/lisp/emacs-lisp/backtrace-tests.el
@@ -1,6 +1,6 @@
;;; backtrace-tests.el --- Tests for backtraces -*- lexical-binding: t; -*-
-;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2018-2021 Free Software Foundation, Inc.
;; Author: Gemini Lasswell
diff --git a/test/lisp/emacs-lisp/benchmark-tests.el b/test/lisp/emacs-lisp/benchmark-tests.el
index 7cca0d1ed70..71bb52f82fc 100644
--- a/test/lisp/emacs-lisp/benchmark-tests.el
+++ b/test/lisp/emacs-lisp/benchmark-tests.el
@@ -1,6 +1,6 @@
;;; benchmark-tests.el --- Test suite for benchmark. -*- lexical-binding: t -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/emacs-lisp/bindat-tests.el b/test/lisp/emacs-lisp/bindat-tests.el
index 842ef10bc57..a9a881987c0 100644
--- a/test/lisp/emacs-lisp/bindat-tests.el
+++ b/test/lisp/emacs-lisp/bindat-tests.el
@@ -1,6 +1,6 @@
;;; bindat-tests.el --- tests for bindat.el -*- lexical-binding: t; coding: utf-8; -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/error-lexical-var-with-add-hook.el b/test/lisp/emacs-lisp/bytecomp-resources/error-lexical-var-with-add-hook.el
new file mode 100644
index 00000000000..5f390898e6a
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/error-lexical-var-with-add-hook.el
@@ -0,0 +1,4 @@
+;;; -*- lexical-binding: t; -*-
+(let ((foo nil))
+ (add-hook 'foo #'next-line)
+ foo)
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/error-lexical-var-with-remove-hook.el b/test/lisp/emacs-lisp/bytecomp-resources/error-lexical-var-with-remove-hook.el
new file mode 100644
index 00000000000..eaa625eba1c
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/error-lexical-var-with-remove-hook.el
@@ -0,0 +1,4 @@
+;;; -*- lexical-binding: t; -*-
+(let ((foo nil))
+ (remove-hook 'foo #'next-line)
+ foo)
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/error-lexical-var-with-run-hook-with-args-until-failure.el b/test/lisp/emacs-lisp/bytecomp-resources/error-lexical-var-with-run-hook-with-args-until-failure.el
new file mode 100644
index 00000000000..7a116ad464b
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/error-lexical-var-with-run-hook-with-args-until-failure.el
@@ -0,0 +1,3 @@
+;;; -*- lexical-binding: t; -*-
+(let ((foo nil))
+ (run-hook-with-args-until-failure 'foo))
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/error-lexical-var-with-run-hook-with-args-until-success.el b/test/lisp/emacs-lisp/bytecomp-resources/error-lexical-var-with-run-hook-with-args-until-success.el
new file mode 100644
index 00000000000..96d10a343df
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/error-lexical-var-with-run-hook-with-args-until-success.el
@@ -0,0 +1,3 @@
+;;; -*- lexical-binding: t; -*-
+(let ((foo nil))
+ (run-hook-with-args-until-success 'foo #'next-line))
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/error-lexical-var-with-run-hook-with-args.el b/test/lisp/emacs-lisp/bytecomp-resources/error-lexical-var-with-run-hook-with-args.el
new file mode 100644
index 00000000000..bb9101bd070
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/error-lexical-var-with-run-hook-with-args.el
@@ -0,0 +1,3 @@
+;;; -*- lexical-binding: t; -*-
+(let ((foo nil))
+ (run-hook-with-args 'foo))
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/error-lexical-var-with-symbol-value.el b/test/lisp/emacs-lisp/bytecomp-resources/error-lexical-var-with-symbol-value.el
new file mode 100644
index 00000000000..5f390898e6a
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/error-lexical-var-with-symbol-value.el
@@ -0,0 +1,4 @@
+;;; -*- lexical-binding: t; -*-
+(let ((foo nil))
+ (add-hook 'foo #'next-line)
+ foo)
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-autoload-not-on-top-level.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-autoload-not-on-top-level.el
new file mode 100644
index 00000000000..f193130c6ca
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-autoload-not-on-top-level.el
@@ -0,0 +1,3 @@
+;;; -*- lexical-binding: t -*-
+(defun foo ()
+ (autoload 'bar "baz" nil nil 'macro))
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-callargs.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-callargs.el
new file mode 100644
index 00000000000..687add380b9
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-callargs.el
@@ -0,0 +1,5 @@
+;;; -*- lexical-binding: t -*-
+(defun foo (_x)
+ nil)
+(defun bar ()
+ (foo 1 2))
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-defcustom-nogroup.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-defcustom-nogroup.el
new file mode 100644
index 00000000000..a67d4f041f3
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-defcustom-nogroup.el
@@ -0,0 +1,3 @@
+;;; -*- lexical-binding: t -*-
+(defcustom foo nil
+ :type 'boolean)
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-defcustom-notype.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-defcustom-notype.el
new file mode 100644
index 00000000000..c15ab9b192a
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-defcustom-notype.el
@@ -0,0 +1,3 @@
+;;; -*- lexical-binding: t -*-
+(defcustom foo nil
+ :group 'emacs)
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-defvar-lacks-prefix.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-defvar-lacks-prefix.el
new file mode 100644
index 00000000000..9f3cbb98900
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-defvar-lacks-prefix.el
@@ -0,0 +1,2 @@
+;;; -*- lexical-binding: t -*-
+(defvar foo nil)
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-format.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-format.el
new file mode 100644
index 00000000000..a1902bc03b0
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-format.el
@@ -0,0 +1,2 @@
+;;; -*- lexical-binding: t -*-
+(message "%s" 1 2)
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-free-setq.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-free-setq.el
new file mode 100644
index 00000000000..6e187129c9b
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-free-setq.el
@@ -0,0 +1,2 @@
+;;; -*- lexical-binding: t -*-
+(setq foo 'bar)
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-free-variable-reference.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-free-variable-reference.el
new file mode 100644
index 00000000000..50a95272874
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-free-variable-reference.el
@@ -0,0 +1,4 @@
+;;; -*- lexical-binding: t -*-
+(defvar xxx-test)
+(defun foo ()
+ (setq xxx-test bar))
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-interactive-only.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-interactive-only.el
new file mode 100644
index 00000000000..9e0c99bd30b
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-interactive-only.el
@@ -0,0 +1,3 @@
+;;; -*- lexical-binding: t -*-
+(defun foo ()
+ (next-line))
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-lambda-malformed-interactive-spec.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-lambda-malformed-interactive-spec.el
new file mode 100644
index 00000000000..6bd902705ed
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-lambda-malformed-interactive-spec.el
@@ -0,0 +1,4 @@
+;;; -*- lexical-binding: t -*-
+(defun foo ()
+ (interactive "foo" "bar")
+ nil)
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-make-variable-buffer-local.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-make-variable-buffer-local.el
new file mode 100644
index 00000000000..aa1e6c0463b
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-make-variable-buffer-local.el
@@ -0,0 +1,4 @@
+;;; -*- lexical-binding: t -*-
+(defvar foobar)
+(defun foo ()
+ (make-variable-buffer-local 'foobar))
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-defun.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-defun.el
new file mode 100644
index 00000000000..2a7af617ac9
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-defun.el
@@ -0,0 +1,8 @@
+;;; -*- lexical-binding: t -*-
+
+(defun foo-obsolete ()
+ (declare (obsolete nil "99.99"))
+ nil)
+
+(defun foo ()
+ (foo-obsolete))
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-hook.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-hook.el
new file mode 100644
index 00000000000..078e6e4a3a9
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-hook.el
@@ -0,0 +1,3 @@
+;;; -*- lexical-binding: t -*-
+(defun foo ()
+ (add-hook 'bytecomp--tests-obsolete-var #'next-line))
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-variable-bound.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-variable-bound.el
new file mode 100644
index 00000000000..e65a541e6e3
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-variable-bound.el
@@ -0,0 +1,7 @@
+;;; -*- lexical-binding: t -*-
+
+(make-obsolete-variable 'bytecomp--tests-obsolete-var-2 nil "99.99")
+
+(defun foo ()
+ (let ((bytecomp--tests-obsolete-var-2 2))
+ bytecomp--tests-obsolete-var-2))
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-variable-same-file.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-variable-same-file.el
new file mode 100644
index 00000000000..31deb6155ba
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-variable-same-file.el
@@ -0,0 +1,13 @@
+;;; -*- lexical-binding: t -*-
+
+(defvar foo-obsolete nil)
+(make-obsolete-variable 'foo-obsolete nil "99.99")
+
+;; From bytecomp.el:
+;; If foo.el declares `toto' as obsolete, it is likely that foo.el will
+;; actually use `toto' in order for this obsolete variable to still work
+;; correctly, so paradoxically, while byte-compiling foo.el, the presence
+;; of a make-obsolete-variable call for `toto' is an indication that `toto'
+;; should not trigger obsolete-warnings in foo.el.
+(defun foo ()
+ foo-obsolete)
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-variable.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-variable.el
new file mode 100644
index 00000000000..9a517cc6767
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-obsolete-variable.el
@@ -0,0 +1,4 @@
+;;; -*- lexical-binding: t -*-
+
+(defun foo ()
+ bytecomp--tests-obsolete-var)
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-redefine-defun-as-macro.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-redefine-defun-as-macro.el
new file mode 100644
index 00000000000..6bd239b6598
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-redefine-defun-as-macro.el
@@ -0,0 +1,3 @@
+;;; -*- lexical-binding: t -*-
+(defun foo () nil)
+(defmacro foo () t)
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-redefine-defun.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-redefine-defun.el
new file mode 100644
index 00000000000..53e4c0ac8de
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-redefine-defun.el
@@ -0,0 +1,3 @@
+;;; -*- lexical-binding: t -*-
+(defun foo () nil)
+(defun foo () t)
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-redefine-macro-as-defun.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-redefine-macro-as-defun.el
new file mode 100644
index 00000000000..f71ae445615
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-redefine-macro-as-defun.el
@@ -0,0 +1,3 @@
+;;; -*- lexical-binding: t -*-
+(defmacro foo () t)
+(defun foo () nil)
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-save-excursion.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-save-excursion.el
new file mode 100644
index 00000000000..38185457192
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-save-excursion.el
@@ -0,0 +1,5 @@
+;;; -*- lexical-binding: t -*-
+(defun foo ()
+ (save-excursion
+ (set-buffer (current-buffer))
+ nil))
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-variable-let-bind-constant.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-variable-let-bind-constant.el
new file mode 100644
index 00000000000..cc1fb572577
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-variable-let-bind-constant.el
@@ -0,0 +1,3 @@
+;;; -*- lexical-binding: t -*-
+(defun foo ()
+ (let ((t 1)) t))
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-variable-let-bind-nonvariable.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-variable-let-bind-nonvariable.el
new file mode 100644
index 00000000000..dde2dcee6e7
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-variable-let-bind-nonvariable.el
@@ -0,0 +1,3 @@
+;;; -*- lexical-binding: t -*-
+(defun foo ()
+ (let (('t 1)) t))
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-variable-set-constant.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-variable-set-constant.el
new file mode 100644
index 00000000000..2fc0680cfab
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-variable-set-constant.el
@@ -0,0 +1,3 @@
+;;; -*- lexical-binding: t -*-
+(defun foo ()
+ (setq t nil))
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-variable-set-nonvariable.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-variable-set-nonvariable.el
new file mode 100644
index 00000000000..0c76c4d388b
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-variable-set-nonvariable.el
@@ -0,0 +1,3 @@
+;;; -*- lexical-binding: t -*-
+(defun foo ()
+ (set '(a) nil))
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-autoload.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-autoload.el
new file mode 100644
index 00000000000..96deb1bbb0a
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-autoload.el
@@ -0,0 +1,3 @@
+;;; -*- lexical-binding: t -*-
+(autoload 'foox "foo"
+ "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx")
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-custom-declare-variable.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-custom-declare-variable.el
new file mode 100644
index 00000000000..2a4700bfda5
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-custom-declare-variable.el
@@ -0,0 +1,4 @@
+;;; -*- lexical-binding: t -*-
+(custom-declare-variable
+ 'foo t
+ "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx")
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defalias.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defalias.el
new file mode 100644
index 00000000000..a4235d22bd3
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defalias.el
@@ -0,0 +1,3 @@
+;;; -*- lexical-binding: t -*-
+(defalias 'foo #'ignore
+ "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx")
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defconst.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defconst.el
new file mode 100644
index 00000000000..946f01989a0
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defconst.el
@@ -0,0 +1,3 @@
+;;; -*- lexical-binding: t -*-
+(defconst foo-bar nil
+ "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx")
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-define-abbrev-table.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-define-abbrev-table.el
new file mode 100644
index 00000000000..3da9ccd48c6
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-define-abbrev-table.el
@@ -0,0 +1,3 @@
+;;; -*- lexical-binding: t -*-
+(define-abbrev-table 'foo ()
+ "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx")
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-define-obsolete-function-alias.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-define-obsolete-function-alias.el
new file mode 100644
index 00000000000..fea841b12ec
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-define-obsolete-function-alias.el
@@ -0,0 +1,3 @@
+;;; -*- lexical-binding: t -*-
+(define-obsolete-function-alias 'foo #'ignore "99.1"
+ "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx")
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-define-obsolete-variable-alias.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-define-obsolete-variable-alias.el
new file mode 100644
index 00000000000..2d5f201cb65
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-define-obsolete-variable-alias.el
@@ -0,0 +1,3 @@
+;;; -*- lexical-binding: t -*-
+(define-obsolete-variable-alias 'foo 'ignore "99.1"
+ "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx")
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defun.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defun.el
new file mode 100644
index 00000000000..94b0e80c979
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defun.el
@@ -0,0 +1,3 @@
+;;; -*- lexical-binding: t -*-
+(defun foo ()
+ "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx")
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defvar.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defvar.el
new file mode 100644
index 00000000000..99aacd09cbd
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defvar.el
@@ -0,0 +1,6 @@
+;;; -*- lexical-binding: t -*-
+(defvar foo-bar nil
+ "multiline
+foo
+xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
+bar")
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defvaralias.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defvaralias.el
new file mode 100644
index 00000000000..52fdc17f5bf
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-defvaralias.el
@@ -0,0 +1,3 @@
+;;; -*- lexical-binding: t -*-
+(defvaralias 'foo-bar #'ignore
+ "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx")
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-ignore-fill-column.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-ignore-fill-column.el
new file mode 100644
index 00000000000..1ff554f3704
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-ignore-fill-column.el
@@ -0,0 +1,7 @@
+;;; -*- lexical-binding: t -*-
+(defvar foo-bar nil
+ "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx")
+
+;; Local Variables:
+;; fill-column: 100
+;; End:
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-ignore-override.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-ignore-override.el
new file mode 100644
index 00000000000..0bcf7b1d63b
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-ignore-override.el
@@ -0,0 +1,8 @@
+;;; -*- lexical-binding: t -*-
+(defvar foo-bar nil
+ "123456789012345")
+
+;; Local Variables:
+;; byte-compile-docstring-max-column: 10
+;; fill-column: 20
+;; End:
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-ignore.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-ignore.el
new file mode 100644
index 00000000000..c80ddd180d9
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-ignore.el
@@ -0,0 +1,7 @@
+;;; -*- lexical-binding: t -*-
+(defvar foo-bar nil
+ "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx")
+
+;; Local Variables:
+;; byte-compile-docstring-max-column: 100
+;; End:
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-multiline-first.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-multiline-first.el
new file mode 100644
index 00000000000..2563dbbb3b9
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-multiline-first.el
@@ -0,0 +1,5 @@
+;;; -*- lexical-binding: t -*-
+(defvar foo-bar nil
+ "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
+This is a multiline docstring where the first line is long.
+foobar")
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-multiline.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-multiline.el
new file mode 100644
index 00000000000..9ae7bc9b9f0
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-multiline.el
@@ -0,0 +1,6 @@
+;;; -*- lexical-binding: t -*-
+(defvar foo-bar nil
+ "This is a multiline docstring.
+But it's not the first line that is long.
+xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
+foobar")
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el
index 13cbedfe1f7..263736af4ed 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -1,6 +1,6 @@
;;; bytecomp-tests.el -*- lexical-binding:t -*-
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Shigeru Fukaya <shigeru.fukaya@gmail.com>
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
@@ -26,6 +26,7 @@
;;; Commentary:
(require 'ert)
+(require 'ert-x)
(require 'cl-lib)
(require 'subr-x)
(require 'bytecomp)
@@ -489,6 +490,9 @@ Subtests signal errors if something goes wrong."
(defun def () (m))))
(should (equal (funcall 'def) 4)))
+
+;;;; Warnings.
+
(ert-deftest bytecomp-tests--warnings ()
(with-current-buffer (get-buffer-create "*Compile-Log*")
(let ((inhibit-read-only t)) (erase-buffer)))
@@ -516,19 +520,201 @@ Subtests signal errors if something goes wrong."
;; Should not warn that mt--test2 is not known to be defined.
(should-not (re-search-forward "my--test2" nil t))))
+(defmacro bytecomp--with-warning-test (re-warning &rest form)
+ (declare (indent 1))
+ `(with-current-buffer (get-buffer-create "*Compile-Log*")
+ (let ((inhibit-read-only t)) (erase-buffer))
+ (byte-compile ,@form)
+ (ert-info ((buffer-string) :prefix "buffer: ")
+ (should (re-search-forward ,re-warning)))))
+
(ert-deftest bytecomp-warn-wrong-args ()
- (with-current-buffer (get-buffer-create "*Compile-Log*")
- (let ((inhibit-read-only t)) (erase-buffer))
- (byte-compile '(remq 1 2 3))
- (ert-info ((buffer-string) :prefix "buffer: ")
- (should (re-search-forward "remq.*3.*2")))))
+ (bytecomp--with-warning-test "remq.*3.*2"
+ '(remq 1 2 3)))
(ert-deftest bytecomp-warn-wrong-args-subr ()
- (with-current-buffer (get-buffer-create "*Compile-Log*")
- (let ((inhibit-read-only t)) (erase-buffer))
- (byte-compile '(safe-length 1 2 3))
- (ert-info ((buffer-string) :prefix "buffer: ")
- (should (re-search-forward "safe-length.*3.*1")))))
+ (bytecomp--with-warning-test "safe-length.*3.*1"
+ '(safe-length 1 2 3)))
+
+(ert-deftest bytecomp-warn-variable-lacks-prefix ()
+ (bytecomp--with-warning-test "foo.*lacks a prefix"
+ '(defvar foo nil)))
+
+(defvar bytecomp-tests--docstring (make-string 100 ?x))
+
+(ert-deftest bytecomp-warn-wide-docstring/defconst ()
+ (bytecomp--with-warning-test "defconst.*foo.*wider than.*characters"
+ `(defconst foo t ,bytecomp-tests--docstring)))
+
+(ert-deftest bytecomp-warn-wide-docstring/defvar ()
+ (bytecomp--with-warning-test "defvar.*foo.*wider than.*characters"
+ `(defvar foo t ,bytecomp-tests--docstring)))
+
+(defmacro bytecomp--define-warning-file-test (file re-warning &optional reverse)
+ `(ert-deftest ,(intern (format "bytecomp/%s" file)) ()
+ :expected-result ,(if reverse :failed :passed)
+ (with-current-buffer (get-buffer-create "*Compile-Log*")
+ (let ((inhibit-read-only t)) (erase-buffer))
+ (byte-compile-file ,(ert-resource-file file))
+ (ert-info ((buffer-string) :prefix "buffer: ")
+ (should (re-search-forward ,re-warning))))))
+
+(bytecomp--define-warning-file-test "error-lexical-var-with-add-hook.el"
+ "add-hook.*lexical var")
+
+(bytecomp--define-warning-file-test "error-lexical-var-with-remove-hook.el"
+ "remove-hook.*lexical var")
+
+(bytecomp--define-warning-file-test "error-lexical-var-with-run-hook-with-args-until-failure.el"
+ "args-until-failure.*lexical var")
+
+(bytecomp--define-warning-file-test "error-lexical-var-with-run-hook-with-args-until-success.el"
+ "args-until-success.*lexical var")
+
+(bytecomp--define-warning-file-test "error-lexical-var-with-run-hook-with-args.el"
+ "args.*lexical var")
+
+(bytecomp--define-warning-file-test "error-lexical-var-with-symbol-value.el"
+ "symbol-value.*lexical var")
+
+(bytecomp--define-warning-file-test "warn-autoload-not-on-top-level.el"
+ "compiler ignores.*autoload.*")
+
+(bytecomp--define-warning-file-test "warn-callargs.el"
+ "with 2 arguments, but accepts only 1")
+
+(bytecomp--define-warning-file-test "warn-defcustom-nogroup.el"
+ "fails to specify containing group")
+
+(bytecomp--define-warning-file-test "warn-defcustom-notype.el"
+ "fails to specify type")
+
+(bytecomp--define-warning-file-test "warn-defvar-lacks-prefix.el"
+ "var.*foo.*lacks a prefix")
+
+(bytecomp--define-warning-file-test "warn-format.el"
+ "called with 2 args to fill 1 format field")
+
+(bytecomp--define-warning-file-test "warn-free-setq.el"
+ "free.*foo")
+
+(bytecomp--define-warning-file-test "warn-free-variable-reference.el"
+ "free.*bar")
+
+(bytecomp--define-warning-file-test "warn-make-variable-buffer-local.el"
+ "make-variable-buffer-local.*not called at toplevel")
+
+(bytecomp--define-warning-file-test "warn-interactive-only.el"
+ "next-line.*interactive use only.*forward-line")
+
+(bytecomp--define-warning-file-test "warn-lambda-malformed-interactive-spec.el"
+ "malformed interactive spec")
+
+(bytecomp--define-warning-file-test "warn-obsolete-defun.el"
+ "foo-obsolete.*obsolete function.*99.99")
+
+(defvar bytecomp--tests-obsolete-var nil)
+(make-obsolete-variable 'bytecomp--tests-obsolete-var nil "99.99")
+
+(bytecomp--define-warning-file-test "warn-obsolete-hook.el"
+ "bytecomp--tests-obs.*obsolete[^z-a]*99.99")
+
+(bytecomp--define-warning-file-test "warn-obsolete-variable-same-file.el"
+ "foo-obs.*obsolete.*99.99" t)
+
+(bytecomp--define-warning-file-test "warn-obsolete-variable.el"
+ "bytecomp--tests-obs.*obsolete[^z-a]*99.99")
+
+(bytecomp--define-warning-file-test "warn-obsolete-variable-bound.el"
+ "bytecomp--tests-obs.*obsolete.*99.99" t)
+
+(bytecomp--define-warning-file-test "warn-redefine-defun-as-macro.el"
+ "as both function and macro")
+
+(bytecomp--define-warning-file-test "warn-redefine-macro-as-defun.el"
+ "as both function and macro")
+
+(bytecomp--define-warning-file-test "warn-redefine-defun.el"
+ "defined multiple")
+
+(bytecomp--define-warning-file-test "warn-save-excursion.el"
+ "with-current.*rather than save-excursion")
+
+(bytecomp--define-warning-file-test "warn-variable-let-bind-constant.el"
+ "let-bind constant")
+
+(bytecomp--define-warning-file-test "warn-variable-let-bind-nonvariable.el"
+ "let-bind nonvariable")
+
+(bytecomp--define-warning-file-test "warn-variable-set-constant.el"
+ "variable reference to constant")
+
+(bytecomp--define-warning-file-test "warn-variable-set-nonvariable.el"
+ "variable reference to nonvariable")
+
+(bytecomp--define-warning-file-test
+ "warn-wide-docstring-autoload.el"
+ "autoload.*foox.*wider than.*characters")
+
+(bytecomp--define-warning-file-test
+ "warn-wide-docstring-custom-declare-variable.el"
+ "custom-declare-variable.*foo.*wider than.*characters")
+
+(bytecomp--define-warning-file-test
+ "warn-wide-docstring-defalias.el"
+ "defalias.*foo.*wider than.*characters")
+
+(bytecomp--define-warning-file-test
+ "warn-wide-docstring-defconst.el"
+ "defconst.*foo.*wider than.*characters")
+
+(bytecomp--define-warning-file-test
+ "warn-wide-docstring-define-abbrev-table.el"
+ "define-abbrev.*foo.*wider than.*characters")
+
+(bytecomp--define-warning-file-test
+ "warn-wide-docstring-define-obsolete-function-alias.el"
+ "defalias.*foo.*wider than.*characters")
+
+(bytecomp--define-warning-file-test
+ "warn-wide-docstring-define-obsolete-variable-alias.el"
+ "defvaralias.*foo.*wider than.*characters")
+
+;; TODO: We don't yet issue warnings for defuns.
+(bytecomp--define-warning-file-test
+ "warn-wide-docstring-defun.el"
+ "wider than.*characters" 'reverse)
+
+(bytecomp--define-warning-file-test
+ "warn-wide-docstring-defvar.el"
+ "defvar.*foo.*wider than.*characters")
+
+(bytecomp--define-warning-file-test
+ "warn-wide-docstring-defvaralias.el"
+ "defvaralias.*foo.*wider than.*characters")
+
+(bytecomp--define-warning-file-test
+ "warn-wide-docstring-ignore-fill-column.el"
+ "defvar.*foo.*wider than.*characters" 'reverse)
+
+(bytecomp--define-warning-file-test
+ "warn-wide-docstring-ignore-override.el"
+ "defvar.*foo.*wider than.*characters" 'reverse)
+
+(bytecomp--define-warning-file-test
+ "warn-wide-docstring-ignore.el"
+ "defvar.*foo.*wider than.*characters" 'reverse)
+
+(bytecomp--define-warning-file-test
+ "warn-wide-docstring-multiline-first.el"
+ "defvar.*foo.*wider than.*characters")
+
+(bytecomp--define-warning-file-test
+ "warn-wide-docstring-multiline.el"
+ "defvar.*foo.*wider than.*characters")
+
+
+;;;; Macro expansion.
(ert-deftest test-eager-load-macro-expansion ()
(test-byte-comp-compile-and-load nil
@@ -810,6 +996,12 @@ literals (Bug#20852)."
(test-suppression
'(defun zot ()
+ (next-line))
+ '((interactive-only next-line))
+ "interactive use only")
+
+ (test-suppression
+ '(defun zot ()
(mapcar #'list '(1 2 3))
nil)
'((mapcar mapcar))
@@ -829,6 +1021,90 @@ literals (Bug#20852)."
'((suspicious set-buffer))
"Warning: Use .with-current-buffer. rather than"))
+(ert-deftest bytecomp-tests--not-writable-directory ()
+ "Test that byte compilation works if the output directory isn't
+writable (Bug#44631)."
+ (let ((directory (make-temp-file "bytecomp-tests-" :directory)))
+ (unwind-protect
+ (let* ((input-file (expand-file-name "test.el" directory))
+ (output-file (expand-file-name "test.elc" directory))
+ (byte-compile-dest-file-function
+ (lambda (_) output-file))
+ (byte-compile-error-on-warn t))
+ (write-region "" nil input-file nil nil nil 'excl)
+ (write-region "" nil output-file nil nil nil 'excl)
+ (set-file-modes input-file #o400)
+ (set-file-modes output-file #o200)
+ (set-file-modes directory #o500)
+ (should (byte-compile-file input-file))
+ (should (file-regular-p output-file))
+ (should (cl-plusp (file-attribute-size
+ (file-attributes output-file)))))
+ (with-demoted-errors "Error cleaning up directory: %s"
+ (set-file-modes directory #o700)
+ (delete-directory directory :recursive)))))
+
+(ert-deftest bytecomp-tests--dest-mountpoint ()
+ "Test that byte compilation works if the destination file is a
+mountpoint (Bug#44631)."
+ (let ((bwrap (executable-find "bwrap"))
+ (emacs (expand-file-name invocation-name invocation-directory)))
+ (skip-unless bwrap)
+ (skip-unless (file-executable-p bwrap))
+ (skip-unless (not (file-remote-p bwrap)))
+ (skip-unless (file-executable-p emacs))
+ (skip-unless (not (file-remote-p emacs)))
+ (let ((directory (make-temp-file "bytecomp-tests-" :directory)))
+ (unwind-protect
+ (let* ((input-file (expand-file-name "test.el" directory))
+ (output-file (expand-file-name "test.elc" directory))
+ (unquoted-file (file-name-unquote output-file))
+ (byte-compile-dest-file-function
+ (lambda (_) output-file))
+ (byte-compile-error-on-warn t))
+ (should-not (file-remote-p input-file))
+ (should-not (file-remote-p output-file))
+ (write-region "" nil input-file nil nil nil 'excl)
+ (write-region "" nil output-file nil nil nil 'excl)
+ (set-file-modes input-file #o400)
+ (set-file-modes output-file #o200)
+ (set-file-modes directory #o500)
+ (with-temp-buffer
+ (let ((status (call-process
+ bwrap nil t nil
+ "--ro-bind" "/" "/"
+ "--bind" unquoted-file unquoted-file
+ emacs "--quick" "--batch" "--load=bytecomp"
+ (format "--eval=%S"
+ `(setq byte-compile-dest-file-function
+ (lambda (_) ,output-file)
+ byte-compile-error-on-warn t))
+ "--funcall=batch-byte-compile" input-file)))
+ (unless (eql status 0)
+ (ert-fail `((status . ,status)
+ (output . ,(buffer-string)))))))
+ (should (file-regular-p output-file))
+ (should (cl-plusp (file-attribute-size
+ (file-attributes output-file)))))
+ (with-demoted-errors "Error cleaning up directory: %s"
+ (set-file-modes directory #o700)
+ (delete-directory directory :recursive))))))
+
+(ert-deftest bytecomp-tests--target-file-no-directory ()
+ "Check that Bug#45287 is fixed."
+ (let ((directory (make-temp-file "bytecomp-tests-" :directory)))
+ (unwind-protect
+ (let* ((default-directory directory)
+ (byte-compile-dest-file-function (lambda (_) "test.elc"))
+ (byte-compile-error-on-warn t))
+ (write-region "" nil "test.el" nil nil nil 'excl)
+ (should (byte-compile-file "test.el"))
+ (should (file-regular-p "test.elc"))
+ (should (cl-plusp (file-attribute-size
+ (file-attributes "test.elc")))))
+ (with-demoted-errors "Error cleaning up directory: %s"
+ (delete-directory directory :recursive)))))
+
;; Local Variables:
;; no-byte-compile: t
;; End:
diff --git a/test/lisp/emacs-lisp/cconv-tests.el b/test/lisp/emacs-lisp/cconv-tests.el
index 0ea9742be49..517373386e3 100644
--- a/test/lisp/emacs-lisp/cconv-tests.el
+++ b/test/lisp/emacs-lisp/cconv-tests.el
@@ -1,6 +1,6 @@
;;; cconv-tests.el -*- lexical-binding: t -*-
-;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2018-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/emacs-lisp/check-declare-tests.el b/test/lisp/emacs-lisp/check-declare-tests.el
index bb9542114c4..9552bf0e397 100644
--- a/test/lisp/emacs-lisp/check-declare-tests.el
+++ b/test/lisp/emacs-lisp/check-declare-tests.el
@@ -1,6 +1,6 @@
;;; check-declare-tests.el --- Tests for check-declare.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; Author: Simen Heggestøyl <simenheg@gmail.com>
;; Keywords:
diff --git a/test/lisp/emacs-lisp/checkdoc-tests.el b/test/lisp/emacs-lisp/checkdoc-tests.el
index c12d0d37311..cf7baf4ce44 100644
--- a/test/lisp/emacs-lisp/checkdoc-tests.el
+++ b/test/lisp/emacs-lisp/checkdoc-tests.el
@@ -1,6 +1,6 @@
;;; checkdoc-tests.el --- unit tests for checkdoc.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2016-2021 Free Software Foundation, Inc.
;; Author: Philipp Stephani <phst@google.com>
diff --git a/test/lisp/emacs-lisp/cl-extra-tests.el b/test/lisp/emacs-lisp/cl-extra-tests.el
index 7546c149377..f3c308725ac 100644
--- a/test/lisp/emacs-lisp/cl-extra-tests.el
+++ b/test/lisp/emacs-lisp/cl-extra-tests.el
@@ -1,6 +1,6 @@
;;; cl-extra-tests.el --- tests for emacs-lisp/cl-extra.el -*- lexical-binding:t -*-
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/emacs-lisp/cl-generic-tests.el b/test/lisp/emacs-lisp/cl-generic-tests.el
index 9582907e511..4a01623cb88 100644
--- a/test/lisp/emacs-lisp/cl-generic-tests.el
+++ b/test/lisp/emacs-lisp/cl-generic-tests.el
@@ -1,6 +1,6 @@
;;; cl-generic-tests.el --- Tests for cl-generic.el functionality -*- lexical-binding: t; -*-
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
diff --git a/test/lisp/emacs-lisp/cl-lib-tests.el b/test/lisp/emacs-lisp/cl-lib-tests.el
index 40dd7e4eeb0..97a44c43ef7 100644
--- a/test/lisp/emacs-lisp/cl-lib-tests.el
+++ b/test/lisp/emacs-lisp/cl-lib-tests.el
@@ -1,6 +1,6 @@
;;; cl-lib-tests.el --- tests for emacs-lisp/cl-lib.el -*- lexical-binding:t -*-
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el
index 29ae95e2771..bcd63f73a3c 100644
--- a/test/lisp/emacs-lisp/cl-macs-tests.el
+++ b/test/lisp/emacs-lisp/cl-macs-tests.el
@@ -1,6 +1,6 @@
;;; cl-macs-tests.el --- tests for emacs-lisp/cl-macs.el -*- lexical-binding:t -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -610,4 +610,27 @@ collection clause."
;; Just make sure the function can be instrumented.
(edebug-defun)))
+;;; cl-labels
+
+(ert-deftest cl-macs--labels ()
+ ;; Simple recursive function.
+ (cl-labels ((len (xs) (if xs (1+ (len (cdr xs))) 0)))
+ (should (equal (len (make-list 42 t)) 42)))
+
+ ;; Simple tail-recursive function.
+ (cl-labels ((len (xs n) (if xs (len (cdr xs) (1+ n)) n)))
+ (should (equal (len (make-list 42 t) 0) 42))
+ ;; Should not bump into stack depth limits.
+ (should (equal (len (make-list 42000 t) 0) 42000)))
+
+ ;; Check that non-recursive functions are handled more efficiently.
+ (should (pcase (macroexpand '(cl-labels ((f (x) (+ x 1))) (f 5)))
+ (`(let* ,_ (funcall ,_ 5)) t)))
+
+ ;; Case of "tail-recursive lambdas".
+ (should (pcase (macroexpand
+ '(cl-labels ((len (xs n) (if xs (len (cdr xs) (1+ n)) n)))
+ #'len))
+ (`(function (lambda (,_ ,_) . ,_)) t))))
+
;;; cl-macs-tests.el ends here
diff --git a/test/lisp/emacs-lisp/cl-preloaded-tests.el b/test/lisp/emacs-lisp/cl-preloaded-tests.el
index c64391698ee..97cb204f775 100644
--- a/test/lisp/emacs-lisp/cl-preloaded-tests.el
+++ b/test/lisp/emacs-lisp/cl-preloaded-tests.el
@@ -1,6 +1,6 @@
;;; cl-preloaded-tests.el --- unit tests for cl-preloaded.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; Author: Philipp Stephani <phst@google.com>
;; This file is part of GNU Emacs.
diff --git a/test/lisp/emacs-lisp/cl-print-tests.el b/test/lisp/emacs-lisp/cl-print-tests.el
index ca5db8d9474..199795106a3 100644
--- a/test/lisp/emacs-lisp/cl-print-tests.el
+++ b/test/lisp/emacs-lisp/cl-print-tests.el
@@ -1,6 +1,6 @@
;;; cl-print-tests.el --- Test suite for the cl-print facility. -*- lexical-binding:t -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/emacs-lisp/cl-seq-tests.el b/test/lisp/emacs-lisp/cl-seq-tests.el
index 7e0f5384542..d0fad8907d5 100644
--- a/test/lisp/emacs-lisp/cl-seq-tests.el
+++ b/test/lisp/emacs-lisp/cl-seq-tests.el
@@ -1,6 +1,6 @@
;;; cl-seq-tests.el --- Tests for cl-seq.el functionality -*- lexical-binding: t; -*-
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Author: Nicolas Richard <youngfrog@members.fsf.org>
diff --git a/test/lisp/emacs-lisp/copyright-tests.el b/test/lisp/emacs-lisp/copyright-tests.el
index 77b9e05da67..7deb8b53a2e 100644
--- a/test/lisp/emacs-lisp/copyright-tests.el
+++ b/test/lisp/emacs-lisp/copyright-tests.el
@@ -1,6 +1,6 @@
;;; copyright-tests.el --- tests for copyright.el -*- lexical-binding: t -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/emacs-lisp/derived-tests.el b/test/lisp/emacs-lisp/derived-tests.el
index d79c41ea44f..9c8e6c33b4c 100644
--- a/test/lisp/emacs-lisp/derived-tests.el
+++ b/test/lisp/emacs-lisp/derived-tests.el
@@ -1,6 +1,6 @@
;;; derived-tests.el --- tests for derived.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/emacs-lisp/easy-mmode-tests.el b/test/lisp/emacs-lisp/easy-mmode-tests.el
index 4a448200a2b..77eaed62579 100644
--- a/test/lisp/emacs-lisp/easy-mmode-tests.el
+++ b/test/lisp/emacs-lisp/easy-mmode-tests.el
@@ -1,6 +1,6 @@
;;; easy-mmode-tests.el --- tests for easy-mmode.el -*- lexical-binding: t -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -44,26 +44,21 @@
'(c-mode (not message-mode mail-mode) text-mode))
t))))
+(define-minor-mode easy-mmode-test-mode "A test.")
+
(ert-deftest easy-mmode--minor-mode ()
(with-temp-buffer
- (define-minor-mode test-mode "A test.")
- (should (eq test-mode nil))
- (test-mode t)
- (should (eq test-mode nil))
- (test-mode nil)
- (should (eq test-mode t))
- (test-mode -33)
- (should (eq test-mode nil))
- (test-mode 33)
- (should (eq test-mode t))
- (test-mode 0)
- (should (eq test-mode nil))
- (test-mode 'toggle)
- (should (eq test-mode t))
- (test-mode 'toggle)
- (should (eq test-mode nil))
- (test-mode "what")
- (should (eq test-mode nil))))
+ (should (eq easy-mmode-test-mode nil))
+ (easy-mmode-test-mode nil)
+ (should (eq easy-mmode-test-mode t))
+ (easy-mmode-test-mode -33)
+ (should (eq easy-mmode-test-mode nil))
+ (easy-mmode-test-mode 33)
+ (should (eq easy-mmode-test-mode t))
+ (easy-mmode-test-mode 'toggle)
+ (should (eq easy-mmode-test-mode nil))
+ (easy-mmode-test-mode 'toggle)
+ (should (eq easy-mmode-test-mode t))))
(provide 'easy-mmode-tests)
diff --git a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el
index 7be057db8b2..a3010f9e354 100644
--- a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el
+++ b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el
@@ -1,6 +1,6 @@
;;; edebug-test-code.el --- Sample code for the Edebug test suite -*- lexical-binding:t -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; Author: Gemini Lasswell
diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el
index 8aae26a1aca..d60a6cb3d50 100644
--- a/test/lisp/emacs-lisp/edebug-tests.el
+++ b/test/lisp/emacs-lisp/edebug-tests.el
@@ -1,6 +1,6 @@
;;; edebug-tests.el --- Edebug test suite -*- lexical-binding:t -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; Author: Gemini Lasswell
@@ -97,7 +97,10 @@ back to the top level.")
;; sit-on interferes with keyboard macros.
(edebug-sit-on-break nil)
- (edebug-continue-kbd-macro t))
+ (edebug-continue-kbd-macro t)
+
+ ;; don't print backtraces, otherwise error messages don't match
+ (backtrace-on-error-noninteractive nil))
,@body))
(defmacro edebug-tests-with-normal-env (&rest body)
diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el b/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el
index 73c3ea82e2d..285616a7806 100644
--- a/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el
+++ b/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el
@@ -1,6 +1,6 @@
;;; eieio-testsinvoke.el -- eieio tests for method invocation -*- lexical-binding:t -*-
-;; Copyright (C) 2005, 2008, 2010, 2013-2020 Free Software Foundation,
+;; Copyright (C) 2005, 2008, 2010, 2013-2021 Free Software Foundation,
;; Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el b/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el
index 6979da8482b..ddbef02c35a 100644
--- a/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el
+++ b/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el
@@ -1,6 +1,6 @@
;;; eieio-test-persist.el --- Tests for eieio-persistent class -*- lexical-binding:t -*-
-;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
index 21adc91e555..a47fb8053b9 100644
--- a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
+++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
@@ -1,6 +1,6 @@
;;; eieio-tests.el -- eieio test routines -*- lexical-binding: t -*-
-;; Copyright (C) 1999-2003, 2005-2010, 2012-2020 Free Software
+;; Copyright (C) 1999-2003, 2005-2010, 2012-2021 Free Software
;; Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el
index 96189356c02..40cb432708e 100644
--- a/test/lisp/emacs-lisp/ert-tests.el
+++ b/test/lisp/emacs-lisp/ert-tests.el
@@ -1,6 +1,6 @@
;;; ert-tests.el --- ERT's self-tests -*- lexical-binding: t -*-
-;; Copyright (C) 2007-2008, 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2008, 2010-2021 Free Software Foundation, Inc.
;; Author: Christian Ohler <ohler@gnu.org>
@@ -801,6 +801,21 @@ This macro is used to test if macroexpansion in `should' works."
(should (eql 0 (ert-stats-completed-unexpected stats)))
(should (eql 1 (ert-stats-skipped stats)))))
+(ert-deftest ert-test-with-demoted-errors ()
+ "Check that ERT correctly handles `with-demoted-errors'."
+ :expected-result :failed ;; FIXME! Bug#11218
+ (should-not (with-demoted-errors (error "Foo"))))
+
+(ert-deftest ert-test-fail-inside-should ()
+ "Check that `ert-fail' inside `should' works correctly."
+ (let ((result (ert-run-test
+ (make-ert-test
+ :name 'test-1
+ :body (lambda () (should (integerp (ert-fail "Boo"))))))))
+ (should (ert-test-failed-p result))
+ (should (equal (ert-test-failed-condition result)
+ '(ert-test-failed ("Boo"))))))
+
(provide 'ert-tests)
diff --git a/test/lisp/emacs-lisp/ert-x-tests.el b/test/lisp/emacs-lisp/ert-x-tests.el
index f342bff0472..f46fa63e4ce 100644
--- a/test/lisp/emacs-lisp/ert-x-tests.el
+++ b/test/lisp/emacs-lisp/ert-x-tests.el
@@ -1,6 +1,6 @@
;;; ert-x-tests.el --- Tests for ert-x.el -*- lexical-binding:t -*-
-;; Copyright (C) 2008, 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008, 2010-2021 Free Software Foundation, Inc.
;; Author: Phil Hagelberg
;; Christian Ohler <ohler@gnu.org>
diff --git a/test/lisp/emacs-lisp/faceup-resources/faceup-test-mode.el b/test/lisp/emacs-lisp/faceup-resources/faceup-test-mode.el
index c77f2dc4990..9040cc07270 100644
--- a/test/lisp/emacs-lisp/faceup-resources/faceup-test-mode.el
+++ b/test/lisp/emacs-lisp/faceup-resources/faceup-test-mode.el
@@ -1,6 +1,6 @@
;;; faceup-test-mode.el --- Dummy major mode for testing `faceup'. -*- lexical-binding:t -*-
-;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2021 Free Software Foundation, Inc.
;; Author: Anders Lindgren
;; Keywords: languages, faces
@@ -67,8 +67,8 @@ If `prog-mode' is defined, inherit from it."
(faceup-test-define-prog-mode faceup-test-mode "faceup-test"
"Dummy major mode for testing `faceup', a test system for font-lock."
- (set (make-local-variable 'syntax-propertize-function)
- #'faceup-test-syntax-propertize)
+ (setq-local syntax-propertize-function
+ #'faceup-test-syntax-propertize)
(setq font-lock-defaults '(faceup-test-font-lock-keywords nil)))
(provide 'faceup-test-mode)
diff --git a/test/lisp/emacs-lisp/faceup-resources/faceup-test-this-file-directory.el b/test/lisp/emacs-lisp/faceup-resources/faceup-test-this-file-directory.el
index d8ab02b650e..3303e7b178d 100644
--- a/test/lisp/emacs-lisp/faceup-resources/faceup-test-this-file-directory.el
+++ b/test/lisp/emacs-lisp/faceup-resources/faceup-test-this-file-directory.el
@@ -1,6 +1,6 @@
;;; faceup-test-this-file-directory.el --- Support file for faceup tests -*- lexical-binding:t -*-
-;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2021 Free Software Foundation, Inc.
;; Author: Anders Lindgren
;; Keywords: languages, faces
diff --git a/test/lisp/emacs-lisp/faceup-tests/faceup-test-basics.el b/test/lisp/emacs-lisp/faceup-tests/faceup-test-basics.el
index 3c9ec76cdf7..0c7e001cc75 100644
--- a/test/lisp/emacs-lisp/faceup-tests/faceup-test-basics.el
+++ b/test/lisp/emacs-lisp/faceup-tests/faceup-test-basics.el
@@ -1,6 +1,6 @@
;;; faceup-test-basics.el --- Tests for the `faceup' package. -*- lexical-binding:t -*-
-;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2021 Free Software Foundation, Inc.
;; Author: Anders Lindgren
;; Keywords: languages, faces
diff --git a/test/lisp/emacs-lisp/faceup-tests/faceup-test-files.el b/test/lisp/emacs-lisp/faceup-tests/faceup-test-files.el
index a87c16d66c0..16e172692c0 100644
--- a/test/lisp/emacs-lisp/faceup-tests/faceup-test-files.el
+++ b/test/lisp/emacs-lisp/faceup-tests/faceup-test-files.el
@@ -1,6 +1,6 @@
;;; faceup-test-files.el --- Self test of `faceup' using dummy major mode. -*- lexical-binding:t -*-
-;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2021 Free Software Foundation, Inc.
;; Author: Anders Lindgren
;; Keywords: languages, faces
diff --git a/test/lisp/emacs-lisp/find-func-tests.el b/test/lisp/emacs-lisp/find-func-tests.el
index d77eb6757ff..28a9a7ecda3 100644
--- a/test/lisp/emacs-lisp/find-func-tests.el
+++ b/test/lisp/emacs-lisp/find-func-tests.el
@@ -1,6 +1,6 @@
;;; find-func-tests.el --- Unit tests for find-func.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords:
@@ -27,6 +27,7 @@
;;; Code:
(require 'ert-x) ;For `ert-run-keys'.
+(require 'find-func)
(ert-deftest find-func-tests--library-completion () ;bug#43393
;; FIXME: How can we make this work in batch (see also
@@ -43,5 +44,77 @@
(concat data-directory (kbd "n x / TAB RET"))
(read-library-name)))))
+(ert-deftest find-func-tests--locate-symbols ()
+ (should (cdr
+ (find-function-search-for-symbol
+ #'goto-line nil "simple")))
+ (should (cdr
+ (find-function-search-for-symbol
+ 'minibuffer-history 'defvar "simple")))
+ (should (cdr
+ (find-function-search-for-symbol
+ 'with-current-buffer nil "subr")))
+ (should (cdr
+ (find-function-search-for-symbol
+ 'font-lock-warning-face 'defface "font-lock")))
+ (should-not (cdr
+ (find-function-search-for-symbol
+ 'wrong-variable 'defvar "simple")))
+ (should-not (cdr
+ (find-function-search-for-symbol
+ 'wrong-function nil "simple")))
+ (should (cdr (find-function-noselect #'goto-line)))
+ (should (cdr (find-function-noselect #'goto-char)))
+ ;; Setting LISP-ONLY and passing a primitive should error.
+ (should-error (find-function-noselect #'goto-char t))
+ (should-error (find-function-noselect 'wrong-function)))
+
+(defun test-locate-helper (func &optional expected-result)
+ "Assert on the result of `find-function-library' for FUNC.
+EXPECTED-RESULT is an alist (FUNC . LIBRARY) with the
+expected function symbol and function library, respectively."
+ (cl-destructuring-bind (orig-function . library)
+ (find-function-library func)
+ (cl-destructuring-bind (expected-func . expected-library)
+ expected-result
+ (should (eq orig-function expected-func))
+ (should (and
+ (not (string-empty-p expected-library))
+ (string-match-p expected-library library))))))
+
+(ert-deftest find-func-tests--locate-library ()
+ (test-locate-helper #'goto-line '(goto-line . "simple"))
+ (test-locate-helper #'forward-char '(forward-char . "cmds.c"))
+ (should-error (test-locate-helper 'wrong-function)))
+
+(ert-deftest find-func-tests--locate-adviced-symbols ()
+ (defun my-message ()
+ (message "Hello!"))
+ (advice-add #'mark-sexp :around 'my-message)
+ (test-locate-helper #'mark-sexp '(mark-sexp . "lisp"))
+ (advice-remove #'mark-sexp 'my-message))
+
+(ert-deftest find-func-tests--find-library-verbose ()
+ (find-function-library #'join-line nil t)
+ (with-current-buffer "*Messages*"
+ (save-excursion
+ (goto-char (point-max))
+ (skip-chars-backward "\n")
+ (should (string-match-p
+ ".join-line. is an alias for .delete-indentation."
+ (buffer-substring
+ (line-beginning-position)
+ (point)))))))
+
+;; Avoid a byte-compilation warning that may confuse people reading
+;; the result of the following test.
+(declare-function compilation--message->loc nil "compile")
+
+(ert-deftest find-func-tests--locate-macro-generated-symbols () ;bug#45443
+ (should (cdr (find-function-search-for-symbol
+ #'compilation--message->loc nil "compile")))
+ (should (cdr (find-function-search-for-symbol
+ 'c-mode-hook 'defvar "cc-mode"))))
+
(provide 'find-func-tests)
;;; find-func-tests.el ends here
diff --git a/test/lisp/emacs-lisp/float-sup-tests.el b/test/lisp/emacs-lisp/float-sup-tests.el
index 9f9a3daa28b..9e87928c232 100644
--- a/test/lisp/emacs-lisp/float-sup-tests.el
+++ b/test/lisp/emacs-lisp/float-sup-tests.el
@@ -1,6 +1,6 @@
;;; float-sup-tests.el --- Tests for float-sup.el -*- lexical-binding:t -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/emacs-lisp/generator-tests.el b/test/lisp/emacs-lisp/generator-tests.el
index 72eee07be8c..ffcd16ad094 100644
--- a/test/lisp/emacs-lisp/generator-tests.el
+++ b/test/lisp/emacs-lisp/generator-tests.el
@@ -1,6 +1,6 @@
;;; generator-tests.el --- Testing generators -*- lexical-binding: t -*-
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Author: Daniel Colascione <dancol@dancol.org>
;; Keywords:
diff --git a/test/lisp/emacs-lisp/gv-tests.el b/test/lisp/emacs-lisp/gv-tests.el
index 29e4273b478..b9850eca8b9 100644
--- a/test/lisp/emacs-lisp/gv-tests.el
+++ b/test/lisp/emacs-lisp/gv-tests.el
@@ -1,6 +1,6 @@
;;; gv-tests.el --- tests for gv.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -83,7 +83,10 @@
(with-temp-buffer
(call-process (concat invocation-directory invocation-name)
nil '(t t) nil
- "-Q" "-batch" "--eval" (prin1-to-string `(byte-compile-file ,el))
+ "-Q" "-batch"
+ "--eval" (prin1-to-string
+ `(let ((backtrace-on-error-noninteractive nil))
+ (byte-compile-file ,el)))
"-l" elc)
(should (equal (buffer-string)
"Symbol's function definition is void: \\(setf\\ gv-test-foo\\)\n")))))
@@ -133,8 +136,10 @@
"-Q" "-batch" "--eval" (prin1-to-string `(byte-compile-file ,el))
"-l" elc
"--eval"
- (prin1-to-string '(progn (setf (gv-test-foo gv-test-pair) 99)
- (message "%d" (car gv-test-pair)))))
+ (prin1-to-string
+ '(let ((backtrace-on-error-noninteractive nil))
+ (setf (gv-test-foo gv-test-pair) 99)
+ (message "%d" (car gv-test-pair)))))
(should (string-match
"\\`Symbol.s function definition is void: \\\\(setf\\\\ gv-test-foo\\\\)\n\\'"
(buffer-string))))))
diff --git a/test/lisp/emacs-lisp/let-alist-tests.el b/test/lisp/emacs-lisp/let-alist-tests.el
index d283ecbe926..d856696da24 100644
--- a/test/lisp/emacs-lisp/let-alist-tests.el
+++ b/test/lisp/emacs-lisp/let-alist-tests.el
@@ -1,6 +1,6 @@
;;; let-alist.el --- tests for file handling. -*- lexical-binding: t; -*-
-;; Copyright (C) 2012-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/emacs-lisp/lisp-mode-tests.el b/test/lisp/emacs-lisp/lisp-mode-tests.el
index d1183d83f6a..85db3a00c8e 100644
--- a/test/lisp/emacs-lisp/lisp-mode-tests.el
+++ b/test/lisp/emacs-lisp/lisp-mode-tests.el
@@ -1,6 +1,6 @@
;;; lisp-mode-tests.el --- Test Lisp editing commands -*- lexical-binding: t; -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; 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
diff --git a/test/lisp/emacs-lisp/lisp-tests.el b/test/lisp/emacs-lisp/lisp-tests.el
index 437b907ba13..fd07011137a 100644
--- a/test/lisp/emacs-lisp/lisp-tests.el
+++ b/test/lisp/emacs-lisp/lisp-tests.el
@@ -1,6 +1,6 @@
;;; lisp-tests.el --- Test Lisp editing commands -*- lexical-binding: t; -*-
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; Author: Aaron S. Hawley <aaron.s.hawley@gmail.com>
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
diff --git a/test/lisp/emacs-lisp/map-tests.el b/test/lisp/emacs-lisp/map-tests.el
index 1888baf6017..9a2cd42a211 100644
--- a/test/lisp/emacs-lisp/map-tests.el
+++ b/test/lisp/emacs-lisp/map-tests.el
@@ -1,6 +1,6 @@
;;; map-tests.el --- Tests for map.el -*- lexical-binding:t -*-
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Author: Nicolas Petton <nicolas@petton.fr>
;; Maintainer: emacs-devel@gnu.org
diff --git a/test/lisp/emacs-lisp/memory-report-tests.el b/test/lisp/emacs-lisp/memory-report-tests.el
new file mode 100644
index 00000000000..da5f4f5700f
--- /dev/null
+++ b/test/lisp/emacs-lisp/memory-report-tests.el
@@ -0,0 +1,57 @@
+;;; memory-report-tests.el --- tests for memory-report.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+(require 'ert)
+(require 'memory-report)
+
+(defun setup-memory-report-tests ()
+ ;; Set the sizes on things based on a 64-bit architecture. (We're
+ ;; hard-coding this to be able to write simple tests that'll work on
+ ;; all architectures.)
+ (memory-report--set-size
+ '((conses 16 499173 99889)
+ (symbols 48 22244 3)
+ (strings 32 92719 4559)
+ (string-bytes 1 40402011)
+ (vectors 16 31919)
+ (vector-slots 8 385148 149240)
+ (floats 8 434 4519)
+ (intervals 56 24499 997)
+ (buffers 984 33))))
+
+(ert-deftest memory-report-sizes ()
+ (setup-memory-report-tests)
+ (should (equal (memory-report-object-size (cons nil nil)) 16))
+ (should (equal (memory-report-object-size (cons 1 2)) 16))
+
+ (should (equal (memory-report-object-size (list 1 2)) 32))
+ (should (equal (memory-report-object-size (list 1)) 16))
+
+ (should (equal (memory-report-object-size (list 'foo)) 16))
+
+ (should (equal (memory-report-object-size (vector 1 2 3 4)) 80))
+
+ (should (equal (memory-report-object-size "") 32))
+ (should (equal (memory-report-object-size "a") 33))
+ (should (equal (memory-report-object-size (propertize "a" 'face 'foo))
+ 81)))
+
+(provide 'memory-report-tests)
+
+;;; memory-report-tests.el ends here
diff --git a/test/lisp/emacs-lisp/nadvice-tests.el b/test/lisp/emacs-lisp/nadvice-tests.el
index a955df0a696..358d9025ad5 100644
--- a/test/lisp/emacs-lisp/nadvice-tests.el
+++ b/test/lisp/emacs-lisp/nadvice-tests.el
@@ -1,6 +1,6 @@
;;; nadvice-tests.el --- Test suite for the new advice thingy. -*- lexical-binding:t -*-
-;; Copyright (C) 2012-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/emacs-lisp/package-resources/signed/update-signatures.sh b/test/lisp/emacs-lisp/package-resources/signed/update-signatures.sh
index a48c9bb1aa2..ca16f8b27a1 100755
--- a/test/lisp/emacs-lisp/package-resources/signed/update-signatures.sh
+++ b/test/lisp/emacs-lisp/package-resources/signed/update-signatures.sh
@@ -2,7 +2,7 @@
# Generate a new key and update the signatures for tests.
-# Copyright (C) 2020 Free Software Foundation, Inc.
+# Copyright (C) 2020-2021 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
diff --git a/test/lisp/emacs-lisp/package-tests.el b/test/lisp/emacs-lisp/package-tests.el
index 23267545f83..67d647d3b9e 100644
--- a/test/lisp/emacs-lisp/package-tests.el
+++ b/test/lisp/emacs-lisp/package-tests.el
@@ -1,6 +1,6 @@
;;; package-tests.el --- Tests for the Emacs package system -*- lexical-binding:t -*-
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; Author: Daniel Hackney <dan@haxney.org>
;; Version: 1.0
@@ -405,9 +405,9 @@ Must called from within a `tar-mode' buffer."
(ert-deftest package-test-list-filter-by-name ()
"Ensure package list is filtered correctly by package name."
(with-package-menu-test ()
- (package-menu-filter-by-name "tetris")
+ (package-menu-filter-by-name "ansi-color")
(goto-char (point-min))
- (should (re-search-forward "^\\s-+tetris" nil t))
+ (should (re-search-forward "^\\s-+ansi-color" nil t))
(should (= (count-lines (point-min) (point-max)) 1))))
(ert-deftest package-test-list-filter-by-status ()
@@ -463,7 +463,7 @@ Must called from within a `tar-mode' buffer."
"Ensure package list filter is cleared correctly."
(with-package-menu-test
(let ((num-packages (count-lines (point-min) (point-max))))
- (package-menu-filter-by-name "tetris")
+ (package-menu-filter-by-name "ansi-color")
(should (= (count-lines (point-min) (point-max)) 1))
(package-menu-clear-filter)
(should (= (count-lines (point-min) (point-max)) num-packages)))))
diff --git a/test/lisp/emacs-lisp/pcase-tests.el b/test/lisp/emacs-lisp/pcase-tests.el
index ac512416b71..e6f4c097504 100644
--- a/test/lisp/emacs-lisp/pcase-tests.el
+++ b/test/lisp/emacs-lisp/pcase-tests.el
@@ -1,6 +1,6 @@
;;; pcase-tests.el --- Test suite for pcase macro. -*- lexical-binding:t -*-
-;; Copyright (C) 2012-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -32,6 +32,10 @@
(should (equal (pcase '(2 . 3) ;bug#18554
(`(,hd . ,(and (pred atom) tl)) (list hd tl))
((pred consp) nil))
+ '(2 3)))
+ (should (equal (pcase '(2 . 3)
+ (`(,hd . ,(and (pred (not consp)) tl)) (list hd tl))
+ ((pred consp) nil))
'(2 3))))
(pcase-defmacro pcase-tests-plus (pat n)
diff --git a/test/lisp/emacs-lisp/pp-tests.el b/test/lisp/emacs-lisp/pp-tests.el
index 8e8de08a408..b04030cc432 100644
--- a/test/lisp/emacs-lisp/pp-tests.el
+++ b/test/lisp/emacs-lisp/pp-tests.el
@@ -1,6 +1,6 @@
;;; pp-tests.el --- Test suite for pretty printer. -*- lexical-binding: t -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/emacs-lisp/regexp-opt-tests.el b/test/lisp/emacs-lisp/regexp-opt-tests.el
index ff93b8b759e..940feb5e828 100644
--- a/test/lisp/emacs-lisp/regexp-opt-tests.el
+++ b/test/lisp/emacs-lisp/regexp-opt-tests.el
@@ -1,6 +1,6 @@
;;; regexp-opt-tests.el --- Tests for regexp-opt.el -*- lexical-binding: t -*-
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: internal
diff --git a/test/lisp/emacs-lisp/ring-tests.el b/test/lisp/emacs-lisp/ring-tests.el
index e348165366e..55df4f36685 100644
--- a/test/lisp/emacs-lisp/ring-tests.el
+++ b/test/lisp/emacs-lisp/ring-tests.el
@@ -1,6 +1,6 @@
;;; ring-tests.el --- Tests for ring.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2016-2021 Free Software Foundation, Inc.
;; Author: Simen Heggestøyl <simenheg@gmail.com>
;; Keywords:
diff --git a/test/lisp/emacs-lisp/rmc-tests.el b/test/lisp/emacs-lisp/rmc-tests.el
index 5add24c479a..9d8f3d48014 100644
--- a/test/lisp/emacs-lisp/rmc-tests.el
+++ b/test/lisp/emacs-lisp/rmc-tests.el
@@ -1,6 +1,6 @@
;;; rmc-tests.el --- Test suite for rmc.el -*- lexical-binding: t -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; Author: Tino Calancha <tino.calancha@gmail.com>
;; Keywords:
diff --git a/test/lisp/emacs-lisp/rx-tests.el b/test/lisp/emacs-lisp/rx-tests.el
index 59d8c600a20..63d7c7b91ea 100644
--- a/test/lisp/emacs-lisp/rx-tests.el
+++ b/test/lisp/emacs-lisp/rx-tests.el
@@ -1,6 +1,6 @@
;;; rx-tests.el --- tests for rx.el -*- lexical-binding: t -*-
-;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2016-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -167,7 +167,11 @@
(let ((k "blue"))
(should (equal (pcase "<blue>"
((rx "<" (literal k) ">") 'ok))
- 'ok))))
+ 'ok)))
+ (should (equal (pcase "abc"
+ ((rx (? (let x alpha)) (?? (let y alnum)) ?c)
+ (list x y)))
+ '("a" "b"))))
(ert-deftest rx-kleene ()
"Test greedy and non-greedy repetition operators."
@@ -540,7 +544,7 @@
(ert-deftest rx-compat ()
"Test old symbol retained for compatibility (bug#37517)."
(should (equal
- (with-suppressed-warnings ((obsolete rx-submatch-n))
+ (with-no-warnings
(rx-submatch-n '(group-n 3 (+ nonl) eol)))
"\\(?3:.+$\\)")))
diff --git a/test/lisp/emacs-lisp/seq-tests.el b/test/lisp/emacs-lisp/seq-tests.el
index a6a80952360..670398354a6 100644
--- a/test/lisp/emacs-lisp/seq-tests.el
+++ b/test/lisp/emacs-lisp/seq-tests.el
@@ -1,6 +1,6 @@
;;; seq-tests.el --- Tests for seq.el -*- lexical-binding:t -*-
-;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2021 Free Software Foundation, Inc.
;; Author: Nicolas Petton <nicolas@petton.fr>
;; Maintainer: emacs-devel@gnu.org
diff --git a/test/lisp/emacs-lisp/shadow-tests.el b/test/lisp/emacs-lisp/shadow-tests.el
index 5d6215ab6f3..52d1d21cee1 100644
--- a/test/lisp/emacs-lisp/shadow-tests.el
+++ b/test/lisp/emacs-lisp/shadow-tests.el
@@ -1,6 +1,6 @@
;;; shadow-tests.el --- Test suite for shadow. -*- lexical-binding: t -*-
-;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2018-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/emacs-lisp/subr-x-tests.el b/test/lisp/emacs-lisp/subr-x-tests.el
index 9d14a5ab7ec..112f3c1dac1 100644
--- a/test/lisp/emacs-lisp/subr-x-tests.el
+++ b/test/lisp/emacs-lisp/subr-x-tests.el
@@ -1,6 +1,6 @@
;;; subr-x-tests.el --- Testing the extended lisp routines -*- lexical-binding:t -*-
-;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2021 Free Software Foundation, Inc.
;; Author: Fabián E. Gallina <fgallina@gnu.org>
;; Keywords:
@@ -582,5 +582,58 @@
(should (equal (string-remove-suffix "a" "aa") "a"))
(should (equal (string-remove-suffix "a" "ba") "b")))
+(ert-deftest subr-clean-whitespace ()
+ (should (equal (string-clean-whitespace " foo ") "foo"))
+ (should (equal (string-clean-whitespace " foo \r\n\t  Bar") "foo Bar")))
+
+(ert-deftest subr-string-fill ()
+ (should (equal (string-fill "foo" 10) "foo"))
+ (should (equal (string-fill "foobar" 5) "foobar"))
+ (should (equal (string-fill "foo bar zot" 5) "foo\nbar\nzot"))
+ (should (equal (string-fill "foo bar zot" 7) "foo bar\nzot")))
+
+(ert-deftest subr-string-limit ()
+ (should (equal (string-limit "foo" 10) "foo"))
+ (should (equal (string-limit "foo" 2) "fo"))
+ (should (equal (string-limit "foo" 2 t) "oo"))
+ (should (equal (string-limit "abc" 10 t) "abc"))
+ (should (equal (string-limit "foo" 0) ""))
+ (should-error (string-limit "foo" -1)))
+
+(ert-deftest subr-string-limit-coding ()
+ (should (not (multibyte-string-p (string-limit "foó" 10 nil 'utf-8))))
+ (should (equal (string-limit "foó" 10 nil 'utf-8) "fo\303\263"))
+ (should (equal (string-limit "foó" 3 nil 'utf-8) "fo"))
+ (should (equal (string-limit "foó" 4 nil 'utf-8) "fo\303\263"))
+ (should (equal (string-limit "foóa" 4 nil 'utf-8) "fo\303\263"))
+ (should (equal (string-limit "foóá" 4 nil 'utf-8) "fo\303\263"))
+ (should (equal (string-limit "foóa" 4 nil 'iso-8859-1) "fo\363a"))
+ (should (equal (string-limit "foóá" 4 nil 'iso-8859-1) "fo\363\341"))
+ (should (equal (string-limit "foóá" 4 nil 'utf-16) "\376\377\000f"))
+
+ (should (equal (string-limit "foó" 10 t 'utf-8) "fo\303\263"))
+ (should (equal (string-limit "foó" 3 t 'utf-8) "o\303\263"))
+ (should (equal (string-limit "foó" 4 t 'utf-8) "fo\303\263"))
+ (should (equal (string-limit "foóa" 4 t 'utf-8) "o\303\263a"))
+ (should (equal (string-limit "foóá" 4 t 'utf-8) "\303\263\303\241"))
+ (should (equal (string-limit "foóa" 4 t 'iso-8859-1) "fo\363a"))
+ (should (equal (string-limit "foóá" 4 t 'iso-8859-1) "fo\363\341"))
+ (should (equal (string-limit "foóá" 4 t 'utf-16) "\376\377\000\341")))
+
+(ert-deftest subr-string-lines ()
+ (should (equal (string-lines "foo") '("foo")))
+ (should (equal (string-lines "foo \nbar") '("foo " "bar"))))
+
+(ert-deftest subr-string-pad ()
+ (should (equal (string-pad "foo" 5) "foo "))
+ (should (equal (string-pad "foo" 5 ?-) "foo--"))
+ (should (equal (string-pad "foo" 5 ?- t) "--foo"))
+ (should (equal (string-pad "foo" 2 ?-) "foo")))
+
+(ert-deftest subr-string-chop-newline ()
+ (should (equal (string-chop-newline "foo\n") "foo"))
+ (should (equal (string-chop-newline "foo\nbar\n") "foo\nbar"))
+ (should (equal (string-chop-newline "foo\nbar") "foo\nbar")))
+
(provide 'subr-x-tests)
;;; subr-x-tests.el ends here
diff --git a/test/lisp/emacs-lisp/syntax-tests.el b/test/lisp/emacs-lisp/syntax-tests.el
index 9d4c4113fdd..1ae1cbc93ff 100644
--- a/test/lisp/emacs-lisp/syntax-tests.el
+++ b/test/lisp/emacs-lisp/syntax-tests.el
@@ -1,6 +1,6 @@
;;; syntax-tests.el --- tests for syntax.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/emacs-lisp/tabulated-list-test.el b/test/lisp/emacs-lisp/tabulated-list-test.el
index 7486e2b9333..db1ce312586 100644
--- a/test/lisp/emacs-lisp/tabulated-list-test.el
+++ b/test/lisp/emacs-lisp/tabulated-list-test.el
@@ -1,6 +1,6 @@
;;; tabulated-list-test.el --- Tests for emacs-lisp/tabulated-list.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
diff --git a/test/lisp/emacs-lisp/testcover-resources/testcases.el b/test/lisp/emacs-lisp/testcover-resources/testcases.el
index 77edf2fec22..5dbf2272b1a 100644
--- a/test/lisp/emacs-lisp/testcover-resources/testcases.el
+++ b/test/lisp/emacs-lisp/testcover-resources/testcases.el
@@ -1,6 +1,6 @@
;;;; testcases.el -- Test cases for testcover-tests.el
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; Author: Gemini Lasswell
diff --git a/test/lisp/emacs-lisp/testcover-tests.el b/test/lisp/emacs-lisp/testcover-tests.el
index 9e7a3bf31e3..9f0312d85ff 100644
--- a/test/lisp/emacs-lisp/testcover-tests.el
+++ b/test/lisp/emacs-lisp/testcover-tests.el
@@ -1,6 +1,6 @@
;;; testcover-tests.el --- Testcover test suite -*- lexical-binding:t -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; Author: Gemini Lasswell
diff --git a/test/lisp/emacs-lisp/text-property-search-tests.el b/test/lisp/emacs-lisp/text-property-search-tests.el
index f643e49aa5e..90f06c3c4c0 100644
--- a/test/lisp/emacs-lisp/text-property-search-tests.el
+++ b/test/lisp/emacs-lisp/text-property-search-tests.el
@@ -1,6 +1,6 @@
;;; text-property-search-tests.el --- Testing text-property-search -*- lexical-binding:t -*-
-;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2018-2021 Free Software Foundation, Inc.
;; Author: Lars Ingebrigtsen <larsi@gnus.org>
;; Keywords:
diff --git a/test/lisp/emacs-lisp/thunk-tests.el b/test/lisp/emacs-lisp/thunk-tests.el
index 67ec415d6dd..1a8537f3b79 100644
--- a/test/lisp/emacs-lisp/thunk-tests.el
+++ b/test/lisp/emacs-lisp/thunk-tests.el
@@ -1,6 +1,6 @@
;;; thunk-tests.el --- Tests for thunk.el -*- lexical-binding: t -*-
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Author: Nicolas Petton <nicolas@petton.fr>
;; Maintainer: emacs-devel@gnu.org
diff --git a/test/lisp/emacs-lisp/timer-tests.el b/test/lisp/emacs-lisp/timer-tests.el
index bc712ee960f..7856c217f9e 100644
--- a/test/lisp/emacs-lisp/timer-tests.el
+++ b/test/lisp/emacs-lisp/timer-tests.el
@@ -1,6 +1,6 @@
;;; timer-tests.el --- tests for timers -*- lexical-binding:t -*-
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -36,8 +36,8 @@
(ert-deftest timer-tests-debug-timer-check ()
;; This function exists only if --enable-checking.
- (if (fboundp 'debug-timer-check)
- (should (debug-timer-check)) t))
+ (skip-unless (fboundp 'debug-timer-check))
+ (should (debug-timer-check)))
(ert-deftest timer-test-multiple-of-time ()
(should (time-equal-p
diff --git a/test/lisp/emacs-lisp/unsafep-tests.el b/test/lisp/emacs-lisp/unsafep-tests.el
index 06c40d28ca9..b2a48d80675 100644
--- a/test/lisp/emacs-lisp/unsafep-tests.el
+++ b/test/lisp/emacs-lisp/unsafep-tests.el
@@ -2,7 +2,7 @@
;; Author: Jonathan Yavner <jyavner@member.fsf.org>
-;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/emacs-lisp/warnings-tests.el b/test/lisp/emacs-lisp/warnings-tests.el
index 02c09b41ca5..aa394634827 100644
--- a/test/lisp/emacs-lisp/warnings-tests.el
+++ b/test/lisp/emacs-lisp/warnings-tests.el
@@ -2,7 +2,7 @@
;; Author: Stefan Kangas <stefankangas@gmail.com>
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/emulation/viper-tests.el b/test/lisp/emulation/viper-tests.el
index b981938fe19..0d999763b61 100644
--- a/test/lisp/emulation/viper-tests.el
+++ b/test/lisp/emulation/viper-tests.el
@@ -1,6 +1,6 @@
;;; viper-tests.el --- tests for viper. -*- lexical-binding:t -*-
-;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2016-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/epg-tests.el b/test/lisp/epg-tests.el
index c9c92f529be..741574f0adf 100644
--- a/test/lisp/epg-tests.el
+++ b/test/lisp/epg-tests.el
@@ -1,6 +1,6 @@
;;; epg-tests.el --- Test suite for epg.el -*- lexical-binding: t -*-
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -96,8 +96,7 @@
context
(ert-resource-file "seckey.asc")))
(with-temp-buffer
- (make-local-variable 'epg-tests-context)
- (setq epg-tests-context context)
+ (setq-local epg-tests-context context)
,@body))
(when (file-directory-p epg-tests-home-directory)
(delete-directory epg-tests-home-directory t)))))
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 27f48fa8131..26e14b98e91 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -1,6 +1,6 @@
;;; erc-tests.el --- Tests for erc. -*- lexical-binding:t -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; Author: Lars Ingebrigtsen <larsi@gnus.org>
diff --git a/test/lisp/erc/erc-track-tests.el b/test/lisp/erc/erc-track-tests.el
index 457f08cb73c..0ce93bd45c6 100644
--- a/test/lisp/erc/erc-track-tests.el
+++ b/test/lisp/erc/erc-track-tests.el
@@ -1,6 +1,6 @@
;;; erc-track-tests.el --- Tests for erc-track. -*- lexical-binding:t -*-
-;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2016-2021 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@delysid.org>
;; Author: Vivek Dasmohapatra <vivek@etla.org>
@@ -24,7 +24,6 @@
(require 'ert)
(require 'erc-track)
-(require 'font-core)
(ert-deftest erc-track--shorten-aggressive-nil ()
"Test non-aggressive erc track buffer name shortening."
diff --git a/test/lisp/eshell/em-hist-tests.el b/test/lisp/eshell/em-hist-tests.el
index 5bb16f64a46..ec65397fd63 100644
--- a/test/lisp/eshell/em-hist-tests.el
+++ b/test/lisp/eshell/em-hist-tests.el
@@ -1,6 +1,6 @@
;;; tests/em-hist-tests.el --- em-hist test suite -*- lexical-binding:t -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/eshell/em-ls-tests.el b/test/lisp/eshell/em-ls-tests.el
index 975701e3838..fc2cd9c8e14 100644
--- a/test/lisp/eshell/em-ls-tests.el
+++ b/test/lisp/eshell/em-ls-tests.el
@@ -1,6 +1,6 @@
;;; tests/em-ls-tests.el --- em-ls test suite -*- lexical-binding:t -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; Author: Tino Calancha <tino.calancha@gmail.com>
diff --git a/test/lisp/eshell/esh-opt-tests.el b/test/lisp/eshell/esh-opt-tests.el
index caba153cf73..0c99da64b2e 100644
--- a/test/lisp/eshell/esh-opt-tests.el
+++ b/test/lisp/eshell/esh-opt-tests.el
@@ -1,6 +1,6 @@
;;; tests/esh-opt-tests.el --- esh-opt test suite -*- lexical-binding:t -*-
-;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2018-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/eshell/eshell-tests.el b/test/lisp/eshell/eshell-tests.el
index 1b93fb0fbbc..4dac7024f41 100644
--- a/test/lisp/eshell/eshell-tests.el
+++ b/test/lisp/eshell/eshell-tests.el
@@ -1,6 +1,6 @@
;;; tests/eshell-tests.el --- Eshell test suite -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
diff --git a/test/lisp/faces-resources/faces-test-dark-theme.el b/test/lisp/faces-resources/faces-test-dark-theme.el
index a5e2ca43627..f3ef6b67fa7 100644
--- a/test/lisp/faces-resources/faces-test-dark-theme.el
+++ b/test/lisp/faces-resources/faces-test-dark-theme.el
@@ -1,6 +1,6 @@
;;; faces-test-dark-theme.el --- A dark theme from tests ;;; -*- lexical-binding: t; -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/faces-resources/faces-test-light-theme.el b/test/lisp/faces-resources/faces-test-light-theme.el
index b2f7ec69742..390b8461644 100644
--- a/test/lisp/faces-resources/faces-test-light-theme.el
+++ b/test/lisp/faces-resources/faces-test-light-theme.el
@@ -1,6 +1,6 @@
;;; faces-test-light-theme.el --- A dark theme from tests ;;; -*- lexical-binding: t; -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/faces-tests.el b/test/lisp/faces-tests.el
index b19cef5decd..6e77259fe1b 100644
--- a/test/lisp/faces-tests.el
+++ b/test/lisp/faces-tests.el
@@ -1,6 +1,6 @@
;;; faces-tests.el --- Tests for faces.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
;; Keywords:
@@ -24,7 +24,6 @@
(require 'ert)
(require 'ert-x)
-(require 'faces)
(defgroup faces--test nil ""
:group 'faces--test)
diff --git a/test/lisp/ffap-tests.el b/test/lisp/ffap-tests.el
index ca8c10831fd..3ceb392d7fb 100644
--- a/test/lisp/ffap-tests.el
+++ b/test/lisp/ffap-tests.el
@@ -1,6 +1,6 @@
;;; ffap-tests.el --- Test suite for ffap.el -*- lexical-binding: t -*-
-;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2016-2021 Free Software Foundation, Inc.
;; Author: Tino Calancha <tino.calancha@gmail.com>
diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el
index 268c3185bc6..d73b072661a 100644
--- a/test/lisp/filenotify-tests.el
+++ b/test/lisp/filenotify-tests.el
@@ -1,6 +1,6 @@
;;; filenotify-tests.el --- Tests of file notifications -*- lexical-binding: t; -*-
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
@@ -108,11 +108,8 @@ There are different timeouts for local and remote file notification libraries."
;; gio/gpollfilemonitor.c declares POLL_TIME_SECS 5. So we must
;; wait at least this time in the GPollFileMonitor case. A
;; similar timeout seems to be needed in the GFamFileMonitor case,
- ;; at least on Cygwin.
- ((and (string-equal (file-notify--test-library) "gfilenotify")
- (memq (file-notify--test-monitor)
- '(GFamFileMonitor GPollFileMonitor)))
- 7)
+ ;; at least on cygwin.
+ ((memq (file-notify--test-monitor) '(GFamFileMonitor GPollFileMonitor)) 7)
((string-equal (file-notify--test-library) "gvfs-monitor-dir.exe") 1)
((file-remote-p temporary-file-directory) 0.1)
(t 0.01))))
@@ -264,13 +261,19 @@ This returns only for the local case and gfilenotify; otherwise it is nil.
;; We cache the result, because after `file-notify-rm-watch',
;; `gfile-monitor-name' does not return a proper result anymore.
;; But we still need this information.
- (unless (file-remote-p temporary-file-directory)
- (or (cdr (assq file-notify--test-desc file-notify--test-monitors))
- (when (functionp 'gfile-monitor-name)
- (add-to-list 'file-notify--test-monitors
- (cons file-notify--test-desc
- (gfile-monitor-name file-notify--test-desc)))
- (cdr (assq file-notify--test-desc file-notify--test-monitors))))))
+ ;; So far, we know the monitors GFamFileMonitor, GFenFileMonitor,
+ ;; GInotifyFileMonitor, GKqueueFileMonitor and GPollFileMonitor.
+ (or (cdr (assq file-notify--test-desc file-notify--test-monitors))
+ (progn
+ (add-to-list
+ 'file-notify--test-monitors
+ (cons file-notify--test-desc
+ (if (file-remote-p temporary-file-directory)
+ (tramp-get-connection-property
+ file-notify--test-desc "gio-file-monitor" nil)
+ (and (functionp 'gfile-monitor-name)
+ (gfile-monitor-name file-notify--test-desc)))))
+ (cdr (assq file-notify--test-desc file-notify--test-monitors)))))
(defmacro file-notify--deftest-remote (test docstring &optional unstable)
"Define ert `TEST-remote' for remote files.
@@ -457,7 +460,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
(unwind-protect
;; Check, that removing watch descriptors out of order do not
- ;; harm. This fails on Cygwin because of timing issues unless a
+ ;; harm. This fails on cygwin because of timing issues unless a
;; long `sit-for' is added before the call to
;; `file-notify--test-read-event'.
(unless (eq system-type 'cygwin)
@@ -631,13 +634,15 @@ delivered."
(cond
;; gvfs-monitor-dir on cygwin does not detect the
;; `created' event reliably.
- ((string-equal
- (file-notify--test-library) "gvfs-monitor-dir.exe")
+ ((string-equal (file-notify--test-library) "gvfs-monitor-dir.exe")
'((deleted stopped)
(created deleted stopped)))
;; cygwin does not raise a `changed' event.
((eq system-type 'cygwin)
'(created deleted stopped))
+ ;; GKqueueFileMonitor does not report the `changed' event.
+ ((equal (file-notify--test-monitor) 'GKqueueFileMonitor)
+ '(created deleted stopped))
(t '(created changed deleted stopped)))
(write-region
"another text" nil file-notify--test-tmpfile nil 'no-message)
@@ -668,6 +673,9 @@ delivered."
((string-equal (file-notify--test-library) "gvfs-monitor-dir.exe")
'((deleted stopped)
(changed deleted stopped)))
+ ;; GKqueueFileMonitor does not report the `changed' event.
+ ((equal (file-notify--test-monitor) 'GKqueueFileMonitor)
+ '(deleted stopped))
;; There could be one or two `changed' events.
(t '((changed deleted stopped)
(changed changed deleted stopped))))
@@ -718,6 +726,9 @@ delivered."
'(created deleted stopped))
((string-equal (file-notify--test-library) "kqueue")
'(created changed deleted stopped))
+ ;; GKqueueFileMonitor does not report the `changed' event.
+ ((equal (file-notify--test-monitor) 'GKqueueFileMonitor)
+ '(created deleted deleted stopped))
(t '(created changed deleted deleted stopped)))
(write-region
"any text" nil file-notify--test-tmpfile nil 'no-message)
@@ -767,6 +778,9 @@ delivered."
;; directory are not detected.
((getenv "EMACS_EMBA_CI")
'(created changed created changed deleted deleted))
+ ;; GKqueueFileMonitor does not report the `changed' event.
+ ((equal (file-notify--test-monitor) 'GKqueueFileMonitor)
+ '(created created deleted deleted deleted stopped))
(t '(created changed created changed
deleted deleted deleted stopped)))
(write-region
@@ -823,6 +837,9 @@ delivered."
'(created created deleted deleted stopped))
((string-equal (file-notify--test-library) "kqueue")
'(created changed renamed deleted stopped))
+ ;; GKqueueFileMonitor does not report the `changed' event.
+ ((equal (file-notify--test-monitor) 'GKqueueFileMonitor)
+ '(created renamed deleted deleted stopped))
(t '(created changed renamed deleted deleted stopped)))
(write-region
"any text" nil file-notify--test-tmpfile nil 'no-message)
@@ -859,6 +876,8 @@ delivered."
((string-equal (file-notify--test-library) "w32notify")
'((changed changed)
(changed changed changed changed)))
+ ;; GKqueueFileMonitor does not report the `attribute-changed' event.
+ ((equal (file-notify--test-monitor) 'GKqueueFileMonitor) nil)
;; For kqueue and in the remote case, `write-region'
;; raises also an `attribute-changed' event.
((or (string-equal (file-notify--test-library) "kqueue")
@@ -925,6 +944,10 @@ delivered."
;; timeouts.
(setq file-notify--test-desc auto-revert-notify-watch-descriptor)
+ ;; GKqueueFileMonitor does not report the `changed' event.
+ (skip-unless
+ (not (equal (file-notify--test-monitor) 'GKqueueFileMonitor)))
+
;; Check, that file notification has been used.
(should auto-revert-mode)
(should auto-revert-use-notify)
@@ -956,7 +979,7 @@ delivered."
;; Modify file. We wait for two seconds, in order to
;; have another timestamp. One second seems to be too
- ;; short. And Cygwin sporadically requires more than two.
+ ;; short. And cygwin sporadically requires more than two.
(ert-with-message-capture captured-messages
(let ((inhibit-message t))
(sleep-for (if (eq system-type 'cygwin) 3 2))
@@ -1028,6 +1051,9 @@ delivered."
((string-equal (file-notify--test-library) "gvfs-monitor-dir.exe")
'((deleted stopped)
(changed deleted stopped)))
+ ;; GKqueueFileMonitor does not report the `changed' event.
+ ((equal (file-notify--test-monitor) 'GKqueueFileMonitor)
+ '(deleted stopped))
;; There could be one or two `changed' events.
(t '((changed deleted stopped)
(changed changed deleted stopped))))
@@ -1077,6 +1103,9 @@ delivered."
'(created deleted stopped))
((string-equal (file-notify--test-library) "kqueue")
'(created changed deleted stopped))
+ ;; GKqueueFileMonitor does not report the `changed' event.
+ ((equal (file-notify--test-monitor) 'GKqueueFileMonitor)
+ '(created deleted deleted stopped))
(t '(created changed deleted deleted stopped)))
(write-region
"any text" nil file-notify--test-tmpfile nil 'no-message)
@@ -1236,7 +1265,7 @@ delivered."
;; Unpredictable failures, eg https://hydra.nixos.org/build/86016286
(file-notify--deftest-remote file-notify-test07-many-events
"Check that events are not dropped for remote directories."
- (getenv "EMACS_HYDRA_CI"))
+ (or (getenv "EMACS_HYDRA_CI") (getenv "EMACS_EMBA_CI")))
(ert-deftest file-notify-test08-backup ()
"Check that backup keeps file notification."
@@ -1254,9 +1283,12 @@ delivered."
'(change) #'file-notify--test-event-handler)))
(should (file-notify-valid-p file-notify--test-desc))
(file-notify--test-with-actions
- ;; There could be one or two `changed' events.
- '((changed)
- (changed changed))
+ (cond
+ ;; GKqueueFileMonitor does not report the `changed' event.
+ ((equal (file-notify--test-monitor) 'GKqueueFileMonitor) nil)
+ ;; There could be one or two `changed' events.
+ (t '((changed)
+ (changed changed))))
;; There shouldn't be any problem, because the file is kept.
(with-temp-buffer
(let ((buffer-file-name file-notify--test-tmpfile)
@@ -1294,6 +1326,9 @@ delivered."
;; On cygwin we only get the `changed' event.
((eq system-type 'cygwin)
'(changed))
+ ;; GKqueueFileMonitor does not report the `changed' event.
+ ((equal (file-notify--test-monitor) 'GKqueueFileMonitor)
+ '(renamed created))
(t '(renamed created changed)))
;; The file is renamed when creating a backup. It shall
;; still be watched.
@@ -1391,7 +1426,12 @@ the file watch."
(make-list (/ n 2) 'changed)
;; Just the directory monitor.
(make-list (/ n 2) 'created)
- (make-list (/ n 2) 'changed)))
+ (make-list (/ n 2) 'changed))
+ (append
+ '(:random)
+ ;; Just the directory monitor. GKqueueFileMonitor
+ ;; does not report the `changed' event.
+ (make-list (/ n 2) 'created)))
(dotimes (i n)
(file-notify--test-read-event)
(if (zerop (mod i 2))
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index 8818099a223..149cc689ae9 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -1,6 +1,6 @@
;;; files-tests.el --- tests for files.el. -*- lexical-binding: t; -*-
-;; Copyright (C) 2012-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/files-x-tests.el b/test/lisp/files-x-tests.el
index 9db198384d0..e97e2c325ec 100644
--- a/test/lisp/files-x-tests.el
+++ b/test/lisp/files-x-tests.el
@@ -1,6 +1,6 @@
;;; files-x-tests.el --- tests for files-x.el. -*- lexical-binding: t -*-
-;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2016-2021 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
@@ -274,7 +274,8 @@
(should-not (local-variable-p 'remote-shell-file-name))
(should-not (boundp 'remote-shell-file-name))))))
-(defvar tramp-connection-local-default-profile)
+(defvar tramp-connection-local-default-shell-variables)
+(defvar tramp-connection-local-default-system-variables)
(ert-deftest files-x-test-with-connection-local-variables ()
"Test setting connection-local variables."
@@ -335,7 +336,10 @@
(append
(nreverse (copy-tree files-x-test--variables3))
(nreverse (copy-tree files-x-test--variables2))
- (nreverse (copy-tree tramp-connection-local-default-profile)))))
+ (nreverse
+ (copy-tree tramp-connection-local-default-shell-variables))
+ (nreverse
+ (copy-tree tramp-connection-local-default-system-variables)))))
;; The variables exist also as local variables.
(should (local-variable-p 'remote-shell-file-name))
(should (local-variable-p 'remote-null-device))
diff --git a/test/lisp/font-lock-tests.el b/test/lisp/font-lock-tests.el
index 477c43091e3..eba51f2885d 100644
--- a/test/lisp/font-lock-tests.el
+++ b/test/lisp/font-lock-tests.el
@@ -1,6 +1,6 @@
;;; font-lock-tests.el --- Test suite for font-lock. -*- lexical-binding: t -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/format-spec-tests.el b/test/lisp/format-spec-tests.el
index 11882217afb..ff2abdeaad5 100644
--- a/test/lisp/format-spec-tests.el
+++ b/test/lisp/format-spec-tests.el
@@ -1,6 +1,6 @@
;;; format-spec-tests.el --- tests for format-spec.el -*- lexical-binding: t -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -178,4 +178,14 @@
(should (equal (format-spec "foo %>4b zot" '((?b . "longbar")))
"foo long zot")))
+(ert-deftest format-spec-split ()
+ (should (equal (format-spec "foo %b bar" '((?b . "zot")) nil t)
+ '("foo " "zot" " bar")))
+ (should (equal (format-spec "%b bar" '((?b . "zot")) nil t)
+ '("zot" " bar")))
+ (should (equal (format-spec "%b" '((?b . "zot")) nil t)
+ '("zot")))
+ (should (equal (format-spec "foo %b" '((?b . "zot")) nil t)
+ '("foo " "zot"))))
+
;;; format-spec-tests.el ends here
diff --git a/test/lisp/gnus/gnus-icalendar-tests.el b/test/lisp/gnus/gnus-icalendar-tests.el
index dd265b4fa97..90c3a34a5c0 100644
--- a/test/lisp/gnus/gnus-icalendar-tests.el
+++ b/test/lisp/gnus/gnus-icalendar-tests.el
@@ -1,6 +1,6 @@
;;; gnus-icalendar-tests.el --- tests -*- lexical-binding: t; -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; Author: Jan Tatarik <jan.tatarik@gmail.com>
;; Keywords:
diff --git a/test/lisp/gnus/gnus-search-tests.el b/test/lisp/gnus/gnus-search-tests.el
new file mode 100644
index 00000000000..63469f8d518
--- /dev/null
+++ b/test/lisp/gnus/gnus-search-tests.el
@@ -0,0 +1,96 @@
+;;; gnus-search-tests.el --- Tests for Gnus' search routines -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2017, 2021 Free Software Foundation, Inc.
+
+;; Author: Eric Abrahamsen <eric@ericabrahamsen.net>
+;; Keywords:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Tests for the search parsing, search engines, and their
+;; transformations.
+
+;;; Code:
+
+(require 'ert)
+(require 'gnus-search)
+
+(ert-deftest gnus-s-parse ()
+ "Test basic structural parsing."
+ (let ((pairs
+ '(("string" . ("string"))
+ ("from:john" . ((from . "john")))
+ ("here and there" . ("here" and "there"))
+ ("here or there" . ((or "here" "there")))
+ ("here (there or elsewhere)" . ("here" ((or "there" "elsewhere"))))
+ ("here not there" . ("here" (not "there")))
+ ("from:boss or not vacation" . ((or (from . "boss") (not "vacation")))))))
+ (dolist (p pairs)
+ (should (equal (gnus-search-parse-query (car p)) (cdr p))))))
+
+(ert-deftest gnus-s-expand-keyword ()
+ "Test expansion of keywords"
+ (let ((gnus-search-expandable-keys
+ (default-value 'gnus-search-expandable-keys))
+ (pairs
+ '(("su" . "subject")
+ ("sin" . "since"))))
+ (dolist (p pairs)
+ (should (equal (gnus-search-query-expand-key (car p))
+ (cdr p))))
+ (should-error (gnus-search-query-expand-key "s")
+ :type 'gnus-search-parse-error)))
+
+(ert-deftest gnus-s-parse-date ()
+ "Test parsing of date expressions."
+ (let ((rel-date (encode-time 0 0 0 15 4 2017))
+ (pairs
+ '(("January" . (nil 1 nil))
+ ("2017" . (nil nil 2017))
+ ("15" . (15 nil nil))
+ ("January 15" . (15 1 nil))
+ ("tuesday" . (11 4 2017))
+ ("1d" . (14 4 2017))
+ ("1w" . (8 4 2017)))))
+ (dolist (p pairs)
+ (should (equal (gnus-search-query-parse-date (car p) rel-date)
+ (cdr p))))))
+
+(ert-deftest gnus-s-delimited-string ()
+ "Test proper functioning of `gnus-search-query-return-string'."
+ (with-temp-buffer
+ (insert "one\ntwo words\nthree \"words with quotes\"\n\"quotes at start\"\n/alternate \"quotes\"/\n(more bits)")
+ (goto-char (point-min))
+ (should (string= (gnus-search-query-return-string)
+ "one"))
+ (forward-line)
+ (should (string= (gnus-search-query-return-string)
+ "two"))
+ (forward-line)
+ (should (string= (gnus-search-query-return-string)
+ "three"))
+ (forward-line)
+ (should (string= (gnus-search-query-return-string "\"")
+ "\"quotes at start\""))
+ (forward-line)
+ (should (string= (gnus-search-query-return-string "/")
+ "/alternate \"quotes\"/"))
+ (forward-line)
+ (should (string= (gnus-search-query-return-string ")" t)
+ "more bits"))))
+
+(provide 'gnus-search-tests)
+;;; search-tests.el ends here
diff --git a/test/lisp/gnus/gnus-test-headers.el b/test/lisp/gnus/gnus-test-headers.el
index 958360a088b..a240784ee01 100644
--- a/test/lisp/gnus/gnus-test-headers.el
+++ b/test/lisp/gnus/gnus-test-headers.el
@@ -1,6 +1,6 @@
;;; gnus-test-headers.el --- Tests for Gnus header-related functions -*- lexical-binding: t; -*-
-;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2018-2021 Free Software Foundation, Inc.
;; Author: Eric Abrahamsen <eric@ericabrahamsen.net>
diff --git a/test/lisp/gnus/gnus-tests.el b/test/lisp/gnus/gnus-tests.el
index fb1b204f042..6602e67a347 100644
--- a/test/lisp/gnus/gnus-tests.el
+++ b/test/lisp/gnus/gnus-tests.el
@@ -1,6 +1,6 @@
;;; gnus-tests.el --- Wrapper for the Gnus tests -*- lexical-binding:t -*-
-;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
;; Author: Teodor Zlatanov <tzz@lifelogs.com>
diff --git a/test/lisp/gnus/gnus-util-tests.el b/test/lisp/gnus/gnus-util-tests.el
index 5a5e66594fa..7f64b96303f 100644
--- a/test/lisp/gnus/gnus-util-tests.el
+++ b/test/lisp/gnus/gnus-util-tests.el
@@ -1,5 +1,5 @@
;;; gnus-util-tests.el --- Selectived tests only. -*- lexical-binding:t -*-
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Author: Jens Lechtenbörger <jens.lechtenboerger@fsfe.org>
diff --git a/test/lisp/gnus/message-tests.el b/test/lisp/gnus/message-tests.el
index 99a4ae463a6..8650053b682 100644
--- a/test/lisp/gnus/message-tests.el
+++ b/test/lisp/gnus/message-tests.el
@@ -1,6 +1,6 @@
;;; message-mode-tests.el --- Tests for message-mode -*- lexical-binding: t; -*-
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Author: João Távora <joaotavora@gmail.com>
diff --git a/test/lisp/gnus/mm-decode-resources/8bit-multipart.bin b/test/lisp/gnus/mm-decode-resources/8bit-multipart.bin
new file mode 100644
index 00000000000..0b193a27234
--- /dev/null
+++ b/test/lisp/gnus/mm-decode-resources/8bit-multipart.bin
@@ -0,0 +1,20 @@
+From: example <example@example.org>
+To: example <example@example.org>
+Content-Type: multipart/alternative; boundary="===============2877195075946974246=="
+Date: Thu, 29 Oct 2020 14:47:55 +0100
+MIME-Version: 1.0
+Subject: test
+
+--===============2877195075946974246==
+Content-Type: text/plain; charset="utf-8"
+Content-Transfer-Encoding: 8bit
+
+ääää
+
+--===============2877195075946974246==
+Content-Type: text/html; charset="utf-8"
+Content-Transfer-Encoding: 8bit
+
+<!doctype html><html><head><meta http-equiv="content-type" content="text/html; charset=UTF-8"></head><body>ääää</body></html>
+
+--===============2877195075946974246==--
diff --git a/test/lisp/gnus/mm-decode-resources/win1252-multipart.bin b/test/lisp/gnus/mm-decode-resources/win1252-multipart.bin
new file mode 100644
index 00000000000..d3c5026dcce
--- /dev/null
+++ b/test/lisp/gnus/mm-decode-resources/win1252-multipart.bin
@@ -0,0 +1,44 @@
+To: example <example@example.org>
+From: example <example@example.org>
+Date: Tue, 5 Jan 2021 10:30:34 +0100
+MIME-Version: 1.0
+Content-Type: multipart/mixed; boundary="------------FB569A4368539497CC91D1DC"
+Content-Language: fr
+Subject: test
+
+--------------FB569A4368539497CC91D1DC
+Content-Type: multipart/alternative;
+ boundary="------------61C81A7DC7592E4C6F856A85"
+
+
+--------------61C81A7DC7592E4C6F856A85
+Content-Type: text/plain; charset=windows-1252; format=flowed
+Content-Transfer-Encoding: 8bit
+
+dj rat
+
+--------------61C81A7DC7592E4C6F856A85
+Content-Type: text/html; charset=windows-1252
+Content-Transfer-Encoding: 8bit
+
+<html>
+ <head>
+ <meta http-equiv="content-type" content="text/html; charset=windows-1252">
+ </head>
+ <body>
+ dj rat
+ </body>
+</html>
+
+--------------61C81A7DC7592E4C6F856A85--
+
+--------------FB569A4368539497CC91D1DC
+Content-Type: text/plain; charset="us-ascii"
+MIME-Version: 1.0
+Content-Transfer-Encoding: 7bit
+Content-Disposition: inline
+
+mailing list signature
+
+--------------FB569A4368539497CC91D1DC--
+
diff --git a/test/lisp/gnus/mm-decode-tests.el b/test/lisp/gnus/mm-decode-tests.el
new file mode 100644
index 00000000000..7d059cb3f87
--- /dev/null
+++ b/test/lisp/gnus/mm-decode-tests.el
@@ -0,0 +1,102 @@
+;;; mm-decode-tests.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, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'ert-x)
+(require 'mm-decode)
+
+(ert-deftest test-mm-dissect-buffer ()
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert-file-contents-literally (ert-resource-file "8bit-multipart.bin"))
+ (while (search-forward "\r\n" nil t)
+ (replace-match "\n"))
+ (let ((handle (mm-dissect-buffer)))
+ (should (equal (mm-handle-media-type handle) "multipart/alternative"))
+ ;; Skip multipart type.
+ (pop handle)
+ (let ((part (pop handle)))
+ (should (equal (mm-handle-media-type part) "text/plain"))
+ (should (eq (mm-handle-encoding part) '8bit))
+ (with-current-buffer (mm-handle-buffer part)
+ (should (equal (decode-coding-string
+ (buffer-string)
+ (intern (mail-content-type-get (mm-handle-type part)
+ 'charset)))
+ "ääää\n"))))
+ (let ((part (pop handle)))
+ (should (equal (mm-handle-media-type part) "text/html"))
+ (should (eq (mm-handle-encoding part) '8bit))
+ (with-current-buffer (mm-handle-buffer part)
+ (should (equal (decode-coding-string
+ (buffer-string)
+ (intern (mail-content-type-get (mm-handle-type part)
+ 'charset)))
+ "<!doctype html><html><head><meta http-equiv=\"content-type\" content=\"text/html; charset=UTF-8\"></head><body>ääää</body></html>\n")))))))
+
+(ert-deftest test-mm-with-part-unibyte ()
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert-file-contents-literally (ert-resource-file "8bit-multipart.bin"))
+ (while (search-forward "\r\n" nil t)
+ (replace-match "\n"))
+ (let ((handle (mm-dissect-buffer)))
+ (pop handle)
+ (let ((part (pop handle)))
+ (should (equal (decode-coding-string
+ (mm-with-part part
+ (buffer-string))
+ (intern (mail-content-type-get (mm-handle-type part)
+ 'charset)))
+ "ääää\n"))))))
+
+(ert-deftest test-mm-dissect-buffer-win1252 ()
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert-file-contents-literally (ert-resource-file "win1252-multipart.bin"))
+ (let ((handle (mm-dissect-buffer)))
+ (should (equal (mm-handle-media-type handle) "multipart/mixed"))
+ ;; Skip multipart type.
+ (pop handle)
+ (setq handle (car handle))
+ (pop handle)
+ (let ((part (pop handle)))
+ (should (equal (mm-handle-media-type part) "text/plain"))
+ (should (eq (mm-handle-encoding part) '8bit))
+ (with-current-buffer (mm-handle-buffer part)
+ (should (equal (decode-coding-string
+ (buffer-string)
+ (intern (mail-content-type-get (mm-handle-type part)
+ 'charset)))
+ "déjà raté\n"))))
+ (let ((part (pop handle)))
+ (should (equal (mm-handle-media-type part) "text/html"))
+ (should (eq (mm-handle-encoding part) '8bit))
+ (with-current-buffer (mm-handle-buffer part)
+ (should (equal (decode-coding-string
+ (buffer-string)
+ (intern (mail-content-type-get (mm-handle-type part)
+ 'charset)))
+ "<html>\n <head>\n <meta http-equiv=\"content-type\" content=\"text/html; charset=windows-1252\">\n </head>\n <body>\n déjà raté\n </body>\n</html>\n")))))))
+
+;;; mm-decode-tests.el ends here
diff --git a/test/lisp/gnus/mml-sec-tests.el b/test/lisp/gnus/mml-sec-tests.el
index a6002b4d51e..b743187030f 100644
--- a/test/lisp/gnus/mml-sec-tests.el
+++ b/test/lisp/gnus/mml-sec-tests.el
@@ -1,5 +1,5 @@
;;; mml-sec-tests.el --- Tests mml-sec.el, see README-mml-secure.txt. -*- lexical-binding:t -*-
-;; Copyright (C) 2015, 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015, 2020-2021 Free Software Foundation, Inc.
;; Author: Jens Lechtenbörger <jens.lechtenboerger@fsfe.org>
@@ -432,6 +432,7 @@ In both cases, the first key is customized for signing and encryption."
(ert-deftest mml-secure-select-preferred-keys-4 ()
"Multiple keys can be recorded per recipient or signature."
(skip-unless (test-conf))
+ (skip-unless (ignore-errors (epg-find-configuration 'CMS)))
(mml-secure-test-fixture
(lambda ()
(let ((pcontext (epg-make-context 'OpenPGP))
@@ -590,6 +591,7 @@ In this test, the single matching key is chosen automatically."
"Encrypt message; then decrypt and test for expected result.
In this test, the encryption key needs to fixed among multiple ones."
(skip-unless (test-conf))
+ (skip-unless (ignore-errors (epg-find-configuration 'CMS)))
;; sub@example.org with multiple candidate keys,
;; fixture customizes preferred ones.
(mml-secure-test-key-fixture
@@ -603,6 +605,7 @@ In this test, the encryption key needs to fixed among multiple ones."
"Encrypt message; then decrypt and test for expected result.
In this test, encrypt-to-self variables are set to t."
(skip-unless (test-conf))
+ (skip-unless (ignore-errors (epg-find-configuration 'CMS)))
;; sub@example.org with multiple candidate keys,
;; fixture customizes preferred ones.
(mml-secure-test-key-fixture
@@ -745,6 +748,7 @@ Use sign-with-sender and encrypt-to-self."
(ert-deftest mml-secure-sign-verify-1 ()
"Sign message with sender; then verify and test for expected result."
(skip-unless (test-conf))
+ (skip-unless (ignore-errors (epg-find-configuration 'CMS)))
(mml-secure-test-key-fixture
(lambda ()
(dolist (method (sign-standards) nil)
@@ -880,10 +884,12 @@ So the second decryption fails."
(dolist (pid (list-system-processes))
(let ((atts (process-attributes pid)))
(when (and (equal (cdr (assq 'user atts)) (user-login-name))
- (equal (cdr (assq 'comm atts)) "gpg-agent")
+ (or (equal (cdr (assq 'comm atts)) "gpg-agent")
+ (equal (cdr (assq 'comm atts)) "scdaemon"))
(string-match
(concat "homedir.*"
- (regexp-quote (ert-resource-directory)))
+ (regexp-quote (directory-file-name
+ (ert-resource-directory))))
(cdr (assq 'args atts))))
(call-process "kill" nil nil nil (format "%d" pid))))))
diff --git a/test/lisp/gnus/nnrss-tests.el b/test/lisp/gnus/nnrss-tests.el
index a4040c908fe..9821ec76fb4 100644
--- a/test/lisp/gnus/nnrss-tests.el
+++ b/test/lisp/gnus/nnrss-tests.el
@@ -1,6 +1,6 @@
;;; nnrss-tests.el --- tests for gnus/nnrss.el -*- lexical-binding:t -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/help-fns-tests.el b/test/lisp/help-fns-tests.el
index bdd488de3f2..80d90daaf91 100644
--- a/test/lisp/help-fns-tests.el
+++ b/test/lisp/help-fns-tests.el
@@ -1,6 +1,6 @@
;;; help-fns-tests.el --- tests for help-fns.el -*- lexical-binding: t -*-
-;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
@@ -24,8 +24,9 @@
;;; Code:
(require 'ert)
+(require 'help-fns)
-(autoload 'help-fns-test--macro "help-fns" nil nil t)
+(autoload 'help-fns-test--macro "foo" nil nil t)
;;; Several tests for describe-function
diff --git a/test/lisp/help-mode-tests.el b/test/lisp/help-mode-tests.el
index 2b9552a8d81..43db59d4b1b 100644
--- a/test/lisp/help-mode-tests.el
+++ b/test/lisp/help-mode-tests.el
@@ -1,6 +1,6 @@
;;; help-mode-tests.el --- Tests for help-mode.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; Author: Simen Heggestøyl <simenheg@gmail.com>
;; Keywords:
@@ -72,14 +72,19 @@ Lisp concepts such as car, cdr, cons cell and list.")
#'info)))))
(ert-deftest help-mode-tests-xref-button ()
- (with-temp-buffer
- (insert "See also the function ‘interactive’.")
- (string-match help-xref-symbol-regexp (buffer-string))
- (help-xref-button 8 'help-function)
- (should-not (button-at 22))
- (should-not (button-at 35))
- (let ((button (button-at 30)))
- (should (eq (button-type button) 'help-function)))))
+ (let* ((fmt "See also the function ‘%s’.")
+ ;; 1+ translates string index to buffer position.
+ (beg (1+ (string-search "%" fmt))))
+ (with-temp-buffer
+ (dolist (fn '(interactive \` = + - * / %))
+ (erase-buffer)
+ (insert (format fmt fn))
+ (goto-char (point-min))
+ (re-search-forward help-xref-symbol-regexp)
+ (help-xref-button 8 'help-function)
+ (should-not (button-at (1- beg)))
+ (should-not (button-at (+ beg (length (symbol-name fn)))))
+ (should (eq (button-type (button-at beg)) 'help-function))))))
(ert-deftest help-mode-tests-insert-xref-button ()
(with-temp-buffer
diff --git a/test/lisp/help-tests.el b/test/lisp/help-tests.el
index b6dffb2a405..8034764741c 100644
--- a/test/lisp/help-tests.el
+++ b/test/lisp/help-tests.el
@@ -1,6 +1,6 @@
;;; help-tests.el --- Tests for help.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; Author: Juanma Barranquero <lekktu@gmail.com>
;; Eli Zaretskii <eliz@gnu.org>
@@ -91,18 +91,18 @@
(ert-deftest help-tests-substitute-command-keys/keymaps ()
(with-substitute-command-keys-test
(test "\\{minibuffer-local-must-match-map}"
- "\
+ "\
key binding
--- -------
-C-g abort-recursive-edit
+C-g abort-minibuffers
TAB minibuffer-complete
C-j minibuffer-complete-and-exit
RET minibuffer-complete-and-exit
ESC Prefix Command
SPC minibuffer-complete-word
? minibuffer-completion-help
-<C-tab> file-cache-minibuffer-complete
+C-<tab> file-cache-minibuffer-complete
<XF86Back> previous-history-element
<XF86Forward> next-history-element
<down> next-line-or-history-element
@@ -122,13 +122,24 @@ M-s next-matching-history-element
(ert-deftest help-tests-substitute-command-keys/keymap-change ()
(with-substitute-command-keys-test
- (test "\\<minibuffer-local-must-match-map>\\[abort-recursive-edit]" "C-g")
+ (test "\\<minibuffer-local-must-match-map>\\[abort-recursive-edit]" "C-]")
(test "\\<emacs-lisp-mode-map>\\[eval-defun]" "C-M-x")))
+(defvar help-tests-remap-map
+ (let ((map (make-keymap)))
+ (define-key map (kbd "x") 'foo)
+ (define-key map (kbd "y") 'bar)
+ (define-key map [remap foo] 'bar)
+ map))
+
+(ert-deftest help-tests-substitute-command-keys/remap ()
+ (should (equal (substitute-command-keys "\\<help-tests-remap-map>\\[foo]") "y"))
+ (should (equal (substitute-command-keys "\\<help-tests-remap-map>\\[bar]") "y")))
+
(ert-deftest help-tests-substitute-command-keys/undefined-map ()
(with-substitute-command-keys-test
(test-re "\\{foobar-map}"
- "\nUses keymap [`'‘]foobar-map['’], which is not currently defined.\n")))
+ "\nUses keymap [`'‘]foobar-map['’], which is not currently defined.\n")))
(ert-deftest help-tests-substitute-command-keys/quotes ()
(with-substitute-command-keys-test
@@ -381,6 +392,12 @@ C-b undefined
(define-key global-map (kbd "C-c C-l r") nil)
(define-key global-map (kbd "C-c C-l") nil)))
+(ert-deftest help-substitute-command-keys/preserves-text-properties ()
+ "Check that we preserve text properties (Bug#17052)."
+ (should (equal (substitute-command-keys
+ (propertize "foo \\[save-buffer]" 'face 'bold))
+ (propertize "foo C-x C-s" 'face 'bold))))
+
(provide 'help-tests)
;;; help-tests.el ends here
diff --git a/test/lisp/hfy-cmap-resources/rgb.txt b/test/lisp/hfy-cmap-resources/rgb.txt
index 86a00539909..f8e369fae2a 100644
--- a/test/lisp/hfy-cmap-resources/rgb.txt
+++ b/test/lisp/hfy-cmap-resources/rgb.txt
@@ -1,3 +1,4 @@
+# test comment
255 250 250 snow
248 248 255 ghost white
248 248 255 GhostWhite
diff --git a/test/lisp/hfy-cmap-tests.el b/test/lisp/hfy-cmap-tests.el
index 4cdc6ffc827..7e0be3753b3 100644
--- a/test/lisp/hfy-cmap-tests.el
+++ b/test/lisp/hfy-cmap-tests.el
@@ -1,6 +1,6 @@
;;; hfy-cmap-tests.el --- tests for hfy-cmap.el -*- lexical-binding: t -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/hi-lock-tests.el b/test/lisp/hi-lock-tests.el
index d30a6d08001..199512fe7de 100644
--- a/test/lisp/hi-lock-tests.el
+++ b/test/lisp/hi-lock-tests.el
@@ -1,6 +1,6 @@
;;; hi-lock-tests.el --- Tests for hi-lock.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; Author: Tino Calancha <tino.calancha@gmail.com>
;; Keywords:
diff --git a/test/lisp/htmlfontify-tests.el b/test/lisp/htmlfontify-tests.el
index 4e48db32789..879131cae32 100644
--- a/test/lisp/htmlfontify-tests.el
+++ b/test/lisp/htmlfontify-tests.el
@@ -1,6 +1,6 @@
;;; htmlfontify-tests.el --- Test suite. -*- lexical-binding: t -*-
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/ibuffer-tests.el b/test/lisp/ibuffer-tests.el
index 2211cae305b..a51079180a5 100644
--- a/test/lisp/ibuffer-tests.el
+++ b/test/lisp/ibuffer-tests.el
@@ -1,6 +1,6 @@
;;; ibuffer-tests.el --- Test suite. -*- lexical-binding: t -*-
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/ido-tests.el b/test/lisp/ido-tests.el
index 1bca4cdb706..90a64b2fd21 100644
--- a/test/lisp/ido-tests.el
+++ b/test/lisp/ido-tests.el
@@ -1,6 +1,6 @@
;;; ido-tests.el --- unit tests for ido.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; Author: Philipp Stephani <phst@google.com>
diff --git a/test/lisp/image-file-tests.el b/test/lisp/image-file-tests.el
index ad7c26ee46c..d3290f6f4c6 100644
--- a/test/lisp/image-file-tests.el
+++ b/test/lisp/image-file-tests.el
@@ -1,6 +1,6 @@
;;; image-file-tests.el --- Test suite for image-files -*- lexical-binding: t; -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/image-tests.el b/test/lisp/image-tests.el
index 0355e78184c..ab7585ca050 100644
--- a/test/lisp/image-tests.el
+++ b/test/lisp/image-tests.el
@@ -1,6 +1,6 @@
;;; image-tests.el --- tests for image.el -*- lexical-binding: t -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/image/exif-tests.el b/test/lisp/image/exif-tests.el
index 9e5da46b508..ddbee75467e 100644
--- a/test/lisp/image/exif-tests.el
+++ b/test/lisp/image/exif-tests.el
@@ -1,6 +1,6 @@
;;; exif-tests.el --- tests for exif.el -*- lexical-binding: t -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/image/gravatar-tests.el b/test/lisp/image/gravatar-tests.el
index 43c3024721e..2324dc5e8b4 100644
--- a/test/lisp/image/gravatar-tests.el
+++ b/test/lisp/image/gravatar-tests.el
@@ -1,6 +1,6 @@
;;; gravatar-tests.el --- tests for gravatar.el -*- lexical-binding: t -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/imenu-tests.el b/test/lisp/imenu-tests.el
index e5cdb9e65d1..17f2501f67d 100644
--- a/test/lisp/imenu-tests.el
+++ b/test/lisp/imenu-tests.el
@@ -1,6 +1,6 @@
;;; imenu-tests.el --- Test suite for imenu. -*- lexical-binding:t -*-
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; Author: Masatake YAMATO <yamato@redhat.com>
;; Keywords: tools convenience
diff --git a/test/lisp/info-xref-tests.el b/test/lisp/info-xref-tests.el
index 940aa7d8ad1..95af21fb591 100644
--- a/test/lisp/info-xref-tests.el
+++ b/test/lisp/info-xref-tests.el
@@ -1,6 +1,6 @@
;;; info-xref.el --- tests for info-xref.el -*- lexical-binding:t -*-
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/international/ccl-tests.el b/test/lisp/international/ccl-tests.el
index 16e591f1dd5..0f765e4ff88 100644
--- a/test/lisp/international/ccl-tests.el
+++ b/test/lisp/international/ccl-tests.el
@@ -1,6 +1,6 @@
;;; ccl-tests.el --- unit tests for ccl.el -*- lexical-binding:t -*-
-;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2018-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/international/mule-tests.el b/test/lisp/international/mule-tests.el
index 9520d9d8633..7727c118b2c 100644
--- a/test/lisp/international/mule-tests.el
+++ b/test/lisp/international/mule-tests.el
@@ -1,6 +1,6 @@
;;; mule-tests.el --- unit tests for mule.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/international/mule-util-tests.el b/test/lisp/international/mule-util-tests.el
index 0524dad88da..6518be66dbe 100644
--- a/test/lisp/international/mule-util-tests.el
+++ b/test/lisp/international/mule-util-tests.el
@@ -1,6 +1,6 @@
;;; mule-util-tests.el --- tests for international/mule-util.el -*- lexical-binding:t -*-
-;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/international/ucs-normalize-tests.el b/test/lisp/international/ucs-normalize-tests.el
index 2c60bd318a2..a2da73767bc 100644
--- a/test/lisp/international/ucs-normalize-tests.el
+++ b/test/lisp/international/ucs-normalize-tests.el
@@ -1,6 +1,6 @@
;;; ucs-normalize --- tests for international/ucs-normalize.el -*- lexical-binding: t -*-
-;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/isearch-tests.el b/test/lisp/isearch-tests.el
index 516077ac1f8..9f3ac373126 100644
--- a/test/lisp/isearch-tests.el
+++ b/test/lisp/isearch-tests.el
@@ -1,6 +1,6 @@
;;; isearch-tests.el --- Tests for isearch.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
diff --git a/test/lisp/jit-lock-tests.el b/test/lisp/jit-lock-tests.el
index dfa74cf35e7..121966b2b77 100644
--- a/test/lisp/jit-lock-tests.el
+++ b/test/lisp/jit-lock-tests.el
@@ -1,6 +1,6 @@
;;; jit-lock-tests.el --- tests for jit-lock -*- lexical-binding:t -*-
-;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2016-2021 Free Software Foundation, Inc.
;; Author: Dmitry Gutov <dgutov@yandex.ru>
diff --git a/test/lisp/json-tests.el b/test/lisp/json-tests.el
index 8ac454467d3..11b61d8b47e 100644
--- a/test/lisp/json-tests.el
+++ b/test/lisp/json-tests.el
@@ -1,6 +1,6 @@
;;; json-tests.el --- Test suite for json.el -*- lexical-binding:t -*-
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Author: Dmitry Gutov <dgutov@yandex.ru>
diff --git a/test/lisp/jsonrpc-tests.el b/test/lisp/jsonrpc-tests.el
index 1ef83daed24..ea340c370d1 100644
--- a/test/lisp/jsonrpc-tests.el
+++ b/test/lisp/jsonrpc-tests.el
@@ -1,6 +1,6 @@
;;; jsonrpc-tests.el --- tests for jsonrpc.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2018-2021 Free Software Foundation, Inc.
;; Author: João Távora <joaotavora@gmail.com>
;; Keywords: tests
diff --git a/test/lisp/kmacro-tests.el b/test/lisp/kmacro-tests.el
index bb18c828140..c8910720763 100644
--- a/test/lisp/kmacro-tests.el
+++ b/test/lisp/kmacro-tests.el
@@ -1,6 +1,6 @@
;;; kmacro-tests.el --- Tests for kmacro.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; Author: Gemini Lasswell <gazally@runbox.com>
diff --git a/test/lisp/ls-lisp-tests.el b/test/lisp/ls-lisp-tests.el
index e08e406619a..e386398eea2 100644
--- a/test/lisp/ls-lisp-tests.el
+++ b/test/lisp/ls-lisp-tests.el
@@ -1,6 +1,6 @@
;;; ls-lisp-tests.el --- tests for ls-lisp.el -*- lexical-binding: t-*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; Author: Tino Calancha <tino.calancha@gmail.com>
;; Keywords:
diff --git a/test/lisp/mail/flow-fill-tests.el b/test/lisp/mail/flow-fill-tests.el
index c2e4178b7d4..ec5b984dc04 100644
--- a/test/lisp/mail/flow-fill-tests.el
+++ b/test/lisp/mail/flow-fill-tests.el
@@ -1,6 +1,6 @@
;;; flow-fill-tests.el --- Tests for flow-fill.el -*- lexical-binding: t -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/mail/footnote-tests.el b/test/lisp/mail/footnote-tests.el
index 6594aa2b3e5..731ba3e706b 100644
--- a/test/lisp/mail/footnote-tests.el
+++ b/test/lisp/mail/footnote-tests.el
@@ -1,6 +1,6 @@
;;; footnote-tests.el --- Tests for footnote-mode -*- lexical-binding: t; -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords:
diff --git a/test/lisp/mail/qp-tests.el b/test/lisp/mail/qp-tests.el
index 8d704499334..89f02894ea8 100644
--- a/test/lisp/mail/qp-tests.el
+++ b/test/lisp/mail/qp-tests.el
@@ -1,6 +1,6 @@
;;; qp-tests.el --- Tests for qp.el -*- lexical-binding:t; coding:utf-8 -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; Author: Stefan Kangas <stefankangas@gmail.com>
diff --git a/test/lisp/mail/rfc2045-tests.el b/test/lisp/mail/rfc2045-tests.el
index edd7a88c69e..ac547aabe5b 100644
--- a/test/lisp/mail/rfc2045-tests.el
+++ b/test/lisp/mail/rfc2045-tests.el
@@ -1,6 +1,6 @@
;;; rfc2045-tests.el --- Tests for rfc2045.el -*- lexical-binding:t -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; Author: Stefan Kangas <stefankangas@gmail.com>
diff --git a/test/lisp/mail/rfc2047-tests.el b/test/lisp/mail/rfc2047-tests.el
index 7a99e851004..befcbc018bc 100644
--- a/test/lisp/mail/rfc2047-tests.el
+++ b/test/lisp/mail/rfc2047-tests.el
@@ -1,6 +1,6 @@
;;; rfc2047-tests.el --- tests for rfc2047.el -*- lexical-binding: t -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/mail/rfc2368-tests.el b/test/lisp/mail/rfc2368-tests.el
index c35b8e33ad5..f997ea3ecb4 100644
--- a/test/lisp/mail/rfc2368-tests.el
+++ b/test/lisp/mail/rfc2368-tests.el
@@ -1,6 +1,6 @@
;;; rfc2368-tests.el --- Tests for rfc2368.el -*- lexical-binding:t -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/mail/rfc822-tests.el b/test/lisp/mail/rfc822-tests.el
index d13966c59cc..3e36a61a1f3 100644
--- a/test/lisp/mail/rfc822-tests.el
+++ b/test/lisp/mail/rfc822-tests.el
@@ -1,6 +1,6 @@
;;; rfc822-tests.el --- Tests for rfc822.el -*- lexical-binding:t -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/mail/rmail-tests.el b/test/lisp/mail/rmail-tests.el
index f96c31c7f00..f533401496b 100644
--- a/test/lisp/mail/rmail-tests.el
+++ b/test/lisp/mail/rmail-tests.el
@@ -1,6 +1,6 @@
;;; rmail-tests.el --- Test suite. -*- lexical-binding: t -*-
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/mail/rmailmm-tests.el b/test/lisp/mail/rmailmm-tests.el
index 645bb96d113..a022008b534 100644
--- a/test/lisp/mail/rmailmm-tests.el
+++ b/test/lisp/mail/rmailmm-tests.el
@@ -1,6 +1,6 @@
;;; rmailmm-tests.el --- Tests for rmailmm.el -*- lexical-binding:t -*-
-;; Copyright (C) 2006-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/mail/uudecode-tests.el b/test/lisp/mail/uudecode-tests.el
index 17566250a92..6ff767562e3 100644
--- a/test/lisp/mail/uudecode-tests.el
+++ b/test/lisp/mail/uudecode-tests.el
@@ -1,6 +1,6 @@
;;; uudecode-tests.el --- Tests for uudecode.el -*- lexical-binding: t -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; Author: Stefan Kangas <stefankangas@gmail.com>
diff --git a/test/lisp/makesum-tests.el b/test/lisp/makesum-tests.el
index d4dd832730c..2b57af78186 100644
--- a/test/lisp/makesum-tests.el
+++ b/test/lisp/makesum-tests.el
@@ -1,6 +1,6 @@
;;; makesum-tests.el --- Tests for makesum.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; Author: Simen Heggestøyl <simenheg@gmail.com>
;; Keywords:
diff --git a/test/lisp/man-tests.el b/test/lisp/man-tests.el
index ddf22ecd404..7fb0c5e9443 100644
--- a/test/lisp/man-tests.el
+++ b/test/lisp/man-tests.el
@@ -1,6 +1,6 @@
;;; man-tests.el --- Test suite for man. -*- lexical-binding:t -*-
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; Author: Wolfgang Jenkner <wjenkner@inode.at>
;; Keywords: help, internal, unix
diff --git a/test/lisp/md4-tests.el b/test/lisp/md4-tests.el
index 5c995ff56c9..ac7eedec6aa 100644
--- a/test/lisp/md4-tests.el
+++ b/test/lisp/md4-tests.el
@@ -1,6 +1,6 @@
;;; md4-tests.el --- tests for md4.el -*- lexical-binding: t -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; Author: Mark Oteiza <mvoteiza@udel.edu>
;; Maintainer: emacs-devel@gnu.org
diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el
index 32734794413..3ebca14a284 100644
--- a/test/lisp/minibuffer-tests.el
+++ b/test/lisp/minibuffer-tests.el
@@ -1,6 +1,6 @@
;;; completion-tests.el --- Tests for completion functions -*- lexical-binding: t; -*-
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords:
diff --git a/test/lisp/misc-tests.el b/test/lisp/misc-tests.el
index fbcbfb7d0cc..a519fd1ee62 100644
--- a/test/lisp/misc-tests.el
+++ b/test/lisp/misc-tests.el
@@ -1,6 +1,6 @@
;;; misc-tests.el --- Tests for misc.el -*- lexical-binding:t -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; Author: Stefan Kangas <stefankangas@gmail.com>
diff --git a/test/lisp/mouse-tests.el b/test/lisp/mouse-tests.el
index d520da7af5c..56411d0365f 100644
--- a/test/lisp/mouse-tests.el
+++ b/test/lisp/mouse-tests.el
@@ -1,6 +1,6 @@
;;; mouse-tests.el --- unit tests for mouse.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2016-2021 Free Software Foundation, Inc.
;; Author: Philipp Stephani <phst@google.com>
diff --git a/test/lisp/mwheel-tests.el b/test/lisp/mwheel-tests.el
index 315f25edae8..058f1a8afb1 100644
--- a/test/lisp/mwheel-tests.el
+++ b/test/lisp/mwheel-tests.el
@@ -1,6 +1,6 @@
;;; mwheel-tests.el --- tests for mwheel.el -*- lexical-binding:t -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/net/browse-url-tests.el b/test/lisp/net/browse-url-tests.el
index b2b27d2ae7b..898bef8513b 100644
--- a/test/lisp/net/browse-url-tests.el
+++ b/test/lisp/net/browse-url-tests.el
@@ -1,6 +1,6 @@
;;; browse-url-tests.el --- Tests for browse-url.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; Author: Simen Heggestøyl <simenheg@gmail.com>
;; Keywords:
diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el
index 3cfb4b7d9e7..34a2af188f0 100644
--- a/test/lisp/net/dbus-tests.el
+++ b/test/lisp/net/dbus-tests.el
@@ -1,6 +1,6 @@
;;; dbus-tests.el --- Tests of D-Bus integration into Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
diff --git a/test/lisp/net/dig-tests.el b/test/lisp/net/dig-tests.el
index 1b14384634e..780985cb6d3 100644
--- a/test/lisp/net/dig-tests.el
+++ b/test/lisp/net/dig-tests.el
@@ -1,6 +1,6 @@
;;; dig-tests.el --- Tests for dig.el -*- lexical-binding:t -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/net/gnutls-tests.el b/test/lisp/net/gnutls-tests.el
index 5205f0b851f..76c00b7eaac 100644
--- a/test/lisp/net/gnutls-tests.el
+++ b/test/lisp/net/gnutls-tests.el
@@ -1,6 +1,6 @@
;;; gnutls-tests.el --- Test suite for gnutls.el -*- lexical-binding:t -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; Author: Ted Zlatanov <tzz@lifelogs.com>
diff --git a/test/lisp/net/hmac-md5-tests.el b/test/lisp/net/hmac-md5-tests.el
index 30d221ec87b..8e01353fa3f 100644
--- a/test/lisp/net/hmac-md5-tests.el
+++ b/test/lisp/net/hmac-md5-tests.el
@@ -1,6 +1,6 @@
;;; hmac-md5-tests.el --- Tests for hmac-md5.el -*- lexical-binding:t -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/net/mailcap-tests.el b/test/lisp/net/mailcap-tests.el
index 0ebbec61159..a1a08322c0f 100644
--- a/test/lisp/net/mailcap-tests.el
+++ b/test/lisp/net/mailcap-tests.el
@@ -1,6 +1,6 @@
;;; mailcap-tests.el --- tests for mailcap.el -*- lexical-binding: t -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; Author: Mark Oteiza <mvoteiza@udel.edu>
diff --git a/test/lisp/net/netrc-tests.el b/test/lisp/net/netrc-tests.el
index 291943990ad..1328b191494 100644
--- a/test/lisp/net/netrc-tests.el
+++ b/test/lisp/net/netrc-tests.el
@@ -1,6 +1,6 @@
;;; netrc-tests.el --- Tests for netrc.el -*- lexical-binding:t -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; Author: Stefan Kangas <stefankangas@gmail.com>
diff --git a/test/lisp/net/network-stream-tests.el b/test/lisp/net/network-stream-tests.el
index 07eb2823282..e0a06a28eec 100644
--- a/test/lisp/net/network-stream-tests.el
+++ b/test/lisp/net/network-stream-tests.el
@@ -1,6 +1,6 @@
;;; network-stream-tests.el --- tests for network processes -*- lexical-binding: t; -*-
-;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2016-2021 Free Software Foundation, Inc.
;; Author: Lars Ingebrigtsen <larsi@gnus.org>
diff --git a/test/lisp/net/newsticker-tests.el b/test/lisp/net/newsticker-tests.el
index 5552fa8c1a6..e08f3110161 100644
--- a/test/lisp/net/newsticker-tests.el
+++ b/test/lisp/net/newsticker-tests.el
@@ -1,6 +1,6 @@
;;; newsticker-tests.el --- Test suite for newsticker. -*- lexical-binding:t -*-
-;; Copyright (C) 2003-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
;; Author: Ulf Jasper <ulf.jasper@web.de>
;; Keywords: News, RSS, Atom
diff --git a/test/lisp/net/nsm-tests.el b/test/lisp/net/nsm-tests.el
index c547533bce2..ff453319b37 100644
--- a/test/lisp/net/nsm-tests.el
+++ b/test/lisp/net/nsm-tests.el
@@ -1,6 +1,6 @@
;;; network-stream-tests.el --- tests for network security manager -*- lexical-binding: t; -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; Author: Robert Pluim <rpluim@gmail.com>
@@ -49,15 +49,17 @@
(should (eq nil (nsm-should-check "127.0.0.1")))
(should (eq nil (nsm-should-check "localhost"))))))
-(defun nsm-ipv6-is-available ()
+;; This will need updating when IANA assign more IPv6 global ranges.
+(defun ipv6-is-available ()
(and (featurep 'make-network-process '(:family ipv6))
(cl-rassoc-if
(lambda (elt)
- (eq 9 (length elt)))
+ (and (eq 9 (length elt))
+ (= (logand (aref elt 0) #xe000) #x2000)))
(network-interface-list))))
(ert-deftest nsm-check-local-subnet-ipv6 ()
- (skip-unless (nsm-ipv6-is-available))
+ (skip-unless (ipv6-is-available))
(let ((local-ip '[123 456 789 11 172 26 128 160 0])
(mask '[255 255 255 255 255 255 255 0 0])
diff --git a/test/lisp/net/ntlm-tests.el b/test/lisp/net/ntlm-tests.el
index e515ebe2635..6408ac13349 100644
--- a/test/lisp/net/ntlm-tests.el
+++ b/test/lisp/net/ntlm-tests.el
@@ -1,6 +1,6 @@
;;; ntlm-tests.el --- tests for ntlm.el -*- lexical-binding: t -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/net/puny-tests.el b/test/lisp/net/puny-tests.el
index 7dac39795b6..b37168f5ca7 100644
--- a/test/lisp/net/puny-tests.el
+++ b/test/lisp/net/puny-tests.el
@@ -1,6 +1,6 @@
;;; puny-tests.el --- tests for net/puny.el -*- coding: utf-8; lexical-binding:t -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/net/rcirc-tests.el b/test/lisp/net/rcirc-tests.el
index 285926af9d2..fd96b7ba714 100644
--- a/test/lisp/net/rcirc-tests.el
+++ b/test/lisp/net/rcirc-tests.el
@@ -1,6 +1,6 @@
;;; rcirc-tests.el --- Tests for rcirc -*- lexical-binding:t -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;;
@@ -51,4 +51,16 @@
"MODE #cchan +kl :a:b"
nil "MODE" '("#cchan" "+kl" "a:b")))
+(ert-deftest rcirc-rename-nicks ()
+ (should (equal (rcirc--make-new-nick "foo" 16)
+ "foo`"))
+ (should (equal (rcirc--make-new-nick "123456789012345" 16)
+ "123456789012345`"))
+ (should (equal (rcirc--make-new-nick "1234567890123456" 16)
+ "123456789012345`"))
+ (should (equal (rcirc--make-new-nick "123456789012345`" 16)
+ "12345678901234``"))
+ (should (equal (rcirc--make-new-nick "123456789012````" 16)
+ "12345678901`````")))
+
;;; rcirc-tests.el ends here
diff --git a/test/lisp/net/rfc2104-tests.el b/test/lisp/net/rfc2104-tests.el
index e7d5a7f30e5..f3498e760a3 100644
--- a/test/lisp/net/rfc2104-tests.el
+++ b/test/lisp/net/rfc2104-tests.el
@@ -1,6 +1,6 @@
;;; rfc2104-tests.el --- Tests of RFC2104 hashes -*- lexical-binding:t -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; Author: Lars Ingebrigtsen <larsi@gnus.org>
diff --git a/test/lisp/net/sasl-scram-rfc-tests.el b/test/lisp/net/sasl-scram-rfc-tests.el
index 09e05b62a25..3e9879a49d4 100644
--- a/test/lisp/net/sasl-scram-rfc-tests.el
+++ b/test/lisp/net/sasl-scram-rfc-tests.el
@@ -1,6 +1,6 @@
;;; sasl-scram-rfc-tests.el --- tests for SCRAM -*- lexical-binding: t; -*-
-;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2021 Free Software Foundation, Inc.
;; Author: Magnus Henoch <magnus.henoch@gmail.com>
diff --git a/test/lisp/net/secrets-tests.el b/test/lisp/net/secrets-tests.el
index 1e2cf3aef66..b392c4d1847 100644
--- a/test/lisp/net/secrets-tests.el
+++ b/test/lisp/net/secrets-tests.el
@@ -1,6 +1,6 @@
;;; secrets-tests.el --- Tests of Secret Service API -*- lexical-binding: t -*-
-;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2018-2021 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
diff --git a/test/lisp/net/shr-tests.el b/test/lisp/net/shr-tests.el
index abc4f6a656b..a06e31a4f88 100644
--- a/test/lisp/net/shr-tests.el
+++ b/test/lisp/net/shr-tests.el
@@ -1,6 +1,6 @@
;;; network-stream-tests.el --- tests for network processes -*- lexical-binding: t; -*-
-;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2016-2021 Free Software Foundation, Inc.
;; Author: Lars Ingebrigtsen <larsi@gnus.org>
diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el
new file mode 100644
index 00000000000..b378ed2964e
--- /dev/null
+++ b/test/lisp/net/socks-tests.el
@@ -0,0 +1,103 @@
+;;; socks-tests.el --- tests for SOCKS -*- coding: utf-8; lexical-binding: t; -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'socks)
+(require 'url-http)
+
+(defvar socks-tests-canned-server-port nil)
+
+(defun socks-tests-canned-server-create (verbatim patterns)
+ "Create a fake SOCKS server and return the process.
+
+`VERBATIM' and `PATTERNS' are dotted alists containing responses.
+Requests are tried in order. On failure, an error is raised."
+ (let* ((buf (generate-new-buffer "*canned-socks-server*"))
+ (filt (lambda (proc line)
+ (let ((resp (or (assoc-default line verbatim
+ (lambda (k s) ; s is line
+ (string= (concat k) s)))
+ (assoc-default line patterns
+ (lambda (p s)
+ (string-match-p p s))))))
+ (unless resp
+ (error "Unknown request: %s" line))
+ (let ((print-escape-control-characters t))
+ (princ (format "<- %s\n" (prin1-to-string line)) buf)
+ (princ (format "-> %s\n" (prin1-to-string resp)) buf))
+ (process-send-string proc (concat resp)))))
+ (srv (make-network-process :server 1
+ :buffer buf
+ :filter filt
+ :name "server"
+ :family 'ipv4
+ :host 'local
+ :service socks-tests-canned-server-port)))
+ (set-process-query-on-exit-flag srv nil)
+ (princ (format "[%s] Listening on localhost:10080\n" srv) buf)
+ srv))
+
+;; Add ([5 3 0 1 2] . [5 2]) to the `verbatim' list below to validate
+;; against curl 7.71 with the following options:
+;; $ curl --verbose -U foo:bar --proxy socks5h://127.0.0.1:10080 example.com
+;;
+;; If later implementing version 4a, try these:
+;; [4 1 0 80 0 0 0 1 0 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0] . [0 90 0 0 0 0 0 0]
+;; $ curl --verbose --proxy socks4a://127.0.0.1:10080 example.com
+
+(ert-deftest socks-tests-auth-filter-url-http ()
+ "Verify correct handling of SOCKS5 user/pass authentication."
+ (let* ((socks-server '("server" "127.0.0.1" 10080 5))
+ (socks-username "foo")
+ (socks-password "bar")
+ (url-gateway-method 'socks)
+ (url (url-generic-parse-url "http://example.com"))
+ (verbatim '(([5 2 0 2] . [5 2])
+ ([1 3 ?f ?o ?o 3 ?b ?a ?r] . [1 0])
+ ([5 1 0 3 11 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0 80]
+ . [5 0 0 1 0 0 0 0 0 0])))
+ (patterns
+ `(("^GET /" . ,(concat "HTTP/1.1 200 OK\r\n"
+ "Content-Type: text/plain; charset=UTF-8\r\n"
+ "Content-Length: 13\r\n\r\n"
+ "Hello World!\n"))))
+ (socks-tests-canned-server-port 10080)
+ (server (socks-tests-canned-server-create verbatim patterns))
+ (tries 10)
+ ;;
+ done
+ ;;
+ (cb (lambda (&rest _r)
+ (goto-char (point-min))
+ (should (search-forward "Hello World" nil t))
+ (setq done t)))
+ (buf (url-http url cb '(nil))))
+ (ert-info ("Connect to HTTP endpoint over SOCKS5 with USER/PASS method")
+ (while (and (not done) (< 0 (cl-decf tries))) ; cl-lib via url-http
+ (sleep-for 0.1)))
+ (should done)
+ (delete-process server)
+ (kill-buffer (process-buffer server))
+ (kill-buffer buf)
+ (ignore url-gateway-method)))
+
+;;; socks-tests.el ends here
diff --git a/test/lisp/net/tramp-archive-tests.el b/test/lisp/net/tramp-archive-tests.el
index 97c22fd2feb..6a6b56f4a1d 100644
--- a/test/lisp/net/tramp-archive-tests.el
+++ b/test/lisp/net/tramp-archive-tests.el
@@ -1,6 +1,6 @@
;;; tramp-archive-tests.el --- Tests of file archive access -*- lexical-binding:t -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 50db55ebb4f..5deee658296 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -1,6 +1,6 @@
;;; tramp-tests.el --- Tests of remote file access -*- lexical-binding:t -*-
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
@@ -78,6 +78,8 @@
;; Needed for Emacs 27.
(defvar process-file-return-signal-string)
(defvar shell-command-dont-erase-buffer)
+;; Needed for Emacs 28.
+(defvar dired-copy-dereference)
;; Beautify batch mode.
(when noninteractive
@@ -98,7 +100,6 @@
'("mock"
(tramp-login-program "sh")
(tramp-login-args (("-i")))
- (tramp-direct-async-args (("-c")))
(tramp-remote-shell "/bin/sh")
(tramp-remote-shell-args ("-c"))
(tramp-connection-timeout 10)))
@@ -113,7 +114,8 @@
"Temporary directory for Tramp tests.")
(defconst tramp-test-vec
- (tramp-dissect-file-name tramp-test-temporary-file-directory)
+ (and (file-remote-p tramp-test-temporary-file-directory)
+ (tramp-dissect-file-name tramp-test-temporary-file-directory))
"The used `tramp-file-name' structure.")
(setq auth-source-save-behavior nil
@@ -2169,6 +2171,8 @@ is greater than 10.
(skip-unless (tramp--test-enabled))
;; The bugs are fixed in Emacs 28.1.
(skip-unless (tramp--test-emacs28-p))
+ ;; Methods with a share do not expand "/path/..".
+ (skip-unless (not (tramp--test-share-p)))
(should
(string-equal
@@ -2268,8 +2272,8 @@ This checks also `file-name-as-directory', `file-name-directory',
(delete-file tmp-name)
(should-not (file-exists-p tmp-name))
- ;; Trashing files doesn't work for crypted remote files.
- (unless (tramp--test-crypt-p)
+ ;; Trashing files doesn't work on MS Windows, and for crypted remote files.
+ (unless (or (tramp--test-windows-nt-p) (tramp--test-crypt-p))
(let ((trash-directory (tramp--test-make-temp-name 'local quoted))
(delete-by-moving-to-trash t))
(make-directory trash-directory)
@@ -2279,9 +2283,13 @@ This checks also `file-name-as-directory', `file-name-directory',
(delete-file tmp-name 'trash)
(should-not (file-exists-p tmp-name))
(should
- (file-exists-p
- (expand-file-name
- (file-name-nondirectory tmp-name) trash-directory)))
+ (or (file-exists-p
+ (expand-file-name
+ (file-name-nondirectory tmp-name) trash-directory))
+ ;; Gdrive.
+ (file-symlink-p
+ (expand-file-name
+ (file-name-nondirectory tmp-name) trash-directory))))
(delete-directory trash-directory 'recursive)
(should-not (file-exists-p trash-directory)))))))
@@ -2431,7 +2439,7 @@ This checks also `file-name-as-directory', `file-name-directory',
;; We must check the last line. There could be
;; other messages from the progress reporter.
(should
- (string-match
+ (string-match-p
(if (and (null noninteractive)
(or (eq visit t) (null visit) (stringp visit)))
(format "^Wrote %s\n\\'" (regexp-quote tmp-name))
@@ -2536,9 +2544,8 @@ This checks also `file-name-as-directory', `file-name-directory',
;; Copy file to directory.
(unwind-protect
- ;; FIXME: This fails on my QNAP server, see
- ;; /share/Web/owncloud/data/owncloud.log
- (unless (or (tramp--test-ange-ftp-p) (tramp--test-nextcloud-p))
+ ;; This doesn't work on FTP.
+ (unless (tramp--test-ange-ftp-p)
(write-region "foo" nil source)
(should (file-exists-p source))
(make-directory target)
@@ -2562,9 +2569,8 @@ This checks also `file-name-as-directory', `file-name-directory',
;; Copy directory to existing directory.
(unwind-protect
- ;; FIXME: This fails on my QNAP server, see
- ;; /share/Web/owncloud/data/owncloud.log
- (unless (or (tramp--test-ange-ftp-p) (tramp--test-nextcloud-p))
+ ;; This doesn't work on FTP.
+ (unless (tramp--test-ange-ftp-p)
(make-directory source)
(should (file-directory-p source))
(write-region "foo" nil (expand-file-name "foo" source))
@@ -2585,9 +2591,8 @@ This checks also `file-name-as-directory', `file-name-directory',
;; Copy directory/file to non-existing directory.
(unwind-protect
- ;; FIXME: This fails on my QNAP server, see
- ;; /share/Web/owncloud/data/owncloud.log
- (unless (or (tramp--test-ange-ftp-p) (tramp--test-nextcloud-p))
+ ;; This doesn't work on FTP.
+ (unless (tramp--test-ange-ftp-p)
(make-directory source)
(should (file-directory-p source))
(write-region "foo" nil (expand-file-name "foo" source))
@@ -2680,9 +2685,8 @@ This checks also `file-name-as-directory', `file-name-directory',
;; Rename directory to existing directory.
(unwind-protect
- ;; FIXME: This fails on my QNAP server, see
- ;; /share/Web/owncloud/data/owncloud.log
- (unless (or (tramp--test-ange-ftp-p) (tramp--test-nextcloud-p))
+ ;; This doesn't work on FTP.
+ (unless (tramp--test-ange-ftp-p)
(make-directory source)
(should (file-directory-p source))
(write-region "foo" nil (expand-file-name "foo" source))
@@ -2704,9 +2708,8 @@ This checks also `file-name-as-directory', `file-name-directory',
;; Rename directory/file to non-existing directory.
(unwind-protect
- ;; FIXME: This fails on my QNAP server, see
- ;; /share/Web/owncloud/data/owncloud.log
- (unless (or (tramp--test-ange-ftp-p) (tramp--test-nextcloud-p))
+ ;; This doesn't work on FTP.
+ (unless (tramp--test-ange-ftp-p)
(make-directory source)
(should (file-directory-p source))
(write-region "foo" nil (expand-file-name "foo" source))
@@ -2783,8 +2786,9 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
(should-not (file-directory-p tmp-name1))
;; Trashing directories works only since Emacs 27.1. It doesn't
- ;; work for crypted remote directories.
- (when (and (not (tramp--test-crypt-p)) (tramp--test-emacs27-p))
+ ;; work on MS Windows, for crypted remote directories and for ange-ftp.
+ (when (and (not (tramp--test-windows-nt-p)) (not (tramp--test-crypt-p))
+ (not (tramp--test-ftp-p)) (tramp--test-emacs27-p))
(let ((trash-directory (tramp--test-make-temp-name 'local quoted))
(delete-by-moving-to-trash t))
(make-directory trash-directory)
@@ -2830,6 +2834,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
(ert-deftest tramp-test15-copy-directory ()
"Check `copy-directory'."
(skip-unless (tramp--test-enabled))
+ (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(let* ((tmp-name1 (tramp--test-make-temp-name nil quoted))
@@ -2925,7 +2930,15 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
'("bla" "foo")))
(should (equal (directory-files
tmp-name1 'full directory-files-no-dot-files-regexp)
- `(,tmp-name2 ,tmp-name3))))
+ `(,tmp-name2 ,tmp-name3)))
+ ;; Check the COUNT arg. It exists since Emacs 28.
+ (when (tramp--test-emacs28-p)
+ (with-no-warnings
+ (should
+ (equal
+ (directory-files
+ tmp-name1 nil directory-files-no-dot-files-regexp nil 1)
+ '("bla"))))))
;; Cleanup.
(ignore-errors (delete-directory tmp-name1 'recursive))))))
@@ -3056,9 +3069,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
(regexp-opt (directory-files tmp-name1))
(length (directory-files tmp-name1)))))))
- ;; Check error case. We do not check for the error type,
- ;; because ls-lisp returns `file-error', and native Tramp
- ;; returns `file-missing'.
+ ;; Check error case.
(delete-directory tmp-name1 'recursive)
(with-temp-buffer
(should-error
@@ -3177,6 +3188,59 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
(ignore-errors (delete-directory tmp-name1 'recursive))
(ignore-errors (delete-directory tmp-name2 'recursive))))))
+;; The following test is inspired by Bug#45691.
+(ert-deftest tramp-test17-insert-directory-one-file ()
+ "Check `insert-directory' inside directory listing."
+ (skip-unless (tramp--test-enabled))
+
+ (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
+ (let* ((tmp-name1
+ (expand-file-name (tramp--test-make-temp-name nil quoted)))
+ (tmp-name2 (expand-file-name "foo" tmp-name1))
+ (tmp-name3 (expand-file-name "bar" tmp-name1))
+ (dired-copy-preserve-time t)
+ (dired-recursive-copies 'top)
+ dired-copy-dereference
+ buffer)
+ (unwind-protect
+ (progn
+ (make-directory tmp-name1)
+ (write-region "foo" nil tmp-name2)
+ (should (file-directory-p tmp-name1))
+ (should (file-exists-p tmp-name2))
+
+ ;; Check, that `insert-directory' works properly.
+ (with-current-buffer
+ (setq buffer (dired-noselect tmp-name1 "--dired -al"))
+ (read-only-mode -1)
+ (goto-char (point-min))
+ (while (not (or (eobp)
+ (string-equal
+ (dired-get-filename 'localp 'no-error)
+ (file-name-nondirectory tmp-name2))))
+ (forward-line 1))
+ (should-not (eobp))
+ (copy-file tmp-name2 tmp-name3)
+ (insert-directory
+ (file-name-nondirectory tmp-name3) "--dired -al -d")
+ ;; Point shall still be the recent file.
+ (should
+ (string-equal
+ (dired-get-filename 'localp 'no-error)
+ (file-name-nondirectory tmp-name2)))
+ (should-not (re-search-forward "dired" nil t))
+ ;; The copied file has been inserted the line before.
+ (forward-line -1)
+ (should
+ (string-equal
+ (dired-get-filename 'localp 'no-error)
+ (file-name-nondirectory tmp-name3))))
+ (kill-buffer buffer))
+
+ ;; Cleanup.
+ (ignore-errors (kill-buffer buffer))
+ (ignore-errors (delete-directory tmp-name1 'recursive))))))
+
;; Method "smb" supports `make-symbolic-link' only if the remote host
;; has CIFS capabilities. tramp-adb.el, tramp-gvfs.el and
;; tramp-rclone.el do not support symbolic links at all.
@@ -3443,7 +3507,14 @@ They might differ only in time attributes or directory size."
(file-attributes (car elt)) (cdr elt))))
(setq attr (directory-files-and-attributes tmp-name2 nil "\\`b"))
- (should (equal (mapcar #'car attr) '("bar" "boz"))))
+ (should (equal (mapcar #'car attr) '("bar" "boz")))
+
+ ;; Check the COUNT arg. It exists since Emacs 28.
+ (when (tramp--test-emacs28-p)
+ (with-no-warnings
+ (setq attr (directory-files-and-attributes
+ tmp-name2 nil "\\`b" nil nil 1))
+ (should (equal (mapcar #'car attr) '("bar"))))))
;; Cleanup.
(ignore-errors (delete-directory tmp-name1 'recursive))))))
@@ -3543,8 +3614,8 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
`(condition-case err
(progn ,@body)
(file-error
- (unless (string-match "^error with add-name-to-file"
- (error-message-string err))
+ (unless (string-match-p "^error with add-name-to-file"
+ (error-message-string err))
(signal (car err) (cdr err))))))
(ert-deftest tramp-test21-file-links ()
@@ -4319,7 +4390,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; there's an indication for a signal describing string.
(let ((process-file-return-signal-string t))
(should
- (string-match
+ (string-match-p
"Interrupt\\|Signal 2"
(process-file
(if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh")
@@ -4387,7 +4458,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(with-timeout (10 (tramp--test-timeout-handler))
(while (< (- (point-max) (point-min)) (length "foo"))
(while (accept-process-output proc 0 nil t))))
- (should (string-match "foo" (buffer-string))))
+ (should (string-match-p "foo" (buffer-string))))
;; Cleanup.
(ignore-errors (delete-process proc)))
@@ -4406,7 +4477,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(with-timeout (10 (tramp--test-timeout-handler))
(while (< (- (point-max) (point-min)) (length "foo"))
(while (accept-process-output proc 0 nil t))))
- (should (string-match "foo" (buffer-string))))
+ (should (string-match-p "foo" (buffer-string))))
;; Cleanup.
(ignore-errors
@@ -4428,7 +4499,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(with-timeout (10 (tramp--test-timeout-handler))
(while (< (- (point-max) (point-min)) (length "foo"))
(while (accept-process-output proc 0 nil t))))
- (should (string-match "foo" (buffer-string))))
+ (should (string-match-p "foo" (buffer-string))))
;; Cleanup.
(ignore-errors (delete-process proc)))
@@ -4441,10 +4512,13 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(should-error
(start-file-process "test4" (current-buffer) nil)
:type 'wrong-type-argument)
+
(setq proc (start-file-process "test4" (current-buffer) nil))
(should (processp proc))
(should (equal (process-status proc) 'run))
- (should (stringp (process-tty-name proc)))))
+ ;; On MS Windows, `process-tty-name' returns nil.
+ (unless (tramp--test-windows-nt-p)
+ (should (stringp (process-tty-name proc))))))
;; Cleanup.
(ignore-errors (delete-process proc))))))
@@ -4454,21 +4528,28 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
"Define ert test `TEST-direct-async' for direct async processes.
If UNSTABLE is non-nil, the test is tagged as `:unstable'."
(declare (indent 1))
- `(ert-deftest ,(intern (concat (symbol-name test) "-direct-async")) ()
- ,docstring
- :tags (if ,unstable '(:expensive-test :unstable) '(:expensive-test))
- (skip-unless (tramp--test-enabled))
- (let ((default-directory tramp-test-temporary-file-directory)
- (ert-test (ert-get-test ',test))
- (tramp-connection-properties
- (cons '(nil "direct-async-process" t) tramp-connection-properties)))
- (skip-unless (tramp-direct-async-process-p))
- ;; We do expect an established connection already,
- ;; `file-truename' does it by side-effect. Suppress
- ;; `tramp--test-enabled', in order to keep the connection.
- (cl-letf (((symbol-function #'tramp--test-enabled) (lambda nil t)))
- (file-truename tramp-test-temporary-file-directory)
- (funcall (ert-test-body ert-test))))))
+ ;; `make-process' supports file name handlers since Emacs 27.
+ (when (let ((file-name-handler-alist '(("" . (lambda (&rest _) t)))))
+ (ignore-errors (make-process :file-handler t)))
+ `(ert-deftest ,(intern (concat (symbol-name test) "-direct-async")) ()
+ ,docstring
+ :tags (if ,unstable '(:expensive-test :unstable) '(:expensive-test))
+ (skip-unless (tramp--test-enabled))
+ (let ((default-directory tramp-test-temporary-file-directory)
+ (ert-test (ert-get-test ',test))
+ (tramp-connection-properties
+ (cons '(nil "direct-async-process" t)
+ tramp-connection-properties)))
+ (skip-unless (tramp-direct-async-process-p))
+ ;; We do expect an established connection already,
+ ;; `file-truename' does it by side-effect. Suppress
+ ;; `tramp--test-enabled', in order to keep the connection.
+ ;; Suppress "Process ... finished" messages.
+ (cl-letf (((symbol-function #'tramp--test-enabled) (lambda nil t))
+ ((symbol-function #'internal-default-process-sentinel)
+ #'ignore))
+ (file-truename tramp-test-temporary-file-directory)
+ (funcall (ert-test-body ert-test)))))))
(tramp--test--deftest-direct-async-process tramp-test29-start-file-process
"Check direct async `start-file-process'.")
@@ -4505,7 +4586,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
(with-timeout (10 (tramp--test-timeout-handler))
(while (< (- (point-max) (point-min)) (length "foo"))
(while (accept-process-output proc 0 nil t))))
- (should (string-match "foo" (buffer-string))))
+ (should (string-match-p "foo" (buffer-string))))
;; Cleanup.
(ignore-errors (delete-process proc)))
@@ -4526,7 +4607,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
(with-timeout (10 (tramp--test-timeout-handler))
(while (< (- (point-max) (point-min)) (length "foo"))
(while (accept-process-output proc 0 nil t))))
- (should (string-match "foo" (buffer-string))))
+ (should (string-match-p "foo" (buffer-string))))
;; Cleanup.
(ignore-errors
@@ -4550,9 +4631,9 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
(process-send-eof proc)
;; Read output.
(with-timeout (10 (tramp--test-timeout-handler))
- (while (not (string-match "foo" (buffer-string)))
+ (while (not (string-match-p "foo" (buffer-string)))
(while (accept-process-output proc 0 nil t))))
- (should (string-match "foo" (buffer-string))))
+ (should (string-match-p "foo" (buffer-string))))
;; Cleanup.
(ignore-errors (delete-process proc)))
@@ -4577,7 +4658,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
(with-timeout (10 (tramp--test-timeout-handler))
(while (accept-process-output proc 0 nil t)))
;; On some MS Windows systems, it returns "unknown signal".
- (should (string-match "unknown signal\\|killed" (buffer-string))))
+ (should (string-match-p "unknown signal\\|killed" (buffer-string))))
;; Cleanup.
(ignore-errors (delete-process proc)))
@@ -4601,7 +4682,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
(delete-process proc)
(with-current-buffer stderr
(should
- (string-match
+ (string-match-p
"cat:.* No such file or directory" (buffer-string)))))
;; Cleanup.
@@ -4628,7 +4709,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
(with-temp-buffer
(insert-file-contents tmpfile)
(should
- (string-match
+ (string-match-p
"cat:.* No such file or directory" (buffer-string)))))
;; Cleanup.
@@ -4640,7 +4721,8 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
(ert-deftest tramp-test31-interrupt-process ()
"Check `interrupt-process'."
- :tags '(:expensive-test)
+ :tags (if (or (getenv "EMACS_HYDRA_CI") (getenv "EMACS_EMBA_CI"))
+ '(:expensive-test :unstable) '(:expensive-test))
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-crypt-p)))
@@ -4680,15 +4762,16 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
(command output-buffer &optional error-buffer input)
"Like `async-shell-command', reading the output.
INPUT, if non-nil, is a string sent to the process."
- (async-shell-command command output-buffer error-buffer)
- (let ((proc (get-buffer-process output-buffer))
+ (let ((proc (async-shell-command command output-buffer error-buffer))
(delete-exited-processes t))
- (when (stringp input)
- (process-send-string proc input))
- (with-timeout
- ((if (getenv "EMACS_EMBA_CI") 30 10) (tramp--test-timeout-handler))
- (while (or (accept-process-output proc nil nil t) (process-live-p proc))))
- (accept-process-output proc nil nil t)))
+ (cl-letf (((symbol-function #'shell-command-sentinel) #'ignore))
+ (when (stringp input)
+ (process-send-string proc input))
+ (with-timeout
+ ((if (getenv "EMACS_EMBA_CI") 30 10) (tramp--test-timeout-handler))
+ (while
+ (or (accept-process-output proc nil nil t) (process-live-p proc))))
+ (accept-process-output proc nil nil t))))
(defun tramp--test-shell-command-to-string-asynchronously (command)
"Like `shell-command-to-string', but for asynchronous processes."
@@ -4742,19 +4825,20 @@ INPUT, if non-nil, is a string sent to the process."
(ignore-errors (delete-file tmp-name)))
;; Test `{async-}shell-command' with error buffer.
- (let ((stderr (generate-new-buffer "*stderr*")))
- (unwind-protect
- (with-temp-buffer
- (funcall
- this-shell-command
- "echo foo >&2; echo bar" (current-buffer) stderr)
- (should (string-equal "bar\n" (buffer-string)))
- ;; Check stderr.
- (with-current-buffer stderr
- (should (string-equal "foo\n" (buffer-string)))))
+ (unless (tramp-direct-async-process-p)
+ (let ((stderr (generate-new-buffer "*stderr*")))
+ (unwind-protect
+ (with-temp-buffer
+ (funcall
+ this-shell-command
+ "echo foo >&2; echo bar" (current-buffer) stderr)
+ (should (string-equal "bar\n" (buffer-string)))
+ ;; Check stderr.
+ (with-current-buffer stderr
+ (should (string-equal "foo\n" (buffer-string)))))
- ;; Cleanup.
- (ignore-errors (kill-buffer stderr)))))
+ ;; Cleanup.
+ (ignore-errors (kill-buffer stderr))))))
;; Test sending string to `async-shell-command'.
(unwind-protect
@@ -4768,7 +4852,7 @@ INPUT, if non-nil, is a string sent to the process."
(should
(string-equal
;; tramp-adb.el echoes, so we must add the string.
- (if (tramp--test-adb-p)
+ (if (and (tramp--test-adb-p) (not (tramp-direct-async-process-p)))
(format
"%s\n%s\n"
(file-name-nondirectory tmp-name)
@@ -4790,6 +4874,9 @@ INPUT, if non-nil, is a string sent to the process."
(when (natnump cols)
(should (= cols async-shell-command-width))))))
+(tramp--test--deftest-direct-async-process tramp-test32-shell-command
+ "Check direct async `shell-command'." 'unstable)
+
;; This test is inspired by Bug#39067.
(ert-deftest tramp-test32-shell-command-dont-erase-buffer ()
"Check `shell-command-dont-erase-buffer'."
@@ -4797,6 +4884,7 @@ INPUT, if non-nil, is a string sent to the process."
;; this test cannot run properly.
:tags '(:expensive-test :unstable)
(skip-unless (tramp--test-enabled))
+ (skip-unless nil)
(skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
(skip-unless (not (tramp--test-crypt-p)))
;; Prior Emacs 27, `shell-command-dont-erase-buffer' wasn't working properly.
@@ -4940,7 +5028,7 @@ INPUT, if non-nil, is a string sent to the process."
(should
(string-equal
(format "%s,tramp:%s\n" emacs-version tramp-version)
- (funcall this-shell-command-to-string "echo ${INSIDE_EMACS:-bla}")))
+ (funcall this-shell-command-to-string "echo \"${INSIDE_EMACS:-bla}\"")))
(let ((process-environment
(cons (format "INSIDE_EMACS=%s,foo" emacs-version)
process-environment)))
@@ -4948,58 +5036,66 @@ INPUT, if non-nil, is a string sent to the process."
(string-equal
(format "%s,foo,tramp:%s\n" emacs-version tramp-version)
(funcall
- this-shell-command-to-string "echo ${INSIDE_EMACS:-bla}"))))
+ this-shell-command-to-string "echo \"${INSIDE_EMACS:-bla}\""))))
;; Set a value.
(let ((process-environment
(cons (concat envvar "=foo") process-environment)))
;; Default value.
(should
- (string-match
+ (string-match-p
"foo"
(funcall
- this-shell-command-to-string (format "echo ${%s:-bla}" envvar)))))
+ this-shell-command-to-string
+ (format "echo \"${%s:-bla}\"" envvar)))))
;; Set the empty value.
(let ((process-environment
(cons (concat envvar "=") process-environment)))
;; Value is null.
(should
- (string-match
+ (string-match-p
"bla"
(funcall
- this-shell-command-to-string (format "echo ${%s:-bla}" envvar))))
+ this-shell-command-to-string (format "echo \"${%s:-bla}\"" envvar))))
;; Variable is set.
(should
- (string-match
+ (string-match-p
(regexp-quote envvar)
(funcall this-shell-command-to-string "set"))))
- ;; We force a reconnect, in order to have a clean environment.
- (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
- ;; Unset the variable.
- (let ((tramp-remote-process-environment
- (cons (concat envvar "=foo") tramp-remote-process-environment)))
- ;; Set the initial value, we want to unset below.
- (should
- (string-match
- "foo"
- (funcall
- this-shell-command-to-string (format "echo ${%s:-bla}" envvar))))
- (let ((process-environment (cons envvar process-environment)))
- ;; Variable is unset.
+ (unless (tramp-direct-async-process-p)
+ ;; We force a reconnect, in order to have a clean environment.
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
+ ;; Unset the variable.
+ (let ((tramp-remote-process-environment
+ (cons (concat envvar "=foo") tramp-remote-process-environment)))
+ ;; Set the initial value, we want to unset below.
(should
- (string-match
- "bla"
- (funcall
- this-shell-command-to-string (format "echo ${%s:-bla}" envvar))))
- ;; Variable is unset.
- (should-not
- (string-match
- (regexp-quote envvar)
- ;; We must remove PS1, the output is truncated otherwise.
+ (string-match-p
+ "foo"
(funcall
- this-shell-command-to-string "printenv | grep -v PS1"))))))))
+ this-shell-command-to-string
+ (format "echo \"${%s:-bla}\"" envvar))))
+ (let ((process-environment (cons envvar process-environment)))
+ ;; Variable is unset.
+ (should
+ (string-match-p
+ "bla"
+ (funcall
+ this-shell-command-to-string
+ (format "echo \"${%s:-bla}\"" envvar))))
+ ;; Variable is unset.
+ (should-not
+ (string-match-p
+ (regexp-quote envvar)
+ ;; We must remove PS1, the output is truncated otherwise.
+ (funcall
+ this-shell-command-to-string "printenv | grep -v PS1")))))))))
+
+(tramp--test--deftest-direct-async-process tramp-test33-environment-variables
+ "Check that remote processes set / unset environment variables properly.
+Use direct async.")
;; This test is inspired by Bug#27009.
(ert-deftest tramp-test33-environment-variables-and-port-numbers ()
@@ -5029,7 +5125,7 @@ INPUT, if non-nil, is a string sent to the process."
(format "%s=%d" envvar port)
tramp-remote-process-environment)))
(should
- (string-match
+ (string-match-p
(number-to-string port)
(shell-command-to-string (format "echo $%s" envvar))))))
@@ -5157,7 +5253,7 @@ INPUT, if non-nil, is a string sent to the process."
(with-timeout (10)
(while (accept-process-output
(get-buffer-process (current-buffer)) nil nil t)))
- (should (string-match "^foo$" (buffer-string)))))
+ (should (string-match-p "^foo$" (buffer-string)))))
;; Cleanup.
(put 'explicit-shell-file-name 'permanent-local nil)
@@ -5292,25 +5388,27 @@ INPUT, if non-nil, is a string sent to the process."
(tramp-remote-process-environment tramp-remote-process-environment)
(inhibit-message t)
(vc-handled-backends
- (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
- (cond
- ((tramp-find-executable
- v vc-git-program (tramp-get-remote-path v))
- '(Git))
- ((tramp-find-executable
- v vc-hg-program (tramp-get-remote-path v))
- '(Hg))
- ((tramp-find-executable
- v vc-bzr-program (tramp-get-remote-path v))
- (setq tramp-remote-process-environment
- (cons (format "BZR_HOME=%s"
- (file-remote-p tmp-name1 'localname))
- tramp-remote-process-environment))
- ;; We must force a reconnect, in order to activate $BZR_HOME.
- (tramp-cleanup-connection
- tramp-test-vec 'keep-debug 'keep-password)
- '(Bzr))
- (t nil))))
+ (cond
+ ((tramp-find-executable
+ tramp-test-vec vc-git-program
+ (tramp-get-remote-path tramp-test-vec))
+ '(Git))
+ ((tramp-find-executable
+ tramp-test-vec vc-hg-program
+ (tramp-get-remote-path tramp-test-vec))
+ '(Hg))
+ ((tramp-find-executable
+ tramp-test-vec vc-bzr-program
+ (tramp-get-remote-path tramp-test-vec))
+ (setq tramp-remote-process-environment
+ (cons (format "BZR_HOME=%s"
+ (file-remote-p tmp-name1 'localname))
+ tramp-remote-process-environment))
+ ;; We must force a reconnect, in order to activate $BZR_HOME.
+ (tramp-cleanup-connection
+ tramp-test-vec 'keep-debug 'keep-password)
+ '(Bzr))
+ (t nil)))
;; Suppress nasty messages.
(inhibit-message t))
(skip-unless vc-handled-backends)
@@ -5636,7 +5734,7 @@ This does not support some special file names."
"Check, whether an FTP-like method is used.
This does not support globbing characters in file names (yet)."
;; Globbing characters are ??, ?* and ?\[.
- (string-match
+ (string-match-p
"ftp$" (file-remote-p tramp-test-temporary-file-directory 'method)))
(defun tramp--test-gvfs-p (&optional method)
@@ -5650,18 +5748,18 @@ 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.
- (with-parsed-tramp-file-name
- (file-truename tramp-test-temporary-file-directory) nil
- (string-match "^HP-UX" (tramp-get-connection-property v "uname" ""))))
+ (file-truename tramp-test-temporary-file-directory) nil
+ (string-match-p
+ "^HP-UX" (tramp-get-connection-property tramp-test-vec "uname" "")))
(defun tramp--test-ksh-p ()
"Check, whether the remote shell is ksh.
ksh93 makes some strange conversions of non-latin characters into
a $'' syntax."
;; We must refill the cache. `file-truename' does it.
- (with-parsed-tramp-file-name
- (file-truename tramp-test-temporary-file-directory) nil
- (string-match "ksh$" (tramp-get-connection-property v "remote-shell" ""))))
+ (file-truename tramp-test-temporary-file-directory) nil
+ (string-match-p
+ "ksh$" (tramp-get-connection-property tramp-test-vec "remote-shell" "")))
(defun tramp--test-mock-p ()
"Check, whether the mock method is used.
@@ -5687,8 +5785,14 @@ This does not support special file names."
(defun tramp--test-sh-p ()
"Check, whether the remote host runs a based method from tramp-sh.el."
- (tramp-sh-file-name-handler-p
- (tramp-dissect-file-name tramp-test-temporary-file-directory)))
+ (tramp-sh-file-name-handler-p tramp-test-vec))
+
+(defun tramp--test-share-p ()
+ "Check, whether the method needs a share."
+ (and (tramp--test-gvfs-p)
+ (string-match-p
+ "^\\(afp\\|davs?\\|smb\\)$"
+ (file-remote-p tramp-test-temporary-file-directory 'method))))
(defun tramp--test-sudoedit-p ()
"Check, whether the sudoedit method is used."
@@ -5707,7 +5811,7 @@ This does not support special characters."
"Check, whether the locale host runs MS Windows, and ps{cp,ftp} is used.
This does not support utf8 based file transfer."
(and (eq system-type 'windows-nt)
- (string-match
+ (string-match-p
(regexp-opt '("pscp" "psftp"))
(file-remote-p tramp-test-temporary-file-directory 'method))))
@@ -5736,7 +5840,8 @@ This requires restrictions of file name syntax."
(tmp-name2 (tramp--test-make-temp-name 'local quoted))
(files (delq nil files))
(process-environment process-environment)
- (sorted-files (sort (copy-sequence files) #'string-lessp)))
+ (sorted-files (sort (copy-sequence files) #'string-lessp))
+ buffer)
(unwind-protect
(progn
(make-directory tmp-name1)
@@ -5798,6 +5903,18 @@ This requires restrictions of file name syntax."
tmp-name2 nil directory-files-no-dot-files-regexp))
sorted-files))
+ ;; Check, that `insert-directory' works properly.
+ (with-current-buffer
+ (setq buffer (dired-noselect tmp-name1 "--dired -al"))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (when-let ((name (dired-get-filename 'localp 'no-error)))
+ (unless
+ (string-match-p name directory-files-no-dot-files-regexp)
+ (should (member name files))))
+ (forward-line 1)))
+ (kill-buffer buffer)
+
;; `substitute-in-file-name' could return different
;; values. For `adb', there could be strange file
;; permissions preventing overwriting a file. We don't
@@ -5893,6 +6010,7 @@ This requires restrictions of file name syntax."
(regexp-quote (getenv envvar))))))))))
;; Cleanup.
+ (ignore-errors (kill-buffer buffer))
(ignore-errors (delete-directory tmp-name1 'recursive))
(ignore-errors (delete-directory tmp-name2 'recursive))))))
@@ -5956,6 +6074,7 @@ This requires restrictions of file name syntax."
(skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-rsync-p)))
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
+ (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
(tramp--test-special-characters))
@@ -5967,6 +6086,8 @@ Use the `stat' command."
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-rsync-p)))
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
+ (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
+ ;; We cannot use `tramp-test-vec', because this fails during compilation.
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
(skip-unless (tramp-get-remote-stat v)))
@@ -5985,6 +6106,8 @@ Use the `perl' command."
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-rsync-p)))
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
+ (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
+ ;; We cannot use `tramp-test-vec', because this fails during compilation.
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
(skip-unless (tramp-get-remote-perl v)))
@@ -6007,6 +6130,7 @@ Use the `ls' command."
(skip-unless (not (tramp--test-rsync-p)))
(skip-unless (not (tramp--test-windows-nt-and-batch-p)))
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
+ (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
(let ((tramp-connection-properties
(append
@@ -6075,6 +6199,7 @@ Use the `ls' command."
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
(skip-unless (not (tramp--test-ksh-p)))
(skip-unless (not (tramp--test-crypt-p)))
+ (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
(tramp--test-utf8))
@@ -6090,6 +6215,8 @@ Use the `stat' command."
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
(skip-unless (not (tramp--test-ksh-p)))
(skip-unless (not (tramp--test-crypt-p)))
+ (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
+ ;; We cannot use `tramp-test-vec', because this fails during compilation.
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
(skip-unless (tramp-get-remote-stat v)))
@@ -6112,6 +6239,8 @@ Use the `perl' command."
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
(skip-unless (not (tramp--test-ksh-p)))
(skip-unless (not (tramp--test-crypt-p)))
+ (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
+ ;; We cannot use `tramp-test-vec', because this fails during compilation.
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
(skip-unless (tramp-get-remote-perl v)))
@@ -6137,6 +6266,7 @@ Use the `ls' command."
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
(skip-unless (not (tramp--test-ksh-p)))
(skip-unless (not (tramp--test-crypt-p)))
+ (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
(let ((tramp-connection-properties
(append
@@ -6210,15 +6340,16 @@ This is needed in timer functions as well as process filters and sentinels."
"Check parallel asynchronous requests.
Such requests could arrive from timers, process filters and
process sentinels. They shall not disturb each other."
- ;; The test fails from time to time, w/o a reproducible pattern. So
- ;; we mark it as unstable.
- :tags '(:expensive-test :unstable)
+ :tags (if (getenv "EMACS_EMBA_CI")
+ '(:expensive-test :unstable) '(:expensive-test))
(skip-unless (tramp--test-enabled))
;; Prior Emacs 27, `shell-file-name' was hard coded as "/bin/sh" for
;; remote processes in Emacs. That doesn't work for tramp-adb.el.
(skip-unless (or (and (tramp--test-adb-p) (tramp--test-emacs27-p))
(tramp--test-sh-p)))
(skip-unless (not (tramp--test-crypt-p)))
+ (skip-unless (not (tramp--test-docker-p)))
+ (skip-unless (not (tramp--test-windows-nt-p)))
(with-timeout
(tramp--test-asynchronous-requests-timeout (tramp--test-timeout-handler))
@@ -6228,12 +6359,11 @@ process sentinels. They shall not disturb each other."
(shell-file-name (if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh"))
;; It doesn't work on w32 systems.
(watchdog
- (unless (tramp--test-windows-nt-p)
- (start-process-shell-command
- "*watchdog*" nil
- (format
- "sleep %d; kill -USR1 %d"
- tramp--test-asynchronous-requests-timeout (emacs-pid)))))
+ (start-process-shell-command
+ "*watchdog*" nil
+ (format
+ "sleep %d; kill -USR1 %d"
+ tramp--test-asynchronous-requests-timeout (emacs-pid))))
(tmp-name (tramp--test-make-temp-name))
(default-directory tmp-name)
;; Do not cache Tramp properties.
@@ -6257,10 +6387,10 @@ process sentinels. They shall not disturb each other."
((getenv "EMACS_HYDRA_CI") 10)
(t 1)))
;; We must distinguish due to performance reasons.
- ;; (timer-operation
- ;; (cond
- ;; ((tramp--test-mock-p) #'vc-registered)
- ;; (t #'file-attributes)))
+ (timer-operation
+ (cond
+ ((tramp--test-mock-p) #'vc-registered)
+ (t #'file-attributes)))
;; This is when all timers start. We check inside the
;; timer function, that we don't exceed timeout.
(timer-start (current-time))
@@ -6288,10 +6418,15 @@ process sentinels. They shall not disturb each other."
(default-directory tmp-name)
(file
(buffer-name
- (nth (random (length buffers)) buffers))))
+ (nth (random (length buffers)) buffers)))
+ ;; A remote operation in a timer could
+ ;; confuse Tramp heavily. So we ignore this
+ ;; error here.
+ (debug-ignored-errors
+ (cons 'remote-file-error debug-ignored-errors)))
(tramp--test-message
"Start timer %s %s" file (current-time-string))
- ;; (funcall timer-operation file)
+ (funcall timer-operation file)
(tramp--test-message
"Stop timer %s %s" file (current-time-string))
;; Adjust timer if it takes too much time.
@@ -6401,6 +6536,9 @@ process sentinels. They shall not disturb each other."
(ignore-errors (cancel-timer timer))
(ignore-errors (delete-directory tmp-name 'recursive))))))
+;; (tramp--test--deftest-direct-async-process tramp-test43-asynchronous-requests
+;; "Check parallel direct asynchronous requests." 'unstable)
+
;; This test is inspired by Bug#29163.
(ert-deftest tramp-test44-auto-load ()
"Check that Tramp autoloads properly."
@@ -6417,7 +6555,7 @@ process sentinels. They shall not disturb each other."
(message \"Tramp loaded: %%s\" (and (file-remote-p %S) t)))"
tramp-test-temporary-file-directory)))
(should
- (string-match
+ (string-match-p
"Tramp loaded: t[\n\r]+"
(shell-command-to-string
(format
@@ -6448,7 +6586,7 @@ process sentinels. They shall not disturb each other."
;; Tramp doesn't load when `tramp-mode' is nil.
(dolist (tm '(t nil))
(should
- (string-match
+ (string-match-p
(format
"Tramp loaded: nil[\n\r]+Tramp loaded: nil[\n\r]+Tramp loaded: %s[\n\r]+"
tm)
@@ -6474,7 +6612,7 @@ process sentinels. They shall not disturb each other."
tramp-test-temporary-file-directory
temporary-file-directory)))
(should-not
- (string-match
+ (string-match-p
"Recursive load"
(shell-command-to-string
(format
@@ -6499,7 +6637,7 @@ process sentinels. They shall not disturb each other."
(load-path (cons \"/foo:bar:\" load-path))) \
(tramp-cleanup-all-connections))"))
(should
- (string-match
+ (string-match-p
(format
"Loading %s"
(regexp-quote
@@ -6546,11 +6684,11 @@ Since it unloads Tramp, it shall be the last test to run."
(lambda (x)
(and (or (and (boundp x) (null (local-variable-if-set-p x)))
(and (functionp x) (null (autoloadp (symbol-function x)))))
- (string-match "^tramp" (symbol-name x))
+ (string-match-p "^tramp" (symbol-name x))
;; `tramp-completion-mode' is autoloaded in Emacs < 28.1.
(not (eq 'tramp-completion-mode x))
- (not (string-match "^tramp\\(-archive\\)?--?test" (symbol-name x)))
- (not (string-match "unload-hook$" (symbol-name x)))
+ (not (string-match-p "^tramp\\(-archive\\)?--?test" (symbol-name x)))
+ (not (string-match-p "unload-hook$" (symbol-name x)))
(ert-fail (format "`%s' still bound" x)))))
;; The defstruct `tramp-file-name' and all its internal functions
;; shall be purged.
@@ -6558,15 +6696,15 @@ Since it unloads Tramp, it shall be the last test to run."
(mapatoms
(lambda (x)
(and (functionp x)
- (string-match "tramp-file-name" (symbol-name x))
+ (string-match-p "tramp-file-name" (symbol-name x))
(ert-fail (format "Structure function `%s' still exists" x)))))
;; There shouldn't be left a hook function containing a Tramp
;; function. We do not regard the Tramp unload hooks.
(mapatoms
(lambda (x)
(and (boundp x)
- (string-match "-\\(hook\\|function\\)s?$" (symbol-name x))
- (not (string-match "unload-hook$" (symbol-name x)))
+ (string-match-p "-\\(hook\\|function\\)s?$" (symbol-name x))
+ (not (string-match-p "unload-hook$" (symbol-name x)))
(consp (symbol-value x))
(ignore-errors (all-completions "tramp" (symbol-value x)))
(ert-fail (format "Hook `%s' still contains Tramp function" x))))))
@@ -6592,14 +6730,12 @@ If INTERACTIVE is non-nil, the tests are run interactively."
;; * Work on skipped tests. Make a comment, when it is impossible.
;; * Revisit expensive tests, once problems in `tramp-error' are solved.
-;; * Fix `tramp-test05-expand-file-name-relative' in `expand-file-name'.
;; * Fix `tramp-test06-directory-file-name' for `ftp'.
;; * Investigate, why `tramp-test11-copy-file' and `tramp-test12-rename-file'
;; do not work properly for `nextcloud'.
;; * Implement `tramp-test31-interrupt-process' for `adb' and for
;; direct async processes.
-;; * Fix Bug#16928 in `tramp-test43-asynchronous-requests'. A remote
-;; file name operation cannot run in the timer. Remove `:unstable' tag?
+;; * Fix `tramp-test44-threads'.
(provide 'tramp-tests)
diff --git a/test/lisp/net/webjump-tests.el b/test/lisp/net/webjump-tests.el
index 47569c948f5..f767099925c 100644
--- a/test/lisp/net/webjump-tests.el
+++ b/test/lisp/net/webjump-tests.el
@@ -1,6 +1,6 @@
;;; webjump-tests.el --- Tests for webjump.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; Author: Simen Heggestøyl <simenheg@gmail.com>
;; Keywords:
diff --git a/test/lisp/nxml/nxml-mode-tests.el b/test/lisp/nxml/nxml-mode-tests.el
index 54d3bd8d132..4baab1f7600 100644
--- a/test/lisp/nxml/nxml-mode-tests.el
+++ b/test/lisp/nxml/nxml-mode-tests.el
@@ -1,6 +1,6 @@
;;; nxml-mode-tests.el --- Test NXML Mode -*- lexical-binding: t; -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; 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
diff --git a/test/lisp/nxml/xsd-regexp-tests.el b/test/lisp/nxml/xsd-regexp-tests.el
new file mode 100644
index 00000000000..4dbc8999247
--- /dev/null
+++ b/test/lisp/nxml/xsd-regexp-tests.el
@@ -0,0 +1,30 @@
+;;; xsd-regexp-tests.el --- Test NXML Mode -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
+
+;; 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 'xsd-regexp)
+
+(ert-deftest xsdre-matches ()
+ (should (equal (string-match (xsdre-translate "\\p{Pd}") "a-b") 1))
+ ;; this fails:
+ (should (equal (string-match (xsdre-translate "\\p{P}") "a-b") 1)))
+
+(provide 'xsd-regexp-tests)
+
+;;; xsd-regexp-tests.el ends here
diff --git a/test/lisp/obarray-tests.el b/test/lisp/obarray-tests.el
index 4b9b4e4a10e..45d82c75c15 100644
--- a/test/lisp/obarray-tests.el
+++ b/test/lisp/obarray-tests.el
@@ -1,6 +1,6 @@
;;; obarray-tests.el --- Tests for obarray -*- lexical-binding: t; -*-
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Author: Przemysław Wojnowski <esperanto@cumego.com>
diff --git a/test/lisp/obsolete/cl-tests.el b/test/lisp/obsolete/cl-tests.el
index 3f3fda3638e..4a5f4f872b6 100644
--- a/test/lisp/obsolete/cl-tests.el
+++ b/test/lisp/obsolete/cl-tests.el
@@ -1,6 +1,6 @@
;;; cl-tests.el --- tests for emacs-lisp/cl.el -*- lexical-binding:t -*-
-;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2018-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/org/org-tests.el b/test/lisp/org/org-tests.el
index 6e91dd28649..c1985a46a40 100644
--- a/test/lisp/org/org-tests.el
+++ b/test/lisp/org/org-tests.el
@@ -1,6 +1,6 @@
;;; org-tests.el --- tests for org/org.el -*- lexical-binding:t -*-
-;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2018-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
diff --git a/test/lisp/paren-tests.el b/test/lisp/paren-tests.el
index b732b8626ab..c4bec5d86de 100644
--- a/test/lisp/paren-tests.el
+++ b/test/lisp/paren-tests.el
@@ -1,6 +1,6 @@
;;; paren-tests.el --- Tests for paren.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; Author: Simen Heggestøyl <simenheg@gmail.com>
;; Keywords:
diff --git a/test/lisp/password-cache-tests.el b/test/lisp/password-cache-tests.el
index 55ebbfce7fe..11cb65cc163 100644
--- a/test/lisp/password-cache-tests.el
+++ b/test/lisp/password-cache-tests.el
@@ -1,6 +1,6 @@
;;; password-cache-tests.el --- Tests for password-cache.el -*- lexical-binding: t -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; Author: Stefan Kangas <stefankangas@gmail.com>
diff --git a/test/lisp/pcmpl-linux-tests.el b/test/lisp/pcmpl-linux-tests.el
index 91a9965483a..1b795ad706e 100644
--- a/test/lisp/pcmpl-linux-tests.el
+++ b/test/lisp/pcmpl-linux-tests.el
@@ -1,6 +1,6 @@
;;; pcmpl-linux-tests.el --- Tests for pcmpl-linux.el -*- lexical-binding: t -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/play/animate-tests.el b/test/lisp/play/animate-tests.el
index 7c41d3b7761..62527244670 100644
--- a/test/lisp/play/animate-tests.el
+++ b/test/lisp/play/animate-tests.el
@@ -1,6 +1,6 @@
;;; animate-tests.el --- Tests for animate.el -*- lexical-binding:t -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/play/dissociate-tests.el b/test/lisp/play/dissociate-tests.el
index e8d903109fc..e2f1e03101a 100644
--- a/test/lisp/play/dissociate-tests.el
+++ b/test/lisp/play/dissociate-tests.el
@@ -1,6 +1,6 @@
;;; dissociate-tests.el --- Tests for dissociate.el -*- lexical-binding:t -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/play/fortune-resources/fortunes b/test/lisp/play/fortune-resources/fortunes
new file mode 100644
index 00000000000..f1ddc512d00
--- /dev/null
+++ b/test/lisp/play/fortune-resources/fortunes
@@ -0,0 +1,11 @@
+Embarrassed
+Manual-Writer
+Accused of
+Communist
+Subversion
+%
+Embarrassingly
+Mundane
+Advertising
+Cuts
+Sales
diff --git a/test/lisp/play/fortune-tests.el b/test/lisp/play/fortune-tests.el
new file mode 100644
index 00000000000..3b85febaf00
--- /dev/null
+++ b/test/lisp/play/fortune-tests.el
@@ -0,0 +1,41 @@
+;;; fortune-tests.el --- Tests for fortune.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'ert-x)
+(require 'fortune)
+
+(defvar fortune-tests--regexp
+ (rx (| "Embarrassed" "Embarrassingly")))
+
+(ert-deftest test-fortune ()
+ (skip-unless (executable-find "fortune"))
+ (unwind-protect
+ (let ((fortune-file (ert-resource-file "fortunes")))
+ (fortune)
+ (goto-char (point-min))
+ (should (looking-at fortune-tests--regexp)))
+ (kill-buffer fortune-buffer-name)))
+
+(provide 'fortune-tests)
+;;; fortune-tests.el ends here
diff --git a/test/lisp/play/life-tests.el b/test/lisp/play/life-tests.el
index 38726bbc416..cdc507b5767 100644
--- a/test/lisp/play/life-tests.el
+++ b/test/lisp/play/life-tests.el
@@ -1,6 +1,6 @@
;;; life-tests.el --- Tests for life.el -*- lexical-binding:t -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; Author: Stefan Kangas <stefankangas@gmail.com>
diff --git a/test/lisp/play/morse-tests.el b/test/lisp/play/morse-tests.el
index ded4ef64586..7e03952970f 100644
--- a/test/lisp/play/morse-tests.el
+++ b/test/lisp/play/morse-tests.el
@@ -1,6 +1,6 @@
;;; morse-tests.el --- Tests for morse.el -*- lexical-binding: t -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; Author: Stefan Kangas <stefankangas@gmail.com>
diff --git a/test/lisp/play/studly-tests.el b/test/lisp/play/studly-tests.el
index 6b6e205b3e6..87e16fdd333 100644
--- a/test/lisp/play/studly-tests.el
+++ b/test/lisp/play/studly-tests.el
@@ -1,6 +1,6 @@
;;; studly-tests.el --- Tests for studly.el -*- lexical-binding: t -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; Author: Stefan Kangas <stefankangas@gmail.com>
diff --git a/test/lisp/progmodes/asm-mode-tests.el b/test/lisp/progmodes/asm-mode-tests.el
index 72d0f00777d..6ae4fdf5850 100644
--- a/test/lisp/progmodes/asm-mode-tests.el
+++ b/test/lisp/progmodes/asm-mode-tests.el
@@ -1,6 +1,6 @@
;;; asm-mode-tests.el --- Tests for asm-mode.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; Author: Simen Heggestøyl <simenheg@gmail.com>
;; Keywords:
diff --git a/test/lisp/progmodes/autoconf-tests.el b/test/lisp/progmodes/autoconf-tests.el
index 63cf2889ee2..3d347feaf65 100644
--- a/test/lisp/progmodes/autoconf-tests.el
+++ b/test/lisp/progmodes/autoconf-tests.el
@@ -1,6 +1,6 @@
;;; autoconf-tests.el --- Tests for autoconf.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; Author: Simen Heggestøyl <simenheg@gmail.com>
;; Keywords:
diff --git a/test/lisp/progmodes/bat-mode-tests.el b/test/lisp/progmodes/bat-mode-tests.el
index 2afa5c3785f..78145124fb4 100644
--- a/test/lisp/progmodes/bat-mode-tests.el
+++ b/test/lisp/progmodes/bat-mode-tests.el
@@ -1,6 +1,6 @@
;;; bat-mode-tests.el --- Tests for bat-mode.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; Author: Vladimir Panteleev <vladimir@thecybershadow.net>
;; Keywords:
diff --git a/test/lisp/progmodes/cc-mode-tests.el b/test/lisp/progmodes/cc-mode-tests.el
index 64d52a952b6..a3a8ff208ed 100644
--- a/test/lisp/progmodes/cc-mode-tests.el
+++ b/test/lisp/progmodes/cc-mode-tests.el
@@ -1,6 +1,6 @@
;;; cc-mode-tests.el --- Test suite for cc-mode. -*- lexical-binding: t; -*-
-;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2016-2021 Free Software Foundation, Inc.
;; Author: Michal Nazarewicz <mina86@mina86.com>
;; Keywords: internal
diff --git a/test/lisp/progmodes/compile-tests.el b/test/lisp/progmodes/compile-tests.el
index b8ed6e0e76b..da6a1e641c7 100644
--- a/test/lisp/progmodes/compile-tests.el
+++ b/test/lisp/progmodes/compile-tests.el
@@ -1,6 +1,6 @@
;;; compile-tests.el --- Test suite for compile.el. -*- lexical-binding: t; -*-
-;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
;; Author: Chong Yidong <cyd@stupidchicken.com>
;; Keywords: internal
@@ -124,6 +124,8 @@
;; cucumber
(cucumber "Scenario: undefined step # features/cucumber.feature:3"
29 nil 3 "features/cucumber.feature")
+ ;; This rule is actually handled by the `cucumber' pattern but when
+ ;; `omake' is included, then `gnu' matches it first.
(gnu " /home/gusev/.rvm/foo/bar.rb:500:in `_wrap_assertion'"
1 nil 500 "/home/gusev/.rvm/foo/bar.rb")
;; edg-1 edg-2
@@ -191,10 +193,10 @@
;; javac
(javac
"/src/Test.java:5: ';' expected\n foo foo\n ^\n"
- 1 15 5 "/src/Test.java" 2)
+ 1 16 5 "/src/Test.java" 2)
(javac
"e:\\src\\Test.java:7: warning: ';' expected\n foo foo\n ^\n"
- 1 10 7 "e:\\src\\Test.java" 1)
+ 1 11 7 "e:\\src\\Test.java" 1)
;; jikes-file jikes-line
(jikes-file
"Found 2 semantic errors compiling \"../javax/swing/BorderFactory.java\":"
diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-bug-19709.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-19709.pl
new file mode 100644
index 00000000000..f7c51a2ce57
--- /dev/null
+++ b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-19709.pl
@@ -0,0 +1,25 @@
+# -------- bug#19709: input --------
+my $a = func1(
+ Module::test()
+ );
+
+my $b = func2(
+ test()
+);
+
+my $c = func3(
+ Module::test(),
+);
+# -------- bug#19709: expected output --------
+my $a = func1(
+ Module::test()
+);
+
+my $b = func2(
+ test()
+);
+
+my $c = func3(
+ Module::test(),
+);
+# -------- bug#19709: end --------
diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-bug-26850.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-26850.pl
new file mode 100644
index 00000000000..a02ea29fe9d
--- /dev/null
+++ b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-26850.pl
@@ -0,0 +1,16 @@
+sub interesting {
+ $_ = shift;
+ return
+ />Today is .+\'s birthday\.</
+ || / like[ds]? your post in </
+ || /like[ds] your new subscription\. </
+ || / likes? that you're interested in </
+ || /> likes? your comment: /
+ || /&amp;birthdays=.*birthdays?\.<\/a>/;
+}
+
+sub boring {
+ return
+ / likes? your post in </
+ || / likes? that you're interested in </
+}
diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-bug-30393.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-30393.pl
new file mode 100644
index 00000000000..01db7b5206c
--- /dev/null
+++ b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-30393.pl
@@ -0,0 +1,19 @@
+# -------- bug#30393: input --------
+#
+ my $sql = "insert into jobs (id, priority) values (1, 2);";
+ my $sth = $dbh->prepare($sql) or die "bother";
+
+ my $sql = "insert into jobs
+(id, priority)
+values (1, 2);";
+ my $sth = $dbh->prepare($sql) or die "bother";
+# -------- bug#30393: expected output --------
+#
+my $sql = "insert into jobs (id, priority) values (1, 2);";
+my $sth = $dbh->prepare($sql) or die "bother";
+
+my $sql = "insert into jobs
+(id, priority)
+values (1, 2);";
+my $sth = $dbh->prepare($sql) or die "bother";
+# -------- bug#30393: end --------
diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-indent-styles.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-indent-styles.pl
index 0832f868288..371b19b7309 100644
--- a/test/lisp/progmodes/cperl-mode-resources/cperl-indent-styles.pl
+++ b/test/lisp/progmodes/cperl-mode-resources/cperl-indent-styles.pl
@@ -42,3 +42,13 @@ die "This world is backwards";
}
}
# -------- PBP uncuddle else: end --------
+
+# -------- PBP closing paren offset: input --------
+my $a = func1(
+ Module::test()
+ );
+# -------- PBP closing paren offset: expected output --------
+my $a = func1(
+ Module::test()
+);
+# -------- PBP closing paren offset: end --------
diff --git a/test/lisp/progmodes/cperl-mode-resources/here-docs.pl b/test/lisp/progmodes/cperl-mode-resources/here-docs.pl
new file mode 100644
index 00000000000..8af4625fff3
--- /dev/null
+++ b/test/lisp/progmodes/cperl-mode-resources/here-docs.pl
@@ -0,0 +1,143 @@
+use 5.020;
+
+=head1 NAME
+
+here-docs.pl - resource file for cperl-test-here-docs
+
+=head1 DESCRIPTION
+
+This file holds a couple of HERE documents, with a variety of normal
+and edge cases. For a formatted view of this description, run:
+
+ (cperl-perldoc "here-docs.pl")
+
+For each of the HERE documents, the following checks will done:
+
+=over 4
+
+=item *
+
+All occurrences of the string "look-here" are fontified correcty.
+Note that we deliberately test the face, not the syntax property:
+Users won't care for the syntax property, but they see the face.
+Different implementations with different syntax properties have been
+seen in the past.
+
+=item *
+
+Indentation of the line(s) containing "look-here" is 0, i.e. there are no
+leading spaces.
+
+=item *
+
+Indentation of the following perl statement containing "indent" should
+be 0 if the statement contains "noindent", and according to the mode's
+continued-statement-offset otherwise.
+
+=back
+
+=cut
+
+# Prologue to make the test file valid without warnings
+
+my $text;
+my $any;
+my $indentation;
+my $anywhere = 'back again';
+my $noindent;
+
+=head1 The Tests
+
+=head2 Test Case 1
+
+We have two HERE documents in one line with different quoting styles.
+
+=cut
+
+## test case
+
+$text = <<"HERE" . <<'THERE' . $any;
+#look-here and
+HERE
+$tlook-here and
+THERE
+
+$noindent = "This should be left-justified";
+
+=head2 Test case 2
+
+A HERE document followed by a continuation line
+
+=cut
+
+## test case
+
+$text = <<HERE
+look-here
+HERE
+
+. 'indent-level'; # Continuation, should be indented
+
+=head2 Test case 3
+
+A here document with a line-end comment in the starter line,
+after a complete statement
+
+=cut
+
+## test case
+
+$text = <<HERE; # start here
+look-here
+HERE
+
+$noindent = "New statement in this line";
+
+=head2 Test case 4
+
+A HERE document with a to-be-continued statement and a comment in the
+starter line.
+
+=cut
+
+## test case
+
+$text = <<HERE # start here
+look-here
+HERE
+
+. 'indent-level'; # Continuation, should be indented
+
+=head2 Test case 5
+
+A HERE document with a comment sign, but no comment to follow.
+
+
+=cut
+
+## test case
+
+$text = <<HERE; #
+look-here
+HERE
+
+$noindent = "New statement in this line";
+
+=head2 Test case 6
+
+A HERE document with a comment sign, but no comment to follow, with a
+statement to be continued. Also, the character before the comment
+sign has a relevant syntax property (end of string in our case) which
+must be preserved.
+
+=cut
+
+## test case
+
+$text = <<"HERE"#
+look-here
+HERE
+
+. 'indent-level'; # Continuation, should be indented
+
+__END__
diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el
index 9a7b5e4d6dd..943c454445c 100644
--- a/test/lisp/progmodes/cperl-mode-tests.el
+++ b/test/lisp/progmodes/cperl-mode-tests.el
@@ -1,6 +1,6 @@
;;; cperl-mode-tests --- Test for cperl-mode -*- lexical-binding: t -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; Author: Harald Jörg <haj@posteo.de>
;; Maintainer: Harald Jörg
@@ -34,6 +34,8 @@
(require 'ert)
(require 'ert-x)
+;;; Utilities
+
(defun cperl-test-ppss (text regexp)
"Return the `syntax-ppss' of the first character matched by REGEXP in TEXT."
(interactive)
@@ -44,48 +46,129 @@
(re-search-forward regexp)
(syntax-ppss)))
-(ert-deftest cperl-mode-test-bug-42168 ()
- "Verify that '/' is a division after ++ or --, not a regexp.
-Reported in https://github.com/jrockway/cperl-mode/issues/45.
-If seen as regular expression, then the slash is displayed using
-font-lock-constant-face. If seen as a division, then it doesn't
-have a face property."
- :tags '(:fontification)
- ;; The next two Perl expressions have divisions. Perl "punctuation"
- ;; operators don't get a face.
- (let ((code "{ $a++ / $b }"))
- (should (equal (nth 8 (cperl-test-ppss code "/")) nil)))
- (let ((code "{ $a-- / $b }"))
- (should (equal (nth 8 (cperl-test-ppss code "/")) nil)))
- ;; The next two Perl expressions have regular expressions. The
- ;; delimiter of a RE is fontified with font-lock-constant-face.
- (let ((code "{ $a+ / $b } # /"))
- (should (equal (nth 8 (cperl-test-ppss code "/")) 7)))
- (let ((code "{ $a- / $b } # /"))
- (should (equal (nth 8 (cperl-test-ppss code "/")) 7))))
+(defmacro cperl--run-test-cases (file &rest body)
+ "Run all test cases in FILE with BODY.
+This macro helps with tests which reformat Perl code, e.g. when
+indenting or rearranging flow control. It extracts source code
+snippets and corresponding expected results from a resource file,
+runs BODY on the snippets, and compares the resulting buffer with
+the expected results.
-(ert-deftest cperl-mode-test-bug-16368 ()
- "Verify that `cperl-forward-group-in-re' doesn't hide errors."
+Test cases in FILE are formatted like this:
+
+# -------- NAME: input --------
+Your input to the test case comes here.
+Both input and expected output may span several lines.
+# -------- NAME: expected output --------
+The expected output from running BODY on the input goes here.
+# -------- NAME: end --------
+
+You can have many of these blocks in one test file. You can
+chose a NAME for each block, which is passed to the 'should'
+clause for easy identification of the first test case that
+failed (if any). Text outside these the blocks is ignored by the
+tests, so you can use it to document the test cases if you wish."
+ `(with-temp-buffer
+ (insert-file-contents ,file)
+ (goto-char (point-min))
+ (while (re-search-forward
+ (concat "^# ?-+ \\_<\\(?1:.+?\\)\\_>: input ?-+\n"
+ "\\(?2:\\(?:.*\n\\)+?\\)"
+ "# ?-+ \\1: expected output ?-+\n"
+ "\\(?3:\\(?:.*\n\\)+?\\)"
+ "# ?-+ \\1: end ?-+")
+ nil t)
+ (let ((name (match-string 1))
+ (code (match-string 2))
+ (expected (match-string 3))
+ got)
+ (with-temp-buffer
+ (insert code)
+ (goto-char (point-min))
+ (funcall cperl-test-mode)
+ ,@body
+ (setq expected (concat "test case " name ":\n" expected))
+ (setq got (concat "test case " name ":\n" (buffer-string)))
+ (should (equal got expected)))))))
+
+;;; Indentation tests
+
+(ert-deftest cperl-test-indent-exp ()
+ "Run various tests for `cperl-indent-exp' edge cases.
+These exercise some standard blocks and also the special
+treatment for Perl expressions where a closing paren isn't the
+end of the statement."
(skip-unless (eq cperl-test-mode #'cperl-mode))
- (let ((code "/(\\d{4})(?{2}/;") ; the regex from the bug report
- (result))
+ (cperl--run-test-cases
+ (ert-resource-file "cperl-indent-exp.pl")
+ (cperl-indent-exp))) ; here we go!
+
+(ert-deftest cperl-test-indent-styles ()
+ (skip-unless (eq cperl-test-mode #'cperl-mode))
+ (cperl--run-test-cases
+ (ert-resource-file "cperl-indent-styles.pl")
+ (cperl-set-style "PBP")
+ (indent-region (point-min) (point-max)) ; here we go!
+ (cperl-set-style-back)))
+
+;;; Fontification tests
+
+(ert-deftest cperl-test-fontify-punct-vars ()
+ "Test fontification of Perl's punctiation variables.
+Perl has variable names containing unbalanced quotes for the list
+separator $\" and pre- and postmatch $` and $'. A reference to
+these variables, for example \\$\", should not cause the dollar
+to be escaped, which would then start a string beginning with the
+quote character. This used to be broken in cperl-mode at some
+point in the distant past, and is still broken in perl-mode. "
+ (skip-unless (eq cperl-test-mode #'cperl-mode))
+ (let ((file (ert-resource-file "fontify-punctuation-vars.pl")))
(with-temp-buffer
- (insert code)
- (goto-char 9)
- (setq result (cperl-forward-group-in-re))
- (should (equal (car result) 'scan-error))
- (should (equal (nth 1 result) "Unbalanced parentheses"))
- (should (= (point) 9)))) ; point remains unchanged on error
- (let ((code "/(\\d{4})(?{2})/;") ; here all parens are balanced
- (result))
+ (insert-file-contents file)
+ (goto-char (point-min))
+ (funcall cperl-test-mode)
+ (while (search-forward "##" nil t)
+ ;; The third element of syntax-ppss is true if in a string,
+ ;; which would indicate bad interpretation of the quote. The
+ ;; fourth element is true if in a comment, which should be the
+ ;; case.
+ (should (equal (nth 3 (syntax-ppss)) nil))
+ (should (equal (nth 4 (syntax-ppss)) t))))))
+
+(ert-deftest cperl-test-heredocs ()
+ "Test that HERE-docs are fontified with the appropriate face."
+ (require 'perl-mode)
+ (let ((file (ert-resource-file "here-docs.pl"))
+ (cperl-continued-statement-offset perl-continued-statement-offset)
+ (target-font (if (equal cperl-test-mode 'perl-mode) 'perl-heredoc
+ 'font-lock-string-face))
+ (case-fold-search nil))
(with-temp-buffer
- (insert code)
- (goto-char 9)
- (setq result (cperl-forward-group-in-re))
- (should (equal result nil))
- (should (= (point) 15))))) ; point has skipped the group
+ (insert-file-contents file)
+ (goto-char (point-min))
+ (funcall cperl-test-mode)
+ (indent-region (point-min) (point-max))
+ (font-lock-ensure (point-min) (point-max))
+ (while (search-forward "## test case" nil t)
+ (save-excursion
+ (while (search-forward "look-here" nil t)
+ (should (equal
+ (get-text-property (match-beginning 0) 'face)
+ target-font))
+ (beginning-of-line)
+ (should (null (looking-at "[ \t]")))
+ (forward-line 1)))
+ (should (re-search-forward
+ (concat "^\\([ \t]*\\)" ; the actual indentation amount
+ "\\([^ \t\n].*?\\)\\(no\\)?indent")
+ nil t))
+ (should (equal (- (match-end 1) (match-beginning 1))
+ (if (match-beginning 3) 0
+ perl-indent-level)))))))
+
+;;; Tests for issues reported in the Bug Tracker
-(defun cperl-mode-test--run-bug-10483 ()
+(defun cperl-test--run-bug-10483 ()
"Runs a short program, intended to be under timer scrutiny.
This function is intended to be used by an Emacs subprocess in
batch mode. The message buffer is used to report the result of
@@ -102,7 +185,7 @@ indentation actually takes place.."
(cperl-indent-exp)
(message "%s" (buffer-string)))))
-(ert-deftest cperl-mode-test-bug-10483 ()
+(ert-deftest cperl-test-bug-10483 ()
"Check that indenting certain perl code does not loop forever.
This verifies that indenting a piece of code that ends in a paren
without a statement terminator on the same line does not loop
@@ -112,8 +195,9 @@ under timeout control."
(interactive)
(skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; FIXME times out
(skip-unless (not (< emacs-major-version 28))) ; times out in older Emacsen
+ (skip-unless (eq cperl-test-mode #'cperl-mode))
(let* ((emacs (concat invocation-directory invocation-name))
- (test-function 'cperl-mode-test--run-bug-10483)
+ (test-function 'cperl-test--run-bug-10483)
(test-function-name (symbol-name test-function))
(test-file (symbol-file test-function 'defun))
(ran-out-of-time nil)
@@ -138,92 +222,76 @@ under timeout control."
(should (string-match
"poop ('foo', \n 'bar')" (buffer-string))))))
-(ert-deftest cperl-mode-test-indent-exp ()
- "Run various tests for `cperl-indent-exp' edge cases.
-These exercise some standard blocks and also the special
-treatment for Perl expressions where a closing paren isn't the
-end of the statement."
+(ert-deftest cperl-test-bug-16368 ()
+ "Verify that `cperl-forward-group-in-re' doesn't hide errors."
(skip-unless (eq cperl-test-mode #'cperl-mode))
- (let ((file (ert-resource-file "cperl-indent-exp.pl")))
- (with-temp-buffer
- (insert-file-contents file)
- (goto-char (point-min))
- (while (re-search-forward
- (concat "^# ?-+ \\_<\\(?1:.+?\\)\\_>: input ?-+\n"
- "\\(?2:\\(?:.*\n\\)+?\\)"
- "# ?-+ \\1: expected output ?-+\n"
- "\\(?3:\\(?:.*\n\\)+?\\)"
- "# ?-+ \\1: end ?-+")
- nil t)
- (let ((name (match-string 1))
- (code (match-string 2))
- (expected (match-string 3))
- got)
- (with-temp-buffer
- (insert code)
- (cperl-mode)
- (goto-char (point-min))
- (cperl-indent-exp) ; here we go!
- (setq expected (concat "test case " name ":\n" expected))
- (setq got (concat "test case " name ":\n" (buffer-string)))
- (should (equal got expected))))))))
-
-(ert-deftest cperl-mode-test-indent-styles ()
- "Verify correct indentation by style \"PBP\".
-Perl Best Practices sets some indentation values different from
- the defaults, and also wants an \"else\" or \"elsif\" keyword
- to align with the \"if\"."
- (let ((file (ert-resource-file "cperl-indent-styles.pl")))
+ (let ((code "/(\\d{4})(?{2}/;") ; the regex from the bug report
+ (result))
(with-temp-buffer
- (cperl-set-style "PBP")
- (insert-file-contents file)
- (goto-char (point-min))
- (while (re-search-forward
- (concat "^# ?-+ \\_<\\(?1:.+?\\)\\_>: input ?-+\n"
- "\\(?2:\\(?:.*\n\\)+?\\)"
- "# ?-+ \\1: expected output ?-+\n"
- "\\(?3:\\(?:.*\n\\)+?\\)"
- "# ?-+ \\1: end ?-+")
- nil t)
- (let ((name (match-string 1))
- (code (match-string 2))
- (expected (match-string 3))
- got)
- (with-temp-buffer
- (insert code)
- (cperl-mode)
- (indent-region (point-min) (point-max)) ; here we go!
- (setq expected (concat "test case " name ":\n" expected))
- (setq got (concat "test case " name ":\n" (buffer-string)))
- (should (equal got expected)))))
- (cperl-set-style "CPerl"))))
-
-(ert-deftest cperl-mode-fontify-punct-vars ()
- "Test fontification of Perl's punctiation variables.
-Perl has variable names containing unbalanced quotes for the list
-separator $\" and pre- and postmatch $` and $'. A reference to
-these variables, for example \\$\", should not cause the dollar
-to be escaped, which would then start a string beginning with the
-quote character. This used to be broken in cperl-mode at some
-point in the distant past, and is still broken in perl-mode. "
- (skip-unless (eq cperl-test-mode #'cperl-mode))
- (let ((file (ert-resource-file "fontify-punctuation-vars.pl")))
+ (insert code)
+ (goto-char 9)
+ (setq result (cperl-forward-group-in-re))
+ (should (equal (car result) 'scan-error))
+ (should (equal (nth 1 result) "Unbalanced parentheses"))
+ (should (= (point) 9)))) ; point remains unchanged on error
+ (let ((code "/(\\d{4})(?{2})/;") ; here all parens are balanced
+ (result))
(with-temp-buffer
- (insert-file-contents file)
- (goto-char (point-min))
- (funcall cperl-test-mode)
- (while (search-forward "##" nil t)
- ;; The third element of syntax-ppss is true if in a string,
- ;; which would indicate bad interpretation of the quote. The
- ;; fourth element is true if in a comment, which should be the
- ;; case.
- (should (equal (nth 3 (syntax-ppss)) nil))
- (should (equal (nth 4 (syntax-ppss)) t))))))
+ (insert code)
+ (goto-char 9)
+ (setq result (cperl-forward-group-in-re))
+ (should (equal result nil))
+ (should (= (point) 15))))) ; point has skipped the group
+
+(ert-deftest cperl-test-bug-19709 ()
+ "Verify that indentation of closing paren works as intended.
+Note that Perl mode has no setting for close paren offset, per
+documentation it does the right thing anyway."
+ (cperl--run-test-cases
+ (ert-resource-file "cperl-bug-19709.pl")
+ ;; settings from the bug report
+ (setq-local cperl-indent-level 4)
+ (setq-local cperl-indent-parens-as-block t)
+ (setq-local cperl-close-paren-offset -4)
+ ;; same, adapted for per-mode
+ (setq-local perl-indent-level 4)
+ (setq-local perl-indent-parens-as-block t)
+ (while (null (eobp))
+ (cperl-indent-command)
+ (forward-line 1))))
+
+(ert-deftest cperl-test-bug-28650 ()
+ "Verify that regular expressions are recognized after 'return'.
+The test uses the syntax property \"inside a string\" for the
+text in regular expressions, which is non-nil for both cperl-mode
+and perl-mode."
+ (with-temp-buffer
+ (insert-file-contents (ert-resource-file "cperl-bug-26850.pl"))
+ (goto-char (point-min))
+ (re-search-forward "sub interesting {[^}]*}")
+ (should-not (equal (nth 3 (cperl-test-ppss (match-string 0) "Today"))
+ nil))
+ (re-search-forward "sub boring {[^}]*}")
+ (should-not (equal (nth 3 (cperl-test-ppss (match-string 0) "likes\\?"))
+ nil))))
-(ert-deftest cperl-bug37127 ()
+(ert-deftest cperl-test-bug-30393 ()
+ "Verify that indentation is not disturbed by an open paren in col 0.
+Perl is not Lisp: An open paren in column 0 does not start a function."
+ (cperl--run-test-cases
+ (ert-resource-file "cperl-bug-30393.pl")
+ (while (null (eobp))
+ (cperl-indent-command)
+ (forward-line 1))))
+
+(ert-deftest cperl-test-bug-37127 ()
"Verify that closing a paren in a regex goes without a message.
Also check that the message is issued if the regex terminator is
missing."
+ ;; The actual fix for this bug is in simple.el, which is not
+ ;; backported to older versions of Emacs. Therefore we skip this
+ ;; test if we're running Emacs 27 or older.
+ (skip-unless (< 27 emacs-major-version))
;; Part one: Regex is ok, no messages
(ert-with-message-capture collected-messages
(with-temp-buffer
@@ -256,4 +324,32 @@ missing."
(should (string-match "^End of .* string/RE"
collected-messages)))))
+(ert-deftest cperl-test-bug-42168 ()
+ "Verify that '/' is a division after ++ or --, not a regexp.
+Reported in https://github.com/jrockway/cperl-mode/issues/45.
+If seen as regular expression, then the slash is displayed using
+font-lock-constant-face. If seen as a division, then it doesn't
+have a face property."
+ :tags '(:fontification)
+ ;; The next two Perl expressions have divisions. Perl "punctuation"
+ ;; operators don't get a face.
+ (let ((code "{ $a++ / $b }"))
+ (should (equal (nth 8 (cperl-test-ppss code "/")) nil)))
+ (let ((code "{ $a-- / $b }"))
+ (should (equal (nth 8 (cperl-test-ppss code "/")) nil)))
+ ;; The next two Perl expressions have regular expressions. The
+ ;; delimiter of a RE is fontified with font-lock-constant-face.
+ (let ((code "{ $a+ / $b } # /"))
+ (should (equal (nth 8 (cperl-test-ppss code "/")) 7)))
+ (let ((code "{ $a- / $b } # /"))
+ (should (equal (nth 8 (cperl-test-ppss code "/")) 7))))
+
+(ert-deftest cperl-test-bug-45255 ()
+ "Verify that \"<<>>\" is recognized as not starting a HERE-doc."
+ (let ((code (concat "while (<<>>) {\n"
+ " ...;\n"
+ "}\n")))
+ ;; The yadda-yadda operator should not be in a string.
+ (should (equal (nth 8 (cperl-test-ppss code "\\.")) nil))))
+
;;; cperl-mode-tests.el ends here
diff --git a/test/lisp/progmodes/elisp-mode-tests.el b/test/lisp/progmodes/elisp-mode-tests.el
index 6c30e4f664b..fd43707f277 100644
--- a/test/lisp/progmodes/elisp-mode-tests.el
+++ b/test/lisp/progmodes/elisp-mode-tests.el
@@ -1,6 +1,6 @@
;;; elisp-mode-tests.el --- Tests for emacs-lisp-mode -*- lexical-binding: t; -*-
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Author: Dmitry Gutov <dgutov@yandex.ru>
;; Author: Stephen Leake <stephen_leake@member.fsf.org>
@@ -314,7 +314,19 @@
(let* ((xref (pop xrefs))
(expected (pop expected-xrefs))
(expected-xref (or (when (consp expected) (car expected)) expected))
- (expected-source (when (consp expected) (cdr expected))))
+ (expected-source (when (consp expected) (cdr expected)))
+ (xref-file (xref-elisp-location-file (oref xref location)))
+ (expected-file (xref-elisp-location-file
+ (oref expected-xref location))))
+
+ ;; Make sure file names compare as strings.
+ (when (file-name-absolute-p xref-file)
+ (setf (xref-elisp-location-file (oref xref location))
+ (file-truename (xref-elisp-location-file (oref xref location)))))
+ (when (file-name-absolute-p expected-file)
+ (setf (xref-elisp-location-file (oref expected-xref location))
+ (file-truename (xref-elisp-location-file
+ (oref expected-xref location)))))
;; Downcase the filenames for case-insensitive file systems.
(when xref--case-insensitive
diff --git a/test/lisp/progmodes/etags-tests.el b/test/lisp/progmodes/etags-tests.el
index 79368cd193f..35a2592e76f 100644
--- a/test/lisp/progmodes/etags-tests.el
+++ b/test/lisp/progmodes/etags-tests.el
@@ -1,6 +1,6 @@
;;; etags-tests.el --- Test suite for etags.el. -*- lexical-binding:t -*-
-;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2016-2021 Free Software Foundation, Inc.
;; Author: Eli Zaretskii <eliz@gnu.org>
diff --git a/test/lisp/progmodes/f90-tests.el b/test/lisp/progmodes/f90-tests.el
index b8a3f7e8401..b3d12229d8f 100644
--- a/test/lisp/progmodes/f90-tests.el
+++ b/test/lisp/progmodes/f90-tests.el
@@ -1,6 +1,6 @@
;;; f90-tests.el --- tests for progmodes/f90.el -*- lexical-binding:t -*-
-;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
;; Author: Glenn Morris <rgm@gnu.org>
;; Maintainer: emacs-devel@gnu.org
diff --git a/test/lisp/progmodes/flymake-tests.el b/test/lisp/progmodes/flymake-tests.el
index df72b523a9d..bda1b663c22 100644
--- a/test/lisp/progmodes/flymake-tests.el
+++ b/test/lisp/progmodes/flymake-tests.el
@@ -1,6 +1,6 @@
;;; flymake-tests.el --- Test suite for flymake -*- lexical-binding: t -*-
-;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
;; Author: Eduard Wiebe <usenet@pusto.de>
diff --git a/test/lisp/progmodes/gdb-mi-tests.el b/test/lisp/progmodes/gdb-mi-tests.el
index 79493a571b6..ab482214afb 100644
--- a/test/lisp/progmodes/gdb-mi-tests.el
+++ b/test/lisp/progmodes/gdb-mi-tests.el
@@ -1,6 +1,6 @@
;;; gdb-mi-tests.el --- tests for gdb-mi.el -*- lexical-binding: t -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -34,8 +34,10 @@
'((alpha . "ab\ncd")
(beta . ("x" ("y" (delta . ())))))))
- (should (equal (gdb-mi--from-string "alpha=\"a\\303\\245b\"")
- `((alpha . ,(string-to-multibyte "a\303\245b")))))
+ (let ((gdb-mi-decode-strings nil))
+ (let ((ref `((alpha . ,(string-to-multibyte "a\303\245b")))))
+ (should (equal (gdb-mi--from-string "alpha=\"a\\303\\245b\"")
+ ref))))
(let ((gdb-mi-decode-strings 'utf-8))
(should (equal (gdb-mi--from-string "alpha=\"a\\303\\245b\"")
'((alpha . "aåb")))))
diff --git a/test/lisp/progmodes/glasses-tests.el b/test/lisp/progmodes/glasses-tests.el
index 277a9cc1927..633c7bf2dbe 100644
--- a/test/lisp/progmodes/glasses-tests.el
+++ b/test/lisp/progmodes/glasses-tests.el
@@ -1,6 +1,6 @@
;;; glasses-tests.el --- Tests for glasses.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; Author: Simen Heggestøyl <simenheg@gmail.com>
;; Keywords:
diff --git a/test/lisp/progmodes/js-tests.el b/test/lisp/progmodes/js-tests.el
index 6c3a618b949..cb7011e9a77 100644
--- a/test/lisp/progmodes/js-tests.el
+++ b/test/lisp/progmodes/js-tests.el
@@ -1,6 +1,6 @@
;;; js-tests.el --- Test suite for js-mode -*- lexical-binding:t -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/progmodes/opascal-tests.el b/test/lisp/progmodes/opascal-tests.el
index 70a4ebfa70d..682f2c6cb6b 100644
--- a/test/lisp/progmodes/opascal-tests.el
+++ b/test/lisp/progmodes/opascal-tests.el
@@ -1,6 +1,6 @@
;;; opascal-tests.el --- tests for opascal.el -*- lexical-binding: t -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/progmodes/pascal-tests.el b/test/lisp/progmodes/pascal-tests.el
index ed4c6fb03e0..e9c705806b3 100644
--- a/test/lisp/progmodes/pascal-tests.el
+++ b/test/lisp/progmodes/pascal-tests.el
@@ -1,6 +1,6 @@
;;; pascal-tests.el --- tests for pascal.el -*- lexical-binding: t -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/progmodes/perl-mode-tests.el b/test/lisp/progmodes/perl-mode-tests.el
index a2ea972c103..9f6800ccd63 100644
--- a/test/lisp/progmodes/perl-mode-tests.el
+++ b/test/lisp/progmodes/perl-mode-tests.el
@@ -1,6 +1,6 @@
;;; perl-mode-tests --- Test for perl-mode -*- lexical-binding: t -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/progmodes/ps-mode-tests.el b/test/lisp/progmodes/ps-mode-tests.el
index 61cf4c62511..eccc862ee3d 100644
--- a/test/lisp/progmodes/ps-mode-tests.el
+++ b/test/lisp/progmodes/ps-mode-tests.el
@@ -1,6 +1,6 @@
;;; ps-mode-tests.el --- Test suite for ps-mode -*- lexical-binding:t -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el
index 64626333c44..3e653cb568a 100644
--- a/test/lisp/progmodes/python-tests.el
+++ b/test/lisp/progmodes/python-tests.el
@@ -1,6 +1,6 @@
;;; python-tests.el --- Test suite for python.el -*- lexical-binding:t -*-
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/progmodes/ruby-mode-resources/ruby.rb b/test/lisp/progmodes/ruby-mode-resources/ruby.rb
index 95928030396..434237cf638 100644
--- a/test/lisp/progmodes/ruby-mode-resources/ruby.rb
+++ b/test/lisp/progmodes/ruby-mode-resources/ruby.rb
@@ -475,3 +475,11 @@ top test(
foo bar, {
tee: qux
}
+
+# Bug#42846, bug#18644
+
+:foo=
+# indent here
+2 = 3
+:foo= if true
+{:abc=>4} # not indented, and '=' is not highlighted
diff --git a/test/lisp/progmodes/ruby-mode-tests.el b/test/lisp/progmodes/ruby-mode-tests.el
index 97ac1e1ecd9..42a011c8bcd 100644
--- a/test/lisp/progmodes/ruby-mode-tests.el
+++ b/test/lisp/progmodes/ruby-mode-tests.el
@@ -1,6 +1,6 @@
;;; ruby-mode-tests.el --- Test suite for ruby-mode -*- lexical-binding:t -*-
-;; Copyright (C) 2012-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -497,7 +497,8 @@ VALUES-PLIST is a list with alternating index and value elements."
(ert-deftest ruby-add-log-current-method-examples ()
(let ((pairs '(("foo" . "#foo")
("C.foo" . ".foo")
- ("self.foo" . ".foo"))))
+ ("self.foo" . ".foo")
+ ("<<" . "#<<"))))
(dolist (pair pairs)
(let ((name (car pair))
(value (cdr pair)))
diff --git a/test/lisp/progmodes/scheme-tests.el b/test/lisp/progmodes/scheme-tests.el
index e3736bd411e..8f2f75f81c2 100644
--- a/test/lisp/progmodes/scheme-tests.el
+++ b/test/lisp/progmodes/scheme-tests.el
@@ -1,6 +1,6 @@
;;; scheme-tests.el --- Test suite for scheme.el -*- lexical-binding:t -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/progmodes/sql-tests.el b/test/lisp/progmodes/sql-tests.el
index 91805ab7251..21dd0649529 100644
--- a/test/lisp/progmodes/sql-tests.el
+++ b/test/lisp/progmodes/sql-tests.el
@@ -1,6 +1,6 @@
;;; sql-tests.el --- Tests for sql.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2016-2021 Free Software Foundation, Inc.
;; Author: Simen Heggestøyl <simenheg@gmail.com>
;; Keywords:
diff --git a/test/lisp/progmodes/subword-tests.el b/test/lisp/progmodes/subword-tests.el
index 6aeee76110b..28a9445e01f 100644
--- a/test/lisp/progmodes/subword-tests.el
+++ b/test/lisp/progmodes/subword-tests.el
@@ -1,6 +1,6 @@
;;; subword-tests.el --- Testing the subword rules -*- lexical-binding:t -*-
-;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords:
diff --git a/test/lisp/progmodes/tcl-tests.el b/test/lisp/progmodes/tcl-tests.el
index fb5a19d3d0c..cf1ed2896e4 100644
--- a/test/lisp/progmodes/tcl-tests.el
+++ b/test/lisp/progmodes/tcl-tests.el
@@ -1,6 +1,6 @@
;;; tcl-tests.el --- Test suite for tcl-mode -*- lexical-binding:t -*-
-;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2018-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -50,14 +50,14 @@
(insert "proc notinthis {} {\n # nothing\n}\n\n")
(should-not (add-log-current-defun))))
-(ert-deftest tcl-mode-function-name ()
+(ert-deftest tcl-mode-function-name-2 ()
(with-temp-buffer
(tcl-mode)
(insert "proc simple {} {\n # nothing\n}")
(backward-char 3)
(should (equal "simple" (add-log-current-defun)))))
-(ert-deftest tcl-mode-function-name ()
+(ert-deftest tcl-mode-function-name-3 ()
(with-temp-buffer
(tcl-mode)
(insert "proc inthis {} {\n # nothing\n")
@@ -72,6 +72,16 @@
(indent-region (point-min) (point-max))
(should (equal (buffer-string) text)))))
+;; From bug#44834
+(ert-deftest tcl-mode-namespace-indent-2 ()
+ :expected-result :failed
+ (with-temp-buffer
+ (tcl-mode)
+ (let ((text "namespace eval Foo {\n proc foo {} {}\n\n proc bar {}{}}\n"))
+ (insert text)
+ (indent-region (point-min) (point-max))
+ (should (equal (buffer-string) text)))))
+
(provide 'tcl-tests)
;;; tcl-tests.el ends here
diff --git a/test/lisp/progmodes/xref-tests.el b/test/lisp/progmodes/xref-tests.el
index 038f9d0e304..b4b5e4db5d6 100644
--- a/test/lisp/progmodes/xref-tests.el
+++ b/test/lisp/progmodes/xref-tests.el
@@ -1,6 +1,6 @@
;;; xref-tests.el --- tests for xref -*- lexical-binding:t -*-
-;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2016-2021 Free Software Foundation, Inc.
;; Author: Dmitry Gutov <dgutov@yandex.ru>
@@ -27,44 +27,50 @@
(require 'xref)
(require 'cl-lib)
-(defvar xref-tests-data-dir
+(defvar xref-tests--data-dir
(expand-file-name "xref-resources/"
(file-name-directory
(or load-file-name buffer-file-name))))
+(defun xref-tests--matches-in-data-dir (regexp &optional files)
+ (xref-matches-in-directory regexp (or files "*") xref-tests--data-dir nil))
+
+(defun xref-tests--locations-in-data-dir (regexp &optional files)
+ (let ((matches (xref-tests--matches-in-data-dir regexp files)))
+ ;; Sort in order to guarantee an order independent from the
+ ;; filesystem traversal.
+ (cl-sort (mapcar #'xref-item-location matches)
+ #'string<
+ :key #'xref-location-group)))
+
(ert-deftest xref-matches-in-directory-finds-none-for-some-regexp ()
- (should (null (xref-matches-in-directory "zzz" "*" xref-tests-data-dir nil))))
+ (should (null (xref-tests--matches-in-data-dir "zzz"))))
(ert-deftest xref-matches-in-directory-finds-some-for-bar ()
- (let* ((matches (xref-matches-in-directory "bar" "*" xref-tests-data-dir nil))
- (locs (cl-sort (mapcar #'xref-item-location matches)
- #'string<
- :key #'xref-location-group)))
- (should (= 2 (length matches)))
+ (let ((locs (xref-tests--locations-in-data-dir "bar")))
+ (should (= 2 (length locs)))
(should (string-match-p "file1\\.txt\\'" (xref-location-group (nth 0 locs))))
(should (string-match-p "file2\\.txt\\'" (xref-location-group (nth 1 locs))))))
(ert-deftest xref-matches-in-directory-finds-two-matches-on-the-same-line ()
- (let* ((matches (xref-matches-in-directory "foo" "*" xref-tests-data-dir nil))
- (locs (mapcar #'xref-item-location matches)))
- (should (= 2 (length matches)))
+ (let ((locs (xref-tests--locations-in-data-dir "foo")))
+ (should (= 2 (length locs)))
(should (string-match-p "file1\\.txt\\'" (xref-location-group (nth 0 locs))))
(should (string-match-p "file1\\.txt\\'" (xref-location-group (nth 1 locs))))
(should (equal 1 (xref-location-line (nth 0 locs))))
(should (equal 1 (xref-location-line (nth 1 locs))))
- (should (equal 0 (xref-file-location-column (nth 0 locs))))
- (should (equal 4 (xref-file-location-column (nth 1 locs))))))
+ (should (equal 0 (xref-location-column (nth 0 locs))))
+ (should (equal 4 (xref-location-column (nth 1 locs))))))
(ert-deftest xref-matches-in-directory-finds-an-empty-line-regexp-match ()
- (let* ((matches (xref-matches-in-directory "^$" "*" xref-tests-data-dir nil))
- (locs (mapcar #'xref-item-location matches)))
- (should (= 1 (length matches)))
+ (let ((locs (xref-tests--locations-in-data-dir "^$")))
+ (should (= 1 (length locs)))
(should (string-match-p "file2\\.txt\\'" (xref-location-group (nth 0 locs))))
(should (equal 1 (xref-location-line (nth 0 locs))))
- (should (equal 0 (xref-file-location-column (nth 0 locs))))))
+ (should (equal 0 (xref-location-column (nth 0 locs))))))
(ert-deftest xref--buf-pairs-iterator-groups-markers-by-buffers-1 ()
- (let* ((xrefs (xref-matches-in-directory "foo" "*" xref-tests-data-dir nil))
+ (let* ((xrefs (xref-tests--matches-in-data-dir "foo"))
(iter (xref--buf-pairs-iterator xrefs))
(cons (funcall iter :next)))
(should (null (funcall iter :next)))
@@ -72,7 +78,7 @@
(should (= 2 (length (cdr cons))))))
(ert-deftest xref--buf-pairs-iterator-groups-markers-by-buffers-2 ()
- (let* ((xrefs (xref-matches-in-directory "bar" "*" xref-tests-data-dir nil))
+ (let* ((xrefs (xref-tests--matches-in-data-dir "bar"))
(iter (xref--buf-pairs-iterator xrefs))
(cons1 (funcall iter :next))
(cons2 (funcall iter :next)))
@@ -82,7 +88,7 @@
(should (= 1 (length (cdr cons2))))))
(ert-deftest xref--buf-pairs-iterator-cleans-up-markers ()
- (let* ((xrefs (xref-matches-in-directory "bar" "*" xref-tests-data-dir nil))
+ (let* ((xrefs (xref-tests--matches-in-data-dir "bar"))
(iter (xref--buf-pairs-iterator xrefs))
(cons1 (funcall iter :next))
(cons2 (funcall iter :next)))
@@ -91,3 +97,44 @@
(should (null (marker-position (cdr (nth 0 (cdr cons1))))))
(should (null (marker-position (car (nth 0 (cdr cons2))))))
(should (null (marker-position (cdr (nth 0 (cdr cons2))))))))
+
+(ert-deftest xref--xref-file-name-display-is-abs ()
+ (let ((xref-file-name-display 'abs)
+ ;; Some older BSD find versions can produce '//' in the output.
+ (expected (list
+ (concat xref-tests--data-dir "/?file1.txt")
+ (concat xref-tests--data-dir "/?file2.txt")))
+ (actual (delete-dups
+ (mapcar 'xref-location-group
+ (xref-tests--locations-in-data-dir "\\(bar\\|foo\\)")))))
+ (should (and (= (length expected) (length actual))
+ (cl-every (lambda (e1 e2)
+ (string-match-p e1 e2))
+ expected actual)))))
+
+(ert-deftest xref--xref-file-name-display-is-nondirectory ()
+ (let ((xref-file-name-display 'nondirectory))
+ (should (equal (delete-dups
+ (mapcar 'xref-location-group
+ (xref-tests--locations-in-data-dir "\\(bar\\|foo\\)")))
+ (list
+ "file1.txt"
+ "file2.txt")))))
+
+(ert-deftest xref--xref-file-name-display-is-relative-to-project-root ()
+ (let* ((data-parent-dir
+ (file-name-directory (directory-file-name xref-tests--data-dir)))
+ (project-find-functions
+ #'(lambda (_) (cons 'transient data-parent-dir)))
+ (xref-file-name-display 'project-relative)
+ ;; Some older BSD find versions can produce '//' in the output.
+ (expected (list
+ "xref-resources//?file1.txt"
+ "xref-resources//?file2.txt"))
+ (actual (delete-dups
+ (mapcar 'xref-location-group
+ (xref-tests--locations-in-data-dir "\\(bar\\|foo\\)")))))
+ (should (and (= (length expected) (length actual))
+ (cl-every (lambda (e1 e2)
+ (string-match-p e1 e2))
+ expected actual)))))
diff --git a/test/lisp/ps-print-tests.el b/test/lisp/ps-print-tests.el
index cae86f600f2..b25e88622d8 100644
--- a/test/lisp/ps-print-tests.el
+++ b/test/lisp/ps-print-tests.el
@@ -1,6 +1,6 @@
;;; ps-print-tests.el --- Test suite for ps-print.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Author: Phillip Lord <phillip.lord@russet.org.uk>
diff --git a/test/lisp/register-tests.el b/test/lisp/register-tests.el
index cfad442b470..537a66737b0 100644
--- a/test/lisp/register-tests.el
+++ b/test/lisp/register-tests.el
@@ -1,6 +1,6 @@
;;; register-tests.el --- tests for register.el -*- lexical-binding: t-*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; Author: Tino Calancha <tino.calancha@gmail.com>
;; Keywords:
diff --git a/test/lisp/replace-tests.el b/test/lisp/replace-tests.el
index aed14c33572..8c2682a1f13 100644
--- a/test/lisp/replace-tests.el
+++ b/test/lisp/replace-tests.el
@@ -1,6 +1,6 @@
;;; replace-tests.el --- tests for replace.el. -*- lexical-binding:t -*-
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Nicolas Richard <youngfrog@members.fsf.org>
;; Author: Juri Linkov <juri@jurta.org>
diff --git a/test/lisp/rot13-tests.el b/test/lisp/rot13-tests.el
index 2b12a464524..374d4ebaa81 100644
--- a/test/lisp/rot13-tests.el
+++ b/test/lisp/rot13-tests.el
@@ -1,6 +1,6 @@
;;; rot13-tests.el --- Tests for rot13.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2016-2021 Free Software Foundation, Inc.
;; Author: Simen Heggestøyl <simenheg@gmail.com>
;; Keywords:
diff --git a/test/lisp/saveplace-tests.el b/test/lisp/saveplace-tests.el
index 8d31e282180..17199ed443a 100644
--- a/test/lisp/saveplace-tests.el
+++ b/test/lisp/saveplace-tests.el
@@ -1,6 +1,6 @@
;;; saveplace-tests.el --- Tests for saveplace.el -*- lexical-binding:t -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; Author: Stefan Kangas <stefankangas@gmail.com>
diff --git a/test/lisp/scroll-lock-tests.el b/test/lisp/scroll-lock-tests.el
index 08f0aeb4089..8391a75f49c 100644
--- a/test/lisp/scroll-lock-tests.el
+++ b/test/lisp/scroll-lock-tests.el
@@ -1,6 +1,6 @@
;;; scroll-lock-tests.el --- Test suite for scroll-lock -*- lexical-binding: t -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/ses-tests.el b/test/lisp/ses-tests.el
index 4080944f296..04f255dcd4c 100644
--- a/test/lisp/ses-tests.el
+++ b/test/lisp/ses-tests.el
@@ -1,6 +1,6 @@
;;; ses-tests.el --- Tests for ses.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Author: Vincent Belaïche <vincentb1@users.sourceforge.net>
diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el
index eed9cb534b1..0c2d7123dd7 100644
--- a/test/lisp/shadowfile-tests.el
+++ b/test/lisp/shadowfile-tests.el
@@ -1,6 +1,6 @@
;;; shadowfile-tests.el --- Tests of shadowfile -*- lexical-binding:t -*-
-;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2018-2021 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
diff --git a/test/lisp/shell-tests.el b/test/lisp/shell-tests.el
index 606de15c9a6..d918de771b7 100644
--- a/test/lisp/shell-tests.el
+++ b/test/lisp/shell-tests.el
@@ -1,6 +1,6 @@
;;; shell-tests.el -*- lexical-binding:t -*-
-;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el
index 786dd1647aa..7b022811a5c 100644
--- a/test/lisp/simple-tests.el
+++ b/test/lisp/simple-tests.el
@@ -1,6 +1,6 @@
;;; simple-test.el --- Tests for simple.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
diff --git a/test/lisp/so-long-tests/autoload-longlines-mode-tests.el b/test/lisp/so-long-tests/autoload-longlines-mode-tests.el
index fd7e030e77a..696206efe20 100644
--- a/test/lisp/so-long-tests/autoload-longlines-mode-tests.el
+++ b/test/lisp/so-long-tests/autoload-longlines-mode-tests.el
@@ -1,6 +1,6 @@
;;; autoload-longlines-mode-tests.el --- Test suite for so-long.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; Author: Phil Sainty <psainty@orcon.net.nz>
;; Keywords: convenience
diff --git a/test/lisp/so-long-tests/autoload-major-mode-tests.el b/test/lisp/so-long-tests/autoload-major-mode-tests.el
index f81a28490dc..87adf826abb 100644
--- a/test/lisp/so-long-tests/autoload-major-mode-tests.el
+++ b/test/lisp/so-long-tests/autoload-major-mode-tests.el
@@ -1,6 +1,6 @@
;;; autoload-major-mode-tests.el --- Test suite for so-long.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; Author: Phil Sainty <psainty@orcon.net.nz>
;; Keywords: convenience
diff --git a/test/lisp/so-long-tests/autoload-minor-mode-tests.el b/test/lisp/so-long-tests/autoload-minor-mode-tests.el
index e611cfba1c0..4980a7e1bc6 100644
--- a/test/lisp/so-long-tests/autoload-minor-mode-tests.el
+++ b/test/lisp/so-long-tests/autoload-minor-mode-tests.el
@@ -1,6 +1,6 @@
;;; autoload-minor-mode-tests.el --- Test suite for so-long.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; Author: Phil Sainty <psainty@orcon.net.nz>
;; Keywords: convenience
diff --git a/test/lisp/so-long-tests/so-long-tests-helpers.el b/test/lisp/so-long-tests/so-long-tests-helpers.el
index 3f7bb368172..ab4d9c6c137 100644
--- a/test/lisp/so-long-tests/so-long-tests-helpers.el
+++ b/test/lisp/so-long-tests/so-long-tests-helpers.el
@@ -1,6 +1,6 @@
;;; so-long-tests-helpers.el --- Test suite for so-long.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; Author: Phil Sainty <psainty@orcon.net.nz>
;; Keywords: convenience
diff --git a/test/lisp/so-long-tests/so-long-tests.el b/test/lisp/so-long-tests/so-long-tests.el
index b72ee2fd612..a6d8721ffc8 100644
--- a/test/lisp/so-long-tests/so-long-tests.el
+++ b/test/lisp/so-long-tests/so-long-tests.el
@@ -1,6 +1,6 @@
;;; so-long-tests.el --- Test suite for so-long.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; Author: Phil Sainty <psainty@orcon.net.nz>
;; Keywords: convenience
diff --git a/test/lisp/so-long-tests/spelling-tests.el b/test/lisp/so-long-tests/spelling-tests.el
index 478a02750fa..0be8555bdd2 100644
--- a/test/lisp/so-long-tests/spelling-tests.el
+++ b/test/lisp/so-long-tests/spelling-tests.el
@@ -1,6 +1,6 @@
;;; spelling-tests.el --- Test suite for so-long.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; Author: Phil Sainty <psainty@orcon.net.nz>
;; Keywords: convenience
diff --git a/test/lisp/sort-tests.el b/test/lisp/sort-tests.el
index 9033745e0d4..62b89c1825d 100644
--- a/test/lisp/sort-tests.el
+++ b/test/lisp/sort-tests.el
@@ -1,6 +1,6 @@
;;; sort-tests.el --- Tests for sort.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
diff --git a/test/lisp/soundex-tests.el b/test/lisp/soundex-tests.el
index 4170d66afb6..aa3609e5db3 100644
--- a/test/lisp/soundex-tests.el
+++ b/test/lisp/soundex-tests.el
@@ -1,6 +1,6 @@
;;; soundex-tests.el --- tests for soundex.el -*- lexical-binding: t -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
diff --git a/test/lisp/startup-tests.el b/test/lisp/startup-tests.el
index 314ffc93e4a..109d909622a 100644
--- a/test/lisp/startup-tests.el
+++ b/test/lisp/startup-tests.el
@@ -1,6 +1,6 @@
;;; startup-tests.el --- unit tests for startup.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; Author: Philipp Stephani <phst@google.com>
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index 035c064d75c..fc5a1eba6d8 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -1,6 +1,6 @@
;;; subr-tests.el --- Tests for subr.el -*- lexical-binding:t -*-
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Author: Oleh Krehel <ohwoeowho@gmail.com>,
;; Nicolas Petton <nicolas@petton.fr>
@@ -61,6 +61,46 @@
(quote
(0 font-lock-keyword-face))))))))
+
+;;;; Keymap support.
+
+(ert-deftest subr-test-kbd ()
+ (should (equal (kbd "f") "f"))
+ (should (equal (kbd "<f1>") [f1]))
+ (should (equal (kbd "RET") "\C-m"))
+ (should (equal (kbd "C-x a") "\C-xa"))
+ ;; Check that kbd handles both new and old style key descriptions
+ ;; (bug#45536).
+ (should (equal (kbd "s-<return>") [s-return]))
+ (should (equal (kbd "<s-return>") [s-return]))
+ (should (equal (kbd "C-M-<return>") [C-M-return]))
+ (should (equal (kbd "<C-M-return>") [C-M-return])))
+
+(ert-deftest subr-test-define-prefix-command ()
+ (define-prefix-command 'foo-prefix-map)
+ (should (keymapp foo-prefix-map))
+ (should (fboundp #'foo-prefix-map))
+ ;; With optional argument.
+ (define-prefix-command 'bar-prefix 'bar-prefix-map)
+ (should (keymapp bar-prefix-map))
+ (should (fboundp #'bar-prefix))
+ ;; Returns the symbol.
+ (should (eq (define-prefix-command 'foo-bar) 'foo-bar)))
+
+(ert-deftest subr-test-local-key-binding ()
+ (with-temp-buffer
+ (emacs-lisp-mode)
+ (should (keymapp (local-key-binding [menu-bar])))
+ (should-not (local-key-binding [f12]))))
+
+(ert-deftest subr-test-global-key-binding ()
+ (should (eq (global-key-binding [f1]) 'help-command))
+ (should (eq (global-key-binding "x") 'self-insert-command))
+ (should-not (global-key-binding [f12])))
+
+
+;;;; Mode hooks.
+
(defalias 'subr-tests--parent-mode
(if (fboundp 'prog-mode) 'prog-mode 'fundamental-mode))
@@ -404,6 +444,15 @@ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19350."
(should (equal (flatten-tree '(1 ("foo" "bar") 2))
'(1 "foo" "bar" 2))))
+(ert-deftest subr--tests-letrec ()
+ ;; Test that simple cases of `letrec' get optimized back to `let*'.
+ (should (equal (macroexpand '(letrec ((subr-tests-var1 1)
+ (subr-tests-var2 subr-tests-var1))
+ (+ subr-tests-var1 subr-tests-var2)))
+ '(let* ((subr-tests-var1 1)
+ (subr-tests-var2 subr-tests-var1))
+ (+ subr-tests-var1 subr-tests-var2)))))
+
(defvar subr-tests--hook nil)
(ert-deftest subr-tests-add-hook-depth ()
@@ -484,5 +533,151 @@ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19350."
(should-error (string-replace "" "x" "abc")))
+(ert-deftest subr-replace-regexp-in-string ()
+ (should (equal (replace-regexp-in-string "a+" "xy" "abaabbabaaba")
+ "xybxybbxybxybxy"))
+ ;; FIXEDCASE
+ (let ((case-fold-search t))
+ (should (equal (replace-regexp-in-string "a+" "xy" "ABAABBABAABA")
+ "XYBXYBBXYBXYBXY"))
+ (should (equal (replace-regexp-in-string "a+" "xy" "ABAABBABAABA" t)
+ "xyBxyBBxyBxyBxy"))
+ (should (equal (replace-regexp-in-string
+ "a[bc]*" "xyz"
+ "a A ab AB Ab aB abc ABC Abc AbC aBc")
+ "xyz XYZ xyz XYZ Xyz xyz xyz XYZ Xyz Xyz xyz"))
+ (should (equal (replace-regexp-in-string
+ "a[bc]*" "xyz"
+ "a A ab AB Ab aB abc ABC Abc AbC aBc" t)
+ "xyz xyz xyz xyz xyz xyz xyz xyz xyz xyz xyz")))
+ (let ((case-fold-search nil))
+ (should (equal (replace-regexp-in-string "a+" "xy" "ABAABBABAABA")
+ "ABAABBABAABA")))
+ ;; group substitution
+ (should (equal (replace-regexp-in-string
+ "a\\(b*\\)" "<\\1,\\&>" "babbcaabacbab")
+ "b<bb,abb>c<,a><b,ab><,a>cb<b,ab>"))
+ (should (equal (replace-regexp-in-string
+ "x\\(?2:..\\)\\(?1:..\\)\\(..\\)\\(..\\)\\(..\\)"
+ "<\\3,\\5,\\4,\\1,\\2>" "yxabcdefghijkl")
+ "y<ef,ij,gh,cd,ab>kl"))
+ ;; LITERAL
+ (should (equal (replace-regexp-in-string
+ "a\\(b*\\)" "<\\1,\\&>" "babbcaabacbab" nil t)
+ "b<\\1,\\&>c<\\1,\\&><\\1,\\&><\\1,\\&>cb<\\1,\\&>"))
+ (should (equal (replace-regexp-in-string
+ "a" "\\\\,\\?" "aba")
+ "\\,\\?b\\,\\?"))
+ (should (equal (replace-regexp-in-string
+ "a" "\\\\,\\?" "aba" nil t)
+ "\\\\,\\?b\\\\,\\?"))
+ ;; SUBEXP
+ (should (equal (replace-regexp-in-string
+ "\\(a\\)\\(b*\\)c" "xy" "babbcdacd" nil nil 2)
+ "baxycdaxycd"))
+ ;; START
+ (should (equal (replace-regexp-in-string
+ "ab" "x" "abcabdabeabf" nil nil nil 4)
+ "bdxexf"))
+ ;; An empty pattern matches once before every character.
+ (should (equal (replace-regexp-in-string "" "x" "abc")
+ "xaxbxc"))
+ (should (equal (replace-regexp-in-string "y*" "x" "abc")
+ "xaxbxc"))
+ ;; replacement function
+ (should (equal (replace-regexp-in-string
+ "a\\(b*\\)c"
+ (lambda (s)
+ (format "<%s,%s,%s,%s,%s>"
+ s
+ (match-beginning 0) (match-end 0)
+ (match-beginning 1) (match-end 1)))
+ "babbcaacabc")
+ "b<abbc,0,4,1,3>a<ac,0,2,1,1><abc,0,3,1,2>"))
+ ;; anchors (bug#15107, bug#44861)
+ (should (equal (replace-regexp-in-string "a\\B" "b" "a aaaa")
+ "a bbba"))
+ (should (equal (replace-regexp-in-string "\\`\\|x" "z" "--xx--")
+ "z--zz--")))
+
+(ert-deftest subr-match-substitute-replacement ()
+ (with-temp-buffer
+ (insert "Alpha Beta Gamma Delta Epsilon")
+ (goto-char (point-min))
+ (re-search-forward "B\\(..\\)a")
+ (should (equal (match-substitute-replacement "carrot")
+ "Carrot"))
+ (should (equal (match-substitute-replacement "<\\&>")
+ "<Beta>"))
+ (should (equal (match-substitute-replacement "m\\1a")
+ "Meta"))
+ (should (equal (match-substitute-replacement "ernin" nil nil nil 1)
+ "Bernina")))
+ (let ((s "Tau Beta Gamma Delta Epsilon"))
+ (string-match "B\\(..\\)a" s)
+ (should (equal (match-substitute-replacement "carrot" nil nil s)
+ "Carrot"))
+ (should (equal (match-substitute-replacement "<\\&>" nil nil s)
+ "<Beta>"))
+ (should (equal (match-substitute-replacement "m\\1a" nil nil s)
+ "Meta"))
+ (should (equal (match-substitute-replacement "ernin" nil nil s 1)
+ "Bernina"))))
+
+(ert-deftest subr-tests--change-group-33341 ()
+ (with-temp-buffer
+ (buffer-enable-undo)
+ (insert "0\n")
+ (let ((g (prepare-change-group)))
+ (activate-change-group g)
+ (insert "b\n")
+ (insert "c\n")
+ (cancel-change-group g))
+ (should (equal (buffer-string) "0\n"))
+ (erase-buffer)
+ (setq buffer-undo-list nil)
+ (insert "0\n")
+ (let ((g (prepare-change-group)))
+ (activate-change-group g)
+ (insert "b\n")
+ (insert "c\n")
+ (accept-change-group g))
+ (should (equal (buffer-string) "0\nb\nc\n"))
+ (undo-boundary)
+ (undo)
+ (should (equal (buffer-string) ""))))
+
+(defvar subr--ordered nil)
+
+(ert-deftest subr--add-to-ordered-list-eq ()
+ (setq subr--ordered nil)
+ (add-to-ordered-list 'subr--ordered 'b 2)
+ (should (equal subr--ordered '(b)))
+ (add-to-ordered-list 'subr--ordered 'c 3)
+ (should (equal subr--ordered '(b c)))
+ (add-to-ordered-list 'subr--ordered 'a 1)
+ (should (equal subr--ordered '(a b c)))
+ (add-to-ordered-list 'subr--ordered 'e)
+ (should (equal subr--ordered '(a b c e)))
+ (add-to-ordered-list 'subr--ordered 'd 4)
+ (should (equal subr--ordered '(a b c d e)))
+ (add-to-ordered-list 'subr--ordered 'e)
+ (should (equal subr--ordered '(a b c d e)))
+ (add-to-ordered-list 'subr--ordered 'b 5)
+ (should (equal subr--ordered '(a c d b e))))
+
+
+;;; Apropos.
+
+(ert-deftest apropos-apropos-internal ()
+ (should (equal (apropos-internal "^next-line$") '(next-line)))
+ (should (>= (length (apropos-internal "^help")) 100))
+ (should-not (apropos-internal "^test-a-missing-symbol-foo-bar-zot$")))
+
+(ert-deftest apropos-apropos-internal/predicate ()
+ (should (equal (apropos-internal "^next-line$" #'commandp) '(next-line)))
+ (should (>= (length (apropos-internal "^help" #'commandp)) 15))
+ (should-not (apropos-internal "^next-line$" #'keymapp)))
+
(provide 'subr-tests)
;;; subr-tests.el ends here
diff --git a/test/lisp/tabify-tests.el b/test/lisp/tabify-tests.el
index 1fde67b6141..4896e4a1aa3 100644
--- a/test/lisp/tabify-tests.el
+++ b/test/lisp/tabify-tests.el
@@ -1,6 +1,6 @@
;;; tabify-tests.el --- tests for tabify.el -*- lexical-binding: t -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; Author: Stefan Kangas <stefankangas@gmail.com>
diff --git a/test/lisp/tar-mode-tests.el b/test/lisp/tar-mode-tests.el
index f05389df60f..48a127157dd 100644
--- a/test/lisp/tar-mode-tests.el
+++ b/test/lisp/tar-mode-tests.el
@@ -1,6 +1,6 @@
;;; tar-mode-tests.el --- Test suite for tar-mode. -*- lexical-binding: t -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/tempo-tests.el b/test/lisp/tempo-tests.el
index bfe475910da..7594c360ad4 100644
--- a/test/lisp/tempo-tests.el
+++ b/test/lisp/tempo-tests.el
@@ -1,6 +1,6 @@
;;; tempo-tests.el --- Test suite for tempo.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; Author: Federico Tedin <federicotedin@gmail.com>
;; Keywords: abbrev
diff --git a/test/lisp/term-tests.el b/test/lisp/term-tests.el
index b9e492138ad..503cb5d7aab 100644
--- a/test/lisp/term-tests.el
+++ b/test/lisp/term-tests.el
@@ -1,6 +1,6 @@
;;; term-tests.el --- tests for term.el -*- lexical-binding: t -*-
-;; Copyright (C) 2017, 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017, 2019-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/term/tty-colors-tests.el b/test/lisp/term/tty-colors-tests.el
index 968c699cbbb..ba29a9c376e 100644
--- a/test/lisp/term/tty-colors-tests.el
+++ b/test/lisp/term/tty-colors-tests.el
@@ -1,6 +1,6 @@
;;; tty-colors-tests.el --- tests for tty-colors.el -*- lexical-binding: t -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/textmodes/bibtex-tests.el b/test/lisp/textmodes/bibtex-tests.el
index 56bd54efb74..010808ce48f 100644
--- a/test/lisp/textmodes/bibtex-tests.el
+++ b/test/lisp/textmodes/bibtex-tests.el
@@ -1,6 +1,6 @@
;;; bibtex-tests.el --- Test suite for bibtex. -*- lexical-binding:t -*-
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; Keywords: bibtex
diff --git a/test/lisp/textmodes/conf-mode-tests.el b/test/lisp/textmodes/conf-mode-tests.el
index 7e094e8a7c2..9c4fd1afdfe 100644
--- a/test/lisp/textmodes/conf-mode-tests.el
+++ b/test/lisp/textmodes/conf-mode-tests.el
@@ -1,6 +1,6 @@
;;; conf-mode-tests.el --- Test suite for conf mode -*- lexical-binding: t; -*-
-;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2016-2021 Free Software Foundation, Inc.
;; Author: J. Alexander Branham <alex.branham@gmail.com>
;; Keywords: internal
diff --git a/test/lisp/textmodes/css-mode-tests.el b/test/lisp/textmodes/css-mode-tests.el
index 476fd326e66..97f5abf1156 100644
--- a/test/lisp/textmodes/css-mode-tests.el
+++ b/test/lisp/textmodes/css-mode-tests.el
@@ -1,6 +1,6 @@
;;; css-mode-tests.el --- Test suite for CSS mode -*- lexical-binding: t; -*-
-;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2016-2021 Free Software Foundation, Inc.
;; Author: Simen Heggestøyl <simenheg@gmail.com>
;; Keywords: internal
diff --git a/test/lisp/textmodes/dns-mode-tests.el b/test/lisp/textmodes/dns-mode-tests.el
index 6eca9327ce8..694d683d546 100644
--- a/test/lisp/textmodes/dns-mode-tests.el
+++ b/test/lisp/textmodes/dns-mode-tests.el
@@ -1,6 +1,6 @@
;;; dns-mode-tests.el --- Test suite for dns-mode -*- lexical-binding: t; -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; Author: Peder O. Klingenberg <peder@klingenberg.no>
;; Keywords: dns zone
diff --git a/test/lisp/textmodes/fill-tests.el b/test/lisp/textmodes/fill-tests.el
index 833d74decdd..21efe620999 100644
--- a/test/lisp/textmodes/fill-tests.el
+++ b/test/lisp/textmodes/fill-tests.el
@@ -1,6 +1,6 @@
;;; fill-test.el --- ERT tests for fill.el -*- lexical-binding: t -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; Author: Marcin Borkowski <mbork@mbork.pl>
;; Keywords: text, wp
@@ -44,6 +44,37 @@
(fill-paragraph)
(should (string= (buffer-string) "Abc\nd efg\n(h ijk)."))))
+(ert-deftest fill-test-unbreakable-paragraph ()
+ (with-temp-buffer
+ (let ((string "aaa = baaaaaaaaaaaaaaaaaaaaaaaaaaaa\n"))
+ (insert string)
+ (goto-char (point-min))
+ (search-forward "b")
+ (let* ((pos (point))
+ (beg (line-beginning-position))
+ (end (line-end-position))
+ (fill-prefix (make-string (- pos beg) ?\s))
+ ;; `fill-column' is too small to accomodate the current line
+ (fill-column (- end beg 10)))
+ (fill-region-as-paragraph beg end nil nil pos))
+ (should (equal (buffer-string) string)))))
+
+(ert-deftest fill-test-breakable-paragraph ()
+ (with-temp-buffer
+ (let ((string "aaa = baaaaaaaa aaaaaaaaaa aaaaaaaaaa\n"))
+ (insert string)
+ (goto-char (point-min))
+ (search-forward "b")
+ (let* ((pos (point))
+ (beg (line-beginning-position))
+ (end (line-end-position))
+ (fill-prefix (make-string (- pos beg) ?\s))
+ ;; `fill-column' is too small to accomodate the current line
+ (fill-column (- end beg 10)))
+ (fill-region-as-paragraph beg end nil nil pos))
+ (should (equal
+ (buffer-string)
+ "aaa = baaaaaaaa aaaaaaaaaa\n aaaaaaaaaa\n")))))
(provide 'fill-tests)
diff --git a/test/lisp/textmodes/mhtml-mode-tests.el b/test/lisp/textmodes/mhtml-mode-tests.el
index 1840e8b4016..ad386bf1bdb 100644
--- a/test/lisp/textmodes/mhtml-mode-tests.el
+++ b/test/lisp/textmodes/mhtml-mode-tests.el
@@ -1,6 +1,6 @@
;;; mhtml-mode-tests.el --- Tests for mhtml-mode -*- lexical-binding:t -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; Keywords: tests
diff --git a/test/lisp/textmodes/page-tests.el b/test/lisp/textmodes/page-tests.el
index 79aabd88dc5..c02d125c2ad 100644
--- a/test/lisp/textmodes/page-tests.el
+++ b/test/lisp/textmodes/page-tests.el
@@ -1,6 +1,6 @@
;;; page-tests.el --- Tests for page.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; Author: Simen Heggestøyl <simenheg@gmail.com>
;; Keywords:
diff --git a/test/lisp/textmodes/paragraphs-resources/mark-paragraph.bin b/test/lisp/textmodes/paragraphs-resources/mark-paragraph.bin
new file mode 100644
index 00000000000..1905477af8c
--- /dev/null
+++ b/test/lisp/textmodes/paragraphs-resources/mark-paragraph.bin
@@ -0,0 +1,9 @@
+First
+paragraph
+
+Second
+
+Third
+paragraph
+
+No line end \ No newline at end of file
diff --git a/test/lisp/textmodes/paragraphs-tests.el b/test/lisp/textmodes/paragraphs-tests.el
index 0b264e7e184..712169029de 100644
--- a/test/lisp/textmodes/paragraphs-tests.el
+++ b/test/lisp/textmodes/paragraphs-tests.el
@@ -1,6 +1,6 @@
;;; paragraphs-tests.el --- Tests for paragraphs.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; Author: Stefan Kangas <stefankangas@gmail.com>
@@ -24,6 +24,7 @@
;;; Code:
(require 'ert)
+(require 'ert-x)
;; (require 'paragraphs) ; loaded by default
(ert-deftest paragraphs-tests-sentence-end ()
@@ -161,5 +162,27 @@
(should (equal (buffer-string)
"First sentence. Third sentence. Second sentence."))))
+(ert-deftest test-mark-paragraphs ()
+ (with-current-buffer
+ (find-file-noselect (ert-resource-file "mark-paragraph.bin"))
+ (goto-char (point-max))
+ ;; Just a sanity check that the file hasn't changed.
+ (should (= (point) 54))
+ (mark-paragraph)
+ (should (= (point) 42))
+ (should (= (mark) 54))
+ ;; Doesn't move.
+ (mark-paragraph)
+ (should (= (point) 42))
+ (should (= (mark) 54))
+ (forward-line -1)
+ (mark-paragraph)
+ (should (= (point) 25))
+ (should (= (mark) 42))
+ (goto-char (point-min))
+ (mark-paragraph)
+ (should (= (point) 1))
+ (should (= (mark) 17))))
+
(provide 'paragraphs-tests)
;;; paragraphs-tests.el ends here
diff --git a/test/lisp/textmodes/po-tests.el b/test/lisp/textmodes/po-tests.el
index a098290ce15..c75cb5eae74 100644
--- a/test/lisp/textmodes/po-tests.el
+++ b/test/lisp/textmodes/po-tests.el
@@ -1,6 +1,6 @@
;;; po-tests.el --- Tests for po.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; Author: Simen Heggestøyl <simenheg@gmail.com>
;; Keywords:
diff --git a/test/lisp/textmodes/reftex-tests.el b/test/lisp/textmodes/reftex-tests.el
index 2350326c14c..b824e05f6d5 100644
--- a/test/lisp/textmodes/reftex-tests.el
+++ b/test/lisp/textmodes/reftex-tests.el
@@ -1,6 +1,6 @@
;;; reftex-tests.el --- Test suite for reftex. -*- lexical-binding: t -*-
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; Author: Rüdiger Sonderfeld <ruediger@c-plusplus.de>
;; Keywords: internal
@@ -153,24 +153,23 @@
edition = {17th},
note = {Updated for Emacs Version 24.2}
}")
- (check (function
- (lambda (parsed)
- (should (string= (reftex-get-bib-field "&key" parsed)
- "Stallman12"))
- (should (string= (reftex-get-bib-field "&type" parsed)
- "book"))
- (should (string= (reftex-get-bib-field "author" parsed)
- "Richard Stallman et al."))
- (should (string= (reftex-get-bib-field "title" parsed)
- "The Emacs Editor"))
- (should (string= (reftex-get-bib-field "publisher" parsed)
- "GNU Press"))
- (should (string= (reftex-get-bib-field "year" parsed)
- "2012"))
- (should (string= (reftex-get-bib-field "edition" parsed)
- "17th"))
- (should (string= (reftex-get-bib-field "note" parsed)
- "Updated for Emacs Version 24.2"))))))
+ (check (lambda (parsed)
+ (should (string= (reftex-get-bib-field "&key" parsed)
+ "Stallman12"))
+ (should (string= (reftex-get-bib-field "&type" parsed)
+ "book"))
+ (should (string= (reftex-get-bib-field "author" parsed)
+ "Richard Stallman et al."))
+ (should (string= (reftex-get-bib-field "title" parsed)
+ "The Emacs Editor"))
+ (should (string= (reftex-get-bib-field "publisher" parsed)
+ "GNU Press"))
+ (should (string= (reftex-get-bib-field "year" parsed)
+ "2012"))
+ (should (string= (reftex-get-bib-field "edition" parsed)
+ "17th"))
+ (should (string= (reftex-get-bib-field "note" parsed)
+ "Updated for Emacs Version 24.2")))))
(funcall check (reftex-parse-bibtex-entry entry))
(with-temp-buffer
(insert entry)
diff --git a/test/lisp/textmodes/sgml-mode-tests.el b/test/lisp/textmodes/sgml-mode-tests.el
index a4457307b35..697c96c78e5 100644
--- a/test/lisp/textmodes/sgml-mode-tests.el
+++ b/test/lisp/textmodes/sgml-mode-tests.el
@@ -1,6 +1,6 @@
;;; sgml-mode-tests.el --- Tests for sgml-mode -*- lexical-binding:t -*-
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Author: Przemysław Wojnowski <esperanto@cumego.com>
;; Keywords: tests
diff --git a/test/lisp/textmodes/tildify-tests.el b/test/lisp/textmodes/tildify-tests.el
index 61f80cc9531..59c23943304 100644
--- a/test/lisp/textmodes/tildify-tests.el
+++ b/test/lisp/textmodes/tildify-tests.el
@@ -1,6 +1,6 @@
;;; tildify-test.el --- ERT tests for tildify.el -*- lexical-binding: t -*-
-;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2021 Free Software Foundation, Inc.
;; Author: Michal Nazarewicz <mina86@mina86.com>
;; Version: 4.5
diff --git a/test/lisp/textmodes/underline-tests.el b/test/lisp/textmodes/underline-tests.el
index 3fbb586da08..481c9cca42e 100644
--- a/test/lisp/textmodes/underline-tests.el
+++ b/test/lisp/textmodes/underline-tests.el
@@ -1,6 +1,6 @@
;;; underline-tests.el --- Tests for underline.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; Author: Stefan Kangas <stefankangas@gmail.com>
diff --git a/test/lisp/thingatpt-tests.el b/test/lisp/thingatpt-tests.el
index f02aeaeef6a..c43c81af9fd 100644
--- a/test/lisp/thingatpt-tests.el
+++ b/test/lisp/thingatpt-tests.el
@@ -1,6 +1,6 @@
;;; thingatpt.el --- tests for thing-at-point. -*- lexical-binding:t -*-
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/thread-tests.el b/test/lisp/thread-tests.el
index 849ca07ddf3..4aed5057ff0 100644
--- a/test/lisp/thread-tests.el
+++ b/test/lisp/thread-tests.el
@@ -1,6 +1,6 @@
;;; thread-tests.el --- Test suite for thread.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2018-2021 Free Software Foundation, Inc.
;; Author: Gemini Lasswell <gazally@runbox.com>
;; Keywords: threads
diff --git a/test/lisp/time-stamp-tests.el b/test/lisp/time-stamp-tests.el
index e75e84b0221..4ae3c1917dd 100644
--- a/test/lisp/time-stamp-tests.el
+++ b/test/lisp/time-stamp-tests.el
@@ -1,6 +1,6 @@
;;; time-stamp-tests.el --- tests for time-stamp.el -*- lexical-binding: t -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -262,40 +262,48 @@
(ert-deftest time-stamp-format-day-of-week ()
"Test time-stamp formats for named day of week."
(with-time-stamp-test-env
- ;; implemented and documented since 1997
- (should (equal (time-stamp-string "%3a" ref-time1) "Mon"))
- (should (equal (time-stamp-string "%#A" ref-time1) "MONDAY"))
- ;; documented 1997-2019
- (should (equal (time-stamp-string "%3A" ref-time1) "MON"))
- (should (equal (time-stamp-string "%:a" ref-time1) "Monday"))
- ;; implemented since 2001, documented since 2019
- (should (equal (time-stamp-string "%#a" ref-time1) "MON"))
- (should (equal (time-stamp-string "%:A" ref-time1) "Monday"))
- ;; allowed but undocumented since 2019 (warned 1997-2019)
- (should (equal (time-stamp-string "%^A" ref-time1) "MONDAY"))
- ;; warned 1997-2019, changed in 2019
- (should (equal (time-stamp-string "%a" ref-time1) "Mon"))
- (should (equal (time-stamp-string "%^a" ref-time1) "MON"))
- (should (equal (time-stamp-string "%A" ref-time1) "Monday"))))
+ (let ((Mon (format-time-string "%a" ref-time1 t))
+ (MON (format-time-string "%^a" ref-time1 t))
+ (Monday (format-time-string "%A" ref-time1 t))
+ (MONDAY (format-time-string "%^A" ref-time1 t)))
+ ;; implemented and documented since 1997
+ (should (equal (time-stamp-string "%3a" ref-time1) Mon))
+ (should (equal (time-stamp-string "%#A" ref-time1) MONDAY))
+ ;; documented 1997-2019
+ (should (equal (time-stamp-string "%3A" ref-time1) MON))
+ (should (equal (time-stamp-string "%:a" ref-time1) Monday))
+ ;; implemented since 2001, documented since 2019
+ (should (equal (time-stamp-string "%#a" ref-time1) MON))
+ (should (equal (time-stamp-string "%:A" ref-time1) Monday))
+ ;; allowed but undocumented since 2019 (warned 1997-2019)
+ (should (equal (time-stamp-string "%^A" ref-time1) MONDAY))
+ ;; warned 1997-2019, changed in 2019
+ (should (equal (time-stamp-string "%a" ref-time1) Mon))
+ (should (equal (time-stamp-string "%^a" ref-time1) MON))
+ (should (equal (time-stamp-string "%A" ref-time1) Monday)))))
(ert-deftest time-stamp-format-month-name ()
"Test time-stamp formats for month name."
(with-time-stamp-test-env
- ;; implemented and documented since 1997
- (should (equal (time-stamp-string "%3b" ref-time1) "Jan"))
- (should (equal (time-stamp-string "%#B" ref-time1) "JANUARY"))
- ;; documented 1997-2019
- (should (equal (time-stamp-string "%3B" ref-time1) "JAN"))
- (should (equal (time-stamp-string "%:b" ref-time1) "January"))
- ;; implemented since 2001, documented since 2019
- (should (equal (time-stamp-string "%#b" ref-time1) "JAN"))
- (should (equal (time-stamp-string "%:B" ref-time1) "January"))
- ;; allowed but undocumented since 2019 (warned 1997-2019)
- (should (equal (time-stamp-string "%^B" ref-time1) "JANUARY"))
- ;; warned 1997-2019, changed in 2019
- (should (equal (time-stamp-string "%b" ref-time1) "Jan"))
- (should (equal (time-stamp-string "%^b" ref-time1) "JAN"))
- (should (equal (time-stamp-string "%B" ref-time1) "January"))))
+ (let ((Jan (format-time-string "%b" ref-time1 t))
+ (JAN (format-time-string "%^b" ref-time1 t))
+ (January (format-time-string "%B" ref-time1 t))
+ (JANUARY (format-time-string "%^B" ref-time1 t)))
+ ;; implemented and documented since 1997
+ (should (equal (time-stamp-string "%3b" ref-time1) Jan))
+ (should (equal (time-stamp-string "%#B" ref-time1) JANUARY))
+ ;; documented 1997-2019
+ (should (equal (time-stamp-string "%3B" ref-time1) JAN))
+ (should (equal (time-stamp-string "%:b" ref-time1) January))
+ ;; implemented since 2001, documented since 2019
+ (should (equal (time-stamp-string "%#b" ref-time1) JAN))
+ (should (equal (time-stamp-string "%:B" ref-time1) January))
+ ;; allowed but undocumented since 2019 (warned 1997-2019)
+ (should (equal (time-stamp-string "%^B" ref-time1) JANUARY))
+ ;; warned 1997-2019, changed in 2019
+ (should (equal (time-stamp-string "%b" ref-time1) Jan))
+ (should (equal (time-stamp-string "%^b" ref-time1) JAN))
+ (should (equal (time-stamp-string "%B" ref-time1) January)))))
(ert-deftest time-stamp-format-day-of-month ()
"Test time-stamp formats for day of month."
@@ -483,14 +491,18 @@
(ert-deftest time-stamp-format-am-pm ()
"Test time-stamp formats for AM and PM strings."
(with-time-stamp-test-env
- ;; implemented and documented since 1997
- (should (equal (time-stamp-string "%#p" ref-time1) "pm"))
- (should (equal (time-stamp-string "%#p" ref-time3) "am"))
- (should (equal (time-stamp-string "%P" ref-time1) "PM"))
- (should (equal (time-stamp-string "%P" ref-time3) "AM"))
- ;; warned 1997-2019, changed in 2019
- (should (equal (time-stamp-string "%p" ref-time1) "PM"))
- (should (equal (time-stamp-string "%p" ref-time3) "AM"))))
+ (let ((pm (format-time-string "%#p" ref-time1 t))
+ (am (format-time-string "%#p" ref-time3 t))
+ (PM (format-time-string "%p" ref-time1 t))
+ (AM (format-time-string "%p" ref-time3 t)))
+ ;; implemented and documented since 1997
+ (should (equal (time-stamp-string "%#p" ref-time1) pm))
+ (should (equal (time-stamp-string "%#p" ref-time3) am))
+ (should (equal (time-stamp-string "%P" ref-time1) PM))
+ (should (equal (time-stamp-string "%P" ref-time3) AM))
+ ;; warned 1997-2019, changed in 2019
+ (should (equal (time-stamp-string "%p" ref-time1) PM))
+ (should (equal (time-stamp-string "%p" ref-time3) AM)))))
(ert-deftest time-stamp-format-day-number-in-week ()
"Test time-stamp formats for day number in week."
@@ -567,10 +579,15 @@
(ert-deftest time-stamp-format-ignored-modifiers ()
"Test additional args allowed (but ignored) to allow for future expansion."
(with-time-stamp-test-env
- ;; allowed modifiers
- (should (equal (time-stamp-string "%.,@-+_ ^(stuff)P" ref-time3) "AM"))
- ;; not all punctuation is allowed
- (should-not (equal (time-stamp-string "%&P" ref-time3) "AM"))))
+ (let ((May (format-time-string "%B" ref-time3 t)))
+ ;; allowed modifiers
+ (should (equal (time-stamp-string "%.,@+ (stuff)B" ref-time3) May))
+ ;; parens nest
+ (should (equal (time-stamp-string "%(st(u)ff)B" ref-time3) May))
+ ;; escaped parens do not change the nesting level
+ (should (equal (time-stamp-string "%(st\\)u\\(ff)B" ref-time3) May))
+ ;; not all punctuation is allowed
+ (should-not (equal (time-stamp-string "%&B" ref-time3) May)))))
(ert-deftest time-stamp-format-non-conversions ()
"Test that without a %, the text is copied literally."
@@ -580,16 +597,22 @@
(ert-deftest time-stamp-format-string-width ()
"Test time-stamp string width modifiers."
(with-time-stamp-test-env
- ;; strings truncate on the right or are blank-padded on the left
- (should (equal (time-stamp-string "%0P" ref-time3) ""))
- (should (equal (time-stamp-string "%1P" ref-time3) "A"))
- (should (equal (time-stamp-string "%2P" ref-time3) "AM"))
- (should (equal (time-stamp-string "%3P" ref-time3) " AM"))
- (should (equal (time-stamp-string "%0%" ref-time3) ""))
- (should (equal (time-stamp-string "%1%" ref-time3) "%"))
- (should (equal (time-stamp-string "%2%" ref-time3) " %"))
- (should (equal (time-stamp-string "%#3a" ref-time3) "SUN"))
- (should (equal (time-stamp-string "%#3b" ref-time2) "NOV"))))
+ (let ((May (format-time-string "%b" ref-time3 t))
+ (SUN (format-time-string "%^a" ref-time3 t))
+ (NOV (format-time-string "%^b" ref-time2 t)))
+ ;; strings truncate on the right or are blank-padded on the left
+ (should (equal (time-stamp-string "%0b" ref-time3) ""))
+ (should (equal (time-stamp-string "%1b" ref-time3) (substring May 0 1)))
+ (should (equal (time-stamp-string "%2b" ref-time3) (substring May 0 2)))
+ (should (equal (time-stamp-string "%3b" ref-time3) May))
+ (should (equal (time-stamp-string "%4b" ref-time3) (concat " " May)))
+ (should (equal (time-stamp-string "%0%" ref-time3) ""))
+ (should (equal (time-stamp-string "%1%" ref-time3) "%"))
+ (should (equal (time-stamp-string "%2%" ref-time3) " %"))
+ (should (equal (time-stamp-string "%9%" ref-time3) " %"))
+ (should (equal (time-stamp-string "%10%" ref-time3) " %"))
+ (should (equal (time-stamp-string "%#3a" ref-time3) SUN))
+ (should (equal (time-stamp-string "%#3b" ref-time2) NOV)))))
;;; Tests of helper functions
diff --git a/test/lisp/time-tests.el b/test/lisp/time-tests.el
index 2d327b959cc..3cf8b540cbc 100644
--- a/test/lisp/time-tests.el
+++ b/test/lisp/time-tests.el
@@ -1,6 +1,6 @@
;;; time-tests.el --- Tests for time.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; Author: Stefan Kangas <stefankangas@gmail.com>
diff --git a/test/lisp/timezone-tests.el b/test/lisp/timezone-tests.el
index 8992e3e80e9..9f6961409e6 100644
--- a/test/lisp/timezone-tests.el
+++ b/test/lisp/timezone-tests.el
@@ -1,6 +1,6 @@
;;; timezone-tests.el --- Tests for timezone.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; Author: Stefan Kangas <stefankangas@gmail.com>
diff --git a/test/lisp/url/url-auth-tests.el b/test/lisp/url/url-auth-tests.el
index d3acdef8535..ff30f100250 100644
--- a/test/lisp/url/url-auth-tests.el
+++ b/test/lisp/url/url-auth-tests.el
@@ -1,6 +1,6 @@
;;; url-auth-tests.el --- Test suite for url-auth. -*- lexical-binding:t -*-
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Author: Jarno Malmari <jarno@malmari.fi>
diff --git a/test/lisp/url/url-domsuf-tests.el b/test/lisp/url/url-domsuf-tests.el
index a4fffb06311..d084c7a8bcb 100644
--- a/test/lisp/url/url-domsuf-tests.el
+++ b/test/lisp/url/url-domsuf-tests.el
@@ -1,6 +1,6 @@
;;; url-domsuf-tests.el --- Tests for url-domsuf.el -*- lexical-binding:t -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/url/url-expand-tests.el b/test/lisp/url/url-expand-tests.el
index 3b0b6fbd41a..52124dfedd8 100644
--- a/test/lisp/url/url-expand-tests.el
+++ b/test/lisp/url/url-expand-tests.el
@@ -1,6 +1,6 @@
;;; url-expand-tests.el --- Test suite for relative URI/URL resolution. -*- lexical-binding:t -*-
-;; Copyright (C) 2012-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
;; Author: Alain Schneble <a.s@realize.ch>
;; Version: 1.0
diff --git a/test/lisp/url/url-file-tests.el b/test/lisp/url/url-file-tests.el
index 810504faf2c..18365c79693 100644
--- a/test/lisp/url/url-file-tests.el
+++ b/test/lisp/url/url-file-tests.el
@@ -1,6 +1,6 @@
;;; url-file-tests.el --- Test suite for url-file. -*- lexical-binding: t -*-
-;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2018-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/url/url-future-tests.el b/test/lisp/url/url-future-tests.el
index a07730a2be6..8b0e20c4dde 100644
--- a/test/lisp/url/url-future-tests.el
+++ b/test/lisp/url/url-future-tests.el
@@ -1,6 +1,6 @@
;;; url-future-tests.el --- Test suite for url-future. -*- lexical-binding:t -*-
-;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
;; Author: Teodor Zlatanov <tzz@lifelogs.com>
;; Keywords: data
@@ -31,13 +31,13 @@
(let* (url-future-tests--saver
(text "running future")
(good (make-url-future :value (lambda () (format text))
- :callback (lambda (f) (set 'url-future-tests--saver f))))
+ :callback (lambda (f) (setq url-future-tests--saver f))))
(bad (make-url-future :value (lambda () (/ 1 0))
- :errorback (lambda (&rest d) (set 'url-future-tests--saver d))))
+ :errorback (lambda (&rest d) (setq url-future-tests--saver d))))
(tocancel (make-url-future :value (lambda () (/ 1 0))
- :callback (lambda (f) (set 'url-future-tests--saver f))
+ :callback (lambda (f) (setq url-future-tests--saver f))
:errorback (lambda (&rest d)
- (set 'url-future-tests--saver d)))))
+ (setq url-future-tests--saver d)))))
(should (equal good (url-future-call good)))
(should (equal good url-future-tests--saver))
(should (equal text (url-future-value good)))
diff --git a/test/lisp/url/url-handlers-test.el b/test/lisp/url/url-handlers-test.el
index 57692e53a70..7e5a60363da 100644
--- a/test/lisp/url/url-handlers-test.el
+++ b/test/lisp/url/url-handlers-test.el
@@ -1,6 +1,6 @@
;;; url-handlers-test.el --- Test suite for url-handlers.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2018-2021 Free Software Foundation, Inc.
;; Author: Nicolas Petton <nicolas@petton.fr>
diff --git a/test/lisp/url/url-misc-tests.el b/test/lisp/url/url-misc-tests.el
index 7b1467c9456..40c6edbd618 100644
--- a/test/lisp/url/url-misc-tests.el
+++ b/test/lisp/url/url-misc-tests.el
@@ -1,6 +1,6 @@
;;; url-misc-tests.el --- Test suite for url-misc. -*- lexical-binding: t -*-
-;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2018-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/url/url-parse-tests.el b/test/lisp/url/url-parse-tests.el
index 6ec46479a6f..2418af40aca 100644
--- a/test/lisp/url/url-parse-tests.el
+++ b/test/lisp/url/url-parse-tests.el
@@ -1,6 +1,6 @@
;;; url-parse-tests.el --- Test suite for URI/URL parsing. -*- lexical-binding:t -*-
-;; Copyright (C) 2012-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
;; Author: Alain Schneble <a.s@realize.ch>
;; Version: 1.0
diff --git a/test/lisp/url/url-tramp-tests.el b/test/lisp/url/url-tramp-tests.el
index 965b9ea0888..63d752ac3a0 100644
--- a/test/lisp/url/url-tramp-tests.el
+++ b/test/lisp/url/url-tramp-tests.el
@@ -1,6 +1,6 @@
;;; url-tramp-tests.el --- Test suite for Tramp / URL conversion. -*- lexical-binding:t -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
diff --git a/test/lisp/url/url-util-tests.el b/test/lisp/url/url-util-tests.el
index 0416331b032..57b67a04ccf 100644
--- a/test/lisp/url/url-util-tests.el
+++ b/test/lisp/url/url-util-tests.el
@@ -1,6 +1,6 @@
;;; url-util-tests.el --- Test suite for url-util. -*- lexical-binding:t -*-
-;; Copyright (C) 2012-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
;; Author: Teodor Zlatanov <tzz@lifelogs.com>
;; Keywords: data
diff --git a/test/lisp/vc/add-log-tests.el b/test/lisp/vc/add-log-tests.el
index f256945ee42..dc2b9961c6c 100644
--- a/test/lisp/vc/add-log-tests.el
+++ b/test/lisp/vc/add-log-tests.el
@@ -1,6 +1,6 @@
;;; add-log-tests.el --- Test suite for add-log. -*- lexical-binding:t -*-
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; Author: Masatake YAMATO <yamato@redhat.com>
;; Keywords: vc tools
diff --git a/test/lisp/vc/diff-mode-tests.el b/test/lisp/vc/diff-mode-tests.el
index b25836405cc..f4e5c89afb4 100644
--- a/test/lisp/vc/diff-mode-tests.el
+++ b/test/lisp/vc/diff-mode-tests.el
@@ -1,6 +1,6 @@
;;; diff-mode-tests.el --- Tests for diff-mode.el -*- lexical-binding:t -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; Author: Dima Kogan <dima@secretsauce.net>
;; Maintainer: emacs-devel@gnu.org
diff --git a/test/lisp/vc/ediff-diff-tests.el b/test/lisp/vc/ediff-diff-tests.el
index e6d52053d0c..001db8b0c4a 100644
--- a/test/lisp/vc/ediff-diff-tests.el
+++ b/test/lisp/vc/ediff-diff-tests.el
@@ -1,6 +1,6 @@
;;; ediff-diff-tests.el --- Unit tests for ediff-diff.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; Author: Philipp Stephani <phst@google.com>
diff --git a/test/lisp/vc/ediff-ptch-tests.el b/test/lisp/vc/ediff-ptch-tests.el
index 15270d68cb5..a464db2349d 100644
--- a/test/lisp/vc/ediff-ptch-tests.el
+++ b/test/lisp/vc/ediff-ptch-tests.el
@@ -1,6 +1,6 @@
;;; ediff-ptch-tests.el --- Tests for ediff-ptch.el -*- lexical-binding:t -*-
-;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2016-2021 Free Software Foundation, Inc.
;; Author: Tino Calancha <tino.calancha@gmail.com>
diff --git a/test/lisp/vc/log-edit-tests.el b/test/lisp/vc/log-edit-tests.el
index 86a40a97b19..84e363ad691 100644
--- a/test/lisp/vc/log-edit-tests.el
+++ b/test/lisp/vc/log-edit-tests.el
@@ -1,6 +1,6 @@
;;; log-edit-tests.el --- Unit tests for log-edit.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/vc/smerge-mode-tests.el b/test/lisp/vc/smerge-mode-tests.el
index 5b15a0931d1..2c8f48618e5 100644
--- a/test/lisp/vc/smerge-mode-tests.el
+++ b/test/lisp/vc/smerge-mode-tests.el
@@ -1,6 +1,6 @@
;;; smerge-mode-tests.el --- Tests for smerge-mode.el -*- lexical-binding:t -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
diff --git a/test/lisp/vc/vc-bzr-tests.el b/test/lisp/vc/vc-bzr-tests.el
index bd26f7979dc..aeab51ec261 100644
--- a/test/lisp/vc/vc-bzr-tests.el
+++ b/test/lisp/vc/vc-bzr-tests.el
@@ -1,6 +1,6 @@
;;; vc-bzr.el --- tests for vc/vc-bzr.el -*- lexical-binding: t -*-
-;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
;; Author: Glenn Morris <rgm@gnu.org>
;; Maintainer: emacs-devel@gnu.org
diff --git a/test/lisp/vc/vc-hg-tests.el b/test/lisp/vc/vc-hg-tests.el
index e4a20bbf2da..2edd4b6fd71 100644
--- a/test/lisp/vc/vc-hg-tests.el
+++ b/test/lisp/vc/vc-hg-tests.el
@@ -1,6 +1,6 @@
;;; vc-hg-tests.el --- tests for vc/vc-hg.el -*- lexical-binding:t -*-
-;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2016-2021 Free Software Foundation, Inc.
;; Author: Dmitry Gutov <dgutov@yandex.ru>
;; Maintainer: emacs-devel@gnu.org
diff --git a/test/lisp/vc/vc-tests.el b/test/lisp/vc/vc-tests.el
index 7b88b8d531a..5430535c5ed 100644
--- a/test/lisp/vc/vc-tests.el
+++ b/test/lisp/vc/vc-tests.el
@@ -1,6 +1,6 @@
;;; vc-tests.el --- Tests of different backends of vc.el -*- lexical-binding:t -*-
-;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2021 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
@@ -439,8 +439,9 @@ This checks also `vc-backend' and `vc-responsible-backend'."
;; nil: Git Mtn
;; "0": Bzr CVS Hg SRC SVN
;; "1.1": RCS SCCS
+ ;; "-1": Hg versions before 5 (probably)
(message "vc-working-revision4 %s" (vc-working-revision tmp-name))
- (should (member (vc-working-revision tmp-name) '(nil "0" "1.1")))
+ (should (member (vc-working-revision tmp-name) '(nil "0" "1.1" "-1")))
;; TODO: Call `vc-checkin', and check the resulting
;; working revision. None of the return values should be
diff --git a/test/lisp/version-tests.el b/test/lisp/version-tests.el
index 8fbd4a19fc5..ef2e9453052 100644
--- a/test/lisp/version-tests.el
+++ b/test/lisp/version-tests.el
@@ -1,6 +1,6 @@
;;; version-tests.el --- Tests for version.el -*- lexical-binding: t -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/wdired-tests.el b/test/lisp/wdired-tests.el
index f876967bf98..ba276e24d96 100644
--- a/test/lisp/wdired-tests.el
+++ b/test/lisp/wdired-tests.el
@@ -1,6 +1,6 @@
;;; wdired-tests.el --- tests for wdired.el -*- lexical-binding: t; -*-
-;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2018-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/whitespace-tests.el b/test/lisp/whitespace-tests.el
index cb3189c3d9e..9f54a4fd340 100644
--- a/test/lisp/whitespace-tests.el
+++ b/test/lisp/whitespace-tests.el
@@ -1,6 +1,6 @@
;;; whitespace-tests.el --- Test suite for whitespace -*- lexical-binding: t -*-
-;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2016-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/lisp/wid-edit-tests.el b/test/lisp/wid-edit-tests.el
index 4508b680232..f843649784a 100644
--- a/test/lisp/wid-edit-tests.el
+++ b/test/lisp/wid-edit-tests.el
@@ -1,6 +1,6 @@
;;; wid-edit-tests.el --- tests for wid-edit.el -*- lexical-binding: t -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -148,4 +148,189 @@
;; Check that we effectively moved the item to the last position.
(should (equal (widget-value lst) '("beg" "middle" "end"))))))
+(ert-deftest widget-test-choice-match-no-inline ()
+ "Test that a no-inline choice widget can match its values."
+ (let* ((choice '(choice (const nil) (const t) string function))
+ (widget (widget-convert choice)))
+ (should (widget-apply widget :match nil))
+ (should (widget-apply widget :match t))
+ (should (widget-apply widget :match ""))
+ (should (widget-apply widget :match 'ignore))))
+
+(ert-deftest widget-test-choice-match-all-inline ()
+ "Test that a choice widget with all inline members can match its values."
+ (let* ((lst '(list (choice (list :inline t symbol number)
+ (list :inline t symbol regexp))))
+ (widget (widget-convert lst)))
+ (should-not (widget-apply widget :match nil))
+ (should (widget-apply widget :match '(:test 2)))
+ (should (widget-apply widget :match '(:test ".*")))
+ (should-not (widget-apply widget :match '(:test ignore)))))
+
+(ert-deftest widget-test-choice-match-some-inline ()
+ "Test that a choice widget with some inline members can match its values."
+ (let* ((lst '(list string
+ (choice (const t)
+ (list :inline t symbol number)
+ (list :inline t symbol regexp))))
+ (widget (widget-convert lst)))
+ (should-not (widget-apply widget :match nil))
+ (should (widget-apply widget :match '("" t)))
+ (should (widget-apply widget :match '("" :test 2)))
+ (should (widget-apply widget :match '("" :test ".*")))
+ (should-not (widget-apply widget :match '(:test ignore)))))
+
+(ert-deftest widget-test-inline-p ()
+ "Test `widget-inline-p'.
+For widgets without an :inline t property, `widget-inline-p' has to return nil.
+But if the widget is a choice widget, it has to return nil if passed nil as
+the bubblep argument, or non-nil if one of the members of the choice widget has
+an :inline t property and we pass a non-nil bubblep argument. If no members of
+the choice widget have an :inline t property, then `widget-inline-p' has to
+return nil, even with a non-nil bubblep argument."
+ (with-temp-buffer
+ (widget-insert "Testing.\n\n")
+ (let* ((widget (widget-create 'repeat
+ :value '(nil)
+ '(choice (const nil) (const t)
+ (list :inline t symbol number))
+ '(choice (const nil) (const t)
+ (list function string))))
+ (children (widget-get widget :children))
+ (child-1 (car children))
+ (child-2 (cadr children)))
+ (should-not (widget-inline-p widget))
+ (should-not (widget-inline-p child-1))
+ (should (widget-inline-p child-1 'bubble))
+ (should-not (widget-inline-p child-2))
+ (should-not (widget-inline-p child-2 'bubble)))))
+
+(ert-deftest widget-test-repeat-can-handle-choice ()
+ "Test that we can create a repeat widget with a choice correctly."
+ (with-temp-buffer
+ (widget-insert "Testing.\n\n")
+ (let* ((widget (widget-create 'repeat
+ :entry-format "%i %d %v"
+ :value '((:test 2))
+ '(choice (const nil) (const t)
+ (list symbol number))))
+ (child (car (widget-get widget :children))))
+ (widget-insert "\n")
+ (use-local-map widget-keymap)
+ (widget-setup)
+ (should child)
+ (should (equal (widget-value widget) '((:test 2)))))))
+
+(ert-deftest widget-test-repeat-can-handle-inlinable-choice ()
+ "Test that we can create a repeat widget with an inlinable choice correctly."
+ (with-temp-buffer
+ (widget-insert "Testing.\n\n")
+ (let* ((widget (widget-create 'repeat
+ :entry-format "%i %d %v"
+ :value '(:test 2)
+ '(choice (const nil) (const t)
+ (list :inline t symbol number))))
+ (child (widget-get widget :children)))
+ (widget-insert "\n")
+ (use-local-map widget-keymap)
+ (widget-setup)
+ (should child)
+ (should (equal (widget-value widget) '(:test 2))))))
+
+(ert-deftest widget-test-list-can-handle-choice ()
+ "Test that we can create a list widget with a choice correctly."
+ (with-temp-buffer
+ (widget-insert "Testing.\n\n")
+ (let* ((widget (widget-create 'list
+ :value '((1 "One"))
+ '(choice string
+ (list number string))))
+ (child (car (widget-get widget :children))))
+ (widget-insert "\n")
+ (use-local-map widget-keymap)
+ (widget-setup)
+ (should child)
+ (should (equal (widget-value widget) '((1 "One")))))))
+
+(ert-deftest widget-test-list-can-handle-inlinable-choice ()
+ "Test that we can create a list widget with an inlinable choice correctly."
+ (with-temp-buffer
+ (widget-insert "Testing.\n\n")
+ (let* ((widget (widget-create 'list
+ :value '(1 "One")
+ '(choice string
+ (list :inline t number string))))
+ (child (car (widget-get widget :children))))
+ (widget-insert "\n")
+ (use-local-map widget-keymap)
+ (widget-setup)
+ (should child)
+ (should (equal (widget-value widget) '(1 "One"))))))
+
+(ert-deftest widget-test-option-can-handle-choice ()
+ "Test that we can create a option widget with a choice correctly."
+ (with-temp-buffer
+ (widget-insert "Testing.\n\n")
+ (let* ((widget (widget-create 'repeat
+ :value '(("foo"))
+ '(list (option
+ (choice string
+ (list :inline t
+ number string))))))
+ (child (car (widget-get widget :children))))
+ (widget-insert "\n")
+ (use-local-map widget-keymap)
+ (widget-setup)
+ (should child)
+ (should (equal (widget-value widget) '(("foo")))))))
+
+(ert-deftest widget-test-option-can-handle-inlinable-choice ()
+ "Test that we can create a option widget with an inlinable choice correctly."
+ (with-temp-buffer
+ (widget-insert "Testing.\n\n")
+ (let* ((widget (widget-create 'repeat
+ :value '((1 "One"))
+ '(list (option
+ (choice string
+ (list :inline t
+ number string))))))
+ (child (car (widget-get widget :children))))
+ (widget-insert "\n")
+ (use-local-map widget-keymap)
+ (widget-setup)
+ (should child)
+ (should (equal (widget-value widget) '((1 "One")))))))
+
+(ert-deftest widget-test-widget-move ()
+ "Test moving with `widget-forward' and `widget-backward'."
+ (with-temp-buffer
+ (dolist (el '("First" "Second" "Third"))
+ (widget-create 'push-button el))
+ (widget-insert "\n")
+ (use-local-map widget-keymap)
+ (widget-setup)
+ (goto-char (point-min))
+ ;; Check that moving from the widget's start works.
+ (widget-forward 2)
+ (should (string= "Third" (widget-value (widget-at))))
+ (widget-backward 1)
+ (should (string= "Second" (widget-value (widget-at))))
+ ;; Check that moving from inside the widget works.
+ (goto-char (point-min))
+ (widget-forward 2)
+ (forward-char)
+ (widget-backward 1)
+ (should (string= "Second" (widget-value (widget-at))))))
+
+(ert-deftest widget-test-color-match ()
+ "Test that the :match function for the color widget works."
+ (let ((widget (widget-convert 'color)))
+ (should (widget-apply widget :match "red"))
+ (should (widget-apply widget :match "#fa3"))
+ (should (widget-apply widget :match "#ff0000"))
+ (should (widget-apply widget :match "#111222333"))
+ (should (widget-apply widget :match "#111122223333"))
+ (should-not (widget-apply widget :match "someundefinedcolorihope"))
+ (should-not (widget-apply widget :match "#11223"))))
+
;;; wid-edit-tests.el ends here
diff --git a/test/lisp/xdg-tests.el b/test/lisp/xdg-tests.el
index c2a16006c35..67cd9401937 100644
--- a/test/lisp/xdg-tests.el
+++ b/test/lisp/xdg-tests.el
@@ -1,6 +1,6 @@
;;; xdg-tests.el --- tests for xdg.el -*- lexical-binding: t -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; Author: Mark Oteiza <mvoteiza@udel.edu>
;; Maintainer: emacs-devel@gnu.org
diff --git a/test/lisp/xml-tests.el b/test/lisp/xml-tests.el
index d09336c0080..cd3e1138f4b 100644
--- a/test/lisp/xml-tests.el
+++ b/test/lisp/xml-tests.el
@@ -1,6 +1,6 @@
;;; xml-parse-tests.el --- Test suite for XML parsing. -*- lexical-binding:t -*-
-;; Copyright (C) 2012-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
;; Author: Chong Yidong <cyd@stupidchicken.com>
;; Keywords: internal
diff --git a/test/lisp/xt-mouse-tests.el b/test/lisp/xt-mouse-tests.el
index 12840df13fe..72659ddf99b 100644
--- a/test/lisp/xt-mouse-tests.el
+++ b/test/lisp/xt-mouse-tests.el
@@ -1,6 +1,6 @@
;;; xt-mouse-tests.el --- Test suite for xt-mouse. -*- lexical-binding: t; -*-
-;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2016-2021 Free Software Foundation, Inc.
;; Author: Philipp Stephani <phst@google.com>
diff --git a/test/manual/biditest.el b/test/manual/biditest.el
index c4ee96a79c6..dc78ef55b03 100644
--- a/test/manual/biditest.el
+++ b/test/manual/biditest.el
@@ -1,6 +1,6 @@
;;; biditest.el --- test bidi reordering in GNU Emacs display engine.
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; Author: Eli Zaretskii
;; Maintainer: emacs-devel@gnu.org
diff --git a/test/manual/cedet/cedet-utests.el b/test/manual/cedet/cedet-utests.el
index ee6be438dd3..7805fce2d12 100644
--- a/test/manual/cedet/cedet-utests.el
+++ b/test/manual/cedet/cedet-utests.el
@@ -1,6 +1,6 @@
;;; cedet-utests.el --- Run all unit tests in the CEDET suite.
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/test/manual/cedet/ede-tests.el b/test/manual/cedet/ede-tests.el
index 0fa7539e139..eb3132398a6 100644
--- a/test/manual/cedet/ede-tests.el
+++ b/test/manual/cedet/ede-tests.el
@@ -1,6 +1,6 @@
;;; ede-tests.el --- Some tests for the Emacs Development Environment
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/test/manual/cedet/semantic-tests.el b/test/manual/cedet/semantic-tests.el
index a0899cb9326..716bcc7abed 100644
--- a/test/manual/cedet/semantic-tests.el
+++ b/test/manual/cedet/semantic-tests.el
@@ -1,6 +1,6 @@
;;; semantic-utest.el --- Miscellaneous Semantic tests.
-;;; Copyright (C) 2003-2004, 2007-2020 Free Software Foundation, Inc.
+;;; Copyright (C) 2003-2004, 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/test/manual/cedet/srecode-tests.el b/test/manual/cedet/srecode-tests.el
index 7c42dfbd000..ebc3261f817 100644
--- a/test/manual/cedet/srecode-tests.el
+++ b/test/manual/cedet/srecode-tests.el
@@ -1,6 +1,6 @@
;;; srecode-tests.el --- Some tests for CEDET's srecode
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/test/manual/cedet/tests/test-fmt.cpp b/test/manual/cedet/tests/test-fmt.cpp
index 31cd6296f3d..ab869c1ce00 100644
--- a/test/manual/cedet/tests/test-fmt.cpp
+++ b/test/manual/cedet/tests/test-fmt.cpp
@@ -1,6 +1,6 @@
/** test-fmt.cpp --- Signatures, and format answers for testing
*
- * Copyright (C) 2012, 2016, 2019-2020 Free Software Foundation
+ * Copyright (C) 2012, 2016, 2019-2021 Free Software Foundation, Inc.
*
* Author: Eric M. Ludlam <zappo@gnu.org>
*
diff --git a/test/manual/cedet/tests/test-fmt.el b/test/manual/cedet/tests/test-fmt.el
index 39641dc865c..122571323b2 100644
--- a/test/manual/cedet/tests/test-fmt.el
+++ b/test/manual/cedet/tests/test-fmt.el
@@ -1,6 +1,6 @@
;;; test-fmt.el --- test semantic tag formatting
-;;; Copyright (C) 2012, 2019-2020 Free Software Foundation, Inc.
+;;; Copyright (C) 2012, 2019-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/test/manual/cedet/tests/test.c b/test/manual/cedet/tests/test.c
index daecb544792..2cdaf4fb0ab 100644
--- a/test/manual/cedet/tests/test.c
+++ b/test/manual/cedet/tests/test.c
@@ -1,6 +1,6 @@
/* test.c --- Semantic unit test for C.
- Copyright (C) 2001-2020 Free Software Foundation, Inc.
+ Copyright (C) 2001-2021 Free Software Foundation, Inc.
Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/test/manual/cedet/tests/test.el b/test/manual/cedet/tests/test.el
index f82e3fbdbcf..3bc945d89f8 100644
--- a/test/manual/cedet/tests/test.el
+++ b/test/manual/cedet/tests/test.el
@@ -1,6 +1,6 @@
;;; test.el --- Unit test file for Semantic Emacs Lisp support.
-;; Copyright (C) 2005-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2005-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/test/manual/cedet/tests/test.make b/test/manual/cedet/tests/test.make
index 2da09841a06..9841567b6b2 100644
--- a/test/manual/cedet/tests/test.make
+++ b/test/manual/cedet/tests/test.make
@@ -1,6 +1,6 @@
# test.make --- Semantic unit test for Make -*- makefile -*-
-# Copyright (C) 2001-2002, 2010-2020 Free Software Foundation, Inc.
+# Copyright (C) 2001-2002, 2010-2021 Free Software Foundation, Inc.
# Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/test/manual/cedet/tests/test.srt b/test/manual/cedet/tests/test.srt
index 24769ec0e6e..38e6f9ed7b7 100644
--- a/test/manual/cedet/tests/test.srt
+++ b/test/manual/cedet/tests/test.srt
@@ -1,6 +1,6 @@
;; test.srt --- unit test support file for semantic-utest-ia
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/test/manual/cedet/tests/testdoublens.cpp b/test/manual/cedet/tests/testdoublens.cpp
index e25e6049c11..ea3afc72a69 100644
--- a/test/manual/cedet/tests/testdoublens.cpp
+++ b/test/manual/cedet/tests/testdoublens.cpp
@@ -1,6 +1,6 @@
// testdoublens.cpp --- semantic-ia-utest completion engine unit tests
-// Copyright (C) 2008-2020 Free Software Foundation, Inc.
+// Copyright (C) 2008-2021 Free Software Foundation, Inc.
// Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/test/manual/cedet/tests/testdoublens.hpp b/test/manual/cedet/tests/testdoublens.hpp
index 4338f285a94..e8c9b345b28 100644
--- a/test/manual/cedet/tests/testdoublens.hpp
+++ b/test/manual/cedet/tests/testdoublens.hpp
@@ -1,6 +1,6 @@
// testdoublens.hpp --- Header file used in one of the Semantic tests
-// Copyright (C) 2008-2020 Free Software Foundation, Inc.
+// Copyright (C) 2008-2021 Free Software Foundation, Inc.
// Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/test/manual/cedet/tests/testjavacomp.java b/test/manual/cedet/tests/testjavacomp.java
index 09ec4e0b7f0..bfc016903c8 100644
--- a/test/manual/cedet/tests/testjavacomp.java
+++ b/test/manual/cedet/tests/testjavacomp.java
@@ -1,6 +1,6 @@
// testjavacomp.java --- Semantic unit test for Java
-// Copyright (C) 2009-2020 Free Software Foundation, Inc.
+// Copyright (C) 2009-2021 Free Software Foundation, Inc.
// Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/test/manual/cedet/tests/testlocalvars.cpp b/test/manual/cedet/tests/testlocalvars.cpp
index f4853facf16..9d2329a0fa8 100644
--- a/test/manual/cedet/tests/testlocalvars.cpp
+++ b/test/manual/cedet/tests/testlocalvars.cpp
@@ -1,6 +1,6 @@
// testlocalvars.java --- Semantic unit test for Java
-// Copyright (C) 2009-2020 Free Software Foundation, Inc.
+// Copyright (C) 2009-2021 Free Software Foundation, Inc.
// Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/test/manual/cedet/tests/testnsp.cpp b/test/manual/cedet/tests/testnsp.cpp
index b72a44c8ca8..db1603cead2 100644
--- a/test/manual/cedet/tests/testnsp.cpp
+++ b/test/manual/cedet/tests/testnsp.cpp
@@ -1,6 +1,6 @@
/* testnsp.cpp --- semantic-ia-utest completion engine unit tests
- Copyright (C) 2008-2020 Free Software Foundation, Inc.
+ Copyright (C) 2008-2021 Free Software Foundation, Inc.
Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/test/manual/cedet/tests/testpolymorph.cpp b/test/manual/cedet/tests/testpolymorph.cpp
index 2a24a599f90..e4befcf0ff5 100644
--- a/test/manual/cedet/tests/testpolymorph.cpp
+++ b/test/manual/cedet/tests/testpolymorph.cpp
@@ -1,6 +1,6 @@
/** testpolymorph.cpp --- A sequence of polymorphism examples.
*
- * Copyright (C) 2009-2020 Free Software Foundation, Inc.
+ * Copyright (C) 2009-2021 Free Software Foundation, Inc.
*
* Author: Eric M. Ludlam <zappo@gnu.org>
*
diff --git a/test/manual/cedet/tests/testspp.c b/test/manual/cedet/tests/testspp.c
index 8acdb1ba26b..2698f48d5f9 100644
--- a/test/manual/cedet/tests/testspp.c
+++ b/test/manual/cedet/tests/testspp.c
@@ -1,6 +1,6 @@
/* testspp.cpp --- Semantic unit test for the C preprocessor
- Copyright (C) 2007-2020 Free Software Foundation, Inc.
+ Copyright (C) 2007-2021 Free Software Foundation, Inc.
Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/test/manual/cedet/tests/testsppcomplete.c b/test/manual/cedet/tests/testsppcomplete.c
index b2612fa45c8..084d6a8687d 100644
--- a/test/manual/cedet/tests/testsppcomplete.c
+++ b/test/manual/cedet/tests/testsppcomplete.c
@@ -1,6 +1,6 @@
/* testesppcomplete.cpp --- semantic-ia-utest completion engine unit tests
- Copyright (C) 2008-2020 Free Software Foundation, Inc.
+ Copyright (C) 2008-2021 Free Software Foundation, Inc.
Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/test/manual/cedet/tests/testsppreplace.c b/test/manual/cedet/tests/testsppreplace.c
index a9ea9a7428f..42a22e14b09 100644
--- a/test/manual/cedet/tests/testsppreplace.c
+++ b/test/manual/cedet/tests/testsppreplace.c
@@ -1,5 +1,5 @@
/* testsppreplace.c --- unit test for CPP/SPP Replacement
- Copyright (C) 2007-2020 Free Software Foundation, Inc.
+ Copyright (C) 2007-2021 Free Software Foundation, Inc.
Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/test/manual/cedet/tests/testsppreplaced.c b/test/manual/cedet/tests/testsppreplaced.c
index 25175426605..d546d61bff6 100644
--- a/test/manual/cedet/tests/testsppreplaced.c
+++ b/test/manual/cedet/tests/testsppreplaced.c
@@ -1,5 +1,5 @@
/* testsppreplaced.c --- unit test for CPP/SPP Replacement
- Copyright (C) 2007-2020 Free Software Foundation, Inc.
+ Copyright (C) 2007-2021 Free Software Foundation, Inc.
Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/test/manual/cedet/tests/teststruct.cpp b/test/manual/cedet/tests/teststruct.cpp
index 10217c11ac7..6659b5557b8 100644
--- a/test/manual/cedet/tests/teststruct.cpp
+++ b/test/manual/cedet/tests/teststruct.cpp
@@ -1,6 +1,6 @@
// teststruct.cpp --- semantic-ia-utest completion engine unit tests
-// Copyright (C) 2008-2020 Free Software Foundation, Inc.
+// Copyright (C) 2008-2021 Free Software Foundation, Inc.
// Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/test/manual/cedet/tests/testsubclass.cpp b/test/manual/cedet/tests/testsubclass.cpp
index 8a2e8d7e308..409950cce2f 100644
--- a/test/manual/cedet/tests/testsubclass.cpp
+++ b/test/manual/cedet/tests/testsubclass.cpp
@@ -1,6 +1,6 @@
// testsubclass.cpp --- unit test for analyzer and complex C++ inheritance
-// Copyright (C) 2007-2020 Free Software Foundation, Inc.
+// Copyright (C) 2007-2021 Free Software Foundation, Inc.
// Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/test/manual/cedet/tests/testsubclass.hh b/test/manual/cedet/tests/testsubclass.hh
index cbca24d3f64..5d795b32b10 100644
--- a/test/manual/cedet/tests/testsubclass.hh
+++ b/test/manual/cedet/tests/testsubclass.hh
@@ -1,6 +1,6 @@
// testsubclass.hh --- unit test for analyzer and complex C++ inheritance
-// Copyright (C) 2007-2020 Free Software Foundation, Inc.
+// Copyright (C) 2007-2021 Free Software Foundation, Inc.
// Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/test/manual/cedet/tests/testtemplates.cpp b/test/manual/cedet/tests/testtemplates.cpp
index 6f376e7f8ff..ed7a057df0b 100644
--- a/test/manual/cedet/tests/testtemplates.cpp
+++ b/test/manual/cedet/tests/testtemplates.cpp
@@ -1,6 +1,6 @@
// testtemplates.cpp --- semantic-ia-utest completion engine unit tests
-// Copyright (C) 2008-2020 Free Software Foundation, Inc.
+// Copyright (C) 2008-2021 Free Software Foundation, Inc.
// Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/test/manual/cedet/tests/testtypedefs.cpp b/test/manual/cedet/tests/testtypedefs.cpp
index 9d257763327..c82535f9581 100644
--- a/test/manual/cedet/tests/testtypedefs.cpp
+++ b/test/manual/cedet/tests/testtypedefs.cpp
@@ -1,6 +1,6 @@
// testtypedefs.cpp --- Sample with some fake bits out of std::string
-// Copyright (C) 2008-2020 Free Software Foundation, Inc.
+// Copyright (C) 2008-2021 Free Software Foundation, Inc.
// Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/test/manual/cedet/tests/testusing.cpp b/test/manual/cedet/tests/testusing.cpp
index df6ab2f510d..6f6c8542633 100644
--- a/test/manual/cedet/tests/testusing.cpp
+++ b/test/manual/cedet/tests/testusing.cpp
@@ -1,6 +1,6 @@
// testusing.cpp --- semantic-ia-utest completion engine unit tests
-// Copyright (C) 2008-2020 Free Software Foundation, Inc.
+// Copyright (C) 2008-2021 Free Software Foundation, Inc.
// Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/test/manual/cedet/tests/testusing.hh b/test/manual/cedet/tests/testusing.hh
index cd703f00747..d3b690f8542 100644
--- a/test/manual/cedet/tests/testusing.hh
+++ b/test/manual/cedet/tests/testusing.hh
@@ -1,6 +1,6 @@
// testusing.hh --- semantic-ia-utest completion engine unit tests
-// Copyright (C) 2008-2020 Free Software Foundation, Inc.
+// Copyright (C) 2008-2021 Free Software Foundation, Inc.
// Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/test/manual/cedet/tests/testvarnames.c b/test/manual/cedet/tests/testvarnames.c
index 940c0ffc50b..e796eb285c6 100644
--- a/test/manual/cedet/tests/testvarnames.c
+++ b/test/manual/cedet/tests/testvarnames.c
@@ -1,6 +1,6 @@
/* testvarnames.cpp --- semantic-ia-utest completion engine unit tests
- Copyright (C) 2008-2020 Free Software Foundation, Inc.
+ Copyright (C) 2008-2021 Free Software Foundation, Inc.
Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/test/manual/cedet/tests/testvarnames.java b/test/manual/cedet/tests/testvarnames.java
index c1cbf6e75a7..7ed9785fc07 100644
--- a/test/manual/cedet/tests/testvarnames.java
+++ b/test/manual/cedet/tests/testvarnames.java
@@ -1,6 +1,6 @@
// testvarnames.java --- Semantic unit test for Java
-// Copyright (C) 2009-2020 Free Software Foundation, Inc.
+// Copyright (C) 2009-2021 Free Software Foundation, Inc.
// Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/test/manual/cedet/tests/testwisent.wy b/test/manual/cedet/tests/testwisent.wy
index cc600e474c8..49eb5780f4b 100644
--- a/test/manual/cedet/tests/testwisent.wy
+++ b/test/manual/cedet/tests/testwisent.wy
@@ -1,6 +1,6 @@
;; testwisent.wy --- unit test support file for semantic-utest-ia
-;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/test/manual/etags/ETAGS.good_1 b/test/manual/etags/ETAGS.good_1
index 5451a79efaa..3de15514e79 100644
--- a/test/manual/etags/ETAGS.good_1
+++ b/test/manual/etags/ETAGS.good_1
@@ -3153,13 +3153,13 @@ tex-src/gzip.texi,303
@node Top,62,2139
@node Copying,80,2652
@node Overview,83,2705
-@node Sample,166,7272
-@node Invoking gzip,Invoking gzip210,8828
-@node Advanced usage,Advanced usage357,13496
-@node Environment,420,15208
-@node Tapes,437,15769
-@node Problems,460,16768
-@node Concept Index,Concept Index473,17288
+@node Sample,166,7273
+@node Invoking gzip,Invoking gzip210,8829
+@node Advanced usage,Advanced usage357,13497
+@node Environment,420,15209
+@node Tapes,437,15770
+@node Problems,460,16769
+@node Concept Index,Concept Index473,17289
tex-src/texinfo.tex,30627
\def\texinfoversion{\texinfoversion26,1035
diff --git a/test/manual/etags/ETAGS.good_2 b/test/manual/etags/ETAGS.good_2
index ab2111eafb2..ddb8d19540b 100644
--- a/test/manual/etags/ETAGS.good_2
+++ b/test/manual/etags/ETAGS.good_2
@@ -3726,13 +3726,13 @@ tex-src/gzip.texi,303
@node Top,62,2139
@node Copying,80,2652
@node Overview,83,2705
-@node Sample,166,7272
-@node Invoking gzip,Invoking gzip210,8828
-@node Advanced usage,Advanced usage357,13496
-@node Environment,420,15208
-@node Tapes,437,15769
-@node Problems,460,16768
-@node Concept Index,Concept Index473,17288
+@node Sample,166,7273
+@node Invoking gzip,Invoking gzip210,8829
+@node Advanced usage,Advanced usage357,13497
+@node Environment,420,15209
+@node Tapes,437,15770
+@node Problems,460,16769
+@node Concept Index,Concept Index473,17289
tex-src/texinfo.tex,30627
\def\texinfoversion{\texinfoversion26,1035
diff --git a/test/manual/etags/ETAGS.good_3 b/test/manual/etags/ETAGS.good_3
index e53fb9629c5..40be768aacb 100644
--- a/test/manual/etags/ETAGS.good_3
+++ b/test/manual/etags/ETAGS.good_3
@@ -3560,13 +3560,13 @@ tex-src/gzip.texi,303
@node Top,62,2139
@node Copying,80,2652
@node Overview,83,2705
-@node Sample,166,7272
-@node Invoking gzip,Invoking gzip210,8828
-@node Advanced usage,Advanced usage357,13496
-@node Environment,420,15208
-@node Tapes,437,15769
-@node Problems,460,16768
-@node Concept Index,Concept Index473,17288
+@node Sample,166,7273
+@node Invoking gzip,Invoking gzip210,8829
+@node Advanced usage,Advanced usage357,13497
+@node Environment,420,15209
+@node Tapes,437,15770
+@node Problems,460,16769
+@node Concept Index,Concept Index473,17289
tex-src/texinfo.tex,30627
\def\texinfoversion{\texinfoversion26,1035
diff --git a/test/manual/etags/ETAGS.good_4 b/test/manual/etags/ETAGS.good_4
index 5a4b5b4b8ba..15f67c5d28a 100644
--- a/test/manual/etags/ETAGS.good_4
+++ b/test/manual/etags/ETAGS.good_4
@@ -3317,13 +3317,13 @@ tex-src/gzip.texi,303
@node Top,62,2139
@node Copying,80,2652
@node Overview,83,2705
-@node Sample,166,7272
-@node Invoking gzip,Invoking gzip210,8828
-@node Advanced usage,Advanced usage357,13496
-@node Environment,420,15208
-@node Tapes,437,15769
-@node Problems,460,16768
-@node Concept Index,Concept Index473,17288
+@node Sample,166,7273
+@node Invoking gzip,Invoking gzip210,8829
+@node Advanced usage,Advanced usage357,13497
+@node Environment,420,15209
+@node Tapes,437,15770
+@node Problems,460,16769
+@node Concept Index,Concept Index473,17289
tex-src/texinfo.tex,30627
\def\texinfoversion{\texinfoversion26,1035
diff --git a/test/manual/etags/ETAGS.good_5 b/test/manual/etags/ETAGS.good_5
index f89cfefc388..583de5cbe22 100644
--- a/test/manual/etags/ETAGS.good_5
+++ b/test/manual/etags/ETAGS.good_5
@@ -4297,13 +4297,13 @@ tex-src/gzip.texi,303
@node Top,62,2139
@node Copying,80,2652
@node Overview,83,2705
-@node Sample,166,7272
-@node Invoking gzip,Invoking gzip210,8828
-@node Advanced usage,Advanced usage357,13496
-@node Environment,420,15208
-@node Tapes,437,15769
-@node Problems,460,16768
-@node Concept Index,Concept Index473,17288
+@node Sample,166,7273
+@node Invoking gzip,Invoking gzip210,8829
+@node Advanced usage,Advanced usage357,13497
+@node Environment,420,15209
+@node Tapes,437,15770
+@node Problems,460,16769
+@node Concept Index,Concept Index473,17289
tex-src/texinfo.tex,30627
\def\texinfoversion{\texinfoversion26,1035
diff --git a/test/manual/etags/ETAGS.good_6 b/test/manual/etags/ETAGS.good_6
index 0a31ed078e8..86df93afab1 100644
--- a/test/manual/etags/ETAGS.good_6
+++ b/test/manual/etags/ETAGS.good_6
@@ -4297,13 +4297,13 @@ tex-src/gzip.texi,303
@node Top,62,2139
@node Copying,80,2652
@node Overview,83,2705
-@node Sample,166,7272
-@node Invoking gzip,Invoking gzip210,8828
-@node Advanced usage,Advanced usage357,13496
-@node Environment,420,15208
-@node Tapes,437,15769
-@node Problems,460,16768
-@node Concept Index,Concept Index473,17288
+@node Sample,166,7273
+@node Invoking gzip,Invoking gzip210,8829
+@node Advanced usage,Advanced usage357,13497
+@node Environment,420,15209
+@node Tapes,437,15770
+@node Problems,460,16769
+@node Concept Index,Concept Index473,17289
tex-src/texinfo.tex,30627
\def\texinfoversion{\texinfoversion26,1035
diff --git a/test/manual/etags/c-src/abbrev.c b/test/manual/etags/c-src/abbrev.c
index 44563d6046a..039addc5a30 100644
--- a/test/manual/etags/c-src/abbrev.c
+++ b/test/manual/etags/c-src/abbrev.c
@@ -1,5 +1,5 @@
/* Primitives for word-abbrev mode.
- Copyright (C) 1985-1986, 1993, 1996, 1998, 2016-2020 Free Software
+ Copyright (C) 1985-1986, 1993, 1996, 1998, 2016-2021 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/test/manual/etags/c-src/emacs/src/gmalloc.c b/test/manual/etags/c-src/emacs/src/gmalloc.c
index e847e44f2a8..f56a243465b 100644
--- a/test/manual/etags/c-src/emacs/src/gmalloc.c
+++ b/test/manual/etags/c-src/emacs/src/gmalloc.c
@@ -1,5 +1,5 @@
/* Declarations for `malloc' and friends.
- Copyright (C) 1990-1993, 1995-1996, 1999, 2002-2007, 2013-2020 Free
+ Copyright (C) 1990-1993, 1995-1996, 1999, 2002-2007, 2013-2021 Free
Software Foundation, Inc.
Written May 1989 by Mike Haertel.
diff --git a/test/manual/etags/c-src/emacs/src/keyboard.c b/test/manual/etags/c-src/emacs/src/keyboard.c
index e869363152b..db86515ef09 100644
--- a/test/manual/etags/c-src/emacs/src/keyboard.c
+++ b/test/manual/etags/c-src/emacs/src/keyboard.c
@@ -1,6 +1,6 @@
/* Keyboard and mouse input; editor command loop.
-Copyright (C) 1985-1989, 1993-1997, 1999-2020 Free Software Foundation,
+Copyright (C) 1985-1989, 1993-1997, 1999-2021 Free Software Foundation,
Inc.
This file is part of GNU Emacs.
diff --git a/test/manual/etags/c-src/emacs/src/lisp.h b/test/manual/etags/c-src/emacs/src/lisp.h
index eceef4c00d1..e2744a1bf3e 100644
--- a/test/manual/etags/c-src/emacs/src/lisp.h
+++ b/test/manual/etags/c-src/emacs/src/lisp.h
@@ -1,6 +1,6 @@
/* Fundamental definitions for GNU Emacs Lisp interpreter.
-Copyright (C) 1985-1987, 1993-1995, 1997-2020 Free Software Foundation,
+Copyright (C) 1985-1987, 1993-1995, 1997-2021 Free Software Foundation,
Inc.
This file is part of GNU Emacs.
diff --git a/test/manual/etags/c-src/emacs/src/regex.h b/test/manual/etags/c-src/emacs/src/regex.h
index 367aadaffc3..3e871303ea2 100644
--- a/test/manual/etags/c-src/emacs/src/regex.h
+++ b/test/manual/etags/c-src/emacs/src/regex.h
@@ -1,7 +1,7 @@
/* Definitions for data structures and routines for the regular
expression library, version 0.12.
- Copyright (C) 1985, 1989-1993, 1995, 2000-2020 Free Software
+ Copyright (C) 1985, 1989-1993, 1995, 2000-2021 Free Software
Foundation, Inc.
This program is free software; you can redistribute it and/or modify
diff --git a/test/manual/etags/c-src/etags.c b/test/manual/etags/c-src/etags.c
index 2dd48978b12..7105ad5cba5 100644
--- a/test/manual/etags/c-src/etags.c
+++ b/test/manual/etags/c-src/etags.c
@@ -28,7 +28,7 @@ OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-Copyright (C) 1984, 1987-1989, 1993-1995, 1998-2020 Free Software
+Copyright (C) 1984, 1987-1989, 1993-1995, 1998-2021 Free Software
Foundation, Inc.
This file is not considered part of GNU Emacs.
diff --git a/test/manual/etags/c-src/exit.c b/test/manual/etags/c-src/exit.c
index 556ee93b4f2..93b3563d832 100644
--- a/test/manual/etags/c-src/exit.c
+++ b/test/manual/etags/c-src/exit.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1991, 2016-2020 Free Software Foundation, Inc.
+/* Copyright (C) 1991, 2016-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/test/manual/etags/c-src/exit.strange_suffix b/test/manual/etags/c-src/exit.strange_suffix
index 556ee93b4f2..93b3563d832 100644
--- a/test/manual/etags/c-src/exit.strange_suffix
+++ b/test/manual/etags/c-src/exit.strange_suffix
@@ -1,4 +1,4 @@
-/* Copyright (C) 1991, 2016-2020 Free Software Foundation, Inc.
+/* Copyright (C) 1991, 2016-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/test/manual/etags/c-src/getopt.h b/test/manual/etags/c-src/getopt.h
index eff9032b532..ec74c836f10 100644
--- a/test/manual/etags/c-src/getopt.h
+++ b/test/manual/etags/c-src/getopt.h
@@ -1,5 +1,5 @@
/* Declarations for getopt.
- Copyright (C) 1989-1992, 2016-2020 Free Software Foundation, Inc.
+ Copyright (C) 1989-1992, 2016-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
diff --git a/test/manual/etags/c-src/sysdep.h b/test/manual/etags/c-src/sysdep.h
index 3cafc9ee92e..187692f5c7c 100644
--- a/test/manual/etags/c-src/sysdep.h
+++ b/test/manual/etags/c-src/sysdep.h
@@ -1,4 +1,4 @@
-/* Copyright (C) 1992-1993, 2016-2020 Free Software Foundation, Inc.
+/* Copyright (C) 1992-1993, 2016-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/test/manual/etags/el-src/emacs/lisp/progmodes/etags.el b/test/manual/etags/el-src/emacs/lisp/progmodes/etags.el
index 3a999864f86..36f6624472d 100644
--- a/test/manual/etags/el-src/emacs/lisp/progmodes/etags.el
+++ b/test/manual/etags/el-src/emacs/lisp/progmodes/etags.el
@@ -1,6 +1,6 @@
;;; etags.el --- etags facility for Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1986, 1988-1989, 1992-1996, 1998, 2000-2020 Free
+;; Copyright (C) 1985-1986, 1988-1989, 1992-1996, 1998, 2000-2021 Free
;; Software Foundation, Inc.
;; Author: Roland McGrath <roland@gnu.org>
diff --git a/test/manual/etags/tex-src/texinfo.tex b/test/manual/etags/tex-src/texinfo.tex
index 8d84f513ba5..a04371d1c90 100644
--- a/test/manual/etags/tex-src/texinfo.tex
+++ b/test/manual/etags/tex-src/texinfo.tex
@@ -1,6 +1,6 @@
%% TeX macros to handle texinfo files
-% Copyright (C) 1985--1986, 1988, 1990--1991, 2016--2020 Free Software
+% Copyright (C) 1985--1986, 1988, 1990--1991, 2016--2021 Free Software
% Foundation, Inc.
%This texinfo.tex file is free software; you can redistribute it and/or
diff --git a/test/manual/etags/y-src/cccp.c b/test/manual/etags/y-src/cccp.c
index 89241cdc395..7156414b64e 100644
--- a/test/manual/etags/y-src/cccp.c
+++ b/test/manual/etags/y-src/cccp.c
@@ -320,7 +320,7 @@ static const short yycheck[] =
#line 3 "/usr/share/bison/bison.simple"
/* Skeleton output parser for bison,
- Copyright (C) 1984, 1989-1990, 2000-2001, 2016-2020 Free Software
+ Copyright (C) 1984, 1989-1990, 2000-2001, 2016-2021 Free Software
Foundation, Inc.
This program is free software; you can redistribute it and/or modify
diff --git a/test/manual/etags/y-src/parse.c b/test/manual/etags/y-src/parse.c
index 0415c4a1180..f90d31505f0 100644
--- a/test/manual/etags/y-src/parse.c
+++ b/test/manual/etags/y-src/parse.c
@@ -28,7 +28,7 @@
#line 1 "y-src/parse.y"
-/* Copyright (C) 1990, 1992-1993, 2016-2020 Free Software Foundation,
+/* Copyright (C) 1990, 1992-1993, 2016-2021 Free Software Foundation,
* Inc.
This file is part of Oleo, the GNU Spreadsheet.
diff --git a/test/manual/etags/y-src/parse.y b/test/manual/etags/y-src/parse.y
index eeef44cc6eb..7985da525be 100644
--- a/test/manual/etags/y-src/parse.y
+++ b/test/manual/etags/y-src/parse.y
@@ -1,5 +1,5 @@
%{
-/* Copyright (C) 1990, 1992-1993, 2016-2020 Free Software Foundation,
+/* Copyright (C) 1990, 1992-1993, 2016-2021 Free Software Foundation,
* Inc.
This file is part of Oleo, the GNU Spreadsheet.
diff --git a/test/manual/image-circular-tests.el b/test/manual/image-circular-tests.el
index 33ea3ea9547..3d1d23234b7 100644
--- a/test/manual/image-circular-tests.el
+++ b/test/manual/image-circular-tests.el
@@ -1,6 +1,6 @@
-;;; image-tests.el --- Test suite for image-related functions.
+;;; image-circular-tests.el --- test image functions with circular objects
-;; Copyright (C) 2019 Free Software Foundation, Inc.
+;; Copyright (C) 2019, 2021 Free Software Foundation, Inc.
;; Author: Pip Cet <pipcet@gmail.com>
;; Keywords: internal
@@ -61,84 +61,5 @@
(and (equal (image-size spec1 t) (cons 1 1))
(equal (image-size spec2 t) (cons 1 1))))))
-(provide 'image-tests)
-;;; image-tests.el ends here.
-;;; image-tests.el --- tests for image.el -*- lexical-binding: t -*-
-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Code:
-
-(require 'ert)
-(require 'image)
-(eval-when-compile
- (require 'cl-lib))
-
-(defconst image-tests--emacs-images-directory
- (expand-file-name "../etc/images" (getenv "EMACS_TEST_DIRECTORY"))
- "Directory containing Emacs images.")
-
-(ert-deftest image--set-property ()
- "Test `image--set-property' behavior."
- (let ((image (list 'image)))
- ;; Add properties.
- (setf (image-property image :scale) 1)
- (should (equal image '(image :scale 1)))
- (setf (image-property image :width) 8)
- (should (equal image '(image :scale 1 :width 8)))
- (setf (image-property image :height) 16)
- (should (equal image '(image :scale 1 :width 8 :height 16)))
- ;; Delete properties.
- (setf (image-property image :type) nil)
- (should (equal image '(image :scale 1 :width 8 :height 16)))
- (setf (image-property image :scale) nil)
- (should (equal image '(image :width 8 :height 16)))
- (setf (image-property image :height) nil)
- (should (equal image '(image :width 8)))
- (setf (image-property image :width) nil)
- (should (equal image '(image)))))
-
-(ert-deftest image-type-from-file-header-test ()
- "Test image-type-from-file-header."
- (should (eq (if (image-type-available-p 'svg) 'svg)
- (image-type-from-file-header
- (expand-file-name "splash.svg"
- image-tests--emacs-images-directory)))))
-
-(ert-deftest image-rotate ()
- "Test `image-rotate'."
- (cl-letf* ((image (list 'image))
- ((symbol-function 'image--get-imagemagick-and-warn)
- (lambda () image)))
- (let ((current-prefix-arg '(4)))
- (call-interactively #'image-rotate))
- (should (equal image '(image :rotation 270.0)))
- (call-interactively #'image-rotate)
- (should (equal image '(image :rotation 0.0)))
- (image-rotate)
- (should (equal image '(image :rotation 90.0)))
- (image-rotate 0)
- (should (equal image '(image :rotation 90.0)))
- (image-rotate 1)
- (should (equal image '(image :rotation 91.0)))
- (image-rotate 1234.5)
- (should (equal image '(image :rotation 245.5)))
- (image-rotate -154.5)
- (should (equal image '(image :rotation 91.0)))))
-
-;;; image-tests.el ends here
+(provide 'image-circular-tests)
+;;; image-circular-tests.el ends here.
diff --git a/test/manual/image-size-tests.el b/test/manual/image-size-tests.el
index 159e9025ae3..489b3972932 100644
--- a/test/manual/image-size-tests.el
+++ b/test/manual/image-size-tests.el
@@ -1,6 +1,6 @@
;;; image-size-tests.el -- tests for image scaling
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/manual/image-transforms-tests.el b/test/manual/image-transforms-tests.el
index 13d74a7c4b5..5342b5edcae 100644
--- a/test/manual/image-transforms-tests.el
+++ b/test/manual/image-transforms-tests.el
@@ -1,6 +1,6 @@
;;; image-transform-tests.el --- Test suite for image transforms. -*- lexical-binding: t -*-
-;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; Author: Alan Third <alan@idiocy.org>
;; Keywords: internal
diff --git a/test/manual/indent/pascal.pas b/test/manual/indent/pascal.pas
index 35ee5215a59..a166eedbc5d 100644
--- a/test/manual/indent/pascal.pas
+++ b/test/manual/indent/pascal.pas
@@ -1,6 +1,6 @@
{ GPC demo program for the CRT unit.
-Copyright (C) 1999-2006, 2013-2020 Free Software Foundation, Inc.
+Copyright (C) 1999-2006, 2013-2021 Free Software Foundation, Inc.
Author: Frank Heckenbach <frank@pascal.gnu.de>
diff --git a/test/manual/indent/perl.perl b/test/manual/indent/perl.perl
index 853aec49245..6ec04303b4f 100755
--- a/test/manual/indent/perl.perl
+++ b/test/manual/indent/perl.perl
@@ -81,3 +81,17 @@ return 'W' if #/^Not Available on Mobile/m; #W=Web only
# A "y|abc|def|" shouldn't interfere when inside a string!
$toto = " x \" string\"";
$toto = " y \" string\""; # This is not the `y' operator!
+
+
+# Tricky cases from Harald Jörg <haj@posteo.de>
+$_ = "abcabc\n";
+s:abc:def:g; # FIXME: the initial s is fontified like a label, and indented
+
+s'def'ghi'g; # The middle ' should not end the quoting.
+s"ghi"ijk"g; # The middle ' should not end the quoting.
+
+s#ijk#lmn#g; # This is a regular expression sustitution.
+
+s #lmn#opq#g; # FIXME: this should be a comment starting with "#lmn"
+ /lmn/rst/g; # and this is the actual regular expression
+print; # prints "rstrst\n"
diff --git a/test/manual/indent/tcl.tcl b/test/manual/indent/tcl.tcl
index c3781533ca4..f055be19663 100644
--- a/test/manual/indent/tcl.tcl
+++ b/test/manual/indent/tcl.tcl
@@ -20,3 +20,7 @@ proc foo3 {} {
puts a""b"; # And that won't either!
puts "a""b"; # But this will!
}
+
+# FIXME: The [..] interpolation within "..." strings is not properly
+# handled by the current `syntax-propertize-function`!
+set a "Testing: [split "192.168.1.1/24" "/"] address";
diff --git a/test/manual/redisplay-testsuite.el b/test/manual/redisplay-testsuite.el
index 46f4a923296..48f3788b54e 100644
--- a/test/manual/redisplay-testsuite.el
+++ b/test/manual/redisplay-testsuite.el
@@ -1,6 +1,6 @@
;;; redisplay-testsuite.el --- Test suite for redisplay.
-;; Copyright (C) 2009-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Chong Yidong <cyd@stupidchicken.com>
;; Keywords: internal
diff --git a/test/manual/scroll-tests.el b/test/manual/scroll-tests.el
index 937e0b12799..2f40b2bb696 100644
--- a/test/manual/scroll-tests.el
+++ b/test/manual/scroll-tests.el
@@ -1,6 +1,6 @@
;;; scroll-tests.el -- tests for scrolling -*- lexical-binding: t -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/src/alloc-tests.el b/test/src/alloc-tests.el
index aa1ab1648f8..1324c2d3b4d 100644
--- a/test/src/alloc-tests.el
+++ b/test/src/alloc-tests.el
@@ -1,6 +1,6 @@
;;; alloc-tests.el --- alloc tests -*- lexical-binding: t -*-
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Author: Daniel Colascione <dancol@dancol.org>
;; Keywords:
diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el
index 0db66f97517..123f2e8eabb 100644
--- a/test/src/buffer-tests.el
+++ b/test/src/buffer-tests.el
@@ -1,6 +1,6 @@
;;; buffer-tests.el --- tests for buffer.c functions -*- lexical-binding: t -*-
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -19,9 +19,7 @@
;;; Code:
-(require 'ert)
-(require 'seq)
-(eval-when-compile (require 'cl-lib))
+(require 'cl-lib)
(ert-deftest overlay-modification-hooks-message-other-buf ()
"Test for bug#21824.
@@ -1334,4 +1332,33 @@ with parameters from the *Messages* buffer modification."
(with-temp-buffer
(should (assq 'buffer-undo-list (buffer-local-variables)))))
+(ert-deftest buffer-tests-inhibit-buffer-hooks ()
+ "Test `get-buffer-create' argument INHIBIT-BUFFER-HOOKS."
+ (let* (run-bluh (bluh (lambda () (setq run-bluh t))))
+ (unwind-protect
+ (let* ( run-kbh (kbh (lambda () (setq run-kbh t)))
+ run-kbqf (kbqf (lambda () (setq run-kbqf t))) )
+
+ ;; Inhibited.
+ (add-hook 'buffer-list-update-hook bluh)
+ (with-current-buffer (generate-new-buffer " foo" t)
+ (add-hook 'kill-buffer-hook kbh nil t)
+ (add-hook 'kill-buffer-query-functions kbqf nil t)
+ (kill-buffer))
+ (with-temp-buffer)
+ (with-output-to-string)
+ (should-not run-bluh)
+ (should-not run-kbh)
+ (should-not run-kbqf)
+
+ ;; Not inhibited.
+ (with-current-buffer (generate-new-buffer " foo")
+ (should run-bluh)
+ (add-hook 'kill-buffer-hook kbh nil t)
+ (add-hook 'kill-buffer-query-functions kbqf nil t)
+ (kill-buffer))
+ (should run-kbh)
+ (should run-kbqf))
+ (remove-hook 'buffer-list-update-hook bluh))))
+
;;; buffer-tests.el ends here
diff --git a/test/src/callint-tests.el b/test/src/callint-tests.el
index 42dae424476..0df58877102 100644
--- a/test/src/callint-tests.el
+++ b/test/src/callint-tests.el
@@ -1,6 +1,6 @@
;;; callint-tests.el --- unit tests for callint.c -*- lexical-binding: t; -*-
-;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2018-2021 Free Software Foundation, Inc.
;; Author: Philipp Stephani <phst@google.com>
diff --git a/test/src/callproc-tests.el b/test/src/callproc-tests.el
index 1617d5e33d3..7262abbe0d0 100644
--- a/test/src/callproc-tests.el
+++ b/test/src/callproc-tests.el
@@ -1,6 +1,6 @@
;;; callproc-tests.el --- callproc.c tests -*- lexical-binding: t -*-
-;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2016-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/src/casefiddle-tests.el b/test/src/casefiddle-tests.el
index 7abb79eadde..9fa54dcaf43 100644
--- a/test/src/casefiddle-tests.el
+++ b/test/src/casefiddle-tests.el
@@ -1,6 +1,6 @@
;;; casefiddle-tests.el --- tests for casefiddle.c functions -*- lexical-binding: t -*-
-;; Copyright (C) 2015-2016, 2018-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2016, 2018-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -247,7 +247,8 @@
;; input upcase downcase [titlecase]
(dolist (test '((?a ?A ?a) (?A ?A ?a)
(?ł ?Ł ?ł) (?Ł ?Ł ?ł)
- (?ß ?ß ?ß) (?ẞ ?ẞ ?ß)
+ ;; We char-upcase ß to ẞ; see bug #11309.
+ (?ß ?ẞ ?ß) (?ẞ ?ẞ ?ß)
(?ⅷ ?Ⅷ ?ⅷ) (?Ⅷ ?Ⅷ ?ⅷ)
(?DŽ ?DŽ ?dž ?Dž) (?Dž ?DŽ ?dž ?Dž) (?dž ?DŽ ?dž ?Dž)))
(let ((ch (car test))
diff --git a/test/src/charset-tests.el b/test/src/charset-tests.el
index 86a0d6ffc1a..5c46627c163 100644
--- a/test/src/charset-tests.el
+++ b/test/src/charset-tests.el
@@ -1,6 +1,6 @@
;;; charset-tests.el --- Tests for charset.c -*- lexical-binding: t -*-
-;; Copyright 2017-2020 Free Software Foundation, Inc.
+;; Copyright 2017-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/src/chartab-tests.el b/test/src/chartab-tests.el
index 4d52dc367c8..bf37fb51cf5 100644
--- a/test/src/chartab-tests.el
+++ b/test/src/chartab-tests.el
@@ -1,6 +1,6 @@
;;; chartab-tests.el --- Tests for char-tab.c -*- lexical-binding: t -*-
-;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2016-2021 Free Software Foundation, Inc.
;; Author: Eli Zaretskii <eliz@gnu.org>
@@ -49,5 +49,25 @@
(#xe0e00 . #xe0ef6)
)))
+(ert-deftest chartab-test-char-table-p ()
+ (should (char-table-p (make-char-table 'foo)))
+ (should (not (char-table-p (make-hash-table)))))
+
+(ert-deftest chartab-test-char-table-subtype ()
+ (should (eq (char-table-subtype (make-char-table 'foo)) 'foo)))
+
+(ert-deftest chartab-test-char-table-parent ()
+ (should (eq (char-table-parent (make-char-table 'foo)) nil))
+ (let ((parent (make-char-table 'foo))
+ (child (make-char-table 'bar)))
+ (set-char-table-parent child parent)
+ (should (eq (char-table-parent child) parent))))
+
+(ert-deftest chartab-test-char-table-extra-slot ()
+ ;; Use any type with extra slots, e.g. 'case-table.
+ (let ((tbl (make-char-table 'case-table)))
+ (set-char-table-extra-slot tbl 1 'bar)
+ (should (eq (char-table-extra-slot tbl 1) 'bar))))
+
(provide 'chartab-tests)
;;; chartab-tests.el ends here
diff --git a/test/src/cmds-tests.el b/test/src/cmds-tests.el
index 302b00c6760..681bfb30164 100644
--- a/test/src/cmds-tests.el
+++ b/test/src/cmds-tests.el
@@ -1,6 +1,6 @@
;;; cmds-tests.el --- Testing some Emacs commands -*- lexical-binding: t -*-
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; Author: Nicolas Richard <youngfrog@members.fsf.org>
;; Keywords:
diff --git a/test/src/coding-tests.el b/test/src/coding-tests.el
index 82883a045c8..0bdcff22ce5 100644
--- a/test/src/coding-tests.el
+++ b/test/src/coding-tests.el
@@ -1,6 +1,6 @@
;;; coding-tests.el --- tests for text encoding and decoding -*- lexical-binding: t -*-
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; Author: Eli Zaretskii <eliz@gnu.org>
;; Author: Kenichi Handa <handa@gnu.org>
diff --git a/test/src/data-tests.el b/test/src/data-tests.el
index ed092039078..03d867f18a8 100644
--- a/test/src/data-tests.el
+++ b/test/src/data-tests.el
@@ -1,6 +1,6 @@
;;; data-tests.el --- tests for src/data.c -*- lexical-binding:t -*-
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -324,7 +324,7 @@ comparing the subr with a much slower lisp implementation."
(defvar binding-test-some-local 'some)
(with-current-buffer binding-test-buffer-A
- (set (make-local-variable 'binding-test-some-local) 'local))
+ (setq-local binding-test-some-local 'local))
(ert-deftest binding-test-manual ()
"A test case from the elisp manual."
@@ -345,6 +345,25 @@ comparing the subr with a much slower lisp implementation."
(setq-default binding-test-some-local 'new-default))
(should (eq binding-test-some-local 'some))))
+(ert-deftest data-tests--let-buffer-local ()
+ (let ((blvar (make-symbol "blvar")))
+ (set-default blvar nil)
+ (make-variable-buffer-local blvar)
+
+ (dolist (var (list blvar 'left-margin))
+ (let ((def (default-value var)))
+ (with-temp-buffer
+ (should (equal def (symbol-value var)))
+ (cl-progv (list var) (list 42)
+ (should (equal (symbol-value var) 42))
+ (should (equal (default-value var) (symbol-value var)))
+ (set var 123)
+ (should (equal (symbol-value var) 123))
+ (should (equal (default-value var) (symbol-value var)))) ;bug#44733
+ (should (equal (symbol-value var) def))
+ (should (equal (default-value var) (symbol-value var))))
+ (should (equal (default-value var) def))))))
+
(ert-deftest binding-test-makunbound ()
"Tests of makunbound, from the manual."
(with-current-buffer binding-test-buffer-B
@@ -381,6 +400,37 @@ comparing the subr with a much slower lisp implementation."
"Test setting a keyword to itself"
(with-no-warnings (should (setq :keyword :keyword))))
+(ert-deftest data-tests--set-default-per-buffer ()
+ :expected-result t ;; Not fixed yet!
+ ;; FIXME: Performance tests are inherently unreliable.
+ ;; Using wall-clock time makes it even worse, so don't bother unless
+ ;; we have the primitive to measure cpu-time.
+ (skip-unless (fboundp 'current-cpu-time))
+ ;; Test performance of set-default on DEFVAR_PER_BUFFER variables.
+ ;; More specifically, test the problem seen in bug#41029 where setting
+ ;; the default value of a variable takes time proportional to the
+ ;; number of buffers.
+ (let* ((fun #'error)
+ (test (lambda ()
+ (with-temp-buffer
+ (let ((st (car (current-cpu-time))))
+ (dotimes (_ 1000)
+ (let ((case-fold-search 'data-test))
+ ;; Use an indirection through a mutable var
+ ;; to try and make sure the byte-compiler
+ ;; doesn't optimize away the let bindings.
+ (funcall fun)))
+ ;; FIXME: Handle the wraparound, if any.
+ (- (car (current-cpu-time)) st)))))
+ (_ (setq fun #'ignore))
+ (time1 (funcall test))
+ (bufs (mapcar (lambda (_) (generate-new-buffer " data-test"))
+ (make-list 1000 nil)))
+ (time2 (funcall test)))
+ (mapc #'kill-buffer bufs)
+ ;; Don't divide one time by the other since they may be 0.
+ (should (< time2 (* time1 5)))))
+
;; More tests to write -
;; kill-local-variable
;; defconst; can modify
diff --git a/test/src/decompress-tests.el b/test/src/decompress-tests.el
index 0a328396818..520445cca5a 100644
--- a/test/src/decompress-tests.el
+++ b/test/src/decompress-tests.el
@@ -1,6 +1,6 @@
;;; decompress-tests.el --- Test suite for decompress. -*- lexical-binding: t -*-
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; Author: Lars Ingebrigtsen <larsi@gnus.org>
@@ -29,16 +29,16 @@
(ert-deftest zlib--decompress ()
"Test decompressing a gzipped file."
- (when (and (fboundp 'zlib-available-p)
- (zlib-available-p))
- (should (string=
- (with-temp-buffer
- (set-buffer-multibyte nil)
- (insert-file-contents-literally
- (expand-file-name "foo.gz" zlib-tests-data-directory))
- (zlib-decompress-region (point-min) (point-max))
- (buffer-string))
- "foo\n"))))
+ (skip-unless (and (fboundp 'zlib-available-p)
+ (zlib-available-p)))
+ (should (string=
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert-file-contents-literally
+ (expand-file-name "foo.gz" zlib-tests-data-directory))
+ (zlib-decompress-region (point-min) (point-max))
+ (buffer-string))
+ "foo\n")))
(provide 'decompress-tests)
diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el
index de0aeabfe78..64f9137865b 100644
--- a/test/src/editfns-tests.el
+++ b/test/src/editfns-tests.el
@@ -1,6 +1,6 @@
;;; editfns-tests.el -- tests for editfns.c -*- lexical-binding:t -*-
-;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2016-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/src/emacs-module-resources/mod-test.c b/test/src/emacs-module-resources/mod-test.c
index 258a679b207..ad59cfc18cd 100644
--- a/test/src/emacs-module-resources/mod-test.c
+++ b/test/src/emacs-module-resources/mod-test.c
@@ -1,6 +1,6 @@
/* Test GNU Emacs modules.
-Copyright 2015-2020 Free Software Foundation, Inc.
+Copyright 2015-2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -24,6 +24,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <errno.h>
#include <limits.h>
+#include <stdbool.h>
#include <stdint.h>
#include <stdio.h>
#include <stdlib.h>
@@ -691,6 +692,42 @@ Fmod_test_identity (emacs_env *env, ptrdiff_t nargs, emacs_value *args,
return args[0];
}
+static emacs_value
+Fmod_test_funcall (emacs_env *env, ptrdiff_t nargs, emacs_value *args,
+ void *data)
+{
+ assert (0 < nargs);
+ return env->funcall (env, args[0], nargs - 1, args + 1);
+}
+
+static emacs_value
+Fmod_test_make_string (emacs_env *env, ptrdiff_t nargs,
+ emacs_value *args, void *data)
+{
+ assert (nargs == 2);
+ intmax_t length_arg = env->extract_integer (env, args[0]);
+ if (env->non_local_exit_check (env) != emacs_funcall_exit_return)
+ return args[0];
+ if (length_arg < 0 || SIZE_MAX < length_arg)
+ {
+ signal_error (env, "Invalid string length");
+ return args[0];
+ }
+ size_t length = (size_t) length_arg;
+ bool multibyte = env->is_not_nil (env, args[1]);
+ char *buffer = length == 0 ? NULL : malloc (length);
+ if (buffer == NULL && length != 0)
+ {
+ memory_full (env);
+ return args[0];
+ }
+ memset (buffer, 'a', length);
+ emacs_value ret = multibyte ? env->make_string (env, buffer, length)
+ : env->make_unibyte_string (env, buffer, length);
+ free (buffer);
+ return ret;
+}
+
/* Lisp utilities for easier readability (simple wrappers). */
/* Provide FEATURE to Emacs. */
@@ -780,6 +817,9 @@ emacs_module_init (struct emacs_runtime *ert)
DEFUN ("mod-test-function-finalizer-calls",
Fmod_test_function_finalizer_calls, 0, 0, NULL, NULL);
DEFUN ("mod-test-async-pipe", Fmod_test_async_pipe, 1, 1, NULL, NULL);
+ DEFUN ("mod-test-funcall", Fmod_test_funcall, 1, emacs_variadic_function,
+ NULL, NULL);
+ DEFUN ("mod-test-make-string", Fmod_test_make_string, 2, 2, NULL, NULL);
#undef DEFUN
@@ -796,6 +836,12 @@ emacs_module_init (struct emacs_runtime *ert)
strlen (interactive_spec)));
bind_function (env, "mod-test-identity", identity_fn);
+ /* We allocate lots of values to trigger bugs in the frame allocator during
+ initialization. */
+ int count = 10000; /* larger than value_frame_size in emacs-module.c */
+ for (int i = 0; i < count; ++i)
+ env->make_integer (env, i);
+
provide (env, "mod-test");
return 0;
}
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el
index fb4ed4a6842..af5bc2a0baf 100644
--- a/test/src/emacs-module-tests.el
+++ b/test/src/emacs-module-tests.el
@@ -1,6 +1,6 @@
;;; emacs-module-tests --- Test GNU Emacs modules. -*- lexical-binding: t; -*-
-;; Copyright 2015-2020 Free Software Foundation, Inc.
+;; Copyright 2015-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -30,6 +30,7 @@
(require 'ert)
(require 'ert-x)
(require 'help-fns)
+(require 'subr-x)
(defconst mod-test-emacs
(expand-file-name invocation-name invocation-directory)
@@ -506,4 +507,73 @@ See Bug#36226."
(should (not (multibyte-string-p (mod-test-return-unibyte))))
(should (equal result "foo\x00zot"))))
+(cl-defstruct (emacs-module-tests--variable
+ (:constructor nil)
+ (:constructor emacs-module-tests--make-variable
+ (name
+ &aux
+ (mutex (make-mutex name))
+ (condvar (make-condition-variable mutex name))))
+ (:copier nil))
+ "A variable that's protected by a mutex."
+ value
+ (mutex nil :read-only t :type mutex)
+ (condvar nil :read-only t :type condition-variable))
+
+(defun emacs-module-tests--wait-for-variable (variable desired)
+ (with-mutex (emacs-module-tests--variable-mutex variable)
+ (while (not (eq (emacs-module-tests--variable-value variable) desired))
+ (condition-wait (emacs-module-tests--variable-condvar variable)))))
+
+(defun emacs-module-tests--change-variable (variable new)
+ (with-mutex (emacs-module-tests--variable-mutex variable)
+ (setf (emacs-module-tests--variable-value variable) new)
+ (condition-notify (emacs-module-tests--variable-condvar variable) :all)))
+
+(ert-deftest emacs-module-tests/interleaved-threads ()
+ (let* ((state-1 (emacs-module-tests--make-variable "1"))
+ (state-2 (emacs-module-tests--make-variable "2"))
+ (thread-1
+ (make-thread
+ (lambda ()
+ (emacs-module-tests--change-variable state-1 'before-module)
+ (mod-test-funcall
+ (lambda ()
+ (emacs-module-tests--change-variable state-1 'in-module)
+ (emacs-module-tests--wait-for-variable state-2 'in-module)))
+ (emacs-module-tests--change-variable state-1 'after-module))
+ "thread 1"))
+ (thread-2
+ (make-thread
+ (lambda ()
+ (emacs-module-tests--change-variable state-2 'before-module)
+ (emacs-module-tests--wait-for-variable state-1 'in-module)
+ (mod-test-funcall
+ (lambda ()
+ (emacs-module-tests--change-variable state-2 'in-module)
+ (emacs-module-tests--wait-for-variable state-1 'after-module)))
+ (emacs-module-tests--change-variable state-2 'after-module))
+ "thread 2")))
+ (thread-join thread-1)
+ (thread-join thread-2)))
+
+(ert-deftest mod-test-make-string/empty ()
+ (dolist (multibyte '(nil t))
+ (ert-info ((format "Multibyte: %s" multibyte))
+ (let ((got (mod-test-make-string 0 multibyte)))
+ (should (stringp got))
+ (should (string-empty-p got))
+ (should (eq (multibyte-string-p got) multibyte))))))
+
+(ert-deftest mod-test-make-string/nonempty ()
+ (dolist (multibyte '(nil t))
+ (ert-info ((format "Multibyte: %s" multibyte))
+ (let ((first (mod-test-make-string 1 multibyte))
+ (second (mod-test-make-string 1 multibyte)))
+ (should (stringp first))
+ (should (eql (length first) 1))
+ (should (eq (multibyte-string-p first) multibyte))
+ (should (string-equal first second))
+ (should-not (eq first second))))))
+
;;; emacs-module-tests.el ends here
diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el
index 074f5be1ef9..b2b7dfefda5 100644
--- a/test/src/eval-tests.el
+++ b/test/src/eval-tests.el
@@ -1,6 +1,6 @@
;;; eval-tests.el --- unit tests for src/eval.c -*- lexical-binding: t; -*-
-;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2016-2021 Free Software Foundation, Inc.
;; Author: Philipp Stephani <phst@google.com>
@@ -27,6 +27,7 @@
(require 'ert)
(eval-when-compile (require 'cl-lib))
+(require 'subr-x)
(ert-deftest eval-tests--bug24673 ()
"Check that Bug#24673 has been fixed."
@@ -176,4 +177,53 @@ in Common Lisp). Instead, make sure substitution in backquote
expressions works for identifiers starting with period."
(should (equal (let ((.x 'identity)) (eval `(,.x 'ok))) 'ok)))
+(ert-deftest eval-tests/backtrace-in-batch-mode ()
+ (let ((emacs (expand-file-name invocation-name invocation-directory)))
+ (skip-unless (file-executable-p emacs))
+ (with-temp-buffer
+ (let ((status (call-process emacs nil t nil
+ "--quick" "--batch"
+ (concat "--eval="
+ (prin1-to-string
+ '(progn
+ (defun foo () (error "Boo"))
+ (foo)))))))
+ (should (natnump status))
+ (should-not (eql status 0)))
+ (goto-char (point-min))
+ (ert-info ((concat "Process output:\n" (buffer-string)))
+ (search-forward " foo()")
+ (search-forward " normal-top-level()")))))
+
+(ert-deftest eval-tests/backtrace-in-batch-mode/inhibit ()
+ (let ((emacs (expand-file-name invocation-name invocation-directory)))
+ (skip-unless (file-executable-p emacs))
+ (with-temp-buffer
+ (let ((status (call-process
+ emacs nil t nil
+ "--quick" "--batch"
+ (concat "--eval="
+ (prin1-to-string
+ '(progn
+ (defun foo () (error "Boo"))
+ (let ((backtrace-on-error-noninteractive nil))
+ (foo))))))))
+ (should (natnump status))
+ (should-not (eql status 0)))
+ (should (equal (string-trim (buffer-string)) "Boo")))))
+
+(ert-deftest eval-tests/backtrace-in-batch-mode/demoted-errors ()
+ (let ((emacs (expand-file-name invocation-name invocation-directory)))
+ (skip-unless (file-executable-p emacs))
+ (with-temp-buffer
+ (should (eql 0 (call-process emacs nil t nil
+ "--quick" "--batch"
+ (concat "--eval="
+ (prin1-to-string
+ '(with-demoted-errors "Error: %S"
+ (error "Boo")))))))
+ (goto-char (point-min))
+ (should (equal (string-trim (buffer-string))
+ "Error: (error \"Boo\")")))))
+
;;; eval-tests.el ends here
diff --git a/test/src/fileio-tests.el b/test/src/fileio-tests.el
index ed381d151ee..7f193d4eeab 100644
--- a/test/src/fileio-tests.el
+++ b/test/src/fileio-tests.el
@@ -1,6 +1,6 @@
;;; unit tests for src/fileio.c -*- lexical-binding: t; -*-
-;; Copyright 2017-2020 Free Software Foundation, Inc.
+;; Copyright 2017-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -155,3 +155,9 @@ Also check that an encoding error can appear in a symlink."
(write-region "hello\n" nil f nil 'silent)
(should-error (insert-file-contents f) :type 'circular-list)
(delete-file f)))
+
+(ert-deftest fileio-tests/null-character ()
+ (should-error (file-exists-p "/foo\0bar")
+ :type 'wrong-type-argument))
+
+;;; fileio-tests.el ends here
diff --git a/test/src/floatfns-tests.el b/test/src/floatfns-tests.el
index 8c56674d4fd..4a3c03d833e 100644
--- a/test/src/floatfns-tests.el
+++ b/test/src/floatfns-tests.el
@@ -1,6 +1,6 @@
;;; floatfns-tests.el --- tests for floating point operations -*- lexical-binding: t -*-
-;; Copyright 2017-2020 Free Software Foundation, Inc.
+;; Copyright 2017-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index d3c22f966e6..e0aed2a71b6 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -1,6 +1,6 @@
;;; fns-tests.el --- tests for src/fns.c -*- lexical-binding:t -*-
-;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -938,6 +938,13 @@
(should (equal (string-search "\303" "aøb") nil))
(should (equal (string-search "\270" "aøb") nil))
(should (equal (string-search "ø" "\303\270") nil))
+ (should (equal (string-search "ø" (make-string 32 ?a)) nil))
+ (should (equal (string-search "ø" (string-to-multibyte (make-string 32 ?a)))
+ nil))
+ (should (equal (string-search "o" (string-to-multibyte
+ (apply #'string
+ (number-sequence ?a ?z))))
+ 14))
(should (equal (string-search "a\U00010f98z" "a\U00010f98a\U00010f98z") 2))
@@ -976,3 +983,118 @@
(should (equal (string-search (string-to-multibyte "o\303\270") "foo\303\270")
2))
(should (equal (string-search "\303\270" "foo\303\270") 3)))
+
+(ert-deftest object-intervals ()
+ (should (equal (object-intervals (propertize "foo" 'bar 'zot))
+ '((0 3 (bar zot)))))
+ (should (equal (object-intervals (concat (propertize "foo" 'bar 'zot)
+ (propertize "foo" 'gazonk "gazonk")))
+ '((0 3 (bar zot)) (3 6 (gazonk "gazonk")))))
+ (should (equal
+ (with-temp-buffer
+ (insert "foobar")
+ (put-text-property 1 3 'foo 1)
+ (put-text-property 3 6 'bar 2)
+ (put-text-property 2 5 'zot 3)
+ (object-intervals (current-buffer)))
+ '((0 1 (foo 1)) (1 2 (zot 3 foo 1)) (2 4 (zot 3 bar 2))
+ (4 5 (bar 2)) (5 6 nil)))))
+
+(ert-deftest length-equals-tests ()
+ (should-not (length< (list 1 2 3) 2))
+ (should-not (length< (list 1 2 3) 3))
+ (should (length< (list 1 2 3) 4))
+
+ (should-not (length< "abc" 2))
+ (should-not (length< "abc" 3))
+ (should (length< "abc" 4))
+
+ (should (length> (list 1 2 3) 2))
+ (should-not (length> (list 1 2 3) 3))
+ (should-not (length> (list 1 2 3) 4))
+
+ (should (length> "abc" 2))
+ (should-not (length> "abc" 3))
+ (should-not (length> "abc" 4))
+
+ (should-not (length= (list 1 2 3) 2))
+ (should (length= (list 1 2 3) 3))
+ (should-not (length= (list 1 2 3) 4))
+
+ (should-not (length= "abc" 2))
+ (should (length= "abc" 3))
+ (should-not (length= "abc" 4))
+
+ (should-not (length< (list 1 2 3) -1))
+ (should-not (length< (list 1 2 3) 0))
+ (should-not (length< (list 1 2 3) -10))
+
+ (should (length> (list 1 2 3) -1))
+ (should (length> (list 1 2 3) 0))
+
+ (should-not (length= (list 1 2 3) -1))
+ (should-not (length= (list 1 2 3) 0))
+ (should-not (length= (list 1 2 3) 1))
+
+ (should-error
+ (let ((list (list 1)))
+ (setcdr list list)
+ (length< list #x1fffe))))
+
+(defun approx-equal (list1 list2)
+ (and (equal (length list1) (length list2))
+ (cl-loop for v1 in list1
+ for v2 in list2
+ when (not (or (= v1 v2)
+ (< (abs (- v1 v2)) 0.1)))
+ return nil
+ finally return t)))
+
+(ert-deftest test-buffer-line-stats-nogap ()
+ (with-temp-buffer
+ (insert "")
+ (should (approx-equal (buffer-line-statistics) '(0 0 0))))
+ (with-temp-buffer
+ (insert "123\n")
+ (should (approx-equal (buffer-line-statistics) '(1 3 3))))
+ (with-temp-buffer
+ (insert "123\n12345\n123\n")
+ (should (approx-equal (buffer-line-statistics) '(3 5 3.66))))
+ (with-temp-buffer
+ (insert "123\n12345\n123")
+ (should (approx-equal (buffer-line-statistics) '(3 5 3.66))))
+ (with-temp-buffer
+ (insert "123\n12345")
+ (should (approx-equal (buffer-line-statistics) '(2 5 4))))
+
+ (with-temp-buffer
+ (insert "123\n12é45\n123\n")
+ (should (approx-equal (buffer-line-statistics) '(3 6 4))))
+
+ (with-temp-buffer
+ (insert "\n\n\n")
+ (should (approx-equal (buffer-line-statistics) '(3 0 0)))))
+
+(ert-deftest test-buffer-line-stats-gap ()
+ (with-temp-buffer
+ (dotimes (_ 1000)
+ (insert "12345678901234567890123456789012345678901234567890\n"))
+ (goto-char (point-min))
+ ;; This should make a gap appear.
+ (insert "123\n")
+ (delete-region (point-min) (point))
+ (should (approx-equal (buffer-line-statistics) '(1000 50 50.0))))
+ (with-temp-buffer
+ (dotimes (_ 1000)
+ (insert "12345678901234567890123456789012345678901234567890\n"))
+ (goto-char (point-min))
+ (insert "123\n")
+ (should (approx-equal (buffer-line-statistics) '(1001 50 49.9))))
+ (with-temp-buffer
+ (dotimes (_ 1000)
+ (insert "12345678901234567890123456789012345678901234567890\n"))
+ (goto-char (point-min))
+ (insert "123\n")
+ (goto-char (point-max))
+ (insert "fóo")
+ (should (approx-equal (buffer-line-statistics) '(1002 50 49.9)))))
diff --git a/test/src/font-tests.el b/test/src/font-tests.el
index cfc6f4c31b7..de153b8de9b 100644
--- a/test/src/font-tests.el
+++ b/test/src/font-tests.el
@@ -1,6 +1,6 @@
;;; font-tests.el --- Test suite for font-related functions. -*- lexical-binding: t -*-
-;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
;; Author: Chong Yidong <cyd@stupidchicken.com>
;; Keywords: internal
diff --git a/test/src/indent-tests.el b/test/src/indent-tests.el
index 7d1a6ce6dc3..10f1202949b 100644
--- a/test/src/indent-tests.el
+++ b/test/src/indent-tests.el
@@ -1,6 +1,6 @@
;;; indent-tests.el --- tests for src/indent.c -*- lexical-binding:t -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/src/inotify-tests.el b/test/src/inotify-tests.el
index d42fe1b0086..5572c7d7a0f 100644
--- a/test/src/inotify-tests.el
+++ b/test/src/inotify-tests.el
@@ -1,6 +1,6 @@
;;; inotify-tests.el --- Test suite for inotify. -*- lexical-binding: t -*-
-;; Copyright (C) 2012-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
;; Author: Rüdiger Sonderfeld <ruediger@c-plusplus.de>
;; Keywords: internal
diff --git a/test/src/json-tests.el b/test/src/json-tests.el
index 028f92f29d3..4be11b8c81a 100644
--- a/test/src/json-tests.el
+++ b/test/src/json-tests.el
@@ -1,6 +1,6 @@
;;; json-tests.el --- unit tests for json.c -*- lexical-binding: t; -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/src/keyboard-tests.el b/test/src/keyboard-tests.el
index 970a53555f9..607d2eafd45 100644
--- a/test/src/keyboard-tests.el
+++ b/test/src/keyboard-tests.el
@@ -1,6 +1,6 @@
;;; keyboard-tests.el --- Tests for keyboard.c -*- lexical-binding: t -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el
index 1a30a7d3a0b..d4f5fc3f190 100644
--- a/test/src/keymap-tests.el
+++ b/test/src/keymap-tests.el
@@ -1,8 +1,9 @@
;;; keymap-tests.el --- Test suite for src/keymap.c -*- lexical-binding: t -*-
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Author: Juanma Barranquero <lekktu@gmail.com>
+;; Stefan Kangas <stefankangas@gmail.com>
;; This file is part of GNU Emacs.
@@ -23,6 +24,50 @@
(require 'ert)
+(defun keymap-tests--make-keymap-test (fun)
+ (should (eq (car (funcall fun)) 'keymap))
+ (should (proper-list-p (funcall fun)))
+ (should (equal (car (last (funcall fun "foo"))) "foo")))
+
+(ert-deftest keymap-make-keymap ()
+ (keymap-tests--make-keymap-test #'make-keymap)
+ (should (char-table-p (cadr (make-keymap)))))
+
+(ert-deftest keymap-make-sparse-keymap ()
+ (keymap-tests--make-keymap-test #'make-sparse-keymap))
+
+(ert-deftest keymap-keymapp ()
+ (should (keymapp (make-keymap)))
+ (should (keymapp (make-sparse-keymap)))
+ (should-not (keymapp '(foo bar))))
+
+(ert-deftest keymap-keymap-parent ()
+ (should-not (keymap-parent (make-keymap)))
+ (should-not (keymap-parent (make-sparse-keymap)))
+ (let ((map (make-keymap)))
+ (set-keymap-parent map help-mode-map)
+ (should (equal (keymap-parent map) help-mode-map))))
+
+(ert-deftest keymap-copy-keymap/is-equal ()
+ (should (equal (copy-keymap help-mode-map) help-mode-map)))
+
+(ert-deftest keymap-copy-keymap/is-not-eq ()
+ (should-not (eq (copy-keymap help-mode-map) help-mode-map)))
+
+(ert-deftest keymap---get-keyelt/runs-menu-item-filter ()
+ (let* (menu-item-filter-ran
+ (object `(menu-item "2" identity
+ :filter ,(lambda (cmd)
+ (setq menu-item-filter-ran t)
+ cmd))))
+ (keymap--get-keyelt object t)
+ (should menu-item-filter-ran)))
+
+(ert-deftest keymap-lookup-key ()
+ (let ((map (make-keymap)))
+ (define-key map [?a] 'foo)
+ (should (eq (lookup-key map [?a]) 'foo))))
+
(ert-deftest describe-buffer-bindings/header-in-current-buffer ()
"Header should be inserted into the current buffer.
https://debbugs.gnu.org/39149#31"
@@ -36,6 +81,26 @@ https://debbugs.gnu.org/39149#31"
(with-temp-buffer
(should (eq (describe-buffer-bindings (current-buffer)) nil))))
+(defun keymap-tests--test-menu-item-filter (show filter-fun)
+ (unwind-protect
+ (progn
+ (define-key global-map (kbd "C-c C-l r")
+ `(menu-item "2" identity :filter ,filter-fun))
+ (with-temp-buffer
+ (describe-buffer-bindings (current-buffer))
+ (goto-char (point-min))
+ (if (eq show 'show)
+ (should (search-forward "C-c C-l r" nil t))
+ (should-not (search-forward "C-c C-l r" nil t)))))
+ (define-key global-map (kbd "C-c C-l r") nil)
+ (define-key global-map (kbd "C-c C-l") nil)))
+
+(ert-deftest describe-buffer-bindings/menu-item-filter-show-binding ()
+ (keymap-tests--test-menu-item-filter 'show (lambda (cmd) cmd)))
+
+(ert-deftest describe-buffer-bindings/menu-item-filter-hide-binding ()
+ (keymap-tests--test-menu-item-filter 'hide (lambda (_) nil)))
+
(ert-deftest keymap-store_in_keymap-XFASTINT-on-non-characters ()
"Check for bug fixed in \"Fix assertion violation in define-key\",
commit 86c19714b097aa477d339ed99ffb5136c755a046."
@@ -51,13 +116,150 @@ commit 86c19714b097aa477d339ed99ffb5136c755a046."
(should (eq (lookup-key Buffer-menu-mode-map [32]) 'undefined)))
(define-key Buffer-menu-mode-map [32] def))))
-(ert-deftest keymap-where-is-internal-test ()
+
+;;;; where-is-internal
+
+(defun keymap-tests--command-1 () (interactive) nil)
+(defun keymap-tests--command-2 () (interactive) nil)
+(put 'keymap-tests--command-1 :advertised-binding [?y])
+
+(ert-deftest keymap-where-is-internal ()
+ (let ((map (make-sparse-keymap)))
+ (define-key map "x" 'keymap-tests--command-1)
+ (define-key map "y" 'keymap-tests--command-1)
+ (should (equal (where-is-internal 'keymap-tests--command-1 map)
+ '([?y] [?x])))))
+
+(ert-deftest keymap-where-is-internal/firstonly-t ()
+ (let ((map (make-sparse-keymap)))
+ (define-key map "x" 'keymap-tests--command-1)
+ (define-key map "y" 'keymap-tests--command-1)
+ (should (equal (where-is-internal 'keymap-tests--command-1 map t)
+ [?y]))))
+
+(ert-deftest keymap-where-is-internal/menu-item ()
+ (let ((map (make-sparse-keymap)))
+ (define-key map [menu-bar foobar cmd1]
+ '(menu-item "Run Command 1" keymap-tests--command-1
+ :help "Command 1 Help"))
+ (define-key map "x" 'keymap-tests--command-1)
+ (should (equal (where-is-internal 'keymap-tests--command-1 map)
+ '([?x] [menu-bar foobar cmd1])))
+ (should (equal (where-is-internal 'keymap-tests--command-1 map t) [?x]))))
+
+
+(ert-deftest keymap-where-is-internal/advertised-binding ()
+ ;; Make sure order does not matter.
+ (dolist (keys '(("x" . "y") ("y" . "x")))
+ (let ((map (make-sparse-keymap)))
+ (define-key map (car keys) 'keymap-tests--command-1)
+ (define-key map (cdr keys) 'keymap-tests--command-1)
+ (should (equal (where-is-internal 'keymap-tests--command-1 map t) [121])))))
+
+(ert-deftest keymap-where-is-internal/advertised-binding-respect-remap ()
+ (let ((map (make-sparse-keymap)))
+ (define-key map "x" 'next-line)
+ (define-key map [remap keymap-tests--command-1] 'next-line)
+ (define-key map "y" 'keymap-tests--command-1)
+ (should (equal (where-is-internal 'keymap-tests--command-1 map t) [?x]))))
+
+(ert-deftest keymap-where-is-internal/remap ()
+ (let ((map (make-keymap)))
+ (define-key map (kbd "x") 'foo)
+ (define-key map (kbd "y") 'bar)
+ (define-key map [remap foo] 'bar)
+ (should (equal (where-is-internal 'foo map t) [?y]))
+ (should (equal (where-is-internal 'bar map t) [?y]))))
+
+(defvar keymap-tests-minor-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "x" 'keymap-tests--command-2)
+ map))
+
+(defvar keymap-tests-major-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "x" 'keymap-tests--command-1)
+ map))
+
+(define-minor-mode keymap-tests-minor-mode "Test.")
+
+(define-derived-mode keymap-tests-major-mode nil "Test.")
+
+(ert-deftest keymap-where-is-internal/shadowed ()
+ (with-temp-buffer
+ (keymap-tests-major-mode)
+ (keymap-tests-minor-mode)
+ (should-not (where-is-internal 'keymap-tests--command-1 nil t))
+ (should (equal (where-is-internal 'keymap-tests--command-2 nil t) [120]))))
+
+(ert-deftest keymap-where-is-internal/preferred-modifier-is-a-string ()
"Make sure we don't crash when `where-is-preferred-modifier' is not a symbol."
(should
(equal (let ((where-is-preferred-modifier "alt"))
(where-is-internal 'execute-extended-command global-map t))
[#x8000078])))
+
+;;;; describe_vector
+
+(ert-deftest help--describe-vector/bug-9293-one-shadowed-in-range ()
+ "Check that we only show a range if shadowed by the same command."
+ (let ((orig-map (let ((map (make-keymap)))
+ (define-key map "e" 'foo)
+ (define-key map "f" 'foo)
+ (define-key map "g" 'foo)
+ (define-key map "h" 'foo)
+ map))
+ (shadow-map (let ((map (make-keymap)))
+ (define-key map "f" 'bar)
+ map))
+ (text-quoting-style 'grave))
+ (with-temp-buffer
+ (help--describe-vector (cadr orig-map) nil #'help--describe-command
+ t shadow-map orig-map t)
+ (should (equal (buffer-string)
+ "
+e foo
+f foo (currently shadowed by `bar')
+g .. h foo
+")))))
+
+(ert-deftest help--describe-vector/bug-9293-same-command-does-not-shadow ()
+ "Check that a command can't be shadowed by the same command."
+ (let ((range-map
+ (let ((map (make-keymap)))
+ (define-key map "0" 'foo)
+ (define-key map "1" 'foo)
+ (define-key map "2" 'foo)
+ (define-key map "3" 'foo)
+ map))
+ (shadow-map
+ (let ((map (make-keymap)))
+ (define-key map "0" 'foo)
+ (define-key map "1" 'foo)
+ (define-key map "2" 'foo)
+ (define-key map "3" 'foo)
+ map)))
+ (with-temp-buffer
+ (help--describe-vector (cadr range-map) nil #'help--describe-command
+ t shadow-map range-map t)
+ (should (equal (buffer-string)
+ "
+0 .. 3 foo
+")))))
+
+(ert-deftest keymap--key-description ()
+ (should (equal (key-description [right] [?\C-x])
+ "C-x <right>"))
+ (should (equal (key-description [M-H-right] [?\C-x])
+ "C-x M-H-<right>"))
+ (should (equal (single-key-description 'home)
+ "<home>"))
+ (should (equal (single-key-description 'home t)
+ "home"))
+ (should (equal (single-key-description 'C-s-home)
+ "C-s-<home>")))
+
(provide 'keymap-tests)
;;; keymap-tests.el ends here
diff --git a/test/src/lcms-tests.el b/test/src/lcms-tests.el
index 4430d696807..40a48f1e9bb 100644
--- a/test/src/lcms-tests.el
+++ b/test/src/lcms-tests.el
@@ -1,6 +1,6 @@
;;; lcms-tests.el --- tests for Little CMS interface -*- lexical-binding: t -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el
index 825b74e6234..f2a60bcf327 100644
--- a/test/src/lread-tests.el
+++ b/test/src/lread-tests.el
@@ -1,6 +1,6 @@
;;; lread-tests.el --- tests for lread.c -*- lexical-binding: t; -*-
-;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2016-2021 Free Software Foundation, Inc.
;; Author: Philipp Stephani <phst@google.com>
@@ -190,4 +190,10 @@ literals (Bug#20852)."
(ert-deftest lread-circular-hash ()
(should-error (read "#s(hash-table data #0=(#0# . #0#))")))
+(ert-deftest test-inhibit-interaction ()
+ (let ((inhibit-interaction t))
+ (should-error (read-char "foo: "))
+ (should-error (read-event "foo: "))
+ (should-error (read-char-exclusive "foo: "))))
+
;;; lread-tests.el ends here
diff --git a/test/src/marker-tests.el b/test/src/marker-tests.el
index 37140f8a10b..234a0b35ea7 100644
--- a/test/src/marker-tests.el
+++ b/test/src/marker-tests.el
@@ -1,6 +1,6 @@
;;; marker-tests.el --- tests for marker.c functions -*- lexical-binding: t -*-
-;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2016-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/src/minibuf-tests.el b/test/src/minibuf-tests.el
index 13f5fac585b..28119fc999e 100644
--- a/test/src/minibuf-tests.el
+++ b/test/src/minibuf-tests.el
@@ -1,6 +1,6 @@
;;; minibuf-tests.el --- tests for minibuf.c functions -*- lexical-binding: t -*-
-;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2016-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -410,5 +410,20 @@
(should (equal (try-completion "baz" '("bAz" "baz"))
(try-completion "baz" '("baz" "bAz"))))))
+(ert-deftest test-inhibit-interaction ()
+ (let ((inhibit-interaction t))
+ (should-error (read-from-minibuffer "foo: "))
+
+ (should-error (y-or-n-p "foo: "))
+ (should-error (yes-or-no-p "foo: "))
+ (should-error (read-blanks-no-input "foo: "))
+
+ ;; See that we get the expected error.
+ (should (eq (condition-case nil
+ (read-from-minibuffer "foo: ")
+ (inhibited-interaction 'inhibit)
+ (error nil))
+ 'inhibit))))
+
;;; minibuf-tests.el ends here
diff --git a/test/src/print-tests.el b/test/src/print-tests.el
index 7b026b6b21f..0d2ea6e3834 100644
--- a/test/src/print-tests.el
+++ b/test/src/print-tests.el
@@ -1,6 +1,6 @@
;;; print-tests.el --- tests for src/print.c -*- lexical-binding: t; -*-
-;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -383,25 +383,28 @@ otherwise, use a different charset."
(let ((print-length 1))
(format "%S" h))))))
-(print-tests--deftest print-integer-output-format ()
+(print-tests--deftest print-integers-as-characters ()
;; Bug#44155.
- (let ((integer-output-format t)
- (syms (list ?? ?\; ?\( ?\) ?\{ ?\} ?\[ ?\] ?\" ?\' ?\\ ?Á)))
- (should (equal (read (print-tests--prin1-to-string syms)) syms))
- (should (equal (print-tests--prin1-to-string syms)
- (concat "(" (mapconcat #'prin1-char syms " ") ")"))))
- (let ((integer-output-format t)
- (syms (list -1 0 1 ?\120 4194175 4194176 (max-char) (1+ (max-char)))))
- (should (equal (read (print-tests--prin1-to-string syms)) syms)))
- (let ((integer-output-format 16)
- (syms (list -1 0 1 most-positive-fixnum (1+ most-positive-fixnum))))
- (should (equal (read (print-tests--prin1-to-string syms)) syms))
- (should (equal (print-tests--prin1-to-string syms)
- (concat "(" (mapconcat
- (lambda (i)
- (if (and (>= i 0) (<= i most-positive-fixnum))
- (format "#x%x" i) (format "%d" i)))
- syms " ") ")")))))
+ (let* ((print-integers-as-characters t)
+ (chars '(?? ?\; ?\( ?\) ?\{ ?\} ?\[ ?\] ?\" ?\' ?\\ ?f ?~ ?Á 32
+ ?\n ?\r ?\t ?\b ?\f ?\a ?\v ?\e ?\d))
+ (nums '(-1 -65 0 1 31 #x80 #x9f #x110000 #x3fff80 #x3fffff))
+ (nonprints '(#xd800 #xdfff #x030a #xffff #x2002 #x200c))
+ (printed-chars (print-tests--prin1-to-string chars))
+ (printed-nums (print-tests--prin1-to-string nums))
+ (printed-nonprints (print-tests--prin1-to-string nonprints)))
+ (should (equal (read printed-chars) chars))
+ (should (equal
+ printed-chars
+ (concat
+ "(?? ?\\; ?\\( ?\\) ?\\{ ?\\} ?\\[ ?\\] ?\\\" ?\\' ?\\\\"
+ " ?f ?~ ?Á ?\\s ?\\n ?\\r ?\\t ?\\b ?\\f 7 11 27 127)")))
+ (should (equal (read printed-nums) nums))
+ (should (equal printed-nums
+ "(-1 -65 0 1 31 128 159 1114112 4194176 4194303)"))
+ (should (equal (read printed-nonprints) nonprints))
+ (should (equal printed-nonprints
+ "(55296 57343 778 65535 8194 8204)"))))
(provide 'print-tests)
;;; print-tests.el ends here
diff --git a/test/src/process-tests.el b/test/src/process-tests.el
index e15ad47f968..949f73595b4 100644
--- a/test/src/process-tests.el
+++ b/test/src/process-tests.el
@@ -1,6 +1,6 @@
;;; process-tests.el --- Testing the process facilities -*- lexical-binding: t -*-
-;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -23,8 +23,12 @@
;;; Code:
+(require 'cl-lib)
(require 'ert)
(require 'puny)
+(require 'rx)
+(require 'subr-x)
+(require 'dns)
;; Timeout in seconds; the test fails if the timeout is reached.
(defvar process-test-sentinel-wait-timeout 2.0)
@@ -47,13 +51,15 @@
(ert-deftest process-test-sentinel-accept-process-output ()
(skip-unless (executable-find "bash"))
+ (with-timeout (60 (ert-fail "Test timed out"))
(should (process-test-sentinel-wait-function-working-p
- #'accept-process-output)))
+ #'accept-process-output))))
(ert-deftest process-test-sentinel-sit-for ()
(skip-unless (executable-find "bash"))
+ (with-timeout (60 (ert-fail "Test timed out"))
(should
- (process-test-sentinel-wait-function-working-p (lambda () (sit-for 0.01 t)))))
+ (process-test-sentinel-wait-function-working-p (lambda () (sit-for 0.01 t))))))
(when (eq system-type 'windows-nt)
(ert-deftest process-test-quoted-batfile ()
@@ -79,6 +85,7 @@
(ert-deftest process-test-stderr-buffer ()
(skip-unless (executable-find "bash"))
+ (with-timeout (60 (ert-fail "Test timed out"))
(let* ((stdout-buffer (generate-new-buffer "*stdout*"))
(stderr-buffer (generate-new-buffer "*stderr*"))
(proc (make-process :name "test"
@@ -103,10 +110,11 @@
(looking-at "hello stdout!")))
(should (with-current-buffer stderr-buffer
(goto-char (point-min))
- (looking-at "hello stderr!")))))
+ (looking-at "hello stderr!"))))))
(ert-deftest process-test-stderr-filter ()
(skip-unless (executable-find "bash"))
+ (with-timeout (60 (ert-fail "Test timed out"))
(let* ((sentinel-called nil)
(stderr-sentinel-called nil)
(stdout-output nil)
@@ -145,10 +153,11 @@
(should (equal 1 (with-current-buffer stderr-buffer
(point-max))))
(should (equal "hello stderr!\n"
- (mapconcat #'identity (nreverse stderr-output) "")))))
+ (mapconcat #'identity (nreverse stderr-output) ""))))))
(ert-deftest set-process-filter-t ()
"Test setting process filter to t and back." ;; Bug#36591
+ (with-timeout (60 (ert-fail "Test timed out"))
(with-temp-buffer
(let* ((print-level nil)
(print-length nil)
@@ -180,11 +189,12 @@
(line-beginning-position) (point-max))
"2> "))
(accept-process-output proc)) ; Read "Two".
- (should (equal (buffer-string) "0> one\n1> two\n2> ")))))
+ (should (equal (buffer-string) "0> one\n1> two\n2> "))))))
(ert-deftest start-process-should-not-modify-arguments ()
"`start-process' must not modify its arguments in-place."
;; See bug#21831.
+ (with-timeout (60 (ert-fail "Test timed out"))
(let* ((path (pcase system-type
((or 'windows-nt 'ms-dos)
;; Make sure the file name uses forward slashes.
@@ -198,11 +208,12 @@
(should (process-live-p (condition-case nil
(start-process "" nil path)
(error nil))))
- (should (equal path samepath))))
+ (should (equal path samepath)))))
(ert-deftest make-process/noquery-stderr ()
"Checks that Bug#30031 is fixed."
(skip-unless (executable-find "sleep"))
+ (with-timeout (60 (ert-fail "Test timed out"))
(with-temp-buffer
(let* ((previous-processes (process-list))
(process (make-process :name "sleep"
@@ -217,7 +228,7 @@
(should new-processes)
(dolist (process new-processes)
(should-not (process-query-on-exit-flag process))))
- (kill-process process)))))
+ (kill-process process))))))
;; Return t if OUTPUT could have been generated by merging the INPUTS somehow.
(defun process-tests--mixable (output &rest inputs)
@@ -233,6 +244,7 @@
(ert-deftest make-process/mix-stderr ()
"Check that `make-process' mixes the output streams if STDERR is nil."
(skip-unless (executable-find "bash"))
+ (with-timeout (60 (ert-fail "Test timed out"))
;; Frequent random (?) failures on hydra.nixos.org, with no process output.
;; Maybe this test should be tagged unstable? See bug#31214.
(skip-unless (not (getenv "EMACS_HYDRA_CI")))
@@ -251,11 +263,12 @@
(should (eq (process-exit-status process) 0))
(should (process-tests--mixable (string-to-list (buffer-string))
(string-to-list "stdout\n")
- (string-to-list "stderr\n"))))))
+ (string-to-list "stderr\n")))))))
(ert-deftest make-process-w32-debug-spawn-error ()
"Check that debugger runs on `make-process' failure (Bug#33016)."
(skip-unless (eq system-type 'windows-nt))
+ (with-timeout (60 (ert-fail "Test timed out"))
(let* ((debug-on-error t)
(have-called-debugger nil)
(debugger (lambda (&rest _)
@@ -271,11 +284,12 @@
;; code.
(make-process :name "test" :command '("c:/No-Such-Command"))
(error :got-error))))
- (should have-called-debugger)))
+ (should have-called-debugger))))
(ert-deftest make-process/file-handler/found ()
- "Check that the ‘:file-handler’ argument of ‘make-process’
+ "Check that the `:file-handler’ argument of `make-process’
works as expected if a file name handler is found."
+ (with-timeout (60 (ert-fail "Test timed out"))
(let ((file-handler-calls 0))
(cl-flet ((file-handler
(&rest args)
@@ -292,27 +306,29 @@ works as expected if a file name handler is found."
:command '("/some/binary")
:file-handler t)
'fake-process))
- (should (= file-handler-calls 1))))))
+ (should (= file-handler-calls 1)))))))
(ert-deftest make-process/file-handler/not-found ()
- "Check that the ‘:file-handler’ argument of ‘make-process’
+ "Check that the `:file-handler’ argument of `make-process’
works as expected if no file name handler is found."
+ (with-timeout (60 (ert-fail "Test timed out"))
(let ((file-name-handler-alist ())
(default-directory invocation-directory)
(program (expand-file-name invocation-name invocation-directory)))
(should (processp (make-process :name "name"
:command (list program "--version")
- :file-handler t)))))
+ :file-handler t))))))
(ert-deftest make-process/file-handler/disable ()
- "Check ‘make-process’ works as expected if it shouldn’t use the
+ "Check `make-process’ works as expected if it shouldn’t use the
file name handler."
+ (with-timeout (60 (ert-fail "Test timed out"))
(let ((file-name-handler-alist (list (cons (rx bos "test-handler:")
#'process-tests--file-handler)))
(default-directory "test-handler:/dir/")
(program (expand-file-name invocation-name invocation-directory)))
(should (processp (make-process :name "name"
- :command (list program "--version"))))))
+ :command (list program "--version")))))))
(defun process-tests--file-handler (operation &rest _args)
(cl-ecase operation
@@ -325,48 +341,513 @@ file name handler."
(ert-deftest make-process/stop ()
"Check that `make-process' doesn't accept a `:stop' key.
See Bug#30460."
+ (with-timeout (60 (ert-fail "Test timed out"))
(should-error
(make-process :name "test"
:command (list (expand-file-name invocation-name
invocation-directory))
- :stop t)))
+ :stop t))))
;; All the following tests require working DNS, which appears not to
;; be the case for hydra.nixos.org, so disable them there for now.
+;; This will need updating when IANA assign more IPv6 global ranges.
+(defun ipv6-is-available ()
+ (and (featurep 'make-network-process '(:family ipv6))
+ (cl-rassoc-if
+ (lambda (elt)
+ (and (eq 9 (length elt))
+ (= (logand (aref elt 0) #xe000) #x2000)))
+ (network-interface-list))))
+
(ert-deftest lookup-family-specification ()
- "network-lookup-address-info should only accept valid family symbols."
+ "`network-lookup-address-info' should only accept valid family symbols."
(skip-unless (not (getenv "EMACS_HYDRA_CI")))
- (should-error (network-lookup-address-info "google.com" 'both))
- (should (network-lookup-address-info "google.com" 'ipv4))
- (when (featurep 'make-network-process '(:family ipv6))
- (should (network-lookup-address-info "google.com" 'ipv6))))
+ (with-timeout (60 (ert-fail "Test timed out"))
+ (should-error (network-lookup-address-info "localhost" 'both))
+ (should (network-lookup-address-info "localhost" 'ipv4))
+ (when (ipv6-is-available)
+ (should (network-lookup-address-info "localhost" 'ipv6)))))
(ert-deftest lookup-unicode-domains ()
- "Unicode domains should fail"
+ "Unicode domains should fail."
(skip-unless (not (getenv "EMACS_HYDRA_CI")))
+ (with-timeout (60 (ert-fail "Test timed out"))
(should-error (network-lookup-address-info "faß.de"))
- (should (network-lookup-address-info (puny-encode-domain "faß.de"))))
+ (should (network-lookup-address-info (puny-encode-domain "faß.de")))))
(ert-deftest unibyte-domain-name ()
- "Unibyte domain names should work"
+ "Unibyte domain names should work."
(skip-unless (not (getenv "EMACS_HYDRA_CI")))
- (should (network-lookup-address-info (string-to-unibyte "google.com"))))
+ (with-timeout (60 (ert-fail "Test timed out"))
+ (should (network-lookup-address-info (string-to-unibyte "google.com")))))
(ert-deftest lookup-google ()
- "Check that we can look up google IP addresses"
+ "Check that we can look up google IP addresses."
(skip-unless (not (getenv "EMACS_HYDRA_CI")))
+ (with-timeout (60 (ert-fail "Test timed out"))
(let ((addresses-both (network-lookup-address-info "google.com"))
(addresses-v4 (network-lookup-address-info "google.com" 'ipv4)))
(should addresses-both)
(should addresses-v4))
- (when (featurep 'make-network-process '(:family ipv6))
- (should (network-lookup-address-info "google.com" 'ipv6))))
+ (when (and (ipv6-is-available)
+ (dns-query "google.com" 'AAAA))
+ (should (network-lookup-address-info "google.com" 'ipv6)))))
(ert-deftest non-existent-lookup-failure ()
+ "Check that looking up non-existent domain returns nil."
(skip-unless (not (getenv "EMACS_HYDRA_CI")))
- "Check that looking up non-existent domain returns nil"
- (should (eq nil (network-lookup-address-info "emacs.invalid"))))
+ (with-timeout (60 (ert-fail "Test timed out"))
+ (should (eq nil (network-lookup-address-info "emacs.invalid")))))
+
+(defmacro process-tests--ignore-EMFILE (&rest body)
+ "Evaluate BODY, ignoring EMFILE errors."
+ (declare (indent 0) (debug t))
+ (let ((err (make-symbol "err"))
+ (message (make-symbol "message")))
+ `(let ((,message (process-tests--EMFILE-message)))
+ (condition-case ,err
+ ,(macroexp-progn body)
+ (file-error
+ ;; If we couldn't determine the EMFILE message, just ignore
+ ;; all `file-error' signals.
+ (and ,message
+ (not (string-equal (caddr ,err) ,message))
+ (signal (car ,err) (cdr ,err))))))))
+
+(defmacro process-tests--with-buffers (var &rest body)
+ "Bind VAR to nil and evaluate BODY.
+Afterwards, kill all buffers in the list VAR. BODY should add
+some buffer objects to VAR."
+ (declare (indent 1) (debug (symbolp body)))
+ (cl-check-type var symbol)
+ `(let ((,var nil))
+ (unwind-protect
+ ,(macroexp-progn body)
+ (mapc #'kill-buffer ,var))))
+
+(defmacro process-tests--with-processes (var &rest body)
+ "Bind VAR to nil and evaluate BODY.
+Afterwards, delete all processes in the list VAR. BODY should
+add some process objects to VAR."
+ (declare (indent 1) (debug (symbolp body)))
+ (cl-check-type var symbol)
+ `(let ((,var nil))
+ (unwind-protect
+ ,(macroexp-progn body)
+ (mapc #'delete-process ,var))))
+
+(defmacro process-tests--with-raised-rlimit (&rest body)
+ "Evaluate BODY using a higher limit for the number of open files.
+Attempt to set the resource limit for the number of open files
+temporarily to the highest possible value."
+ (declare (indent 0) (debug t))
+ (let ((prlimit (make-symbol "prlimit"))
+ (soft (make-symbol "soft"))
+ (hard (make-symbol "hard"))
+ (pid-arg (make-symbol "pid-arg")))
+ `(let ((,prlimit (executable-find "prlimit"))
+ (,pid-arg (format "--pid=%d" (emacs-pid)))
+ (,soft nil) (,hard nil))
+ (cl-flet ((set-limit
+ (value)
+ (cl-check-type value natnum)
+ (when ,prlimit
+ (call-process ,prlimit nil nil nil
+ ,pid-arg
+ (format "--nofile=%d:" value)))))
+ (when ,prlimit
+ (with-temp-buffer
+ (when (eql (call-process ,prlimit nil t nil
+ ,pid-arg "--nofile"
+ "--raw" "--noheadings"
+ "--output=SOFT,HARD")
+ 0)
+ (goto-char (point-min))
+ (when (looking-at (rx (group (+ digit)) (+ blank)
+ (group (+ digit)) ?\n))
+ (setq ,soft (string-to-number
+ (match-string-no-properties 1))
+ ,hard (string-to-number
+ (match-string-no-properties 2))))))
+ (and ,soft ,hard (< ,soft ,hard)
+ (set-limit ,hard)))
+ (unwind-protect
+ ,(macroexp-progn body)
+ (when ,soft (set-limit ,soft)))))))
+
+(defmacro process-tests--fd-setsize-test (&rest body)
+ "Run BODY as a test for FD_SETSIZE overflow.
+Try to generate pipe processes until we are close to the
+FD_SETSIZE limit. Within BODY, only a small number of file
+descriptors should still be available. Furthermore, raise the
+maximum number of open files in the Emacs process above
+FD_SETSIZE."
+ (declare (indent 0) (debug t))
+ (let ((process (make-symbol "process"))
+ (processes (make-symbol "processes"))
+ (buffer (make-symbol "buffer"))
+ (buffers (make-symbol "buffers"))
+ ;; FD_SETSIZE is typically 1024 on Unix-like systems. On
+ ;; MS-Windows we artificially limit FD_SETSIZE to 64, see the
+ ;; commentary in w32proc.c.
+ (fd-setsize (if (eq system-type 'windows-nt) 64 1024)))
+ `(process-tests--with-raised-rlimit
+ (process-tests--with-buffers ,buffers
+ (process-tests--with-processes ,processes
+ ;; First, allocate enough pipes to definitely exceed the
+ ;; FD_SETSIZE limit.
+ (cl-loop for i from 1 to ,(1+ fd-setsize)
+ for ,buffer = (generate-new-buffer
+ (format " *pipe %d*" i))
+ do (push ,buffer ,buffers)
+ for ,process = (process-tests--ignore-EMFILE
+ (make-pipe-process
+ :name (format "pipe %d" i)
+ ;; Prevent delete-process from
+ ;; trying to read from pipe
+ ;; processes that didn't exit
+ ;; yet, because no one is
+ ;; writing to those pipes, and
+ ;; the read will stall.
+ :stop (eq system-type 'windows-nt)
+ :buffer ,buffer
+ :coding 'no-conversion
+ :noquery t))
+ while ,process
+ do (push ,process ,processes))
+ (unless (cddr ,processes)
+ (ert-fail "Couldn't allocate enough pipes"))
+ ;; Delete two pipes to test more edge cases.
+ (delete-process (pop ,processes))
+ (delete-process (pop ,processes))
+ ,@body)))))
+
+(defmacro process-tests--with-temp-directory (var &rest body)
+ "Bind VAR to the name of a new directory and evaluate BODY.
+Afterwards, delete the directory."
+ (declare (indent 1) (debug (symbolp body)))
+ (cl-check-type var symbol)
+ (let ((dir (make-symbol "dir")))
+ `(let ((,dir (make-temp-file "emacs-test-" :dir)))
+ (unwind-protect
+ (let ((,var ,dir))
+ ,@body)
+ (delete-directory ,dir :recursive)))))
+
+;; Tests for FD_SETSIZE overflow (Bug#24325). The following tests
+;; generate lots of process objects of the various kinds. Running the
+;; tests with assertions enabled should not result in any crashes due
+;; to file descriptor set overflow. These tests first generate lots
+;; of unused pipe processes to fill up the file descriptor space.
+;; Then, they create a few instances of the process type under test.
+
+(ert-deftest process-tests/fd-setsize-no-crash/make-process ()
+ "Check that Emacs doesn't crash when trying to use more than
+FD_SETSIZE file descriptors (Bug#24325)."
+ (with-timeout (60 (ert-fail "Test timed out"))
+ (let ((cat (executable-find "cat")))
+ (skip-unless cat)
+ (dolist (conn-type '(pipe pty))
+ (ert-info ((format "Connection type `%s'" conn-type))
+ (process-tests--fd-setsize-test
+ (process-tests--with-processes processes
+ ;; Start processes until we exhaust the file descriptor
+ ;; set size. We assume that each process requires at
+ ;; least one file descriptor.
+ (dotimes (i 10)
+ (let ((process
+ ;; Failure to allocate more file descriptors
+ ;; should signal `file-error', but not crash.
+ ;; Since we don't know the exact limit, we
+ ;; ignore `file-error'.
+ (process-tests--ignore-EMFILE
+ (make-process :name (format "test %d" i)
+ :command (list cat)
+ :connection-type conn-type
+ :coding 'no-conversion
+ :noquery t))))
+ (when process (push process processes))))
+ ;; We should have managed to start at least one process.
+ (should processes)
+ (dolist (process processes)
+ ;; The process now should either be running, or have
+ ;; already failed before `exec'.
+ (should (memq (process-status process) '(run exit)))
+ (when (process-live-p process)
+ (process-send-eof process))
+ (while (accept-process-output process))
+ (should (eq (process-status process) 'exit))
+ ;; If there's an error between fork and exec, Emacs
+ ;; will use exit statuses between 125 and 127, see
+ ;; process.h. This can happen if the child process
+ ;; tries to set up terminal device but fails due to
+ ;; file number limits. We don't treat this as an
+ ;; error.
+ (should (memql (process-exit-status process)
+ '(0 125 126 127)))))))))))
+
+(ert-deftest process-tests/fd-setsize-no-crash/make-pipe-process ()
+ "Check that Emacs doesn't crash when trying to use more than
+FD_SETSIZE file descriptors (Bug#24325)."
+ (with-timeout (60 (ert-fail "Test timed out"))
+ (process-tests--fd-setsize-test
+ (process-tests--with-buffers buffers
+ (process-tests--with-processes processes
+ ;; Start processes until we exhaust the file descriptor set
+ ;; size. We assume that each process requires at least one
+ ;; file descriptor.
+ (dotimes (i 10)
+ (let ((buffer (generate-new-buffer (format " *%d*" i))))
+ (push buffer buffers)
+ (let ((process
+ ;; Failure to allocate more file descriptors
+ ;; should signal `file-error', but not crash.
+ ;; Since we don't know the exact limit, we ignore
+ ;; `file-error'.
+ (process-tests--ignore-EMFILE
+ (make-pipe-process :name (format "test %d" i)
+ :buffer buffer
+ :coding 'no-conversion
+ :noquery t))))
+ (when process (push process processes)))))
+ ;; We should have managed to start at least one process.
+ (should processes))))))
+
+(ert-deftest process-tests/fd-setsize-no-crash/make-network-process ()
+ "Check that Emacs doesn't crash when trying to use more than
+FD_SETSIZE file descriptors (Bug#24325)."
+ (skip-unless (featurep 'make-network-process '(:server t)))
+ (skip-unless (featurep 'make-network-process '(:family local)))
+ (with-timeout (60 (ert-fail "Test timed out"))
+ (process-tests--with-temp-directory directory
+ (process-tests--with-processes processes
+ (let* ((num-clients 10)
+ (socket-name (expand-file-name "socket" directory))
+ ;; Run a UNIX server to connect to.
+ (server (make-network-process :name "server"
+ :server num-clients
+ :buffer nil
+ :service socket-name
+ :family 'local
+ :coding 'no-conversion
+ :noquery t)))
+ (push server processes)
+ (process-tests--fd-setsize-test
+ ;; Start processes until we exhaust the file descriptor
+ ;; set size. We assume that each process requires at
+ ;; least one file descriptor.
+ (dotimes (i num-clients)
+ (let ((client
+ ;; Failure to allocate more file descriptors
+ ;; should signal `file-error', but not crash.
+ ;; Since we don't know the exact limit, we ignore
+ ;; `file-error'.
+ (process-tests--ignore-EMFILE
+ (make-network-process
+ :name (format "client %d" i)
+ :service socket-name
+ :family 'local
+ :coding 'no-conversion
+ :noquery t))))
+ (when client (push client processes))))
+ ;; We should have managed to start at least one process.
+ (should processes)))))))
+
+(ert-deftest process-tests/fd-setsize-no-crash/make-serial-process ()
+ "Check that Emacs doesn't crash when trying to use more than
+FD_SETSIZE file descriptors (Bug#24325)."
+ ;; This test cannot be run if PTYs aren't supported.
+ (skip-unless (not (eq system-type 'windows-nt)))
+ (with-timeout (60 (ert-fail "Test timed out"))
+ (process-tests--with-processes processes
+ ;; In order to use `make-serial-process', we need to create some
+ ;; pseudoterminals. The easiest way to do that is to start a
+ ;; normal process using the `pty' connection type. We need to
+ ;; ensure that the terminal stays around while we connect to it.
+ ;; Create the host processes before the dummy pipes so we have a
+ ;; high chance of succeeding here.
+ (let ((sleep (executable-find "sleep"))
+ (tty-names ()))
+ (skip-unless sleep)
+ (dotimes (i 10)
+ (let* ((host (make-process :name (format "tty host %d" i)
+ :command (list sleep "60")
+ :buffer nil
+ :coding 'utf-8-unix
+ :connection-type 'pty
+ :noquery t))
+ (tty-name (process-tty-name host)))
+ (should (processp host))
+ (push host processes)
+ ;; FIXME: The assumption below that using :connection 'pty
+ ;; in make-process necessarily produces a process with PTY
+ ;; connection is unreliable and non-portable.
+ ;; make-process can legitimately and silently fall back on
+ ;; pipes if allocating a PTY fails (and on MS-Windows it
+ ;; always fails). The following code also assumes that
+ ;; process-tty-name produces a file name that can be
+ ;; passed to 'stat' and to make-serial-process, which is
+ ;; also non-portable.
+ (should tty-name)
+ (should (file-exists-p tty-name))
+ (should-not (member tty-name tty-names))
+ (push tty-name tty-names)))
+ (process-tests--fd-setsize-test
+ (process-tests--with-processes processes
+ (process-tests--with-buffers buffers
+ (dolist (tty-name tty-names)
+ (let ((buffer (generate-new-buffer
+ (format " *%s*" tty-name))))
+ (push buffer buffers)
+ ;; Failure to allocate more file descriptors should
+ ;; signal `file-error', but not crash. Since we
+ ;; don't know the exact limit, we ignore
+ ;; `file-error'.
+ (let ((process (process-tests--ignore-EMFILE
+ (make-serial-process
+ :name (format "test %s" tty-name)
+ :port tty-name
+ :speed 9600
+ :buffer buffer
+ :coding 'no-conversion
+ :noquery t))))
+ (when process (push process processes))))))
+ ;; We should have managed to start at least one process.
+ (should processes)))))))
+
+(defvar process-tests--EMFILE-message :unknown
+ "Cached result of the function `process-tests--EMFILE-message'.")
+
+(defun process-tests--EMFILE-message ()
+ "Return the error message for the EMFILE POSIX error.
+Return nil if that can't be determined."
+ (when (eq process-tests--EMFILE-message :unknown)
+ (setq process-tests--EMFILE-message
+ (with-temp-buffer
+ (when (eql (ignore-error 'file-error
+ (call-process "errno" nil t nil "EMFILE"))
+ 0)
+ (goto-char (point-min))
+ (when (looking-at (rx "EMFILE" (+ blank) (+ digit)
+ (+ blank) (group (+ nonl))))
+ (match-string-no-properties 1))))))
+ process-tests--EMFILE-message)
+
+(ert-deftest process-tests/sentinel-called ()
+ "Check that sentinels are called after processes finish"
+ (let ((command (process-tests--emacs-command)))
+ (skip-unless command)
+ (dolist (conn-type '(pipe pty))
+ (ert-info ((format "Connection type: %s" conn-type))
+ (process-tests--with-processes processes
+ (let* ((calls ())
+ (process (make-process
+ :name "echo"
+ :command (process-tests--eval
+ command '(print "first"))
+ :noquery t
+ :connection-type conn-type
+ :coding 'utf-8-unix
+ :sentinel (lambda (process message)
+ (push (list process message)
+ calls)))))
+ (push process processes)
+ (while (accept-process-output process))
+ (should (equal calls
+ (list (list process "finished\n"))))))))))
+
+(ert-deftest process-tests/sentinel-with-multiple-processes ()
+ "Check that sentinels are called in time even when other processes
+have written output."
+ (let ((command (process-tests--emacs-command)))
+ (skip-unless command)
+ (dolist (conn-type '(pipe pty))
+ (ert-info ((format "Connection type: %s" conn-type))
+ (process-tests--with-processes processes
+ (let* ((calls ())
+ (process (make-process
+ :name "echo"
+ :command (process-tests--eval
+ command '(print "first"))
+ :noquery t
+ :connection-type conn-type
+ :coding 'utf-8-unix
+ :sentinel (lambda (process message)
+ (push (list process message)
+ calls)))))
+ (push process processes)
+ (push (make-process
+ :name "bash"
+ :command (process-tests--eval
+ command
+ '(progn (sleep-for 10) (print "second")))
+ :noquery t
+ :connection-type conn-type)
+ processes)
+ (while (accept-process-output process))
+ (should (equal calls
+ (list (list process "finished\n"))))))))))
+
+(defun process-tests--eval (command form)
+ "Return a command that evaluates FORM in an Emacs subprocess.
+COMMAND must be a list returned by
+`process-tests--emacs-command'."
+ (let ((print-gensym t)
+ (print-circle t)
+ (print-length nil)
+ (print-level nil)
+ (print-escape-control-characters t)
+ (print-escape-newlines t)
+ (print-escape-multibyte t)
+ (print-escape-nonascii t))
+ `(,@command "--quick" "--batch" ,(format "--eval=%S" form))))
+
+(defun process-tests--emacs-command ()
+ "Return a command to reinvoke the current Emacs instance.
+Return nil if that doesn't appear to be possible."
+ (when-let ((binary (process-tests--emacs-binary))
+ (dump (process-tests--dump-file)))
+ (cons binary
+ (unless (eq dump :not-needed)
+ (list (concat "--dump-file="
+ (file-name-unquote dump)))))))
+
+(defun process-tests--emacs-binary ()
+ "Return the filename of the currently running Emacs binary.
+Return nil if that can't be determined."
+ (and (stringp invocation-name)
+ (not (file-remote-p invocation-name))
+ (not (file-name-absolute-p invocation-name))
+ (stringp invocation-directory)
+ (not (file-remote-p invocation-directory))
+ (file-name-absolute-p invocation-directory)
+ (when-let ((file (process-tests--usable-file-for-reinvoke
+ (expand-file-name invocation-name
+ invocation-directory))))
+ (and (file-executable-p file) file))))
+
+(defun process-tests--dump-file ()
+ "Return the filename of the dump file used to start Emacs.
+Return nil if that can't be determined. Return `:not-needed' if
+Emacs wasn't started with a dump file."
+ (if-let ((stats (and (fboundp 'pdumper-stats) (pdumper-stats))))
+ (when-let ((file (process-tests--usable-file-for-reinvoke
+ (cdr (assq 'dump-file-name stats)))))
+ (and (file-readable-p file) file))
+ :not-needed))
+
+(defun process-tests--usable-file-for-reinvoke (filename)
+ "Return a version of FILENAME that can be used to reinvoke Emacs.
+Return nil if FILENAME doesn't exist."
+ (when (and (stringp filename)
+ (not (file-remote-p filename)))
+ (cl-callf file-truename filename)
+ (and (stringp filename)
+ (not (file-remote-p filename))
+ (file-name-absolute-p filename)
+ (file-regular-p filename)
+ filename)))
(provide 'process-tests)
-;; process-tests.el ends here.
+;;; process-tests.el ends here
diff --git a/test/src/regex-emacs-tests.el b/test/src/regex-emacs-tests.el
index f9372e37b11..0607eacf397 100644
--- a/test/src/regex-emacs-tests.el
+++ b/test/src/regex-emacs-tests.el
@@ -1,6 +1,6 @@
;;; regex-emacs-tests.el --- tests for regex-emacs.c -*- lexical-binding: t -*-
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -803,4 +803,68 @@ This evaluates the TESTS test cases from glibc."
(should-not (string-match "å" "\xe5"))
(should-not (string-match "[å]" "\xe5")))
+(ert-deftest regexp-case-fold ()
+ "Test case-sensitive and case-insensitive matching."
+ (let ((case-fold-search nil))
+ (should (equal (string-match "aB" "ABaB") 2))
+ (should (equal (string-match "åÄ" "ÅäåäÅÄåÄ") 6))
+ (should (equal (string-match "λΛ" "lΛλλΛ") 3))
+ (should (equal (string-match "шШ" "zШшшШ") 3))
+ (should (equal (string-match "[[:alpha:]]+" ".3aBåÄßλΛшШ中﷽") 2))
+ (should (equal (match-end 0) 12))
+ (should (equal (string-match "[[:alnum:]]+" ".3aBåÄßλΛшШ中﷽") 1))
+ (should (equal (match-end 0) 12))
+ (should (equal (string-match "[[:upper:]]+" ".3aåλшBÄΛШ中﷽") 6))
+ (should (equal (match-end 0) 10))
+ (should (equal (string-match "[[:lower:]]+" ".3BÄΛШaåλш中﷽") 6))
+ (should (equal (match-end 0) 10)))
+ (let ((case-fold-search t))
+ (should (equal (string-match "aB" "ABaB") 0))
+ (should (equal (string-match "åÄ" "ÅäåäÅÄåÄ") 0))
+ (should (equal (string-match "λΛ" "lΛλλΛ") 1))
+ (should (equal (string-match "шШ" "zШшшШ") 1))
+ (should (equal (string-match "[[:alpha:]]+" ".3aBåÄßλΛшШ中﷽") 2))
+ (should (equal (match-end 0) 12))
+ (should (equal (string-match "[[:alnum:]]+" ".3aBåÄßλΛшШ中﷽") 1))
+ (should (equal (match-end 0) 12))
+ (should (equal (string-match "[[:upper:]]+" ".3aåλшBÄΛШ中﷽") 2))
+ (should (equal (match-end 0) 10))
+ (should (equal (string-match "[[:lower:]]+" ".3BÄΛШaåλш中﷽") 2))
+ (should (equal (match-end 0) 10))))
+
+(ert-deftest regexp-eszett ()
+ "Test matching of ß and ẞ."
+ ;; Sanity checks.
+ (should (equal (upcase "ß") "SS"))
+ (should (equal (downcase "ß") "ß"))
+ (should (equal (capitalize "ß") "Ss")) ; undeutsch...
+ (should (equal (upcase "ẞ") "ẞ"))
+ (should (equal (downcase "ẞ") "ß"))
+ (should (equal (capitalize "ẞ") "ẞ"))
+ ;; ß is a lower-case letter (Ll); ẞ is an upper-case letter (Lu).
+ (let ((case-fold-search nil))
+ (should (equal (string-match "ß" "ß") 0))
+ (should (equal (string-match "ß" "ẞ") nil))
+ (should (equal (string-match "ẞ" "ß") nil))
+ (should (equal (string-match "ẞ" "ẞ") 0))
+ (should (equal (string-match "[[:alpha:]]" "ß") 0))
+ ;; bug#11309
+ (should (equal (string-match "[[:lower:]]" "ß") 0))
+ (should (equal (string-match "[[:upper:]]" "ß") nil))
+ (should (equal (string-match "[[:alpha:]]" "ẞ") 0))
+ (should (equal (string-match "[[:lower:]]" "ẞ") nil))
+ (should (equal (string-match "[[:upper:]]" "ẞ") 0)))
+ (let ((case-fold-search t))
+ (should (equal (string-match "ß" "ß") 0))
+ (should (equal (string-match "ß" "ẞ") 0))
+ (should (equal (string-match "ẞ" "ß") 0))
+ (should (equal (string-match "ẞ" "ẞ") 0))
+ (should (equal (string-match "[[:alpha:]]" "ß") 0))
+ ;; bug#11309
+ (should (equal (string-match "[[:lower:]]" "ß") 0))
+ (should (equal (string-match "[[:upper:]]" "ß") 0))
+ (should (equal (string-match "[[:alpha:]]" "ẞ") 0))
+ (should (equal (string-match "[[:lower:]]" "ẞ") 0))
+ (should (equal (string-match "[[:upper:]]" "ẞ") 0))))
+
;;; regex-emacs-tests.el ends here
diff --git a/test/src/syntax-resources/syntax-comments.txt b/test/src/syntax-resources/syntax-comments.txt
index 6f595e4d8dc..a292d816b9d 100644
--- a/test/src/syntax-resources/syntax-comments.txt
+++ b/test/src/syntax-resources/syntax-comments.txt
@@ -62,7 +62,33 @@
33; \
33
+/* Lisp comments within lists */
+40)40
+41(;90 comment
+91)41
+42(;92\
+93)42
+43( ;94
+95
+
+/* Nested Lisp comments */
+100|#100
+101#|#
+102#||#102
+103#| Comment |#103
+104#| Comment
+|#104
+105#|#|#105
+106#| #| Comment |# |#106
+107#|#|#|#|#|#|#|#|#| Comment |#|#|#|#|#|#|#|#|#107
+
+/* Mixed Lisp comments */
+110; #|
+110
+111#| ; |#111
+
Local Variables:
mode: fundamental
eval: (set-syntax-table (make-syntax-table))
End:
+999 \ No newline at end of file
diff --git a/test/src/syntax-tests.el b/test/src/syntax-tests.el
index 4b9c3f277aa..479b818935f 100644
--- a/test/src/syntax-tests.el
+++ b/test/src/syntax-tests.el
@@ -1,6 +1,6 @@
;;; syntax-tests.el --- tests for syntax.c functions -*- lexical-binding: t -*-
-;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -220,7 +220,7 @@ missing or nil, the value of -START- is assumed for it."
(cond
((eq -dir- 'forward) t)
((eq -dir- 'backward) nil)
- (t (error "Invalid -dir- argument \"%s\" to `syntax-comments'" -dir-))))
+ (t (error "Invalid -dir- argument \"%s\" to `syntax-br-comments'" -dir-))))
(start -start-)
(start-str (format "%d" (abs start)))
(type -type-))
@@ -338,10 +338,14 @@ the `parse-partial-sexp's are expected to stop. See
(setq parse-sexp-ignore-comments t)
(setq comment-end-can-be-escaped nil)
(modify-syntax-entry ?\n ">")
- (modify-syntax-entry ?\; "<"))
+ (modify-syntax-entry ?\; "<")
+ (modify-syntax-entry ?{ ".")
+ (modify-syntax-entry ?} "."))
(defun \;-out ()
(modify-syntax-entry ?\n " ")
- (modify-syntax-entry ?\; "."))
+ (modify-syntax-entry ?\; ".")
+ (modify-syntax-entry ?{ "(}")
+ (modify-syntax-entry ?} "){"))
(eval-and-compile
(setq syntax-comments-section "lisp"))
@@ -353,6 +357,62 @@ the `parse-partial-sexp's are expected to stop. See
(syntax-comments \; forward t 33)
(syntax-comments \; backward t 33)
+;; "Lisp" style comments inside lists.
+(syntax-br-comments \; backward nil 40)
+(syntax-br-comments \; forward t 41)
+(syntax-br-comments \; backward t 41)
+(syntax-br-comments \; forward t 42)
+(syntax-br-comments \; backward t 42)
+(syntax-br-comments \; forward nil 43)
+
+;; "Lisp" style comments parsed by `parse-partial-sexp'.
+(syntax-pps-comments \; 41 90 91)
+(syntax-pps-comments \; 42 92 93)
+(syntax-pps-comments \; 43 94 95 -999)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; "Lisp" style nested comments: between delimiters #| |#.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun \#|-in ()
+ (setq parse-sexp-ignore-comments t)
+ (modify-syntax-entry ?# ". 14")
+ (modify-syntax-entry ?| ". 23n")
+ (modify-syntax-entry ?\; "< b")
+ (modify-syntax-entry ?\n "> b"))
+(defun \#|-out ()
+ (modify-syntax-entry ?# ".")
+ (modify-syntax-entry ?| ".")
+ (modify-syntax-entry ?\; ".")
+ (modify-syntax-entry ?\n " "))
+(eval-and-compile
+ (setq syntax-comments-section "lisp-n"))
+
+(syntax-comments \#| forward nil 100 0)
+(syntax-comments \#| backward nil 100 0)
+(syntax-comments \#| forward nil 101 -999)
+(syntax-comments \#| forward t 102)
+(syntax-comments \#| backward t 102)
+
+(syntax-comments \#| forward t 103)
+(syntax-comments \#| backward t 103)
+(syntax-comments \#| forward t 104)
+(syntax-comments \#| backward t 104)
+
+(syntax-comments \#| forward nil 105 -999)
+(syntax-comments \#| backward t 105)
+(syntax-comments \#| forward t 106)
+(syntax-comments \#| backward t 106)
+(syntax-comments \#| forward t 107)
+(syntax-comments \#| backward t 107)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Mixed "Lisp" style (nested and unnested) comments.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(syntax-comments \#| forward t 110)
+(syntax-comments \#| backward t 110)
+(syntax-comments \#| forward t 111)
+(syntax-comments \#| backward t 111)
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Emacs 27 "C" style comments - `comment-end-can-be-escaped' is non-nil.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff --git a/test/src/textprop-tests.el b/test/src/textprop-tests.el
index 365d2c7a7b7..b083588e645 100644
--- a/test/src/textprop-tests.el
+++ b/test/src/textprop-tests.el
@@ -1,6 +1,6 @@
;;; textprop-tests.el --- Test suite for text properties. -*- lexical-binding: t -*-
-;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Author: Wolfgang Jenkner <wjenkner@inode.at>
;; Keywords: internal
diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el
index df34a2b66eb..f14d2426ef0 100644
--- a/test/src/thread-tests.el
+++ b/test/src/thread-tests.el
@@ -1,6 +1,6 @@
;;; threads.el --- tests for threads. -*- lexical-binding: t -*-
-;; Copyright (C) 2012-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/src/timefns-tests.el b/test/src/timefns-tests.el
index b35a5287946..e55bd1eb4ee 100644
--- a/test/src/timefns-tests.el
+++ b/test/src/timefns-tests.el
@@ -1,6 +1,6 @@
;;; timefns-tests.el -- tests for timefns.c -*- lexical-binding: t -*-
-;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2016-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/src/undo-tests.el b/test/src/undo-tests.el
index 182e2df93bc..055bf102dfc 100644
--- a/test/src/undo-tests.el
+++ b/test/src/undo-tests.el
@@ -1,6 +1,6 @@
;;; undo-tests.el --- Tests of primitive-undo -*- lexical-binding: t -*-
-;; Copyright (C) 2012-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
;; Author: Aaron S. Hawley <aaron.s.hawley@gmail.com>
diff --git a/test/src/xdisp-tests.el b/test/src/xdisp-tests.el
index fad90fad531..4e7d2ad8ab2 100644
--- a/test/src/xdisp-tests.el
+++ b/test/src/xdisp-tests.el
@@ -1,6 +1,6 @@
;;; xdisp-tests.el --- tests for xdisp.c functions -*- lexical-binding: t -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -57,9 +57,9 @@
(xdisp-tests--in-minibuffer
(let ((max-mini-window-height 4))
(dotimes (_ 80) (insert "\nhello"))
- (beginning-of-buffer)
+ (goto-char (point-min))
(redisplay 'force)
- (end-of-buffer)
+ (goto-char (point-max))
;; A simple edit like removing the last `o' shouldn't cause
;; the rest of the minibuffer's text to move.
(list
@@ -72,4 +72,31 @@
(should (equal (nth 0 posns) (nth 1 posns)))
(should (equal (nth 1 posns) (nth 2 posns)))))
+(ert-deftest xdisp-tests--window-text-pixel-size () ;; bug#45748
+ (with-temp-buffer
+ (insert "xxx")
+ (switch-to-buffer (current-buffer))
+ (let* ((char-width (frame-char-width))
+ (size (window-text-pixel-size nil t t))
+ (width-in-chars (/ (car size) char-width)))
+ (should (equal width-in-chars 3)))))
+
+(ert-deftest xdisp-tests--window-text-pixel-size-leading-space () ;; bug#45748
+ (with-temp-buffer
+ (insert " xx")
+ (switch-to-buffer (current-buffer))
+ (let* ((char-width (frame-char-width))
+ (size (window-text-pixel-size nil t t))
+ (width-in-chars (/ (car size) char-width)))
+ (should (equal width-in-chars 3)))))
+
+(ert-deftest xdisp-tests--window-text-pixel-size-trailing-space () ;; bug#45748
+ (with-temp-buffer
+ (insert "xx ")
+ (switch-to-buffer (current-buffer))
+ (let* ((char-width (frame-char-width))
+ (size (window-text-pixel-size nil t t))
+ (width-in-chars (/ (car size) char-width)))
+ (should (equal width-in-chars 3)))))
+
;;; xdisp-tests.el ends here
diff --git a/test/src/xfaces-tests.el b/test/src/xfaces-tests.el
index bde3a354229..0a7ef55b2b6 100644
--- a/test/src/xfaces-tests.el
+++ b/test/src/xfaces-tests.el
@@ -1,6 +1,6 @@
;;; xfaces-tests.el --- tests for xfaces.c -*- lexical-binding: t -*-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/test/src/xml-tests.el b/test/src/xml-tests.el
index 800f400b3ca..a35b4d2ccc8 100644
--- a/test/src/xml-tests.el
+++ b/test/src/xml-tests.el
@@ -1,6 +1,6 @@
;;; xml-tests.el --- Test suite for libxml parsing. -*- lexical-binding: t -*-
-;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2021 Free Software Foundation, Inc.
;; Author: Ulf Jasper <ulf.jasper@web.de>
;; Keywords: internal
@@ -44,12 +44,12 @@
(ert-deftest libxml-tests ()
"Test libxml."
- (when (fboundp 'libxml-parse-xml-region)
- (with-temp-buffer
- (dolist (test libxml-tests--data-comments-preserved)
- (erase-buffer)
- (insert (car test))
- (should (equal (cdr test)
- (libxml-parse-xml-region (point-min) (point-max))))))))
+ (skip-unless (fboundp 'libxml-parse-xml-region))
+ (with-temp-buffer
+ (dolist (test libxml-tests--data-comments-preserved)
+ (erase-buffer)
+ (insert (car test))
+ (should (equal (cdr test)
+ (libxml-parse-xml-region (point-min) (point-max)))))))
;;; libxml-tests.el ends here